Topspeed_JPI/TS/MODBASE/DBFORDER.MOD

IMPLEMENTATION MODULE DBFOrder;
(*
 *  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,DBIndex,InitCompIndex,BuildCompIndex;
FROM Drectory IMPORT DeleteFile;	
FROM StrEdit IMPORT CrunchBlanks,CAPstr;
FROM StrConv IMPORT StrToReal;
FROM NumTypes IMPORT Real8,REALToReal8;
FROM DBStuff IMPORT MakeKey;
FROM ScanUtils IMPORT Present,CaseSens;
FROM DBFields IMPORT GetDateField,GetLogicalField,GetNumField,Replace,
     ReplaceD,ReplaceN;


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

VAR IndexOpen,DBInit : BOOLEAN;

PROCEDURE MoveOrderToDBF(Rec : OrderRec );
(* This code will move the data from the record to *)
(* the data base                                   *)
BEGIN
  WITH Rec DO
    Replace( OrderDBF,  1,INVNBR);    (* Invoice number *)
    Replace( OrderDBF,  2,ITEMNBR   );    (* Item number *)
    Replace( OrderDBF,  3,DESC      );    (* Description of item *)
    Replace( OrderDBF,  4,NOTES1    );    (* Notes of items line 1 *)
    Replace( OrderDBF,  5,NOTES2    );    (* Notes for item line 2 *)
    Replace( OrderDBF,  6,NOTES3    );    (* Notes for item line 3 *)
    Replace( OrderDBF,  7,UNITS     );    (* Units *)
    ReplaceN( OrderDBF,  8,QNTSOLD   );    (* Quantity sold *)
    ReplaceN( OrderDBF,  9,QNTORDER  );    (* Quant ordered (for pricing ) *)
    ReplaceN( OrderDBF, 10,REALToReal8(FLOAT(DSCLEVEL  )));    (* Discount level applied *)
    ReplaceN( OrderDBF, 11,UNITPRC   );    (* Item price *)
    ReplaceN( OrderDBF, 12,TOTAL     );    (* Total price for line item *)
    Replace( OrderDBF, 13,MANPRICE  );    (* over rider computed price *)
END;  (* end of with REC *)
END MoveOrderToDBF;



PROCEDURE MoveOrderFromDBF(VAR Rec : OrderRec );
(* This code will move the data from the Database to *)
(* the record                                        *)
VAR B : BOOLEAN;
    R : Real8;
BEGIN
  WITH Rec DO
    GetField( OrderDBF,  1,INVNBR );   (* Invoice number *)
    GetField( OrderDBF,  2,ITEMNBR    );   (* Item number *)
    GetField( OrderDBF,  3,DESC       );   (* Description of item *)
    GetField( OrderDBF,  4,NOTES1     );   (* Notes of items line 1 *)
    GetField( OrderDBF,  5,NOTES2     );   (* Notes for item line 2 *)
    GetField( OrderDBF,  6,NOTES3     );   (* Notes for item line 3 *)
    GetField( OrderDBF,  7,UNITS      );   (* Units *)
    GetNumField( OrderDBF,  8,QNTSOLD   );   (* Quantity sold *)
    GetNumField( OrderDBF,  9,QNTORDER  );   (* Quant ordered (for pricing ) *)
    GetNumField( OrderDBF, 10,R);
    DSCLEVEL  := TRUNC(R);   (* Discount level applied *)
    GetNumField( OrderDBF, 11,UNITPRC   );   (* Item price *)
    GetNumField( OrderDBF, 12,TOTAL     );   (* Total price for line item *)
    GetField( OrderDBF, 13,MANPRICE   );   (* over rider computed price *)
END;  (* end of with REC^ *)
END MoveOrderFromDBF;


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




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

(* Open the DBF file *)

  IF NOT DBInit THEN
    DBInit:=TRUE;
    InitDBF("Order.DBF", OrderDBF,Buffer,Safty,Exclusive,AutoLock,DefaultFixUp );
     InitCompIndex( "Invnbr.Idx",InvnbrIdx,OrderDBF,MakeOrderKey,Buffer,
                   Safty,FALSE,Exclusive);
     AddToUpdateList( OrderDBF, InvnbrIdx );
 
  END;
 IF NOT OpenDBF( OrderDBF)
     THEN END;

IF WithIdx
  THEN
    (* open all indexes and append to dbfile *)
      IF NOT OpenIndex( InvnbrIdx )
       THEN
	 ER := BuildCompIndex(InvnbrIdx,'C','Invnbr',12);
       END;
     ActOrderIdx := InvnbrIdx; (* make current index *)
  END; (* end with inx *)
END OpenOrderDBF;



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

BEGIN
  CloseDBF(OrderDBF);  (* close dbf file *)
  IF IndexOpen
    THEN
      CloseIndex(InvnbrIdx ); (* close index file *)
    END;
 END CloseOrderDBF;



PROCEDURE FindOrderByInvnbr( Key : ARRAY OF CHAR) : BOOLEAN;
VAR Found : BOOLEAN;
    CKey : ARRAY[0..80] OF CHAR;
BEGIN
   ActOrderIdx := InvnbrIdx ;   (* make this index the active idx*)
   FindPositionCh( InvnbrIdx, Key, Found);
   CurrentKeyCh(InvnbrIdx,CKey);
   Found := Present(Key,CKey,CaseSens);
    IF Found
       THEN ReadDBRec( OrderDBF, CurrentRec( InvnbrIdx));
   END;
   RETURN Found;
END FindOrderByInvnbr;







PROCEDURE NextOrder () : BOOLEAN;
VAR
  L : LONGINT;    (* record number *)
BEGIN
  IF  NextRecord( ActOrderIdx,L)
    THEN ReadDBRec( OrderDBF,L  );
         RETURN TRUE;
    ELSE RETURN FALSE;
    END;
END NextOrder;

PROCEDURE PrevOrder () : BOOLEAN;
VAR
  L : LONGINT;    (* record number *)
BEGIN
  IF  PrevRecord( ActOrderIdx,L)
    THEN ReadDBRec( OrderDBF,L  );
         RETURN TRUE;
    ELSE RETURN FALSE;
    END;
END PrevOrder;

PROCEDURE FirstOrder ();
VAR
  L : LONGINT;    (* record number *)
BEGIN
  GoTop(ActOrderIdx);
  ReadDBRec( OrderDBF,CurrentRec(  ActOrderIdx));
END FirstOrder;

PROCEDURE LastOrder ();
VAR
  L : LONGINT;    (* record number *)
BEGIN
  GoBottom(ActOrderIdx);
  ReadDBRec( OrderDBF,CurrentRec(  ActOrderIdx));
END LastOrder;



PROCEDURE PackOrder();
VAR
  EM : CARDINAL;
BEGIN
  CloseOrderDBF();
  OpenOrderDBF(FALSE);  (* no index *)
  DBPack(OrderDBF);

  CloseDBF(OrderDBF);
  EM := DeleteFile("Invnbr.Idx");
  OpenOrderDBF(TRUE);  (* open & rebuild the index *)
  CloseOrderDBF();

END PackOrder;
BEGIN
  NilDBF(OrderDBF);
  IndexOpen := FALSE;
  DBInit:=FALSE;
END DBFOrder.