Retro1.org codex

*DECK     COLLECT 
*IF DEF,CDCNET,1
  PRGM  CLCDCNT;
*IF -DEF,CDCNET,1 
  PRGM  COLLECT;
# 
                      DUMP COLLECTION PROCESSOR 
  
  
                P R O C E D U R E    C O N T E N T S
                ------------------------------------
  
  
                          ITEM DECLARATIONS 
                          LINK DECLARATIONS 
                          ARRAY DECLARATIONS
                          COMMON DECLARATIONS 
                          MISC DECLARATIONS 
                           FUNC KEYLINE 
                           PROC READ$CFO
                           PROC COLECT (MAIN PROCESS) 
  
  
  
        COLLECT COPYRIGHT CONTROL DATA SYSTEMS INC. 1994. 
  
  
# 
 
  CONTROL EJECT;
 
 
# 
  
              NETWORK DUMP COLLECTION PROGRAM 
  
     THE NETWORK DUMP COLLECTION PROGRAM, COLLECT, IS USED TO 
     CO-LOCATE THE VARIOUS DUMP, TRACE, STATISTIC AND LIST
     FILES WHICH RESULT FROM ANY INVOCATION OF THE NETWORK. 
     THESE FILES ARE FIRST COPIED TO A LOCAL FILE BY THE
     PROGRAM "COLLECT" AND THEN, VIA JOB CONTROL STATEMENTS,
     THIS FILE IS COPIED TO A TAPE FILE.
  
     THE CALL STATEMENT FOR THE COLLECTION PROGRAM TAKES THE
     FOLLOWING FORM-- 
  
              COLLECT(NIN=XXX[,NOPURGE][,NOSAVE]) 
  
     THE NETWORK INVOCATION NUMBER XXX IS A ONE TO THREE CHAR-
     ACTER DECIMAL NUMBER WHICH INDICATES THE UPPER LIMIT OF THE
     INVOCATION NUMBERS TO BE COLLECTED.  ALL FILES WITH AN NIN 
     FROM 1 THROUGH XXX WILL BE COPIED TO THE LOCAL 
     FILE.  IF THE NIN VALUE IS NOT SPECIFIED, A DEFAULT
     VALUE OF 1 (ONE) WILL BE USED. 
  
     THE NOPURGE OPTION, IF SPECIFIED, INDICATES THAT THE COLLECTED 
     FILES ARE NOT TO BE PURGED AFTER THEY ARE SUCCESSFULLY COPIED
     TO THE COMMON LOCAL FILE.  IF THIS OPTION IS NOT SPEC- 
     IFIED, EACH FILE COPIED WILL BE IMMEDIATELY PURGED.
  
     THE NOSAVE OPTION, WHEN SPECIFIED, BYPASSES THE FILE COPYING 
     FUNCTIONS.  THAT IS, NO DUMPXXX FILES WILL BE CREATED.  THIS 
     OPTION MAY BE SPECIFIED TO CAUSE THE PURGING (ONLY) OF ALL 
     NETWORK DUMP FILES.
  
     THE COLLECTION PROCESS IS INITIATED VIA THE NETWORK STARTUP
     JOB, NAMI.  THE RELEASED NAMI JOB MASTER FILE WILL CAUSE 
     NAMI TO INITIATE THE COLLECTOR JOB UPON EACH INVOCATION OF THE 
     NETWORK.  THE COLLECTOR JOB WILL BE PASSED AN NIN VALUE OF THE 
     LAST NETWORK INVOCATION NUMBER--  THE CURRENT NETWORK WILL BE
     INITIATED WITH AN INCREMENTAL VALUE OF THE NIN.  THE PURGE AND 
     SAVE OPTIONS WILL BE IN EFFECT.  FOR EXAMPLE, ON THE 5TH 
     INITIATION OF THE NETWORK, THE COLLECTOR JOB WILL HAVE THE 
     CONTROL STATEMENT CALL OF--- 
  
            COLLECT(NIN=004)
  
     AND THE NETWORK WILL BE STARTED WITH AN NIN OF 005.
  
  
     THE COLLECTOR JOB WILL PROCESS ALL FILES WHICH HAVE A NAME OF
     THE FORM---
  
            PPTSXXX     WHERE    PP  = PRODUCT PREFIX 
                                       CS, NS, NV (FOR NVF),
                                       NI (FOR NIP), TV (FOR TVF) 
                                       IA (FOR IAF), RB (FOR RBF),
                                       NP (NPUS), IT (ITF), PR (PSU), 
                                       QT (QTF), QS (QTFS), PS (PTFS),
                                       AT (ATF), PI (FTPI), TS (FTPS) 
*IF DEF,CDCNET
                                       FS, OS, LS, IN (INITMDI) 
                                       DI...DR, DS...D9 (MDI DUMPS) 
