Topspeed_JPI/TS-V3/MODBASE/DBFINVTR.LST

Listing:

    1  IMPLEMENTATION MODULE DBFInvtry;
    2  (*
    3   *  ModBase
    4   *  Release 3.0
    5   *  (c) Copyright 1986 - 1991 PMI
    6   *  P.O. Box 8402
    7   *  Green Bay Wi 53308
    8   *  All Rights Reserved
    9   *  by Ed Ross  
   10   *)
   11  
   12  FROM ModBase3 IMPORT InitDBF,OpenDBF,CloseDBF,ReadDBRec,GetField,
   13       DBFile,DefaultFixUp,NilDBF;
   14  FROM DBCopier IMPORT DBPack;
   15  FROM DBIndxes IMPORT InitIndex,OpenIndex,AddToUpdateList,CloseIndex,
   16                CurrentRec,FindPositionCh,BuildIndex,GoTop,GoBottom,
   17                NextRecord,PrevRecord,CurrentKeyCh,FindPositionN,
   18                CurrentKeyN,InitCompIndex,BuildCompIndex,DBIndex;
   19  FROM Drectory IMPORT DeleteFile;	
   20  FROM M2Strings IMPORT Assign;
   21  FROM StrEdit IMPORT CrunchBlanks,CAPstr,AssignStr;
   22  FROM DBStuff IMPORT MakeKey;
   23  FROM StrConv IMPORT StrToReal;
   24  FROM NumTypes IMPORT Real8,REALToReal8;
   25  FROM LowLevel IMPORT Fill;
   26  FROM SYSTEM IMPORT ADR;
   27  FROM ScanUtils IMPORT Present,CaseSens;
   28  FROM PosUtils IMPORT Equal;
   29  FROM DBFields IMPORT GetDateField,GetLogicalField,GetNumField,Replace,
   30       ReplaceD,ReplaceN,ReplaceL;
   31  
   32  CONST
   33    Buffer = 0;
   34    Safty = TRUE;
   35    Exclusive = FALSE;
   36    AutoLock = TRUE;
   37  
   38  VAR
   39    DBInit,IndexOpen : BOOLEAN;
   40  
   41  
   42  PROCEDURE MoveInvtryToDBF(Rec : InvtryRec );
*****                                  ^ undeclared identifier
   43  (* This code will move the data from the record to *)
   44  (* the data base                                   *)
   45  BEGIN
   46    WITH Rec DO
*****         ^ not supported yet
   47      CAPstr(INVCODE);                  (* only caps for item code*)
*****      ^ not supported yet
*****             ^ undeclared identifier
   48      Replace( InvtryDBF,  1,INVCODE);
*****      ^ not supported yet
*****               ^ undeclared identifier
*****                             ^ undeclared identifier
   49      ReplaceN( InvtryDBF,  2,REALToReal8(FLOAT(PRICETBL)));
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                              ^ not supported yet
*****                                          ^ undeclared identifier
*****                                                ^ undeclared identifier
   50      Replace( InvtryDBF,  3,GROUP);
*****      ^ not supported yet
*****               ^ undeclared identifier
*****                             ^ undeclared identifier
   51      CAPstr(GROUP);
*****      ^ not supported yet
*****             ^ undeclared identifier
   52      CrunchBlanks(GROUP);
*****      ^ not supported yet
*****                   ^ undeclared identifier
   53      Replace( InvtryDBF,  4,DESC);
*****      ^ not supported yet
*****               ^ undeclared identifier
*****                             ^ undeclared identifier
   54      ReplaceN( InvtryDBF,  5,REALToReal8(FLOAT(REORDER)));
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                              ^ not supported yet
*****                                          ^ undeclared identifier
*****                                                ^ undeclared identifier
   55      ReplaceN( InvtryDBF,  6,ONHAND);
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                              ^ undeclared identifier
   56      ReplaceN( InvtryDBF,  7,REALToReal8(FLOAT(MINORDER)));
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                              ^ not supported yet
*****                                          ^ undeclared identifier
*****                                                ^ undeclared identifier
   57      ReplaceN( InvtryDBF,  8,PURPRICE);
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                              ^ undeclared identifier
   58      ReplaceL( InvtryDBF,  9,STOCKED);
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                              ^ undeclared identifier
   59      Replace( InvtryDBF, 10,UNITS);
