*DECK     DCUPD00 
00001  IDENTIFICATION DIVISION.                                         07/14/78
       PROGRAM-ID. UPD00. 
00003 *************************************************************        LV001
00004 *                                                                 DCUPD00 
00005 *        D A T A   C A T A L O G U E  2                           DCUPD00 
00006 *                                                                 DCUPD00 
00007 *          U P D A T E   P R O G R A M                            DCUPD00 
00008 *                                                                 DCUPD00 
00009 *                                                                 DCUPD00 
00010 *     I N I T   A N D   E N D   R O U T I N E                        CL**2
00011 *                                                                 DCUPD00 
00012 *************************************************************     DCUPD00 
00013  ENVIRONMENT DIVISION.                                            DCUPD00 
00014  CONFIGURATION SECTION.                                           DCUPD00 
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
00017  INPUT-OUTPUT SECTION.                                            DCUPD00 
00018  FILE-CONTROL.                                                    DCUPD00 
           SELECT MAST3 ASSIGN TO "MAST3" 
               ORGANIZATION IS RELATIVE 
               ACCESS MODE IS RANDOM
               RELATIVE KEY IS CON-KEY
               USE "PRUF=YES".
00022  DATA DIVISION.                                                   DCUPD00 
00023  FILE SECTION.                                                    DCUPD00 
*CALL     MAST3FD 
*CALL UPDCS 
*CALL QUALINE 
00025  WORKING-STORAGE SECTION.                                         DCUPD00 
       77  EDIT-ONLY-SWITCH PICTURE X.
       77  CURRENT-DATE PICTURE X(8). 
00026  77  HEAD-1           PICTURE X(31)  VALUE                           CL**2
00027      "D A T A   C A T A L O G U E  2 ".                              CL**2
00028  77  HEAD-2          PICTURE X(43) VALUE                             CL**2
00029      "      U P D A T E   A U D I T   R E P O R T".                  CL**2
00030  77  HEAD-4            PICTURE X(26) VALUE                           CL**2
00031      "***  END AUDIT REPORT  ***".                                   CL**2
00032  77  CERR-915F      PICTURE X(50) VALUE                              CL**2
00033      "915-S *ERROR REVISION NUMBER MUST BE 5 DIGITS".                CL**2
00034  77  CERR-920F      PICTURE X(50) VALUE                              CL**2
00035      "920-F *ERROR REVISION NUMBER NOT NUMERIC".                     CL**2
00036  77  CERR-925F      PICTURE X(50) VALUE                              CL**2
00037      "925-F *ERROR INCORRECT REVISION NUMBER".                       CL**2
00038  77  CERR-930F      PICTURE X(50) VALUE                              CL**2
00039      "930-F *ERROR EDIT-ONLY VALUE MUST BE YES OR NO".               CL**2
00040  77  CERR-935F      PICTURE X(50) VALUE                              CL**2
00041      "935-F *ERROR UNKNOWN OPTION KEYWORD".                          CL**2
00042  77  CERR-945F      PICTURE X(50) VALUE                              CL**2
00043      "945-F *ERROR SYNTAX-UNABLE TO PROCESS ABOVE".                  CL**2
00044  77  CERR-950F      PICTURE X(50) VALUE                              CL**2
00045      "950-F *ERROR MAST3-READ CLIENT RECORD".                        CL**2
00046  77  CERR-955F      PICTURE X(50) VALUE                              CL**2
00047      "955-F *ERROR MAST3-READ PW RECORD".                            CL**2
00048  77  CERR-960F      PICTURE X(50) VALUE                              CL**2
00049      "960-F *ERROR MAST3-READ ENTRY RECORD".                         CL**2
00050  77  CERR-965F      PICTURE X(50) VALUE                              CL**2
00051      "965-F *ERROR MAST3-READ CATG RECORD".                          CL**2
00052  77  CERR-970F      PICTURE X(50) VALUE                              CL**2
00053      "970-F *ERROR MAST3-READ FIELD RECORD".                         CL**2
00054  77  CERR-975S      PICTURE X(50) VALUE                              CL**2
00055      "975-F *ERROR MAST3-REWRITE CLIENT RECORD".                     CL**2
       77  CERR-980F               PICTURE X(28)  VALUE 
           "980-F  *ERROR UNKNOWN ENTITY".
*CALL CURDATE 
00056  01  OPTION-KW     PICTURE X(10) VALUE SPACES.                    DCUPD00 
00057  01  NO-CK-SW           PICTURE X VALUE "N".                         CL**2
00058  01  VAL-AREA.                                                    DCUPD00 
00059      03  VAL       PICTURE X OCCURS 10 TIMES.                     DCUPD00 
00060  01  H-8POS               PICTURE X(8).                              CL**2
00061  01  STATUS-CODE        PICTURE X VALUE SPACE.                    DCUPD00 
00062  01  TAB          PICTURE S999 COMP SYNC.                            CL**2
       01  FINIS                   PICTURE X. 
       01  SAVE-CAT                    PICTURE XXX. 
00063  01  PROP-MSG.                                                       CL**2
00064      03  FILLER     PICTURE X(44) VALUE                              CL**2
               "DATA CATALOGUE 2                        V2.0".
