| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328 |
- IMPLEMENTATION MODULE Invoice;
- (*
- * 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,Record;
- FROM Gas IMPORT CheckOutGas,CheckInGas,GasAmountDue,DeleteGasFromInv;
- FROM PMIGlobals IMPORT PMIScreens,Today,TodayStr,TodayDays,Config,
- OpenReportDevice,CloseReportDevice,NormalTitle;
- FROM PriceTable IMPORT ClearGrpCnt,AddGrp,GrpTotal,GetPrice,
- GetPriceTable;
- FROM DateFunctions IMPORT DateToStr,Date,DaysSince1900;
- 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,CompareStr,Assign;
- FROM LowLevel IMPORT Fill;
- FROM DBStuff IMPORT MakeSeqNbr,FindAll,ReadAllRecs,MakeKey,
- ConditionType,ChangeDateField,DeleteAllRecs;
- FROM DBUtils IMPORT ReadCardField,ReadRealField,ReadDateField,
- ChangeCardField,ChangeRealField,PrintFrame;
- FROM NumTypes IMPORT Real8;
- FROM Payments IMPORT MakePayment;
- FROM DBFPayments IMPORT OpenPaymentsDBF,ClosePaymentsDBF;
- FROM Customer IMPORT GetCustNbr,GetCustTerms,GetCustSalesRep,GetCustShipVia,
- GetCustDisAmount,GetCustDisCntLvl,GetCustTaxable,SetCustOutStd,
- GetCustFreeFrght,AddressRec,AddressTypes,GetCustAddr,GetCurrCustName,
- SetCustLastInvDate,AddCustYTD,AddCustOutStd;
- FROM StringIO IMPORT PrintMessage,ErrorMessage,WriteEol,WriteStr;
- (* these next two are from stonybrook - the pmi version doesn't work*)
- FROM SmartScreen IMPORT ClearScreen;
- FROM VWindows IMPORT ClearPart, CurrentWindow, SetCursorHeight;
- 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,RedrawArea;
- FROM InputManager IMPORT ControlFrame;
- FROM FrameManager IMPORT EraseFrame;
- FROM Prompts IMPORT Prompt,PromptStr,PromptYN;
- FROM SYSTEM IMPORT ADR,SIZE,TSIZE,ADDRESS;
- FROM ControlUtils IMPORT ControlSeparately, LoadFrameList,Control,ReadInput,
- ChangeField,AddMenuItem,AddStrField;
- FROM DspFiles IMPORT OpenDisplayFile,ReadDisplayFrame;
- FROM HandleIO IMPORT FileExists,OpenFile,CloseHandle;
- FROM GenLists IMPORT GenList, NewList,ListLength,GetElmt,ElmtNow,GetElmtAdr,
- JoinLists,ListDelete,ListInsert,DisposeList,ShellSortList,SortList,NilList;
- FROM Invtry IMPORT UpdateInvQuant,GeneralInventory;
- FROM DBFInvtry IMPORT InvtryRec,MoveInvtryToDBF,MoveInvtryFromDBF,
- FindInvtryByInvcode,NextInvtry,PrevInvtry,LastInvtry,InvtryDBF,
- InvcodeIdx;
- FROM DBFOrder IMPORT OrderRec,MoveOrderToDBF,MoveOrderFromDBF,OrderDBF,
- InvnbrIdx,OpenOrderDBF,CloseOrderDBF;
- FROM Invtry IMPORT GetInvItem;
- FROM UOpsExt IMPORT Lookup,LookupProc;
- FROM UserOps IMPORT AKeyHandler,TheKeyHandler;
- IMPORT Key;
- FROM VStorage IMPORT DosAlloc,DosDealloc;
- FROM InvoicePrint IMPORT PrintInvoice,PostSales;
- FROM DBFInvoice IMPORT InvoiceDBF, OpenInvoiceDBF,InvoiceIdx,
- CloseInvoiceDBF,InvoiceRec,FindInvoiceByInvoice,CustidIdx,
- FindInvoiceByCustid,NextInvoice,PrevInvoice,InvoiceDBF,
- FirstInvoice,LastInvoice,MoveInvoiceToDBF,MoveInvoiceFromDBF;
- (***********************************************************************
- 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
-
- ********************************************************************)
- VAR
- Status : INTEGER;
- J : CARDINAL;
- NextFrame,EndingFrame : AFrameName;
- SelChar : CHAR;
- PullDnMenu : GenList;
- ItemsChanged : BOOLEAN;
- PROCEDURE SortItemList(Item1 : ADDRESS; Size1 : CARDINAL;
- Item2 : ADDRESS; Size2 : CARDINAL) : INTEGER;
- VAR
- I1,I2 : POINTER TO InvoiceItem;
- BEGIN
- I1 := Item1;
- I2 := Item2;
- RETURN CompareStr(I1^.ItemOrderRec.ITEMNBR,I2^.ItemOrderRec.ITEMNBR);
-
- END SortItemList;
- PROCEDURE UpdateOrderScreen();
- (* redraw just the fields on the screen rather than the entire screen*)
- VAR
- J,K : CARDINAL;
- BEGIN
- K := FieldListTotal(OrderItemDF);
- FOR J := 1 TO K DO
- RedrawField(OrderItemDF,J,(K=1)); (* make first field active field*)
- END;
- END UpdateOrderScreen;
- PROCEDURE UpdateOrd( );
- VAR Str : ARRAY[0..12] OF CHAR;
- BEGIN
- WITH CurrentItem^.ItemOrderRec DO
- ChangeField(OrderItemDF,ITEMNBR,'Item',TRUE);
- RealToStr(TOTAL,2,8,Str);
- ChangeField(OrderItemDF,Str,'Total',TRUE); (* computed field *)
- ChangeRealField(OrderItemDF,QNTSOLD,'Quant');
- ChangeField(OrderItemDF,UNITS,'Units',TRUE); (* alow override *)
- ChangeField(OrderItemDF,DESC,'Desc',TRUE);
- ChangeField(OrderItemDF,NOTES1,'Notes1',TRUE);
- ChangeField(OrderItemDF,NOTES2,'Notes2',TRUE);
- ChangeField(OrderItemDF,NOTES3,'Notes3',TRUE);
- ChangeField(OrderItemDF,MANPRICE,'Override',TRUE);
- ChangeRealField(OrderItemDF,UNITPRC,'UnitPrice');
- END;
- WITH CurrentItem^.InventoryItem DO
- ChangeField(OrderItemDF,GROUP,'Group',TRUE);
- RealToStr(ONHAND,2,8,Str);
- ChangeField(OrderItemDF,Str,'OnHand',TRUE);
- CardinalToStr(MINORDER,5,Str);
- ChangeField(OrderItemDF,Str,'MinOrder',TRUE);
- ChangeCardField(OrderItemDF,PRICETBL,'TableNbr');
- END;
- WITH CurrentItem^ DO
- ChangeCardField(OrderItemDF,Q1,'Q1');
- ChangeCardField(OrderItemDF,Q2,'Q2');
- ChangeCardField(OrderItemDF,Q3,'Q3');
- ChangeCardField(OrderItemDF,Q4,'Q4');
- ChangeRealField(OrderItemDF,P1,'P1');
- ChangeRealField(OrderItemDF,P2,'P2');
- ChangeRealField(OrderItemDF,P3,'P3');
- ChangeRealField(OrderItemDF,P4,'P4');
- END;
- UpdateOrderScreen();
- END UpdateOrd;
- PROCEDURE LookUpInv(VAR ItmCode : ARRAY OF CHAR);
- (* called from userops to lookup an item when the user exists an item
- fields
- This routine will always store the results in the current item
- inventory record *)
- VAR
- Tmp : ARRAY[0..20] OF CHAR;
- PROCEDURE InitOrder();
- BEGIN
- WITH CurrentItem^ DO
- Assign( CurrentInvoice.INVOICE,ItemOrderRec.INVNBR );
- Assign( InventoryItem.INVCODE,ItemOrderRec.ITEMNBR);
- Assign( InventoryItem.DESC,ItemOrderRec.DESC );
- ItemOrderRec.UNITPRC := InventoryItem.UNITPRICE;
- Assign(InventoryItem.UNITS,ItemOrderRec.UNITS );
- ItemOrderRec.MANPRICE := 'N';
- GetPriceTable(InventoryItem.PRICETBL,Q1,Q2,Q3,Q4,P1,P2,P3,P4);
- END;
- END InitOrder;
- BEGIN
- CAPstr(ItmCode);
- IF CurrentItem^.BeenAdded
- THEN
- (* IF NOT Special(ItmCode)
- THEN
- ItmCode := CurrentItem^.ItemOrderRec.INVNBR;
- END; *)
- RETURN
- END;
- IF Special(ItmCode)
- THEN (* credit or special order *)
- Assign( CurrentInvoice.INVOICE,CurrentItem^.ItemOrderRec.INVNBR );
- CurrentItem^.ItemOrderRec.MANPRICE := 'Y';
- Assign(ItmCode,CurrentItem^.ItemOrderRec.ITEMNBR );
- Assign( ItmCode,Tmp);
- UpdateOrd();
- RETURN
- END;
- Assign( ItmCode,Tmp);
- CrunchBlanks(Tmp);
- CrunchBlanks(CurrentItem^.InventoryItem.INVCODE);
- IF Equal(Tmp,CurrentItem^.InventoryItem.INVCODE)
- THEN
- RETURN; (* didn't change the items - so we're ok *)
- END;
- IF FindInvtryByInvcode(Tmp)
- THEN
- MoveInvtryFromDBF(CurrentItem^.InventoryItem);
- CurrentItem^.InventoryFilePos := Record(InvtryDBF);
- InitOrder(); (* re init the display frame *)
- ReadDisplayFrame(PMIScreens,OrderItemDF,'OrderItem');
- UpdateOrd();
- ELSE
- GeneralInventory(ItmCode);
- MoveInvtryFromDBF(CurrentItem^.InventoryItem);
- Assign( CurrentItem^.InventoryItem.INVCODE,ItmCode );
- CurrentItem^.InventoryFilePos := Record(InvtryDBF);
- InitOrder();
- ReadDisplayFrame(PMIScreens,OrderItemDF,'OrderItem');
- ShowDisplayFrame(OrderItemDF,0,0,0,0);
- RedrawArea(InvoiceHeadDF,1,10,80,13);
- UpdateOrd();
- END;
- END LookUpInv;
- PROCEDURE ReadAnInvoice(VAR AddrOfRec : ADDRESS; VAR SizeOfRec: CARDINAL);
- (* a procedure passed to reall all recs to read an invoice record *)
- VAR
- P : POINTER TO FInvoice;
- BEGIN
- SizeOfRec := SIZE(FInvoice);
- DosAlloc(P,SizeOfRec);
- MoveInvoiceFromDBF(P^.Invoice);
- P^.LI := Record(InvoiceDBF);
- AddrOfRec := P;
- END ReadAnInvoice;
- PROCEDURE Special(Item:ARRAY OF CHAR) : BOOLEAN;
- BEGIN
- IF (Pos(Credit,Item) = 0) OR (Pos(SpecialOrd,Item) = 0)
- THEN RETURN TRUE;
- ELSE RETURN FALSE;
- END;
- END Special;
- PROCEDURE ReadScrn();
- VAR
- Str : ARRAY[0..15] OF CHAR;
- B : BOOLEAN;
- BEGIN
- IF NOT OrderItemDF^.FrameChanged (* just looked - nothing changed *)
- THEN
- RETURN;
- END;
- WITH CurrentItem^.ItemOrderRec DO
- ReadInput(OrderItemDF,Str,'Quant');
- B := StrToReal(Str,0,QNTSOLD);
- ReadInput(OrderItemDF,Str,'UnitPrice');
- B := StrToReal(Str,0,UNITPRC);
- ReadInput(OrderItemDF,DESC,'Desc');
- ReadInput(OrderItemDF,UNITS,'Units');
- ReadInput(OrderItemDF,MANPRICE,'Override');
- CAPstr(MANPRICE);
- ReadInput(OrderItemDF,NOTES1,'Notes1');
- ReadInput(OrderItemDF,NOTES2,'Notes2');
- ReadInput(OrderItemDF,NOTES3,'Notes3');
- END;
- END ReadScrn;
- PROCEDURE ReadHeader();
- VAR
- C : CARDINAL;
- R : Real8;
- Str : ARRAY[0..15] OF CHAR;
- BEGIN
- WITH CurrentInvoice DO
- ReadInput(InvoiceHeadDF,CUSTPO,'PONbr');
- ReadInput(InvoiceHeadDF,SALESMAN,'SalesRep');
- ReadInput(InvoiceHeadDF,TERMS,'Terms');
- ReadInput(InvoiceHeadDF,SHIPVIA,'ShipVia');
- ReadInput(InvoiceHeadDF,TAXABLE,'Taxable');
- ReadDateField(InvoiceHeadDF,INVDATE,'InvDate');
- ReadRealField(InvoiceHeadDF,INVDSCNT,'Discount');
- ReadCardField(InvoiceHeadDF,DFLTLVL,'DefaultLevel');
- ReadRealField(InvoiceHeadDF,SHIPPING,'Shipping');
- ReadInput(InvoiceHeadDF,NOTE1,'NOTE1');
- ReadInput(InvoiceHeadDF,NOTE2,'NOTE2');
- ReadInput(InvoiceHeadDF,NOTE3,'NOTE3');
- ReadInput(InvoiceHeadDF,NOTESFOR,'NOTESFOR');
- CAPstr(NOTESFOR);
- END;
- END ReadHeader;
- PROCEDURE UpdateInventory();
- VAR
- Str : ARRAY[0..30] OF CHAR;
- StrNum : ARRAY[0..10] OF CHAR;
- R : Real8;
- BEGIN
- WITH CurrentItem^ DO
- IF Special(ItemOrderRec.ITEMNBR)
- THEN RETURN;
- END;
- ItemOrderRec.QNTORDER := ItemOrderRec.QNTSOLD;
- ReadDBRec(InvtryDBF,InventoryFilePos); (* get uptodate inventory item
- and position the file pointer to the item *)
- IF ItemOrderRec.QNTORDER > InventoryItem.ONHAND
- THEN
- ItemOrderRec.QNTSOLD := InventoryItem.ONHAND;
- RealToStr(ItemOrderRec.QNTORDER - ItemOrderRec.QNTSOLD,2,5,StrNum);
- ItemOrderRec.NOTES1 := 'Short - ';
- Append(ItemOrderRec.NOTES1,StrNum);
- InventoryItem.ONHAND := 0.0;
- IF InventoryItem.STOCKED
- THEN Append(ItemOrderRec.NOTES1,' - Please reorder');
- ELSE ItemOrderRec.NOTES1 := ' -Item no longer stocked'
- END;
- Prompt(ItemOrderRec.NOTES1);
- ELSE
- InventoryItem.ONHAND := InventoryItem.ONHAND - ItemOrderRec.QNTSOLD;
- END;
- END; (* end of with *)
- (* update the inventory record immediately *)
- MoveInvtryToDBF(CurrentItem^.InventoryItem);
- WriteDBRec(InvtryDBF);
- END UpdateInventory;
- PROCEDURE AddItems(VAR Inv : InvoiceRec);
- VAR
- NxtFrame : AFrameName;
- OldLookup : Lookup;
- J : CARDINAL;
- PROCEDURE InsertInList();
- BEGIN
- IF CurrentItem^.BeenAdded
- THEN
- RETURN
- END;
- CurrentItem^.BeenAdded := TRUE;
- IF NOT Special(CurrentItem^.ItemOrderRec.ITEMNBR)
- THEN
- UpdateInventory();
- END; (* if not special*)
- ListInsert(CurrentItem^,2,OrderItemLst,9999); (* insert at end *)
- Recompute();
- END InsertInList;
- PROCEDURE ShowSummary();
- CONST
- Title =
- 'Item Units Quant Description Price Total';
- VAR
- Cnt, LL : CARDINAL;
- Size,Code : CARDINAL;
- Line : ARRAY[0..80] OF CHAR;
- Tmp : ARRAY[0..12] OF CHAR;
- FieldRec : InputFieldRecord;
- (*
- 012345678901234567890123456789012345678901234567890123456789012345678901234
- 0 1 2 3 4 5 6 7
- Item Units Quant Description Price Total
- xxxxxx xxxxx xxx.x xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xxxx.xx xxxxx.xx
- *)
- BEGIN
- Recompute();
- SortList(OrderItemLst,SortItemList);
- InitDisplayFrame(SummaryDF,CurrentWindow);
- AddStrField(SummaryDF,2,2,Title,75);
- GetFieldRec(SummaryDF,1,FieldRec);
- FieldRec.typ := DispCode; (* headline = display code *)
- PutFieldRec(FieldRec,SummaryDF,1);
- SummaryDF^.headline := 2;
- LL := ListLength(OrderItemLst);
- FOR Cnt := 1 TO LL DO
- GetElmtAdr(OrderItemLst,Cnt,CurrentItem,Size,Code);
- Fill(ADR(Line),SIZE(Line),' ');
- Line[78] := 0C; (* force end of line *)
- WITH CurrentItem^.ItemOrderRec DO
- OverWrite(ITEMNBR,Line,0);
- OverWrite(UNITS,Line,8);
- RealToStr(QNTSOLD,1,5,Tmp);
- OverWrite(Tmp,Line,15);
- OverWrite(DESC,Line,22);
- RealToStr(UNITPRC,2,7,Tmp);
- OverWrite(Tmp,Line,58);
- RealToStr(TOTAL,2,7,Tmp);
- OverWrite(Tmp,Line,67);
- AddMenuItem(SummaryDF,2,Cnt+2,Line,78,0,ITEMNBR);
- END; (* end of with *)
- END; (* end of for *)
- ShowDisplayFrame(SummaryDF,1,13,80,24);
- END ShowSummary;
- PROCEDURE InList(ItemCode : ARRAY OF CHAR) : BOOLEAN;
- VAR Tmp : POINTER TO InvoiceItem;
- J : CARDINAL;
- Code,Size : CARDINAL;
- BEGIN
- FOR J := 1 TO ListLength(OrderItemLst) DO
- GetElmtAdr(OrderItemLst,J,Tmp,Size,Code);
- IF Equal(Tmp^.ItemOrderRec.ITEMNBR,ItemCode)
- THEN
- Prompt('Item already in invoice - can not add');
- RETURN TRUE;
- END;
- END; (* end for j *)
- RETURN FALSE;
- END InList;
- BEGIN (* additems *)
- InitDisplayFrame(OrderItemDF,CurrentWindow);
- OldLookup := LookupProc;
- (* call(reg_param=>()) *)
- LookupProc := LookUpInv;
- (* call(reg_param=>(ax,bx,cx,dx,st0,st6,st5,st4,st3)) *)
- ItemsChanged := TRUE;
- REPEAT
- DosAlloc(CurrentItem,SIZE(CurrentItem^));
- Fill(CurrentItem,SIZE(CurrentItem^),0);
- CurrentItem^.BeenAdded := FALSE;
- CurrentItem^.GasPriced := FALSE;
- ReadDisplayFrame(PMIScreens,OrderItemDF,'OrderItem');
- ControlFrame(OrderItemDF,1,'',TRUE,NxtFrame);
- ReadScrn();
- IF CurrentItem^.ItemOrderRec.ITEMNBR[0] > 0C (* F10 pressed not data*)
- THEN (* the f10 key pressed - data on the screen *)
- IF NOT InList(CurrentItem^.ItemOrderRec.ITEMNBR)
- THEN
- InsertInList();
- ELSE
- DosDealloc(CurrentItem,SIZE(CurrentItem^));
- END;
- ELSE (* f10 or Esc key pressed - not data on screen *)
- IF NOT CurrentItem^.BeenAdded (* if blank screen - done*)
- THEN
- NxtFrame := ''; (* blank screen - exit time*)
- DosDealloc(CurrentItem,SIZE(CurrentItem^));
- END;
- END;
- UNTIL NOT Equal(OrderItemDF^.normlnext,NxtFrame);
- LookupProc := OldLookup;
- CloseDisplayFrame(OrderItemDF);
- ShowSummary();
- END AddItems;
- PROCEDURE ShowSummary();
- CONST
- Title =
- 'Item Units Quant Description Price Total';
- VAR
- Cnt, LL : CARDINAL;
- Size,Code : CARDINAL;
- Line : ARRAY[0..80] OF CHAR;
- Tmp : ARRAY[0..12] OF CHAR;
- FieldRec : InputFieldRecord;
- (*
- 012345678901234567890123456789012345678901234567890123456789012345678901234
- 0 1 2 3 4 5 6 7
- Item Units Quant Description Price Total
- xxxxxx xxxxx xxx.x xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xxxx.xx xxxxx.xx
- *)
- BEGIN
- Recompute();
- SortList(OrderItemLst,SortItemList);
- InitDisplayFrame(SummaryDF,CurrentWindow);
- AddStrField(SummaryDF,2,2,Title,75);
- GetFieldRec(SummaryDF,1,FieldRec);
- FieldRec.typ := DispCode; (* headline = display code *)
- PutFieldRec(FieldRec,SummaryDF,1);
- SummaryDF^.headline := 2;
- LL := ListLength(OrderItemLst);
- FOR Cnt := 1 TO LL DO
- GetElmtAdr(OrderItemLst,Cnt,CurrentItem,Size,Code);
- Fill(ADR(Line),SIZE(Line),' ');
- Line[78] := 0C; (* force end of line *)
- WITH CurrentItem^.ItemOrderRec DO
- OverWrite(ITEMNBR,Line,0);
- OverWrite(UNITS,Line,8);
- RealToStr(QNTSOLD,1,5,Tmp);
- OverWrite(Tmp,Line,15);
- OverWrite(DESC,Line,22);
- RealToStr(UNITPRC,2,7,Tmp);
- OverWrite(Tmp,Line,58);
- RealToStr(TOTAL,2,7,Tmp);
- OverWrite(Tmp,Line,67);
- AddMenuItem(SummaryDF,2,Cnt+2,Line,78,0,ITEMNBR);
- END; (* end of with *)
- END; (* end of for *)
- ShowDisplayFrame(SummaryDF,1,13,80,24);
- END ShowSummary;
- PROCEDURE SelectFromSummary();
- (* select an item from the list and put into current item *)
- VAR
- NextFrame : AFrameName;
- K : CARDINAL;
- Size,Code : CARDINAL;
- BEGIN
- ControlFrame(SummaryDF,1,'',FALSE,NextFrame);
- (* CrunchBlanks(NextFrame); *)
- K := 1;
- LOOP
- IF K > ListLength(OrderItemLst)
- THEN EXIT;
- END;
- GetElmtAdr(OrderItemLst,K,CurrentItem,Size,Code);
- IF Equal(NextFrame,CurrentItem^.ItemOrderRec.ITEMNBR)
- THEN EXIT;
- END;
- INC(K);
- END; (* end of loop *)
- CloseDisplayFrame(SummaryDF);
- END SelectFromSummary;
- PROCEDURE Recompute();
- (* go through the list twice
- 1 - count the items in each group
- 2 - get price based on group *)
- VAR
- Total : Real8;
- LL : CARDINAL;
- J : CARDINAL;
- Code,Size : CARDINAL;
- PROCEDURE CreditCompute(VAR ItemOrderRec :OrderRec) : Real8;
- BEGIN
- IF ItemOrderRec.UNITPRC > 0.0 (* credit items are negative *)
- THEN ItemOrderRec.UNITPRC := - ItemOrderRec.UNITPRC;
- END;
- ItemOrderRec.TOTAL := ItemOrderRec.UNITPRC;
- RETURN ItemOrderRec.TOTAL;
- END CreditCompute;
- PROCEDURE GasCompute(VAR ItemOrderRec : OrderRec; VAR GasPriced : BOOLEAN) : Real8;
- BEGIN
- IF ItemOrderRec.MANPRICE = 'Y'
- THEN RETURN ItemOrderRec.TOTAL; (* already priced - *)
- END;
- ItemOrderRec.MANPRICE := 'Y';
- GasAmountDue(CurrentInvoice.CUSTID,
- ItemOrderRec.ITEMNBR,
- TRUNC(ItemOrderRec.QNTSOLD),
- CurrentInvoice.INVDATE,
- ItemOrderRec.TOTAL,
- ItemOrderRec.NOTES1);
- RETURN ItemOrderRec.TOTAL;
- END GasCompute;
- PROCEDURE ComputeNormal() : Real8;
- BEGIN
- WITH CurrentItem^ DO
- IF (InventoryItem.PRICETBL > 0) AND
- (ItemOrderRec.MANPRICE = 'N')
- THEN
- IF InventoryItem.GROUP[0] > 0C (* a group exists *)
- THEN
- ItemOrderRec.UNITPRC := GetPrice(InventoryItem.PRICETBL,
- GrpTotal(InventoryItem.GROUP),
- CurrentInvoice.DFLTLVL);
- ELSE (* price based on this item alone *)
- (* use the qntorder for computing the unit price*)
- ItemOrderRec.UNITPRC := GetPrice(InventoryItem.PRICETBL,
- TRUNC(ItemOrderRec.QNTORDER),
- CurrentInvoice.DFLTLVL);
- END; (* not table priced - *)
- END;
- ItemOrderRec.TOTAL := ItemOrderRec.QNTSOLD * ItemOrderRec.UNITPRC;
- END; (* end with *)
- RETURN CurrentItem^.ItemOrderRec.TOTAL;
- END ComputeNormal;
- BEGIN
- ClearGrpCnt();
- HeaderChanged := TRUE;
- LL := ListLength(OrderItemLst); (* go through the list and add items *)
- FOR J := 1 TO LL DO
- GetElmtAdr(OrderItemLst,J,CurrentItem,Size,Code);
- IF CurrentItem^.InventoryItem.GROUP[0] > 0C (*a group exists *)
- THEN
- AddGrp(CurrentItem^.InventoryItem.GROUP,TRUNC(CurrentItem^.ItemOrderRec.QNTSOLD));
- END;
- CurrentInvoice.INVNET := 0.0;
- END;
- FOR J := 1 TO LL DO (* now compute price *)
- GetElmtAdr(OrderItemLst,J,CurrentItem,Size,Code);
- WITH CurrentItem^ DO
- IF Pos(Credit,ItemOrderRec.ITEMNBR) = 0 (* credit item *)
- THEN
- CurrentInvoice.INVNET := CurrentInvoice.INVNET +
- CreditCompute(ItemOrderRec);
- ELSIF Pos(GasIn,CurrentItem^.ItemOrderRec.ITEMNBR) = 0
- THEN
- CurrentInvoice.INVNET := CurrentInvoice.INVNET +
- GasCompute(ItemOrderRec,GasPriced);
- ELSE
- CurrentInvoice.INVNET := CurrentInvoice.INVNET +
- ComputeNormal();
- END;
- END; (* end with current item *)
- END; (* end for j *)
- CurrentInvoice.INVNET := CurrentInvoice.INVNET * (1.0 - CurrentInvoice.INVDSCNT/100.0);
- CAPstr(CurrentInvoice.TAXABLE);
- IF (CurrentInvoice.TAXABLE = 'Y')
- THEN
- CurrentInvoice.INVTAX := CurrentInvoice.INVNET * (Config.TaxRate/100.0); (* add tax *)
- ELSE
- CurrentInvoice.INVTAX := 0.0;
- END;
- CurrentInvoice.TOTALAMT := CurrentInvoice.INVNET + CurrentInvoice.INVTAX +
- CurrentInvoice.SHIPPING;
- ChangeRealField(InvoiceHeadDF,CurrentInvoice.TOTALAMT,'Total'); (*update header screen*)
- ChangeRealField(InvoiceHeadDF,CurrentInvoice.INVTAX,'Tax');
- ChangeRealField(InvoiceHeadDF,CurrentInvoice.INVNET,'Net');
- RedrawField(InvoiceHeadDF,FieldNum(InvoiceHeadDF,'Tax'),FALSE);
- RedrawField(InvoiceHeadDF,FieldNum(InvoiceHeadDF,'Net'),FALSE);
- RedrawField(InvoiceHeadDF,FieldNum(InvoiceHeadDF,'Total'),FALSE);
- END Recompute;
- PROCEDURE UpdateInvHeader();
- (* update the invoice header and display *)
- BEGIN
- WITH CurrentInvoice DO
- CrunchBlanks(INVOICE);
- ChangeField(InvoiceHeadDF,INVOICE,'InvNbr',TRUE);
- ChangeDateField(InvoiceHeadDF,INVDATE,'InvDate');
- ChangeField(InvoiceHeadDF,SALESMAN,'SalesRep',TRUE);
- ChangeField(InvoiceHeadDF,TERMS,'Terms',TRUE);
- ChangeField(InvoiceHeadDF,SHIPVIA,'ShipVia',TRUE);
- ChangeField(InvoiceHeadDF,TAXABLE,'Taxable',TRUE);
- ChangeRealField(InvoiceHeadDF,INVDSCNT,'Discount');
- ChangeRealField(InvoiceHeadDF,INVTAX,'Tax');
- ChangeRealField(InvoiceHeadDF,INVNET,'Net');
- ChangeRealField(InvoiceHeadDF,SHIPPING,'Shipping');
- ChangeCardField(InvoiceHeadDF,DFLTLVL,'DefaultLevel');
- ChangeRealField(InvoiceHeadDF,TOTALAMT,'Total');
- ChangeField(InvoiceHeadDF,NOTE1,'NOTE1',TRUE);
- ChangeField(InvoiceHeadDF,NOTE2,'NOTE2',TRUE);
- ChangeField(InvoiceHeadDF,NOTE3,'NOTE3',TRUE);
- ChangeField(InvoiceHeadDF,NOTESFOR,'NOTESFOR',TRUE);
- END;
- ShowDisplayFrame(InvoiceHeadDF,0,0,0,0);
- END UpdateInvHeader;
- PROCEDURE GetInvoice(InvNbr : ARRAY OF CHAR);
- (* get the invoice header, get the invoice items, get the inventory items*)
- VAR
- Items : GenList;
- LI : LONGINT;
- J : CARDINAL;
- Code : CARDINAL;
- Tmp : InvoiceItem;
- BEGIN
- NewList(Items); (* get all items *)
- FindAll(InvnbrIdx,InvNbr,EQ,Items);
- FOR J := 1 TO ListLength(Items) DO
- GetElmt(Items,J,LI,Code);
- ReadDBRec(OrderDBF,LI); (* read the record *)
- MoveOrderFromDBF(Tmp.ItemOrderRec);
- IF NOT Special(Tmp.ItemOrderRec.ITEMNBR)
- THEN
- IF NOT FindInvtryByInvcode(Tmp.ItemOrderRec.ITEMNBR)
- THEN Prompt(' could not find inventory');
- ELSE
- MoveInvtryFromDBF(Tmp.InventoryItem);
- Tmp.InventoryFilePos := Record(InvtryDBF);
- END;
- ELSE Fill(ADR(Tmp.InventoryItem ),SIZE(Tmp.InventoryItem),0);
- END;
- Tmp.OldQuant := Tmp.ItemOrderRec.QNTSOLD;
- Tmp.BeenAdded := TRUE;
- Tmp.GasPriced := TRUE;
- GetPriceTable(Tmp.InventoryItem.PRICETBL,Tmp.Q1,Tmp.Q2,Tmp.Q3,Tmp.Q4,
- Tmp.P1,Tmp.P2,Tmp.P3,Tmp.P4);
- ListInsert(Tmp,1,OrderItemLst,1);
- END; (* end for j *)
- ShellSortList(OrderItemLst,SortItemList);
- END GetInvoice;
- PROCEDURE MakeInvoicePrintLine(InvAddr : ADDRESS; VAR Line : ARRAY OF CHAR);
- VAR
- TmpInv : POINTER TO FInvoice;
- B : BOOLEAN;
- Str : ARRAY[0..10] OF CHAR;
- BEGIN
- TmpInv := InvAddr;
- Fill(ADR(Line),70,' ');
- Line[60] := 0C;
- OverWrite(TmpInv^.Invoice.INVOICE,Line,0);
- DateToStr(TmpInv^.Invoice.INVDATE,Str,B);
- OverWrite(Str,Line,10);
- RealToStr(TmpInv^.Invoice.TOTALAMT,2,9,Str);
- OverWrite(Str,Line,20);
- RealToStr(TmpInv^.Invoice.AMTOUT,2,9,Str);
- OverWrite(Str,Line,33);
- OverWrite(TmpInv^.Invoice.INVPRNT,Line,53);
- END MakeInvoicePrintLine;
- PROCEDURE DisplayInvList(TheList : GenList);
- VAR
- Code,Size: CARDINAL;
- K : CARDINAL;
- TmpInv : POINTER TO FInvoice;
- Line : ARRAY[0..80] OF CHAR;
- CustID : ARRAY[0..15] OF CHAR;
- B : BOOLEAN;
- Str : ARRAY[0..10] OF CHAR;
- found : BOOLEAN;
- FieldRec : InputFieldRecord;
- BEGIN
- (*
- 1 2 3 4 5
- 012345678901234567890123456789012345678901234567890123456
- Inv Nbr Inv Date Inv Total Amount Out Status
- *)
- InitDisplayFrame(SummaryDF,CurrentWindow);
- AddStrField(SummaryDF,2,2,
- 'Inv Nbr Inv Date Inv Total Amount Outstanding Status',60);
- GetFieldRec(SummaryDF,1,FieldRec);
- FieldRec.typ := DispCode; (* headline = display code *)
- PutFieldRec(FieldRec,SummaryDF,1);
- SummaryDF^.headline := 2;
- K := ListLength(TheList); (*debug trap *)
- FOR J := 1 TO K DO
- GetElmtAdr(TheList,J,TmpInv,Size,Code);
- MakeInvoicePrintLine(TmpInv,Line);
- AddMenuItem(SummaryDF,2,J+2,Line,60,0,TmpInv^.Invoice.INVOICE);
- END; (* end of for *)
- ShowDisplayFrame(SummaryDF,1,13,80,24);
- END DisplayInvList;
- PROCEDURE SelectInvoiceFromList(VAR TheList : GenList; ReadInvtry : BOOLEAN);
- (* returns the selected invoice in current invoice *)
- (* assumes summary df already set up *)
- VAR NextFrame : AFrameName;
- Size,Code : CARDINAL;
- found : BOOLEAN;
- K : CARDINAL;
- TmpInv : POINTER TO FInvoice;
- BEGIN
- ControlFrame(SummaryDF,1,'',TRUE,NextFrame);
- K := 1;
- found := TRUE;
- CrunchBlanks(NextFrame);
- LOOP
- IF K > ListLength(TheList)
- THEN
- (* Prompt('Could not find invoice '); *)
- found := FALSE;
- EXIT;
- END;
- GetElmtAdr(TheList,K,TmpInv,Size,Code);
- CrunchBlanks(TmpInv^.Invoice.INVOICE);
- IF Equal(TmpInv^.Invoice.INVOICE,NextFrame)
- THEN EXIT;
- END;
- INC(K);
- END; (* end of loop *)
- CloseDisplayFrame(SummaryDF);
- IF found
- THEN
- ReadDBRec(InvoiceDBF,TmpInv^.LI); (* read the selected item *)
- CurrentInvoice := TmpInv^.Invoice; (* make current invoice *)
- IF CurrentInvoice.INVPRNT = 'P'
- THEN
- CurrInvOldAmt := CurrentInvoice.INVNET; (* if they reprint *)
- ELSE
- CurrInvOldAmt := 0.0; (* keep the ytd amount correct*)
- END;
- IF ReadInvtry (* if this call from select invoice to update*)
- THEN
- UpdateInvHeader();
- GetInvoice(CurrentInvoice.INVOICE);
- ShowSummary();
- END;
- ELSE
- CurrentInvoice.INVOICE := '';
- END;
- END SelectInvoiceFromList;
- PROCEDURE SelectInvoice( );
- (* this routine will select from the set of invoices owned by a customer
- and return the invoice number of the selected - If esc is hit then no
- invoice is selected *)
- VAR
- SelList : GenList;
- PrnList : GenList;
- J,K : CARDINAL;
- Code,Size: CARDINAL;
- TmpInv : POINTER TO FInvoice;
- CustID : ARRAY[0..15] OF CHAR;
- B : BOOLEAN;
- found : BOOLEAN;
- BEGIN
- GetCustNbr(CustID); (* get the open invoice *)
- Append(CustID,'O'); (* only get the open ones *)
- MakeKey(CustID);
- NilList(SelList);
- FindAll(CustidIdx,CustID,EQ,SelList);
- ReadAllRecs(InvoiceDBF,ReadAnInvoice,SelList);
- GetCustNbr(CustID); (* get all of the printed ones *)
- Append(CustID,'P');
- MakeKey(CustID);
- NilList(PrnList);
- FindAll(CustidIdx,CustID,EQ,PrnList);
- ReadAllRecs(InvoiceDBF,ReadAnInvoice,PrnList);
- JoinLists(PrnList,SelList,1); (* join the two lists - all outstanding*)
- IF ListLength(SelList) = 0
- THEN Prompt('No open invoices');
- CurrentInvoice.INVOICE := '';
- DisposeList(SelList);
- RETURN;
- END;
- DisplayInvList(SelList);
- SelectInvoiceFromList(SelList,TRUE);
- DisposeList(SelList);
- END SelectInvoice;
- PROCEDURE InvoiceHistory();
- VAR
- PrnList : GenList;
- CustID : ARRAY[0..15] OF CHAR;
- B : BOOLEAN;
- J : CARDINAL;
- Code,Size : CARDINAL;
- TotalDue : Real8;
- P :POINTER TO FInvoice;
- Title1 : ARRAY[0..80] OF CHAR;
- Handle : CARDINAL;
- BEGIN
- OpenInvoiceDBF(TRUE);
- GetCustNbr(CustID); (* get all of the printed ones *)
- NilList(PrnList);
- FindAll(CustidIdx,CustID,BeginsWith,PrnList);
- ReadAllRecs(InvoiceDBF,ReadAnInvoice,PrnList);
- IF ListLength(PrnList) = 0
- THEN Prompt('No invoice History');
- DisposeList(PrnList);
- RETURN;
- END;
- DisplayInvList(PrnList);
- Control(SummaryDF);
- IF PromptYN(' Print the report ',SummaryDF)
- THEN
- GetCurrCustName(Title1);
- Append(Title1,' - Invoice History ');
- Handle := OpenReportDevice();
- NormalTitle(Title1);
- PrintFrame(SummaryDF,Handle);
- CloseReportDevice(Handle);
- END;
- DisposeList(PrnList);
- CloseInvoiceDBF();
- END InvoiceHistory;
- PROCEDURE DeleteInvItems(InvNbr : ARRAY OF CHAR);
- VAR TheList : GenList;
- BEGIN
- CrunchBlanks(InvNbr);
- NilList(TheList);
- FindAll(InvnbrIdx,InvNbr,EQ,TheList); (* get old invoices *)
- IF ListLength(TheList) > 0 (* some invoice have zero items from conversion*)
- THEN
- DeleteAllRecs(OrderDBF,TheList);
- END;
- DisposeList(TheList);
- END DeleteInvItems;
- PROCEDURE InvoiceDaysLate(InvAddr : ADDRESS) : CARDINAL;
- (* return the nubmer of days late for an invoice*)
- VAR
- TodaysDays,
- InvoiceDays :CARDINAL;
- InvPoint : POINTER TO FInvoice;
- BEGIN
- InvPoint := InvAddr;
- InvoiceDays := DaysSince1900(InvPoint^.Invoice.INVDATE);
- RETURN (InvoiceDays - TodaysDays);
- END InvoiceDaysLate;
- PROCEDURE GetOutstanding(CustID : ARRAY OF CHAR; VAR TheList:GenList);
- BEGIN
- (* assumes the database is open *)
- Append(CustID,'P');
- NilList(TheList);
- FindAll(CustidIdx,CustID,EQ,TheList);
- ReadAllRecs(InvoiceDBF,ReadAnInvoice,TheList);
- END GetOutstanding;
- PROCEDURE PayInvoice();
- VAR
- PrnList : GenList;
- CustID : ARRAY[0..15] OF CHAR;
- PymtDF : DisplayFrame;
- ManualPay : BOOLEAN;
- FldRec : InputFieldRecord;
- PymtAmount : Real8;
- Remaining : Real8;
- B : BOOLEAN;
- CheckNbr : ARRAY[0..10] OF CHAR;
- PymtDate : Date;
- J : CARDINAL;
- Code,Size : CARDINAL;
- TotalDue : Real8;
- P :POINTER TO FInvoice;
- BEGIN
- OpenInvoiceDBF(TRUE);
- GetCustNbr(CustID); (* get all of the printed ones *)
- Append(CustID,'P');
- NilList(PrnList);
- FindAll(CustidIdx,CustID,EQ,PrnList);
- ReadAllRecs(InvoiceDBF,ReadAnInvoice,PrnList);
- IF ListLength(PrnList) = 0
- THEN Prompt('No outstanding invoices');
- DisposeList(PrnList);
- RETURN;
- END;
- TotalDue := 0.0;
- FOR J := 1 TO ListLength(PrnList) DO (* zip through and get total out*)
- GetElmtAdr(PrnList,J,P,Code,Size);
- TotalDue := TotalDue + P^.Invoice.AMTOUT;
- END;
- InitDisplayFrame(PymtDF,CurrentWindow);
- ReadDisplayFrame(PMIScreens,PymtDF,'Pymts');
- GetFieldRec(PymtDF,FieldNum(PymtDF,'PymtAmt'),FldRec); (* make max amout*)
- FldRec.rMax := TotalDue;
- FldRec.decimalPlace := 2;
- PutFieldRec(FldRec,PymtDF,FieldNum(PymtDF,'PymtAmt'));
- SetCustOutStd(TotalDue);
- ChangeField(PymtDF,TodayStr,'PymtDate',TRUE);
- ShowDisplayFrame(PymtDF,0,0,0,0);
- DisplayInvList(PrnList);
- Control(PymtDF);
- (* if the user selected manual payments *)
- (* then select which invoice to pay *)
- (* otherwise select invoices until payments *)
- (* reach zero *)
-
- ReadInput(PymtDF,CheckNbr,'ChkNumber');
- ReadRealField(PymtDF,PymtAmount,'PymtAmt');
- ReadDateField(PymtDF,PymtDate,'PymtDate');
- GetFieldRec(PymtDF,FieldNum(PymtDF,'Manual'),FldRec);
- SetCustOutStd(TotalDue-PymtAmount);
- OpenPaymentsDBF(TRUE);
- OpenOrderDBF(TRUE);
- REPEAT (* loop through here until the full payment is used *)
- (* can not enter a payment greater than total due *)
-
- IF FldRec.selected (* manual invoice entry *)
- THEN
- SelectInvoiceFromList(PrnList,FALSE); (* take selected *)
- IF CurrentInvoice.INVOICE[0] = 0C (* nothing selected *)
- THEN
- GetElmtAdr(PrnList,1,P,Size,Code); (* or take the first *)
- CurrentInvoice := P^.Invoice;
- ReadDBRec(InvoiceDBF,P^.LI); (* set the file to correct invoice*)
- PymtAmount := 0.0;
- END;
- ELSE
- GetElmtAdr(PrnList,1,P,Size,Code); (* or take the first *)
- CurrentInvoice := P^.Invoice;
- ReadDBRec(InvoiceDBF,P^.LI); (* set the file to correct invoice*)
- END;
- ListDelete(PrnList,ElmtNow(PrnList),1);(* delete the chosen invoice from the list *)
- Remaining := PymtAmount - CurrentInvoice.AMTOUT;
- IF PymtAmount >= CurrentInvoice.AMTOUT
- THEN
- MakePayment(CurrentInvoice.INVOICE,PymtDate,CurrentInvoice.AMTOUT,
- CheckNbr,CurrentInvoice.CUSTID);
- CurrentInvoice.AMTOUT := 0.0; (* pay in full *)
- CurrentInvoice.INVPRNT := 'C'; (* closed *)
- PostSales(CurrentInvoice.INVOICE);
- DeleteInvItems(CurrentInvoice.INVOICE);
- ELSE
- MakePayment(CurrentInvoice.INVOICE,PymtDate,PymtAmount,
- CheckNbr,CurrentInvoice.CUSTID);
- CurrentInvoice.AMTOUT := CurrentInvoice.AMTOUT - PymtAmount;
- IF CurrentInvoice.AMTOUT < 0.01 (* rounding remainder *)
- THEN
- CurrentInvoice.AMTOUT := 0.0;
- CurrentInvoice.INVPRNT := 'C'; (* close *)
- PostSales(CurrentInvoice.INVOICE);
- DeleteInvItems(CurrentInvoice.INVOICE);
- END;
- END;
- MoveInvoiceToDBF(CurrentInvoice);
- WriteDBRec(InvoiceDBF);
- IF FldRec.selected AND (Remaining > 0.01) (* manual invoice entry *)
- THEN
- DisplayInvList(PrnList); (* display remaining invoice *)
- END;
- PymtAmount := Remaining;
- UNTIL (PymtAmount < 0.01); (* go through until out of money *)
- CloseDisplayFrame(PymtDF);
- ClosePaymentsDBF();
- CloseOrderDBF();
- IF NOT FldRec.selected
- THEN (* remove for automatic payments *)
- CloseDisplayFrame(SummaryDF);
- END;
- DisposeList(PrnList);
- CloseInvoiceDBF();
- END PayInvoice;
- PROCEDURE CancelInvoice();
- VAR
- CustID : ARRAY[0..10] OF CHAR;
- TheList : GenList;
- J : CARDINAL;
- Size,Code : CARDINAL;
- BEGIN
- FOR J := 1 TO ListLength(OrderItemLst) DO
- GetElmtAdr(OrderItemLst,J,CurrentItem,Size,Code);
- IF NOT Special(CurrentItem^.ItemOrderRec.ITEMNBR)
- THEN
- CurrentItem^.InventoryItem.ONHAND :=
- CurrentItem^.InventoryItem.ONHAND+CurrentItem^.ItemOrderRec.QNTSOLD;
- CurrentItem^.ItemOrderRec.QNTSOLD := 0.0;
- UpdateInventory();
- END;
- END;
- DeleteGasFromInv(CurrentInvoice.INVOICE);
- DeleteInvItems(CurrentInvoice.INVOICE);
- CurrentInvoice.INVPRNT := 'X';
- HeaderChanged := TRUE;
- END CancelInvoice;
- PROCEDURE SaveInvoice();
- (* save the invoice header - replace if one is already there*)
- VAR
- BEGIN
- IF NOT HeaderChanged
- THEN RETURN;
- END;
- IF NOT FindInvoiceByInvoice(CurrentInvoice.INVOICE)
- THEN
- AppendBlank(InvoiceDBF);
- END;
- MoveInvoiceToDBF(CurrentInvoice);
- WriteDBRec(InvoiceDBF);
- END SaveInvoice;
- PROCEDURE SaveItems();
- (* go through the items list and save the items
- Then go through the inventory list and update the
- inventory records
- *)
- VAR
- OldList : GenList;
- TmpItem : OrderRec;
- Code: CARDINAL;
- L : LONGINT;
- J, Size,LL : CARDINAL;
- K : CARDINAL;
- Inv : InvtryRec;
- BEGIN
- IF NOT ItemsChanged (* if nothing changed - dont resave the items*)
- THEN
- DisposeList(OrderItemLst);
- RETURN;
- END;
- NewList(OldList); (* first delete any existing entries *)
- (* find the position of the inventory item id in the record *)
- (* so I can adjust the inventory amount by the deleted record *)
- (* must do this in the case of the update changing the quanity *)
- DeleteInvItems(CurrentInvoice.INVOICE);
- (* now update with the new entries *)
- LL := ListLength(OrderItemLst);
- FOR J := 1 TO LL DO
- GetElmtAdr(OrderItemLst,J,CurrentItem,Size,Code);
- AppendBlank(OrderDBF);
- MoveOrderToDBF(CurrentItem^.ItemOrderRec);
- WriteDBRec(OrderDBF);
- END;
- END SaveItems;
- PROCEDURE AddInvoice();
- VAR
- Weekday,mmddyy : ARRAY[0..15] OF CHAR;
- BEGIN
- CurrInvOldAmt := 0.0;
- Fill(ADR(CurrentInvoice),SIZE(CurrentInvoice),0);
- GetCustNbr(CurrentInvoice.CUSTID);
- GetCustSalesRep(CurrentInvoice.SALESMAN);
- GetCustTerms(CurrentInvoice.TERMS);
- GetCustShipVia(CurrentInvoice.SHIPVIA);
- GetCustDisCntLvl(CurrentInvoice.DFLTLVL);
- GetCustTaxable(CurrentInvoice.TAXABLE);
- GetCustFreeFrght(CurrentInvoice.FREEFRGHT);
- IF CurrentInvoice.DFLTLVL < 0
- THEN CurrentInvoice.DFLTLVL := 1
- ELSIF CurrentInvoice.DFLTLVL > 3
- THEN CurrentInvoice.DFLTLVL := 3;
- END;
- GetCustDisAmount(CurrentInvoice.INVDSCNT);
- MakeSeqNbr('Invoice',Config.InvoicePre,CurrentInvoice.INVOICE);
- CrunchBlanks(CurrentInvoice.INVOICE);
- CurrentInvoice.INVDATE := Today;
- CurrentInvoice.INVPRNT := 'O'; (* invoice opened *)
- NewList(OrderItemLst);
- UpdateInvHeader();
- HeaderChanged := TRUE;
- AddItems(CurrentInvoice); (* get inventory items *)
- END AddInvoice;
- PROCEDURE ControlInvoice( CtlType : CHAR);
- VAR InvNbr : ARRAY[0..10] OF CHAR;
- FldNum : CARDINAL;
- FldRec : InputFieldRecord;
- CtrlInv : BOOLEAN;
- Size, Code : CARDINAL;
- BEGIN
- CtrlInv := TRUE;
- HeaderChanged := FALSE;
- ItemsChanged := FALSE;
- NewList(OrderItemLst);
- InitDisplayFrame(InvoiceHeadDF,CurrentWindow);
- ReadDisplayFrame(PMIScreens,InvoiceHeadDF,'InvHeader');
- OpenOrderDBF(TRUE);
- OpenInvoiceDBF(TRUE);
- IF (CtlType # 'N')
- THEN SelectInvoice(); (* always select one if not new *)
- IF CurrentInvoice.INVOICE[0] = 0C
- THEN RETURN (* no open invoice *)
- END;
- ELSE AddInvoice();
- END;
- IF (CtlType = 'C')
- THEN CancelInvoice();
- CtrlInv := FALSE;
- END;
- (* CASE CtlType OF
- |'P' : PrintPkg( InvNbr);
- |'I' : PrintInv(InvNbr);
- |'C' : CancellInv(InvNbr);
- END; *)
- IF CtrlInv
- THEN
- NewList(PullDnMenu);
- LoadFrameList(PMIScreens,'InvoiceMain',PullDnMenu);
- REPEAT
- NextFrame := 'InvoiceMain';
- ControlSeparately(PullDnMenu,NextFrame,SelChar,EndingFrame);
- CASE SelChar OF
- 'H' : ShowDisplayFrame(InvoiceHeadDF,0,0,0,0); (* show bottom part *)
- Control(InvoiceHeadDF); (* edit header *)
- ReadHeader();
- Recompute();
- UpdateInvHeader();
- ShowDisplayFrame(SummaryDF,0,0,0,0);
- |'E' : SelectFromSummary();
- InitDisplayFrame(OrderItemDF,CurrentWindow);
- ReadDisplayFrame(PMIScreens,OrderItemDF,'OrderItem');
- ShowDisplayFrame(OrderItemDF,0,0,0,0);
- FldNum := FieldNum(OrderItemDF,'Item');
- ItemsChanged := TRUE; (* make sure to update the items*)
- GetFieldRec(OrderItemDF,FldNum,FldRec);
- FldRec.typ := 'D'; (* make display field *)
- PutFieldRec(FldRec,OrderItemDF,FldNum);
- UpdateOrd();
- CurrentItem^.OldQuant := CurrentItem^.ItemOrderRec.QNTSOLD;
- ControlFrame(OrderItemDF,2,'',FALSE,NextFrame);
- ReadScrn();
- IF NOT Special(CurrentItem^.ItemOrderRec.ITEMNBR)
- THEN
- IF CurrentItem^.OldQuant <> CurrentItem^.ItemOrderRec.QNTSOLD
- THEN
- CurrentItem^.InventoryItem.ONHAND :=
- CurrentItem^.InventoryItem.ONHAND+
- CurrentItem^.OldQuant;
- CurrentItem^.ItemOrderRec.NOTES1 := ''; (* zero out back orer*)
- CurrentItem^.ItemOrderRec.NOTES2 := '';
- CurrentItem^.ItemOrderRec.NOTES3 := '';
- UpdateInventory();
- END;
- CloseDisplayFrame(OrderItemDF);
- END;
- ShowSummary();
- |'V' : SelectFromSummary(); (* view items *)
- ShowSummary();
- |'A' : CloseDisplayFrame(SummaryDF);
- AddItems(CurrentInvoice);
- |'D' : SelectFromSummary();
- GetElmtAdr(OrderItemLst,ElmtNow(OrderItemLst),CurrentItem,Size,Code);
-
- IF NOT Special(CurrentItem^.ItemOrderRec.ITEMNBR)
- THEN
- CurrentItem^.InventoryItem.ONHAND :=
- CurrentItem^.InventoryItem.ONHAND+CurrentItem^.ItemOrderRec.QNTSOLD;
- CurrentItem^.ItemOrderRec.QNTSOLD := 0.0;
- UpdateInventory();
- END;
- ListDelete(OrderItemLst,ElmtNow(OrderItemLst),1);
- ShowSummary();
- ItemsChanged := TRUE;
- |'P' : (*SelectFromSummary(); *)
- PrintInvoice(FALSE);
- |'K' : (* Print Packing slip *)
- (* SelectFromSummary(); *)
- PrintInvoice(TRUE);
- |'C' : IF PromptYN('About to cancel invoice - continue',InvoiceHeadDF)
- THEN
- CancelInvoice ();
- SelChar := 'X';
- END;
-
- END;
-
- UNTIL SelChar='X'; (* Assumes 'X' is only used to exit *)
- END; (* end if control *)
- (* ClearScreen(); *)
- CloseDisplayFrame(InvoiceHeadDF);
- SaveInvoice();
- SaveItems();
- CloseInvoiceDBF();
- CloseOrderDBF();
- END ControlInvoice;
- END Invoice.
|