*****      ^ not supported yet
*****               ^ undeclared identifier
*****                             ^ undeclared identifier
   60      ReplaceD( InvtryDBF, 11,LASTPUR);
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                              ^ undeclared identifier
   61      ReplaceN( InvtryDBF, 12,LSTPUAMT);
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                              ^ undeclared identifier
   62      CAPstr(ORDERFRM);
*****      ^ not supported yet
*****             ^ undeclared identifier
   63      Replace( InvtryDBF, 13,ORDERFRM);
*****      ^ not supported yet
*****               ^ undeclared identifier
*****                             ^ undeclared identifier
   64      ReplaceN( InvtryDBF, 14,UNITPRICE );    (* Unit price if not price table *)
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                              ^ undeclared identifier
   65      Replace(InvtryDBF,15,ONORDER);  (* 'Y' - item is onorder *)
*****      ^ not supported yet
*****              ^ undeclared identifier
*****                           ^ undeclared identifier
   66      ReplaceN(InvtryDBF,16,REORDAMT);  (* normal reorder quant *)
*****      ^ not supported yet
*****               ^ undeclared identifier
*****                            ^ undeclared identifier
   67  
   68  END;  (* end of with REC *)
*****  ^ not supported yet
   69  END MoveInvtryToDBF;
*****      ^ not supported yet
   70  
   71  
   72  
   73  PROCEDURE MoveInvtryFromDBF(VAR Rec : InvtryRec );
*****                                        ^ undeclared identifier
   74  (* This code will move the data from the Database to *)
   75  (* the record                                        *)
   76  VAR B : BOOLEAN;
   77      R : Real8;
   78  BEGIN
   79    WITH Rec DO
*****         ^ not supported yet
   80      GetField( InvtryDBF,  1,INVCODE );
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                              ^ undeclared identifier
   81      GetNumField( InvtryDBF,  2,R);
*****      ^ not supported yet
*****                   ^ undeclared identifier
*****                                 ^ not supported yet
   82      PRICETBL:= TRUNC(R);
*****      ^ undeclared identifier
*****                 ^ undeclared identifier
*****                       ^ not supported yet
   83      GetField( InvtryDBF,  3,GROUP );
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                              ^ undeclared identifier
   84      GetField( InvtryDBF,  4,DESC );
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                              ^ undeclared identifier
   85      GetNumField( InvtryDBF,  5,R);
*****      ^ not supported yet
*****                   ^ undeclared identifier
*****                                 ^ not supported yet
   86      REORDER:= TRUNC(R);
*****      ^ undeclared identifier
*****                ^ undeclared identifier
*****                      ^ not supported yet
   87      GetNumField( InvtryDBF,  6,ONHAND);
*****      ^ not supported yet
*****                   ^ undeclared identifier
*****                                 ^ undeclared identifier
   88      GetNumField( InvtryDBF,  7,R);
*****      ^ not supported yet
*****                   ^ undeclared identifier
*****                                 ^ not supported yet
   89      MINORDER:= TRUNC(R);
*****      ^ undeclared identifier
*****                 ^ undeclared identifier
*****                       ^ not supported yet
   90      GetNumField( InvtryDBF,  8,PURPRICE);
*****      ^ not supported yet
*****                   ^ undeclared identifier
*****                                 ^ undeclared identifier
   91      GetLogicalField( InvtryDBF,  9,STOCKED);
*****      ^ not supported yet
*****                       ^ undeclared identifier
*****                                     ^ undeclared identifier
   92      GetField( InvtryDBF, 10,UNITS );
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                              ^ undeclared identifier
   93      GetDateField( InvtryDBF, 11,LASTPUR);