00066      03  FILLER     PICTURE X(29) VALUE                              CL**2
*CALL LEVEL 
00068  01  OPT-SETUP.                                                      CL**2
00069      03  OPT-1         PICTURE X(15).                                CL**2
00070      03  OPT-2         PICTURE X.                                    CL**2
00071      03  OPT-3         PICTURE X(15).                                CL**2
00072  01  TOT-SETUP REDEFINES OPT-SETUP.                                  CL**2
00073      03  TOT-1.                                                      CL**2
00074          05  TOT-1A          PICTURE X(5).                           CL**2
00075          05  FILLER           PICTURE X.                             CL**2
00076          05  TOT-1B          PICTURE X(15).                          CL**2
00077          05  FILLER           PICTURE X(4).                          CL**2
00078      03  FILLER         PICTURE X.                                   CL**2
00079      03  TOT-2          PICTURE ZZZZ9.                               CL**2
*CALL     MAST3DD1
00138                                                                    DCUPD00
00139  PROCEDURE DIVISION.                                                 CL**2
00142 ****************************************************              DCUPD00 
00143 *                                                                 DCUPD00 
00144 *     C O N T R O L   F I L E   R E A D I N G                     DCUPD00 
00145 *                                                                 DCUPD00 
00146 ****************************************************              DCUPD00 
      * 
      *    THE FOLLOWING FUNCTIONS ARE RECOGNIZED BY UPD00
      *        A   OPTION ANALYSIS REPORT 
      *        C   READ CONTROL FILE, BUILD ENTRY, CATALOG AND
      *                FIELD TABLE THRU COMMON CATEGORIES 
      *        O   OPTION EDIT
      *        T   READ FIELD TABLES FOR AN ENTITY
      *        U   UNKNOWN
      *        NONE OF ABOVE IS END-OF-JOB
      * 
00147  100-INIT-CTL.                                                       CL**2
00148      IF FUNC EQUAL TO "A" GO TO 5000-INIT-ANAL.                      CL**2
           MOVE ZEROS TO SAVE-CAT.
00149      IF FUNC NOT EQUAL TO "C"                                        CL**2
               GO TO 450-BUILD-ENTRY-TABLE. 
00151      PERFORM CON-OPEN THRU CON-OPEN-XIT.                          DCUPD00 
           MOVE "1" TO CON-ENTRY-FUNCTION.
00153 *                                                                 DCUPD00 
00154 *     READ CUSTOMER INFO RECORD                                   DCUPD00 
00155 *                                                                 DCUPD00 
00156      PERFORM CON-READ THRU CON-READ-XIT.                          DCUPD00 
00157      IF CON-RETURN-CODE NOT EQUAL TO "0"                          DCUPD00 
00158         MOVE CERR-950F TO ERR-MSG (1)                                CL**2
00159      GO TO 1000-CON-ERR.                                          DCUPD00 
00160      MOVE CTL-REV-NUM TO HOLD-REV.                                DCUPD00 
00162      MOVE HOLD-REV TO REVISION-NUMBER.                               CL**2
00163      MOVE CTL-NAME TO HOLD-NAME.                                     CL**2
00164      MOVE CTL-NAME TO CON-USER.                                      CL**2
00165      MOVE PROP-MSG TO CON-TITLE.                                     CL**2
00166      MOVE CTL-ADDRESS TO HOLD-ADDR.                                  CL**2
00167      MOVE CTL-LINES TO MAX-LINES.                                    CL**2
00168      MOVE CTL-DATE-UPD TO DATE-LAST-REVISION.                        CL**2
00169      MOVE CTL-DBMS TO HOLD-DBMS.                                     CL**2
00170      MOVE ZERO TO PAGE-NO.                                           CL**2
           IF ON-LINE-SW EQUAL "Y"
              MOVE "D" TO 8BY11-FLAG
           ELSE 
              MOVE "N" TO 8BY11-FLAG. 
00172      MOVE 99 TO LINE-CT.                                             CL**2
00173      MOVE 1 TO PRT-CTL.                                              CL**2
00174      MOVE SPACES TO STD-REPORT-REC.                                  CL**2
00175      MOVE ZERO TO HOF-IND.                                           CL**2
00176      MOVE 1 TO SPACE-1.                                              CL**2
*CALL ACCEPTDT
           MOVE CURRENT-DATE TO CTL-DATE-UPD. 
00177      MOVE CURRENT-DATE TO PRT-CURRENT-DATE.                          CL**2
00178      MOVE HEAD-1 TO CON-DC.                                          CL**2
00179      MOVE HEAD-2 TO REPORT-TITLE-LONG.                               CL**2
00180      MOVE SPACES TO USER-TITLE.                                      CL**2
00181      MOVE "REPORT DATE-" TO PRT-DATE1-HCON.                          CL**2
00182      MOVE "REVISION NUMBER-" TO PRT-REV-NO-HCON.                     CL**2
00183      MOVE "PAGE" TO PRT-PAGE-HCON.                                   CL**2
00184      MOVE "DATE OF LAST REVISION-" TO PRT-DATE2-HCON.                CL**2
00185      MOVE SPACES TO EOP-MSG.                                         CL**2
00186      IF CTL-EOP-MSG NOT EQUAL TO SPACES                              CL**2
00187          MOVE CTL-EOP-MSG TO EOP-MSG.                                CL**2
00190 *                                                                 DCUPD00 
00191 *     READ PASSWORD RECORD                                        DCUPD00 
00192 *                                                                 DCUPD00 
           MOVE "2" TO CON-ENTRY-FUNCTION.
