Topspeed_JPI/TS-V3/MODBASE/DBFPAYME.LST

Listing:

    1  (*
    2   *  ModBase
    3   *  Release 3.0
    4   *  (c) Copyright 1986 - 1991 PMI
    5   *  P.O. Box 8402
    6   *  Green Bay Wi 53308
    7   *  All Rights Reserved
    8   *  by Ed Ross  
    9   *)
   10  
   11  IMPLEMENTATION MODULE DBFPayments;
   12  FROM ModBase3 IMPORT InitDBF,OpenDBF,CloseDBF,ReadDBRec,GetField,
   13                DeleteRecord,DBFile,DefaultFixUp,NilDBF,Record;
   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 StrEdit IMPORT CrunchBlanks;
   20  FROM PMIGlobals IMPORT Today,Config;
   21  FROM Drectory IMPORT DeleteFile;
   22  FROM StrConv IMPORT StrToReal;
   23  FROM NumTypes IMPORT Real8;
   24  FROM DBStuff IMPORT MakeKey;
   25  FROM DateFunctions IMPORT DaysSince1900;
   26  FROM ScanUtils IMPORT Present,CaseSens;
   27  FROM DBFields IMPORT GetDateField,GetLogicalField,GetNumField,Replace,
   28       ReplaceD,ReplaceN;
   29  
   30  
   31  
   32  CONST
   33    Buffer = 0;
   34    Safty = TRUE;
   35    Exclusive = FALSE;
   36    AutoLock = TRUE;
   37  
   38  VAR IndexOpen,DBInit : BOOLEAN;
   39  
   40  PROCEDURE MovePaymentsToDBF(Rec : PaymentsRec );
*****                                    ^ undeclared identifier
   41  (* This code will move the data from the record to *)
   42  (* the data base                                   *)
   43  BEGIN
   44    WITH Rec DO
*****         ^ not supported yet
   45      Replace( PaymentsDBF,  1,INVOICE);    (* Invoice number *)
*****      ^ not supported yet
*****               ^ undeclared identifier
*****                               ^ undeclared identifier
   46      ReplaceD( PaymentsDBF,  2,PMTDATE   );    (* Payment Date *)
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                                ^ undeclared identifier
   47      ReplaceN( PaymentsDBF,  3,PMTAMT    );    (* Payment amount *)
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                                ^ undeclared identifier
   48      Replace( PaymentsDBF,  4,CHECKNB   );    (* Check number *)
*****      ^ not supported yet
*****               ^ undeclared identifier
*****                               ^ undeclared identifier
   49      Replace( PaymentsDBF,  5,CUSTID);    (* Customer who payed *)
*****      ^ not supported yet
*****               ^ undeclared identifier
*****                               ^ undeclared identifier
   50  END;  (* end of with REC *)
*****  ^ not supported yet
   51  END MovePaymentsToDBF;
*****      ^ not supported yet
   52  
   53  
   54  
   55  PROCEDURE MovePaymentsFromDBF(VAR Rec : PaymentsRec );
*****                                          ^ undeclared identifier
   56  (* This code will move the data from the Database to *)
   57  (* the record                                        *)
   58  VAR B : BOOLEAN;
   59      R : Real8;
   60  BEGIN
   61    WITH Rec DO
*****         ^ not supported yet
   62      GetField( PaymentsDBF,  1,INVOICE );   (* Invoice number *)
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                                ^ undeclared identifier
   63      GetDateField( PaymentsDBF,  2,PMTDATE   );   (* Payment Date *)
*****      ^ not supported yet
*****                    ^ undeclared identifier
*****                                    ^ undeclared identifier
   64      GetNumField( PaymentsDBF,  3,PMTAMT    );   (* Payment amount *)
*****      ^ not supported yet
*****                   ^ undeclared identifier
*****                                   ^ undeclared identifier
   65      GetField( PaymentsDBF,  4,CHECKNB    );   (* Check number *)
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                                ^ undeclared identifier
   66      GetField( PaymentsDBF,  5,CUSTID );   (* Customer who payed *)
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                                ^ undeclared identifier
   67  END;  (* end of with REC^ *)
