*DECK DCUTL 
00001  IDENTIFICATION DIVISION.                                         11/09/78
       PROGRAM-ID. DCUTL. 
*CALL COPYRIGHT 
00003 ******************************************************************   LV002
00004 *     THIS IS THE ROOT MODULE FOR THE DATA ADMINISTRATOR UTILITY     CL**2
00005 *                                                                *DCUTLCOP
00006 ******************************************************************DCUTLCOP
00007  ENVIRONMENT DIVISION.                                            DCUTLCOP
00008  CONFIGURATION SECTION.                                           DCUTLCOP
       SOURCE-COMPUTER.  CYBER. 
       OBJECT-COMPUTER.  CYBER. 
*CALL OTHSN 
00011  INPUT-OUTPUT SECTION.                                            DCUTLCOP
00012  FILE-CONTROL.                                                    DCUTLCOP
           SELECT MAST1 ASSIGN TO "MAST1" 
               ORGANIZATION IS DIRECT 
               ACCESS MODE IS RANDOM
               RECORD KEY IS DATA-KEY-2.
           SELECT MAST3 ASSIGN TO "MAST3" 
               ORGANIZATION IS RELATIVE 
               ACCESS MODE IS RANDOM
               RELATIVE KEY IS CONTROL-NOM-KEY
               USE "PRUF=YES".
           SELECT SYSPRINT ASSIGN TO "OUTPUT".
           SELECT SYSINFIL ASSIGN TO "INPUT". 
           SELECT SOURCE-FILE ASSIGN TO "SOURCE"
           USE "RT=Z".
           SELECT TARGET-FILE ASSIGN TO "TARGET"
           USE "RT=Z".
           SELECT NEW-TARGET-FILE ASSIGN TO "NEWTARG" 
           USE "RT=Z".
00024  DATA DIVISION.                                                   DCUTLCOP
00025  FILE SECTION.                                                    DCUTLCOP
00026  FD  SYSINFIL                                                        CL**2
00029      LABEL RECORDS ARE OMITTED                                       CL**2
00030      DATA RECORDS ARE CARD-REC.                                      CL**2
00031  01  CARD-REC.                                                       CL**2
00032      05  FUNCTION-TYPE.                                              CL**2
00033          10  FUNCTION-TYPE-3     PICTURE XXX.                        CL**2
00034          10  FILLER              PICTURE X(5).                       CL**2
00035      05  FILLER                  PICTURE X(72).                      CL**2
00036  01  CARD-REC1.                                                      CL**2
00037      05  FILLER                  PICTURE XXX.                        CL**2
00038      05  FUNCTION-OPERAND.                                           CL**2
00039      10  TX-POS        PICTURE X OCCURS 77 TIMES.                    CL**2
*CALL     MAST3FD 
*CALL     SYSPRTFD
00043  FD  SOURCE-FILE                                                     CL**2
00046      LABEL RECORDS ARE OMITTED                                       CL**2
00048      DATA RECORDS ARE SOURCE-CARD.                                   CL**2
00049  01  SOURCE-CARD             PICTURE X(80).                          CL**2
00051  FD  TARGET-FILE                                                     CL**2
00054      LABEL RECORDS ARE OMITTED                                       CL**2
00056      DATA RECORDS ARE TARGET-CARD.                                   CL**2
00057  01  TARGET-CARD             PICTURE X(80).                          CL**2
       FD  NEW-TARGET-FILE
           LABEL RECORDS ARE OMITTED
           DATA RECORDS ARE NEW-TARGET-CARD.
       01  NEW-TARGET-CARD            PICTURE X(80).
*CALL     MAST1FD2
       COMMON-STORAGE SECTION.
       77  RETURN-CODE PICTURE 99 VALUE ZERO. 
00067 ****************************************************************     CL**2
00068 *                                                                    CL**2
00069 *        LINKAGE FOR ALL                                             CL**2
00070 *                                                                    CL**2
00071 ****************************************************************     CL**2
00072  01  WKPRINT-UTL.                                                    CL**2
*CALL     WKPRINT 
00074      10  ERROR-LINE REDEFINES STD-REPORT-REC.                        CL**2
00075          15  FILLER              PICTURE X(20).                      CL**2
00076          15  ERROR-POS1          PICTURE X(6).                       CL**2
00077          15  ERROR-POS2          PICTURE X(60).                      CL**2
00078          15  FILLER              PICTURE X(46).                      CL**2
00080 ***************************************************************      CL**2
00081 *                                                                    CL**2
00082 *     LINKAGE FOR BACKUP AND RESTORE                                 CL**2
00083 *                                                                    CL**2
00084 ***************************************************************      CL**2
00085  01  UTL-TABLE-BUP.                                               DCUTLCOP
00086      05  MAST1-OPT               PICTURE X.                       DCUTLCOP
00087      05  MAST2-OPT               PICTURE X.                       DCUTLCOP
00088      05  MAST3-OPT                   PICTURE X.                      CL**2
00089      05  OFFCOND                 PICTURE X  VALUE "N".            DCUTLCOP
           05 REV-SAVE   PICTURE 9(5).
00090      05  ENTRY-TYPES.                                             DCUTLCOP
               10  DBPROC-TYPE        PICTURE XX. 
               10  DBPROC-NAME        PICTURE X(15).
00091          10  ELEMENT-TYPE            PICTURE XX.                  DCUTLCOP
00092          10  ELEMENT-NAME          PICTURE X(15).                    CL**2
00093          10  GROUP-TYPE            PICTURE XX.                    DCUTLCOP
00094          10  GROUP-NAME          PICTURE X(15).                      CL**2
00095          10  RECORD-TYPE            PICTURE XX.                   DCUTLCOP
00096          10  RECORD-NAME          PICTURE X(15).                     CL**2
00097          10  FILE-TYPE            PICTURE XX.                     DCUTLCOP
00098          10  FILE-NAME          PICTURE X(15).                       CL**2
               10  AREA-TYPE          PICTURE XX. 
               10  AREA-NAME          PICTURE X(15).
               10  SUBSCHEMA-TYPE     PICTURE XX. 
               10  SUBSCHEMA-NAME     PICTURE X(15).
               10  SCHEMA-TYPE        PICTURE XX. 
               10  SCHEMA-NAME        PICTURE X(15).
00099          10  IMSDB-TYPE            PICTURE XX.                    DCUTLCOP
00100          10  IMSDB-NAME          PICTURE X(15).                      CL**2
00101          10  IMSPSB-TYPE            PICTURE XX.                   DCUTLCOP
00102          10  IMSPSB-NAME          PICTURE X(15).                     CL**2
00103          10  FORM-TYPE            PICTURE XX.                     DCUTLCOP
00104          10  FORM-NAME          PICTURE X(15).                       CL**2
00105          10  REPORT-TYPE            PICTURE XX.                   DCUTLCOP
00106          10  REPORT-NAME          PICTURE X(15).                     CL**2
00107          10  PROGRAM-TYPE            PICTURE XX.                  DCUTLCOP
00108          10  PROGRAM-NAME          PICTURE X(15).                    CL**2
00109          10  TASK-TYPE            PICTURE XX.                     DCUTLCOP
00110          10  TASK-NAME          PICTURE X(15).                       CL**2
00111          10  RESOURCE-TYPE            PICTURE XX.                 DCUTLCOP
00112          10  RESOURCE-NAME          PICTURE X(15).                   CL**2
00113          10  SYSTEM-TYPE            PICTURE XX.                   DCUTLCOP
00114          10  SYSTEM-NAME          PICTURE X(15).                     CL**2
00115          10  MGMT-TYPE            PICTURE XX.                     DCUTLCOP
00116          10  MGMT-NAME          PICTURE X(15).                       CL**2
           05 REL-NAME                PICTURE X(15) VALUE "RELATIONAL". 
00122      05  CTL-NAME-LINK          PICTURE X(15) VALUE                  CL**2
           "CONTROL". 
