Topspeed_JPI/TS-V3/MODBASE/GAS.MOD

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.