*****  ^ not supported yet
   68  END MovePaymentsFromDBF;
*****      ^ not supported yet
   69  
   70  
   71  
   72  
   73  
   74  PROCEDURE MakeCustidKey(  DBF : DBFile;  Idx : DBIndex;
   75                            VAR Key : ARRAY OF CHAR);
*****                                               ^ not supported yet
   76  VAR
   77    B : BOOLEAN;
   78  BEGIN
   79    GetField( PaymentsDBF,  5,Key );   (* Customer who payed *)
*****    ^ not supported yet
*****              ^ undeclared identifier
*****                              ^ not supported yet
   80    MakeKey(Key);
*****    ^ not supported yet
*****            ^ not supported yet
   81  END MakeCustidKey;
*****      ^ not supported yet
   82  
   83  
   84  
   85  
   86  PROCEDURE OpenPaymentsDBF(WithIdx : BOOLEAN);
   87    VAR  ER : CARDINAL;
   88  BEGIN
   89   IndexOpen := WithIdx;
   90  
   91  (* Open the DBF file *)
   92  
   93  IF NOT DBInit THEN
   94    DBInit:=TRUE;
   95    InitDBF("Payments.DBF", PaymentsDBF,Buffer,Safty,Exclusive,AutoLock,
*****    ^ not supported yet
*****            ^ not supported yet
*****                            ^ undeclared identifier
*****                                               ^ not supported yet
*****                                                     ^ not supported yet
*****                                                               ^ not supported yet
   96  	DefaultFixUp );
*****  	^ not supported yet
   97       InitCompIndex( "Pymts.Idx",CustidIdx,PaymentsDBF,MakeCustidKey,Buffer,
*****       ^ not supported yet
*****                      ^ not supported yet
*****                                  ^ undeclared identifier
*****                                            ^ undeclared identifier
*****                                                        ^ not supported yet
   98                      Safty,FALSE,Exclusive);
*****                      ^ not supported yet
*****                                  ^ not supported yet
   99       AddToUpdateList( PaymentsDBF, CustidIdx );
*****       ^ not supported yet
*****                        ^ undeclared identifier
*****                                     ^ undeclared identifier
  100   
  101  END;
  102   IF NOT OpenDBF( PaymentsDBF)
*****          ^ not supported yet
*****                   ^ undeclared identifier
  103       THEN
  104         HALT;
*****         ^ undeclared identifier
  105       END;
  106  
  107   IF WithIdx THEN
  108  
  109      (* open all indexes and append to dbfile *)
  110       IF NOT OpenIndex( CustidIdx )
*****              ^ not supported yet
*****                         ^ undeclared identifier
  111         THEN
  112  	 ER := BuildCompIndex(CustidIdx,'C','Custid',12); (* check key lenght *)
*****  	       ^ not supported yet
*****  	                      ^ undeclared identifier
*****  	                                    ^ not supported yet
*****  	                                               ^ not supported yet
  113         END;
  114    END;   (* end with idx *)
  115  
  116  END OpenPaymentsDBF;
*****      ^ not supported yet
  117  
  118  
  119  
  120  PROCEDURE ClosePaymentsDBF ();   (* close Data and index files *)
  121  
  122  BEGIN
  123    CloseDBF(PaymentsDBF);  (* close dbf file *)
*****    ^ not supported yet
*****             ^ undeclared identifier
  124    IF IndexOpen
  125      THEN
  126        CloseIndex(CustidIdx ); (* close index file *)
*****        ^ not supported yet
*****                   ^ undeclared identifier
  127      END;
  128   END ClosePaymentsDBF;
*****       ^ not supported yet
  129  
  130  
  131  
  132  
  133  
  134  
  135  PROCEDURE FindPaymentsByCustid( Key : ARRAY OF CHAR) : BOOLEAN;