00124      05  DATA-RECORD-COUNT.                                       DCUTLCOP
               10 DBPROC-REC-COUNT       PICTURE 9(5).
               10 ELEMENT-REC-COUNT      PICTURE 9(5).
               10 GROUP-REC-COUNT        PICTURE 9(5).
               10 RECORD-REC-COUNT       PICTURE 9(5).
               10 FILE-REC-COUNT         PICTURE 9(5).
               10 AREA-REC-COUNT         PICTURE 9(5).
               10 SUBSCHEMA-REC-COUNT    PICTURE 9(5).
               10 SCHEMA-REC-COUNT       PICTURE 9(5).
               10 IMSDB-REC-COUNT        PICTURE 9(5).
               10 IMSPSB-REC-COUNT       PICTURE 9(5).
               10 FORM-REC-COUNT         PICTURE 9(5).
               10 REPORT-REC-COUNT       PICTURE 9(5).
               10 PROGRAM-REC-COUNT      PICTURE 9(5).
               10 TASK-REC-COUNT         PICTURE 9(5).
               10 RESOURCE-REC-COUNT     PICTURE 9(5).
               10 SYSTEM-REC-COUNT       PICTURE 9(5).
               10 MGMT-REC-COUNT         PICTURE 9(5).
               10 TOTAL-REC-COUNT        PICTURE 9(5).
               10 DBPROC-NAME-COUNT      PICTURE 9(5).
               10 ELEMENT-NAME-COUNT     PICTURE 9(5).
               10 GROUP-NAME-COUNT       PICTURE 9(5).
               10 RECORD-NAME-COUNT      PICTURE 9(5).
               10 FILE-NAME-COUNT        PICTURE 9(5).
               10 AREA-NAME-COUNT        PICTURE 9(5).
               10 SUBSCHEMA-NAME-COUNT   PICTURE 9(5).
               10 SCHEMA-NAME-COUNT      PICTURE 9(5).
               10 IMSDB-NAME-COUNT       PICTURE 9(5).
               10 IMSPSB-NAME-COUNT      PICTURE 9(5).
               10 FORM-NAME-COUNT        PICTURE 9(5).
               10 REPORT-NAME-COUNT      PICTURE 9(5).
               10 PROGRAM-NAME-COUNT     PICTURE 9(5).
               10 TASK-NAME-COUNT        PICTURE 9(5).
               10 RESOURCE-NAME-COUNT    PICTURE 9(5).
               10 SYSTEM-NAME-COUNT      PICTURE 9(5).
               10 MGMT-NAME-COUNT        PICTURE 9(5).
               10 TOTAL-COUNT            PICTURE 9(5).
           05 REL-RECORD-COUNT. 
               10 REL-REC-COUNT          PICTURE 9(5).
               10 REL-ENTRY-COUNT        PICTURE 9(5).
           05 CONTROL-REC-COUNT          PICTURE 9(5).
           05 CTL-LINK. 
               10 DATA-PRIME             PICTURE 9(5).
               10 REL-PRIME              PICTURE 9(5).
00165 *****************************************************************    CL**2
00166 *         LINKAGE FOR RENAME                                         CL**2
00167 *****************************************************************    CL**2
00168  01  TRANS-AREA                   PICTURE X(72).                     CL**2
00169  01  UTL-TABLE-RNM.                                                  CL**2
           05 CTL-PRIME-NUM1   PICTURE 9(5).
           05 CTL-PRIME-NUM2   PICTURE 9(5).
00172      05  FUNCTION-CODE            PICTURE X.                         CL**2
00174 ****************************************************************     CL**2
00175 *     LINKAGE FOR STANDARDS                                          CL**2
00176 *****************************************************************    CL**2
00177  01  UTL-TABLE-STD.                                                  CL**2
00178      05  FUNCTION-CODE-S           PICTURE X.                        CL**2
00180 *****************************************************************    CL**2
00181 *                                                                    CL**2
00182 *          LINKAGE FOR OPTION                                        CL**2
00183 *                                                                    CL**2
00184 *****************************************************************    CL**2
00185  01  UTL-TABLE-OPT.                                                  CL**2
00186          10  LINK-OPT-REC                PICTURE X(80).              CL**2
00187          10  NAME-TYPE   PICTURE XXX VALUE "NAM".                    CL**2
00188          10  ADDRESS-TYPE     PICTURE XXX VALUE "ADD".               CL**2
00189          10  LINES-TYPE   PICTURE XXX VALUE "LIN".                   CL**2
00190          10  ENDMSG-TYPE  PICTURE XXX VALUE "END".                   CL**2
00192 ***************************************************************      CL**2
00193 *                                                                    CL**2
00194 *     LINKAGE FOR INITIATE                                           CL**2
00195 *                                                                    CL**2
00196 ***************************************************************      CL**2
00197  01  UTL-TABLE-INIT.                                                 CL**2
00198      05  INIT-REC1          PICTURE X(72).                           CL**2
00199      05  INIT-REC2          PICTURE X(72).                           CL**2
00200      05  INIT-REC3          PICTURE X(72).                           CL**2
00202 **************************************************                   CL**2
00203 *                                                                    CL**2
00204 *    LINKAGE FOR MOVE/COPY                                           CL**2
00205 *                                                                    CL**2
00206 **************************************************                   CL**2
*CALL     MAST1LK 
*CALL     ENTSAVE 
*CALL     COPYWORK
00211                                                                      CL**2
00212 *****************************************************************    CL**2
00213 *                                                                    CL**2
00214 *             LINKAGE FOR DISPLAY                                    CL**2
00215 *                                                                    CL**2
00216 *****************************************************************    CL**2
00217  01  UTL-TABLE-DISP.                                                 CL**2
00218          10  DISP-LINK    PICTURE X(77).                             CL**2
00220 ***************************************************************      CL**2
00221 *                                                                    CL**2
00222 *     WORK AREAS FOR THIS MODULE                                     CL**2
00223 *                                                                    CL**2
00224 ***************************************************************      CL**2
       01 CONTROL-NOM-KEY   PICTURE 999.
*CALL WRKSTG77
       77 TX-SUB   PICTURE 99.
       77 OPT-SUB  PICTURE 99.
       77 MAX-POS  PICTURE 99 VALUE 77. 
       77 COMMA-CHAR   PICTURE X  VALUE ",".
       77 LINE-SUB     PICTURE 99.
00230  01  WORK-AREA.                                                      CL**2
00231      05  TYPE-CON.                                                   CL**2
00232          10  UTILITY-TYPE        PICTURE X(9) VALUE "$UTILITY ".     CL**2
00233          10  RENAME-TYPE             PICTURE XXX VALUE "REN".        CL**2
00234          10  BACKUP-TYPE   PICTURE XXX VALUE "BAC".                  CL**2
00235          10  RESTORE-TYPE  PICTURE XXX VALUE "RES".                  CL**2
00236          10  STANDARD-TYPE          PICTURE X(3) VALUE "STA".        CL**2
00237          10  REVISION-TYPE PICTURE XXX VALUE "REV".                  CL**2
00238          10  RELEASE-TYPE  PICTURE XXX VALUE "REL".                  CL**2
00239          10  PASSWORD-TYPE         PICTURE X(3) VALUE "PAS".         CL**2
00240          10  NUMBER-TYPE           PICTURE X(3) VALUE "NUM".         CL**2
00241          10  DISPLAY-TYPE  PICTURE XXX VALUE "DIS".                  CL**2
00242          10  ANALYZE-TYPE       PICTURE XXX VALUE "ANA".             CL**2
00243          10  OPTIMIZE-TYPE      PICTURE XXX VALUE "OPT".             CL**2
00244          10  DATA-FILE          PICTURE X(3) VALUE "DAT".            CL**2
00246           10  CON-FILE            PICTURE X(3) VALUE "CON".          CL**2
00247           10  ALL-FILE            PICTURE X(3) VALUE "ALL".          CL**2
00248          10  MAINT-TYPE             PICTURE X(3) VALUE "MAI".        CL**2
00249          10  INIT-TYPE              PICTURE X(3) VALUE "INI".        CL**2
00250          10  PROG-ID              PICTURE X(6) VALUE "DCUTL-".       CL**3
00251          10  COPY-TYPE           PICTURE X(3)  VALUE "COP".          CL**2
00252          10  MOVE-TYPE           PICTURE X(3)  VALUE "MOV".          CL**2
               10  MIGRATE-TYPE           PICTURE X(3) VALUE "MIG". 
