Topspeed_JPI/TS/MODBASE/PRICETAB.MOD

IMPLEMENTATION MODULE PriceTable;
(*
 *  ModBase
 *  Release 3.0
 *  (c) Copyright 1986 - 1991 PMI
 *  P.O. Box 8402
 *  Green Bay Wi 53308
 *  All Rights Reserved
 *  by Ed Ross  
 *)

FROM NumTypes IMPORT Real8;
FROM Numbers IMPORT Max;
FROM Hash IMPORT HashTable,Define,Dispose,Insert,GetData,KeyFind;
FROM StrConv IMPORT RealToStr,CardinalToStr;
FROM ScrnUtl1 IMPORT GetFieldImageRec;
FROM Tables IMPORT Table,CellValue,GetCell,PutCell,BuildTable,
     DefineTextCol,DefineIntegerCol,DefineRealCol,DefineTable,ControlTable,
     DeleteTable,ShowTable,NumberOfRows;
FROM GenLists IMPORT GenList,ListLength,GetElmtAdr,BlockToList,
     GetElmt, ListInsertAdr,NewList,DisposeList,ListInsert,ShellSortList;
FROM StringIO IMPORT ErrorMessage,NoError,WriteEol,WriteStr,outp;
FROM PosUtils IMPORT Equal,Present,Pos;
FROM Prompts IMPORT PromptStr,PromptYN;
FROM M2Strings IMPORT Length,CompareStr,Assign;
FROM StrEdit IMPORT CAPstr,CrunchBlanks,Append,SetLength,AssignStr,LowerStr,
     DeleteRightJustified,CAPstr;
FROM ControlUtils IMPORT AddMenuItem,ChangeField,ReadInput,Control;
FROM FramePainter IMPORT ShowDisplayFrame;
FROM InputManager IMPORT ControlFrame;
FROM ScrnTypes IMPORT InitDisplayFrame,DisplayFrame,AFrameName,ImageElement;
FROM ScrnUtl2 IMPORT CloseDisplayFrame;
FROM LowLevel IMPORT Fill;
FROM SYSTEM IMPORT TSIZE,ADR,ADDRESS;
IMPORT VWindows;
FROM VStorage IMPORT DosAlloc,DosDealloc;
IMPORT InitCompilerMods;
FROM HandleIO IMPORT FileExists, OpenFile,CreateFile,CloseHandle,
     BlockRead,BlockWrite;

TYPE
  PriceTblItem = RECORD
    Quantity : ARRAY[1..4] OF CARDINAL;
    Price    : ARRAY[1 ..4] OF Real8;
    Desc     : ARRAY[0..30] OF CHAR;
  END;



VAR
   DF : DisplayFrame;
   Tab : Table;
   Initialized : BOOLEAN;
   SerList : GenList;
   FileName : ARRAY[0..20] OF CHAR;
   Card : CARDINAL;
   EM : ErrorMessage;
   Code,J : CARDINAL;
   Bool : BOOLEAN;
   PriceTbl : POINTER TO ARRAY[0..26] OF PriceTblItem;

    GroupCnt : POINTER TO  ARRAY[1..20] OF CARDINAL;
    NxtGrp : CARDINAL;    (* next assigned index into array *)
    GrpTab : HashTable;

(* pricing is done on a sliding scale depending on the number of items
   purchased.  The item count is summed on the group level not the
   SKU level at the inventory level *)



PROCEDURE ClearGrpCnt();
(* this procedure will clear out the group count table for a
   recompute *)
BEGIN
    Fill(GroupCnt,SIZE(GroupCnt^),0);

END ClearGrpCnt;

PROCEDURE GrpTotal(Grp : ARRAY OF CHAR) : CARDINAL;
VAR
  Index : CARDINAL;
BEGIN
  IF KeyFind(GrpTab,Grp)
    THEN
      GetData(GrpTab,Index);
      RETURN GroupCnt^[Index];
    ELSE
      RETURN 0;
  END;

END GrpTotal;

PROCEDURE AddGrp(Grp : ARRAY OF CHAR; AddAmt : CARDINAL);
VAR Index : CARDINAL;
BEGIN

  IF KeyFind(GrpTab,Grp)
    THEN
      GetData(GrpTab,Index);
      GroupCnt^[Index] := GroupCnt^[Index] + AddAmt;
    ELSE
      Insert(GrpTab,Grp,NxtGrp);
      GroupCnt^[NxtGrp] := AddAmt;
      INC(NxtGrp);
   END;