00194      PERFORM CON-READ THRU CON-READ-XIT.                          DCUPD00 
00195      IF CON-RETURN-CODE NOT EQUAL TO "0"                          DCUPD00 
00196          MOVE CERR-955F TO ERR-MSG (1)                               CL**2
00197          GO TO 1000-CON-ERR.                                      DCUPD00 
00198 *  MOVE PASSWORDS                                                 DCUPD00 
00199 *                                                                 DCUPD00 
00200 *     READ ENTRY RECORD                                           DCUPD00 
00201 *                                                                 DCUPD00 
           MOVE "3" TO CON-ENTRY-FUNCTION.
00203      PERFORM CON-READ THRU CON-READ-XIT.                          DCUPD00 
00204      IF CON-RETURN-CODE NOT EQUAL TO "0"                          DCUPD00 
00205          MOVE CERR-960F TO ERR-MSG (1)                               CL**2
00206          GO TO 1000-CON-ERR.                                      DCUPD00 
           MOVE 1 TO COUNTER. 
           MOVE CTL-DIR-START (1) TO CON-KEY-LAST.
           SUBTRACT 1 FROM CON-KEY-LAST.
           PERFORM VARYING TAB FROM 1 BY 1
             UNTIL TAB GREATER THAN 17
               MOVE CTL-ENTRY (TAB) TO ENT-TAB (TAB)
               PERFORM VARYING VA FROM COUNTER BY 1 
                 UNTIL CTL-DIR-ID (VA) EQUAL ENTRY-ID (TAB) 
                   CONTINUE 
               END-PERFORM
               MOVE CTL-DIR-START (VA) TO ENT-DIR-START (TAB) 
               MOVE VA TO COUNTER 
           END-PERFORM
00213      MOVE HIGH-VALUES TO ENT-TAB (TAB).                           DCUPD00 
00214 *                                                                 DCUPD00 
00215 *     READ CATG RECORD                                            DCUPD00 
00216 *                                                                 DCUPD00 
           MOVE "4" TO CON-ENTRY-FUNCTION.
00218      PERFORM CON-READ THRU CON-READ-XIT.                          DCUPD00 
00219      IF CON-RETURN-CODE NOT EQUAL TO "0"                          DCUPD00 
00220          MOVE CERR-965F TO ERR-MSG (1)                               CL**2
00221          GO TO 1000-CON-ERR.                                      DCUPD00 
00222      MOVE 1 TO TAB.                                               DCUPD00 
00223  400-CON-LOOP.                                                    DCUPD00 
00224      MOVE CTL-CATEGORY (TAB) TO CATG-TAB (TAB).                      CL**2
00225      ADD 1 TO TAB.                                                DCUPD00 
00226      IF TAB NOT EQUAL TO 35                                          CL**2
00227          GO TO 400-CON-LOOP.                                      DCUPD00 
00228      MOVE HIGH-VALUES TO CATG-TAB (TAB).                          DCUPD00 
00229 *                                                                 DCUPD00 
      * 
      *    READ FIELD RECORDS FOR COMMON CATEGORIES 
      *    RELATIVE RECORD NUMBER WAS SET WHILE BUILDING
      *    ENTRY TABLE.  COMMON CATEGORIES REMAIN STATIC
      *    THROUGHOUT THE EXECUTION OF UPDATE.
      *    ENTITY RECORDS WILL BE READ AS NEEDED STARTING 
      *    AT POSITION SAVE-TAB WHICH IS THE END OF 
      *    THE COMMON CATEGORIES
      * 
           MOVE 1 TO TAB. 
           MOVE 03 TO ENT-ID. 
           PERFORM 500-BLD-LOOP THRU 500-BLD-LOOP-EXIT. 
           MOVE TAB TO SAVE-TAB.
           EXIT PROGRAM.
       450-BUILD-ENTRY-TABLE. 
           IF FUNC NOT EQUAL TO "T" 
               GO TO 2000-INIT-OPT. 
           IF ENT-ID NOT = FLD-ENT-TYPE (SAVE-TAB)
               PERFORM CON-OPEN THRU CON-OPEN-XIT 
               PERFORM FIND-ENT-START THRU FIND-ENT-START-EXIT
               MOVE SAVE-TAB TO TAB 
               PERFORM 500-BLD-LOOP THRU 500-BLD-LOOP-EXIT
           END-IF 
           EXIT PROGRAM.
00244  500-BLD-LOOP.                                                       CL**2
00245      MOVE "N" TO CON-ENTRY-FUNCTION.                                 CL**2
00246      PERFORM CON-READ THRU CON-READ-XIT.                             CL**2
           IF CON-RETURN-CODE EQUAL TO "0" OR "1" OR "3"
00248          GO TO 550-BLD-LOOP.                                         CL**2
00249          MOVE CERR-970F TO ERR-MSG (1)                               CL**2
00250      GO TO 1000-CON-ERR.                                             CL**2
00251  550-BLD-LOOP.                                                       CL**2
           IF ENT-ID NOT EQUAL TO CTL-FLD-ENTRY-TYPE
             OR CON-RETURN-CODE EQUAL "3" 
             OR SAVE-CAT GREATER THAN CTL-FLD-CATEGORY
               MOVE HIGH-VALUE TO FLD-TAB (TAB) 
               MOVE SPACE TO FUNC 
               PERFORM CON-CLOSE THRU CON-CLOSE-XIT 
               MOVE WK-DATE TO CUR-DATE 
               GO TO 500-BLD-LOOP-EXIT
           END-IF 
00252      MOVE 1 TO VA.                                                   CL**2
00253      MOVE CTL-FLD-ENTRY-TYPE TO FLD-ENT-TYPE (TAB).                  CL**2
00254      MOVE CTL-FLD-CATEGORY TO FLD-CAT-TYPE (TAB).                    CL**2
           MOVE CTL-FLD-CATEGORY TO SAVE-CAT. 