00253          10  LITERAL-1         PICTURE X(24) VALUE                   CL**2
00254              "REPORT DATE-".                                         CL**2
00255          10  LITERAL-2         PICTURE X(24) VALUE                   CL**2
00256              "DATE OF LAST REVISION-".                               CL**2
00257          10  LITERAL-3         PICTURE X(5) VALUE                    CL**2
00258              "PAGE".                                                 CL**2
00259          10  LITERAL-4         PICTURE X(31) VALUE                   CL**2
00260              "D A T A   C A T A L O G U E   2".                      CL**2
00261          10  LITERAL-5         PICTURE X(25) VALUE                   CL**2
00262              "REVISION NUMBER-".                                     CL**2
00263      05  FLAG-IND.                                                   CL**2
00264          10  ONCOND          PICTURE X VALUE "Y".                    CL**2
00265          10  END-INPUT               PICTURE X VALUE "N".            CL**2
00266      05  MSG-LINES.                                                  CL**2
00267          10  COPY-REQUESTED PICTURE X VALUE "N".                     CL**2
00268          10  DOING-COPY-NOW PICTURE X VALUE "N".                     CL**2
00269          10  END-MSG.                                                CL**2
00270          15  FILLER             PICTURE X(26) VALUE SPACE.           CL**2
00271              15  FILLER         PICTURE X(48) VALUE                  CL**2
00272              "*** END OF DATA ADMINISTRATOR UTILITY REPORT ***".     CL**2
00273          10  NAME-REPORT              PICTURE X(50) VALUE            CL**2
00274              "         DATA ADMINISTRATOR UTILITY REPORT".           CL**2
00275          10  NOT-UTL          PICTURE X(50) VALUE                    CL**2
00276              "400-S *ERROR $UTILITY TRANSACTION INVALID".            CL**2
00277          10  BAD-FUNC          PICTURE X(50) VALUE                   CL**2
00278              "405-S *ERROR KEYWORD INVALID".                         CL**2
00279          10  BAD-OPER             PICTURE X(52) VALUE                CL**2
00280              "410-S *ERROR OPERAND MUST BE DATA,REL,CON OR ALL".     CL**2
00281          10  BAD-KEY          PICTURE X(50) VALUE                    CL**2
00282              "950-F *ERROR MAST3-READ CLIENT RECORD".                CL**2
00283          10 BAD-KEY1           PICTURE X(50) VALUE                   CL**3
00284              "955-F *ERROR MAST3-READ PW RECORD".                    CL**2
00285          10 BAD-KEY2           PICTURE X(50) VALUE                   CL**3
00286              "960-F *ERROR MAST3-READ ENTRY RECORD".                 CL**2
00287          10 BAD-KEY3           PICTURE X(50) VALUE                   CL**3
00288              "965-F *ERROR MAST3-READ CATG RECORD".                  CL**2
00289          10 BAD-KEY4           PICTURE X(50) VALUE                   CL**3
00290              "970-F *ERROR MAST3-READ FIELD RECORD".                 CL**2
00291          10  INIT-BAD             PICTURE X(50) VALUE                CL**2
00292              "995-F *ERROR INITIATION INCOMPLETE".                   CL**2
00293          10  PROP-MSG.                                               CL**2
00294              15  FILLER           PICTURE X(44) VALUE                CL**2
               "DATA CATALOGUE 2                        V2.0".
00296              15  FILLER           PICTURE X(29) VALUE                CL**2
*CALL LEVEL 
00298          10  COLUMN-LINE1.                                           CL**2
00299              15  FILLER PICTURE X(27) VALUE SPACES.                  CL**2
00300              15  FILLER PICTURE X(30) VALUE                          CL**2
00301              "0        1         2         3".                       CL**2
00302              15  FILLER PICTURE X(30) VALUE                          CL**2
00303              "         4         5         6".                       CL**2
00304              15  FILLER PICTURE X(20) VALUE                          CL**2
00305              "         7         8".                                 CL**2
00306          10  COLUMN-LINE2.                                           CL**2
00307      15  FILLER      PICTURE X VALUE SPACE.                          CL**2
00308          15  COMMON-TX-HDG      PICTURE X(6).                        CL**2
00309      15  FILLER            PICTURE X(20) VALUE                       CL**2
00310          " CARD IMAGE         ".                                     CL**2
00311              15  FILLER PICTURE X(30) VALUE                          CL**2
00312              "1........0.........0.........0".                       CL**2
00313              15  FILLER PICTURE X(30) VALUE                          CL**2
00314              ".........0.........0.........0".                       CL**2
00315              15  FILLER PICTURE X(20) VALUE                          CL**2
00316              ".........0..3......0".                                 CL**2
00317      10  TARGET-LINE.                                                CL**2
00318          15  FILLER             PICTURE X(5) VALUE SPACE.            CL**2
00319          15  TARGET-PRINT       PICTURE ZZZZZ9.                      CL**2
00320          15  FILLER             PICTURE X(41) VALUE                  CL**2
00321          " TRANSACTIONS WERE WRITTEN TO TARGET FILE".                CL**2
00322       10  SOURCE-LINE.                                               CL**2
00323          15  FILLER             PICTURE X(5) VALUE SPACE.            CL**2
00324          15  SOURCE-PRINT       PICTURE ZZZZZ9.                      CL**2
00325          15  FILLER             PICTURE X(41) VALUE                  CL**2
00326          " TRANSACTIONS WERE WRITTEN TO SOURCE FILE".                CL**2
00327       10  CARD-DETAIL.                                               CL**2
00328          15  FILLER             PICTURE X(27) VALUE SPACE.           CL**2
00329          15  CARD-SPACE         PICTURE X(80).                       CL**2
00330          15  FILLER             PICTURE X(25) VALUE SPACE.           CL**2
00331      05  FUNCTION-OPT.                                               CL**2
00332          10  OPT-AREA            PICTURE X OCCURS 3 TIMES.           CL**2
00333      05  SAVE-AREAS.                                                 CL**2
00334          10  SAVE-RELEASE.                                           CL**2
00335              15  SAVE-RELEASE-SUB PICTURE X OCCURS 6 TIMES.          CL**2
00336          10  SAVE-REV-NO.                                            CL**2
00337               15 SAVE-REV-SUB PICTURE 9 OCCURS 5 TIMES.              CL**2
               10 CTL-HMB-SAVE   PICTURE 9(5).
       01 WK-DATE.
           02 Y    PICTURE 99.
           02 M    PICTURE 99.
           02 D    PICTURE 99.
       01 WK-DATEX. 
           02 MX   PICTURE 99.
           02 FILLER   PICTURE X   VALUE "/". 
           02 DX   PICTURE 99.
           02 FILLER   PICTURE X   VALUE "/". 
           02 YX   PICTURE 99.
00340  PROCEDURE DIVISION.                                              DCUTLCOP
       ALL-ENTRY. 
00341      OPEN OUTPUT SYSPRINT.                                           CL**2
00342      MOVE 1 TO PRT-CTL.                                              CL**2
           MOVE 99 TO LINE-CT.
00344      MOVE 59 TO MAX-LINES.                                           CL**2
00345      MOVE SPACE TO USER-TITLE.                                       CL**2
00346      MOVE "N" TO 8BY11-FLAG.                                         CL**2
00347      MOVE NAME-REPORT TO REPORT-TITLE-LONG.                          CL**2
00348      MOVE ZERO TO PAGE-NO.                                           CL**2
00349      MOVE SPACE TO EOP-MSG.                                          CL**2
           ACCEPT WK-DATE FROM DATE.
           MOVE Y TO YX.
           MOVE M TO MX.
           MOVE D TO DX.
           MOVE WK-DATEX TO CURRENT-DATE. 
00350      MOVE CURRENT-DATE TO PRT-CURRENT-DATE.                          CL**2
00351      MOVE ZERO TO REVISION-NUMBER.                                   CL**2
00352      MOVE SPACE TO CON-TITLE CON-USER.                               CL**2
00353      MOVE CURRENT-DATE TO DATE-LAST-REVISION.                        CL**2
00354      MOVE LITERAL-1 TO PRT-DATE1-HCON.                               CL**2
00355      MOVE LITERAL-2 TO PRT-DATE2-HCON.                               CL**2
00356      MOVE LITERAL-3 TO PRT-PAGE-HCON.                                CL**2
00357      MOVE LITERAL-4 TO CON-DC.                                       CL**2
00358      MOVE LITERAL-5 TO PRT-REV-NO-HCON.                              CL**2
00359      MOVE ZERO TO HOF-IND.                                           CL**2
00360      MOVE 1 TO SPACE-1.                                              CL**2
00361      MOVE SPACE TO PRINT-LINE.                                       CL**2
00362      OPEN INPUT SYSINFIL.                                            CL**2
00363 ****************************************************************     CL**2
00364 *                                                                    CL**2
00365 *        READ $UTILITY TRANSACTION ONLY                              CL**2
00366 *                                                                    CL**2
00367 ****************************************************************     CL**2
00368  READ-UTL.                                                           CL**2
00369      READ SYSINFIL                                                   CL**2
00370          AT END GO TO EOJ.                                           CL**2
00371      IF FUNCTION-TYPE NOT EQUAL UTILITY-TYPE                         CL**2
00372          GO TO BAD-INIT.                                             CL**2
00373      MOVE SPACE TO FUNCTION-OPT.                                     CL**2
00374      MOVE ZERO TO OPT-SUB.                                           CL**2
00375      MOVE 5 TO TX-SUB.                                               CL**2
00376      PERFORM FIND-BLANK-100 THRU FIND-BLANK-XIT.                     CL**2
00377      IF TX-SUB GREATER THAN MAX-POS                                  CL**2
00378          GO TO BEGIN-MAINT.                                          CL**2
00379      PERFORM FIND-OPT THRU FIND-OPT-XIT.                             CL**2
           IF FUNCTION-OPT EQUAL SPACE OR MAINT-TYPE