*****      ^ not supported yet
*****                    ^ undeclared identifier
*****                                  ^ undeclared identifier
   94      GetNumField( InvtryDBF, 12,LSTPUAMT);
*****      ^ not supported yet
*****                   ^ undeclared identifier
*****                                 ^ undeclared identifier
   95      GetField( InvtryDBF, 13,ORDERFRM );
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                              ^ undeclared identifier
   96      GetNumField( InvtryDBF, 14,UNITPRICE );   (* Unit price if not price table *)
*****      ^ not supported yet
*****                   ^ undeclared identifier
*****                                 ^ undeclared identifier
   97      GetField(InvtryDBF,15,ONORDER );
*****      ^ not supported yet
*****               ^ undeclared identifier
*****                            ^ undeclared identifier
   98      GetNumField(InvtryDBF,16,REORDAMT);
*****      ^ not supported yet
*****                  ^ undeclared identifier
*****                               ^ undeclared identifier
   99  END;  (* end of with REC^ *)
*****  ^ not supported yet
  100  END MoveInvtryFromDBF;
*****      ^ not supported yet
  101  
  102  PROCEDURE FixInvRec();
  103  VAR Rec : InvtryRec;
*****            ^ undeclared identifier
  104  BEGIN
  105    MoveInvtryFromDBF(Rec);
*****    ^ not supported yet
*****                      ^ not supported yet
  106    MoveInvtryToDBF(Rec);
*****    ^ not supported yet
*****                    ^ not supported yet
  107  END FixInvRec;
*****      ^ not supported yet
  108  
  109  PROCEDURE MakeItemKey( DBF : DBFile;  Idx : DBIndex;
  110                         VAR Key : ARRAY OF CHAR);
*****                                            ^ not supported yet
  111  		
  112  VAR B : BOOLEAN;
  113  BEGIN
  114      GetField( DBF,  1,Key );
*****      ^ not supported yet
*****                ^ not supported yet
*****                        ^ not supported yet
  115      MakeKey(Key);
*****      ^ not supported yet
*****              ^ not supported yet
  116  		
  117  END MakeItemKey;		
*****      ^ not supported yet
  118  
  119  
  120  
  121  PROCEDURE OpenInvtryDBF(WithIdx : BOOLEAN);
  122  VAR
  123    ER : CARDINAL;
  124  BEGIN
  125    IndexOpen := WithIdx;
  126  
  127  (* Open the DBF file *)
  128  IF NOT DBInit THEN
  129    DBInit:=TRUE;
  130    InitDBF("Invtry.DBF", InvtryDBF,Buffer,Safty,Exclusive,AutoLock,DefaultFixUp );
*****    ^ not supported yet
*****            ^ not supported yet
*****                          ^ undeclared identifier
*****                                           ^ not supported yet
*****                                                 ^ not supported yet
*****                                                           ^ not supported yet
*****                                                                    ^ not supported yet
  131    InitCompIndex( "Invcode.Idx",InvcodeIdx,InvtryDBF,MakeItemKey,Buffer,
*****    ^ not supported yet
*****                   ^ not supported yet
*****                                 ^ undeclared identifier
*****                                            ^ undeclared identifier
*****                                                      ^ not supported yet
  132       		   Safty,FALSE,Exclusive);
*****       		   ^ not supported yet
*****       		               ^ not supported yet
  133       AddToUpdateList( InvtryDBF, InvcodeIdx );
*****       ^ not supported yet
*****                        ^ undeclared identifier
*****                                   ^ undeclared identifier
  134  
  135   END;
  136   IF NOT OpenDBF( InvtryDBF)
*****          ^ not supported yet
*****                   ^ undeclared identifier
  137       THEN END;
  138   IF WithIdx THEN
  139  
  140      (* open all indexes and append to dbfile *)
  141       IF NOT OpenIndex( InvcodeIdx )
*****              ^ not supported yet
*****                         ^ undeclared identifier
  142         THEN
  143  	 ER := BuildCompIndex(InvcodeIdx, 'C','Invcode',6);