00255      MOVE LOW-VALUE TO FLD-NAME3 (TAB).                              CL**2
00256      ADD 1 TO TAB.                                                   CL**2
00257      PERFORM BUILD-ENT THRU BUILD-ENT-XIT.                           CL**2
           GO TO 500-BLD-LOOP.
       500-BLD-LOOP-EXIT. 
           EXIT.
00272  BUILD-ENT.                                                          CL**2
00273      MOVE CTL-FLD-NAME (VA) TO FLD-NAME (TAB).                       CL**2
00274      MOVE CTL-FLD-LENGTH (VA) TO FLD-LEN (TAB).                      CL**2
00275      MOVE CTL-FLD-FORMAT (VA) TO FLD-FORM (TAB).                     CL**2
00276      MOVE CTL-FLD-ID (VA) TO FLD-ID (TAB).                           CL**2
00277      MOVE CTL-FLD-REV (VA) TO FLD-REV (TAB).                         CL**2
00278      MOVE CTL-FLD-STD (VA) TO FLD-STD (TAB).                         CL**2
00279      ADD 1 TO TAB VA.                                                CL**2
           IF VA EQUAL TO 30 GO TO BUILD-ENT-XIT. 
00281      IF CTL-FLD-ID (VA) NOT EQUAL TO SPACES                          CL**2
00282          GO TO BUILD-ENT.                                            CL**2
00283  BUILD-ENT-XIT. EXIT.                                                CL**2
00284 *                                                                 DCUPD00 
00285 *     CONTROL FILE ERRORS                                         DCUPD00 
00286 *                                                                 DCUPD00 
00287  1000-CON-ERR.                                                    DCUPD00 
00288      MOVE HIGH-VALUE TO FUNC.                                        CL**2
00289      PERFORM CON-CLOSE THRU CON-CLOSE-XIT.                        DCUPD00 
           EXIT PROGRAM.
00291                                                                    DCUPD00
00292 ****************************************************              DCUPD00 
00293 *                                                                 DCUPD00 
00294 *     O P T I O N   E D I T I N G                                 DCUPD00 
00295 *                                                                 DCUPD00 
00296 ****************************************************              DCUPD00 
00297  2000-INIT-OPT.                                                      CL**2
00298      IF FUNC NOT EQUAL TO "O"                                        CL**2
00299          GO TO 6000-INIT-UPD.                                        CL**2
00300  3000-OPT-LOCATE.                                                 DCUPD00 
00301      IF STATUS-CODE EQUAL TO HIGH-VALUE                           DCUPD00 
00302          GO TO 5000-INIT-ANAL.                                       CL**2
00303      MOVE 1 TO VA.                                                DCUPD00 
           IF VAL-AREA EQUALS "YES" MOVE "Y" TO EDIT-ONLY-SWITCH
               ELSE MOVE "N" TO EDIT-ONLY-SWITCH. 
00304      MOVE SPACES TO VAL-AREA.                                     DCUPD00 
00305  OPT-LOC-10.                                                      DCUPD00 
00306      MOVE TX-POS (TX) TO VAL (VA).                                   CL**2
00307      ADD 1 TO VA TX.                                              DCUPD00 
00308      IF TX-POS (TX) EQUAL TO "="                                     CL**2
00309          MOVE VAL-AREA TO OPTION-KW                               DCUPD00 
00310          GO TO OPT-LOC-20.                                        DCUPD00 
00311      IF TX GREATER THAN 70                                        DCUPD00 
00312          GO TO OPT-SYNTAX.                                        DCUPD00 
00313      IF VA LESS THAN 11                                           DCUPD00 
00314          GO TO OPT-LOC-10.                                        DCUPD00 
00315  OPT-SYNTAX.                                                      DCUPD00 
00316      MOVE CERR-945F TO ERR-MSG (MSG).                                CL**2
00317      GO TO OPT-ERR.                                               DCUPD00 
00318  OPT-LOC-20.                                                      DCUPD00 
00319      MOVE SPACES TO VAL-AREA.                                     DCUPD00 
00320      MOVE 1 TO VA.                                                DCUPD00 
00321      ADD 1 TO TX.                                                 DCUPD00 
00322  OPT-LOC-30.                                                      DCUPD00 
00323      MOVE TX-POS (TX) TO VAL (VA).                                   CL**2
00324      ADD 1 TO VA TX.                                              DCUPD00 
00325      IF TX-POS (TX) EQUAL TO SPACE                                   CL**2
00326          MOVE HIGH-VALUE TO STATUS-CODE                           DCUPD00 
00327          GO TO OPT-FIND.                                          DCUPD00 
00328      IF TX-POS (TX) EQUAL TO ","                                     CL**2
00329          ADD 1 TO TX                                              DCUPD00 
00330          MOVE SPACE TO STATUS-CODE                                DCUPD00 
00331          GO TO OPT-FIND.                                          DCUPD00 
00332      IF TX GREATER THAN 72                                        DCUPD00 
00333           GO TO OPT-SYNTAX.                                       DCUPD00 
00334      IF VA GREATER THAN 10                                        DCUPD00 
00335          GO TO OPT-SYNTAX.                                        DCUPD00 
00336      GO TO OPT-LOC-30.                                            DCUPD00 
00337 *                                                                 DCUPD00 
00338 *     F I N D  O P T I O N                                        DCUPD00 
00339 *                                                                 DCUPD00 
00340  OPT-FIND.                                                        DCUPD00 
00341      IF OPTION-KW EQUAL TO "REV-NO"                                  CL**2
00342          GO TO OPT-REV-NO.                                        DCUPD00 
00343      IF OPTION-KW EQUAL TO "EDIT-ONLY"                            DCUPD00 
00344          GO TO OPT-EDIT-ONLY.                                     DCUPD00 
00345      IF OPTION-KW EQUAL TO "USER"                                 DCUPD00 
               GO TO OPT-USER.
