Listing: 1 IMPLEMENTATION MODULE Payments; 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 UpdateDBFile,WriteDBRec,DeleteRecord,ReadDBRec, 13 AppendBlank; 14 FROM PMIGlobals IMPORT NormalTitle,OpenReportDevice,CloseReportDevice; 15 FROM DateFunctions IMPORT Date,DaysSince1900,DateToStr; 16 FROM ScrnUtl2 IMPORT CloseDisplayFrame; 17 FROM Customer IMPORT GetCurrCustName; 18 FROM DBStuff IMPORT FindAll,ReadAllRecs,ConditionType; 19 FROM ScrnUtl1 IMPORT GetFieldRec,PutFieldRec,FieldNum,FieldListTotal; 20 FROM FramePainter IMPORT ShowDisplayFrame; 21 FROM DBUtils IMPORT PrintFrame; 22 FROM NumTypes IMPORT Real8; 23 FROM StrEdit IMPORT CrunchBlanks,OverWrite,Append; 24 FROM M2Strings IMPORT CompareStr,Assign; 25 FROM PosUtils IMPORT Equal; 26 FROM StrConv IMPORT RealToStr; 27 FROM SmartScreen IMPORT ClearScreen; 28 FROM VStorage IMPORT DosAlloc; 29 FROM VWindows IMPORT ClearPart, CurrentWindow, SetCursorHeight; 30 FROM ScrnTypes IMPORT DisplayFrame,InputFieldRecord,InitDisplayFrame, 31 AFrameName,DispCode; 32 FROM InputManager IMPORT ControlFrame; 33 FROM FrameManager IMPORT EraseFrame; 34 FROM Prompts IMPORT Prompt,PromptStr,PromptYN; 35 FROM SYSTEM IMPORT ADR,SIZE,ADDRESS; 36 FROM ControlUtils IMPORT ControlSeparately, LoadFrameList,Control, 37 AddStrField,AddMenuItem; 38 FROM DspFiles IMPORT OpenDisplayFile,ReadDisplayFrame; 39 FROM HandleIO IMPORT FileExists; 40 FROM LowLevel IMPORT Fill; 41 FROM GenLists IMPORT GenList, NewList,ListLength,SortList, 42 GetElmt,GetElmtAdr,DisposeList,NilList; 43 FROM DBFPayments IMPORT PaymentsDBF, OpenPaymentsDBF,CustidIdx, 44 ClosePaymentsDBF,PaymentsRec,MovePaymentsToDBF,MovePaymentsFromDBF; 45 46 47 48 PROCEDURE MakePayment(InvoiceNbr : ARRAY OF CHAR; ***** ^ not supported yet 49 Pmtdate : Date; 50 PmtAmt : Real8; 51 CheckNbr : ARRAY OF CHAR; ***** ^ not supported yet 52 CustID : ARRAY OF CHAR); ***** ^ not supported yet 53 VAR 54 Payment :PaymentsRec; 55 BEGIN 56 IF PmtAmt < 0.01 (* don't add zero payments *) ***** ^ not supported yet 57 THEN RETURN; 58 END; 59 WITH Payment DO ***** ^ not supported yet 60 Assign( InvoiceNbr,INVOICE ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 61 PMTDATE := Pmtdate; ***** ^ undeclared identifier ***** ^ not supported yet 62 PMTAMT := PmtAmt; ***** ^ undeclared identifier ***** ^ not supported yet 63 Assign(CheckNbr,CHECKNB ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 64 Assign( CustID,CUSTID); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 65 END; ***** ^ not supported yet 66 AppendBlank(PaymentsDBF); ***** ^ not supported yet ***** ^ not supported yet 67 MovePaymentsToDBF(Payment); ***** ^ not supported yet ***** ^ undeclared identifier 68 WriteDBRec(PaymentsDBF); ***** ^ not supported yet ***** ^ not supported yet 69 70 END MakePayment; ***** ^ not supported yet 71 72 PROCEDURE ReadARec(VAR AddressOfRec : ADDRESS; VAR SizeOfRec : CARDINAL); 73 VAR 74 P : POINTER TO PaymentsRec; ***** ^ not supported yet 75 BEGIN 76 SizeOfRec := SIZE(P^); ***** ^ not supported yet ***** ^ not supported yet 77 DosAlloc(P,SizeOfRec); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 78 MovePaymentsFromDBF(P^); ***** ^ not supported yet ***** ^ not supported yet 79 AddressOfRec := P; ***** ^ not supported yet ***** ^ not supported yet 80 END ReadARec; ***** ^ not supported yet 81 82 PROCEDURE SortByDate(P1 : ADDRESS; C1 :CARDINAL; 83 P2 : ADDRESS; C2 : CARDINAL): INTEGER; 84 85 (* sort by invoice then payment date within invoice *) 86 VAR 87 Pymt1,Pymt2 : POINTER TO PaymentsRec; ***** ^ not supported yet 88 Days1,Days2 : CARDINAL; 89 BEGIN 90 Pymt1 := P1; ***** ^ not supported yet ***** ^ not supported yet 91 Pymt2 := P2; ***** ^ not supported yet ***** ^ not supported yet 92 IF Equal(Pymt1^.INVOICE,Pymt2^.INVOICE) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 93 THEN 94 Days1 := DaysSince1900(Pymt1^.PMTDATE); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 95 Days2 := DaysSince1900(Pymt2^.PMTDATE); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 96 IF Days1 < Days2 97 THEN RETURN -1 98 ELSIF 99 Days1 > Days2 100 THEN RETURN 1 101 ELSE RETURN 0 102 END; 103 ELSE 104 RETURN CompareStr(Pymt1^.INVOICE,Pymt2^.INVOICE); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 105 END; 106 107 END SortByDate; ***** ^ not supported yet 108 PROCEDURE ShowPaymentHist(CustID : ARRAY OF CHAR); ***** ^ not supported yet 109 VAR Payment : POINTER TO PaymentsRec; ***** ^ not supported yet 110 Lst : GenList; 111 Cnt : CARDINAL; 112 Handle : CARDINAL; 113 Size, Code : CARDINAL; 114 DF : DisplayFrame; 115 B : BOOLEAN; 116 Str : ARRAY[0..10] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 117 Title1 : ARRAY[0..80] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 118 FieldRec : InputFieldRecord; 119 Line : ARRAY[0..65] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 120 CONST 121 Title = ' Invoice Pymt Date Amount Check Number '; ***** ^ not supported yet 122 123 BEGIN 124 OpenPaymentsDBF(TRUE); ***** ^ not supported yet ***** ^ not supported yet 125 CrunchBlanks(CustID); ***** ^ not supported yet ***** ^ not supported yet 126 NilList(Lst); ***** ^ not supported yet ***** ^ not supported yet 127 FindAll(CustidIdx,CustID,EQ,Lst); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 128 ReadAllRecs(PaymentsDBF,ReadARec,Lst); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 129 ClosePaymentsDBF(); ***** ^ not supported yet ***** ^ not supported yet 130 IF ListLength(Lst) = 0 (* some tanks are outstanding *) ***** ^ not supported yet ***** ^ not supported yet 131 THEN 132 DisposeList(Lst); ***** ^ not supported yet ***** ^ not supported yet 133 Prompt('No payment history'); ***** ^ not supported yet ***** ^ not supported yet 134 RETURN; 135 END; 136 137 SortList(Lst,SortByDate); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 138 139 (* 1 2 3 4 140 01234567890123456789012345678901234567890123456780 141 Invoice Date Amount Check Number Date 142 *) 143 144 InitDisplayFrame(DF,CurrentWindow); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 145 AddStrField(DF,2,2,Title,55); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 146 GetFieldRec(DF,1,FieldRec); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 147 FieldRec.typ := DispCode; (* headline = display code *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 148 PutFieldRec(FieldRec,DF,1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 149 DF^.headline := 2; ***** ^ not supported yet ***** ^ not supported yet 150 151 152 FOR Cnt := 1 TO ListLength(Lst) DO ***** ^ not supported yet ***** ^ not supported yet 153 GetElmtAdr(Lst,Cnt,Payment,Size,Code); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 154 Fill(ADR(Line),SIZE(Line),' '); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 155 OverWrite(Payment^.INVOICE,Line,1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 156 DateToStr(Payment^.PMTDATE,Str,B); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 157 OverWrite(Str,Line,12); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 158 RealToStr(Payment^.PMTAMT,2,8,Str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 159 OverWrite(Str,Line,22); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 160 OverWrite(Payment^.CHECKNB,Line,33); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 161 AddMenuItem(DF,2,Cnt+2,Line,70,0,' '); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 162 END; 163 ShowDisplayFrame(DF,1,13,80,24); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 164 Control(DF); ***** ^ not supported yet ***** ^ not supported yet 165 IF PromptYN(' Print the report ',DF) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 166 THEN 167 GetCurrCustName(Title1); ***** ^ not supported yet ***** ^ not supported yet 168 Append(Title1,' - Payments '); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 169 NormalTitle(Title1); ***** ^ not supported yet ***** ^ not supported yet 170 Handle := OpenReportDevice(); ***** ^ not supported yet ***** ^ not supported yet 171 PrintFrame(DF,Handle); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 172 CloseReportDevice(Handle); ***** ^ not supported yet ***** ^ not supported yet 173 END; 174 CloseDisplayFrame(DF); ***** ^ not supported yet ***** ^ not supported yet 175 176 177 END ShowPaymentHist; ***** ^ not supported yet 178 179 180 PROCEDURE ManagePaymentFile(); 181 END ManagePaymentFile; ***** ^ not supported yet 182 183 184 END Payments. ***** ^ not supported yet 183 errors