*ENDIF
  
                                 T   = TYPE OF FILE 
                                       L (LIST FILE), T (TRACE FILE)
                                       S (STATISTICS FILE), D (DUMP 
                                       FILE)
  
                                 S   = SUB TYPE FOR FILE
                                       0, 1 OR 2
  
                                 XXX = NETWORK INVOCATION NUMBER
                                       000 THROUGH 999
  
                        NOTE - T AND S ARE NOT VALID FOR NP AND 
                               MDI DUMP FILES.
  
     THE FILE PRODUCED BY THE COLLECTOR JOB HAS ONE FILE
     AND MANY RECORDS.  EACH FILE SELECTED (SEE ABOVE FILE NAME 
     DESCRIPTION) IS COPIED TO THE COMMON FILE AS ONE OR MORE 
     RECORDS WHERE THE FIRST RECORD IS PRECEDED BY A 16 (20B) WORD
     RECORD WHICH CONTAINS THE FILE NAME.  IN THIS WAY, AN ITEMIZE
     OR CATALOG OF THE COLLECTOR COMMON FILE WILL EASILY SHOW 
     WHICH FILES WERE COPIED. 
  
     THE LOCAL FILES CREATED BY THE COLLECTION PROGRAM HAVE 
     THE NAMES--- 
               DUMPXXX     WHERE XXX IS THE SPECIFIED OR DEFAULT
                                     NIN FROM THE COLLECTOR CALL
                                     STATEMENT.  THIS FILE WILL 
                                     CONTAIN ALL OF THE FILES 
                                     EXCEPT THOSE WRITTEN TO
                                     DUNPXXX AND/OR DMDIXXX.
  
               DUNPXXX     WHERE XXX IS THE SPECIFIED OR DEFAULT
                                     NIN FROM THE COLLECTOR CALL
                                     STATEMENT.  THIS FILE WILL 
                                     CONTAIN THE NP DUMP FILES, THAT
                                     IS, FILES OF THE NAME NPZZXXX. 
*IF DEF,CDCNET
  
               DMDIXXX     WHERE XXX IS THE SPECIFIED OR DEFAULT
                                     NIN FROM THE COLLECTOR CALL
                                     STATEMENT.  THIS FILE WILL 
                                     CONTAIN THE MDI DUMP FILES, THAT 
                                     IS, FILES OF THE NAME
                                       DI_AA_NIN ... DI_99_NIN
                                        .             . 
                                        .             . 
                                        .             . 
                                       DR_AA_NIN ... DR_99_NIN
  
                                       DS_AA_NIN ... DS_99_NIN
                                        .             . 
                                        .             . 
                                        .             . 
                                       D9_AA_NIN ... D9_99_NIN
*ENDIF
  
  
     THE JOB SKELETON FOR THE COLLECTOR JOB WHICH IS RELEASED 
     WITH THE MULTI-HOST NETWORK WILL CAUSE THE COMMON (LOCAL)
     FILES TO BE COPIED TO MAGNETIC TAPE.  WHEN THE FILES HAVE BEEN 
     SUCCESSFULLY COPIED, COLLECT WILL AGAIN BE EXECUTED TO PURGE 
     THE INDIVIDUAL FILES WHICH WERE COLLECTED. 
  
  
     TO USE THE COLLECTOR JOB AS A PURGING VEHICLE, THE FOLLOWING 
     CALL STATEMENT MAY BE USED---
  
               COLLECT(NIN=999,NOSAVE)
  
     WITH THIS INVOCATION OF THE COLLECTOR, ALL FILES WITH THE
     NAME FORMAT AS DESCRIBED ABOVE WILL BE PURGED.  NO DUMP FILE 
     WILL BE CREATED. 
  
  
# 
  CONTROL EJECT;
 
                                                  #ITEM DECLARATIONS   #
 
  BEGIN 
 
    ITEM INDX1      I=0;
    ITEM NDXPF      I=0;
    ITEM K          I=0,    K1      I=0,     K2      I=0; 
    ITEM J1         I=0,    J2      I=0,     J3      I=0; 
    ITEM N          I=0,    N1      I=0,     N2      I=0; 
    ITEM NR1        R=0,    NR2     R=0;
    ITEM OPTION     I=0;
    ITEM TOTPRU     I=0;
 
    DEF STATEOI     #O"1031"#;
 
    ITEM SPACES     C(10) = "          "; 
    ITEM EDITX      C(10);
    ITEM SCANF      C(10);
    ITEM SCANK      C(10);
    ITEM SCANV      C(10);
    ITEM NETINV     C(10);      #NIN0ZZZ   #
    ITEM USERNUM    C(10);
 
    ITEM INV$LOW    I=1;
    ITEM INV$HIGH   I=999;
    ITEM INV$ONE    I=0;
 
    ITEM DD60       B=FALSE;
    ITEM FL2PURGE   B=TRUE; 
    ITEM FL2TAPE    B=FALSE;
    ITEM FL2DISK    B=TRUE; 
    ITEM FL2SAVE    B=TRUE; 
    ITEM MORE$2$DO  B=TRUE; 
    ITEM SHORT      B=FALSE;
    ITEM CHK$RANGE  B=TRUE; 
*IF DEF,CDCNET
    ITEM $DEFAULT   C(10)= O"53040506012514240000";  # PN & UN PARAMS # 
    ITEM $CURRENT   C(10)= O"53032522220516240000";  # FOR NETCDA CALL# 
*ENDIF
 
    DEF  MODE$P      #1#; 
    DEF  MODE$T      #2#; 
    DEF  MODE$D      #4#; 
    DEF  MODE$S      #8#; 
 
 
    COMMON IDINFO;
       BEGIN
         ITEM IDVERSN    C(40);     # COLLECTOR VERSION IDENT # 
         ITEM COPYRIGHT  C(50);     # COLLECTOR COPYRIGHT     # 
       END
 
  CONTROL EJECT;
                                                  #LINK DECLARATIONS   #
 
 
    XREF PROC CFOWAIT;
    XREF PROC CFOBCLR;
    XREF PROC CFOBSET;
    XREF PROC CPYOPN; 
    XREF PROC CPYATT; 
    XREF PROC CPYGET; 
    XREF PROC CPYFLS; 
    XREF PROC CPYPUR; 
    XREF PROC CPYRET; 
    XREF PROC CPYSAV; 
    XREF PROC FINSHIO;
    XREF PROC OFLUSH; 
    XREF PROC PUTLINE;
    XREF PROC PUTTERM;
    XREF PROC PUTTRMX;
    XREF PROC SENDMSG;
    XREF PROC SETUPC; 
    XREF PROC SIERRA; 
    XREF PROC STARTIO;
    XREF PROC TIGRLST;
 
    XREF FUNC XCDD       C(10); 
    XREF FUNC XCOD       C(10); 
    XREF FUNC XSFW       C(10); 
    XREF FUNC XCFD       C(10); 
 
