Listing: 1 IMPLEMENTATION MODULE PMIMaint; 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 PMIGlobals IMPORT Config,PMIScreens; 14 FROM NumTypes IMPORT Real8; 15 FROM Numbers IMPORT Max; 16 FROM PosUtils IMPORT Equal; 17 FROM StrEdit IMPORT CrunchBlanks,DeleteRightJustified,Append,CAPstr,DeleteChar; 18 FROM M2Strings IMPORT Length; 19 FROM LowLevel IMPORT Fill; 20 FROM StringIO IMPORT PrintMessage,ErrorMessage,WriteEol,WriteStr,outp; 21 FROM SmartScreen IMPORT ClearScreen; 22 FROM ScrnUtl1 IMPORT FieldNum; 23 FROM ScrnUtl2 IMPORT CloseDisplayFrame; 24 FROM VWindows IMPORT ClearPart, CurrentWindow, SetCursorHeight; 25 FROM ScrnTypes IMPORT DisplayFrame,InitDisplayFrame,AFrameName; 26 FROM FramePainter IMPORT ShowDisplayFrame,RedrawField; 27 FROM InputManager IMPORT ControlFrame; 28 FROM FrameManager IMPORT EraseFrame; 29 FROM Prompts IMPORT PromptYN; 30 FROM SYSTEM IMPORT ADR,SIZE,ADDRESS; 31 FROM ControlUtils IMPORT ControlSeparately, LoadFrameList,Control,ChangeField; 32 FROM DspFiles IMPORT OpenDisplayFile,ReadDisplayFrame; 33 34 35 36 FROM DBFCustomer IMPORT CustomerDBF,MoveCustomerToDBF,MoveCustomerFromDBF, 37 CustomerRec, OpenCustomerDBF,CloseCustomerDBF,PackCustomer; 38 FROM ModBase3 IMPORT ReadDBRec,WriteDBRec,NumberRecords; 39 40 FROM DBFInvtry IMPORT PackInvtry; 41 FROM DBFInvoice IMPORT PackInvoice; 42 FROM DBFGas IMPORT PackGas; 43 FROM DBFPayments IMPORT PackPayments; 44 FROM DBFOrder IMPORT PackOrder; 45 46 47 VAR 48 DF : DisplayFrame; 49 NxtFrame : AFrameName; 50 51 PROCEDURE PackDatabase(); 52 TYPE 53 PackType = (PCust,PPay,PInv,PInvy,PGas,POrder); 54 VAR 55 WhatToPack : SET OF PackType; ***** ^ not supported yet 56 57 BEGIN 58 WhatToPack := WhatToPack / WhatToPack; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 59 IF PromptYN(' Pack Customer ',DF) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 60 THEN 61 INCL(WhatToPack,PCust); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 62 END; 63 IF PromptYN(' Pack Payments ',DF) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 64 THEN 65 INCL(WhatToPack,PPay); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 66 END; 67 IF PromptYN(' Pack Invoices ',DF) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 68 THEN 69 INCL(WhatToPack,PInv); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 70 END; 71 IF PromptYN(' Pack Inventory ',DF) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 72 THEN 73 INCL(WhatToPack,PInvy); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 74 END; 75 IF PromptYN(' Pack Helium ',DF) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 76 THEN 77 INCL(WhatToPack,PGas); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 78 END; 79 IF PromptYN(' Pack Orders ',DF) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 80 THEN 81 INCL(WhatToPack,POrder); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 82 END; 83 ClearScreen(); ***** ^ not supported yet ***** ^ not supported yet 84 IF PPay IN WhatToPack ***** ^ not supported yet ***** ^ not supported yet 85 THEN 86 WriteEol(outp,' Packing Payments database '); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 87 PackPayments(); ***** ^ not supported yet ***** ^ not supported yet 88 END; 89 90 IF PCust IN WhatToPack ***** ^ not supported yet ***** ^ not supported yet 91 THEN 92 WriteEol(outp,' Packing customer database '); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 93 PackCustomer(); ***** ^ not supported yet ***** ^ not supported yet 94 END; 95 96 IF PInv IN WhatToPack ***** ^ not supported yet ***** ^ not supported yet 97 THEN 98 WriteEol(outp,' Packing Invoice database '); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 99 PackInvoice(); ***** ^ not supported yet ***** ^ not supported yet 100 END; 101 102 IF PInvy IN WhatToPack ***** ^ not supported yet ***** ^ not supported yet 103 THEN 104 WriteEol(outp,' Packing Inventory database '); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 105 PackInvtry(); ***** ^ not supported yet ***** ^ not supported yet 106 END; 107 108 IF PGas IN WhatToPack ***** ^ not supported yet ***** ^ not supported yet 109 THEN 110 WriteEol(outp,' Packing Gas database '); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 111 PackGas(); ***** ^ not supported yet ***** ^ not supported yet 112 END; 113 IF POrder IN WhatToPack ***** ^ not supported yet ***** ^ not supported yet 114 THEN 115 WriteEol(outp,'Packing orderdatabase'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 116 PackOrder(); ***** ^ not supported yet ***** ^ not supported yet 117 END; 118 END PackDatabase; ***** ^ not supported yet 119 120 PROCEDURE ResetCustYTD(); 121 VAR 122 Cust : CustomerRec; 123 LI : LONGINT; 124 BEGIN 125 IF NOT PromptYN(' Reset Customer YTD Purchases? ',DF) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 126 THEN 127 RETURN; 128 END; 129 OpenCustomerDBF(FALSE); ***** ^ not supported yet ***** ^ not supported yet 130 ClearScreen(); ***** ^ not supported yet ***** ^ not supported yet 131 FOR LI := 1 TO NumberRecords(CustomerDBF) DO ***** ^ not supported yet ***** ^ not supported yet 132 ReadDBRec(CustomerDBF,LI); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 133 MoveCustomerFromDBF(Cust); ***** ^ not supported yet ***** ^ not supported yet 134 WriteStr(outp,' Processing '); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 135 WriteEol(outp,Cust.NAME); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 136 Cust.YTDPURCH := 0.0; ***** ^ not supported yet ***** ^ not supported yet 137 MoveCustomerToDBF(Cust); ***** ^ not supported yet ***** ^ not supported yet 138 WriteDBRec(CustomerDBF); ***** ^ not supported yet ***** ^ not supported yet 139 END; 140 CloseCustomerDBF(); ***** ^ not supported yet ***** ^ not supported yet 141 END ResetCustYTD; ***** ^ not supported yet 142 143 PROCEDURE Maintain(); 144 145 BEGIN 146 InitDisplayFrame(DF,CurrentWindow); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 147 ReadDisplayFrame(PMIScreens,DF,'Maint'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 148 REPEAT 149 ClearScreen(); ***** ^ not supported yet ***** ^ not supported yet 150 ShowDisplayFrame(DF,0,0,0,0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 151 ControlFrame(DF,1,'',FALSE,NxtFrame); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 152 IF Equal(NxtFrame,'PackDB') ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 153 THEN PackDatabase(); ***** ^ not supported yet ***** ^ not supported yet 154 ELSIF Equal(NxtFrame,'ResetCust') ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 155 THEN ResetCustYTD(); ***** ^ not supported yet ***** ^ not supported yet 156 END; 157 UNTIL Equal(NxtFrame,'Exit'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 158 CloseDisplayFrame(DF); ***** ^ not supported yet ***** ^ not supported yet 159 END Maintain; ***** ^ not supported yet 160 161 162 163 END PMIMaint. ***** ^ not supported yet 147 errors