END AddGrp;

PROCEDURE InitGrp();
BEGIN
  NxtGrp := 1;
  Define(GrpTab,100,2);
  DosAlloc(GroupCnt,SIZE(GroupCnt^));
  ClearGrpCnt();
END InitGrp;

(*   Table should look like this
1234567890123456789012345678901234567890123456789012345678901234567890123456
         1         2         3         4         5         6         7
 Nbr  Min 1  Price 1  Min 2  Price 2  Min 3  Price 3  Min 4  Price 4  Desc
 xx   xxxxx  xxxx.xx  xxxxx  xxxx.xx  xxxxx  xxxx.xx  xxxxx  xxxx.xx  xxxxxxxxxxxxxxxxxxxxxx
         *)	


PROCEDURE SetupTable();
BEGIN

   DefineTable(Tab,'Price Table');
   DefineTextCol(Tab,3,2,'Nbr',TRUE);

   DefineIntegerCol(Tab,7,6,'Min 1',0,9999);
   DefineRealCol(Tab,14,8,'Price 1',0.0,9999.99);

   DefineIntegerCol(Tab,23,6,'Min 2',0,99999);
   DefineRealCol(Tab,30,8,'Price 2',0.0,9999.99);

   DefineIntegerCol(Tab,39,6,'Min 3',0,99999);
   DefineRealCol(Tab,46,8,'Price 3',0.0,9999.99);

   DefineIntegerCol(Tab,55,6,'Min 4',0,99999);
   DefineRealCol(Tab,62,8,'Price 4',0.0,9999.99);


   DefineTextCol(Tab,71,20,'Desc',FALSE);

END SetupTable;






    			
PROCEDURE GetPriceTbl();

(* return a list of all products *)
VAR
  H : CARDINAL;
  EM : ErrorMessage;
  Size : CARDINAL;
  J : CARDINAL;
BEGIN

  J := SIZE(PriceTbl^);
  DosAlloc(PriceTbl,SIZE(PriceTbl^));
  IF FileExists('Price.tbl')
    THEN
      EM := OpenFile(H,'Price.Tbl');
      EM := BlockRead(H,PriceTbl,SIZE(PriceTbl^));
      EM := CloseHandle(H);
    ELSE
       Fill(PriceTbl,SIZE(PriceTbl^),0);

   END;
END GetPriceTbl;





PROCEDURE DefinePriceTbl();
VAR
 H : CARDINAL;
   EM : CARDINAL;
  J : CARDINAL;
  Cell : CellValue;
  Row  : CARDINAL;
  Str : ARRAY [0..5] OF CHAR;
  Nbr : ARRAY[0..4] OF CHAR;
  Size,Code : CARDINAL;
BEGIN
 IF NOT Initialized
    THEN
      InitGrp();
      GetPriceTbl();
      Initialized := TRUE;
    END;
  WriteEol(outp,'..This may take a few minutes .. standby..');
  SetupTable();
  BuildTable(Tab,26);  (* increase table size by *)
  FOR Row := 1 TO 25 DO

    CardinalToStr(Row,3,Nbr);
    Assign( Nbr,Cell.Str);
    PutCell(Tab,1,Row,Cell);     (* indexed *)


    Cell.I := PriceTbl^[Row].Quantity[1];	(* min 1 *)
    PutCell(Tab,2,Row,Cell);
    Cell.R := PriceTbl^[Row].Price[1];  (* min price *)
    PutCell(Tab,3,Row,Cell);

    Cell.I := PriceTbl^[Row].Quantity[2];	(* min 2 *)
    PutCell(Tab,4,Row,Cell);
    Cell.R := PriceTbl^[Row].Price[2];  (* min price *)
    PutCell(Tab,5,Row,Cell);

    Cell.I := PriceTbl^[Row].Quantity[3];	(* min 3 *)
    PutCell(Tab,6,Row,Cell);
    Cell.R := PriceTbl^[Row].Price[3];  (* min price *)
    PutCell(Tab,7,Row,Cell);

    Cell.I := PriceTbl^[Row].Quantity[4];	(* min 3 *)
    PutCell(Tab,8,Row,Cell);
    Cell.R := PriceTbl^[Row].Price[4];  (* min price *)
    PutCell(Tab,9,Row,Cell);


    Assign(PriceTbl^[Row].Desc,Cell.Str);
    PutCell(Tab,10,Row,Cell);


  END;
  ControlTable(Tab,2,5,79,20);
  (* now read the table in and save values *)
  FOR Row := 1 TO 25 DO
    GetCell(Tab,2,Row,Cell);
    PriceTbl^[Row].Quantity[1] := Cell.I;
    GetCell(Tab,3,Row,Cell);
    PriceTbl^[Row].Price[1] := Cell.R;

    GetCell(Tab,4,Row,Cell);
    PriceTbl^[Row].Quantity[2] := Cell.I;
    GetCell(Tab,5,Row,Cell);
    PriceTbl^[Row].Price[2] := Cell.R;

    GetCell(Tab,6,Row,Cell);
    PriceTbl^[Row].Quantity[3] := Cell.I;
    GetCell(Tab,7,Row,Cell);
    PriceTbl^[Row].Price[3] := Cell.R;

    GetCell(Tab,8,Row,Cell);
    PriceTbl^[Row].Quantity[4] := Cell.I;
    GetCell(Tab,9,Row,Cell);
    PriceTbl^[Row].Price[4] := Cell.R;


    GetCell(Tab,10,Row,Cell);
    Assign( Cell.Str,PriceTbl^[Row].Desc);
  END;