*IF DEF,CDCNET
    XREF PROC NETCDA; 
    XREF PROC NETFMA; 
    XREF PROC NETFMP; 
*ENDIF
 
  CONTROL EJECT;
                                                  #ARRAY DECLARATIONS  #
 
    ARRAY LINE[0:10] S(1);
          BEGIN 
          ITEM LIN6       C(0, 0,    6);
          ITEM LINX       C(0, 0,   10);
          ITEM LIN80      C(0, 0,   80);
          ITEM LINX1A     C(0, 0,  110);
          ITEM LIN4       C(0, 0,    4);
          END 
 
 
 
    ARRAY ENVIRONS [0:0] S(21); 
          BEGIN 
          ITEM ENV1       C(0,  0,  10) = ["          "]; 
          ITEM ENV2       C(1,  0,  10) = ["CFO=YES   "]; 
          ITEM ENV3       C(2,  0,  10) = ["CMU=YES   "]; 
          ITEM ENV4       C(3,  0,  10) = ["C/MEJ=YES "]; 
          ITEM ENV5       C(4,  0,  10) = ["          "]; 
          ITEM ENV6       C(5,  0,  10) = ["PPUS=00   "]; 
          ITEM ENV7       C(6,  0,  10) = ["CM=000000B"]; 
          ITEM ENV8       C(7,  0,  10) = ["          "]; 
          ITEM ENV9       C(8,  0,  20) = ["CONTROL STATEMENT = "]; 
          ITEM ENV10      C(08, 0,  50);
          ITEM ENV11      C(11, 0,  10);
          ITEM ENV12      C(12, 0,  10);
          ITEM ENV13      C(13, 0,  10) = ["          "]; 
          ITEM ENV14      C(14, 0,  10) = ["SUNDAY    "]; 
          ITEM ENV15      C(15, 0,  20) = [" MM/DD/YY  HH.MM.SS "]; 
          ITEM ENV17      C(17, 0,  10) = ["          "]; 
          ITEM ENV18      C(18, 0,  10) = ["SAVE=YES  "]; 
          ITEM ENV19      C(19, 0,  10) = ["TAPE=YES  "]; 
          ITEM ENV20      C(20, 0,  10) = ["PURGE=YES "]; 
          END 
 
 
  CONTROL EJECT;
                                                  #COMMON DECLARATIONS #
    COMMON PASSIT;
      BEGIN 
      ITEM IOFWA      I;
      ITEM IOCNT      I;
      ITEM IOCMP      I;
      ITEM IOLVL      I;
      ITEM IOFLG      I;
      END 
 
    COMMON PARAMS;
        BEGIN 
        ITEM CMODE      I;
        ITEM CSTAT      I;
        ARRAY CMSG     [0:7] S(1);
              BEGIN 
              ITEM CMESS      C(0, 0, 10);
              ITEM CMSG80     C(0, 0, 80);
              END 
        END 
 
    COMMON TIGRCOM; 
        BEGIN 
          ITEM TCSTAT     I;
          ITEM TCLEN      I;
          ARRAY TBUFFR [0:64] S(1); 
                BEGIN 
                  ITEM TBUF       C(0, 0, 10);
                  ITEM TBUFNAM    C(0, 0,  7);
                  ITEM TBUFCNT    U(0, 0, 24);
                  ITEM TBUFTYP    C(0, 42, 3);
                END 
        END 
 
    COMMON COPYCOM; 
        BEGIN 
          ITEM PFN1       C(10);
          ITEM UN1        C(10);
          ITEM PFN2       C(10);
          ITEM UN2        C(10);
          ITEM PFN3       C(10);
          ITEM UN3        C(10);
        END 
 
    COMMON PFEMSG;
        BEGIN 
          ITEM PFERMSG    C(30);
          ITEM PFEZBYT    I;
        END 
  CONTROL EJECT;
                                                  #COMMON DECLARATIONS #
 
    COMMON SIERRAC; 
      BEGIN 
       ARRAY SIE [0:0] S(7);
             BEGIN
             ITEM SIECM      U(0, 00, 30);
             ITEM SIEDATE    C(1, 00, 10);
             ITEM SIEJDATE   C(2, 00, 10);
             ITEM SIEJYR     C(2, 30, 02);
             ITEM SIEJDAY    C(2, 42, 03);
             ITEM SIETIME    C(3, 00, 10);
             ITEM SIECPUS    U(4, 24, 24);
             ITEM SIECPUMS   U(4, 48, 12);
             ITEM SIEUSER    C(5, 00, 07);
             ITEM SIEMID     C(6, 00, 10);
             END
      END 
 
  COMMON MSGCOM;
      BEGIN 
      ARRAY MSGCOMA [0:8] S(1); 
            BEGIN 
              ITEM OPMSG1    C(0, 00, 10);
              ITEM OPMSG     C(0, 00, 80);
              ITEM OPMSGZB   U(0, 00, 60);
            END 
      END 
 
  COMMON PFTABLES;
      BEGIN 
      ARRAY PFTABLE [0:99] S(1);
          BEGIN 
            ITEM PFLIST     C(0, 00,  9); 
            ITEM PFTYPE     U(0, 54,  6); 
          END 
      END 
 
      DEF DIR #4#;
      DEF IND #9#;
