Listing: 1 IMPLEMENTATION MODULE IvyReports; 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 13 FROM DBFInvtry IMPORT InvtryRec,OpenInvtryDBF,InvtryDBF, 14 CloseInvtryDBF,MoveInvtryFromDBF,InvcodeIdx,FindInvtryByInvcode, 15 MoveInvtryToDBF; 16 FROM PosUtils IMPORT Equal,Pos; 17 FROM PriceTable IMPORT GetPriceTable; 18 FROM PMIGlobals IMPORT Today,TodayDays,Config,NormalTitle, 19 OpenReportDevice,CloseReportDevice; 20 FROM DBUtils IMPORT GetDateRange,PrintFrame,SelectFromScreen, 21 GetSelected; 22 FROM DBStuff IMPORT MakeKey,FindAll,ReadAllRecs,ConditionType,MakeSeqNbr; 23 FROM GenLists IMPORT GenList,ListInsert,DisposeList, 24 GetElmt,GetElmtAdr,NewList,ListLength,SortList,ListDelete; 25 FROM StrConv IMPORT RealToStr,CardinalToStr; 26 FROM StrEdit IMPORT CrunchBlanks,DeleteRightJustified,Append, 27 CAPstr,OverWrite,RightJustify,Center,SetLength,CutLeadingChars; 28 FROM ModBase3 IMPORT ReadDBRec,CloseDBF,WriteDBRec; 29 FROM M2Strings IMPORT Length,CompareStr; 30 FROM LowLevel IMPORT Fill; 31 FROM NumTypes IMPORT Real8; 32 IMPORT VWindows; 33 FROM ScrnUtl2 IMPORT CloseDisplayFrame; 34 FROM ScrnUtl1 IMPORT GetFieldRec,PutFieldRec,FieldNum,FieldListTotal; 35 FROM ScrnTypes IMPORT DisplayFrame,InitDisplayFrame,AFrameName, 36 DispCode,ContinueInput,CancelInput,SubmitInput,InputFieldRecord; 37 FROM FramePainter IMPORT ShowDisplayFrame,RedrawField; 38 FROM ControlUtils IMPORT Control,AddStrField,AddMenuItem; 39 FROM Prompts IMPORT Prompt,PromptStr,PromptYN; 40 FROM ScrnTypes IMPORT AFrameName, InitDisplayFrame,DisplayFile; ***** ^ duplicate identifier ***** ^ duplicate identifier ***** ^ duplicate identifier 41 FROM SYSTEM IMPORT ADDRESS,ADR,SIZE; 42 FROM VStorage IMPORT DosAlloc; 43 44 45 PROCEDURE SortInv(A1 : ADDRESS; Size1 :CARDINAL; 46 A2 : ADDRESS; Size2 : CARDINAL): INTEGER; 47 48 VAR 49 I1, I2 : POINTER TO InvtryRec; ***** ^ not supported yet 50 BEGIN 51 I1 := A1; ***** ^ not supported yet ***** ^ not supported yet 52 I2 := A2; ***** ^ not supported yet ***** ^ not supported yet 53 RETURN CompareStr(I1^.INVCODE,I2^.INVCODE); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 54 END SortInv; ***** ^ not supported yet 55 56 57 (* # call(reg_param=>(ax,bx,cx,dx,st0,st6,st5,st4,st3) ) *) 58 PROCEDURE ReadInvRec(VAR A: ADDRESS; VAR Size : CARDINAL); 59 VAR 60 InvRec : POINTER TO InvtryRec; ***** ^ not supported yet 61 BEGIN 62 Size := SIZE(InvtryRec); ***** ^ not supported yet ***** ^ not supported yet 63 DosAlloc(InvRec,Size); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 64 MoveInvtryFromDBF(InvRec^); ***** ^ not supported yet ***** ^ not supported yet 65 A := InvRec; ***** ^ not supported yet ***** ^ not supported yet 66 67 END ReadInvRec; ***** ^ not supported yet 68 69 PROCEDURE TotalInventory(); 70 VAR 71 Str : ARRAY[0..20] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 72 InvList : GenList; 73 J : CARDINAL; 74 Line : ARRAY[0..80] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 75 DF : DisplayFrame; 76 FieldRec : InputFieldRecord; 77 Inventory : InvtryRec; 78 Code : CARDINAL; 79 Value : Real8; 80 Handle : CARDINAL; 81 Cost : Real8; 82 P1,P2,P3,P4 : Real8; 83 Q1,Q2,Q3,Q4 : CARDINAL; 84 BEGIN 85 Str := ''; ***** ^ not supported yet ***** ^ incompatible assignment 86 PromptStr('Enter Inventory Code (or partial Code)',Str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 87 MakeKey(Str); ***** ^ not supported yet ***** ^ not supported yet 88 OpenInvtryDBF(TRUE); ***** ^ not supported yet ***** ^ not supported yet 89 FindAll(InvcodeIdx,Str,BeginsWith,InvList); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 90 91 ReadAllRecs(InvtryDBF,ReadInvRec,InvList); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 92 CloseInvtryDBF(); ***** ^ not supported yet ***** ^ not supported yet 93 94 95 InitDisplayFrame(DF,VWindows.CurrentWindow); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 96 AddStrField(DF,2,2, ***** ^ not supported yet ***** ^ not supported yet 97 ' Code Description On Hand Purch Price Cost Value ',78); ***** ^ not supported yet ***** ^ not supported yet 98 GetFieldRec(DF,1,FieldRec); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 99 FieldRec.typ := DispCode; (* headline = display code *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 100 PutFieldRec(FieldRec,DF,1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 101 DF^.headline := 2; ***** ^ not supported yet ***** ^ not supported yet 102 Cost := 0.0; ***** ^ not supported yet 103 Value := 0.0; ***** ^ not supported yet 104 SortList(InvList,SortInv); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 105 FOR J := 1 TO ListLength(InvList) DO ***** ^ not supported yet ***** ^ not supported yet 106 GetElmt(InvList,J,Inventory,Code); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 107 Fill(ADR(Line),SIZE(Line),' '); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 108 Line[77] := 0C; ***** ^ not supported yet ***** ^ not supported yet 109 OverWrite(Inventory.INVCODE,Line,1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 110 OverWrite(Inventory.DESC,Line,8); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 111 RealToStr(Inventory.ONHAND,2,8,Str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 112 OverWrite(Str,Line,42); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 113 RealToStr(Inventory.PURPRICE,2,8,Str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 114 OverWrite(Str,Line,51); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 115 RealToStr(Inventory.PURPRICE * Inventory.ONHAND,2,8,Str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 116 Cost := Cost + (Inventory.PURPRICE * Inventory.ONHAND); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 117 OverWrite(Str,Line,61); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 118 119 IF Inventory.PRICETBL > 0 ***** ^ not supported yet ***** ^ not supported yet 120 THEN 121 GetPriceTable(Inventory.PRICETBL,Q1,Q2,Q3,Q4,Inventory.UNITPRICE,P2,P3,P4); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 122 (* make up a unit price for value *) 123 END; 124 125 RealToStr(Inventory.UNITPRICE * Inventory.ONHAND,2,8,Str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 126 Value := Value + (Inventory.UNITPRICE * Inventory.ONHAND); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 127 OverWrite(Str,Line,70); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 128 AddMenuItem(DF,2,J+2,Line,78,0,' '); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 129 END; (* end of for J *) 130 131 132 DisposeList(InvList); ***** ^ not supported yet ***** ^ not supported yet 133 ShowDisplayFrame(DF,1,1,80,24); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 134 Control(DF); ***** ^ not supported yet ***** ^ not supported yet 135 IF PromptYN(' Print Report ',DF) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 136 THEN 137 Line := 'Inventory Sorted by Item Code'; ***** ^ not supported yet ***** ^ not supported yet 138 NormalTitle(Line); ***** ^ not supported yet ***** ^ not supported yet 139 Handle := OpenReportDevice(); ***** ^ not supported yet ***** ^ not supported yet 140 PrintFrame(DF,Handle); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 141 CloseReportDevice(Handle); ***** ^ not supported yet ***** ^ not supported yet 142 END; 143 CloseDisplayFrame(DF); ***** ^ not supported yet ***** ^ not supported yet 144 DisposeList(InvList); ***** ^ not supported yet ***** ^ not supported yet 145 146 147 148 149 150 END TotalInventory; ***** ^ not supported yet 151 152 153 154 155 PROCEDURE ReorderInventory(); 156 VAR 157 Str : ARRAY[0..20] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 158 InvList : GenList; 159 OrderList : GenList; 160 LineCnt : CARDINAL; 161 J,K : CARDINAL; 162 Line : ARRAY[0..80] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 163 DF : DisplayFrame; 164 Handle : CARDINAL; 165 FieldRec : InputFieldRecord; 166 Inventory : InvtryRec; 167 Code : CARDINAL; 168 BEGIN 169 Str := ''; ***** ^ not supported yet ***** ^ incompatible assignment 170 PromptStr('Enter Inventory Code (or partial Code)',Str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 171 MakeKey(Str); ***** ^ not supported yet ***** ^ not supported yet 172 OpenInvtryDBF(TRUE); ***** ^ not supported yet ***** ^ not supported yet 173 FindAll(InvcodeIdx,Str,BeginsWith,InvList); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 174 ReadAllRecs(InvtryDBF,ReadInvRec,InvList); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 175 176 177 178 InitDisplayFrame(DF,VWindows.CurrentWindow); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 179 AddStrField(DF,2,2, ***** ^ not supported yet ***** ^ not supported yet 180 'Code Description Units On Hand On Ord Reorder Qnt ',67); ***** ^ not supported yet ***** ^ not supported yet 181 GetFieldRec(DF,1,FieldRec); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 182 FieldRec.typ := DispCode; (* headline = display code *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 183 PutFieldRec(FieldRec,DF,1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 184 DF^.headline := 2; ***** ^ not supported yet ***** ^ not supported yet 185 LineCnt := 3; 186 J := ListLength(InvList); ***** ^ not supported yet ***** ^ not supported yet 187 LOOP 188 (* FOR J := ListLength(InvList) DOWNTO 1 BY -1 DO *) 189 IF J = 0 190 THEN EXIT; 191 END; 192 GetElmt(InvList,J,Inventory,Code); (* Only take those <= reorder level*) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 193 DEC(J); ***** ^ undeclared identifier ***** ^ not supported yet 194 IF (Inventory.STOCKED) AND (TRUNC(Inventory.ONHAND) <= Inventory.REORDER) ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 195 THEN 196 Fill(ADR(Line),SIZE(Line),' '); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 197 Line[78] := 0C; ***** ^ not supported yet ***** ^ not supported yet 198 OverWrite(Inventory.INVCODE,Line,3); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 199 OverWrite(Inventory.DESC,Line,11); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 200 OverWrite(Inventory.UNITS,Line,44); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 201 RealToStr(Inventory.ONHAND,2,8,Str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 202 OverWrite(Str,Line,52); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 203 OverWrite(Inventory.ONORDER,Line,63); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 204 RealToStr(Inventory.REORDAMT,2,8,Str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 205 OverWrite(Str,Line,70); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 206 AddMenuItem(DF,2,LineCnt,Line,78,0,Inventory.INVCODE); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 207 INC(LineCnt); ***** ^ undeclared identifier ***** ^ not supported yet 208 (* ELSE 209 ListDelete(InvList,J,1); *) (* didn't need to reorder *) 210 END; (* end if need to reorder *) 211 END; (* end of loop *) 212 SelectFromScreen(DF); ***** ^ not supported yet ***** ^ not supported yet 213 GetSelected(OrderList,DF); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 214 CloseDisplayFrame(DF); ***** ^ not supported yet ***** ^ not supported yet 215 InitDisplayFrame(DF,VWindows.CurrentWindow); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 216 217 AddStrField(DF,2,2, ***** ^ not supported yet ***** ^ not supported yet 218 ' Code Units Description Quantity ',67); ***** ^ not supported yet ***** ^ not supported yet 219 GetFieldRec(DF,1,FieldRec); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 220 FieldRec.typ := DispCode; (* headline = display code *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 221 PutFieldRec(FieldRec,DF,1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 222 DF^.headline := 2; ***** ^ not supported yet ***** ^ not supported yet 223 LineCnt := 3; 224 (* go through the order list and find the item in the invlist *) 225 (* make printable - and create string fields *) 226 J := ListLength(OrderList); ***** ^ not supported yet ***** ^ not supported yet 227 LOOP 228 IF J = 0 229 THEN EXIT; 230 END; 231 GetElmt(OrderList,J,Inventory.INVCODE,Code); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 232 DEC(J); ***** ^ undeclared identifier ***** ^ not supported yet 233 IF FindInvtryByInvcode(Inventory.INVCODE) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 234 THEN 235 Inventory.ONORDER := 'Y'; ***** ^ not supported yet ***** ^ not supported yet 236 MoveInvtryToDBF(Inventory); ***** ^ not supported yet ***** ^ not supported yet 237 WriteDBRec(InvtryDBF); ***** ^ not supported yet ***** ^ not supported yet 238 END; 239 Fill(ADR(Line),SIZE(Line),' '); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 240 Line[77] := 0C; ***** ^ not supported yet ***** ^ not supported yet 241 OverWrite(Inventory.INVCODE,Line,3); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 242 OverWrite(Inventory.UNITS,Line,11); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 243 OverWrite(Inventory.DESC,Line,20); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 244 245 RealToStr(Inventory.REORDAMT,2,8,Str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 246 OverWrite(Str,Line,63); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 247 AddStrField(DF,2,LineCnt,Line,78); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 248 INC(LineCnt); ***** ^ undeclared identifier ***** ^ not supported yet 249 250 END; (* end for J *) 251 ShowDisplayFrame(DF,1,1,80,24); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 252 Control(DF); ***** ^ not supported yet ***** ^ not supported yet 253 IF PromptYN(' Print Report ',DF) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 254 THEN 255 Line := 'Purchase Order Number '; ***** ^ not supported yet ***** ^ not supported yet 256 MakeSeqNbr('POSEQ',Config.PurchOrdPre,Str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 257 Append(Line,Str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 258 NormalTitle(Line); ***** ^ not supported yet ***** ^ not supported yet 259 Handle := OpenReportDevice(); ***** ^ not supported yet ***** ^ not supported yet 260 PrintFrame(DF,Handle); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 261 CloseReportDevice(Handle); ***** ^ not supported yet ***** ^ not supported yet 262 END; 263 CloseDisplayFrame(DF); ***** ^ not supported yet ***** ^ not supported yet 264 CloseInvtryDBF(); ***** ^ not supported yet ***** ^ not supported yet 265 DisposeList(InvList); ***** ^ not supported yet ***** ^ not supported yet 266 DisposeList(OrderList); ***** ^ not supported yet ***** ^ not supported yet 267 END ReorderInventory; ***** ^ not supported yet 268 269 270 271 272 END IvyReports. ***** ^ not supported yet 413 errors