00347      IF OPTION-KW EQUAL TO "QUOTE"                                DCUPD00 
00348          GO TO OPT-QUOTE.                                         DCUPD00 
00349      MOVE CERR-935F TO ERR-MSG (MSG).                                CL**2
00350      GO TO OPT-ERR.                                               DCUPD00 
00351  OPT-REV-NO.                                                      DCUPD00 
00352      IF VAL-AREA EQUAL TO "NO-CHK"                                   CL**2
00353          MOVE "Y" TO NO-CK-SW                                        CL**2
00354          GO TO 3000-OPT-LOCATE.                                   DCUPD00 
00355      IF VA NOT EQUAL TO 6                                         DCUPD00 
00356          MOVE CERR-915F TO ERR-MSG (MSG)                             CL**2
00357          GO TO OPT-ERR.                                           DCUPD00 
00358      MOVE 1 TO VA.                                                DCUPD00 
00360  OPT-REV-LOOP.                                                    DCUPD00 
           IF VAL (VA) IS NOT NUMERIC 
00362          MOVE CERR-920F TO ERR-MSG (MSG)                             CL**2
00363          GO TO OPT-ERR.                                           DCUPD00 
00364      ADD 1 TO VA.                                                 DCUPD00 
00365      IF VA NOT EQUAL TO 6                                         DCUPD00 
00366          GO TO OPT-REV-LOOP.                                      DCUPD00 
00367      IF VAL-AREA NOT EQUAL TO HOLD-REV                               CL**2
00368          MOVE CERR-925F TO ERR-MSG (MSG)                             CL**2
00369          GO TO OPT-ERR.                                              CL**2
00370      GO TO 3000-OPT-LOCATE.                                       DCUPD00 
00371  OPT-EDIT-ONLY.                                                   DCUPD00 
00372      IF VAL-AREA EQUAL TO "YES" OR "NO"                           DCUPD00 
00373          MOVE VAL (1) TO EDIT-OPT                                 DCUPD00 
00374          GO TO 3000-OPT-LOCATE.                                   DCUPD00 
00375      MOVE CERR-930F TO ERR-MSG (MSG).                                CL**2
00376      GO TO OPT-ERR.                                               DCUPD00 
00377  OPT-USER.                                                        DCUPD00 
00378      MOVE VAL-AREA TO USER-OPT.                                   DCUPD00 
00379      IF USER-OPT EQUAL TO "###"                                      CL**2
00380          MOVE "I" TO HOLD-DBMS.                                      CL**2
00381      GO TO 3000-OPT-LOCATE.                                       DCUPD00 
00382  OPT-QUOTE.                                                       DCUPD00 
00383      MOVE VAL (1) TO QUOTE-OPT.                                   DCUPD00 
00384      GO TO 3000-OPT-LOCATE.                                       DCUPD00 
00385  OPT-ERR.                                                         DCUPD00 
00386      MOVE HIGH-VALUE TO FUNC.                                        CL**2
00387  OPT-END.                                                         DCUPD00 
           EXIT PROGRAM.
00389                                                                    DCUPD00
00390 ****************************************************************     CL**2
00391 *                                                                    CL**2
00392 *     OPTION ANALYSIS REPORT                                         CL**2
00393 *                                                                    CL**2
00394 ****************************************************************     CL**2
00395  5000-INIT-ANAL.                                                     CL**2
00396      MOVE 1 TO MSG.                                                  CL**2
00397      MOVE "OPTIONS IN EFFECT THIS UPDATE :" TO ERR-MSG (MSG).        CL**2
00398      ADD 1 TO MSG.                                                   CL**2
00399      MOVE SPACES TO OPT-SETUP.                                       CL**2
00400      MOVE "REVISION NUMBER" TO OPT-1.                                CL**2
00401      MOVE "=" TO OPT-2.                                              CL**2
00402      IF NO-CK-SW EQUAL TO "Y"                                        CL**2
00403          MOVE "NO CHECKING" TO OPT-3                                 CL**2
00404          ELSE                                                        CL**2
00405          MOVE HOLD-REV TO OPT-3.                                     CL**2
00406      MOVE OPT-SETUP TO ERR-MSG (MSG).                                CL**2
00407      ADD 1 TO MSG.                                                   CL**2
00408      MOVE SPACES TO OPT-SETUP.                                       CL**2
00409      MOVE "EDIT ONLY" TO OPT-1.                                      CL**2
00410      MOVE "=" TO OPT-2.                                              CL**2
00411      IF EDIT-OPT EQUAL TO "N"                                        CL**2
00412          MOVE "NO" TO OPT-3                                          CL**2
00413          ELSE                                                        CL**2
00414          MOVE "YES" TO OPT-3.                                        CL**2
00415      MOVE OPT-SETUP TO ERR-MSG (MSG).                                CL**2
00416      ADD 1 TO MSG.                                                   CL**2
00417      MOVE SPACES TO OPT-SETUP.                                       CL**2
00418      MOVE "QUOTE" TO OPT-1.                                          CL**2
00419      MOVE "=" TO OPT-2.                                              CL**2
00420      IF QUOTE-OPT EQUAL TO QUOTE                                     CL**2
00421          MOVE "QUOTE" TO OPT-3                                       CL**2
00422          ELSE                                                        CL**2
00423          MOVE QUOTE-OPT TO OPT-3.                                    CL**2
00424      MOVE OPT-SETUP TO ERR-MSG (MSG).                                CL**2
00425       ADD 1 TO MSG.                                                  CL**2
00426      MOVE SPACES TO OPT-SETUP.                                       CL**2
00427      MOVE "USER" TO OPT-1.                                           CL**2
00428      MOVE "=" TO OPT-2.                                              CL**2
00429      IF USER-OPT EQUAL TO SPACES                                     CL**2
00430          MOVE "NONE SPECIFIED" TO OPT-3                              CL**2
00431          ELSE                                                        CL**2
00432          MOVE USER-OPT TO OPT-3.                                     CL**2
00433      MOVE OPT-SETUP TO ERR-MSG (MSG).                                CL**2
00434      ADD 1 TO MSG.                                                   CL**2
00435      MOVE SPACES TO ERR-MSG (MSG).                                   CL**2
00436      MOVE HIGH-VALUES TO REVISION-TABLE.                             CL**2
           MOVE ZEROS TO TOT-03 TOT-05 TOT-10 TOT-13. 
           MOVE ZEROS TO TOT-19 TOT-20 TOT-22 TOT-24. 
           MOVE ZEROS TO TOT-26 TOT-32 TOT-35 TOT-40. 
           MOVE ZEROS TO TOT-45 TOT-50 TOT-55 TOT-60. 
           MOVE ZEROS TO TOT-65.
           EXIT PROGRAM.