*IF DEF,CDCNET
      DEF NFM #3#;
 
COMMON NFMBLK;
       BEGIN
       ARRAY NETFMBLOCK [0:30] S(1);
             BEGIN
             ITEM NFMLFN     C(0,0,6);
             ITEM NFMNFN     C(0,0,10); 
             ITEM NFMPFN     C(0,0,7);
             ITEM NFMSTAT    U(0,42,18);
             ITEM NFMWORD    U(0,0,60); 
             END
       END
*ENDIF
  CONTROL EJECT;
 
    COMMON PFNLIST; 
       BEGIN
       ARRAY PFNA [0:20] S(1);
             BEGIN
               ITEM PFNC1C2    C(0, 0, 10); 
             END
       ARRAY PFNB [0:39] S(1);
             BEGIN
               ITEM PFNC3      C(0, 0, 10); 
               ITEM PFNC3NP    C(20, 0, 10);
             END
       END
 
    COMMON PACKING; 
        BEGIN 
        ITEM PACK80     C(80);
        ITEM PACK160    C(100); 
        ITEM PACKEND    C(10);
        ARRAY PACK01    [0:79] S(1);
              BEGIN 
              ITEM PACKW      C(0, 0, 10);
              END 
        ITEM UPCSTAT    U;
        ITEM UPCOUNT    U;
        END 
  CONTROL EJECT;
 
    XREF
    ARRAY RAZERO [0:0] S(64); 
          BEGIN 
          ITEM JCACFO     B(00, 45, 01);
          ITEM JCACMU     B(53, 00, 01);
          ITEM JCACME     B(54, 00, 01);
          ITEM JCAPPU     U(54, 07, 05);
          ITEM JCA70      C(56, 00, 50);
          ITEM JCAOPMSG   C(56, 00, 80);
          END 
 
    ARRAY DATALNY [0:0] S(12);
          BEGIN 
          ITEM LNY0       C(0, 0, 20) = ["          MODE = 00B"]; 
          ITEM LNY1       C(2, 0, 20) = ["        OPTION = 00B"]; 
          ITEM LNY2       C(4, 0, 20) = ["          NIN = 000D"]; 
          ITEM LNY3       C(6, 0, 20) = ["        NINCR = 000D"]; 
          ITEM LNY4       C(8, 0, 20) = ["        NINLO = 000D"]; 
          ITEM LNY5       C(10,0, 20) = ["        NINHI = 000D"]; 
          ITEM LNY1A      C(1, 42, 2);
          ITEM LNY1B      C(3, 42, 2);
          ITEM LNY1C      C(5, 36, 3);
          ITEM LNY1D      C(7, 36, 3);
          ITEM LNY1E      C(9, 36, 3);
          ITEM LNY1F      C(11,36, 3);
          END 
 
    ARRAY DAY2DAY [0:6] S(1); 
          BEGIN 
          ITEM DAY0       C(0, 0, 10) = ["SUNDAY    "]; 
          ITEM DAY1       C(1, 0, 20) = ["MONDAY    TUESDAY   "]; 
          ITEM DAY3       C(3, 0, 20) = ["WEDNESDAY THURSDAY  "]; 
          ITEM DAY5       C(5, 0, 20) = ["FRIDAY    SATURDAY  "]; 
          END 
 
  CONTROL EJECT;
 
 
                                                  # PROC READ$CFO      #
  PROC READ$CFO;
 
  BEGIN 
 
    ITEM SAVEFWA    I;
 
    FOR K = 0 STEP 1 UNTIL 7 DO 
        CMESS[K] = SPACES;
    CFOBSET;
    #   IF NOT DD60 THEN READLN        #
    CFOWAIT;
    CMSG80[0] = JCAOPMSG[0];
    SAVEFWA = IOFWA;
    IOFWA = LOC(CMSG80[0]); 
    IOCNT = 7;
    PUTLINE;
    OPMSG[0] = CMSG80[0]; 
    OPMSGZB[4] = 0; 
    SENDMSG;
    IOFWA = SAVEFWA;
 
  END   #READ CFO#
 
 
 
  PROC FILL55 (FILET);
 
  BEGIN 
 
    ITEM FILET      C(10);
 
    FOR N2 = 0 STEP 1 UNTIL 9 DO
        IF (C<N2,1>FILET LS "A") OR (C<N2,1>FILET GR "9") 
           THEN C<N2,1>FILET = " "; 
 
    END     #FILL55#
 
 
  PROC STRIP55 (STRIPIT); 
 
  BEGIN 
 
    ITEM STRIPIT   C(10); 
 
    FOR N2 = 0 STEP 1 UNTIL 9 DO
        IF (C<N2,1>STRIPIT LS "A") OR (C<N2,1>STRIPIT GR "9") 
           THEN C<N2,1>STRIPIT = 0; 
 
  END     #STRIP55# 
 
  CONTROL EJECT;
                                                  # PROC SHOTERM       #
 
    PROC SHOTERM (FWA, COUNT, FLUSH); 
 
    BEGIN 
 
      ITEM FWA I; 
      ITEM COUNT I; 
      ITEM FLUSH B; 
 
      IF FWA NQ 0 THEN IOFWA = FWA; 
      IF COUNT NQ 0 THEN IOCNT = COUNT; 
      PUTTERM;
      IF FLUSH THEN PUTTRMX;
 
    END #SHOTERM# 
 
 
 
                                                  # PROC CLR$OPMSG     #
  PROC CLR$OPMSG; 
  BEGIN 
    ITEM NN         I;
    FOR NN = 0 STEP 1 UNTIL 7 DO
        OPMSG1[NN] = SPACES;
  END 
 
 
 
                                                  # PROC WEEKDAY       #
    PROC WEEKDAY; 
 
    BEGIN 
 
      EDITX = SIEJYR; 
      N1 = C<0,1>EDITX - "0"; 
      N2 = C<1,1>EDITX - "0"; 
      N  = (N1 * 10) + N2;
      NR1 = 365.25 * N; 
      EDITX = SIEJDAY;
      N1 =       (C<0,1>EDITX - "0") * 100; 
      N1 = N1 + ((C<1,1>EDITX - "0") * 10); 
      N1 = N1 +  (C<2,1>EDITX - "0"); 
      NR1 = NR1 + N1; 
      N = NR1;
      NR2 = N;
      IF NR1 EQ NR2 THEN NR1 = NR1 - 1.0; 
      N = NR1;
      FOR K=0 WHILE N GR 6 DO 
        N = N -7; 
      ENV14 = DAY0[N];
 
    END #WEEKDAY# 
 
  CONTROL EJECT;
 
  FUNC DCODE (CHARS) I; 
 
  BEGIN 
 
    ITEM CHARS C(10); 
    ITEM TVAL I;
    ITEM J1   I;
 
    DCODE = 0;
    TVAL = 0; 
 
    FOR J1 = 0 STEP 1 UNTIL 9 DO
    BEGIN 
      IF (C<J1,1>CHARS GQ "0") AND (C<J1,1>CHARS LQ "9")
       THEN   TVAL = TVAL * 10 + (C<J1,1>CHARS - "0");
    END 
 
    DCODE = TVAL; 
 
  END #DCODE# 
 
  CONTROL EJECT;
 
  PROC CRACK$CALL;
 
  BEGIN 
    PACK80 = SPACES;
    PACK80 = JCAOPMSG;
    C<79,1>PACK80 = ".";
 
    SETUPC; 
 
    USERNUM = SPACES; 
    NETINV = "NIN0999   ";
    SHORT = TRUE; 
 
    FOR J2 = 0 STEP 1 WHILE C<0,1>PACKW[J2] NQ 0 DO 
    BEGIN 
      SCANF = PACKW[J2];
      SCANV = PACKW[J2+1];
      FILL55 (SCANF); 
      FILL55 (SCANV); 
          SCANK = C<0, 4>SCANF; 
          IF SCANK EQ "NOPU" THEN FL2PURGE = FALSE; 
          IF SCANK EQ "NOSA" THEN FL2SAVE  = FALSE; 
          IF SCANK EQ "UN  " THEN USERNUM = SCANV;
          IF SCANK EQ "NINL" THEN INV$LOW = DCODE (SCANV);
          IF SCANK EQ "NINH" THEN INV$HIGH  = DCODE (SCANV);
          IF SCANK EQ "NIN " THEN INV$HIGH = DCODE (SCANV); 
          IF SCANK EQ "OIN " THEN INV$HIGH = DCODE (SCANV); 
          IF SCANK EQ "NINC" THEN INV$ONE = DCODE (SCANV);
          IF SCANK EQ "SHOR" THEN SHORT = TRUE; 
          IF SCANK EQ "FULL" THEN SHORT = FALSE;
    END 
    IF INV$ONE NQ 0 THEN CHK$RANGE = FALSE; 
    IF INV$ONE EQ 0 THEN INV$ONE = INV$HIGH;
    INV$ONE = INV$ONE + 10000;
    EDITX = XCDD (INV$ONE); 
    INV$ONE = INV$ONE - 10000;
    C<4,3>NETINV = C<7,3>EDITX; 
  END     #CRACK$CALL#
  CONTROL EJECT;
 
                                                  # PROC INITCPA       #
    PROC INITCPA; 
 
    BEGIN 
 
      SIERRA; 
 
      IF NOT JCACFO THEN C<4,3>ENV2 = "NO ";
      IF NOT JCACMU THEN C<4,3>ENV3 = "NO ";
      IF NOT JCACME THEN C<6,3>ENV4 = "NO ";
      N = JCAPPU; 
      EDITX = XCDD(N);
      C<5,2>ENV6 = C<8,2>EDITX; 
      N = SIECM;
      EDITX = XCOD(N);
      C<3,6>ENV7 = C<4,6>EDITX; 
      C<00,10>ENV15 = SIEDATE;
      C<10,10>ENV15 = SIETIME;
      WEEKDAY;
      IF (NOT FL2PURGE) THEN C<6,3>ENV20 = "NO "; 
      IF (NOT FL2TAPE)  THEN C<5,3>ENV19 = "NO "; 
      IF (NOT FL2SAVE)  THEN C<5,3>ENV18 = "NO "; 
      SHOTERM (LOC(ENV1), 1, FALSE);
      SHOTERM (LOC(ENV1), 4, FALSE);
      SHOTERM (LOC(ENV5), 3, FALSE);
      SHOTERM (LOC(ENV8), 3, FALSE);
      ENV10 = JCA70;
      FOR K = 0 STEP 1 UNTIL 49 DO
        IF C<K,1>ENV10 EQ 0 THEN C<K,1>ENV10 = " "; 
      SHOTERM (LOC(ENV8), 6, FALSE);
      SHOTERM (LOC(ENV13), 1, FALSE); 
      SHOTERM (LOC(ENV13), 4, FALSE); 
      SHOTERM (LOC(ENV17), 1, FALSE); 
      SHOTERM (LOC(ENV17), 4, FALSE); 
      SHOTERM (LOC(ENV17), 1, TRUE);
 
      NR1 = SIECPUS * 1000.0; 
      NR2 = SIECPUMS; 
      NR1 = NR1 + NR2;
 
    END #INITCPA# 
 
  CONTROL EJECT;
 
                                                  # PROC DS$DEFAULT    #
  PROC DS$DEFAULT;
 
  BEGIN 
 
      EDITX = XCOD(CMODE);
      LNY1A = C<8,2>EDITX;
      EDITX = XCOD(OPTION); 
      LNY1B = C<8,2>EDITX;
      LNY1C = C<4,3>NETINV; 
      EDITX = XCDD(INV$ONE);
      LNY1D = C<7,3>EDITX;
      EDITX = XCDD(INV$LOW);
      LNY1E = C<7,3>EDITX;
      EDITX = XCDD(INV$HIGH); 
      LNY1F = C<7,3>EDITX;
      SHOTERM (LOC(LNY0), 6, FALSE);
      SHOTERM (LOC(LNY3), 6, FALSE);
      SHOTERM (LOC(LNY0), 1, TRUE); 
 
  END     #DS$DEFAULT#
 
 
 
  FUNC IN$RANGE B;
 
  BEGIN 
 
    IN$RANGE = FALSE; 
    EDITX = C<4,3>PFN1; 
    IF CHK$RANGE THEN 
    BEGIN 
      IF DCODE (EDITX) LS INV$LOW THEN RETURN;
      IF DCODE (EDITX) GR INV$HIGH THEN RETURN; 
      IN$RANGE = TRUE;
      RETURN; 
    END 
    ELSE
    BEGIN 
      IF DCODE (EDITX) NQ INV$ONE THEN RETURN;
      IN$RANGE = TRUE;
      RETURN; 
    END 
 
  END     #IN$RANGE#
 
 
 
  CONTROL EJECT;
 
                                                  # PROC SETUP$CLCT    #
  PROC SETUP$CLCT;
 
  BEGIN 
 
      CLR$OPMSG;
      OPMSG[0] = IDVERSN; 
      SENDMSG;
 
      CRACK$CALL; 
 
 
 
      CMODE = 0;
      IF FL2PURGE THEN CMODE = CMODE + MODE$P;
      IF FL2TAPE  THEN CMODE = CMODE + MODE$T;
      IF FL2DISK  THEN CMODE = CMODE + MODE$D;
      IF FL2SAVE  THEN CMODE = CMODE + MODE$S;
 
      STRIP55(USERNUM); 
 
      INITCPA;
      DS$DEFAULT; 
 
      FOR N = 0 STEP 1 UNTIL 99 DO
      BEGIN 
        PFLIST[N]   = SPACES; 
        PFTYPE[N]   = 0;
      END 
 
 
      TCSTAT = 0; 
      MORE$2$DO = TRUE; 
 
  END #SETUP$CLCT#
  CONTROL EJECT;
 
  PROC SHOW$STAT (SWRD, OP, FTYPE); 
 
  BEGIN 
 
    ITEM SWRD       C(10);
    ITEM OP         C(10);
    ITEM FTYPE      I;
 
    LINX[0] = SPACES; 
    EDITX = SWRD; 
    EDITX = C<0,7>EDITX;
    FILL55 (EDITX); 
      IF FTYPE EQ DIR THEN LINX[0] = " DIR FILE ";
      IF FTYPE EQ IND THEN LINX[0] = " IND FILE ";
