Topspeed_JPI/TS-V3/MODBASE/PMIMAINT.LST

Listing:

    1  IMPLEMENTATION MODULE PMIMaint;
    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  
   13  FROM PMIGlobals IMPORT Config,PMIScreens;
   14  FROM NumTypes IMPORT Real8;
   15  FROM Numbers IMPORT Max;
   16  FROM PosUtils IMPORT Equal;
   17  FROM StrEdit IMPORT CrunchBlanks,DeleteRightJustified,Append,CAPstr,DeleteChar;
   18  FROM M2Strings IMPORT Length;
   19  FROM LowLevel IMPORT Fill;
   20  FROM StringIO IMPORT PrintMessage,ErrorMessage,WriteEol,WriteStr,outp;
   21  FROM SmartScreen IMPORT ClearScreen;
   22  FROM ScrnUtl1 IMPORT FieldNum;
   23  FROM ScrnUtl2 IMPORT CloseDisplayFrame;
   24  FROM VWindows IMPORT ClearPart, CurrentWindow, SetCursorHeight;
   25  FROM ScrnTypes IMPORT DisplayFrame,InitDisplayFrame,AFrameName;
   26  FROM FramePainter IMPORT ShowDisplayFrame,RedrawField;
   27  FROM InputManager IMPORT ControlFrame;
   28  FROM FrameManager IMPORT EraseFrame;
   29  FROM Prompts IMPORT PromptYN;
   30  FROM SYSTEM IMPORT ADR,SIZE,ADDRESS;
   31  FROM ControlUtils IMPORT ControlSeparately, LoadFrameList,Control,ChangeField;
   32  FROM DspFiles IMPORT OpenDisplayFile,ReadDisplayFrame;
   33  
   34  
   35  
   36  FROM DBFCustomer IMPORT CustomerDBF,MoveCustomerToDBF,MoveCustomerFromDBF,
   37       CustomerRec, OpenCustomerDBF,CloseCustomerDBF,PackCustomer;
   38  FROM ModBase3 IMPORT ReadDBRec,WriteDBRec,NumberRecords;
   39  
   40  FROM DBFInvtry IMPORT PackInvtry;
   41  FROM DBFInvoice IMPORT PackInvoice;
   42  FROM DBFGas IMPORT PackGas;
   43  FROM DBFPayments IMPORT PackPayments;
   44  FROM DBFOrder IMPORT PackOrder;
   45  
   46  
   47  VAR
   48    DF : DisplayFrame;
   49    NxtFrame : AFrameName;
   50  
   51  PROCEDURE PackDatabase();
   52  TYPE
   53   PackType = (PCust,PPay,PInv,PInvy,PGas,POrder);
   54  VAR
   55    WhatToPack : SET OF PackType;
*****                        ^ not supported yet
   56  
   57  BEGIN
   58    WhatToPack := WhatToPack / WhatToPack;
*****    ^ not supported yet
*****                  ^ not supported yet
*****                               ^ not supported yet
   59    IF PromptYN(' Pack Customer ',DF)
*****       ^ not supported yet
*****                ^ not supported yet
*****                                  ^ not supported yet
   60      THEN
   61        INCL(WhatToPack,PCust);
*****        ^ undeclared identifier
*****             ^ not supported yet
*****                        ^ not supported yet
   62      END;
   63    IF PromptYN(' Pack Payments ',DF)
*****       ^ not supported yet
*****                ^ not supported yet
*****                                  ^ not supported yet
   64      THEN
   65        INCL(WhatToPack,PPay);
*****        ^ undeclared identifier
*****             ^ not supported yet
*****                        ^ not supported yet
   66      END;
   67    IF PromptYN(' Pack Invoices ',DF)
*****       ^ not supported yet
*****                ^ not supported yet
*****                                  ^ not supported yet
   68      THEN
   69        INCL(WhatToPack,PInv);
*****        ^ undeclared identifier
*****             ^ not supported yet
*****                        ^ not supported yet
   70      END;
   71    IF PromptYN(' Pack Inventory ',DF)
*****       ^ not supported yet
*****                ^ not supported yet
*****                                   ^ not supported yet
   72      THEN
   73        INCL(WhatToPack,PInvy);
*****        ^ undeclared identifier
*****             ^ not supported yet
*****                        ^ not supported yet
   74      END;
   75    IF PromptYN(' Pack Helium ',DF)
*****       ^ not supported yet
*****                ^ not supported yet
*****                                ^ not supported yet
   76      THEN
   77        INCL(WhatToPack,PGas);
*****        ^ undeclared identifier
*****             ^ not supported yet
*****                        ^ not supported yet
   78      END;
   79    IF PromptYN(' Pack Orders ',DF)
*****       ^ not supported yet
*****                ^ not supported yet
*****                                ^ not supported yet
   80      THEN
   81        INCL(WhatToPack,POrder);
*****        ^ undeclared identifier
*****             ^ not supported yet
*****                        ^ not supported yet
   82      END;
   83    ClearScreen();
*****    ^ not supported yet
*****                ^ not supported yet
   84    IF PPay IN WhatToPack
*****       ^ not supported yet
*****               ^ not supported yet
   85      THEN
   86       WriteEol(outp,' Packing Payments database ');
*****       ^ not supported yet
*****                ^ not supported yet
*****                     ^ not supported yet
   87       PackPayments();
*****       ^ not supported yet
*****                    ^ not supported yet
   88      END;
   89  
   90    IF PCust IN WhatToPack
*****       ^ not supported yet
*****                ^ not supported yet
   91      THEN
   92        WriteEol(outp,' Packing customer database ');
