Topspeed_JPI/TS/MODBASE/DBFINVOI.MOD

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


CONST
  Buffer = 0;
  Safty = TRUE;
  Exclusive = FALSE;
  AutoLock = TRUE;
VAR
  DBInit,IndexOpen : BOOLEAN;

PROCEDURE MoveInvoiceToDBF(Rec : InvoiceRec );
(* This code will move the data from the record to *)
(* the data base                                   *)
BEGIN
  WITH Rec DO
    Replace( InvoiceDBF,  1,INVOICE);    (* Invoice number *)
    ReplaceD( InvoiceDBF,  2,INVDATE   );    (* Invoce date *)
    Replace( InvoiceDBF,  3,CUSTID);    (* FK - customer id number *)
    ReplaceN( InvoiceDBF,  4,INVNET    );    (* Invoice net *)
    ReplaceN( InvoiceDBF,  5,INVTAX    );    (* Invoice Tax *)
    ReplaceN( InvoiceDBF,  6,AMTOUT    );    (* Amount outstanding *)
    ReplaceN( InvoiceDBF,  7,TOTALAMT  );    (* Invoice discount *)
    Replace( InvoiceDBF,  8,SPORDER   );    (* special order boolean *)
    Replace( InvoiceDBF,  9,HELIUM    );    (* Helium associated with order *)
    ReplaceN( InvoiceDBF, 10,INVDSCNT );    (* special discount *)
    Replace( InvoiceDBF, 11,CUSTPO    );    (* customer's purchase order *)
    Replace( InvoiceDBF, 12,INVPRNT   );    (* Invoice printed Y/N *)
    Replace( InvoiceDBF, 13,INVCLSD   );    (* Invoice closed - no special out *)
    ReplaceD( InvoiceDBF, 14,SHIPDATE  );    (* Date Shipped *)
    Replace( InvoiceDBF, 15,SALESMAN  );    (* Whodoneit *)
    Replace( InvoiceDBF, 16,TERMS     );    (* terms of invoice *)
    Replace( InvoiceDBF, 17,SHIPVIA   );    (* method of shippment *)
    ReplaceN( InvoiceDBF, 18,SHIPPING  );    (* shipping charge *)
    ReplaceN( InvoiceDBF, 19,REALToReal8(FLOAT(DFLTLVL))); (* default price level *)
    CAPstr(TAXABLE);
    Replace(InvoiceDBF,20,TAXABLE);         (* if taxable *)
    CAPstr(FREEFRGHT);
    Replace(InvoiceDBF,21,FREEFRGHT);   (* free freight *)
    Replace( InvoiceDBF, 22,NOTESFOR  );    (* Notes for Inv, Pkg or both *)
    Replace( InvoiceDBF, 23,NOTE1     );    (*  *)
    Replace( InvoiceDBF, 24,NOTE2     );    (*  *)
    Replace( InvoiceDBF, 25,NOTE3     );    (*  *)
END;  (* end of with REC *)
END MoveInvoiceToDBF;



PROCEDURE MoveInvoiceFromDBF(VAR Rec : InvoiceRec );
(* This code will move the data from the Database to *)
(* the record                                        *)
VAR B : BOOLEAN;
    R : Real8;
BEGIN
  WITH Rec DO
    GetField( InvoiceDBF,  1,INVOICE);   (* Invoice number *)
    GetDateField( InvoiceDBF,  2,INVDATE   );   (* Invoce date *)
    GetField( InvoiceDBF,  3,CUSTID);   (* FK - customer id number *)
    GetNumField( InvoiceDBF,  4,INVNET    );   (* Invoice net *)
    GetNumField( InvoiceDBF,  5,INVTAX    );   (* Invoice Tax *)
    GetNumField( InvoiceDBF,  6,AMTOUT    );   (* Amount outstanding *)
    GetNumField( InvoiceDBF,  7,TOTALAMT  );   (* Invoice discount *)
    GetField( InvoiceDBF,  8,SPORDER);   (* special order boolean *)
    GetField( InvoiceDBF,  9,HELIUM );   (* Helium associated with order *)
    GetNumField( InvoiceDBF, 10,INVDSCNT);
    GetField( InvoiceDBF, 11,CUSTPO );   (* customer's purchase order *)
    GetField( InvoiceDBF, 12,INVPRNT);   (* Invoice printed Y/N *)
    GetField( InvoiceDBF, 13,INVCLSD);   (* Invoice closed - no special out *)
    GetDateField( InvoiceDBF, 14,SHIPDATE  );   (* Date Shipped *)
    GetField( InvoiceDBF, 15,SALESMAN );   (* Whodoneit *)
    GetField( InvoiceDBF, 16,TERMS    );   (* terms of invoice *)
    GetField( InvoiceDBF, 17,SHIPVIA  );   (* method of shippment *)
    GetNumField(InvoiceDBF,18,SHIPPING);     (* shipping amount *)
    GetNumField(InvoiceDBF,19,R);    (* default discount table level*)
    DFLTLVL := TRUNC(R);
    GetField( InvoiceDBF, 20,TAXABLE);  (* if taxable invoice *)
    GetField( InvoiceDBF,21,FREEFRGHT);
    GetField( InvoiceDBF, 22,NOTESFOR );   (* Notes for Inv, Pkg or both *)
    GetField( InvoiceDBF, 23,NOTE1    );   (*  *)
    GetField( InvoiceDBF, 24,NOTE2    );   (*  *)
    GetField( InvoiceDBF, 25,NOTE3    );   (*  *)
END;  (* end of with REC^ *)
END MoveInvoiceFromDBF;

PROCEDURE MakeCustKey(DBF : DBFile; Idx: DBIndex;
                      VAR Key : ARRAY OF CHAR);
		
		
(* when indexed by customer id - append the status of on the key *)
		
VAR B : BOOLEAN;
 Str : ARRAY[0..3] OF CHAR;
BEGIN
  GetField(DBF,3,Key);
  GetField(DBF,12,Str);
  Append(Key,Str);
  MakeKey(Key);		
END MakeCustKey;		

PROCEDURE MakeInvoiceKey(DBF : DBFile; Idx: DBIndex;
                         VAR Key : ARRAY OF CHAR);
		
		
(* when indexed by customer id - append the status of on the key *)
		
VAR B : BOOLEAN;
 Str : ARRAY[0..3] OF CHAR;
BEGIN
  GetField(DBF,1,Key);
  MakeKey(Key);		
END MakeInvoiceKey;		




PROCEDURE OpenInvoiceDBF(WithIdx : BOOLEAN);
VAR
  B : CARDINAL;
BEGIN
  IndexOpen := WithIdx;

(* Open the DBF file *)
IF NOT DBInit THEN
  DBInit:=TRUE;
  InitDBF("Invoice.DBF", InvoiceDBF,Buffer,Safty,Exclusive,AutoLock,
         DefaultFixUp );
     InitCompIndex( "Invoice.Idx",InvoiceIdx,InvoiceDBF,MakeInvoiceKey,
                    Buffer, Safty,FALSE,Exclusive);
     AddToUpdateList( InvoiceDBF, InvoiceIdx );
     InitCompIndex( "Custid.Idx",CustidIdx,InvoiceDBF,MakeCustKey,
                  Buffer, Safty,FALSE,Exclusive);
     AddToUpdateList( InvoiceDBF, CustidIdx );

END;
 IF NOT OpenDBF( InvoiceDBF)
     THEN END;

IF WithIdx
  THEN
    (* open all indexes and append to dbfile *)
     IF NOT OpenIndex( InvoiceIdx )
       THEN
	 B := BuildCompIndex(InvoiceIdx,'C', 'INVOICE',10);
       END;
     ActInvoiceIdx := InvoiceIdx; (* make current index *)
     IF NOT OpenIndex( CustidIdx )
       THEN
	 B := BuildCompIndex(CustidIdx, 'C','CUSTID',10);
       END;
     ActInvoiceIdx := CustidIdx; (* make current index *)
   END;  (* with index *)
END OpenInvoiceDBF;



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

BEGIN
  CloseDBF(InvoiceDBF);  (* close dbf file *)
  IF IndexOpen
    THEN
 	CloseIndex(InvoiceIdx ); (* close index file *)
	CloseIndex(CustidIdx ); (* close index file *)
    END;	
 END CloseInvoiceDBF;



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







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







PROCEDURE NextInvoice () : BOOLEAN;
VAR
  L : LONGINT;    (* record number *)
BEGIN
  IF  NextRecord( ActInvoiceIdx,L)
    THEN ReadDBRec( InvoiceDBF,L  );
         RETURN TRUE;
    ELSE RETURN FALSE;
    END;
END NextInvoice;

PROCEDURE PrevInvoice () : BOOLEAN;
VAR
  L : LONGINT;    (* record number *)
BEGIN
  IF  PrevRecord( ActInvoiceIdx,L)
    THEN ReadDBRec( InvoiceDBF,L  );
         RETURN TRUE;
    ELSE RETURN FALSE;
    END;
END PrevInvoice;

PROCEDURE FirstInvoice ();
VAR
  L : LONGINT;    (* record number *)
BEGIN
  GoTop(ActInvoiceIdx);
  ReadDBRec( InvoiceDBF,CurrentRec(  ActInvoiceIdx));
END FirstInvoice;

PROCEDURE LastInvoice ();
VAR
  L : LONGINT;    (* record number *)
BEGIN
  GoBottom(ActInvoiceIdx);
  ReadDBRec( InvoiceDBF,CurrentRec(  ActInvoiceIdx));
END LastInvoice;


PROCEDURE PackInvoice();
VAR
  EM : CARDINAL;
BEGIN
  CloseInvoiceDBF();


  InitDBF("Invoice.DBF", InvoiceDBF,Buffer,Safty,TRUE,AutoLock,DefaultFixUp );
  IF NOT OpenDBF( InvoiceDBF)
     THEN END;
  DBPack(InvoiceDBF);
  CloseDBF(InvoiceDBF);
  EM := DeleteFile('Invoice.IDX');
  EM := DeleteFile('CustId.Idx');
  OpenInvoiceDBF(TRUE);  (* open & rebuild the index *)
  CloseInvoiceDBF();

END PackInvoice;

BEGIN
  NilDBF(InvoiceDBF);
  IndexOpen := FALSE;
  DBInit:=FALSE;
END DBFInvoice.