*IF DEF,CDCNET
      IF FTYPE EQ NFM THEN LINX[0] = " NFM FILE ";
*ENDIF
      LINX[1] = EDITX;
      LINX[2] = " FCN =     ";
      C<7,3>LINX[2] = C<0,3>OP; 
      LINX[3] = "     ST = "; 
      K = SWRD LAN O"77 7777";
      EDITX = XCOD(K);
      LINX[4] = SPACES; 
      LINX[4] = C<4,6>EDITX;
      SHOTERM (LOC(LINX[0]), 5, TRUE);
 
  END     #SHOW$STAT# 
 
 
 
  FUNC PFERR (NAMPF) B; 
 
  BEGIN 
 
    ITEM NAMPF      C(10);
 
    K = NAMPF / 2**10;
    K = K LAN O"377"; 
    IF K EQ 0 THEN PFERR = FALSE; 
    IF K NQ 0 THEN PFERR = TRUE;
    IF K EQ 0 THEN RETURN;
 
    LINX[0] = SPACES; 
    LINX[1] = "ERROR CODE"; 
    LINX[2] = SPACES; 
    EDITX = XCOD (K); 
    LINX[2] = C<6,4>EDITX;
    SHOTERM (LOC(LINX[0]), 3, FALSE); 
    SHOTERM (LOC(PFERMSG), 3, TRUE);
    RETURN; 
 
  END     #PFERR#;
  CONTROL EJECT;
 
  PROC CAT$LIST;
 
  BEGIN 
 
    UN2 = USERNUM;
 
    FOR TCSTAT = 0 WHILE MORE$2$DO DO 
    BEGIN 
      TIGRLST;
      TCSTAT = TCSTAT LAN O"1777";
        FOR J1 = 0 STEP 16 WHILE J1 LS  TCLEN DO
        BEGIN 
          PFLIST[NDXPF] = XSFW(TBUFNAM[J1]);
          TOTPRU = TOTPRU + TBUFCNT[J1+1];
          LINX[0] = SPACES; 
          C<1,8>LINX[0] = C<0,8>PFLIST[NDXPF];
          EDITX = XCDD (TBUFCNT[J1+1]); 
          LINX[1] = EDITX;
          TBUFTYP[J1+7] = "IND";
          PFTYPE[NDXPF] = IND;
          IF (TBUF[J1+1] LAN O"4000") NQ 0 THEN 
             BEGIN
             TBUFTYP[J1+7] = "DIR"; 
             PFTYPE[NDXPF] = DIR; 
             END
          C<0,3>LINX[1] = TBUFTYP[J1+7];
          IF (NOT SHORT) THEN SHOTERM (LOC(LINX[0]), 2, FALSE); 
          NDXPF = NDXPF +1; 
          PFLIST[NDXPF] = 0;
        END 
        MORE$2$DO = TCSTAT NQ STATEOI;
        IF NDXPF GQ 96 THEN MORE$2$DO = FALSE;
 
    END 
 
    IF TCSTAT EQ STATEOI THEN 
    BEGIN 
      LINX[0] = "  TOTAL = "; 
      LINX[1] = XCDD (TOTPRU);
      SHOTERM (LOC(LINX[0]), 2, TRUE);
    END 
  END     #CAT$LIST#
  CONTROL EJECT;
 
                                     #COPY$ONE FILE#
  PROC COPY$ONE;
 
  BEGIN 
 
      PFN1 = PFLIST[INDX1]; 
 
      IF IN$RANGE THEN
      BEGIN 
 
        STRIP55(PFN1);
        C<0,4>PFN2 = "DUMP";
        IF C<0,2>PFN1 EQ "NP" THEN C<0,4>PFN2 = "DUNP"; 
        IF PFTYPE[INDX1] EQ IND THEN CPYGET;
        IF PFTYPE[INDX1] EQ DIR THEN CPYATT;
 
        SHOW$STAT (PFN1, "ACC", PFTYPE[INDX1]); 
 
        IF (NOT PFERR(PFN1)) THEN 
        BEGIN 
          IF FL2SAVE THEN 
          BEGIN 
            CPYFLS; 
            LINX[0] = "   COPIED "; 
            LINX[1] = PFLIST[INDX1];
            SHOTERM (LOC(LINX[0]), 2, TRUE);
          END 
          IF FL2PURGE THEN
          BEGIN 
            CPYRET; 
            PFN1 = PFLIST[INDX1]; 
            STRIP55(PFN1);
            CPYPUR; 
            SHOW$STAT (PFN1, "PUR", PFTYPE[INDX1]); 
            IF (NOT PFERR(PFN1)) THEN N = N;
          END 
        END 
 
        CPYRET; 
 
      END 
 
  END #COPY$ONE#
  CONTROL EJECT;
 
                                             #FIND/COPY FILES     # 
  PROC COPY$FILES;
 
  BEGIN 
 
 
  FOR J1 = 0 STEP 1 WHILE C<0,1>PFNC1C2[J1] NQ 0 DO 
  BEGIN 
    J3 = 0; 
    IF C<0,2>PFNC1C2[J1] EQ "NP" THEN J3 = 20;
    FOR J2 = J3 STEP 1 WHILE C<0,1>PFNC3[J2] NQ 0 DO
    BEGIN 
      SCANF = SPACES; 
      C<0,2>SCANF = PFNC1C2[J1];
      C<2,1>SCANF = PFNC3[J2];
      LINX[0] = SPACES; 
      LINX[1] = "SEARCH--  "; 
      LINX[2] = SCANF;
      IF (NOT SHORT) THEN SHOTERM (LOC(LINE), 3, TRUE); 
      FOR INDX1 = 0 STEP 1 WHILE INDX1 LS NDXPF DO
          IF C<0,3>SCANF EQ C<0,3>PFLIST[INDX1] THEN COPY$ONE;
    END 
  END 
 
  END     #COPY$FILES#
