Procedure HELP;
begin
  abort := true;
  WRITELN('  To run DBLIST:');
  WRITELN('  DBLIST <cr>');
  WRITELN('  DBLIST ?<cr>  <----gets this help screen.');
  WRITELN('  DBLIST INFILE <cr>');
  WRITELN('  DBLIST INFILE OUTPUT <cr>');
  WRITELN('  DBLIST INFILE OUTPUT F/B/C');
  WRITELN;
  HALT;
end;

Procedure OPENFILES;
Var
    I,NUMBLOCKS,OPENERRNUM: Integer;
    OPENOK: Boolean;
    LISTOPTION: Char;
Begin { OPEN }
   CLRSCR;
   GOTOXY(1,1);
   BIGDASH;
   WRITELN(Centered('DBLIST.COM * A combination of LISTER & XLIST'));
   WRITELN(Centered(' to XLIST INCLUDE FILES  V 1.1 JUNE 1987'));
   WRITELN(Centered('MODIFIED FOR DBASEII FILES BY: ELLIS B. LEVIN'));
   BIGDASH;
   WRITELN(SPACE(20),'1.) PASCAL CROSS-REF UTILITY.');
   WRITELN(SPACE(20),'2.) WILL SHOW START AND END OF BLOCKS.');
   WRITELN(SPACE(20),'3.) WILL CALL INCLUDE FILES.');
   BIGDASH;
   WRITELN;
   ABORT := FALSE ;
   Repeat
      NODOT := TRUE;
      Write('FILENAME: ( CR TO QUIT): ');
      if (paramcount >= 1) and (nextime) then
         begin
            FILENAME := paramstr(1);
            writeln(filename);
            nextime := false
         end
      else
         READLN( FILENAME );
        ABORT := Length(FILENAME) <= 0;
        if (NOT ABORT) and (FILENAME = '?') then help;
        If NOT ABORT then
          Begin
            For I := 1 to LENGTH(FILENAME) do
              Begin
                FILENAME[I] := UPcase(FILENAME[I]) ;
                If FILENAME[I] = '.' then
                  NODOT := False
              End;
            If NODOT then
              FILENAME := FILENAME + '.CMD';
            ASSIGN(INFILE,FILENAME);
            RESET(INFILE);
            OPENERRNUM := IORESULT;
            OPENOK := ( OPENERRNUM = 0);
            If NOT OPENOK then
              Writeln(FILENAME,' NOT FOUND')
            Else
              FILETITLE := FILENAME;
              If POS(':',FILETITLE) = 2 then
                DELETE(FILETITLE,1,2);
              LTITLE := LENGTH(FILETITLE);
        End;
   Until OPENOK OR ABORT;

   If NOT ABORT then
     Begin
       Write('DESTINATION FILE OR DEVICE (CON:=SCR;<CR>=LST:): ');
       if (paramcount >= 2) and (nex2time) then
          begin
             LSTFILENAME := paramstr(2);
             writeln(LSTFILENAME);
             nex2time := false
          end
       else
          READLN(LSTFILENAME);
       If LENGTH (LSTFILENAME) <= 0 then
         LSTFILENAME := 'LST:' ;
       For I := 1 to LENGTH(LSTFILENAME) do
         LSTFILENAME[I] := UPcase(LSTFILENAME[I]) ;
       ASSIGN(LST,LSTFILENAME);
       Rewrite(LST);
  End;
   If NOT ABORT then
     Begin
       Repeat
         Write('DO YOU WANT A <F>ull,<B>lock or <C>ross index listing (F/B/C)? ');
         if (paramcount >= 3) and (nex3time) then
            begin
               LISTOPTION := Upcase(paramstr(3));
               nex3time := false;
            end
         ELSE
            READLN( LISTOPTION );
         LISTOPTION := UPcase(LISTOPTION);
       Until LISTOPTION IN ['B','C','F'];
         LISTING := LISTOPTION = 'F';
         BLOCK := LISTOPTION = 'B';
       IF NOT LISTING AND NOT BLOCK THEN
       WRITELN('WORKING: CROSS INDEX only. Please wait ! ')
       ELSE WRITELN;
     End;
End; {open}

Procedure PUTALFA(S:ALFA);
Begin
  MOVE(S[1],BUF[BUFCURSOR],16); {8}
  BUFCURSOR:=BUFCURSOR+16;      {8}
End;

Procedure PUTNUMBER(NUM: Integer);
Var I,IPOT:Integer;
    A: ALFA;
    CH: Char;
    ZAP:Boolean;

Begin
  ZAP:=TRUE;
  IPOT:=10000;
  A[1]:=' ';
  For I:= 2 to 6 do
    Begin
      CH:=CHR(NUM DIV IPOT + ORD('0'));
      If I <> 6 then
        If ZAP then
           If CH = '0' then
             CH:=' '
           Else ZAP:=FALSE;
      A[I]:=CH;
      NUM:=NUM MOD IPOT;
      IPOT:=IPOT DIV 10;
    End;
  A[7]:=' ';
  MOVE(A,BUF[BUFCURSOR],7);
  BUFCURSOR:=BUFCURSOR+7;
End;


Procedure SEARCH( ID: ALFA );               {MODULO P HASH SEARCH}
{GLOBAL: T, TOP}
Var
    I,J,H,D  : Integer;
    X         : ITEMPTR;
    F         : Boolean;

Begin
   J:=0;
   For I:= 1 to ALFALEN do
     J:= J*10+ORD(ID[I]);
   H  := ABS(J) MOD P;
   F  := FALSE;
   D  := 1;
   Repeat
      If T[H].KEY = ID
         then
            Begin {FOUND}
               F := TRUE;
               If T[H].LAST^.REFNUM = REFSPERITEM
                  then
                     Begin
                         NEW(X);
                         X^.REFNUM := 1;
                         X^.REF[1] := LINECOUNT;
                         T[H].LAST^.NEXT:= X;
                         T[H].LAST        := X;
                     End
                 Else
                    WITH T[H].LAST^ do
                       Begin
                          REFNUM      := REFNUM + 1;
                          REF[REFNUM] := LINECOUNT
                       End
            End
         Else
            If T[H].KEY = '                '
               then
                  Begin {NEW ENTRY}
                     F := TRUE;
                     NEW(X);
                     X^.REFNUM := 1;
                     X^.REF[1] := LINECOUNT;
                     T[H].KEY := ID;
                     T[H].FIRST := X;
                     T[H].LAST := X;
                     T[H].FOL := TOP;
                     TOP := H
                  End
               Else
                  Begin {COLLISION}
                     H := H+D;
                     D := D+2;
                     If H >= P
                        then
                           H := H - P;
                     If D = P
                        then
                           Begin
                              Writeln(OUTPUT,'TBLE OVFLW');
                              ERROR := TRUE
                           End ;
                  End
   Until F OR ERROR
End {SEARCH} ;