Topspeed_JPI/TS-V3/MODBASE/DBFORDER.LST

Listing:

    1  IMPLEMENTATION MODULE DBFOrder;
    2  (*
    3   *  ModBase
    4   *  Release 3.0
    5   *  (c) Copyright 1986 - 1991 PMI
    6   *  P.O. Box 8402
    7   *  Green Bay Wi 53308
    8   *  All Rights Reserved
    9   *  by Ed Ross
   10   *)
   11  
   12  FROM ModBase3 IMPORT InitDBF,OpenDBF,CloseDBF,ReadDBRec,GetField,
   13       DBFile,DefaultFixUp,NilDBF;
   14  FROM DBCopier IMPORT DBPack;
   15  FROM DBIndxes IMPORT InitIndex,OpenIndex,AddToUpdateList,CloseIndex,
   16                CurrentRec,FindPositionCh,BuildIndex,GoTop,GoBottom,
   17                NextRecord,PrevRecord,CurrentKeyCh,FindPositionN,
   18                CurrentKeyN,DBIndex,InitCompIndex,BuildCompIndex;
   19  FROM Drectory IMPORT DeleteFile;	
   20  FROM StrEdit IMPORT CrunchBlanks,CAPstr;
   21  FROM StrConv IMPORT StrToReal;
   22  FROM NumTypes IMPORT Real8,REALToReal8;
   23  FROM DBStuff IMPORT MakeKey;
   24  FROM ScanUtils IMPORT Present,CaseSens;
   25  FROM DBFields IMPORT GetDateField,GetLogicalField,GetNumField,Replace,
   26       ReplaceD,ReplaceN;
   27  
   28  
   29  CONST
   30    Buffer = 0;
   31    Safty = TRUE;
   32    Exclusive = FALSE;
   33    AutoLock = TRUE;
   34  
   35  VAR IndexOpen,DBInit : BOOLEAN;
   36  
   37  PROCEDURE MoveOrderToDBF(Rec : OrderRec );
*****                                 ^ undeclared identifier
   38  (* This code will move the data from the record to *)
   39  (* the data base                                   *)
   40  BEGIN
   41    WITH Rec DO
*****         ^ not supported yet
   42      Replace( OrderDBF,  1,INVNBR);    (* Invoice number *)
*****      ^ not supported yet
*****               ^ undeclared identifier
*****                            ^ undeclared identifier
   43      Replace( OrderDBF,  2,ITEMNBR   );    (* Item number *)
*****      ^ not supported yet
*****               ^ undeclared identifier
*****                            ^ undeclared identifier
   44      Replace( OrderDBF,  3,DESC      );    (* Description of item *)
*****      ^ not supported yet
*****               ^ undeclared identifier
*****                            ^ undeclared identifier
   45      Replace( OrderDBF,  4,NOTES1    );    (* Notes of items line 1 *)
*****      ^ not supported yet
*****               ^ undeclared identifier
*****                            ^ undeclared identifier
   46      Replace( OrderDBF,  5,NOTES2    );    (* Notes for item line 2 *)
*****      ^ not supported yet
*****               ^ undeclared identifier
*****                            ^ undeclared identifier
   47      Replace( OrderDBF,  6,NOTES3    );    (* Notes for item line 3 *)
*****      ^ not supported yet
*****               ^ undeclared identifier
*****                            ^ undeclared identifier
   48      Replace( OrderDBF,  7,UNITS     );    (* Units *)
*****      ^ not supported yet
*****               ^ undeclared identifier
*****                            ^ undeclared identifier
   49      ReplaceN( OrderDBF,  8,QNTSOLD   );    (* Quantity sold *)
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                             ^ undeclared identifier
   50      ReplaceN( OrderDBF,  9,QNTORDER  );    (* Quant ordered (for pricing ) *)
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                             ^ undeclared identifier
   51      ReplaceN( OrderDBF, 10,REALToReal8(FLOAT(DSCLEVEL  )));    (* Discount level applied *)
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                             ^ not supported yet
*****                                         ^ undeclared identifier
*****                                               ^ undeclared identifier
   52      ReplaceN( OrderDBF, 11,UNITPRC   );    (* Item price *)
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                             ^ undeclared identifier
   53      ReplaceN( OrderDBF, 12,TOTAL     );    (* Total price for line item *)
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                             ^ undeclared identifier
   54      Replace( OrderDBF, 13,MANPRICE  );    (* over rider computed price *)