*IF DEF,CDCNET
CONTROL EJECT;
 
PROC CPYMDIDUMP;
 
# 
*        COPY ONE MDI DUMP FILE 
# 
 
BEGIN 
 
ITEM NFMRC U; 
 
PFN1 = PFLIST[INDX1]; 
IF IN$RANGE 
   THEN BEGIN 
        C<0,4>PFN2 = "DMDI";
        FOR K1 = 0 STEP 1 UNTIL 30 DO 
            NFMWORD[K1] = 0;
        NFMLFN[0] = "CPYFL1"; 
        NFMPFN[22] = PFN1;
        NETFMA (LOC (NETFMBLOCK),NFMRC);
        NFMSTAT[22] = NFMRC;
        SHOW$STAT (NFMWORD[22], "ATT", NFM);
        IF NFMRC EQ 0 
           THEN BEGIN 
                IF FL2SAVE
                   THEN BEGIN 
                        CPYFLS; 
                        LINX[0] = "   COPIED "; 
                        LINX[1] = PFLIST[INDX1];
                        SHOTERM (LOC(LINX[0]), 2, TRUE);
                        END 
                IF FL2PURGE 
                   THEN BEGIN 
                        CPYRET; 
                        NFMSTAT[22] = 0;
                        NETFMP (LOC (NETFMBLOCK),NFMRC);
                        NFMSTAT[22] = NFMRC;
                        SHOW$STAT (NFMWORD[22], "PUR", NFM);
                        END 
                END 
 
        ELSE
          BEGIN 
          # COULD NOT HAVE ACCESS TO THE FILE THROUGH NETFM.      # 
          # GO AHEAD TRY TO CELLECT (AND/OR PURGE) IT DIRECTLY    # 
          # WITHOUT CALLING NETFM.                                # 
 
          PFN1 = PFLIST[INDX1]; 
          STRIP55(PFN1);
 
          IF PFTYPE[INDX1] EQ IND        # IF THIS IS AN INDIRECT # 
          THEN                           # ACCESS FILE , GET IT.  # 
            CPYGET; 
          ELSE                        # OTHERWISE, IT MUST BE     # 
            CPYATT;                   # DIRECT ACCESS, ATTACH IT. # 
 
          IF (NOT PFERR(PFN1)) THEN   # IF NO ERROR IN ACCESS TO  # 
            BEGIN                     # THE FILE, PROCESS IT.     # 
            IF FL2SAVE THEN           # IF NOSAVE IS NOT SPECIFIED# 
              BEGIN 
              CPYFLS; 
              LINX[0] = "   COPIED "; 
              LINX[1] = PFLIST[INDX1];
              SHOTERM (LOC(LINX[0]), 2, TRUE);
              END 
 
            IF FL2PURGE THEN        # IF NOPURGE IS NOT SPECIFIED # 
              BEGIN 
              CPYRET;                  # RETURN THE FILE          # 
              PFN1 = PFLIST[INDX1]; 
              STRIP55(PFN1);
              CPYPUR;                  # PURGE THE FILE           # 
              SHOW$STAT (PFN1, "PUR", PFTYPE[INDX1]); 
              END 
            END 
          END 
 
        CPYRET; 
 
        END 
 
