Topspeed_JPI/TS-V3/MODBASE/DBFPAYME.MOD

(*
 *  ModBase
 *  Release 3.0
 *  (c) Copyright 1986 - 1991 PMI
 *  P.O. Box 8402
 *  Green Bay Wi 53308
 *  All Rights Reserved
 *  by Ed Ross  
 *)

IMPLEMENTATION MODULE DBFPayments;
FROM ModBase3 IMPORT InitDBF,OpenDBF,CloseDBF,ReadDBRec,GetField,
              DeleteRecord,DBFile,DefaultFixUp,NilDBF,Record;
FROM DBCopier IMPORT DBPack;
FROM DBIndxes IMPORT InitIndex,OpenIndex,AddToUpdateList,CloseIndex,
              CurrentRec,FindPositionCh,BuildIndex,GoTop,GoBottom,
              NextRecord,PrevRecord,CurrentKeyCh,FindPositionN,
              CurrentKeyN,InitCompIndex,BuildCompIndex,DBIndex;
FROM StrEdit IMPORT CrunchBlanks;
FROM PMIGlobals IMPORT Today,Config;
FROM Drectory IMPORT DeleteFile;
FROM StrConv IMPORT StrToReal;
FROM NumTypes IMPORT Real8;
FROM DBStuff IMPORT MakeKey;
FROM DateFunctions IMPORT DaysSince1900;
FROM ScanUtils IMPORT Present,CaseSens;
FROM DBFields IMPORT GetDateField,GetLogicalField,GetNumField,Replace,
     ReplaceD,ReplaceN;



CONST
  Buffer = 0;
  Safty = TRUE;
  Exclusive = FALSE;
  AutoLock = TRUE;

VAR IndexOpen,DBInit : BOOLEAN;

PROCEDURE MovePaymentsToDBF(Rec : PaymentsRec );
(* This code will move the data from the record to *)
(* the data base                                   *)
BEGIN
  WITH Rec DO
    Replace( PaymentsDBF,  1,INVOICE);    (* Invoice number *)
    ReplaceD( PaymentsDBF,  2,PMTDATE   );    (* Payment Date *)
    ReplaceN( PaymentsDBF,  3,PMTAMT    );    (* Payment amount *)
    Replace( PaymentsDBF,  4,CHECKNB   );    (* Check number *)
    Replace( PaymentsDBF,  5,CUSTID);    (* Customer who payed *)
END;  (* end of with REC *)
END MovePaymentsToDBF;



PROCEDURE MovePaymentsFromDBF(VAR Rec : PaymentsRec );
(* This code will move the data from the Database to *)
(* the record                                        *)
VAR B : BOOLEAN;
    R : Real8;
BEGIN
  WITH Rec DO
    GetField( PaymentsDBF,  1,INVOICE );   (* Invoice number *)
    GetDateField( PaymentsDBF,  2,PMTDATE   );   (* Payment Date *)
    GetNumField( PaymentsDBF,  3,PMTAMT    );   (* Payment amount *)
    GetField( PaymentsDBF,  4,CHECKNB    );   (* Check number *)
    GetField( PaymentsDBF,  5,CUSTID );   (* Customer who payed *)
END;  (* end of with REC^ *)
END MovePaymentsFromDBF;





PROCEDURE MakeCustidKey(  DBF : DBFile;  Idx : DBIndex;
                          VAR Key : ARRAY OF CHAR);
VAR
  B : BOOLEAN;
BEGIN
  GetField( PaymentsDBF,  5,Key );   (* Customer who payed *)
  MakeKey(Key);
END MakeCustidKey;




PROCEDURE OpenPaymentsDBF(WithIdx : BOOLEAN);
  VAR  ER : CARDINAL;
BEGIN
 IndexOpen := WithIdx;

(* Open the DBF file *)

IF NOT DBInit THEN
  DBInit:=TRUE;
  InitDBF("Payments.DBF", PaymentsDBF,Buffer,Safty,Exclusive,AutoLock,
	DefaultFixUp );
     InitCompIndex( "Pymts.Idx",CustidIdx,PaymentsDBF,MakeCustidKey,Buffer,
                    Safty,FALSE,Exclusive);
     AddToUpdateList( PaymentsDBF, CustidIdx );
 
END;
 IF NOT OpenDBF( PaymentsDBF)
     THEN
       HALT;
     END;

 IF WithIdx THEN

    (* open all indexes and append to dbfile *)
     IF NOT OpenIndex( CustidIdx )
       THEN
	 ER := BuildCompIndex(CustidIdx,'C','Custid',12); (* check key lenght *)
       END;
  END;   (* end with idx *)

END OpenPaymentsDBF;



PROCEDURE ClosePaymentsDBF ();   (* close Data and index files *)

BEGIN
  CloseDBF(PaymentsDBF);  (* close dbf file *)
  IF IndexOpen
    THEN
      CloseIndex(CustidIdx ); (* close index file *)
    END;
 END ClosePaymentsDBF;






PROCEDURE FindPaymentsByCustid( Key : ARRAY OF CHAR) : BOOLEAN;
VAR Found : BOOLEAN;
    CKey : ARRAY[0..80] OF CHAR;
BEGIN
   FindPositionCh( CustidIdx, Key, Found);
   CurrentKeyCh(CustidIdx,CKey);
   Found := Present(Key,CKey,CaseSens);
    IF Found
       THEN ReadDBRec( PaymentsDBF, CurrentRec( CustidIdx));
   END;
   RETURN Found;
END FindPaymentsByCustid;


PROCEDURE DeletePayments();
(* go through the payments file and delete all payments greater than
   the number of weeks to keep payments *)
VAR
  LI : LONGINT;
  DeleteDate, PaymentDate : CARDINAL;
  Payment : PaymentsRec;
BEGIN
  DeleteDate := DaysSince1900(Today) + (Config.KeepPaymentHist * 7);
     (* payment hist is in weeks *)
  FOR LI := 1 TO Record(PaymentsDBF) DO
      ReadDBRec(PaymentsDBF,LI);
      MovePaymentsFromDBF(Payment);
      IF ( DaysSince1900(Payment.PMTDATE) > DeleteDate)
        THEN DeleteRecord(PaymentsDBF);
      END;
  END;
END DeletePayments;

PROCEDURE PackPayments();
VAR
  EM : CARDINAL;
BEGIN
  ClosePaymentsDBF();
  OpenPaymentsDBF(FALSE);
  DeletePayments();
  DBPack(PaymentsDBF);

  CloseDBF(PaymentsDBF);
  EM := DeleteFile("Pymts.Idx");
  OpenPaymentsDBF(TRUE);  (* open & rebuild the index *)
  ClosePaymentsDBF();

END PackPayments;

BEGIN
 NilDBF(PaymentsDBF);
 IndexOpen := FALSE;
 DBInit:=FALSE;
 END DBFPayments.