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.