*****  	       ^ not supported yet
*****  	                      ^ undeclared identifier
*****  	                                      ^ not supported yet
*****  	                                                 ^ not supported yet
  144         END;
  145       ActInvtryIdx := InvcodeIdx; (* make current index *)
*****       ^ undeclared identifier
*****                       ^ undeclared identifier
  146  
  147    END; (* with index *)
  148  END OpenInvtryDBF;
*****      ^ not supported yet
  149  
  150  
  151  
  152  PROCEDURE CloseInvtryDBF ();   (* close Data and index files *)
  153  
  154  BEGIN
  155    CloseDBF(InvtryDBF);  (* close dbf file *)
*****    ^ not supported yet
*****             ^ undeclared identifier
  156    IF IndexOpen
  157      THEN
  158        CloseIndex(InvcodeIdx ); (* close index file *)
*****        ^ not supported yet
*****                   ^ undeclared identifier
  159      END;
  160   END CloseInvtryDBF;
*****       ^ not supported yet
  161  
  162  
  163  
  164  PROCEDURE FindInvtryByInvcode( Key : ARRAY OF CHAR) : BOOLEAN;
*****                                                ^ not supported yet
  165  VAR Found : BOOLEAN;
  166      CKey : ARRAY[0..80] OF CHAR;
*****                      ^ not supported yet
*****                             ^ not supported yet
  167      L : LONGINT;
  168  BEGIN
  169     Fill(ADR(CKey),80,0);
*****     ^ not supported yet
*****          ^ not supported yet
*****              ^ not supported yet
*****                        ^ not supported yet
  170     Assign(Key,CKey);
*****     ^ not supported yet
*****            ^ not supported yet
*****                ^ not supported yet
  171     CrunchBlanks(CKey);
*****     ^ not supported yet
*****                  ^ not supported yet
  172     ActInvtryIdx := InvcodeIdx ;   (* make this index the active idx*)
*****     ^ undeclared identifier
*****                     ^ undeclared identifier
  173     FindPositionCh( InvcodeIdx, CKey, Found);
*****     ^ not supported yet
*****                     ^ undeclared identifier
*****                                 ^ not supported yet
*****                                            ^ not supported yet
  174     ReadDBRec( InvtryDBF, CurrentRec( InvcodeIdx)); (* if found - then exact*)
*****     ^ not supported yet
*****                ^ undeclared identifier
*****                           ^ not supported yet
*****                                       ^ undeclared identifier
  175                                                     (* else the closest one*)
  176     RETURN Found;
  177  END FindInvtryByInvcode;
*****      ^ not supported yet
  178  
  179  
  180  
  181  
  182  
  183  
  184  
  185  PROCEDURE FindInvtryByOrderfrm( Key : ARRAY OF CHAR) : BOOLEAN;
*****                                                 ^ not supported yet
  186  VAR Found : BOOLEAN;
  187      CKey : ARRAY[0..80] OF CHAR;
*****                      ^ not supported yet
*****                             ^ not supported yet
  188  BEGIN
  189     ActInvtryIdx := OrderfrmIdx ;   (* make this index the active idx*)
*****     ^ undeclared identifier
*****                     ^ undeclared identifier
  190     MakeKey(Key);
*****     ^ not supported yet
*****             ^ not supported yet
  191     FindPositionCh( OrderfrmIdx, Key, Found);
*****     ^ not supported yet
*****                     ^ undeclared identifier
*****                                  ^ not supported yet
*****                                            ^ not supported yet
  192     CurrentKeyCh(OrderfrmIdx,CKey);
*****     ^ not supported yet
*****                  ^ undeclared identifier
*****                              ^ not supported yet
  193     Found := Equal(Key,CKey);
*****              ^ not supported yet
*****                    ^ not supported yet
*****                        ^ not supported yet
  194      IF Found
  195         THEN ReadDBRec( InvtryDBF, CurrentRec( OrderfrmIdx));
*****              ^ not supported yet
*****                         ^ undeclared identifier
*****                                    ^ not supported yet
*****                                                ^ undeclared identifier
  196     END;
  197     RETURN Found;
  198  END FindInvtryByOrderfrm;