00443  6000-INIT-UPD.                                                      CL**2
00444      IF FUNC NOT EQUAL TO "U"                                        CL**2
00445           GO TO 8000-INIT-END.                                       CL**2
           EXIT PROGRAM.
00447                                                                    DCUPD00
00448 **************************************************************       CL**2
00449 *                                                                    CL**2
00450 *     E N D   O F   J O B   R O U T I N E                            CL**2
00451 *                                                                    CL**2
00452 *****************************************************************    CL**2
00453  8000-INIT-END.                                                      CL**2
00454      MOVE 1 TO MSG.                                                  CL**2
00455      MOVE SPACES TO MESSAGE-TABLE.                                   CL**2
           IF FUNC EQUAL TO "D" 
               MOVE SPACE TO FUNC 
               GO TO 8100-INIT-ENTRY
           END-IF 
00457      MOVE "UPDATE STATISTICS THIS RUN:" TO ERR-MSG (MSG).            CL**2
00458      ADD 1 TO MSG.                                                   CL**2
00459      MOVE SPACES TO TOT-SETUP.                                       CL**2
00460      MOVE "TOTAL TX IMAGES READ" TO TOT-1.                           CL**2
00461      MOVE TOT-TX-READ TO TOT-2.                                      CL**2
00462      MOVE TOT-SETUP TO ERR-MSG (MSG).                                CL**2
00463      ADD 1 TO MSG.                                                   CL**2
00464      MOVE SPACES TO TOT-SETUP.                                       CL**2
00465      MOVE "TOTAL ENTRIES PROCESSED" TO TOT-1.                        CL**2
00466      MOVE TOT-ENT-PROC TO TOT-2.                                     CL**2
00467      MOVE TOT-SETUP TO ERR-MSG (MSG).                                CL**2
00468      ADD 1 TO MSG.                                                   CL**2
00469      MOVE SPACES TO TOT-SETUP.                                       CL**2
00470      MOVE "TOTAL ENTRIES ADDED" TO TOT-1.                            CL**2
00471      MOVE TOT-ENT-ADD TO TOT-2.                                      CL**2
00472      MOVE TOT-SETUP TO ERR-MSG (MSG).                                CL**2
00473      ADD 1 TO MSG.                                                   CL**2
00474      MOVE SPACES TO TOT-SETUP.                                       CL**2
00475      MOVE "TOTAL ENTRIES CHANGED" TO TOT-1.                          CL**2
00476      MOVE TOT-ENT-CHG TO TOT-2.                                      CL**2
00477      MOVE TOT-SETUP TO ERR-MSG (MSG).                                CL**2
00478      ADD 1 TO MSG.                                                   CL**2
00479      MOVE SPACES TO TOT-SETUP.                                       CL**2
00480      MOVE "TOTAL ENTRIES DELETED" TO TOT-1.                          CL**2
00481      MOVE TOT-ENT-DEL TO TOT-2.                                      CL**2
00482      MOVE TOT-SETUP TO ERR-MSG (MSG).                                CL**2
00483      ADD 1 TO MSG.                                                   CL**2
00484      MOVE SPACE TO TOT-SETUP.                                        CL**2
00485      MOVE "TOTAL SERIOUS ERRORS" TO TOT-1.                           CL**2
00486      MOVE TOT-S TO TOT-2.                                            CL**2
00487      MOVE TOT-SETUP TO ERR-MSG (MSG).                                CL**2
00488      ADD 1 TO MSG.                                                   CL**2
00489      MOVE SPACE TO TOT-SETUP.                                        CL**2
00490      MOVE "TOTAL WARNINGS" TO TOT-1.                                 CL**2
00491      MOVE TOT-W TO TOT-2.                                            CL**2
00492      MOVE TOT-SETUP TO ERR-MSG (MSG).                                CL**2
00493      IF TOT-05 NOT EQUAL ZERO                                        CL**2
00494          MOVE 05 TO ENT-ID                                           CL**2
00495          PERFORM TOTAL-SETUP THRU TOTAL-SETUP-XIT.                   CL**2
           IF TOT-03 NOT EQUAL TO ZERO
               MOVE TOT-03 TO TOT-05
               MOVE 03 TO ENT-ID
               PERFORM TOTAL-SETUP THRU TOTAL-SETUP-XIT.
