Listing: 1 IMPLEMENTATION MODULE CustReports; 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 PosUtils IMPORT Equal; 13 FROM PMIGlobals IMPORT Config,NormalTitle,OpenReportDevice,CloseReportDevice; 14 FROM Customer IMPORT GetCustName,SetCustomerRec,GetCustAddr, 15 AddressRec,AddressTypes; 16 FROM DBFCustomer IMPORT OpenCustomerDBF,CloseCustomerDBF, 17 CustomerRec,CustomerDBF,MoveCustomerFromDBF; 18 FROM DBUtils IMPORT GetDateRange,PrintFrame,PrintTitle; 19 FROM HandleIO IMPORT OpenFile,CloseHandle; 20 FROM StringIO IMPORT WriteStr,WriteEol; 21 FROM GenLists IMPORT GenList,ListInsert,DisposeList, 22 GetElmt,GetElmtAdr,NewList,ListLength,SortList; 23 FROM ListUtils IMPORT PrintList,TextFileToList; 24 FROM Invoice IMPORT MakeInvoicePrintLine,GetOutstanding,InvoiceDaysLate; 25 FROM DateFunctions IMPORT Comparison,CompareDates,Date,DateToStr, 26 CardToDate,DaysSince1900; 27 FROM StrConv IMPORT RealToStr,CardinalToStr; 28 FROM StrEdit IMPORT CrunchBlanks,DeleteRightJustified,Append, 29 CAPstr,OverWrite,RightJustify,Center,SetLength; 30 FROM ModBase3 IMPORT ReadDBRec,CloseDBF,NumberRecords; 31 FROM M2Strings IMPORT Concat,Length,CompareStr; 32 FROM LowLevel IMPORT Fill; 33 FROM NumTypes IMPORT Real8; 34 FROM Numbers IMPORT Max; 35 IMPORT VWindows; 36 FROM ScrnUtl2 IMPORT CloseDisplayFrame; 37 FROM ScrnUtl1 IMPORT GetFieldRec,PutFieldRec,FieldNum,FieldListTotal; 38 FROM ScrnTypes IMPORT DisplayFrame,InitDisplayFrame,AFrameName, 39 DispCode,ContinueInput,CancelInput,SubmitInput,InputFieldRecord; 40 FROM FramePainter IMPORT ShowDisplayFrame,RedrawField; 41 FROM ControlUtils IMPORT Control,AddStrField,AddMenuItem; 42 FROM Prompts IMPORT Prompt,PromptStr,PromptYN; 43 FROM ScrnTypes IMPORT AFrameName, InitDisplayFrame,DisplayFile; ***** ^ duplicate identifier ***** ^ duplicate identifier ***** ^ duplicate identifier 44 FROM SYSTEM IMPORT ADDRESS,ADR,SIZE; 45 FROM VStorage IMPORT DosAlloc; 46 47 48 VAR 49 MinOut : Real8; 50 51 PROCEDURE ReadCustFile(VAR TheList : GenList); 52 VAR 53 LI : LONGINT; 54 Cust : CustomerRec; 55 BEGIN 56 OpenCustomerDBF(FALSE); ***** ^ not supported yet ***** ^ not supported yet 57 NewList(TheList); ***** ^ not supported yet ***** ^ not supported yet 58 FOR LI := 1 TO NumberRecords(CustomerDBF) DO ***** ^ not supported yet ***** ^ not supported yet 59 ReadDBRec(CustomerDBF,LI); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 60 MoveCustomerFromDBF(Cust); ***** ^ not supported yet ***** ^ not supported yet 61 IF Cust.YTDPURCH >= MinOut ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 62 THEN ListInsert(Cust,1,TheList,1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 63 END; 64 END; 65 66 END ReadCustFile; ***** ^ not supported yet 67 68 PROCEDURE SortByZipCode(C1 : ADDRESS; S1 : CARDINAL; 69 C2 : ADDRESS; S2 : CARDINAL): INTEGER; 70 VAR 71 P1,P2 :POINTER TO CustomerRec; ***** ^ not supported yet 72 BEGIN 73 P1 := C1; ***** ^ not supported yet ***** ^ not supported yet 74 P2 := C2; ***** ^ not supported yet ***** ^ not supported yet 75 RETURN CompareStr(P1^.BILLTOZP, P2^.BILLTOZP); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 76 END SortByZipCode; ***** ^ not supported yet 77 78 PROCEDURE SortByValue(C1 : ADDRESS; S1 : CARDINAL; 79 C2 : ADDRESS; S2 : CARDINAL): INTEGER; 80 VAR 81 P1 : POINTER TO CustomerRec; ***** ^ not supported yet 82 P2 : POINTER TO CustomerRec; ***** ^ not supported yet 83 84 BEGIN 85 P1 := C1; ***** ^ not supported yet ***** ^ not supported yet 86 P2 := C2; ***** ^ not supported yet ***** ^ not supported yet 87 IF P1^.YTDPURCH < P2^.YTDPURCH ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 88 THEN RETURN -1; 89 ELSIF P1^.YTDPURCH > P2^.YTDPURCH ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 90 THEN RETURN 1; 91 ELSE RETURN 0; 92 END; 93 END SortByValue; ***** ^ not supported yet 94 95 96 PROCEDURE CustMailLabels(); 97 CONST 98 FormFeed = 12C; 99 VAR 100 101 CustList : GenList; 102 J,K : CARDINAL; 103 Cust : CustomerRec; 104 Code : CARDINAL; 105 CustAddr : AddressRec; 106 Handle : CARDINAL; 107 BEGIN 108 MinOut := 0.0; (* get everyone *) ***** ^ not supported yet 109 ReadCustFile(CustList); ***** ^ not supported yet ***** ^ not supported yet 110 SortList(CustList,SortByZipCode); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 111 Handle := OpenReportDevice(); ***** ^ not supported yet ***** ^ not supported yet 112 FOR J := 1 TO ListLength(CustList) DO ***** ^ not supported yet ***** ^ not supported yet 113 GetElmt(CustList,J,Cust,Code); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 114 SetCustomerRec(Cust); ***** ^ not supported yet ***** ^ not supported yet 115 GetCustAddr(CustAddr,Billing); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 116 FOR K := 0 TO 3 DO 117 WriteEol(Handle,CustAddr.Line[K]); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 118 END; (* end for k *) 119 WriteEol(Handle,''); ***** ^ not supported yet ***** ^ not supported yet 120 WriteEol(Handle,''); ***** ^ not supported yet ***** ^ not supported yet 121 END; 122 CloseReportDevice(Handle); ***** ^ not supported yet ***** ^ not supported yet 123 DisposeList(CustList); ***** ^ not supported yet ***** ^ not supported yet 124 END CustMailLabels; ***** ^ not supported yet 125 126 PROCEDURE CustValue(); 127 VAR 128 129 CustList : GenList; 130 J : CARDINAL; 131 Cust : CustomerRec; 132 Code : CARDINAL; 133 CustAddr : AddressRec; 134 Handle : CARDINAL; 135 Str : ARRAY[0..10]OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 136 FieldRec : InputFieldRecord; 137 DF : DisplayFrame; 138 Line : ARRAY[0..80] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 139 BEGIN 140 MinOut := 1.0; (* get everyone that has purchased anything*) ***** ^ not supported yet 141 ReadCustFile(CustList); ***** ^ not supported yet ***** ^ not supported yet 142 SortList(CustList,SortByValue); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 143 InitDisplayFrame(DF,VWindows.CurrentWindow); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 144 AddStrField(DF,2,2, ***** ^ not supported yet ***** ^ not supported yet 145 ' Customer Name Sales Rep YTD Purchase',67); ***** ^ 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 FOR J := 1 TO ListLength(CustList) DO ***** ^ not supported yet ***** ^ not supported yet 152 GetElmt(CustList,J,Cust,Code); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 153 Fill(ADR(Line),SIZE(Line),' '); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 154 Line[77] := 0C; ***** ^ not supported yet ***** ^ not supported yet 155 OverWrite(Cust.NAME,Line,1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 156 OverWrite(Cust.SALESREP,Line,45); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 157 RealToStr(Cust.YTDPURCH,2,8,Str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 158 OverWrite(Str,Line,60); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 159 AddMenuItem(DF,2,J+2,Line,78,0,' '); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 160 END; 161 DisposeList(CustList); ***** ^ not supported yet ***** ^ not supported yet 162 ShowDisplayFrame(DF,1,1,80,24); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 163 Control(DF); ***** ^ not supported yet ***** ^ not supported yet 164 IF PromptYN(' Print Report ',DF) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 165 THEN 166 Line := 'Customer Sorted by YTD Purchases'; ***** ^ not supported yet ***** ^ not supported yet 167 NormalTitle(Line); ***** ^ not supported yet ***** ^ not supported yet 168 Handle := OpenReportDevice(); ***** ^ not supported yet ***** ^ not supported yet 169 PrintFrame(DF,Handle); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 170 CloseReportDevice(Handle); ***** ^ not supported yet ***** ^ not supported yet 171 END; 172 CloseDisplayFrame(DF); ***** ^ not supported yet ***** ^ not supported yet 173 DisposeList(CustList); ***** ^ not supported yet ***** ^ not supported yet 174 END CustValue; ***** ^ not supported yet 175 176 PROCEDURE CustLateLetters(); 177 178 VAR 179 L10Pre, 180 L10Suf, 181 L30Pre, 182 L30Suf, 183 L60Pre, 184 L60Suf : GenList; 185 LI : LONGINT; 186 DaysLate : CARDINAL; 187 PrtStr : ARRAY[0..80] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 188 InvList : GenList; 189 J : CARDINAL; 190 InvAddr : ADDRESS; 191 Code,Size : CARDINAL; 192 PtrHand : CARDINAL; 193 EM : CARDINAL; 194 Cust : CustomerRec; 195 B : BOOLEAN; 196 PROCEDURE PrintLetter(Prefix,Suffix ,Invoice : GenList); 197 CONST 198 (* FormLength : ARRAY OF CHAR = [027c,'C',66c]; *) 199 FormFeed = 012C; 200 VAR 201 202 J : CARDINAL; 203 Addr :AddressRec; 204 Line : ARRAY [0..80] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 205 FormLength : ARRAY[0..3] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 206 BEGIN 207 Concat(027C,'C',FormLength); ***** ^ not supported yet ***** ^ not supported yet 208 Append(FormLength,66C); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 209 WriteStr( PtrHand,FormLength); ***** ^ not supported yet ***** ^ not supported yet 210 Line := ''; ***** ^ not supported yet ***** ^ incompatible assignment 211 NormalTitle(Line); ***** ^ not supported yet ***** ^ not supported yet 212 FOR J := 0 TO 6 DO 213 WriteEol(PtrHand,PrintTitle[J]); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 214 END; 215 SetCustomerRec(Cust); ***** ^ not supported yet ***** ^ not supported yet 216 GetCustAddr(Addr,Billing); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 217 FOR J := 0 TO 3 DO 218 WriteEol(PtrHand,''); ***** ^ not supported yet ***** ^ not supported yet 219 END; 220 FOR J := 0 TO 3 DO 221 WriteEol(PtrHand,Addr.Line[J]); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 222 WriteStr(PtrHand,' '); ***** ^ not supported yet ***** ^ not supported yet 223 END; 224 225 PrintList(PtrHand,Prefix,4,''); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 226 FOR J := 1 TO ListLength(InvList) DO ***** ^ not supported yet ***** ^ not supported yet 227 GetElmtAdr(InvList,J,InvAddr,Code,Size); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 228 MakeInvoicePrintLine(InvAddr,Line); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 229 WriteEol(PtrHand,Line); ***** ^ not supported yet ***** ^ not supported yet 230 END; 231 PrintList(PtrHand,Suffix,4,''); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 232 WriteEol(PtrHand,FormFeed); ***** ^ not supported yet ***** ^ not supported yet 233 END PrintLetter; ***** ^ not supported yet 234 235 BEGIN 236 EM := OpenFile(PtrHand,Config.LabelPrt); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 237 NewList(L10Pre); ***** ^ not supported yet ***** ^ not supported yet 238 NewList(L10Suf); ***** ^ not supported yet ***** ^ not supported yet 239 NewList(L30Pre); ***** ^ not supported yet ***** ^ not supported yet 240 NewList(L30Suf); ***** ^ not supported yet ***** ^ not supported yet 241 NewList(L60Pre); ***** ^ not supported yet ***** ^ not supported yet 242 NewList(L60Suf); ***** ^ not supported yet ***** ^ not supported yet 243 PrtStr := 'l10pre.txt'; ***** ^ not supported yet ***** ^ not supported yet 244 J := TextFileToList(PrtStr,L10Pre); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 245 PrtStr := 'l30pre.txt'; ***** ^ not supported yet ***** ^ not supported yet 246 J := TextFileToList(PrtStr,L30Pre); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 247 PrtStr := 'l60pre.txt'; ***** ^ not supported yet ***** ^ not supported yet 248 J := TextFileToList(PrtStr,L60Pre); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 249 PrtStr := 'l10Suf.txt'; ***** ^ not supported yet ***** ^ not supported yet 250 J := TextFileToList(PrtStr,L10Suf); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 251 PrtStr := 'l30Suf.txt'; ***** ^ not supported yet ***** ^ not supported yet 252 J := TextFileToList(PrtStr,L10Suf); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 253 PrtStr := 'l60Suf.txt'; ***** ^ not supported yet ***** ^ not supported yet 254 J := TextFileToList(PrtStr,L10Suf); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 255 OpenCustomerDBF(FALSE); ***** ^ not supported yet ***** ^ not supported yet 256 FOR LI := 1 TO NumberRecords(CustomerDBF) DO ***** ^ not supported yet ***** ^ not supported yet 257 ReadDBRec(CustomerDBF,LI); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 258 MoveCustomerFromDBF(Cust); ***** ^ not supported yet ***** ^ not supported yet 259 GetOutstanding(Cust.CIN,InvList); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 260 DaysLate := 0; 261 FOR J := 1 TO ListLength(InvList) DO ***** ^ not supported yet ***** ^ not supported yet 262 GetElmtAdr(InvList,J,InvAddr,Code,Size); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 263 DaysLate := Max(DaysLate,InvoiceDaysLate(InvAddr)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 264 END; 265 IF DaysLate >= 60 266 THEN PrintLetter(L60Pre,L60Suf,InvList); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 267 ELSIF DaysLate >= 30 268 THEN PrintLetter(L30Pre,L30Suf,InvList); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 269 ELSIF DaysLate >= 10 270 THEN PrintLetter(L10Pre,L10Suf,InvList); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 271 END; 272 DisposeList(InvList); ***** ^ not supported yet ***** ^ not supported yet 273 END; 274 DisposeList(L10Pre); ***** ^ not supported yet ***** ^ not supported yet 275 DisposeList(L30Pre); ***** ^ not supported yet ***** ^ not supported yet 276 DisposeList(L60Pre); ***** ^ not supported yet ***** ^ not supported yet 277 DisposeList(L10Suf); ***** ^ not supported yet ***** ^ not supported yet 278 DisposeList(L30Suf); ***** ^ not supported yet ***** ^ not supported yet 279 DisposeList(L60Suf); ***** ^ not supported yet ***** ^ not supported yet 280 281 EM := CloseHandle(PtrHand); ***** ^ not supported yet ***** ^ not supported yet 282 END CustLateLetters; ***** ^ not supported yet 283 284 285 286 END CustReports. ***** ^ not supported yet 322 errors