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.