00381          GO TO BEGIN-MAINT.                                          CL**2
           IF FUNCTION-OPT EQUAL MIGRATE-TYPE 
              GO TO LOAD-MIGRATE. 
00384      IF FUNCTION-OPT EQUAL INIT-TYPE                                 CL**2
00385          GO TO LOAD-INIT.                                            CL**2
00386      GO TO BAD-INIT.                                                 CL**2
00388 ***************************************************************      CL**2
00389 *                                                                    CL**2
00390 *    MAINTENANCE MODE PROCESSING                                     CL**2
00391 *                                                                    CL**2
00392 ***************************************************************      CL**2
00393  BEGIN-MAINT.                                                        CL**2
00394      MOVE CARD-REC TO STD-REPORT-REC.                                CL**2
00395  BEGIN-MAINT-100.                                                    CL**2
00396      OPEN INPUT MAST3.                                               CL**2
           MOVE 1 TO CONTROL-NOM-KEY. 
00398      READ MAST3                                                      CL**2
00399          INVALID KEY MOVE BAD-KEY TO ERROR-POS2                      CL**3
00400          GO TO UTL-ABORT.                                            CL**3
00401      MOVE CTL-PRIME-NUM TO DATA-PRIME.                               CL**2
00402      MOVE CTL-PRIME-NUM-REL TO REL-PRIME.                            CL**2
00403      MOVE CTL-DATE-UPD TO DATE-LAST-REVISION.                        CL**2
00404      MOVE CTL-REV-NUM TO REVISION-NUMBER.                            CL**2
00405      MOVE CTL-EOP-MSG TO EOP-MSG.                                    CL**2
00406      MOVE CTL-LINES TO LINE-CT.                                      CL**2
00407      MOVE CTL-DC-RELEASE TO SAVE-RELEASE.                            CL**2
00408      MOVE CTL-REV-NUM TO REV-SAVE.                                   CL**2
           MOVE CTL-HMB TO CTL-HMB-SAVE.
00409      MOVE CTL-NUM-RES TO TOTAL-COUNT.                                CL**2
00410      SUBTRACT 1 FROM LINE-CT GIVING MAX-LINES.                       CL**2
00411      MOVE PROP-MSG TO CON-TITLE.                                     CL**2
00412      MOVE CTL-NAME TO CON-USER.                                      CL**2
           MOVE 3 TO CONTROL-NOM-KEY. 
00414      READ MAST3                                                      CL**2
00415          INVALID KEY MOVE BAD-KEY3 TO ERROR-POS2                     CL**3
00416          GO TO UTL-ABORT.                                            CL**3
00417 ***************************************************************      CL**2
00418 *                                                                    CL**2
00419 *    SET UP STANDARD NAMES AND IDS                                   CL**2
00420 *                                                                    CL**2
00421 ***************************************************************      CL**2
           MOVE CTL-ENTRY-NAME (1) TO DBPROC-NAME.
           MOVE CTL-ENTRY-ID (1) TO DBPROC-TYPE.
           MOVE CTL-ENTRY-NAME (2) TO ELEMENT-NAME. 
           MOVE CTL-ENTRY-ID (2) TO ELEMENT-TYPE. 
           MOVE CTL-ENTRY-NAME (3) TO GROUP-NAME. 
           MOVE CTL-ENTRY-ID (3) TO GROUP-TYPE. 
           MOVE CTL-ENTRY-NAME (4) TO RECORD-NAME.
           MOVE CTL-ENTRY-ID (4) TO RECORD-TYPE.
           MOVE CTL-ENTRY-NAME (5) TO IMSDB-NAME. 
           MOVE CTL-ENTRY-ID (5) TO IMSDB-TYPE. 
           MOVE CTL-ENTRY-NAME (6) TO FILE-NAME.
           MOVE CTL-ENTRY-ID (6) TO FILE-TYPE.
           MOVE CTL-ENTRY-NAME (7) TO AREA-NAME.
           MOVE CTL-ENTRY-ID (7) TO AREA-TYPE.
           MOVE CTL-ENTRY-NAME (8) TO SUBSCHEMA-NAME. 
           MOVE CTL-ENTRY-ID (8) TO SUBSCHEMA-TYPE. 
           MOVE CTL-ENTRY-NAME (9) TO SCHEMA-NAME.
           MOVE CTL-ENTRY-ID (9) TO SCHEMA-TYPE.
           MOVE CTL-ENTRY-NAME (10) TO IMSPSB-NAME. 
           MOVE CTL-ENTRY-ID (10) TO IMSPSB-TYPE. 
           MOVE CTL-ENTRY-NAME (11) TO FORM-NAME. 
           MOVE CTL-ENTRY-ID (11) TO FORM-TYPE. 
           MOVE CTL-ENTRY-NAME (12) TO REPORT-NAME. 
           MOVE CTL-ENTRY-ID (12) TO REPORT-TYPE. 
           MOVE CTL-ENTRY-NAME (13) TO RESOURCE-NAME. 
           MOVE CTL-ENTRY-ID (13) TO RESOURCE-TYPE. 
           MOVE CTL-ENTRY-NAME (14) TO PROGRAM-NAME.
           MOVE CTL-ENTRY-ID (14) TO PROGRAM-TYPE.
           MOVE CTL-ENTRY-NAME (15) TO TASK-NAME. 
           MOVE CTL-ENTRY-ID (15) TO TASK-TYPE. 
           MOVE CTL-ENTRY-NAME (16) TO SYSTEM-NAME. 
           MOVE CTL-ENTRY-ID (16) TO SYSTEM-TYPE. 
           MOVE CTL-ENTRY-NAME (17) TO MGMT-NAME. 
           MOVE CTL-ENTRY-ID (17) TO MGMT-TYPE. 
00452      CLOSE MAST3.                                                    CL**2
           IF FUNCTION-TYPE = UTILITY-TYPE MOVE 99 TO LINE-CT 
               PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.
00455 ***************************************************************      CL**2
00456 *                                                                    CL**2
00457 *    READ TRANSACTIONS                                               CL**2
00458 *                                                                    CL**2
00459 ***************************************************************      CL**2
00460  READ-TRANS.                                                         CL**2
00461      IF RETURN-CODE EQUAL 12                                         CL**2
00462          GO TO EOJ.                                                  CL**2
00463      READ SYSINFIL                                                   CL**2
00464          AT END GO TO EOJ.                                           CL**2
00465      MOVE MAX-LINES TO LINE-CT.                                      CL**2
00466      MOVE SPACE TO PRINT-LINE.                                       CL**2
00467      MOVE CARD-REC TO STD-REPORT-REC.                                CL**2
00468      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00469      MOVE ZERO TO TX-SUB.                                            CL**2
00470  LOOP-IT.                                                            CL**2
00471      ADD 1 TO TX-SUB.                                                CL**2
00472      IF TX-SUB GREATER THAN MAX-POS                                  CL**2
00473          GO TO LOOP-IT-100.                                          CL**2
00474      IF TX-POS (TX-SUB) NOT EQUAL SPACE                              CL**2
00475          MOVE SPACE TO TX-POS (TX-SUB)                               CL**2
00476          GO TO LOOP-IT.                                              CL**2
00477  LOOP-IT-100.                                                        CL**2
00478      MOVE SPACE TO FUNCTION-OPT.                                     CL**2
00479      IF FUNCTION-TYPE-3 EQUAL RENAME-TYPE                            CL**2
00480          GO TO LOAD-RENAME.                                          CL**2
00481      IF FUNCTION-TYPE-3 EQUAL BACKUP-TYPE                            CL**2
00482          GO TO LOAD-BUP.                                             CL**2
00483      IF FUNCTION-TYPE-3 EQUAL RESTORE-TYPE                           CL**2
00484          GO TO LOAD-BUP.                                             CL**2
00485      IF FUNCTION-TYPE-3 EQUAL NUMBER-TYPE                            CL**2
00486          GO TO LOAD-RENAME.                                          CL**2
00487      IF FUNCTION-TYPE-3 EQUAL PASSWORD-TYPE                          CL**2
00488          GO TO LOAD-PASSWORD.                                        CL**2
00489      IF FUNCTION-TYPE-3 EQUAL STANDARD-TYPE                          CL**2
00490          GO TO LOAD-STD.                                             CL**2
00491      IF FUNCTION-TYPE-3 EQUAL RELEASE-TYPE                           CL**2
00492          GO TO UPDATE-REL.                                           CL**2
00493      IF FUNCTION-TYPE-3 EQUAL REVISION-TYPE                          CL**2
00494          GO TO UPDATE-REV.                                           CL**2
00495      IF FUNCTION-TYPE-3 EQUAL LINES-TYPE                             CL**2
00496          GO TO LOAD-OPT.                                             CL**2
00497      IF FUNCTION-TYPE-3 EQUAL ENDMSG-TYPE                            CL**2
00498          GO TO LOAD-OPT.                                             CL**2
00499      IF FUNCTION-TYPE-3 EQUAL ADDRESS-TYPE                           CL**2
00500          GO TO LOAD-OPT.                                             CL**2
00501      IF FUNCTION-TYPE-3 EQUAL NAME-TYPE                              CL**2
00502            GO TO LOAD-OPT.                                           CL**2
00503      IF FUNCTION-TYPE-3 EQUAL DISPLAY-TYPE                           CL**2
00504          GO TO LOAD-DISP.                                            CL**2
00505      IF FUNCTION-TYPE-3 EQUAL COPY-TYPE                              CL**2
00506          GO TO LOAD-COPY.                                            CL**2
00507      IF FUNCTION-TYPE-3 EQUAL MOVE-TYPE                              CL**2
00508          GO TO LOAD-COPY.                                            CL**2
00509      MOVE BAD-FUNC TO ERROR-POS2.                                    CL**3
00510  READ-TRANS-100.                                                     CL**2
00511      MOVE 8 TO RETURN-CODE.                                          CL**2
00512      MOVE PROG-ID TO ERROR-POS1.                                     CL**2
00513      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00514      GO TO READ-TRANS.                                               CL**2
      ***************************************************** 
      *          MIGRATE FUNCTION REQUESTED               * 
      ***************************************************** 
       LOAD-MIGRATE.
           CLOSE SYSPRINT 
           CALL "UTL900"
  
      ******************************************************* 
      *          RETURN FROM MIGRATION SEGMENT
      ******************************************************* 
           OPEN OUTPUT SYSPRINT 
           GO TO EXEC-STOP-RUN. 
  