END      # CPYMDIDUMP # 
CONTROL EJECT;
 
PROC CPYMDIDMPS;
 
# 
*   THIS PROC VISITS EVERY FILE NAME IN PFLIST ONCE. IF A FILE NAME 
*   STARTS WITH SOMETHING IN THE RANGE DI..D9, IT WILL CALL CPYMDIDUMP
*   TO COLLECT (AND/OR PURGE) THE FILE. 
# 
 
BEGIN 
 
ITEM  DI      C(10) = "DI"; 
ITEM  D9      C(10) = "D9"; 
 
FOR INDX1 = 0 STEP 1 WHILE INDX1 LS NDXPF DO
  BEGIN 
  IF ( B<0,12>PFLIST[INDX1] GQ B<0,12>DI ) AND
     ( B<0,12>PFLIST[INDX1] LQ B<0,12>D9 )
  THEN
    CPYMDIDUMP; 
  END 
END      # CPYMDIDMPS # 
*ENDIF
 
  CONTROL EJECT;
                                                  # PROC COLLECT       #
                                                  # (MAIN  PROCESS)    #
 
*IF DEF,CDCNET
      NETCDA ($DEFAULT,$CURRENT);   #USE NETDIR IN THE CURRENT USER # 
*ENDIF
      SETUP$CLCT; 
      PFN2 = "DUMPVVV"; 
      C<4,3>PFN2 = C<4,3>NETINV;
      UN2  = USERNUM; 
      UN1  = USERNUM; 
      STRIP55(UN1); 
      STRIP55(UN2); 
      STRIP55(PFN2);
      IF FL2SAVE THEN 
      BEGIN 
        CPYOPN;          # OPEN DUMPXXX FILE - ALL BUT NP/MDI FILES # 
        SHOW$STAT (PFN2, "OPN", DIR); 
        C<0,4>PFN2 = "DUNP";
        CPYOPN;          # OPEN DUNPXXX FILE - NP DUMP FILES #
        SHOW$STAT (PFN2, "OPN", DIR); 
