Topspeed_JPI/TS/MODBASE/INVOICEP.MOD

IMPLEMENTATION MODULE InvoicePrint;
(*
 *  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 PMIScreens,Today,TodayStr,
     TodayDays,Config,NormalTitle;
FROM PriceTable IMPORT ClearGrpCnt,AddGrp,GrpTotal,GetPrice,
     GetPriceTable;
FROM DBFSalesrec IMPORT SalesRec,SalesrecDBF,SalesRecIdx,MoveSalesrecToDBF,
     MoveSalesrecFromDBF,OpenSalesrecDBF,CloseSalesrecDBF;
FROM DBIndxes IMPORT FindPositionCh,CurrentRec;
FROM ModBase3 IMPORT AppendBlank,ReadDBRec,WriteDBRec;
FROM ScrnUtl1 IMPORT FieldNum;
FROM DBStuff IMPORT MakeKey;
FROM InputManager IMPORT ControlFrame;
FROM Customer IMPORT AddressRec,AddCustYTD,GetCustAddr,AddressTypes,
     AddCustOutStd,SetCustLastInvDate;
FROM DateFunctions IMPORT DateToStr;
FROM DBFOrder IMPORT OrderRec,InvnbrIdx,OrderDBF,MoveOrderFromDBF;
FROM PosUtils IMPORT Equal,Pos;
FROM StrEdit IMPORT CrunchBlanks,DeleteRightJustified,Append,
     CAPstr,OverWrite,RightJustify,Center;
FROM StrConv IMPORT CardinalToStr,RealToStr,StrToReal;
FROM M2Strings IMPORT Length,Assign,Concat;
FROM Gas IMPORT CheckOutGas,CheckInGas,DeleteGasFromInv;
FROM LowLevel IMPORT Fill;
FROM DBStuff IMPORT MakeSeqNbr,FindAll,ReadAllRecs,
              ConditionType,ChangeDateField,DeleteAllRecs;
FROM DBUtils IMPORT ReadCardField,ReadRealField,ReadDateField,
             ChangeCardField,ChangeRealField,PrintFrame;
FROM ScrnTypes IMPORT AFrameName;	
FROM NumTypes IMPORT Real8;
FROM StringIO IMPORT PrintMessage,ErrorMessage,WriteEol,WriteStr;
(* these next two are from stonybrook - the pmi version doesn't work*)
FROM Prompts IMPORT Prompt,PromptStr,PromptYN;
FROM SYSTEM IMPORT ADR,SIZE,TSIZE,ADDRESS,BYTE;
FROM HandleIO IMPORT FileExists,OpenFile,CloseHandle,BlockWrite;
FROM GenLists IMPORT GenList, NewList,ListLength,GetElmt,ElmtNow,GetElmtAdr,
     JoinLists,ListDelete,ListInsert,DisposeList,ShellSortList;
FROM DBFInvoice IMPORT InvoiceDBF, OpenInvoiceDBF,InvoiceIdx,
     CloseInvoiceDBF,InvoiceRec,FindInvoiceByInvoice,CustidIdx,
     FindInvoiceByCustid,NextInvoice,PrevInvoice,InvoiceDBF,
     FirstInvoice,LastInvoice,MoveInvoiceToDBF,MoveInvoiceFromDBF;
FROM Invoice IMPORT InvoiceItem,FInvoice,Credit,GasOut,GasIn,
      InvoiceHeadDF,OrderItemDF,CurrentInvoice,CurrInvOldAmt,OrderItemLst,
      SummaryDF,CurrentItem,HeaderChanged,Recompute,Special,ReadHeader;


(***********************************************************************
 invoices are stored with the invoice number indexed and the
   customer number indexed.

   The customer number is indexed  as
     Customer Number + Status
       Where status =
         'O'  - Open - not yet printed so can be edited
	 'P'  - Posted (printed ) - can not be editied but can be viewes
	 'C'  - Invoice is closed  i.e. paid off
	
      Item Status = 'R' - Items still recorded	
                    'D' - Items deleted
		
********************************************************************)  		




PROCEDURE PostSales(InvNbr : ARRAY OF CHAR);
(* go through the invoice and add items to inventory sales history*)
VAR
  J : CARDINAL;
  Key : ARRAY[0..15] OF CHAR;
  Found : BOOLEAN;
  Sales : SalesRec;
  Size,Code : CARDINAL;
  TheList : GenList;
  Item    : OrderRec;
  RecNbr  : LONGINT;
BEGIN
  RETURN;  (* * * * * * * * * * *TEMP FIX * * * * * * * * * * *)
  NewList(TheList);
  CrunchBlanks(InvNbr);
  FindAll(InvnbrIdx,InvNbr,EQ,TheList);  (* get items ordered *)

  OpenSalesrecDBF(TRUE);
  FOR J := 1 TO ListLength(TheList) DO
    GetElmt(TheList,J,RecNbr,Code);
    ReadDBRec(OrderDBF,RecNbr);
    MoveOrderFromDBF(Item);
    IF NOT Special(Item.ITEMNBR)
      THEN
        Assign( Item.ITEMNBR,Key );
        FindPositionCh(SalesRecIdx,Key,Found);
	IF Found
	  THEN
	    ReadDBRec(SalesrecDBF,CurrentRec(SalesRecIdx));
	    MoveSalesrecFromDBF(Sales);	
	    Sales.Sold[Today.mo] := Sales.Sold[Today.mo] +
	                             Item.QNTSOLD;
	    MoveSalesrecToDBF(Sales);
	  ELSE
	    AppendBlank(SalesrecDBF);
	    Fill(ADR(Sales),SIZE(Sales),0);
	    Sales.Sold[Today.mo] := Item.QNTSOLD;	
	    Assign(   Item.ITEMNBR,Sales.ITEMNBR );
	    MoveSalesrecToDBF(Sales);
	  END;
	WriteDBRec(SalesrecDBF);
     END; (* end if not special order *)	
   END; (* end of loop *)
   DisposeList(TheList);
   CloseSalesrecDBF();
END PostSales;


PROCEDURE PrintInvoice(PkgSlipOnly : BOOLEAN);
CONST
  Blank = '                              ';
  LinesPerPage = 32;
VAR
  Str : ARRAY[0..100] OF CHAR;
  CurrentPage : CARDINAL;
  CurrentLine : CARDINAL;
  TotalPages  : CARDINAL;
  NextFrame : AFrameName;
  BufCnt : CARDINAL;
  FF     : BYTE;
  Prt : CARDINAL;
  R   : Real8;
  J   : CARDINAL;
  EM : ErrorMessage;
  Size,Code : CARDINAL;
  ShipTo,BillTo : AddressRec;
  TmpTotal : Real8;

PROCEDURE NbrOfPages() : CARDINAL;
(* calculate the number of pages for the invoice *)
VAR J : CARDINAL;
    Lines : CARDINAL;
    Size,Code : CARDINAL;
    Tmp : ARRAY[0..80] OF CHAR;
    PgNbr : CARDINAL;
PROCEDURE CountNoteLines();
BEGIN

      CrunchBlanks(CurrentInvoice.NOTE1);
      IF Length(CurrentInvoice.NOTE1) > 1
        THEN INC(Lines);
	END;
      CrunchBlanks(CurrentInvoice.NOTE2);
      IF Length(CurrentInvoice.NOTE2) > 1
        THEN INC(Lines);
	END;
      CrunchBlanks(CurrentInvoice.NOTE3);
      IF Length(CurrentInvoice.NOTE3) > 1
        THEN INC(Lines);
	END;
END CountNoteLines;
BEGIN
  Lines := 1; (**)
   PgNbr := 1;
  IF (CurrentInvoice.NOTESFOR = 'B')
     THEN CountNoteLines();
  ELSIF ((CurrentInvoice.NOTESFOR='P') AND PkgSlipOnly)
     THEN CountNoteLines();
  ELSIF ((CurrentInvoice.NOTESFOR='I') AND NOT PkgSlipOnly)
     THEN CountNoteLines();
  END;

  FOR J := 1 TO ListLength(OrderItemLst) DO
    INC(Lines);
    IF Lines > LinesPerPage
      THEN
        INC (PgNbr);
	Lines := 1;
      END;	
    GetElmtAdr(OrderItemLst,J,CurrentItem,Size,Code);
    CrunchBlanks(CurrentItem^.ItemOrderRec.NOTES1);
    CrunchBlanks(CurrentItem^.ItemOrderRec.NOTES2);
    CrunchBlanks(CurrentItem^.ItemOrderRec.NOTES3);
    IF Length(CurrentItem^.ItemOrderRec.NOTES1 ) > 1
      THEN
        INC(Lines);
      END;	
    IF Length(CurrentItem^.ItemOrderRec.NOTES2) > 1
     THEN
      INC(Lines);
     END;
    IF Length(CurrentItem^.ItemOrderRec.NOTES3) > 1
      THEN
        INC(Lines);
      END;
  END;	 (* end for j *)
(*  Lines := Lines + 5; (* net, tax, discount, total *)*)
  RETURN PgNbr;
END NbrOfPages;

PROCEDURE PrintLine(Item : OrderRec; PksOnly : BOOLEAN);

VAR
  Line : ARRAY[0..120] OF CHAR;

BEGIN
  INC(CurrentLine);      (* increment line counter *)
  Fill(ADR(Line),102,' ');
  RealToStr(Item.QNTSOLD,2,8,Str);
  RightJustify(Str,8);
(*  CrunchBlanks(Str); *)
  OverWrite(Str,Line,0);
  OverWrite(Item.UNITS,Line,8);
  OverWrite(Item.ITEMNBR,Line,14);
  OverWrite(Item.DESC,Line,23);
  IF NOT PksOnly
    THEN
      RealToStr(Item.UNITPRC,2,6,Str);
      RightJustify(Str,6);
      OverWrite(Str,Line,78);
      RealToStr(Item.TOTAL,2,6,Str);
      RightJustify(Str,7);
      OverWrite(Str,Line,88);
      Line[96] := 0C;
    ELSE
      Line[79] := 0C;
    END;
  WriteEol(Prt,Line);
  CrunchBlanks(Item.NOTES1);
  CrunchBlanks(Item.NOTES2);
  CrunchBlanks(Item.NOTES3);
  IF Item.NOTES1[0] > 0C  (* notes exist *)
     THEN
       WriteStr(Prt,Blank);
       WriteEol(Prt,Item.NOTES1);
       INC(CurrentLine);
     IF Item.NOTES2[0] > 0C
       THEN
        WriteStr(Prt,Blank);
        WriteEol(Prt,Item.NOTES2);
	INC(CurrentLine);
        IF Item.NOTES3[0] > 0C
	  THEN
	   WriteStr(Prt,Blank);
           WriteEol(Prt,Item.NOTES3);	
	   INC(CurrentLine);
	 END;
       END;
    END;   	
END PrintLine;

PROCEDURE PrintPkgSlpHeader();
VAR J : CARDINAL;
   Str2 : ARRAY[0..10] OF CHAR;
BEGIN
  Assign( Config.CompanyName,Str );
  Center(Str,80);
  OverWrite(TodayStr,Str,64);
  WriteEol(Prt,Str);
  Fill(ADR(Str),SIZE(Str),' ');

  Assign( Config.CompanyAddr1,Str );
  Center(Str,80);
  CardinalToStr(CurrentPage,2,Str2);
  INC(CurrentPage);
  OverWrite('Page ',Str,60);
  OverWrite(Str2,Str,65);
  OverWrite('OF ',Str,67);
  CardinalToStr(TotalPages,2,Str2);
  OverWrite(Str2,Str,70);
  WriteEol(Prt,Str);

  Fill(ADR(Str),SIZE(Str),' ');

  Assign( Config.CompanyAddr2,Str );
  Center(Str,80);
  OverWrite(CurrentInvoice.CUSTID,Str,64);
  WriteEol(Prt,Str);

  Assign( Config.Phone,Str );
  Center(Str,80);
  WriteEol(Prt,Str);
  Assign( TodayStr,Str );
  Center(Str,80);
  WriteEol(Prt,Str);
  WriteEol(Prt,'');
  WriteEol(Prt,'');
  WriteEol(Prt,'');
  Fill(ADR(Str),SIZE(Str),' ');
  Str[79] := 0C;
  OverWrite('SHIP TO: ',Str,10);
  FOR J := 0 TO 3 DO
    OverWrite(ShipTo.Line[J],Str,20);
    WriteEol(Prt,Str);
    Fill(ADR(Str),SIZE(Str),' ');
    Str[79] := 0C;
  END;
  WriteEol(Prt,'');
  WriteEol(Prt,'');
  WriteEol(Prt,'');

  WriteStr(Prt,'Ship VIA: ');
  WriteStr(Prt,CurrentInvoice.SHIPVIA);
  WriteStr(Prt,'  FF = ');
  WriteStr(Prt,CurrentInvoice.FREEFRGHT);
  WriteStr(Prt,'Terms: ');
  WriteStr(Prt,CurrentInvoice.TERMS);
  WriteEol(Prt,'');
  WriteStr(Prt,'Invoice Number: ');
  WriteStr(Prt,CurrentInvoice.INVOICE);
  WriteEol(Prt,'');
  WriteEol(Prt,'');

END PrintPkgSlpHeader;

PROCEDURE PrintHeader();
CONST
  err = 'ASCII ERROR';
VAR
     Tmp : ARRAY[0..10] OF CHAR;
     B : BOOLEAN;
     J  : CARDINAL;
     TLines : CARDINAL;
     Str2,
     CPI12,
     CPIPana : ARRAY[0..10] OF CHAR;
     Str : ARRAY[0..120] OF CHAR;
BEGIN
  Concat(CHR(27),':',CPI12);
  Concat(CHR(27),CHR(15),CPIPana);
   Str := err;
 WriteStr(Prt,CPI12);
 CurrentLine := 1;
 IF PkgSlipOnly
   THEN
     WriteStr(Prt,CPIPana);
     PrintPkgSlpHeader();
     RETURN;
   END;
 Fill(ADR(Str),SIZE(Str),' ');
 Str[95] := 0C;
 WriteEol(Prt,'');
 DateToStr(CurrentInvoice.INVDATE,Str2,B);
 OverWrite(Str2,Str,75);
 WriteEol(Prt,Str);
 Fill(ADR(Str),SIZE(Str),' ');
 CardinalToStr(CurrentPage,2,Str2);
 OverWrite(Str2,Str,76);
 INC(CurrentPage);
 OverWrite('OF ',Str,79);
 TLines := TotalPages;
 CardinalToStr(TLines,2,Str2);
(* CardinalToStr(TotalPages,2,Str[70..73]);*)
 OverWrite(Str2,Str,82);
 Str[96] := 0C;
 WriteEol(Prt,Str);
 Fill(ADR(Str),SIZE(Str),' ');
 Str[96] := 0C;
 OverWrite(CurrentInvoice.CUSTID,Str,76);
 WriteEol(Prt,Str);

 WriteEol(Prt,'');
 WriteEol(Prt,'');
 WriteEol(Prt,'');
 WriteEol(Prt,'');
 WriteEol(Prt,'');
 FOR J := 0 TO 3 DO
   Fill(ADR(Str),SIZE(Str),' ');
   OverWrite(BillTo.Line[J],Str,15);
   OverWrite(ShipTo.Line[J],Str,66);
   Str[94] := 0C;
   WriteEol(Prt,Str);
 END;

 FOR J := 1 TO 5 DO
   WriteEol(Prt,'');
 END;
 Fill(ADR(Str),SIZE(Str),' ');
 Str[95] := 0C;
 DateToStr(CurrentInvoice.INVDATE,Str2,B);
 OverWrite(Str2,Str,0);
 OverWrite(CurrentInvoice.CUSTPO,Str,10);
 OverWrite(Str2,Str,23);
 OverWrite(CurrentInvoice.SALESMAN,Str,33);
 OverWrite(CurrentInvoice.TERMS,Str,42);
 OverWrite(CurrentInvoice.SHIPVIA,Str,63);
 OverWrite(CurrentInvoice.INVOICE,Str,88);
 WriteEol(Prt,Str);
 FOR J := 1 TO 4 DO
   WriteEol(Prt,'');
 END;

END PrintHeader;



PROCEDURE WriteHeaderNotes();
VAR
 TmpStr : ARRAY[0..30] OF CHAR;

BEGIN
      IF Length(CurrentInvoice.NOTE1) > 1
        THEN
          WriteStr(Prt,Blank);
          WriteEol(Prt,CurrentInvoice.NOTE1);
	  INC(CurrentLine);
	END;
      IF Length(CurrentInvoice.NOTE2) > 1
        THEN
          WriteStr(Prt,Blank);
          WriteEol(Prt,CurrentInvoice.NOTE2);
	  INC(CurrentLine);
	END;	
        IF Length(CurrentInvoice.NOTE3) > 1
        THEN
          WriteStr(Prt,Blank);
          WriteEol(Prt,CurrentInvoice.NOTE3);
	  INC(CurrentLine);
	END;	
END WriteHeaderNotes;

VAR
  TmpStr : ARRAY[0..10] OF CHAR;


BEGIN (* print invoice *)
  TotalPages :=NbrOfPages();
  IF CurrentInvoice.INVPRNT # 'O'
    THEN
      IF NOT PromptYN('WARNING Invoice already posted - Continue (y/n)?',InvoiceHeadDF)
        THEN
          RETURN
	ELSE
	 IF CurrentInvoice.HELIUM = 'Y'
          THEN
	    DeleteGasFromInv(CurrentInvoice.INVOICE);
	  END;
	 R := - CurrInvOldAmt;
	 AddCustYTD(R);  (* subtract the value from invoice prior to  *)
       END;	
    END;	
  GetCustAddr(BillTo,Billing);
  GetCustAddr(ShipTo, Shipping);
  IF PkgSlipOnly
     THEN  EM := OpenFile(Prt,Config.PksSlipPrt)  (* which printer *)
     ELSE

       EM := OpenFile(Prt,Config.InvoicePrt);
       CurrentInvoice.INVPRNT := 'P';  (* printed/posted *)
       CurrentInvoice.AMTOUT := CurrentInvoice.TOTALAMT;
       HeaderChanged := TRUE;
       IF CurrentInvoice.AMTOUT = 0.0
         THEN IF PromptYN('Zero Invoice Amount - close invoice ',InvoiceHeadDF)
	   THEN CurrentInvoice.INVPRNT := 'C';
	   END;
	 END;
       AddCustOutStd(CurrentInvoice.AMTOUT);	
       SetCustLastInvDate(CurrentInvoice.INVDATE);

       (*CurrentInvoice.INVDATE := Today;    invoice date = date printed *)
       AddCustYTD(CurrentInvoice.INVNET);  (* update YTD Amount *)
       CurrInvOldAmt := CurrentInvoice.INVNET;
       IF (CurrentInvoice.SHIPPING = 0.0 ) AND (CurrentInvoice.FREEFRGHT # 'Y')
         THEN
           R := - CurrentInvoice.AMTOUT;
	   AddCustOutStd(R);
	   ControlFrame(InvoiceHeadDF,FieldNum(InvoiceHeadDF,'Shipping'),'',FALSE,NextFrame);
	   ReadHeader();
	   Recompute();  (* get shipping charge *)
           CurrentInvoice.AMTOUT := CurrentInvoice.TOTALAMT;	   	


	 END;
      AddCustOutStd(CurrentInvoice.AMTOUT);	
  END;
  CurrentPage := 1;
  CurrentLine := 1;
  PrintHeader();
  IF (CurrentInvoice.NOTESFOR = 'B')
    THEN WriteHeaderNotes();
  ELSIF ((CurrentInvoice.NOTESFOR = 'P') AND PkgSlipOnly)
    THEN WriteHeaderNotes();
  ELSIF  ((CurrentInvoice.NOTESFOR = 'I') AND NOT PkgSlipOnly)
    THEN WriteHeaderNotes();
  END;

  FOR J := 1 TO ListLength(OrderItemLst) DO
    IF((CurrentLine  MOD  LinesPerPage) = 0)
      THEN
         FF := 0C;
         EM := BlockWrite(Prt,ADR(FF),1);
         PrintHeader()
      END;
     GetElmtAdr(OrderItemLst,J,CurrentItem,Size,Code);  (* get the item*)
     PrintLine(CurrentItem^.ItemOrderRec,PkgSlipOnly);
     IF NOT PkgSlipOnly
       THEN
         IF Pos(GasOut,CurrentItem^.ItemOrderRec.ITEMNBR) = 0
	   THEN
	     CurrentInvoice.HELIUM := 'Y';
	     CheckOutGas(CurrentInvoice.CUSTID,CurrentInvoice.INVOICE,
	                 CurrentItem^.ItemOrderRec.ITEMNBR,
	                 TRUNC(CurrentItem^.ItemOrderRec.QNTSOLD),
			 CurrentInvoice.INVDATE);
	   ELSIF Pos(GasIn,CurrentItem^.ItemOrderRec.ITEMNBR) = 0
	     THEN
	       CurrentInvoice.HELIUM := 'Y';	
	       CheckInGas(CurrentInvoice.CUSTID,CurrentInvoice.INVOICE,
	                  CurrentItem^.ItemOrderRec.ITEMNBR,
	                  TRUNC(CurrentItem^.ItemOrderRec.QNTSOLD),
			  CurrentInvoice.INVDATE);
 	     END;		  		
        END;
   END;
   IF NOT PkgSlipOnly
     THEN
       WriteEol(Prt,'');

       Fill(ADR(Str),SIZE(Str)-2,' ');

       OverWrite('========',Str,88);
       WriteEol(Prt,Str);
       Fill(ADR(Str),SIZE(Str)-2,' ');
       OverWrite('Net',Str,40);
       TmpTotal := CurrentInvoice.INVNET / (1.0 - (CurrentInvoice.INVDSCNT/100.0));

       RealToStr(TmpTotal,2,8,TmpStr);
       OverWrite(Str,TmpStr,87);
       WriteEol(Prt,Str);

       IF CurrentInvoice.INVDSCNT > 0.0
         THEN
           Fill(ADR(Str),SIZE(Str)-2,' ');
           OverWrite('Discount @',Str,40);
           RealToStr(CurrentInvoice.INVDSCNT ,1,4,TmpStr);
           OverWrite(Str,TmpStr,51);
           OverWrite('%',Str,56);
	   IF Str[55] = 0C
	     THEN
	       Str[55] := ' ';
	     END;
	   RealToStr((-1.0 * TmpTotal * CurrentInvoice.INVDSCNT/100.0 ),
	             2,8,TmpStr);
           OverWrite(TmpStr,Str,87);	
	   WriteEol(Prt,Str);
	 END;
	
      IF (CurrentInvoice. TAXABLE = 'Y')
        THEN
           Fill(ADR(Str),SIZE(Str)-2,' ');
           OverWrite('Tax ',Str,40);
	   RealToStr(CurrentInvoice.INVTAX,2,8,TmpStr);
	   OverWrite(TmpStr,Str,87);
	   WriteEol(Prt,Str);
	
	END;

       IF CurrentInvoice.SHIPPING > 0.0
         THEN
	   Fill(ADR(Str),SIZE(Str)-2,' ');
	   OverWrite('Shipping/Handling',Str,40);
	   RealToStr(CurrentInvoice.SHIPPING,2,8,TmpStr);
	   OverWrite(TmpStr,Str,87);
	   WriteEol(Prt,Str);
	 END;
       WriteEol(Prt,'');
       Fill(ADR(Str),SIZE(Str)-2,' ');
       OverWrite('TOTAL DUE',Str,40);
       RealToStr(CurrentInvoice.TOTALAMT,2,8,TmpStr);
       OverWrite(TmpStr,Str,87);
       WriteEol(Prt,Str);	
     END;
     WriteStr(Prt,12C);  (* final form feed *)
   EM := CloseHandle(Prt);

(* if freight = 0.0 and invoice charge freight = y Then prompt for frieght*)

END PrintInvoice;



END InvoicePrint.