00500      IF TOT-10 NOT EQUAL ZERO                                        CL**2
00501          MOVE TOT-10 TO TOT-05                                       CL**2
00502          MOVE 10 TO ENT-ID                                           CL**2
00503          PERFORM TOTAL-SETUP THRU TOTAL-SETUP-XIT.                   CL**2
00508      IF TOT-13 NOT EQUAL ZERO                                        CL**2
00509          MOVE TOT-13 TO TOT-05                                       CL**2
00510          MOVE 13 TO ENT-ID                                           CL**2
00511          PERFORM TOTAL-SETUP THRU TOTAL-SETUP-XIT.                   CL**2
00520      IF TOT-19 NOT EQUAL ZERO                                        CL**2
00521          MOVE TOT-19 TO TOT-05                                       CL**2
00522          MOVE 19 TO ENT-ID                                           CL**2
00523          PERFORM TOTAL-SETUP THRU TOTAL-SETUP-XIT.                   CL**2
00524      IF TOT-20 NOT EQUAL ZERO                                        CL**2
00525          MOVE TOT-20 TO TOT-05                                       CL**2
00526          MOVE 20 TO ENT-ID                                           CL**2
00527          PERFORM TOTAL-SETUP THRU TOTAL-SETUP-XIT.                   CL**2
00528      IF TOT-22 NOT EQUAL TO ZERO                                     CL**2
00529           MOVE TOT-22 TO TOT-05                                      CL**2
00530           MOVE 22 TO ENT-ID                                          CL**2
00531           PERFORM TOTAL-SETUP THRU TOTAL-SETUP-XIT.                  CL**2
           IF TOT-24 NOT EQUAL TO ZERO
               MOVE TOT-24 TO TOT-05
               MOVE 24 TO ENT-ID
               PERFORM TOTAL-SETUP THRU TOTAL-SETUP-XIT.
           IF TOT-26 NOT EQUAL TO ZERO
               MOVE TOT-26 TO TOT-05
               MOVE 26 TO ENT-ID
               PERFORM TOTAL-SETUP THRU TOTAL-SETUP-XIT.
00540      IF TOT-32 NOT EQUAL ZERO                                        CL**2
00541          MOVE TOT-32 TO TOT-05                                       CL**2
00542          MOVE 32 TO ENT-ID                                           CL**2
00543          PERFORM TOTAL-SETUP THRU TOTAL-SETUP-XIT.                   CL**2
00550      IF TOT-35 NOT EQUAL ZERO                                        CL**2
00551          MOVE 35 TO ENT-ID                                           CL**2
00552          MOVE TOT-35 TO TOT-05                                       CL**2
00553          PERFORM TOTAL-SETUP THRU TOTAL-SETUP-XIT.                   CL**2
00556      MOVE 40 TO ENT-ID.                                              CL**2
00557      IF TOT-40 NOT EQUAL ZERO                                        CL**2
00558          MOVE TOT-40 TO TOT-05                                       CL**2
00559          PERFORM TOTAL-SETUP THRU TOTAL-SETUP-XIT.                   CL**2
00560      IF FUNC EQUAL "D"                                               CL**2
00561          GO TO 8010-END-HALF.                                        CL**2
00562  PRINT-TOTAL-45.                                                     CL**2
00563      MOVE 45 TO ENT-ID.                                              CL**2
00564      IF TOT-45 NOT EQUAL ZERO                                        CL**2
00565          MOVE TOT-45 TO TOT-05                                       CL**2
00566          PERFORM TOTAL-SETUP THRU TOTAL-SETUP-XIT.                   CL**2
00567      IF FUNC EQUAL "D"                                               CL**2
00568          GO TO 8010-END-HALF.                                        CL**2
00569  PRINT-TOTAL-50.                                                     CL**2
00570      MOVE 50 TO ENT-ID.                                              CL**2
00571      IF TOT-50 NOT EQUAL ZERO                                        CL**2
00572          MOVE TOT-50 TO TOT-05                                       CL**2
00573          PERFORM TOTAL-SETUP THRU TOTAL-SETUP-XIT.                   CL**2
00574      IF FUNC EQUAL "D"                                               CL**2
00575          GO TO 8010-END-HALF.                                        CL**2
00583  PRINT-TOTAL-55.                                                     CL**2
00584      MOVE 55 TO ENT-ID.                                              CL**2
00585      IF TOT-55 NOT EQUAL ZERO                                        CL**2
00586          MOVE TOT-55 TO TOT-05                                       CL**2
00587          PERFORM TOTAL-SETUP THRU TOTAL-SETUP-XIT.                   CL**2
00588      IF FUNC EQUAL "D"                                               CL**2
00589          GO TO 8010-END-HALF.                                        CL**2
00590  PRINT-TOTAL-60.                                                     CL**2
00591      MOVE 60 TO ENT-ID.                                              CL**2
00592      IF TOT-60 NOT EQUAL ZERO                                        CL**2
00593          MOVE TOT-60 TO TOT-05                                       CL**2
00594          PERFORM TOTAL-SETUP THRU TOTAL-SETUP-XIT.                   CL**2
00595      IF FUNC EQUAL "D"                                               CL**2
00596          GO TO 8010-END-HALF.                                        CL**2
00597  PRINT-TOTAL-65.                                                     CL**2
00598      MOVE 65 TO ENT-ID.                                              CL**2
00599      IF TOT-65 NOT EQUAL ZERO                                        CL**2
00600          MOVE TOT-65 TO TOT-05                                       CL**2
00601          PERFORM TOTAL-SETUP THRU TOTAL-SETUP-XIT.                   CL**2
00602      IF FUNC EQUAL "D"                                               CL**2
00603          GO TO 8010-END-HALF.                                        CL**2
00604      GO TO 8100-INIT-ENTRY.                                          CL**2
00605  8010-END-HALF.                                                      CL**2
           EXIT PROGRAM.