00516 ******************************************************************   CL**2
00517 *                                                                *   CL**2
00518 *      BACKUP OR RESTORE FUNCTION REQUESTED                          CL**2
00519 *                                                                *   CL**2
00520 ******************************************************************   CL**2
00521  LOAD-BUP.                                                           CL**2
00522      MOVE ZERO TO OPT-SUB.                                           CL**2
00523      PERFORM FIND-BLANK THRU FIND-BLANK-XIT.                         CL**2
00524      PERFORM FIND-OPT THRU FIND-OPT-XIT.                             CL**2
00525      MOVE OFFCOND TO MAST1-OPT MAST2-OPT MAST3-OPT.                  CL**2
00526      IF FUNCTION-OPT EQUAL SPACE                                     CL**2
00527          MOVE ONCOND TO MAST1-OPT MAST2-OPT MAST3-OPT                CL**2
00528          GO TO CALL-BUP.                                             CL**2
00529  LOAD-BUP-100.                                                       CL**2
00530      IF FUNCTION-OPT EQUAL DATA-FILE                                 CL**2
           MOVE ONCOND TO MAST2-OPT MAST1-OPT GO TO CALL-BUP. 
00539      IF FUNCTION-OPT EQUAL ALL-FILE                                  CL**2
00540          MOVE ONCOND TO MAST1-OPT MAST2-OPT MAST3-OPT                CL**2
00541          GO TO CALL-BUP.                                             CL**2
00542      MOVE BAD-OPER TO ERROR-POS2.                                    CL**3
00543      GO TO READ-TRANS-100.                                           CL**2
00548  CALL-BUP.                                                           CL**2
00549      MOVE SPACE TO PRINT-LINE.                                       CL**2
00550      CLOSE SYSPRINT.                                                 CL**2
00551      IF FUNCTION-TYPE-3 EQUAL RESTORE-TYPE                           CL**2
           GO TO CALL-RES.
           CALL "UTL500". 
00556      GO TO CALL-RES-100.                                             CL**2
00558 ******************************************************************   CL**2
00559 *                                                                *   CL**2
00560 *        RESTORE FUNCTION REQUESTED                              *   CL**2
00561 *                                                                *   CL**2
00562 ******************************************************************   CL**2
00563  CALL-RES.                                                           CL**2
           CALL "UTL600". 
00567  CALL-RES-100.                                                       CL**2
00568      OPEN OUTPUT SYSPRINT.                                           CL**2
           IF RETURN-CODE NOT = 0 
00570          GO TO EOJ.                                                  CL**2
00571  CALL-RES-200.                                                       CL**2
00572 ********************************************************             CL**2
00573 *                                                                    CL**2
00574 *     REWRITE THE COMPANY CONTROL RECORD                             CL**2
00575 *                                                                    CL**2
00576 ***************************************************************      CL**2
00577      OPEN I-O MAST3.                                                 CL**2
           MOVE 1 TO CONTROL-NOM-KEY. 
00579      READ MAST3                                                      CL**2
00580          INVALID KEY MOVE BAD-KEY TO ERROR-POS2                      CL**3
00581          GO TO UTL-ABORT.                                            CL**3
00582      MOVE CURRENT-DATE TO CTL-DATE-RES.                              CL**2
00583      MOVE TOTAL-COUNT TO CTL-NUM-RES.                                CL**3
00584      MOVE REV-SAVE TO CTL-REV-NUM.                                   CL**2
           MOVE CTL-HMB-SAVE TO CTL-HMB.
00585      MOVE SAVE-RELEASE TO CTL-DC-RELEASE.                            CL**2
00586      REWRITE CTL-RECORD-1                                            CL**2
00587          INVALID KEY MOVE BAD-KEY TO ERROR-POS2                      CL**3
00588          GO TO UTL-ABORT.                                            CL**3
00589      CLOSE MAST3.                                                    CL**2
00590      GO TO READ-TRANS.                                               CL**2
00592 ***************************************************************      CL**2
00593 *                                                                    CL**2
00594 *       INITIATION FUNCTION REQUESTED                **              CL**2
00595 *                                                                    CL**2
00596 ***************************************************************      CL**2
00597  LOAD-INIT.                                                          CL**2
00598      MOVE CARD-REC TO STD-REPORT-REC.                                CL**2
00599      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00600      READ SYSINFIL                                                   CL**2
00601          AT END GO TO INIT-ABORT.                                    CL**2
00602      MOVE CARD-REC TO INIT-REC1.                                     CL**2
00603      READ SYSINFIL                                                   CL**2
00604          AT END GO TO INIT-ABORT.                                    CL**2
00605      MOVE CARD-REC TO INIT-REC2.                                     CL**2
00606      READ SYSINFIL                                                   CL**2
00607          AT END GO TO INIT-ABORT.                                    CL**2
00608      MOVE CARD-REC TO INIT-REC3.                                     CL**2
00609      MOVE SPACE TO PRINT-LINE.                                       CL**2
00610      CLOSE SYSPRINT.                                                 CL**2
           CALL "UTL100". 
00614      OPEN OUTPUT SYSPRINT.                                           CL**2
00615      IF RETURN-CODE NOT EQUAL ZERO                                   CL**2
00616           GO TO INIT-ABORT.                                          CL**2
00617      MOVE SPACE TO PRINT-LINE.                                       CL**2
00618      GO TO BEGIN-MAINT-100.                                          CL**2
00620 ******************************************************************   CL**2
00621 *                                                                    CL**2
00622 *      RENAME OR NUMBER FUNCTION REQUESTED                           CL**2
00623 ******************************************************************   CL**2
00624 *                                                                    CL**2
00625  LOAD-RENAME.                                                        CL**2
00626      MOVE "N" TO FUNCTION-CODE.                                      CL**2
00627      CLOSE SYSPRINT.                                                 CL**2
00628  LOAD-RENAME-100.                                                    CL**2
00629      MOVE CARD-REC TO TRANS-AREA.                                    CL**2
00630      MOVE DATA-PRIME TO CTL-PRIME-NUM1.                              CL**2
00631      MOVE REL-PRIME TO CTL-PRIME-NUM2.                               CL**2
           CALL "UTL300". 
00636      IF END-INPUT EQUAL "Y"                                          CL**2
00637          OPEN OUTPUT SYSPRINT                                        CL**2
00638          GO TO EOJ.                                                  CL**2
00639      IF FUNCTION-CODE EQUAL "N"                                      CL**2
00640          GO TO LOAD-OPT-100.                                         CL**2
00641      READ SYSINFIL                                                   CL**2
00642          AT END                                                      CL**2
00643          MOVE "Y" TO END-INPUT                                       CL**2
00644          MOVE "END OF FILE" TO CARD-REC.                             CL**2
00645      GO TO LOAD-RENAME-100.                                          CL**2
00647 **************************************************************       CL**2
00648 *                                                                    CL**2
00649 *     PASSWORD FUNCTION REQUESTED                                    CL**2
00650 *                                                                    CL**2
00651 ****************************************************************     CL**2
00652  LOAD-PASSWORD.                                                      CL**2
00653      MOVE "N" TO FUNCTION-CODE-S.                                    CL**2
00654      CLOSE SYSPRINT.                                                 CL**2
00655  LOAD-PASSWORD-100.                                                  CL**2
00656      MOVE CARD-REC TO TRANS-AREA.                                    CL**2
      ********************************************************
      * 
      *        CALL TO PASS-WORD ROUTINE WILL GO HERE 
      * 
      ********************************************************