*****      ^ not supported yet
*****               ^ undeclared identifier
*****                            ^ undeclared identifier
   55  END;  (* end of with REC *)
*****  ^ not supported yet
   56  END MoveOrderToDBF;
*****      ^ not supported yet
   57  
   58  
   59  
   60  PROCEDURE MoveOrderFromDBF(VAR Rec : OrderRec );
*****                                       ^ undeclared identifier
   61  (* This code will move the data from the Database to *)
   62  (* the record                                        *)
   63  VAR B : BOOLEAN;
   64      R : Real8;
   65  BEGIN
   66    WITH Rec DO
*****         ^ not supported yet
   67      GetField( OrderDBF,  1,INVNBR );   (* Invoice number *)
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                             ^ undeclared identifier
   68      GetField( OrderDBF,  2,ITEMNBR    );   (* Item number *)
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                             ^ undeclared identifier
   69      GetField( OrderDBF,  3,DESC       );   (* Description of item *)
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                             ^ undeclared identifier
   70      GetField( OrderDBF,  4,NOTES1     );   (* Notes of items line 1 *)
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                             ^ undeclared identifier
   71      GetField( OrderDBF,  5,NOTES2     );   (* Notes for item line 2 *)
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                             ^ undeclared identifier
   72      GetField( OrderDBF,  6,NOTES3     );   (* Notes for item line 3 *)
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                             ^ undeclared identifier
   73      GetField( OrderDBF,  7,UNITS      );   (* Units *)
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                             ^ undeclared identifier
   74      GetNumField( OrderDBF,  8,QNTSOLD   );   (* Quantity sold *)
*****      ^ not supported yet
*****                   ^ undeclared identifier
*****                                ^ undeclared identifier
   75      GetNumField( OrderDBF,  9,QNTORDER  );   (* Quant ordered (for pricing ) *)
*****      ^ not supported yet
*****                   ^ undeclared identifier
*****                                ^ undeclared identifier
   76      GetNumField( OrderDBF, 10,R);
*****      ^ not supported yet
*****                   ^ undeclared identifier
*****                                ^ not supported yet
   77      DSCLEVEL  := TRUNC(R);   (* Discount level applied *)
*****      ^ undeclared identifier
*****                   ^ undeclared identifier
*****                         ^ not supported yet
   78      GetNumField( OrderDBF, 11,UNITPRC   );   (* Item price *)
*****      ^ not supported yet
*****                   ^ undeclared identifier
*****                                ^ undeclared identifier
   79      GetNumField( OrderDBF, 12,TOTAL     );   (* Total price for line item *)
*****      ^ not supported yet
*****                   ^ undeclared identifier
*****                                ^ undeclared identifier
   80      GetField( OrderDBF, 13,MANPRICE   );   (* over rider computed price *)
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                             ^ undeclared identifier
   81  END;  (* end of with REC^ *)
*****  ^ not supported yet
   82  END MoveOrderFromDBF;
*****      ^ not supported yet
   83  
   84  
   85  PROCEDURE MakeOrderKey(DBF : DBFile; Idx : DBIndex;
   86                         VAR Key : ARRAY OF CHAR);
*****                                            ^ not supported yet
   87  		
   88  VAR B : BOOLEAN;
   89  BEGIN
   90      GetField( DBF, 1,Key );
*****      ^ not supported yet
*****                ^ not supported yet
*****                       ^ not supported yet
   91      MakeKey(Key);
*****      ^ not supported yet
*****              ^ not supported yet
   92  END MakeOrderKey;		