*****                                                 ^ not supported yet
  136  VAR Found : BOOLEAN;
  137      CKey : ARRAY[0..80] OF CHAR;
*****                      ^ not supported yet
*****                             ^ not supported yet
  138  BEGIN
  139     FindPositionCh( CustidIdx, Key, Found);
*****     ^ not supported yet
*****                     ^ undeclared identifier
*****                                ^ not supported yet
*****                                          ^ not supported yet
  140     CurrentKeyCh(CustidIdx,CKey);
*****     ^ not supported yet
*****                  ^ undeclared identifier
*****                            ^ not supported yet
  141     Found := Present(Key,CKey,CaseSens);
*****              ^ not supported yet
*****                      ^ not supported yet
*****                          ^ not supported yet
*****                               ^ not supported yet
  142      IF Found
  143         THEN ReadDBRec( PaymentsDBF, CurrentRec( CustidIdx));
*****              ^ not supported yet
*****                         ^ undeclared identifier
*****                                      ^ not supported yet
*****                                                  ^ undeclared identifier
  144     END;
  145     RETURN Found;
  146  END FindPaymentsByCustid;
*****      ^ not supported yet
  147  
  148  
  149  PROCEDURE DeletePayments();
  150  (* go through the payments file and delete all payments greater than
  151     the number of weeks to keep payments *)
  152  VAR
  153    LI : LONGINT;
  154    DeleteDate, PaymentDate : CARDINAL;
  155    Payment : PaymentsRec;
*****              ^ undeclared identifier
  156  BEGIN
  157    DeleteDate := DaysSince1900(Today) + (Config.KeepPaymentHist * 7);
*****                  ^ not supported yet
*****                                ^ not supported yet
*****                                          ^ not supported yet
*****                                                 ^ not supported yet
  158       (* payment hist is in weeks *)
  159    FOR LI := 1 TO Record(PaymentsDBF) DO
*****                   ^ not supported yet
*****                          ^ undeclared identifier
  160        ReadDBRec(PaymentsDBF,LI);
*****        ^ not supported yet
*****                  ^ undeclared identifier
*****                                ^ not supported yet
  161        MovePaymentsFromDBF(Payment);
*****        ^ not supported yet
*****                            ^ not supported yet
  162        IF ( DaysSince1900(Payment.PMTDATE) > DeleteDate)
*****             ^ not supported yet
*****                           ^ not supported yet
*****                                   ^ not supported yet
  163          THEN DeleteRecord(PaymentsDBF);
*****               ^ not supported yet
*****                            ^ undeclared identifier
  164        END;
  165    END;
  166  END DeletePayments;
*****      ^ not supported yet
  167  
  168  PROCEDURE PackPayments();
  169  VAR
  170    EM : CARDINAL;
  171  BEGIN
  172    ClosePaymentsDBF();
*****    ^ not supported yet
*****                     ^ not supported yet
  173    OpenPaymentsDBF(FALSE);
*****    ^ not supported yet
*****                         ^ not supported yet
  174    DeletePayments();
*****    ^ not supported yet
*****                   ^ not supported yet
  175    DBPack(PaymentsDBF);
*****    ^ not supported yet
*****           ^ undeclared identifier
  176  
  177    CloseDBF(PaymentsDBF);
*****    ^ not supported yet
*****             ^ undeclared identifier
  178    EM := DeleteFile("Pymts.Idx");
*****          ^ not supported yet
*****                     ^ not supported yet
  179    OpenPaymentsDBF(TRUE);  (* open & rebuild the index *)
*****    ^ not supported yet
*****                        ^ not supported yet
  180    ClosePaymentsDBF();
*****    ^ not supported yet
*****                     ^ not supported yet
  181  
  182  END PackPayments;
*****      ^ not supported yet
  183  
  184  BEGIN
  185   NilDBF(PaymentsDBF);
*****   ^ not supported yet
*****          ^ undeclared identifier
  186   IndexOpen := FALSE;
  187   DBInit:=FALSE;
  188   END DBFPayments.
*****       ^ not supported yet

  134 errors