Topspeed_JPI/TS/MODBASE/PAYMENTS.MOD

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

FROM ModBase3 IMPORT UpdateDBFile,WriteDBRec,DeleteRecord,ReadDBRec,
     AppendBlank;
FROM PMIGlobals IMPORT NormalTitle,OpenReportDevice,CloseReportDevice;
FROM DateFunctions IMPORT Date,DaysSince1900,DateToStr;
FROM ScrnUtl2 IMPORT CloseDisplayFrame;
FROM Customer IMPORT GetCurrCustName;
FROM DBStuff IMPORT FindAll,ReadAllRecs,ConditionType;
FROM ScrnUtl1 IMPORT GetFieldRec,PutFieldRec,FieldNum,FieldListTotal;
FROM FramePainter IMPORT ShowDisplayFrame;
FROM DBUtils IMPORT PrintFrame;
FROM NumTypes IMPORT Real8;
FROM StrEdit IMPORT CrunchBlanks,OverWrite,Append;
FROM M2Strings IMPORT CompareStr,Assign;
FROM PosUtils IMPORT Equal;
FROM StrConv IMPORT RealToStr;
FROM SmartScreen IMPORT ClearScreen;
FROM VStorage IMPORT DosAlloc;
FROM VWindows IMPORT ClearPart, CurrentWindow, SetCursorHeight;
FROM ScrnTypes IMPORT DisplayFrame,InputFieldRecord,InitDisplayFrame,
                      AFrameName,DispCode;
FROM InputManager IMPORT ControlFrame;
FROM FrameManager IMPORT EraseFrame;
FROM Prompts IMPORT Prompt,PromptStr,PromptYN;
FROM SYSTEM IMPORT ADR,SIZE,ADDRESS;
FROM ControlUtils IMPORT ControlSeparately, LoadFrameList,Control,
            AddStrField,AddMenuItem;
FROM DspFiles IMPORT OpenDisplayFile,ReadDisplayFrame;
FROM HandleIO IMPORT FileExists;
FROM LowLevel IMPORT Fill;
FROM GenLists IMPORT GenList, NewList,ListLength,SortList,
                     GetElmt,GetElmtAdr,DisposeList,NilList;
FROM DBFPayments IMPORT PaymentsDBF, OpenPaymentsDBF,CustidIdx,
     ClosePaymentsDBF,PaymentsRec,MovePaymentsToDBF,MovePaymentsFromDBF;



PROCEDURE MakePayment(InvoiceNbr : ARRAY OF CHAR;
                      Pmtdate : Date;
		      PmtAmt  : Real8;
		      CheckNbr : ARRAY OF CHAR;
		      CustID   : ARRAY OF CHAR);
VAR
  Payment :PaymentsRec;
BEGIN
  IF PmtAmt < 0.01   (* don't add zero payments *)
    THEN RETURN;
    END;
  WITH Payment DO
    Assign( InvoiceNbr,INVOICE );
    PMTDATE := Pmtdate;
    PMTAMT := PmtAmt;
    Assign(CheckNbr,CHECKNB );
    Assign( CustID,CUSTID);
  END;
 AppendBlank(PaymentsDBF);
 MovePaymentsToDBF(Payment);
 WriteDBRec(PaymentsDBF);

END MakePayment;		

PROCEDURE ReadARec(VAR AddressOfRec : ADDRESS; VAR SizeOfRec : CARDINAL);
VAR
  P : POINTER TO PaymentsRec;
BEGIN
  SizeOfRec := SIZE(P^);
  DosAlloc(P,SizeOfRec);
  MovePaymentsFromDBF(P^);
  AddressOfRec := P;
END ReadARec;

PROCEDURE SortByDate(P1 : ADDRESS; C1 :CARDINAL;
                      P2 : ADDRESS; C2 : CARDINAL): INTEGER;
		
 (* sort by invoice then payment date within invoice *)		
VAR
 Pymt1,Pymt2 : POINTER TO PaymentsRec;		
 Days1,Days2 : CARDINAL;
BEGIN
 Pymt1 := P1;
 Pymt2 := P2;
 IF Equal(Pymt1^.INVOICE,Pymt2^.INVOICE)
   THEN
     Days1 := DaysSince1900(Pymt1^.PMTDATE);
     Days2 := DaysSince1900(Pymt2^.PMTDATE);
     IF Days1 < Days2
       THEN RETURN -1
       ELSIF
	Days1 > Days2
	  THEN RETURN 1
	ELSE RETURN 0
      END;
    ELSE
      RETURN CompareStr(Pymt1^.INVOICE,Pymt2^.INVOICE);
  END;

END SortByDate;
PROCEDURE ShowPaymentHist(CustID : ARRAY OF CHAR);		
VAR Payment : POINTER TO PaymentsRec;
    Lst : GenList;
    Cnt : CARDINAL;
    Handle : CARDINAL;
    Size, Code : CARDINAL;
    DF : DisplayFrame;
    B : BOOLEAN;
    Str : ARRAY[0..10] OF CHAR;
    Title1 : ARRAY[0..80] OF CHAR;
    FieldRec : InputFieldRecord;
    Line : ARRAY[0..65] OF CHAR;
CONST
  Title = '    Invoice   Pymt Date  Amount      Check Number  ';

BEGIN
 OpenPaymentsDBF(TRUE);
 CrunchBlanks(CustID);
 NilList(Lst);
 FindAll(CustidIdx,CustID,EQ,Lst);
 ReadAllRecs(PaymentsDBF,ReadARec,Lst);
 ClosePaymentsDBF();
 IF ListLength(Lst) = 0   (* some tanks are outstanding *)
  THEN
     DisposeList(Lst);
     Prompt('No payment history');
     RETURN;
  END;

 SortList(Lst,SortByDate);

(*        1         2         3         4
01234567890123456789012345678901234567890123456780
  Invoice  Date     Amount      Check Number    Date
*)

  InitDisplayFrame(DF,CurrentWindow);
  AddStrField(DF,2,2,Title,55);
  GetFieldRec(DF,1,FieldRec);
  FieldRec.typ := DispCode;   (* headline = display code *)
  PutFieldRec(FieldRec,DF,1);
  DF^.headline := 2;


 FOR Cnt := 1 TO ListLength(Lst) DO
   GetElmtAdr(Lst,Cnt,Payment,Size,Code);
   Fill(ADR(Line),SIZE(Line),' ');
   OverWrite(Payment^.INVOICE,Line,1);
   DateToStr(Payment^.PMTDATE,Str,B);
   OverWrite(Str,Line,12);
   RealToStr(Payment^.PMTAMT,2,8,Str);
   OverWrite(Str,Line,22);
   OverWrite(Payment^.CHECKNB,Line,33);
   AddMenuItem(DF,2,Cnt+2,Line,70,0,' ');
 END;
 ShowDisplayFrame(DF,1,13,80,24);
 Control(DF);
 IF PromptYN(' Print the report ',DF)
   THEN
     GetCurrCustName(Title1);
     Append(Title1,' - Payments ');
     NormalTitle(Title1);
     Handle := OpenReportDevice();
     PrintFrame(DF,Handle);
     CloseReportDevice(Handle);
   END;
 CloseDisplayFrame(DF);


END ShowPaymentHist;


PROCEDURE ManagePaymentFile();
END ManagePaymentFile;


END Payments.