*****      ^ not supported yet
   93  
   94  
   95  
   96  
   97  PROCEDURE OpenOrderDBF(WithIdx : BOOLEAN);
   98  VAR ER : CARDINAL;
   99  BEGIN
  100    IndexOpen := WithIdx;
  101  
  102  (* Open the DBF file *)
  103  
  104    IF NOT DBInit THEN
  105      DBInit:=TRUE;
  106      InitDBF("Order.DBF", OrderDBF,Buffer,Safty,Exclusive,AutoLock,DefaultFixUp );
*****      ^ not supported yet
*****              ^ not supported yet
*****                           ^ undeclared identifier
*****                                           ^ not supported yet
*****                                                 ^ not supported yet
*****                                                           ^ not supported yet
*****                                                                    ^ not supported yet
  107       InitCompIndex( "Invnbr.Idx",InvnbrIdx,OrderDBF,MakeOrderKey,Buffer,
*****       ^ not supported yet
*****                      ^ not supported yet
*****                                   ^ undeclared identifier
*****                                             ^ undeclared identifier
*****                                                      ^ not supported yet
  108                     Safty,FALSE,Exclusive);
*****                     ^ not supported yet
*****                                 ^ not supported yet
  109       AddToUpdateList( OrderDBF, InvnbrIdx );
*****       ^ not supported yet
*****                        ^ undeclared identifier
*****                                  ^ undeclared identifier
  110   
  111    END;
  112   IF NOT OpenDBF( OrderDBF)
*****          ^ not supported yet
*****                   ^ undeclared identifier
  113       THEN END;
  114  
  115  IF WithIdx
  116    THEN
  117      (* open all indexes and append to dbfile *)
  118        IF NOT OpenIndex( InvnbrIdx )
*****               ^ not supported yet
*****                          ^ undeclared identifier
  119         THEN
  120  	 ER := BuildCompIndex(InvnbrIdx,'C','Invnbr',12);
*****  	       ^ not supported yet
*****  	                      ^ undeclared identifier
*****  	                                    ^ not supported yet
*****  	                                               ^ not supported yet
  121         END;
  122       ActOrderIdx := InvnbrIdx; (* make current index *)
*****       ^ undeclared identifier
*****                      ^ undeclared identifier
  123    END; (* end with inx *)
  124  END OpenOrderDBF;
*****      ^ not supported yet
  125  
  126  
  127  
  128  PROCEDURE CloseOrderDBF ();   (* close Data and index files *)
  129  
  130  BEGIN
  131    CloseDBF(OrderDBF);  (* close dbf file *)
*****    ^ not supported yet
*****             ^ undeclared identifier
  132    IF IndexOpen
  133      THEN
  134        CloseIndex(InvnbrIdx ); (* close index file *)
*****        ^ not supported yet
*****                   ^ undeclared identifier
  135      END;
  136   END CloseOrderDBF;
*****       ^ not supported yet
  137  
  138  
  139  
  140  PROCEDURE FindOrderByInvnbr( Key : ARRAY OF CHAR) : BOOLEAN;
*****                                              ^ not supported yet
  141  VAR Found : BOOLEAN;
  142      CKey : ARRAY[0..80] OF CHAR;
*****                      ^ not supported yet
*****                             ^ not supported yet
  143  BEGIN
  144     ActOrderIdx := InvnbrIdx ;   (* make this index the active idx*)
*****     ^ undeclared identifier
*****                    ^ undeclared identifier
  145     FindPositionCh( InvnbrIdx, Key, Found);
*****     ^ not supported yet
*****                     ^ undeclared identifier
*****                                ^ not supported yet
*****                                          ^ not supported yet
  146     CurrentKeyCh(InvnbrIdx,CKey);
*****     ^ not supported yet
*****                  ^ undeclared identifier
*****                            ^ not supported yet
  147     Found := Present(Key,CKey,CaseSens);
*****              ^ not supported yet
*****                      ^ not supported yet
*****                          ^ not supported yet
*****                               ^ not supported yet
  148      IF Found
  149         THEN ReadDBRec( OrderDBF, CurrentRec( InvnbrIdx));