00661      IF END-INPUT EQUAL "Y"                                          CL**2
00662          OPEN OUTPUT SYSPRINT                                        CL**2
00663          GO TO EOJ.                                                  CL**2
00664      IF FUNCTION-CODE-S EQUAL "N"                                    CL**2
00665          GO TO LOAD-OPT-100.                                         CL**2
00666      READ SYSINFIL                                                   CL**2
00667         AT END                                                       CL**2
00668             MOVE "Y" TO END-INPUT                                    CL**2
00669             MOVE "E" TO FUNCTION-CODE-S                              CL**2
00670             MOVE "END OF FILE" TO CARD-REC.                          CL**2
00671      GO TO LOAD-PASSWORD-100.                                        CL**2
00673 *****************************************************************    CL**2
00674 *                                                                    CL**2
00675 *   STANDARD FUNCTION REQUESTED                                      CL**2
00676 *                                                                    CL**2
00677 *                                                                    CL**2
00678 *****************************************************************    CL**2
00679  LOAD-STD.                                                           CL**2
00680      MOVE "N" TO FUNCTION-CODE-S.                                    CL**2
00681      CLOSE SYSPRINT.                                                 CL**2
00682  LOAD-STD-100.                                                       CL**2
00683      MOVE CARD-REC TO TRANS-AREA.                                    CL**2
           CALL "UTL400". 
00688      IF END-INPUT EQUAL "Y"                                          CL**2
00689          OPEN OUTPUT SYSPRINT                                        CL**2
00690          GO TO EOJ.                                                  CL**2
00691      IF FUNCTION-CODE-S EQUAL "N"                                    CL**2
00692          GO TO LOAD-OPT-100.                                         CL**2
00693      READ SYSINFIL                                                   CL**2
00694          AT END                                                      CL**2
00695             MOVE "Y" TO END-INPUT                                    CL**2
00696             MOVE "END OF FILE" TO CARD-REC.                          CL**2
00697      GO TO LOAD-STD-100.                                             CL**2
00699 *****************************************************************    CL**2
00700 *                                                                    CL**2
00701 *         OPTION FUNCTION REQUESTED                                  CL**2
00702 *                                                                    CL**2
00703 *****************************************************************    CL**2
00704  LOAD-OPT.                                                           CL**2
00705      MOVE CARD-REC TO LINK-OPT-REC.                                  CL**2
00706      MOVE SPACE TO PRINT-LINE.                                       CL**2
00707      CLOSE SYSPRINT.                                                 CL**2
           CALL "UTL200". 
00711  LOAD-OPT-100.                                                       CL**2
00712      OPEN OUTPUT SYSPRINT.                                           CL**2
00713      GO TO READ-TRANS.                                               CL**2
00715 *****************************************************************    CL**2
00716 *                                                                    CL**2
00717 *         DISPLAY FUNCTION REQUESTED                                 CL**2
00718 *                                                                    CL**2
00719 *****************************************************************    CL**2
00720  LOAD-DISP.                                                          CL**2
00721      MOVE FUNCTION-OPERAND TO DISP-LINK.                             CL**2
00722      MOVE SPACE TO PRINT-LINE.                                       CL**2
00723      CLOSE SYSPRINT.                                                 CL**2
           CALL "UTL700". 
00727      GO TO LOAD-OPT-100.                                             CL**2
00729 *****************************************************************    CL**2
00730 *                                                                    CL**2
00731 *        COPY OR MOVE FUNCTION REQUESTED                             CL**2
00732 *                                                                    CL**2
00733 *****************************************************************    CL**2
00734  LOAD-COPY.                                                          CL**2
00735      OPEN INPUT MAST3.                                               CL**2
00736      IF COPY-REQUESTED EQUAL "N"                                     CL**2
00737          MOVE "Y" TO COPY-REQUESTED                                  CL**2
00738          OPEN INPUT MAST1                                            CL**2
00739          MOVE ZEROES TO SOURCE-TOTAL                                 CL**2
00740          MOVE ZEROES TO TARGET-TOTAL                                 CL**2
00741          MOVE SPACES TO LIST-OPT                                     CL**2
00742          MOVE "N" TO SOURCE-UPDATE-WRITTEN                           CL**2
00743          MOVE "N" TO TARGET-UPDATE-WRITTEN                           CL**2
00744          OPEN OUTPUT SOURCE-FILE                                     CL**2
00745          OPEN OUTPUT TARGET-FILE.                                    CL**2
00746      MOVE ZERO TO COPY-FUNCTION-CODE.                                CL**2
00747      MOVE "N" TO TX-EOF-SW.                                          CL**2
00748  LOAD-COPY-100.                                                      CL**2
00749      MOVE CARD-REC TO COPY-TRANS.                                    CL**2
00751  CALL-COPY.                                                          CL**2
           CALL "UTL800". 
00758 *                                                                    CL**2
00759 *     RESPOND TO COPY MODULE I/O REQUESTS                            CL**2
00760 *                                                                    CL**2
00761 *         1=READ MAST1                                               CL**2
00762 *         3=READ MAST3                                               CL**2
00763 *         4=OUTPUT PRINT/PUNCH TABLE                                 CL**2
00764 *         5=READ ANOTHER INPUT CARD                                  CL**2
00765 *         8=ABORT CURRENT TRANSACTION                                CL**2
00766 *         9=COPY TRANSACTION PROCESSING COMPLETE                     CL**2
00767 *                                                                    CL**2
00768      IF COPY-FUNCTION-CODE NOT EQUAL TO "1"                          CL**2
00769          GO TO TEST-MAST3-REQUEST.                                   CL**2
           MOVE DATA-KEY TO DATA-KEY-2. 
00771      READ MAST1 INVALID KEY                                          CL**2
00772          MOVE ZEROES TO DATA-HDR-ENT-ID                              CL**2
00773          GO TO CALL-COPY.                                            CL**2
00774      MOVE MAST1-RECORD TO DATA-RECORD.                               CL**2
00775      GO TO CALL-COPY.                                                CL**2
00776  TEST-MAST3-REQUEST.                                                 CL**2
00777      IF COPY-FUNCTION-CODE NOT EQUAL TO "3"                          CL**2
00778          GO TO TEST-PUNCH-REQUEST.                                   CL**2
00779      MOVE ZERO TO MAST3-RETURN-CODE.                                 CL**2
00780      MOVE CON-KEY TO CONTROL-NOM-KEY.                                CL**2
00781      READ MAST3 INVALID KEY                                          CL**2
00782          MOVE "1" TO MAST3-RETURN-CODE                               CL**2
00783          GO TO CALL-COPY.                                            CL**2
           IF CON-KEY = 3 
00785          MOVE CTL-RECORD-3 TO ENT-TABLE                              CL**2
00786          GO TO CALL-COPY.                                            CL**2
           IF CON-KEY = 4 