*****      ^ not supported yet
  199  
  200  
  201  
  202  
  203  
  204  
  205  
  206  PROCEDURE NextInvtry () : BOOLEAN;
  207  VAR
  208    L : LONGINT;    (* record number *)
  209  BEGIN
  210    IF  NextRecord( ActInvtryIdx,L)
*****        ^ not supported yet
*****                    ^ undeclared identifier
*****                                  ^ not supported yet
  211      THEN ReadDBRec( InvtryDBF,L  );
*****           ^ not supported yet
*****                      ^ undeclared identifier
*****                                   ^ not supported yet
  212           RETURN TRUE;
  213      ELSE RETURN FALSE;
  214      END;
  215  END NextInvtry;
*****      ^ not supported yet
  216  
  217  PROCEDURE PrevInvtry () : BOOLEAN;
  218  VAR
  219    L : LONGINT;    (* record number *)
  220  BEGIN
  221    IF  PrevRecord( ActInvtryIdx,L)
*****        ^ not supported yet
*****                    ^ undeclared identifier
*****                                  ^ not supported yet
  222      THEN ReadDBRec( InvtryDBF,L  );
*****           ^ not supported yet
*****                      ^ undeclared identifier
*****                                   ^ not supported yet
  223           RETURN TRUE;
  224      ELSE RETURN FALSE;
  225      END;
  226  END PrevInvtry;
*****      ^ not supported yet
  227  
  228  PROCEDURE FirstInvtry ();
  229  VAR
  230    L : LONGINT;    (* record number *)
  231  BEGIN
  232    GoTop(ActInvtryIdx);
*****    ^ not supported yet
*****          ^ undeclared identifier
  233    ReadDBRec( InvtryDBF,CurrentRec(  ActInvtryIdx));
*****    ^ not supported yet
*****               ^ undeclared identifier
*****                         ^ not supported yet
*****                                      ^ undeclared identifier
  234  END FirstInvtry;
*****      ^ not supported yet
  235  
  236  PROCEDURE LastInvtry ();
  237  VAR
  238    L : LONGINT;    (* record number *)
  239  BEGIN
  240    GoBottom(ActInvtryIdx);
*****    ^ not supported yet
*****             ^ undeclared identifier
  241    ReadDBRec( InvtryDBF,CurrentRec(  ActInvtryIdx));
*****    ^ not supported yet
*****               ^ undeclared identifier
*****                         ^ not supported yet
*****                                      ^ undeclared identifier
  242  END LastInvtry;
*****      ^ not supported yet
  243  
  244  PROCEDURE PackInvtry();
  245  VAR
  246    EM : CARDINAL;
  247  BEGIN
  248    CloseInvtryDBF();
*****    ^ not supported yet
*****                   ^ not supported yet
  249    OpenInvtryDBF(FALSE);
*****    ^ not supported yet
*****                       ^ not supported yet
  250    DBPack(InvtryDBF);
*****    ^ not supported yet
*****           ^ undeclared identifier
  251  
  252    CloseDBF(InvtryDBF);
*****    ^ not supported yet
*****             ^ undeclared identifier
  253    EM := DeleteFile("Invcode.Idx");
*****          ^ not supported yet
*****                     ^ not supported yet
  254    EM := DeleteFile("Orderfrm.Idx");
*****          ^ not supported yet
*****                     ^ not supported yet
  255    OpenInvtryDBF(TRUE);  (* open & rebuild the index *)
*****    ^ not supported yet
*****                      ^ not supported yet
  256    CloseInvtryDBF();
*****    ^ not supported yet
*****                   ^ not supported yet
  257  
  258  END PackInvtry;
*****      ^ not supported yet
  259  
  260  
  261  BEGIN
  262    NilDBF(InvtryDBF);
*****    ^ not supported yet
*****           ^ undeclared identifier
  263    IndexOpen := FALSE;
  264    DBInit:=FALSE;
  265  END DBFInvtry.
*****      ^ not supported yet

  266 errors