*IF DEF,CDCNET
        C<0,4>PFN2 = "DMDI";
        CPYOPN;          # OPEN DMDIXXX FILE - MDI DUMP FILES # 
        SHOW$STAT (PFN2, "OPN", DIR); 
*ENDIF
        C<0,4>PFN2 = "DUMP";
      END 
 
      FOR TCSTAT = 0 WHILE TCSTAT NQ STATEOI DO 
      BEGIN 
        NDXPF = 0;
        MORE$2$DO = TRUE; 
        CAT$LIST; 
        COPY$FILES; 
*IF DEF,CDCNET
        CPYMDIDMPS; 
*ENDIF
      END 
 
      C<0,4>PFN2 = "DUMP";
      IF FL2SAVE THEN CPYSAV; 
      C<0,4>PFN2 = "DUNP";
      IF FL2SAVE THEN CPYSAV; 
*IF DEF,CDCNET
      C<0,4>PFN2 = "DMDI";
      IF FL2SAVE THEN CPYSAV; 
*ENDIF
 
      SIERRA; 
      NR2 = SIECPUS * 1000.0; 
      NR2 = NR2 + SIECPUMS; 
      NR2 = NR2 - NR1;
      J2 = NR2; 
      EDITX = XCFD(J2); 
      OPMSG[0] = "     CPU  MS  REQD  ";
      OPMSG1[2] = EDITX;
      OPMSGZB[3] = 0; 
      SENDMSG;
      SHOTERM (LOC(OPMSG[0]), 3, TRUE); 
 
      OFLUSH; 
      FINSHIO;
 
 
 
 
  END #COLLECT# 
 
  TERM
*CWEOR,0