(* now save the price table in the file *)
  DeleteTable(Tab);
  IF NOT FileExists('Price.Tbl')
    THEN EM := CreateFile(H,'Price.tbl');
    ELSE EM := OpenFile(H,'Price.tbl');
    END;
  EM := BlockWrite(H,PriceTbl,SIZE(PriceTbl^));
  EM := CloseHandle(H);


END DefinePriceTbl;

PROCEDURE GetPrice(Line : CARDINAL; Quantity : CARDINAL;
           StartAtLvl : CARDINAL) : Real8;
VAR
  ItemCnt : CARDINAL;	
BEGIN
 IF NOT Initialized
    THEN
      GetPriceTbl();
      Initialized := TRUE;
    END;
  IF ((Line = 0 ) OR (Line > 25))
    THEN RETURN 0.0
    END;
  IF StartAtLvl < 1
    THEN
      StartAtLvl := 1;
    END;
  IF StartAtLvl > 4
    THEN
      StartAtLvl := 4;
    END;
     (* get either the actual count or the count for the quantity specified*)
  ItemCnt := Max(Quantity,PriceTbl^[Line].Quantity[StartAtLvl]);
  IF ItemCnt < PriceTbl^[Line].Quantity[2]
    THEN RETURN PriceTbl^[Line].Price[1]
    ELSIF ItemCnt < PriceTbl^[Line].Quantity[3]
        THEN RETURN PriceTbl^[Line].Price[2]
    ELSIF ItemCnt < PriceTbl^[Line].Quantity[4]
        THEN RETURN PriceTbl^[Line].Price[3]
    ELSE RETURN PriceTbl^[Line].Price[4];
  END;
END GetPrice;

PROCEDURE GetPriceTable(TblNbr : CARDINAL;
            VAR Q1,Q2,Q3,Q4 : CARDINAL;
	    VAR P1,P2,P3,P4 : Real8);
	
(* return the price table for a line
   so the invoice routine can display *)	
BEGIN
 IF (TblNbr = 0) OR (TblNbr > 25)
   THEN
     P1 := 0.0;
     P2 := 0.0;
     P3 := 0.0;
     P4 := 0.0;
     Q1 := 0;
     Q2 := 0;
     Q3 := 0;
     Q4 := 0;
     RETURN;
   END;
   Q1 := PriceTbl^[TblNbr].Quantity[1];
   Q2 := PriceTbl^[TblNbr].Quantity[2];
   Q3 := PriceTbl^[TblNbr].Quantity[3];
   Q4 := PriceTbl^[TblNbr].Quantity[4];
   P1 := PriceTbl^[TblNbr].Price[1];
   P2 := PriceTbl^[TblNbr].Price[2];
   P3 := PriceTbl^[TblNbr].Price[3];
   P4 := PriceTbl^[TblNbr].Price[4];
END GetPriceTable;	

PROCEDURE InitializePrice();
BEGIN
  GetPriceTbl();
  InitGrp();
  Initialized := TRUE;
END InitializePrice;



BEGIN

  Initialized := FALSE;

END PriceTable.