*****              ^ not supported yet
*****                         ^ undeclared identifier
*****                                   ^ not supported yet
*****                                               ^ undeclared identifier
  150     END;
  151     RETURN Found;
  152  END FindOrderByInvnbr;
*****      ^ not supported yet
  153  
  154  
  155  
  156  
  157  
  158  
  159  
  160  PROCEDURE NextOrder () : BOOLEAN;
  161  VAR
  162    L : LONGINT;    (* record number *)
  163  BEGIN
  164    IF  NextRecord( ActOrderIdx,L)
*****        ^ not supported yet
*****                    ^ undeclared identifier
*****                                 ^ not supported yet
  165      THEN ReadDBRec( OrderDBF,L  );
*****           ^ not supported yet
*****                      ^ undeclared identifier
*****                                  ^ not supported yet
  166           RETURN TRUE;
  167      ELSE RETURN FALSE;
  168      END;
  169  END NextOrder;
*****      ^ not supported yet
  170  
  171  PROCEDURE PrevOrder () : BOOLEAN;
  172  VAR
  173    L : LONGINT;    (* record number *)
  174  BEGIN
  175    IF  PrevRecord( ActOrderIdx,L)
*****        ^ not supported yet
*****                    ^ undeclared identifier
*****                                 ^ not supported yet
  176      THEN ReadDBRec( OrderDBF,L  );
*****           ^ not supported yet
*****                      ^ undeclared identifier
*****                                  ^ not supported yet
  177           RETURN TRUE;
  178      ELSE RETURN FALSE;
  179      END;
  180  END PrevOrder;
*****      ^ not supported yet
  181  
  182  PROCEDURE FirstOrder ();
  183  VAR
  184    L : LONGINT;    (* record number *)
  185  BEGIN
  186    GoTop(ActOrderIdx);
*****    ^ not supported yet
*****          ^ undeclared identifier
  187    ReadDBRec( OrderDBF,CurrentRec(  ActOrderIdx));
*****    ^ not supported yet
*****               ^ undeclared identifier
*****                        ^ not supported yet
*****                                     ^ undeclared identifier
  188  END FirstOrder;
*****      ^ not supported yet
  189  
  190  PROCEDURE LastOrder ();
  191  VAR
  192    L : LONGINT;    (* record number *)
  193  BEGIN
  194    GoBottom(ActOrderIdx);
*****    ^ not supported yet
*****             ^ undeclared identifier
  195    ReadDBRec( OrderDBF,CurrentRec(  ActOrderIdx));
*****    ^ not supported yet
*****               ^ undeclared identifier
*****                        ^ not supported yet
*****                                     ^ undeclared identifier
  196  END LastOrder;
*****      ^ not supported yet
  197  
  198  
  199  
  200  PROCEDURE PackOrder();
  201  VAR
  202    EM : CARDINAL;
  203  BEGIN
  204    CloseOrderDBF();
*****    ^ not supported yet
*****                  ^ not supported yet
  205    OpenOrderDBF(FALSE);  (* no index *)
*****    ^ not supported yet
*****                      ^ not supported yet
  206    DBPack(OrderDBF);
*****    ^ not supported yet
*****           ^ undeclared identifier
  207  
  208    CloseDBF(OrderDBF);
*****    ^ not supported yet
*****             ^ undeclared identifier
  209    EM := DeleteFile("Invnbr.Idx");
*****          ^ not supported yet
*****                     ^ not supported yet
  210    OpenOrderDBF(TRUE);  (* open & rebuild the index *)
*****    ^ not supported yet
*****                     ^ not supported yet
  211    CloseOrderDBF();
*****    ^ not supported yet
*****                  ^ not supported yet
  212  
  213  END PackOrder;
*****      ^ not supported yet
  214  BEGIN
  215    NilDBF(OrderDBF);
*****    ^ not supported yet
*****           ^ undeclared identifier
  216    IndexOpen := FALSE;
  217    DBInit:=FALSE;
  218  END DBFOrder.
*****      ^ not supported yet

  198 errors