IMPLEMENTATION MODULE Gas; (* * 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 AppendBlank,ReadDBRec, WriteDBRec,Record; FROM NumTypes IMPORT Real8,REALToReal8; FROM DBFGas IMPORT GasRec,MoveGasFromDBF,MoveGasToDBF; FROM LowLevel IMPORT Fill; FROM StrEdit IMPORT Append,OverWrite,AssignStr; FROM StrConv IMPORT CardinalToStr; FROM M2Strings IMPORT CompareStr,Assign; FROM ScrnUtl2 IMPORT CloseDisplayFrame; FROM ScrnUtl1 IMPORT GetFieldRec,PutFieldRec,FieldNum,FieldListTotal; FROM ScrnTypes IMPORT DisplayFrame,InitDisplayFrame,AFrameName, DispCode,ContinueInput,CancelInput,SubmitInput,InputFieldRecord; FROM FramePainter IMPORT ShowDisplayFrame,RedrawField; FROM Prompts IMPORT PromptYN,Prompt,PromptNum; FROM ControlUtils IMPORT Control,AddStrField,AddMenuItem; FROM PMIGlobals IMPORT Today,TodayP30,TodayP30Str,Config, OpenReportDevice,CloseReportDevice,NormalTitle; FROM SYSTEM IMPORT ADR,SIZE; FROM PosUtils IMPORT Equal; FROM GenLists IMPORT ListLength,GenList,DisposeList,GetElmtAdr, SortList,GetElmt,NilList; FROM DateFunctions IMPORT Date,DaysSince1900,DateToStr; FROM DBStuff IMPORT ConditionType,MakeKey,FindAll,ReadAllRecs,DeleteAllRecs; FROM DBUtils IMPORT PrintFrame; FROM Customer IMPORT GetCurrCustName; FROM DBFGas IMPORT GasRec,GasDBF,GasIdx,OpenGasDBF,CloseGasDBF, GasOutIdx,GasInIdx; FROM SYSTEM IMPORT SIZE,ADDRESS; FROM VWindows IMPORT CurrentWindow; FROM Storage IMPORT ALLOCATE; TYPE FGasRec = RECORD Gas: GasRec; LI : LONGINT; END; PROCEDURE SortByDate (P1 : ADDRESS; C1 :CARDINAL; P2 : ADDRESS; C2 : CARDINAL): INTEGER; VAR Gas1, Gas2 : POINTER TO FGasRec; BEGIN Gas1 := P1; (* sort by invoice by item types *) Gas2 := P2; IF Equal(Gas1^.Gas.INVNBR,Gas2^.Gas.INVNBR) THEN RETURN CompareStr(Gas1^.Gas.ITEMNBR,Gas2^.Gas.ITEMNBR) ELSE RETURN CompareStr(Gas1^.Gas.INVNBR,Gas2^.Gas.INVNBR); (* inv numbers sort by date*) END; END SortByDate; PROCEDURE ReadARec(VAR AddressOfRec : ADDRESS; VAR SizeOfRec: CARDINAL); VAR P : POINTER TO FGasRec; BEGIN SizeOfRec := SIZE(FGasRec); ALLOCATE(P,SizeOfRec); MoveGasFromDBF(P^.Gas); P^.LI := Record(GasDBF); AddressOfRec := P; END ReadARec; PROCEDURE DeleteGasFromInv(InvNbr : ARRAY OF CHAR); VAR TheList : GenList; J : CARDINAL; LI : LONGINT; Gas : GasRec; Code : CARDINAL; BEGIN OpenGasDBF(TRUE); MakeKey(InvNbr); NilList(TheList); FindAll(GasOutIdx,InvNbr,EQ,TheList); DeleteAllRecs(GasDBF,TheList); (* delete all recs from check out*) FindAll(GasInIdx,InvNbr,EQ,TheList); (* find any check in recs *) IF ListLength(TheList) > 0 THEN FOR J := 1 TO ListLength(TheList) DO GetElmt(TheList,J,LI,Code); ReadDBRec(GasDBF,LI); MoveGasFromDBF(Gas); Gas.STATUS := 'O'; (* make outstanding*) Gas.ININVNBR := ''; MoveGasToDBF(Gas); WriteDBRec(GasDBF); END; END; DisposeList(TheList); CloseGasDBF(); END DeleteGasFromInv; PROCEDURE CheckOutGas(CustID,OutInvoiceNbr,InvtryItem : ARRAY OF CHAR; Quant : CARDINAL;InvDate: Date); VAR Rec : GasRec; J : CARDINAL; BEGIN OpenGasDBF(TRUE); Fill(ADR(Rec),SIZE(Rec),0); WITH Rec DO Assign( CustID,CIN ); Assign( OutInvoiceNbr,INVNBR ); Assign( InvtryItem,ITEMNBR); DATEOUT := InvDate; DUEDATE := TodayP30; STATUS := 'O'; END; FOR J := 1 TO Quant DO AppendBlank(GasDBF); MoveGasToDBF(Rec); WriteDBRec(GasDBF); END; CloseGasDBF(); END CheckOutGas; PROCEDURE GetGasByCust(CustID,InvtryItem : ARRAY OF CHAR;Status : CHAR; VAR TheList : GenList); VAR Str : ARRAY[0..30] OF CHAR; J : CARDINAL; BEGIN Assign(CustID,Str ); (* form the partial key *) Append(Str,Status); Append(Str,InvtryItem); MakeKey(Str); (* upcase remove blanks *) NilList(TheList); FindAll(GasIdx,Str,BeginsWith,TheList); ReadAllRecs(GasDBF,ReadARec,TheList); SortList(TheList,SortByDate); END GetGasByCust; PROCEDURE CheckInGas(CustID,InInvoiceNbr,InvtryItem: ARRAY OF CHAR; Quant : CARDINAL; InvDate : Date); VAR OutList : GenList; J : CARDINAL; Size, Code : CARDINAL; LL : CARDINAL; Str : ARRAY[0..30] OF CHAR; Str2 : ARRAY[0..5] OF CHAR; Rec : POINTER TO FGasRec; D1,D2 : CARDINAL; BEGIN OpenGasDBF(TRUE); InvtryItem[1] := '0'; (* find by the size checkout *) GetGasByCust(CustID,InvtryItem,'O',OutList); LL := ListLength(OutList); IF Quant <= LL (* can handle this - more tanks out than turned in*) THEN FOR J := 1 TO Quant DO GetElmtAdr(OutList,J,Rec,Size,Code); Rec^.Gas.DATEIN := InvDate; Assign( InInvoiceNbr,Rec^.Gas.ININVNBR ); Rec^.Gas.STATUS := 'I'; (* change status *) D2 := DaysSince1900(Rec^.Gas.DUEDATE); D1 := DaysSince1900(Rec^.Gas.DATEIN); IF D1 > D2 THEN Rec^.Gas.DAYSLATE := D1 - D2; END; ReadDBRec(GasDBF,Rec^.LI); (* position the database *) MoveGasToDBF(Rec^.Gas); (* update the record *) WriteDBRec(GasDBF); END; (* end of for *) ELSE (* here were in trouble - the cust wants to return more*) (* tanks than what I have recored as outstanding *) D1 := Quant - LL; (* number to be checked in without being checkou*) CardinalToStr(D1,4,Str2); Str := ' WARNING - '; Append(Str,Str2); Append(Str,' More tanks checked out than on record'); Prompt(Str); CheckOutGas(CustID,'??????',InvtryItem,D1,InvDate); (* check out with out an in*) (* make a recursive call to check in - this time it should work*) CheckInGas(CustID,InInvoiceNbr,InvtryItem,Quant,InvDate); END; CloseGasDBF(); END CheckInGas; PROCEDURE GasAmountDue(CustID, InvtryItem : ARRAY OF CHAR;Quant : CARDINAL; InvDate : Date; VAR AmountDue : Real8; VAR Notes : ARRAY OF CHAR); (* filled in if late*) VAR Str : ARRAY[0..40] OF CHAR; Str2 : ARRAY[0..5] OF CHAR; DaysLate : CARDINAL; List : GenList; Rec : POINTER TO FGasRec; J, Size,Code : CARDINAL; D1, D2 : CARDINAL; DL : Real8; BEGIN OpenGasDBF(TRUE); InvtryItem[1] := '0'; (* make it look like a check out *) GetGasByCust(CustID,InvtryItem,'O',List); DaysLate := 0; D1 := DaysSince1900(InvDate); IF Quant > ListLength(List) THEN Quant := ListLength(List); END; FOR J := 1 TO Quant DO GetElmtAdr(List,J,Rec,Size,Code); D2 := DaysSince1900(Rec^.Gas.DUEDATE); IF D1 > D2 (* late *) THEN Str := 'Tank late by '; CardinalToStr(D1-D2,5,Str2); Append(Str,Str2); Append(Str,' Days - Charge for '); DaysLate := DaysLate + PromptNum(Str,D1 - D2); END; END; (* end for J := quant *) DL := REALToReal8(FLOAT(DaysLate)); AmountDue := DL * Config.OvertimeCharge; IF DaysLate > 0 THEN AssignStr( 'Late charge for ',Notes); CardinalToStr(DaysLate,3,Str); Append(Str,Notes); Append(Notes,' tank days '); END; DisposeList(List); CloseGasDBF(); END GasAmountDue; PROCEDURE ListOutstanding(CustID : ARRAY OF CHAR); CONST Title = ' Tank Size Invoice Out Invoice Date Due Date '; (* 0123456789012345678901234567890123456789012345678901234567890*) VAR DF : DisplayFrame; Handle : CARDINAL; Line : ARRAY[0..80] OF CHAR; Str : ARRAY [0..20] OF CHAR; Rec : POINTER TO FGasRec; B : BOOLEAN; J : CARDINAL; Code,Size : CARDINAL; FieldRec : InputFieldRecord; List : GenList; Title1 : ARRAY[0..80] OF CHAR; BEGIN OpenGasDBF(TRUE); GetGasByCust(CustID,'','O',List); (* get all items *) CloseGasDBF(); InitDisplayFrame(DF,CurrentWindow); AddStrField(DF,2,2,Title,75); GetFieldRec(DF,1,FieldRec); FieldRec.typ := DispCode; (* headline = display code *) PutFieldRec(FieldRec,DF,1); DF^.headline := 2; IF ListLength(List) > 0 (* some tanks are outstanding *) THEN FOR J := 1 TO ListLength(List) DO GetElmtAdr(List,J,Rec,Size,Code); Fill(ADR(Line),SIZE(Line),' '); OverWrite(Rec^.Gas.ITEMNBR,Line,1); OverWrite(Rec^.Gas.INVNBR,Line,14); DateToStr(Rec^.Gas.DATEOUT,Str,B); OverWrite(Str,Line,29); DateToStr(Rec^.Gas.DUEDATE,Str,B); OverWrite(Str,Line,47); AddMenuItem(DF,2,J+2,Line,78,0,' '); END; ShowDisplayFrame(DF,1,13,80,24); Control(DF); IF PromptYN('Do you wish to print Y/N?',DF) THEN GetCurrCustName(Title1); Append(Title1,' - Gas Outstanding'); Handle := OpenReportDevice(); NormalTitle(Title1); PrintFrame(DF,Handle); CloseReportDevice(Handle); END; END; (* end of if > 0 *) CloseDisplayFrame(DF); DisposeList(List); END ListOutstanding; PROCEDURE ListHistory(CustID : ARRAY OF CHAR; DF1 : DisplayFrame); CONST Title = ' Size InvoiceOut DateOut DueDate InvoiceIn DateIn DaysLate Charge '; (* 0123456789012345678901234567890123456789012345678901234567890*) VAR DF : DisplayFrame; Line : ARRAY[0..80] OF CHAR; Str : ARRAY [0..20] OF CHAR; Rec : POINTER TO FGasRec; B : BOOLEAN; J : CARDINAL; Code,Size : CARDINAL; FieldRec : InputFieldRecord; List : GenList; Title1 : ARRAY[0..80] OF CHAR; Handle : CARDINAL; BEGIN IF NOT PromptYN('Warning Display gas history could take several minutes',DF1) THEN RETURN END; OpenGasDBF(TRUE); GetGasByCust(CustID,'','I',List); (* get all items *) CloseGasDBF(); InitDisplayFrame(DF,CurrentWindow); AddStrField(DF,2,2,Title,75); GetFieldRec(DF,1,FieldRec); FieldRec.typ := DispCode; (* headline = display code *) PutFieldRec(FieldRec,DF,1); DF^.headline := 2; IF ListLength(List) > 0 (* some tanks are outstanding *) THEN FOR J := 1 TO ListLength(List) DO (*************************************************************************** Size InvoiceOut DateOut DueDate InvoiceIn DateIn DaysLate Charge '; 0123456789012345678901234567890123456789012345678901234567890123456781234567*) GetElmtAdr(List,J,Rec,Size,Code); Fill(ADR(Line),SIZE(Line),' '); OverWrite(Rec^.Gas.ITEMNBR,Line,1); OverWrite(Rec^.Gas.INVNBR,Line,8); DateToStr(Rec^.Gas.DATEOUT,Str,B); OverWrite(Str,Line,20); DateToStr(Rec^.Gas.DUEDATE,Str,B); OverWrite(Str,Line,29); OverWrite(Rec^.Gas.ININVNBR,Line,38); DateToStr(Rec^.Gas.DATEIN,Str,B); OverWrite(Str,Line,49); CardinalToStr(Rec^.Gas.DAYSLATE,4,Str); OverWrite(Str,Line,60); AddMenuItem(DF,2,J+2,Line,78,0,' '); END; ShowDisplayFrame(DF,1,13,80,24); Control(DF); IF PromptYN('Do you wish to print Y/N?',DF) THEN GetCurrCustName(Title1); Append(Title1,' - Gas History'); NormalTitle(Title1); Handle := OpenReportDevice(); PrintFrame(DF,Handle); CloseReportDevice(Handle); END; END; (* end of if > 0 *) CloseDisplayFrame(DF); DisposeList(List); END ListHistory; END Gas.