00788          MOVE CTL-RECORD-4 TO CATEGORY-TABLE                         CL**2
00789          GO TO CALL-COPY.                                            CL**2
00790      MOVE CTL-RECORD-5 TO FIELD-TABLE.                               CL**2
00791      GO TO CALL-COPY.                                                CL**2
00792  TEST-PUNCH-REQUEST.                                                 CL**2
00793      IF COPY-FUNCTION-CODE NOT EQUAL TO "4"                          CL**2
00794          GO TO TEST-CARD-READ-REQUEST.                               CL**2
00795      PERFORM OUTPUT-TX THRU OUTPUT-TX-XIT.                           CL**2
00796      GO TO CALL-COPY.                                                CL**2
00797  TEST-CARD-READ-REQUEST.                                             CL**2
00798      IF COPY-FUNCTION-CODE NOT EQUAL TO "5"                          CL**2
00799         GO TO TEST-ABORT-REQUEST.                                    CL**2
00800      READ SYSINFIL                                                   CL**2
00801          AT END                                                      CL**2
00802              MOVE "Y" TO END-INPUT                                   CL**2
00803      MOVE "Y" TO TX-EOF-SW.                                          CL**2
00804      GO TO LOAD-COPY-100.                                            CL**2
00805  TEST-ABORT-REQUEST.                                                 CL**2
00806      IF COPY-FUNCTION-CODE NOT EQUAL TO "8"                          CL**2
00807          GO TO PROCESS-COPY-END-REQUEST.                             CL**2
00808      PERFORM OUTPUT-TX THRU OUTPUT-TX-XIT.                           CL**2
00809      GO TO UTL-ABORT.                                                CL**2
00810  PROCESS-COPY-END-REQUEST.                                           CL**2
00811      PERFORM OUTPUT-TX THRU OUTPUT-TX-XIT.                           CL**2
00812      MOVE "N" TO DOING-COPY-NOW.                                     CL**2
00813      IF END-INPUT EQUAL TO "Y"                                       CL**2
00814          CLOSE MAST3                                                 CL**2
00815          GO TO EOJ.                                                  CL**2
00816      CLOSE MAST3.                                                    CL**2
00817      GO TO READ-TRANS.                                               CL**2
00819 *****************************************************************    CL**2
00820 *     UPDATE RELEASE NUMBER                                          CL**2
00821 *****************************************************************    CL**2
00822  UPDATE-REL.                                                         CL**2
00823      PERFORM FIND-BLANK THRU FIND-BLANK-XIT.                         CL**2
00824      MOVE TX-POS (TX-SUB) TO SAVE-RELEASE-SUB (1).                   CL**2
00825      ADD 1 TO TX-SUB.                                                CL**2
00826      MOVE TX-POS (TX-SUB) TO SAVE-RELEASE-SUB (2).                   CL**2
00827      ADD 1 TO TX-SUB.                                                CL**2
00828      MOVE TX-POS (TX-SUB) TO SAVE-RELEASE-SUB (3).                   CL**2
00829      ADD 1 TO TX-SUB.                                                CL**2
00830      MOVE TX-POS (TX-SUB) TO SAVE-RELEASE-SUB (4).                   CL**2
00831      ADD 1 TO TX-SUB.                                                CL**2
00832      MOVE TX-POS (TX-SUB) TO SAVE-RELEASE-SUB (5).                   CL**2
00833      ADD 1 TO TX-SUB.                                                CL**2
00834      MOVE TX-POS (TX-SUB) TO SAVE-RELEASE-SUB (6).                   CL**2
00835      GO TO CALL-RES-200.                                             CL**2
00836 *****************************************************************    CL**2
00837 *     UPDATE REVISION NUMBER                                         CL**2
00838 *****************************************************************    CL**2
00839  UPDATE-REV.                                                         CL**2
00840      PERFORM FIND-BLANK THRU FIND-BLANK-XIT.                         CL**2
00841      MOVE TX-POS (TX-SUB) TO SAVE-REV-SUB (1).                       CL**2
00842      ADD 1 TO TX-SUB.                                                CL**2
00843      MOVE TX-POS (TX-SUB) TO SAVE-REV-SUB (2).                       CL**2
00844      ADD 1 TO TX-SUB.                                                CL**2
00845      MOVE TX-POS (TX-SUB) TO SAVE-REV-SUB (3).                       CL**2
00846      ADD 1 TO TX-SUB.                                                CL**2
00847      MOVE TX-POS (TX-SUB) TO SAVE-REV-SUB (4).                       CL**2
00848      ADD 1 TO TX-SUB.                                                CL**2
00849      MOVE TX-POS (TX-SUB) TO SAVE-REV-SUB (5).                       CL**2
00850      IF SAVE-REV-NO NOT NUMERIC                                      CL**2
00851           GO TO READ-TRANS.                                          CL**2
00852      MOVE SAVE-REV-NO TO REV-SAVE.                                   CL**2
00853      GO TO CALL-RES-200.                                             CL**2
00854 *****************************************************************    CL**2
00855 *                                                                    CL**2
00856 *             END OF JOB                                             CL**2
00857 *****************************************************************    CL**2
00858 *                                                                    CL**2
00859  EOJ.                                                                CL**2
00860      IF COPY-REQUESTED EQUAL "Y"                                     CL**2
00861          PERFORM LIST-COPY-TOT THRU LIST-COPY-TOT-XIT                CL**2
00862          CLOSE SOURCE-FILE                                           CL**2
00863          CLOSE TARGET-FILE                                           CL**2
00864          CLOSE MAST1.                                                CL**2
00865      MOVE SPACE TO PRINT-LINE.                                       CL**2
00866      MOVE SPACES TO STD-REPORT-REC.                                  CL**2
00867      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00868      MOVE END-MSG TO STD-REPORT-REC.                                 CL**2
00869      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
       EXEC-STOP-RUN. 
00870      CLOSE SYSINFIL.                                                 CL**2
00871      CLOSE SYSPRINT.                                                 CL**2
           PERFORM RETURN-CODE-00 THRU RETURN-CODE-XIT. 
           STOP RUN.