*****        ^ not supported yet
*****                 ^ not supported yet
*****                      ^ not supported yet
   93        PackCustomer();
*****        ^ not supported yet
*****                     ^ not supported yet
   94      END;
   95  
   96    IF PInv IN WhatToPack
*****       ^ not supported yet
*****               ^ not supported yet
   97      THEN
   98         WriteEol(outp,' Packing Invoice database ');
*****         ^ not supported yet
*****                  ^ not supported yet
*****                       ^ not supported yet
   99         PackInvoice();
*****         ^ not supported yet
*****                     ^ not supported yet
  100      END;
  101  
  102    IF PInvy IN WhatToPack
*****       ^ not supported yet
*****                ^ not supported yet
  103      THEN
  104        WriteEol(outp,' Packing Inventory database ');
*****        ^ not supported yet
*****                 ^ not supported yet
*****                      ^ not supported yet
  105        PackInvtry();
*****        ^ not supported yet
*****                   ^ not supported yet
  106      END;
  107  
  108   IF PGas IN WhatToPack
*****      ^ not supported yet
*****              ^ not supported yet
  109     THEN
  110        WriteEol(outp,' Packing Gas database ');
*****        ^ not supported yet
*****                 ^ not supported yet
*****                      ^ not supported yet
  111        PackGas();
*****        ^ not supported yet
*****                ^ not supported yet
  112      END;
  113   IF POrder IN WhatToPack
*****      ^ not supported yet
*****                ^ not supported yet
  114     THEN
  115       WriteEol(outp,'Packing orderdatabase');
*****       ^ not supported yet
*****                ^ not supported yet
*****                     ^ not supported yet
  116       PackOrder();
*****       ^ not supported yet
*****                 ^ not supported yet
  117     END;
  118  END PackDatabase;
*****      ^ not supported yet
  119  
  120  PROCEDURE ResetCustYTD();
  121  VAR
  122    Cust : CustomerRec;
  123    LI : LONGINT;
  124  BEGIN
  125    IF NOT PromptYN(' Reset Customer YTD Purchases? ',DF)
*****           ^ not supported yet
*****                    ^ not supported yet
*****                                                      ^ not supported yet
  126      THEN
  127        RETURN;
  128      END;
  129    OpenCustomerDBF(FALSE);
*****    ^ not supported yet
*****                         ^ not supported yet
  130    ClearScreen();
*****    ^ not supported yet
*****                ^ not supported yet
  131    FOR LI := 1 TO NumberRecords(CustomerDBF) DO
*****                   ^ not supported yet
*****                                 ^ not supported yet
  132      ReadDBRec(CustomerDBF,LI);
*****      ^ not supported yet
*****                ^ not supported yet
*****                              ^ not supported yet
  133      MoveCustomerFromDBF(Cust);
*****      ^ not supported yet
*****                          ^ not supported yet
  134      WriteStr(outp,' Processing  ');
*****      ^ not supported yet
*****               ^ not supported yet
*****                    ^ not supported yet
  135      WriteEol(outp,Cust.NAME);
*****      ^ not supported yet
*****               ^ not supported yet
*****                    ^ not supported yet
*****                         ^ not supported yet
  136      Cust.YTDPURCH := 0.0;
*****      ^ not supported yet
*****           ^ not supported yet
  137      MoveCustomerToDBF(Cust);
*****      ^ not supported yet
*****                        ^ not supported yet
  138      WriteDBRec(CustomerDBF);
*****      ^ not supported yet
*****                 ^ not supported yet
  139    END;
  140    CloseCustomerDBF();
*****    ^ not supported yet
*****                     ^ not supported yet
  141  END ResetCustYTD;
*****      ^ not supported yet
  142  
  143  PROCEDURE Maintain();
  144  
  145  BEGIN
  146    InitDisplayFrame(DF,CurrentWindow);
*****    ^ not supported yet
*****                     ^ not supported yet
*****                        ^ not supported yet
  147    ReadDisplayFrame(PMIScreens,DF,'Maint');
*****    ^ not supported yet
*****                     ^ not supported yet
*****                                ^ not supported yet
*****                                   ^ not supported yet
  148    REPEAT
  149      ClearScreen();
*****      ^ not supported yet
*****                  ^ not supported yet
  150      ShowDisplayFrame(DF,0,0,0,0);
*****      ^ not supported yet
*****                       ^ not supported yet
*****                                 ^ not supported yet
  151      ControlFrame(DF,1,'',FALSE,NxtFrame);
*****      ^ not supported yet
*****                   ^ not supported yet
*****                                 ^ not supported yet
  152      IF Equal(NxtFrame,'PackDB')
*****         ^ not supported yet
*****               ^ not supported yet
*****                        ^ not supported yet
  153        THEN PackDatabase();
*****             ^ not supported yet
*****                          ^ not supported yet
  154      ELSIF Equal(NxtFrame,'ResetCust')
*****            ^ not supported yet
*****                  ^ not supported yet
*****                           ^ not supported yet
  155        THEN ResetCustYTD();
*****             ^ not supported yet
*****                          ^ not supported yet
  156    END;
  157    UNTIL Equal(NxtFrame,'Exit');
*****          ^ not supported yet
*****                ^ not supported yet
*****                         ^ not supported yet
  158    CloseDisplayFrame(DF);
*****    ^ not supported yet
*****                      ^ not supported yet
  159  END Maintain;
*****      ^ not supported yet
  160  
  161  
  162  
  163  END PMIMaint.
*****      ^ not supported yet

  147 errors