| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273 |
- IMPLEMENTATION MODULE IvyReports;
- (*
- * ModBase
- * Release 3.0
- * (c) Copyright 1986 - 1991 PMI
- * P.O. Box 8402
- * Green Bay Wi 53308
- * All Rights Reserved
- * by Ed Ross
- *)
- FROM DBFInvtry IMPORT InvtryRec,OpenInvtryDBF,InvtryDBF,
- CloseInvtryDBF,MoveInvtryFromDBF,InvcodeIdx,FindInvtryByInvcode,
- MoveInvtryToDBF;
- FROM PosUtils IMPORT Equal,Pos;
- FROM PriceTable IMPORT GetPriceTable;
- FROM PMIGlobals IMPORT Today,TodayDays,Config,NormalTitle,
- OpenReportDevice,CloseReportDevice;
- FROM DBUtils IMPORT GetDateRange,PrintFrame,SelectFromScreen,
- GetSelected;
- FROM DBStuff IMPORT MakeKey,FindAll,ReadAllRecs,ConditionType,MakeSeqNbr;
- FROM GenLists IMPORT GenList,ListInsert,DisposeList,
- GetElmt,GetElmtAdr,NewList,ListLength,SortList,ListDelete;
- FROM StrConv IMPORT RealToStr,CardinalToStr;
- FROM StrEdit IMPORT CrunchBlanks,DeleteRightJustified,Append,
- CAPstr,OverWrite,RightJustify,Center,SetLength,CutLeadingChars;
- FROM ModBase3 IMPORT ReadDBRec,CloseDBF,WriteDBRec;
- FROM M2Strings IMPORT Length,CompareStr;
- FROM LowLevel IMPORT Fill;
- FROM NumTypes IMPORT Real8;
- IMPORT VWindows;
- 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 ControlUtils IMPORT Control,AddStrField,AddMenuItem;
- FROM Prompts IMPORT Prompt,PromptStr,PromptYN;
- FROM ScrnTypes IMPORT AFrameName, InitDisplayFrame,DisplayFile;
- FROM SYSTEM IMPORT ADDRESS,ADR,SIZE;
- FROM VStorage IMPORT DosAlloc;
- PROCEDURE SortInv(A1 : ADDRESS; Size1 :CARDINAL;
- A2 : ADDRESS; Size2 : CARDINAL): INTEGER;
-
- VAR
- I1, I2 : POINTER TO InvtryRec;
- BEGIN
- I1 := A1;
- I2 := A2;
- RETURN CompareStr(I1^.INVCODE,I2^.INVCODE);
- END SortInv;
- (* # call(reg_param=>(ax,bx,cx,dx,st0,st6,st5,st4,st3) ) *)
- PROCEDURE ReadInvRec(VAR A: ADDRESS; VAR Size : CARDINAL);
- VAR
- InvRec : POINTER TO InvtryRec;
- BEGIN
- Size := SIZE(InvtryRec);
- DosAlloc(InvRec,Size);
- MoveInvtryFromDBF(InvRec^);
- A := InvRec;
- END ReadInvRec;
-
- PROCEDURE TotalInventory();
- VAR
- Str : ARRAY[0..20] OF CHAR;
- InvList : GenList;
- J : CARDINAL;
- Line : ARRAY[0..80] OF CHAR;
- DF : DisplayFrame;
- FieldRec : InputFieldRecord;
- Inventory : InvtryRec;
- Code : CARDINAL;
- Value : Real8;
- Handle : CARDINAL;
- Cost : Real8;
- P1,P2,P3,P4 : Real8;
- Q1,Q2,Q3,Q4 : CARDINAL;
- BEGIN
- Str := '';
- PromptStr('Enter Inventory Code (or partial Code)',Str);
- MakeKey(Str);
- OpenInvtryDBF(TRUE);
- FindAll(InvcodeIdx,Str,BeginsWith,InvList);
- ReadAllRecs(InvtryDBF,ReadInvRec,InvList);
- CloseInvtryDBF();
- InitDisplayFrame(DF,VWindows.CurrentWindow);
- AddStrField(DF,2,2,
- ' Code Description On Hand Purch Price Cost Value ',78);
- GetFieldRec(DF,1,FieldRec);
- FieldRec.typ := DispCode; (* headline = display code *)
- PutFieldRec(FieldRec,DF,1);
- DF^.headline := 2;
- Cost := 0.0;
- Value := 0.0;
- SortList(InvList,SortInv);
- FOR J := 1 TO ListLength(InvList) DO
- GetElmt(InvList,J,Inventory,Code);
- Fill(ADR(Line),SIZE(Line),' ');
- Line[77] := 0C;
- OverWrite(Inventory.INVCODE,Line,1);
- OverWrite(Inventory.DESC,Line,8);
- RealToStr(Inventory.ONHAND,2,8,Str);
- OverWrite(Str,Line,42);
- RealToStr(Inventory.PURPRICE,2,8,Str);
- OverWrite(Str,Line,51);
- RealToStr(Inventory.PURPRICE * Inventory.ONHAND,2,8,Str);
- Cost := Cost + (Inventory.PURPRICE * Inventory.ONHAND);
- OverWrite(Str,Line,61);
- IF Inventory.PRICETBL > 0
- THEN
- GetPriceTable(Inventory.PRICETBL,Q1,Q2,Q3,Q4,Inventory.UNITPRICE,P2,P3,P4);
- (* make up a unit price for value *)
- END;
- RealToStr(Inventory.UNITPRICE * Inventory.ONHAND,2,8,Str);
- Value := Value + (Inventory.UNITPRICE * Inventory.ONHAND);
- OverWrite(Str,Line,70);
- AddMenuItem(DF,2,J+2,Line,78,0,' ');
- END; (* end of for J *)
- DisposeList(InvList);
- ShowDisplayFrame(DF,1,1,80,24);
- Control(DF);
- IF PromptYN(' Print Report ',DF)
- THEN
- Line := 'Inventory Sorted by Item Code';
- NormalTitle(Line);
- Handle := OpenReportDevice();
- PrintFrame(DF,Handle);
- CloseReportDevice(Handle);
- END;
- CloseDisplayFrame(DF);
- DisposeList(InvList);
- END TotalInventory;
- PROCEDURE ReorderInventory();
- VAR
- Str : ARRAY[0..20] OF CHAR;
- InvList : GenList;
- OrderList : GenList;
- LineCnt : CARDINAL;
- J,K : CARDINAL;
- Line : ARRAY[0..80] OF CHAR;
- DF : DisplayFrame;
- Handle : CARDINAL;
- FieldRec : InputFieldRecord;
- Inventory : InvtryRec;
- Code : CARDINAL;
- BEGIN
- Str := '';
- PromptStr('Enter Inventory Code (or partial Code)',Str);
- MakeKey(Str);
- OpenInvtryDBF(TRUE);
- FindAll(InvcodeIdx,Str,BeginsWith,InvList);
- ReadAllRecs(InvtryDBF,ReadInvRec,InvList);
- InitDisplayFrame(DF,VWindows.CurrentWindow);
- AddStrField(DF,2,2,
- 'Code Description Units On Hand On Ord Reorder Qnt ',67);
- GetFieldRec(DF,1,FieldRec);
- FieldRec.typ := DispCode; (* headline = display code *)
- PutFieldRec(FieldRec,DF,1);
- DF^.headline := 2;
- LineCnt := 3;
- J := ListLength(InvList);
- LOOP
- (* FOR J := ListLength(InvList) DOWNTO 1 BY -1 DO *)
- IF J = 0
- THEN EXIT;
- END;
- GetElmt(InvList,J,Inventory,Code); (* Only take those <= reorder level*)
- DEC(J);
- IF (Inventory.STOCKED) AND (TRUNC(Inventory.ONHAND) <= Inventory.REORDER)
- THEN
- Fill(ADR(Line),SIZE(Line),' ');
- Line[78] := 0C;
- OverWrite(Inventory.INVCODE,Line,3);
- OverWrite(Inventory.DESC,Line,11);
- OverWrite(Inventory.UNITS,Line,44);
- RealToStr(Inventory.ONHAND,2,8,Str);
- OverWrite(Str,Line,52);
- OverWrite(Inventory.ONORDER,Line,63);
- RealToStr(Inventory.REORDAMT,2,8,Str);
- OverWrite(Str,Line,70);
- AddMenuItem(DF,2,LineCnt,Line,78,0,Inventory.INVCODE);
- INC(LineCnt);
- (* ELSE
- ListDelete(InvList,J,1); *) (* didn't need to reorder *)
- END; (* end if need to reorder *)
- END; (* end of loop *)
- SelectFromScreen(DF);
- GetSelected(OrderList,DF);
- CloseDisplayFrame(DF);
- InitDisplayFrame(DF,VWindows.CurrentWindow);
- AddStrField(DF,2,2,
- ' Code Units Description Quantity ',67);
- GetFieldRec(DF,1,FieldRec);
- FieldRec.typ := DispCode; (* headline = display code *)
- PutFieldRec(FieldRec,DF,1);
- DF^.headline := 2;
- LineCnt := 3;
- (* go through the order list and find the item in the invlist *)
- (* make printable - and create string fields *)
- J := ListLength(OrderList);
- LOOP
- IF J = 0
- THEN EXIT;
- END;
- GetElmt(OrderList,J,Inventory.INVCODE,Code);
- DEC(J);
- IF FindInvtryByInvcode(Inventory.INVCODE)
- THEN
- Inventory.ONORDER := 'Y';
- MoveInvtryToDBF(Inventory);
- WriteDBRec(InvtryDBF);
- END;
- Fill(ADR(Line),SIZE(Line),' ');
- Line[77] := 0C;
- OverWrite(Inventory.INVCODE,Line,3);
- OverWrite(Inventory.UNITS,Line,11);
- OverWrite(Inventory.DESC,Line,20);
- RealToStr(Inventory.REORDAMT,2,8,Str);
- OverWrite(Str,Line,63);
- AddStrField(DF,2,LineCnt,Line,78);
- INC(LineCnt);
- END; (* end for J *)
- ShowDisplayFrame(DF,1,1,80,24);
- Control(DF);
- IF PromptYN(' Print Report ',DF)
- THEN
- Line := 'Purchase Order Number ';
- MakeSeqNbr('POSEQ',Config.PurchOrdPre,Str);
- Append(Line,Str);
- NormalTitle(Line);
- Handle := OpenReportDevice();
- PrintFrame(DF,Handle);
- CloseReportDevice(Handle);
- END;
- CloseDisplayFrame(DF);
- CloseInvtryDBF();
- DisposeList(InvList);
- DisposeList(OrderList);
- END ReorderInventory;
- END IvyReports.
|