IMPLEMENTATION MODULE PMIMaint; (* * ModBase * Release 3.0 * (c) Copyright 1986 - 1991 PMI * P.O. Box 8402 * Green Bay Wi 53308 * All Rights Reserved * by Ed Ross *) FROM PMIGlobals IMPORT Config,PMIScreens; FROM NumTypes IMPORT Real8; FROM Numbers IMPORT Max; FROM PosUtils IMPORT Equal; FROM StrEdit IMPORT CrunchBlanks,DeleteRightJustified,Append,CAPstr,DeleteChar; FROM M2Strings IMPORT Length; FROM LowLevel IMPORT Fill; FROM StringIO IMPORT PrintMessage,ErrorMessage,WriteEol,WriteStr,outp; FROM SmartScreen IMPORT ClearScreen; FROM ScrnUtl1 IMPORT FieldNum; FROM ScrnUtl2 IMPORT CloseDisplayFrame; FROM VWindows IMPORT ClearPart, CurrentWindow, SetCursorHeight; FROM ScrnTypes IMPORT DisplayFrame,InitDisplayFrame,AFrameName; FROM FramePainter IMPORT ShowDisplayFrame,RedrawField; FROM InputManager IMPORT ControlFrame; FROM FrameManager IMPORT EraseFrame; FROM Prompts IMPORT PromptYN; FROM SYSTEM IMPORT ADR,SIZE,ADDRESS; FROM ControlUtils IMPORT ControlSeparately, LoadFrameList,Control,ChangeField; FROM DspFiles IMPORT OpenDisplayFile,ReadDisplayFrame; FROM DBFCustomer IMPORT CustomerDBF,MoveCustomerToDBF,MoveCustomerFromDBF, CustomerRec, OpenCustomerDBF,CloseCustomerDBF,PackCustomer; FROM ModBase3 IMPORT ReadDBRec,WriteDBRec,NumberRecords; FROM DBFInvtry IMPORT PackInvtry; FROM DBFInvoice IMPORT PackInvoice; FROM DBFGas IMPORT PackGas; FROM DBFPayments IMPORT PackPayments; FROM DBFOrder IMPORT PackOrder; VAR DF : DisplayFrame; NxtFrame : AFrameName; PROCEDURE PackDatabase(); TYPE PackType = (PCust,PPay,PInv,PInvy,PGas,POrder); VAR WhatToPack : SET OF PackType; BEGIN WhatToPack := WhatToPack / WhatToPack; IF PromptYN(' Pack Customer ',DF) THEN INCL(WhatToPack,PCust); END; IF PromptYN(' Pack Payments ',DF) THEN INCL(WhatToPack,PPay); END; IF PromptYN(' Pack Invoices ',DF) THEN INCL(WhatToPack,PInv); END; IF PromptYN(' Pack Inventory ',DF) THEN INCL(WhatToPack,PInvy); END; IF PromptYN(' Pack Helium ',DF) THEN INCL(WhatToPack,PGas); END; IF PromptYN(' Pack Orders ',DF) THEN INCL(WhatToPack,POrder); END; ClearScreen(); IF PPay IN WhatToPack THEN WriteEol(outp,' Packing Payments database '); PackPayments(); END; IF PCust IN WhatToPack THEN WriteEol(outp,' Packing customer database '); PackCustomer(); END; IF PInv IN WhatToPack THEN WriteEol(outp,' Packing Invoice database '); PackInvoice(); END; IF PInvy IN WhatToPack THEN WriteEol(outp,' Packing Inventory database '); PackInvtry(); END; IF PGas IN WhatToPack THEN WriteEol(outp,' Packing Gas database '); PackGas(); END; IF POrder IN WhatToPack THEN WriteEol(outp,'Packing orderdatabase'); PackOrder(); END; END PackDatabase; PROCEDURE ResetCustYTD(); VAR Cust : CustomerRec; LI : LONGINT; BEGIN IF NOT PromptYN(' Reset Customer YTD Purchases? ',DF) THEN RETURN; END; OpenCustomerDBF(FALSE); ClearScreen(); FOR LI := 1 TO NumberRecords(CustomerDBF) DO ReadDBRec(CustomerDBF,LI); MoveCustomerFromDBF(Cust); WriteStr(outp,' Processing '); WriteEol(outp,Cust.NAME); Cust.YTDPURCH := 0.0; MoveCustomerToDBF(Cust); WriteDBRec(CustomerDBF); END; CloseCustomerDBF(); END ResetCustYTD; PROCEDURE Maintain(); BEGIN InitDisplayFrame(DF,CurrentWindow); ReadDisplayFrame(PMIScreens,DF,'Maint'); REPEAT ClearScreen(); ShowDisplayFrame(DF,0,0,0,0); ControlFrame(DF,1,'',FALSE,NxtFrame); IF Equal(NxtFrame,'PackDB') THEN PackDatabase(); ELSIF Equal(NxtFrame,'ResetCust') THEN ResetCustYTD(); END; UNTIL Equal(NxtFrame,'Exit'); CloseDisplayFrame(DF); END Maintain; END PMIMaint.