Topspeed_JPI/TS/MODBASE/DBFINVTR.MOD

IMPLEMENTATION MODULE DBFInvtry;
(*
 *  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 InitDBF,OpenDBF,CloseDBF,ReadDBRec,GetField,
     DBFile,DefaultFixUp,NilDBF;
FROM DBCopier IMPORT DBPack;
FROM DBIndxes IMPORT InitIndex,OpenIndex,AddToUpdateList,CloseIndex,
              CurrentRec,FindPositionCh,BuildIndex,GoTop,GoBottom,
              NextRecord,PrevRecord,CurrentKeyCh,FindPositionN,
              CurrentKeyN,InitCompIndex,BuildCompIndex,DBIndex;
FROM Drectory IMPORT DeleteFile;	
FROM M2Strings IMPORT Assign;
FROM StrEdit IMPORT CrunchBlanks,CAPstr,AssignStr;
FROM DBStuff IMPORT MakeKey;
FROM StrConv IMPORT StrToReal;
FROM NumTypes IMPORT Real8,REALToReal8;
FROM LowLevel IMPORT Fill;
FROM SYSTEM IMPORT ADR;
FROM ScanUtils IMPORT Present,CaseSens;
FROM PosUtils IMPORT Equal;
FROM DBFields IMPORT GetDateField,GetLogicalField,GetNumField,Replace,
     ReplaceD,ReplaceN,ReplaceL;

CONST
  Buffer = 0;
  Safty = TRUE;
  Exclusive = FALSE;
  AutoLock = TRUE;

VAR
  DBInit,IndexOpen : BOOLEAN;


PROCEDURE MoveInvtryToDBF(Rec : InvtryRec );
(* This code will move the data from the record to *)
(* the data base                                   *)
BEGIN
  WITH Rec DO
    CAPstr(INVCODE);                  (* only caps for item code*)
    Replace( InvtryDBF,  1,INVCODE);
    ReplaceN( InvtryDBF,  2,REALToReal8(FLOAT(PRICETBL)));
    Replace( InvtryDBF,  3,GROUP);
    CAPstr(GROUP);
    CrunchBlanks(GROUP);
    Replace( InvtryDBF,  4,DESC);
    ReplaceN( InvtryDBF,  5,REALToReal8(FLOAT(REORDER)));
    ReplaceN( InvtryDBF,  6,ONHAND);
    ReplaceN( InvtryDBF,  7,REALToReal8(FLOAT(MINORDER)));
    ReplaceN( InvtryDBF,  8,PURPRICE);
    ReplaceL( InvtryDBF,  9,STOCKED);
    Replace( InvtryDBF, 10,UNITS);
    ReplaceD( InvtryDBF, 11,LASTPUR);
    ReplaceN( InvtryDBF, 12,LSTPUAMT);
    CAPstr(ORDERFRM);
    Replace( InvtryDBF, 13,ORDERFRM);
    ReplaceN( InvtryDBF, 14,UNITPRICE );    (* Unit price if not price table *)
    Replace(InvtryDBF,15,ONORDER);  (* 'Y' - item is onorder *)
    ReplaceN(InvtryDBF,16,REORDAMT);  (* normal reorder quant *)

END;  (* end of with REC *)
END MoveInvtryToDBF;



PROCEDURE MoveInvtryFromDBF(VAR Rec : InvtryRec );
(* This code will move the data from the Database to *)
(* the record                                        *)
VAR B : BOOLEAN;
    R : Real8;
BEGIN
  WITH Rec DO
    GetField( InvtryDBF,  1,INVCODE );
    GetNumField( InvtryDBF,  2,R);
    PRICETBL:= TRUNC(R);
    GetField( InvtryDBF,  3,GROUP );
    GetField( InvtryDBF,  4,DESC );
    GetNumField( InvtryDBF,  5,R);
    REORDER:= TRUNC(R);
    GetNumField( InvtryDBF,  6,ONHAND);
    GetNumField( InvtryDBF,  7,R);
    MINORDER:= TRUNC(R);
    GetNumField( InvtryDBF,  8,PURPRICE);
    GetLogicalField( InvtryDBF,  9,STOCKED);
    GetField( InvtryDBF, 10,UNITS );
    GetDateField( InvtryDBF, 11,LASTPUR);
    GetNumField( InvtryDBF, 12,LSTPUAMT);
    GetField( InvtryDBF, 13,ORDERFRM );
    GetNumField( InvtryDBF, 14,UNITPRICE );   (* Unit price if not price table *)
    GetField(InvtryDBF,15,ONORDER );
    GetNumField(InvtryDBF,16,REORDAMT);
END;  (* end of with REC^ *)
END MoveInvtryFromDBF;

PROCEDURE FixInvRec();
VAR Rec : InvtryRec;
BEGIN
  MoveInvtryFromDBF(Rec);
  MoveInvtryToDBF(Rec);
END FixInvRec;

PROCEDURE MakeItemKey( DBF : DBFile;  Idx : DBIndex;
                       VAR Key : ARRAY OF CHAR);
		
VAR B : BOOLEAN;
BEGIN
    GetField( DBF,  1,Key );
    MakeKey(Key);
		
END MakeItemKey;		



PROCEDURE OpenInvtryDBF(WithIdx : BOOLEAN);
VAR
  ER : CARDINAL;
BEGIN
  IndexOpen := WithIdx;

(* Open the DBF file *)
IF NOT DBInit THEN
  DBInit:=TRUE;
  InitDBF("Invtry.DBF", InvtryDBF,Buffer,Safty,Exclusive,AutoLock,DefaultFixUp );
  InitCompIndex( "Invcode.Idx",InvcodeIdx,InvtryDBF,MakeItemKey,Buffer,
     		   Safty,FALSE,Exclusive);
     AddToUpdateList( InvtryDBF, InvcodeIdx );

 END;
 IF NOT OpenDBF( InvtryDBF)
     THEN END;
 IF WithIdx THEN

    (* open all indexes and append to dbfile *)
     IF NOT OpenIndex( InvcodeIdx )
       THEN
	 ER := BuildCompIndex(InvcodeIdx, 'C','Invcode',6);
       END;
     ActInvtryIdx := InvcodeIdx; (* make current index *)

  END; (* with index *)
END OpenInvtryDBF;



PROCEDURE CloseInvtryDBF ();   (* close Data and index files *)

BEGIN
  CloseDBF(InvtryDBF);  (* close dbf file *)
  IF IndexOpen
    THEN
      CloseIndex(InvcodeIdx ); (* close index file *)
    END;
 END CloseInvtryDBF;



PROCEDURE FindInvtryByInvcode( Key : ARRAY OF CHAR) : BOOLEAN;
VAR Found : BOOLEAN;
    CKey : ARRAY[0..80] OF CHAR;
    L : LONGINT;
BEGIN
   Fill(ADR(CKey),80,0);
   Assign(Key,CKey);
   CrunchBlanks(CKey);
   ActInvtryIdx := InvcodeIdx ;   (* make this index the active idx*)
   FindPositionCh( InvcodeIdx, CKey, Found);
   ReadDBRec( InvtryDBF, CurrentRec( InvcodeIdx)); (* if found - then exact*)
                                                   (* else the closest one*)
   RETURN Found;
END FindInvtryByInvcode;







PROCEDURE FindInvtryByOrderfrm( Key : ARRAY OF CHAR) : BOOLEAN;
VAR Found : BOOLEAN;
    CKey : ARRAY[0..80] OF CHAR;
BEGIN
   ActInvtryIdx := OrderfrmIdx ;   (* make this index the active idx*)
   MakeKey(Key);
   FindPositionCh( OrderfrmIdx, Key, Found);
   CurrentKeyCh(OrderfrmIdx,CKey);
   Found := Equal(Key,CKey);
    IF Found
       THEN ReadDBRec( InvtryDBF, CurrentRec( OrderfrmIdx));
   END;
   RETURN Found;
END FindInvtryByOrderfrm;







PROCEDURE NextInvtry () : BOOLEAN;
VAR
  L : LONGINT;    (* record number *)
BEGIN
  IF  NextRecord( ActInvtryIdx,L)
    THEN ReadDBRec( InvtryDBF,L  );
         RETURN TRUE;
    ELSE RETURN FALSE;
    END;
END NextInvtry;

PROCEDURE PrevInvtry () : BOOLEAN;
VAR
  L : LONGINT;    (* record number *)
BEGIN
  IF  PrevRecord( ActInvtryIdx,L)
    THEN ReadDBRec( InvtryDBF,L  );
         RETURN TRUE;
    ELSE RETURN FALSE;
    END;
END PrevInvtry;

PROCEDURE FirstInvtry ();
VAR
  L : LONGINT;    (* record number *)
BEGIN
  GoTop(ActInvtryIdx);
  ReadDBRec( InvtryDBF,CurrentRec(  ActInvtryIdx));
END FirstInvtry;

PROCEDURE LastInvtry ();
VAR
  L : LONGINT;    (* record number *)
BEGIN
  GoBottom(ActInvtryIdx);
  ReadDBRec( InvtryDBF,CurrentRec(  ActInvtryIdx));
END LastInvtry;

PROCEDURE PackInvtry();
VAR
  EM : CARDINAL;
BEGIN
  CloseInvtryDBF();
  OpenInvtryDBF(FALSE);
  DBPack(InvtryDBF);

  CloseDBF(InvtryDBF);
  EM := DeleteFile("Invcode.Idx");
  EM := DeleteFile("Orderfrm.Idx");
  OpenInvtryDBF(TRUE);  (* open & rebuild the index *)
  CloseInvtryDBF();

END PackInvtry;


BEGIN
  NilDBF(InvtryDBF);
  IndexOpen := FALSE;
  DBInit:=FALSE;
END DBFInvtry.