IMPLEMENTATION MODULE Customer; (* * ModBase * Release 3.0 * (c) Copyright 1986 - 1991 PMI * P.O. Box 8402 * Green Bay Wi 53308 * All Rights Reserved * by Ed Ross *) FROM ModBase3 IMPORT UpdateDBFile,WriteDBRec,DeleteRecord,ReadDBRec, AppendBlank; FROM PMIGlobals IMPORT PMIScreens,Config,NormalTitle; FROM DBStuff IMPORT MakeSeqNbr,MakeKey; FROM DBUtils IMPORT ChangeDateField,ChangeRealField,PrintTitle; FROM Scrn2DBF IMPORT FrameToDBF, DBFToFrame; FROM NumTypes IMPORT Real8; FROM DateFunctions IMPORT Date; FROM Numbers IMPORT Max; FROM PosUtils IMPORT Equal; FROM StrEdit IMPORT CrunchBlanks,DeleteRightJustified,Append,CAPstr, AssignStr,DeleteChar; FROM M2Strings IMPORT Length,Assign,Concat; FROM LowLevel IMPORT Fill; FROM StringIO IMPORT PrintMessage,ErrorMessage,WriteEol,WriteStr; (* these next two are from stonybrook - the pmi version doesn't work*) FROM SmartScreen IMPORT ClearScreen; FROM ScrnUtl1 IMPORT FieldNum; FROM ScrnUtl2 IMPORT CloseDisplayFrame; FROM VWindows IMPORT ClearPart, CurrentWindow, SetCursorHeight; FROM ScrnTypes IMPORT DisplayFrame,InitDisplayFrame,AFrameName,DisplayFile; FROM FramePainter IMPORT ShowDisplayFrame,RedrawField; FROM InputManager IMPORT ControlFrame; FROM FrameManager IMPORT EraseFrame; FROM Prompts IMPORT Prompt,PromptStr,PromptNum,PromptYN; FROM SYSTEM IMPORT ADR,SIZE,ADDRESS; FROM ControlUtils IMPORT ControlSeparately, LoadFrameList,Control,ChangeField; FROM DspFiles IMPORT OpenDisplayFile,ReadDisplayFrame; FROM HandleIO IMPORT FileExists,OpenFile,CloseHandle; FROM Prompts IMPORT Prompt; FROM ManualInvoice IMPORT AddManualInvoice; FROM GenLists IMPORT GenList, NewList,ListLength,GetElmt, GetElmtAdr,DisposeList; FROM Invoice IMPORT ControlInvoice,PayInvoice,InvoiceHistory, MakeInvoicePrintLine,InvoiceDaysLate,GetOutstanding; FROM DBFCustomer IMPORT CustomerDBF, OpenCustomerDBF, CloseCustomerDBF,CustomerRec,FindCustomerByCin,FindCustomerByName, NextCustomer,PrevCustomer,FirstCustomer,LastCustomer,MoveCustomerFromDBF, MoveCustomerToDBF; FROM Payments IMPORT ShowPaymentHist; FROM Gas IMPORT ListOutstanding,ListHistory; VAR Status : INTEGER; Environ : ARRAY [0..60] OF CHAR; J : CARDINAL; FirstTime: BOOLEAN; NextFrame,EndingFrame : AFrameName; SelChar : CHAR; NoData : BOOLEAN; (* true when no data is on the screen *) CustomerDF : DisplayFrame; DSPFile : DisplayFile; PullDnMenu : GenList; CurrentCust : CustomerRec; PROCEDURE GetCustNbr( VAR CustNbr : ARRAY OF CHAR); BEGIN Assign(CurrentCust.CIN,CustNbr); CrunchBlanks(CustNbr); END GetCustNbr; PROCEDURE GetCustTerms(VAR Terms : ARRAY OF CHAR); BEGIN Assign(CurrentCust.TERMS,Terms ); END GetCustTerms; PROCEDURE GetCustSalesRep(VAR Rep : ARRAY OF CHAR); BEGIN Assign(CurrentCust.SALESREP,Rep ); END GetCustSalesRep; PROCEDURE GetCustSalesRepCom(VAR Percent : Real8); BEGIN Percent := CurrentCust.SALEREPCOM; END GetCustSalesRepCom; PROCEDURE GetCustShipVia(VAR Ship : ARRAY OF CHAR); BEGIN Assign( CurrentCust.SHIPVIA,Ship); END GetCustShipVia; PROCEDURE GetCustDisAmount(VAR DcntAmount : Real8); BEGIN DcntAmount := CurrentCust.DISCAMOUNT; END GetCustDisAmount; PROCEDURE GetCustDisCntLvl(VAR DefaultLvl : CARDINAL); BEGIN DefaultLvl := CurrentCust.DISCLEVEL; END GetCustDisCntLvl; PROCEDURE GetCustTaxable(VAR Taxable : CHAR); BEGIN Taxable := CurrentCust.TAXABLE; CAPstr(Taxable); END GetCustTaxable; PROCEDURE GetCustFreeFrght(VAR FreeFrght : CHAR); BEGIN FreeFrght := CurrentCust.FREEFRGHT; CAPstr(FreeFrght); END GetCustFreeFrght; PROCEDURE GetCustAddr(VAR Addr : AddressRec; AddrType : AddressTypes); VAR J : CARDINAL; BEGIN Fill(ADR(Addr),SIZE(Addr),0); J := 1; WITH CurrentCust DO IF AddrType = Billing THEN Assign(NAME,Addr.Line[0]); Assign( BILLTOZP,Addr.ZipCode); Assign( BILLTOA1,Addr.Line[1]); CrunchBlanks(Addr.Line[1]); IF Length(Addr.Line[1]) > 0 THEN INC(J); END; Assign( BILLTOA2,Addr.Line[J]); CrunchBlanks(Addr.Line[J]); IF Length(Addr.Line[J]) > 0 THEN INC(J); END; Assign( BILLTOA3,Addr.Line[J]); CrunchBlanks(Addr.Line[J]); IF Length(Addr.Line[J]) = 0 THEN DEC(J); END; Append(Addr.Line[J],' '); Append(Addr.Line[J],BILLTOZP); ELSE Assign( NAME,Addr.Line[0]); Assign( SHIPTOZP,Addr.ZipCode); Assign( SHIPTOA1,Addr.Line[1]); CrunchBlanks(Addr.Line[1]); IF Length(Addr.Line[1]) > 0 THEN INC(J); END; Assign( SHIPTOA2,Addr.Line[J]); CrunchBlanks(Addr.Line[J]); IF Length(Addr.Line[J]) > 0 THEN INC(J); END; Assign( SHIPTOA3,Addr.Line[J] ); CrunchBlanks(Addr.Line[J]); IF Length(Addr.Line[J]) = 0 THEN DEC(J); END; Append(Addr.Line[J],' '); Append(Addr.Line[J],' '); Append(Addr.Line[J],SHIPTOZP); END; END; (* end of with *) END GetCustAddr; PROCEDURE GetCurrCustName(VAR Name : ARRAY OF CHAR); BEGIN Assign( CurrentCust.NAME,Name); END GetCurrCustName; PROCEDURE SetCustomerRec(Cust : CustomerRec); BEGIN CurrentCust := Cust; END SetCustomerRec; PROCEDURE UpdateCustomerFile(); BEGIN MoveCustomerToDBF(CurrentCust); WriteDBRec(CustomerDBF); END UpdateCustomerFile; PROCEDURE SetCustLastInvDate( D : Date); BEGIN CurrentCust.LASTINV := D; ChangeDateField(CustomerDF,D,'LASTINV'); (* RedrawField(CustomerDF,FieldNum(CustomerDF,'LASTINV'),FALSE); *) UpdateCustomerFile(); END SetCustLastInvDate; PROCEDURE SetCustOutStd(AmountOut : Real8); BEGIN CurrentCust.AMTOUT := AmountOut; ChangeRealField(CustomerDF,AmountOut,'AMTOUT'); RedrawField(CustomerDF,FieldNum(CustomerDF,'AMTOUT'),FALSE); UpdateCustomerFile(); END SetCustOutStd; PROCEDURE AddCustOutStd(AmountOut : Real8); BEGIN CurrentCust.AMTOUT := CurrentCust.AMTOUT + AmountOut; ChangeRealField(CustomerDF,CurrentCust.AMTOUT,'AMTOUT'); RedrawField(CustomerDF,FieldNum(CustomerDF,'AMTOUT'),FALSE); UpdateCustomerFile(); END AddCustOutStd; PROCEDURE AddCustYTD(AddAmount : Real8); BEGIN CurrentCust.YTDPURCH := CurrentCust.YTDPURCH + AddAmount; IF CurrentCust.YTDPURCH < 0.0 THEN CurrentCust.YTDPURCH := 0.0; END; ChangeRealField(CustomerDF,CurrentCust.YTDPURCH,'YTDPURCH'); (* RedrawField(CustomerDF,FieldNum(CustomerDF,'YTDPURCH'),FALSE); *) UpdateCustomerFile(); END AddCustYTD; PROCEDURE GetCustName(CIN : ARRAY OF CHAR; VAR Name : ARRAY OF CHAR); VAR TMP : CustomerRec; BEGIN MakeKey(CIN); IF NOT FindCustomerByCin(CIN) THEN AssignStr( '?????',Name); ELSE MoveCustomerFromDBF(CurrentCust); Assign(CurrentCust.NAME,Name); END; END GetCustName; PROCEDURE PrintLabels(); (* print shipping labels*) CONST ShipLines = CHR(12); FF = CHR(12); NorLength = CHR(66); (* L1:=ARRAY OF CHAR (CHR(27),'C'); L2:ARRAY OF CHAR=[CHR(27),'C',NorLength]; *) VAR Cnt : CARDINAL; J,K : CARDINAL; PrtHand : CARDINAL; EM : ErrorMessage; Addr : AddressRec; L1 : ARRAY[0..2] OF CHAR; L2 : ARRAY[0..3] OF CHAR; BEGIN Concat(27C,'C',L1); Concat(L1,NorLength,L2); Cnt := PromptNum(' Enter number of labels to print ',1); EM := OpenFile(PrtHand,Config.LabelPrt); (* put the form length here *) (* WriteStr(PrtHand,L1); *) (* set form length to lenght of lables*) WriteStr(PrtHand,CHAR(18)); FOR J := 1 TO Cnt DO WriteStr(PrtHand,'FROM '); WriteEol(PrtHand,Config.CompanyName); WriteStr(PrtHand,' '); WriteEol(PrtHand,Config.CompanyAddr1); WriteStr(PrtHand,' '); WriteEol(PrtHand,Config.CompanyAddr2); WriteEol(PrtHand,''); (* go to the from part *) WriteEol(PrtHand,''); WriteEol(PrtHand,''); WriteEol(PrtHand,''); WriteEol(PrtHand,''); WriteStr(PrtHand,'TO '); GetCustAddr(Addr,Shipping); FOR K := 0 TO 3 DO WriteEol(PrtHand,Addr.Line[K]); WriteStr(PrtHand,' '); END; FOR K := 1 TO 6 DO WriteEol(PrtHand,''); END; END; (* WriteStr(PrtHand,L2); (* reset lenght at 66 lines / inch *)*) EM := CloseHandle(PrtHand); END PrintLabels; PROCEDURE FileMenu(SelChar: CHAR); VAR B : BOOLEAN; Str : ARRAY [0..80] OF CHAR; BEGIN CASE SelChar OF 'A' : ReadDisplayFrame(PMIScreens,CustomerDF,'Customer'); (*Clear out any of the fields *) MakeSeqNbr('Cust',Config.CustNbrPre,Str); ChangeField(CustomerDF,Str,'CIN',TRUE); ShowDisplayFrame(CustomerDF,0,0,0,0); Control(CustomerDF); (* alow user input *) AppendBlank(CustomerDBF); B := FrameToDBF(CustomerDBF,CustomerDF); (* do something if couldn't add*) MoveCustomerFromDBF(CurrentCust); WITH CurrentCust DO CrunchBlanks(BILLTOA1); IF (BILLTOA1[0] = CHR(0)) THEN Assign( SHIPTOA1,BILLTOA1); Assign( SHIPTOA2,BILLTOA2); Assign(SHIPTOA3,BILLTOA3 ); Assign( SHIPTOZP,BILLTOZP); MoveCustomerToDBF(CurrentCust); DBFToFrame(CustomerDBF,CustomerDF); ShowDisplayFrame(CustomerDF,0,0,0,0); END; END; (* end of with *) WriteDBRec(CustomerDBF); |'F' : FirstCustomer(); DBFToFrame(CustomerDBF,CustomerDF); ShowDisplayFrame(CustomerDF,0,0,0,0); |'L' : LastCustomer(); DBFToFrame(CustomerDBF,CustomerDF); ShowDisplayFrame(CustomerDF,0,0,0,0); |'N' : IF NextCustomer() THEN DBFToFrame(CustomerDBF,CustomerDF); ShowDisplayFrame(CustomerDF,0,0,0,0); END; |'P' : IF PrevCustomer() THEN DBFToFrame(CustomerDBF,CustomerDF); ShowDisplayFrame(CustomerDF,0,0,0,0); END; |'C' : (* The first unused letter in the index name or 'Q' *) Fill(ADR(Str),SIZE(Str),0); PromptStr('Enter Customer Cin ',Str); MakeKey(Str); IF NOT FindCustomerByCin(Str) THEN Prompt('Customer Not Found'); ELSE DBFToFrame(CustomerDBF,CustomerDF); ShowDisplayFrame(CustomerDF,0,0,0,0); END; |'M' : (* The first unused letter in the index name or 'Q' *) Fill(ADR(Str),SIZE(Str),0); PromptStr('Enter Customer Nameidx ',Str); MakeKey(Str); IF NOT FindCustomerByName(Str) THEN (* always display the cust or the closet one *) END; DBFToFrame(CustomerDBF,CustomerDF); ShowDisplayFrame(CustomerDF,0,0,0,0); END; (* end of case *) END FileMenu; PROCEDURE EditMenu(SelChar : CHAR); VAR B : BOOLEAN; BEGIN CASE SelChar OF 'U' : Control(CustomerDF); B := FrameToDBF(CustomerDBF,CustomerDF); WriteDBRec(CustomerDBF); |'D' : IF PromptYN('About to delete customer - continue ?',CustomerDF) THEN DeleteRecord(CustomerDBF); B :=NextCustomer(); FileMenu('P'); END; END; END EditMenu; PROCEDURE InvoiceMenu(SelChar: CHAR); VAR Inv : ARRAY[0..15] OF CHAR; BEGIN MoveCustomerFromDBF(CurrentCust); CASE SelChar OF 'A' : ControlInvoice('N'); |'E' : ControlInvoice('E'); (*edit invoice *) |'P' : ControlInvoice('P'); |'C' : ControlInvoice('C'); |'Y' : PayInvoice(); |'M' : AddManualInvoice(); END; (* end of case *) ShowDisplayFrame(CustomerDF,0,0,0,0); (* clear out the invoice stuff*) END InvoiceMenu; PROCEDURE PrintMenu(SelChar : CHAR); BEGIN MoveCustomerFromDBF(CurrentCust); CrunchBlanks(CurrentCust.CIN); CASE SelChar OF 'H' : ListOutstanding(CurrentCust.CIN); |'L' : PrintLabels(); |'E' : ListHistory(CurrentCust.CIN,CustomerDF); |'Y' : ShowPaymentHist(CurrentCust.CIN); |'V' : InvoiceHistory(); END; END PrintMenu; PROCEDURE ControlCustomer(); BEGIN (* OpenCustomerDBF(TRUE); *) ClearScreen(); InitDisplayFrame(CustomerDF,CurrentWindow); NewList(PullDnMenu); LoadFrameList(PMIScreens,'TopMenu',PullDnMenu); NoData := TRUE; ReadDisplayFrame(PMIScreens,CustomerDF,'Customer'); REPEAT NextFrame := 'TopMenu'; ControlSeparately(PullDnMenu,NextFrame,SelChar,EndingFrame); IF Equal(EndingFrame,'FileMenu') THEN FileMenu(SelChar); ELSIF Equal(EndingFrame,'EditMenu') THEN EditMenu(SelChar); ELSIF Equal(EndingFrame,'InvoiceMenu') THEN InvoiceMenu(SelChar); ELSIF Equal(EndingFrame,'PrintMenu') THEN PrintMenu(SelChar); END; UNTIL SelChar='X'; (* Assumes 'X' is only used to exit *) CloseDisplayFrame(CustomerDF); (* CloseCustomerDBF();*) ClearScreen(); END ControlCustomer; END Customer.