00607  8100-INIT-ENTRY.                                                    CL**2
00608      IF ENT-ID EQUAL 55 GO TO PRINT-TOTAL-60.                        CL**2
00609      IF ENT-ID EQUAL 60 GO TO PRINT-TOTAL-65.                        CL**2
00610      IF ENT-ID EQUAL 65 GO TO 8180-CONTINUE-MESSAGE.                 CL**2
           IF ENT-ID EQUAL TO 50 GO TO PRINT-TOTAL-55.
00613      IF ENT-ID EQUAL 45 GO TO PRINT-TOTAL-50.                        CL**2
00614      IF ENT-ID EQUAL 40 GO TO PRINT-TOTAL-45.                        CL**2
00615  8180-CONTINUE-MESSAGE.                                              CL**2
00616      ADD 1 TO MSG.                                                   CL**2
00617      OPEN I-O MAST3.                                                 CL**2
           MOVE "1" TO CON-ENTRY-FUNCTION.
00619      PERFORM CON-READ THRU CON-READ-XIT.                             CL**2
           IF CON-RETURN-CODE NOT EQUAL TO "0"
00621          MOVE CERR-950F TO ERR-MSG (MSG)                             CL**2
00622          ADD 1 TO MSG                                                CL**2
00623          GO TO 8200-INIT-END.                                        CL**2
           IF EDIT-ONLY-SWITCH EQUALS "N" 
               ADD 1 TO HOLD-REV. 
00624      MOVE HOLD-REV TO CTL-REV-NUM.                                   CL**2
*CALL ACCEPTDT
00626      ADD TOT-ENT-DEL TO CTL-NUM-DEL.                                 CL**2
00627      ADD TOT-ENT-ADD TO CTL-NUM-INS.                                 CL**2
00628      ADD TOT-ENT-CHG TO CTL-NUM-UPD.                                 CL**2
00629      REWRITE CTL-RECORD-1 INVALID KEY                                CL**2
00630          MOVE CERR-975S TO ERR-MSG (MSG)                             CL**2
00631          ADD 1 TO MSG.                                               CL**2
00632  8200-INIT-END.                                                      CL**2
00633      MOVE HEAD-4 TO ERR-MSG (MSG).                                   CL**2
00634      ADD 1 TO MSG.                                                   CL**2
00635      MOVE SPACES TO ERR-MSG (MSG).                                   CL**2
00636      MOVE "E" TO FUNC.                                               CL**2
           PERFORM CON-CLOSE. 
           EXIT PROGRAM.
00638  TOTAL-SETUP.                                                        CL**2
00639      ADD 1 TO MSG.                                                   CL**2
00640      MOVE SPACES TO TOT-SETUP.                                       CL**2
00641      MOVE "TOTAL" TO TOT-1A.                                         CL**2
00642      MOVE 1 TO TX.                                                   CL**2
00643  TOTAL-SETUP-100.                                                    CL**2
00644      IF ENT-ID EQUAL ENTRY-ID (TX)                                   CL**2
00645          MOVE ENTRY-NAME (TX) TO TOT-1B                              CL**2
00646          GO TO TOTAL-SETUP-200.                                      CL**2
00647      ADD 1 TO TX.                                                    CL**2
           IF TX LESS THAN 18 GO TO TOTAL-SETUP-100.
00649  TOTAL-SETUP-200.                                                    CL**2
00650      MOVE TOT-05 TO TOT-2.                                           CL**2
00651      MOVE TOT-SETUP TO ERR-MSG (MSG).                                CL**2
00652      IF MSG EQUAL 20 MOVE "D" TO FUNC.                               CL**2
00653  TOTAL-SETUP-XIT.                                                    CL**2
00654      EXIT.                                                           CL**2
00655                                                                    DCUPD00
       FIND-ENT-START.
           MOVE "F" TO FINIS. 
           PERFORM VARYING COUNTER FROM 1 BY 1
             UNTIL FINIS EQUAL "T"
               IF ENT-ID EQUAL ENTRY-ID (COUNTER) 
                   MOVE ENT-DIR-START (COUNTER) TO CON-KEY-LAST 
                   SUBTRACT 1 FROM CON-KEY-LAST 
                   MOVE "T" TO FINIS
               END-IF 
               IF ENT-TAB (COUNTER) EQUAL HIGH-VALUES 
                   MOVE "T" TO FINIS
                   MOVE CERR-980F TO ERR-MSG (1)
                   GO TO 1000-CON-ERR 
               END-IF 
           END-PERFORM. 
       FIND-ENT-START-EXIT. 
           EXIT.
*CALL     MAST3IO1
