Topspeed_JPI/TS/MODBASE/INVTRY.MOD

IMPLEMENTATION MODULE Invtry;
(*
 *  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;
FROM DBIndxes IMPORT  CurrentRec;
FROM PMIGlobals IMPORT PMIScreens;
FROM DBStuff IMPORT MakeKey;
FROM FrameManager IMPORT EraseFrame;
FROM Scrn2DBF IMPORT FrameToDBF, DBFToFrame;
FROM PosUtils IMPORT Equal;
FROM ScrnUtl2 IMPORT CloseDisplayFrame;
FROM StrEdit IMPORT CrunchBlanks,DeleteRightJustified,CAPstr,AssignStr;
FROM M2Strings IMPORT Length;
FROM StrConv IMPORT StrToReal;
FROM LowLevel IMPORT Fill;
FROM StringIO IMPORT PrintMessage,WriteStr,WriteEol,outp;
(* these next two are from stonybrook - the pmi version doesn't work*)
FROM EnvironUtils IMPORT ReadEnvironment;
FROM SmartScreen IMPORT ClearScreen;
FROM VWindows IMPORT ClearPart, CurrentWindow, SetCursorHeight;
FROM ScrnTypes IMPORT DisplayFrame,InitDisplayFrame,AFrameName,
      ContinueInput,CancelInput,SubmitInput;
FROM FramePainter IMPORT ShowDisplayFrame;
FROM InputManager IMPORT ControlFrame;
FROM Prompts IMPORT Prompt,PromptStr,PromptYN;
FROM SYSTEM IMPORT ADR,SIZE;
FROM ControlUtils IMPORT ControlSeparately, LoadFrameList,Control,ReadInput;
FROM DspFiles IMPORT ReadDisplayFrame;
FROM HandleIO IMPORT FileExists;
FROM LowLevel IMPORT Fill;
FROM GenLists IMPORT GenList, NewList,ListLength,GetElmt,DisposeList;
FROM ScrnTypes IMPORT AFrameName, InitDisplayFrame,DisplayFile;
FROM DBFInvtry IMPORT InvtryDBF, OpenInvtryDBF,
     CloseInvtryDBF,FixInvRec,InvtryRec,MoveInvtryToDBF,MoveInvtryFromDBF,
     FindInvtryByInvcode, FindInvtryByOrderfrm, NextInvtry,
     PrevInvtry,FirstInvtry,LastInvtry,InvcodeIdx;
IMPORT InitCompilerMods;
FROM NumTypes IMPORT Real8;
FROM UOpsExt IMPORT Lookup,LookupProc;
FROM UserOps IMPORT AKeyHandler,TheKeyHandler;
IMPORT Key;

VAR
 Status : INTEGER;
 Environ : ARRAY [0..60] OF CHAR;
 J : CARDINAL;
 TopMenu : GenList;
 FirstTime: BOOLEAN;
 NextFrame,EndingFrame : AFrameName;
 SelChar    : CHAR;
 NoData     : BOOLEAN;    (* true when no data is on the screen *)
 InvtryDF : DisplayFrame;
 PullDnMenu  : GenList;
 CurrentDF  : DisplayFrame;   (* used with lookup *)
 LookUpOk   : BOOLEAN;
 InitInvtry : BOOLEAN;




PROCEDURE LookUpInvty(VAR Key : ARRAY OF CHAR);
(* this routine will be called to lookup the database item
   and fill in the blanks *)
VAR
  Inv : InvtryRec;
  CKey : ARRAY[0..10] OF CHAR;
  B    : BOOLEAN;
BEGIN
  CAPstr(Key);
  AssignStr(Key,CKey);
  MakeKey(CKey);
  IF NOT FindInvtryByInvcode(CKey)
    THEN
      GeneralInventory(CKey)
    END;
  AssignStr(Key,CKey);
  LookUpOk := TRUE;

  DBFToFrame(InvtryDBF,CurrentDF);  (* fill in the frame and update*)
  ShowDisplayFrame(CurrentDF,0,0,0,0);
END LookUpInvty;

PROCEDURE UpdateInvQuant(InvtryNbr : ARRAY OF CHAR; ChangeAmt: Real8);
(* add the change amount to the on hand amount.  The change amount could
   be positive or negative *)

END UpdateInvQuant;



PROCEDURE AddInvBatch();
(* take the value from the screen and add to the inventory record*)
(* used when new orders come in *)
VAR
  OldLookup : Lookup;
  FrameName : AFrameName;
  AddStr    : ARRAY[0..10] OF CHAR;
  AddAmt    : Real8;
  B : BOOLEAN;
  InvRec : InvtryRec;
BEGIN
  OldLookup := LookupProc;  (* save old lookup proc *)
  LookupProc :=LookUpInvty;
  InitDisplayFrame(CurrentDF,CurrentWindow);
  REPEAT
    ReadDisplayFrame(PMIScreens,CurrentDF,'InvAdd');
    ShowDisplayFrame(CurrentDF,0,0,0,0);
    ControlFrame(CurrentDF,0,'',FALSE,FrameName);
    IF NOT LookUpOk
      THEN
        Prompt('Item not found ');
      ELSE
         ReadInput(CurrentDF,AddStr,'AddAmt');
	 B := StrToReal(AddStr,0,AddAmt);
         B := FrameToDBF(InvtryDBF,CurrentDF);
	 MoveInvtryFromDBF(InvRec);
	 InvRec.ONHAND := InvRec.ONHAND + AddAmt;
	 InvRec.ONORDER := 'N';
	 MoveInvtryToDBF(InvRec);
         WriteDBRec(InvtryDBF);
     END;	
   UNTIL NOT Equal(FrameName,'InvAdd');
   CloseDisplayFrame(CurrentDF);
   LookupProc := OldLookup;
END AddInvBatch;

PROCEDURE CtlKeyHandler(FrameRec : DisplayFrame; VAR LastKey : CARDINAL;
          VAR NextFrame : AFrameName);
VAR
B : BOOLEAN;


BEGIN
   NextFrame := ContinueInput;
   CASE LastKey OF
     Key.PgUp      : B:= PrevInvtry();
    |Key.PgDn     :  B:= NextInvtry();
    |Key.CtrlPgDn :  LastInvtry();
    |Key.CtrlPgUp :  FirstInvtry();	
    |Key.Escape   :  NextFrame := CancelInput;
    |Key.Return   :  NextFrame := SubmitInput;
    ELSE
   END;    	
   IF NOT (LastKey = Key.Escape)   (* update the display *)
     THEN
       DBFToFrame(InvtryDBF,FrameRec);
       ShowDisplayFrame(FrameRec,0,0,0,0);
     END;

END CtlKeyHandler;


PROCEDURE GetInvItem( VAR InvItem : InvtryRec): BOOLEAN;
(* this routine controls the problems associated with not finding
   the inventory item on a lookup - will allow the user to
   go forward, backward in the inventory records till the
   correct item is found -
   Returns the item in the record
   otherwise returns false     *)
VAR
   OldKeyHandler : AKeyHandler;
   NxtFrame : AFrameName;
    B : BOOLEAN;
BEGIN
  OldKeyHandler := TheKeyHandler;
  TheKeyHandler := CtlKeyHandler;
  InitDisplayFrame(InvtryDF,CurrentWindow);
  ReadDisplayFrame(PMIScreens,InvtryDF,'InvSearch');
  ReadDBRec(InvtryDBF,CurrentRec(InvcodeIdx)); (* get closest rec*)
  DBFToFrame(InvtryDBF,InvtryDF);
  ShowDisplayFrame(InvtryDF,0,0,0,0);
  ControlFrame(InvtryDF,1,'',TRUE,NxtFrame);


  TheKeyHandler := OldKeyHandler;
  B := Equal('SUBMIT',NxtFrame);
  CloseDisplayFrame(InvtryDF);
  IF B
    THEN
      MoveInvtryFromDBF(InvItem);
      RETURN TRUE;
    ELSE
      RETURN FALSE;
  END;
END GetInvItem;


PROCEDURE UpdateInvBatch();
 (* this routine will update the inventory items in a batch mode*)
 (* until the user hits esc key*)
VAR
  OldLookup : Lookup;
  FrameName : AFrameName;
  B : BOOLEAN;
BEGIN
  OldLookup := LookupProc;  (* save old lookup proc *)
  LookupProc :=           LookUpInvty;
  InitDisplayFrame(CurrentDF,CurrentWindow);
  REPEAT
    ReadDisplayFrame(PMIScreens,CurrentDF,'InvUpdate');
    ShowDisplayFrame(CurrentDF,0,0,0,0);
    ControlFrame(CurrentDF,0,'',FALSE,FrameName);
    IF NOT LookUpOk
      THEN
        Prompt('Item not found ');
      ELSE
         B := FrameToDBF(InvtryDBF,CurrentDF);
	 FixInvRec();
         WriteDBRec(InvtryDBF);
     END;
   UNTIL NOT Equal(FrameName,'Update');
   CloseDisplayFrame(CurrentDF);
   LookupProc := OldLookup;
END UpdateInvBatch;        	

PROCEDURE FileMenu(SelChar: CHAR);
VAR
 B : BOOLEAN;
 Str : ARRAY [0..80] OF CHAR;
BEGIN
  CASE SelChar OF
 'A'  : ReadDisplayFrame(PMIScreens,InvtryDF,'Invtry');  (*Clear out any of the fields *)
        ShowDisplayFrame(InvtryDF,0,0,0,0);
        Control(InvtryDF);		(* alow user input *)
        AppendBlank(InvtryDBF);
	B := FrameToDBF(InvtryDBF,InvtryDF); (* do something if couldn't add*)
	FixInvRec();
	WriteDBRec(InvtryDBF);
 |'F' : FirstInvtry();
        DBFToFrame(InvtryDBF,InvtryDF);
	ShowDisplayFrame(InvtryDF,0,0,0,0);
 |'L' : LastInvtry();
        DBFToFrame(InvtryDBF,InvtryDF);
	ShowDisplayFrame(InvtryDF,0,0,0,0);

 |'N' : IF NextInvtry()
          THEN
            DBFToFrame(InvtryDBF,InvtryDF);
  	    ShowDisplayFrame(InvtryDF,0,0,0,0);
	  END;

 |'P' : IF PrevInvtry()
          THEN
            DBFToFrame(InvtryDBF,InvtryDF);
  	    ShowDisplayFrame(InvtryDF,0,0,0,0);
	  END;


 |'I' :   (* The first unused letter in the index name  or 'Q'  *)
        Fill(ADR(Str),SIZE(Str),0);

        PromptStr('Enter Invtry Invcode ',Str);


        CrunchBlanks(Str);
	CAPstr(Str);
        IF NOT FindInvtryByInvcode(Str)
	  THEN
	  END;
        DBFToFrame(InvtryDBF,InvtryDF);
        ShowDisplayFrame(InvtryDF,0,0,0,0);


 |'O' :   (* The first unused letter in the index name  or 'Q'  *)
        Fill(ADR(Str),SIZE(Str),0);

        PromptStr('Enter Invtry Orderfrm ',Str);


        CrunchBlanks(Str);
        IF NOT FindInvtryByOrderfrm(Str)
	  THEN
	   Prompt('Invtry Not Found');
	 ELSE
	   DBFToFrame(InvtryDBF,InvtryDF);
	   ShowDisplayFrame(InvtryDF,0,0,0,0);
	 END;
  END;  (* end of case  *)
END FileMenu;

PROCEDURE EditMenu(SelChar : CHAR);
VAR
 B : BOOLEAN;
 BEGIN
   CASE SelChar OF
   'U' : Control(InvtryDF);
	 B := FrameToDBF(InvtryDBF,InvtryDF);
	 FixInvRec();
         WriteDBRec(InvtryDBF);
  |'D' : IF PromptYN('About to delete inventory ',InvtryDF)
         THEN
           DeleteRecord(InvtryDBF);
           B := NextInvtry();  (* set the index to next - then prev to point to *)
	                (* the correct item *)
	
           FileMenu('P');  (* display the next customer *)
	   NoData := TRUE;
	 END;
   END;
END EditMenu;

PROCEDURE Init();
BEGIN
  NewList(PullDnMenu);
  LoadFrameList(PMIScreens,'InvtryTopMenu',PullDnMenu);
  InitInvtry := TRUE;
END Init;

PROCEDURE GeneralInventory(VAR InvtyCode : ARRAY OF CHAR);
VAR
  Inv : InvtryRec;
  B : BOOLEAN;
BEGIN
  InitDisplayFrame(InvtryDF,CurrentWindow);
  ReadDisplayFrame(PMIScreens,InvtryDF,'Invtry');
  MakeKey(InvtyCode);
  IF InvtyCode[0] = CHR(0)
    THEN FirstInvtry();
    ELSE
     IF NOT NextInvtry()   (* assume already did a find by number *)
       THEN
	  B := PrevInvtry();
        END;
    END;
  DBFToFrame(InvtryDBF,InvtryDF);
  ShowDisplayFrame(InvtryDF,0,0,0,0);
  IF NOT InitInvtry
    THEN Init();
    END;
  NoData := TRUE;
  REPEAT
    NextFrame := 'InvtryTopMenu';
    ControlSeparately(PullDnMenu,NextFrame,SelChar,EndingFrame);
    IF Equal(EndingFrame,'InvtryFileMenu')
         THEN FileMenu(SelChar);
    ELSIF Equal(EndingFrame,'InvtEditMenu')
         THEN EditMenu(SelChar);
    END;

  UNTIL SelChar='X';  (* Assumes  'X' is only used to exit *)
  MoveInvtryFromDBF(Inv);
  AssignStr(Inv.INVCODE,InvtyCode);
  CloseDisplayFrame(InvtryDF);

END GeneralInventory;




PROCEDURE ControlInvtry();
 VAR
  NextFrame : AFrameName;
  Str : ARRAY[0..10] OF CHAR;
  DF : DisplayFrame;
BEGIN
  ClearScreen();
  InitDisplayFrame(DF,CurrentWindow);

  OpenInvtryDBF(TRUE);

  REPEAT
    ReadDisplayFrame(PMIScreens,DF,'InvtryMain');
    ControlFrame(DF,1,'',TRUE,NextFrame);
    IF Equal(NextFrame,'GenInv')
         THEN Str := '';
	      GeneralInventory(Str);
    ELSIF Equal(NextFrame,'AddInv')
         THEN AddInvBatch();
    ELSIF Equal(NextFrame,'UpdateInv')
         THEN UpdateInvBatch();
    END;
    ClearScreen();
  UNTIL Equal(NextFrame,'Exit');


  CloseDisplayFrame(DF);
END ControlInvtry;
BEGIN
  InitInvtry := FALSE;
END Invtry.