00874 ***************************************************************      CL**2
00875 *                                                                    CL**2
00876 *     SUBROUTINES                                                    CL**2
00877 *                                                                    CL**2
00878 ***************************************************************      CL**2
00879 ***************************************************************      CL**2
00880 *                                                                    CL**2
00881 *     PRINT A LINE                                                   CL**2
00882 *                                                                    CL**2
00883 ***************************************************************      CL**2
*CALL     DISPLAYLN 
*CALL     WRITELN 
00886  USER-ROUTINE.                                                       CL**2
00887      IF DOING-COPY-NOW EQUAL TO "Y"                                  CL**2
00888          MOVE COLUMN-LINE1 TO PRINT-LINE                             CL**2
00889          MOVE 2 TO PRT-CTL                                           CL**2
00890          PERFORM WRITE-LINE THRU WRITE-LINE-XIT                      CL**2
00891          MOVE COLUMN-LINE2 TO PRINT-LINE                             CL**2
00892          MOVE 1 TO PRT-CTL                                           CL**2
00893          PERFORM WRITE-LINE THRU WRITE-LINE-XIT                      CL**2
00894          MOVE SPACES TO PRINT-LINE                                   CL**2
00895          PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                     CL**2
00896  USER-ROUTINE-XIT.                                                   CL**2
00897      EXIT.                                                           CL**2
00899 ***************************************************************      CL**2
00900 *                                                                    CL**2
00901 *     FIND NON-BLANK CHARACTER                                       CL**2
00902 *                                                                    CL**2
00903 ***************************************************************      CL**2
00904  FIND-BLANK.                                                         CL**2
00905      MOVE ZERO TO TX-SUB.                                            CL**2
00906  FIND-BLANK-100.                                                     CL**2
00907      ADD 1 TO TX-SUB.                                                CL**2
00908      IF TX-SUB GREATER THAN MAX-POS                                  CL**2
00909          GO TO FIND-BLANK-XIT.                                       CL**2
00910      IF TX-POS (TX-SUB) EQUAL SPACE                                  CL**2
00911          GO TO FIND-BLANK-100.                                       CL**2
00912  FIND-BLANK-XIT.                                                     CL**2
00913      EXIT.                                                           CL**2
00914 ***************************************************************      CL**2
00915 *                                                                    CL**2
00916 *     FIND OPTION SELECTED                                           CL**2
00917 *                                                                    CL**2
00918 ***************************************************************      CL**2
00919  FIND-OPT.                                                           CL**2
00920      ADD 1 TO OPT-SUB.                                               CL**2
00921      MOVE TX-POS (TX-SUB) TO OPT-AREA (OPT-SUB).                     CL**2
00922      ADD 1 TO TX-SUB.                                                CL**2
00923      IF TX-SUB GREATER THAN MAX-POS                                  CL**2
00924          GO TO FIND-OPT-XIT.                                         CL**2
00925      IF OPT-SUB LESS THAN 3                                          CL**2
00926          GO TO FIND-OPT.                                             CL**2
00927  FIND-OPT-XIT.                                                       CL**2
00928      EXIT.                                                           CL**2
00929 ******************************************************************   CL**2
00930 *                                                                    CL**2
00931 *           FIND COMMA CHARACTER                                     CL**2
00932 *                                                                    CL**2
00933 ****************************************************************     CL**2
00934  COMMA-SEARCH.                                                       CL**2
00935      MOVE SPACE TO FUNCTION-OPT.                                     CL**2
00936  COMMA-SEARCH-100.                                                   CL**2
00937      IF TX-SUB GREATER THAN MAX-POS                                  CL**2
00938         GO TO COMMA-SEARCH-XIT.                                      CL**2
00939      IF TX-POS (TX-SUB) EQUAL COMMA-CHAR                             CL**2
00940          PERFORM FIND-BLANK-100 THRU FIND-BLANK-XIT                  CL**2
00941          MOVE ZERO TO OPT-SUB                                        CL**2
00942         PERFORM FIND-OPT THRU FIND-OPT-XIT.                          CL**2
00943      ADD 1 TO TX-SUB.                                                CL**2
00944      GO TO COMMA-SEARCH-100.                                         CL**2
00945  COMMA-SEARCH-XIT.                                                   CL**2
00946      EXIT.                                                           CL**2
00948 **************************************************                   CL**2
00949 *                                                                    CL**2
00950 *    OUTPUT COPY PRINT/PUNCH TABLE CREATED BY COPY MODULE            CL**2
00951 *       A MAXIMUM OF 40 LINES IN TABLE                               CL**2
00952 **************************************************                   CL**2
00953  OUTPUT-TX.                                                          CL**2
00954      IF COPY-COUNT EQUAL ZERO                                        CL**2
00955          GO TO OUTPUT-TX-XIT.                                        CL**2
00956      MOVE 1 TO LINE-SUB.                                             CL**2
00957  NEXT-COPY-LINE.                                                     CL**2
00958      IF COPY-OUTPUT-INDICATOR (LINE-SUB) EQUAL "E"                   CL**2
00959          MOVE COPY-OUTPUT-ENTRY (LINE-SUB) TO STD-REPORT-REC         CL**2
00960          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT                  CL**2
00961          GO TO CHECK-END-LINES.                                      CL**2
00962 *                                                                    CL**2
00963 *     LIST GENERATED TX"S IN TEST MODE ONLY                          CL**2
00964 *                                                                    CL**2
00965      IF LIST-OPT EQUAL TO "TES"                                      CL**2
00966          MOVE COPY-OUTPUT-ENTRY (LINE-SUB) TO STD-REPORT-REC         CL**2
00967          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                 CL**2
00968 *                                                                    CL**2
00969 *     WRITE TARGET DICTIONARY UPDATE TRANSACTIONS                    CL**2
00970 *                                                                    CL**2
00971      IF COPY-OUTPUT-INDICATOR (LINE-SUB) EQUAL "T"                   CL**2
00972          MOVE COPY-CARD-IMAGE (LINE-SUB) TO TARGET-CARD              CL**2
00973          WRITE TARGET-CARD                                           CL**2
00974          GO TO CHECK-END-LINES.                                      CL**2
00975 *                                                                    CL**2
00976 *     WRITE SOURCE DICTIONARY UPDATE TRANSACTIONS                    CL**2
00977 *                                                                    CL**2
00978      IF COPY-OUTPUT-INDICATOR (LINE-SUB) EQUAL "S"                   CL**2
00979          MOVE COPY-CARD-IMAGE (LINE-SUB) TO SOURCE-CARD              CL**2
00980          WRITE SOURCE-CARD                                           CL**2
00981          GO TO CHECK-END-LINES.                                      CL**2
00982      MOVE "BAD RECORD INDICATOR" TO STD-REPORT-REC.                  CL**2
00983      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00984  CHECK-END-LINES.                                                    CL**2
00985      IF LINE-SUB NOT EQUAL TO COPY-COUNT                             CL**2
00986          ADD 1 TO LINE-SUB                                           CL**2
00987          GO TO NEXT-COPY-LINE.                                       CL**2
00988      MOVE SPACES TO COPY-OUTPUT-TABLE.                               CL**2
00989  OUTPUT-TX-XIT.                                                      CL**2
00990      EXIT.                                                           CL**2
00992 *****************************************************                CL**2
00993 *                                                                    CL**2
00994 *     OUTPUT TOTAL UPDATE TX-S CREATED FOR MOVE/COPY                 CL**2
00995 *     LIST TARGET AND SOURCE FILE OUTPUT IF REQUESTED                CL**2
00996 *                                                                    CL**2
00997 *****************************************************                CL**2
00998  LIST-COPY-TOT.                                                      CL**2
00999      IF TARGET-TOTAL EQUAL ZEROES                                    CL**2
01000          GO TO LIST-COPY-TOT-XIT.                                    CL**2
01001      MOVE SPACES TO STD-REPORT-REC.                                  CL**2
01002      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01003      MOVE TARGET-TOTAL TO TARGET-PRINT.                              CL**2
01004      MOVE TARGET-LINE TO STD-REPORT-REC.                             CL**2
01005      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01006      MOVE SOURCE-TOTAL TO TARGET-PRINT.                              CL**2
01007      MOVE SOURCE-TOTAL TO SOURCE-PRINT.                              CL**2
01008      MOVE SOURCE-LINE TO STD-REPORT-REC.                             CL**2
01009      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01010 *                                                                    CL**2
01011      IF LIST-OPT EQUAL "NO"                                          CL**2
01012          GO TO LIST-COPY-TOT-XIT.                                    CL**2
01013 *                                                                    CL**2
01014 *    LIST TARGET FILE TRANSACTIONS                                   CL**2
01015 *                                                                    CL**2
01016      CLOSE TARGET-FILE.                                              CL**2
01017      MOVE "Y" TO DOING-COPY-NOW.                                     CL**2
01018      OPEN INPUT TARGET-FILE.                                         CL**2
01019      MOVE "TARGET" TO COMMON-TX-HDG.                                 CL**2
01020      MOVE MAX-LINES TO LINE-CT.                                      CL**2
01021      MOVE SPACES TO PRINT-LINE.                                      CL**2
01022      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01023  GET-TARGET.                                                         CL**2
01024      READ TARGET-FILE AT END                                         CL**2
01025          GO TO CHECK-SOURCE.                                         CL**2
01026      MOVE TARGET-CARD TO CARD-SPACE.                                 CL**2
01027      MOVE CARD-DETAIL TO STD-REPORT-REC.                             CL**2
01028      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01029      GO TO GET-TARGET.                                               CL**2
01030 *                                                                    CL**2
01031 *    LIST SOURCE FILE IF MOVE COMMAND WAS PROCESSED                  CL**2
01032 *                                                                    CL**2
01033  CHECK-SOURCE.                                                       CL**2
01034      IF SOURCE-TOTAL EQUAL TO ZEROES                                 CL**2
01035          GO TO LIST-COPY-TOT-XIT.                                    CL**2
01036      CLOSE SOURCE-FILE.                                              CL**2
01037      OPEN INPUT SOURCE-FILE.                                         CL**2
01038      MOVE "SOURCE" TO COMMON-TX-HDG.                                 CL**2
01039      MOVE MAX-LINES TO LINE-CT.                                      CL**2
01040      MOVE SPACES TO PRINT-LINE.                                      CL**2
01041      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01042  GET-SOURCE.                                                         CL**2
01043      READ SOURCE-FILE AT END                                         CL**2
01044          GO TO LIST-COPY-TOT-XIT.                                    CL**2
01045      MOVE SOURCE-CARD TO CARD-SPACE.                                 CL**2
01046      MOVE CARD-DETAIL TO STD-REPORT-REC.                             CL**2
01047      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01048      GO TO GET-SOURCE.                                               CL**2
01049  LIST-COPY-TOT-XIT.                                                  CL**2
01050      EXIT.                                                           CL**2
01052 ***************************************************************      CL**2
01053 *                                                                    CL**2
01054 *     ERROR ROUTINES                                                 CL**2
01055 *                                                                    CL**2
01056 ***************************************************************      CL**2
01057 ***************************************************************      CL**2
01058 *                                                                    CL**2
01059 *     CONTROL FILE BAD                                               CL**2
01060 *                                                                    CL**2
01061 ***************************************************************      CL**2
01062  UTL-ABORT.                                                          CL**2
01063      CLOSE MAST3.                                                    CL**2
01064      GO TO INIT-ABORT-100.                                           CL**2
01065 ***************************************************************      CL**2
01066 *                                                                    CL**2
01067 *     INVALID UTILITY OPERAND                                        CL**2
01068 *                                                                    CL**3
01069 *********************************************************            CL**3
01070  BAD-INIT.                                                           CL**2
01071      MOVE CARD-REC TO STD-REPORT-REC.                                CL**2
01072      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01073      MOVE 8 TO RETURN-CODE.                                          CL**2
01074      MOVE PROG-ID TO ERROR-POS1.                                     CL**3
01075      MOVE NOT-UTL TO ERROR-POS2.                                     CL**3
01076      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01077      GO TO READ-UTL.                                                 CL**2
01078 ***************************************************************      CL**2
01079 *         INITIATION INCOMPLETE   ****                               CL**2
01080 ***************************************************************      CL**2
01081  INIT-ABORT.                                                         CL**2
01082      MOVE INIT-BAD TO ERROR-POS2.                                    CL**3
01083  INIT-ABORT-100.                                                     CL**2
01084      MOVE 12 TO RETURN-CODE.                                         CL**2
01085      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01086      GO TO EOJ.                                                      CL**2
*CALL RETCODE 
