*DECK DCUPDATE
00001  IDENTIFICATION DIVISION.                                         08/09/78
       PROGRAM-ID.  UPD.
*CALL COPYRIGHT 
00003 ***********************************************************          LV001
00004 ***********************************************************          CL**2
00005 *                                                                 DCUPDCTL
00006 *     D A T A   C A T A L O G U E   2                                CL**2
00007 *                                                                    CL**2
00008 *       U P D A T E   P R O G R A M                                  CL**2
00009 *                                                                    CL**2
00011 *      C O N T R O L   R O U T I N E                                 CL**2
00012 *                                                                 DCUPDCTL
00013 ***********************************************************          CL**2
00014 ***********************************************************          CL**2
00015  ENVIRONMENT DIVISION.                                            DCUPDCTL
00016  CONFIGURATION SECTION.                                           DCUPDCTL
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
*CALL UPQRYSN 
00019  INPUT-OUTPUT SECTION.                                            DCUPDCTL
00020  FILE-CONTROL.                                                    DCUPDCTL
           SELECT MAST1 ASSIGN TO "MAST1" 
               ACCESS MODE IS RANDOM
               ORGANIZATION IS DIRECT 
               RECORD KEY IS DATA-KEY.
           SELECT MAST2 ASSIGN TO "MAST2" 
               ACCESS MODE IS RANDOM
               ORGANIZATION IS DIRECT 
               RECORD KEY IS REL-KEY. 
           SELECT TRANS-FILE ASSIGN TO "INPUT". 
           SELECT TEMP1 ASSIGN TO "TEMPX".
           SELECT SYSPRINT ASSIGN TO "OUTPUT".
00030  DATA DIVISION.                                                   DCUPDCTL
00031  FILE SECTION.                                                    DCUPDCTL
*CALL     MAST1FD 
*CALL     MAST2FD 
*CALL     SYSPRTFD
00035  FD  TEMP1                                                           CL**2
           LABEL RECORDS ARE OMITTED
           RECORD CONTAINS 162 CHARACTERS 
           BLOCK CONTAINS 640 CHARACTERS
00038      DATA RECORD IS WORK-REC.                                        CL**2
       01 WORK-REC   PICTURE X(162).
00040  FD  TRANS-FILE                                                   DCUPDCTL
00041      LABEL RECORDS ARE OMITTED                                    DCUPDCTL
00044      DATA RECORD IS TRANS.                                        DCUPDCTL
00045  01  TRANS        PIC X(80).                                      DCUPDCTL
       COMMON-STORAGE SECTION.
       77  RETURN-CODE PICTURE 99.
*CALL DCUPDLNK
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
      * 
      *    E N T RY 
      * 
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
      *    E N T R Y  T A B L E 
       01 ENTRY-TABLE.
           03 ENT-TAB OCCURS 18 TIMES.
              05 ENTRY-NAME.
                07 ENTRY-NAME3  PICTURE XXX.
                07 FILLER   PICTURE X(12).
              05 ENTRY-ID   PICTURE 99. 
               05  ENT-DIR-START       PICTURE XXX. 
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
      * 
      *    C A T E G O R Y  T A B L E 
      * 
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
       01 CATG-TABLE. 
            03 CAT-TAB  OCCURS 35 TIMES.
              05 CATG-NAME. 
                07 CATG-NAME3   PICTURE XXX.
                07 FILLER   PICTURE X(12).
              05 CATG-ID   PICTURE 999. 
               05  CATG-LOC OCCURS 18 TIMES.
                07 CATG-ENT   PICTURE 99. 
                07 CATG-LENGTH   PICTURE 999. 
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
      * 
      *    LINK-AREA  OPTION-INFO,  CUST-INFO,  TOTALS
      *    USED IN DCUP00 AND DCUPDDEL
      * 
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
       01 LINK-AREA-OPT.
            03 RUN-OPTIONS. 
              05 HOLD-REV   PICTURE 9(5)   VALUE 99999. 
              05 EDIT-OPT   PICTURE X   VALUE "N".
              05 ON-LINE-SW   PICTURE X   VALUE "N".
              05 PASS-WORD   PICTURE X(5)   VALUE SPACES. 
              05 USER-OPT    PICTURE XXX    VALUE SPACES. 
              05 QUOTE-OPT   PICTURE X   VALUE QUOTE. 
           03 HOLD-DBMS           PICTURE X.
           03 CUST-NAME           PICTURE X(27).
           03 CUST-ADD            PICTURE X(27).
           03 CUR-DATE            PICTURE X(6). 
           03 TOT-TX-READ         PICTURE 9(5)   VALUE ZEROS. 
           03  CTL-PRIME-NUM PIC 9(5).
           03 CTL-PRIME-NUM-REL   PICTURE 9(5)   VALUE ZEROS. 
           03 TOT-ENT-PROC        PICTURE 9(5)   VALUE ZEROS. 
           03 TOT-ENT-ADD         PICTURE 9(5)   VALUE ZEROS. 
           03 TOT-ENT-CHG         PICTURE 9(5)   VALUE ZEROS. 
           03 TOT-ENT-DEL         PICTURE 9(5)   VALUE ZEROS. 
           03 TOT-S               PICTURE 9(5)   VALUE ZEROS. 
           03 TOT-W               PICTURE 9(5)   VALUE ZEROS. 
           03 TOT-03              PICTURE 9(5)   VALUE ZEROS. 
           03 TOT-05              PICTURE 9(5)   VALUE ZEROS. 
           03 TOT-10              PICTURE 9(5)   VALUE ZEROS. 
           03 TOT-13              PICTURE 9(5)   VALUE ZEROS. 
           03 TOT-19              PICTURE 9(5)   VALUE ZEROS. 
           03 TOT-20              PICTURE 9(5)   VALUE ZEROS. 
           03 TOT-22              PICTURE 9(5)   VALUE ZEROS. 
           03 TOT-24              PICTURE 9(5)   VALUE ZEROS. 
           03 TOT-26              PICTURE 9(5)   VALUE ZEROS. 
           03 TOT-32              PICTURE 9(5)   VALUE ZEROS. 
           03 TOT-35              PICTURE 9(5)   VALUE ZEROS. 
           03 TOT-40              PICTURE 9(5)   VALUE ZEROS. 
           03 TOT-45              PICTURE 9(5)   VALUE ZEROS. 
           03 TOT-50              PICTURE 9(5)   VALUE ZEROS. 
           03 TOT-55              PICTURE 9(5)   VALUE ZEROS. 
           03 TOT-60              PICTURE 9(5)   VALUE ZEROS. 
           03 TOT-65              PICTURE 9(5)   VALUE ZEROS. 
*CALL     WKPRINT 
00222 *     D I S P L A Y   L I N E   A R E A                              CL**2
00223 *                                                                    CL**2
00224          10  DISPLAY-MESSAGE-AREA REDEFINES STD-REPORT-REC.          CL**2
00225              15  DISP-MSG-TX          PICTURE X(72).                 CL**2
00226              15  FILLER               PICTURE X(60).                 CL**2
00227          10  DISPLAY-MESSAGE-AREA1 REDEFINES STD-REPORT-REC.         CL**2
00228              15  FILLER               PICTURE X(10).                 CL**2
00229              15  DISP-MSG-ERR.                                       CL**2
00230                  20  DISP-MSG-ERR1    PICTURE X(6).                  CL**2
00231                   20  DISP-MSG-ERR2   PICTURE X(58).                 CL**2
00232              20  DISP-MSG-ERRTAG   PICTURE X(7).                     CL**2
00233              15  DISP-MSG-ERR-IO REDEFINES DISP-MSG-ERR.             CL**2
00234                   20  FILLER           PICTURE X(6).                 CL**2
00235                   20  DISP-MSG-ERR3IO  PICTURE X(24).                CL**2
00236                  20  DISP-MSG-ERR3    PICTURE X(8).                  CL**2
00237              20  FILLER           PICTURE X(23).                     CL**2
00238              15  DISP-MSG-ERR-TYPE REDEFINES DISP-MSG-ERR.           CL**2
00239                  20  FILLER           PICTURE X(10).                 CL**2
00240                  20  DISP-MSG-ERR-LEV PICTURE X.                     CL**2
00241                  20  FILLER           PICTURE X(50).                 CL**2
                   15  FILLER PICTURE X(51).
*CALL TESTWACOM 
*CALL DCDPTRS 
       01 CAT-STC-REL-LINE REDEFINES CAT-WORK-AREAS.
               03 FILLER   PICTURE X(15). 
           03  C-LINE-TYPE         PICTURE X. 
            03 CAT-CNAME   PICTURE X(32). 
            03 CAT-PUSE    PICTURE X. 
           03  FILLER              PICTURE X(113).
*CALL QUALINE 
*CALL     WRKSTG77
00047  77  CERR-00               PICTURE X(6) VALUE "DCUPD-".           DCUPDCTL
00048  77  CERR-215W        PICTURE X(46) VALUE                            CL**2
00049      "215-W *ERROR NO VALUE ACCEPTED OR ALL DELETED".                CL**2
00050  77  CERR-400S       PICTURE X(35) VALUE                             CL**2
00051      "400-S *ERROR SYNTAX-NO ENTRY HEADER".                          CL**2
00052  77  CERR-405S       PICTURE X(31) VALUE                             CL**2
00053      "405-S *ERROR UNKNOWN ENTRY TYPE".                              CL**2
00054  77  CERR-410S       PICTURE X(47) VALUE                             CL**2
00055      "410-S *ERROR SYNTAX-UNABLE TO LOCATE ENTRY TYPE".              CL**2
00056  77  CERR-415S       PICTURE X(43) VALUE                             CL**2
00057      "415-S *ERROR CATALOGUE NAME LONGER THAN 32".                   CL**2
00058  77  CERR-420S       PICTURE X(36) VALUE                             CL**2
00059      "420-S *ERROR ADD FOR EXISTING ENTRY".                          CL**2
00060  77  CERR-425S       PICTURE X(39) VALUE                             CL**2
00061      "425-S *ERROR CHG FOR NON-EXISTENT ENTRY".                      CL**2
00062  77  CERR-435S       PICTURE X(55) VALUE                             CL**2
           "435-S *ERROR SYNTAX-UNKNOWN DATA AFTER CATALOGUE NAME ".
00064  77  CERR-445S       PICTURE X(47) VALUE                             CL**2
00065      "445-S *ERROR CATALOGUE NAME IS RESERVED WORD".                 CL**2
00066  77  CERR-500S       PICTURE X(38) VALUE                             CL**2
00067      "500-S *ERROR SYNTAX-NO CATEGORY HEADER".                       CL**2
00068  77  CERR-505S       PICTURE X(29) VALUE                             CL**2
00069      "505-S *ERROR UNKNOWN CATEGORY".                                CL**2
00070  77  CERR-510S       PICTURE X(41) VALUE                             CL**2
00071      "510-S *ERROR CATEGORY NOT VALID FOR ENTRY".                    CL**2
00072  77  CERR-515S       PICTURE X(54) VALUE                             CL**2
00073      "515-S *ERROR SYNTAX-UNKNOWN KEYWORD IN CATEGORY HEADER".       CL**2
00074  77  CERR-520S       PICTURE X(40) VALUE                             CL**2
00075      "520-S *ERROR CATEGORY CAN NOT BE DELETED".                     CL**2
00076  77  CERR-525S       PICTURE X(45) VALUE                             CL**2
00077      "525-S *ERROR CATEGORY DOES NOT EXIST IN ENTRY".                CL**2
00078  77  CERR-530S       PICTURE X(48) VALUE                             CL**2
00079      "530-S *ERROR DELETE ONLY ALLOWED FOR FUNC CHG".                CL**2
00080  77  CERR-600S       PICTURE X(52) VALUE                             CL**2
00081      "600-S *ERROR SYNTAX-NO LINE FOUND FOR LAST CATEGORY".          CL**2
00082  77  CERR-605S       PICTURE X(40) VALUE                             CL**2
00083      "605-S *ERROR LINE NUMBER NOT NUMERIC".                         CL**2
00084  77  CERR-610S       PICTURE X(55) VALUE                             CL**2
00085      "610-S *ERROR SYNTAX-LINE NUMBER NOT FOLLOWED BY A SPACE".      CL**2
00086  77  CERR-615S       PICTURE X(40) VALUE                             CL**2
00087      "615-S *ERROR LINE NUMBER OUT OF SEQUENCE".                     CL**2
00088  77  CERR-620S       PICTURE X(50) VALUE                             CL**2
00089      "620-S *ERROR END OF FILE DURING LINE CONTINUATION".            CL**2
00090  77  CERR-625S       PICTURE X(53) VALUE                             CL**2
00091      "625-S *ERROR SYNTAX-THRU MISSING ON LINE DELETE RANGE".        CL**2
00092  77  CERR-630S       PICTURE X(50) VALUE                             CL**2
00093      "630-S *ERROR SECOND LINE NUMBER LOWER THAN FIRST".             CL**2
00094  77  CERR-635S       PICTURE X(53) VALUE                             CL**2
00095      "635-S *ERROR SYNTAX-NO CLAUSE FOUND AFTER LINE NUMBER".        CL**2
00096  77  CERR-640S       PICTURE X(51) VALUE                             CL**2
00097      "640-S *ERROR LINE NUMBER DOES NOT EXIST IN CATEGORY".          CL**2
00098  77  CERR-645S       PICTURE X(47) VALUE                             CL**2
00099      "645-S *ERRROR SYNTAX-ILLEGAL LINE CONTINUATION".               CL**2
00100  77  CERR-800S       PICTURE X(24) VALUE                             CL**2
00101      "800-S *ERROR MAST1-CTL ".                                      CL**2
00102  77  CERR-850S       PICTURE X(24) VALUE                             CL**2
00103      "850-S *ERROR MAST2-CTL ".                                      CL**2
00104  77  CERR-900F       PICTURE X(42) VALUE                             CL**2
00105      "900-F *ERROR $UPDATE TRANSACTION MISSING".                     CL**2
00106  77  CERR-910F       PICTURE X(42) VALUE                             CL**2
00107      "910-F *ERROR $OPTION TRANSACTION MISSING".                     CL**2
*CALL     WRKSTG01
*CALL     MAST1WS 
*CALL     MAST1OUT
       01  HOLD-CAT-LENGTH   PICTURE 999. 
       01  HOLD-USED-BYTES   PICTURE 9999.
       01  O-DATA-NEXT-REC   PICTURE 9(5)   VALUE ZEROS.
00139  01  HOLD-DELETE            PICTURE X(9) VALUE SPACES.               CL**2
       01  HOLD-WK   PICTURE 999. 
       01  WK        PICTURE 999. 
       01  TAB       PICTURE 99  COMP.
       01 D-OUT        PICTURE 9999  COMP   VALUE 1.
00144  01  LINE-NO               PICTURE 9(4)  VALUE ZEROS.             DCUPDCTL
          01   START-POS               PICTURE 99.
00145  01  VAL-AREA.                                                    DCUPDCTL
00146      03  VAL-3POS.                                                   CL**2
00147          05  VAL-3         PICTURE X(3).                             CL**2
00148          05  FILLER        PICTURE X(37).                            CL**2
00149      03  VAL-4POS REDEFINES VAL-3POS.                                CL**2
00150          05  VAL-4         PICTURE X(4).                          DCUPDCTL
00151          05  FILLER        PICTURE X(36).                         DCUPDCTL
00152      03  VAL-5POS REDEFINES VAL-4POS.                             DCUPDCTL
00153          05  VAL-5         PICTURE X(5).                          DCUPDCTL
00154          05  FILLER        PICTURE X(35).                         DCUPDCTL
00155      03  VAL-7POS REDEFINES VAL-4POS.                                CL**2
00156          05  VAL-7          PICTURE X(7).                            CL**2
00157          05  FILLER         PICTURE X(33).                           CL**2
00158      03  VAL-8POS REDEFINES VAL-4POS.                             DCUPDCTL
00159          05  VAL-8         PICTURE X(8).                          DCUPDCTL
00160          05  FILLER        PICTURE X(32).                         DCUPDCTL
00161      03  VAL-POS  REDEFINES VAL-4POS.                             DCUPDCTL
00162          05  VAL           PICTURE X OCCURS 40 TIMES.             DCUPDCTL
00163  01  CONTROL-STATUS.                                              DCUPDCTL
00164      03  ENTRY-FOUND       PICTURE X VALUE "N".                   DCUPDCTL
00165      03  CATG-FOUND        PICTURE X VALUE "N".                   DCUPDCTL
00166      03  LINE-FOUND        PICTURE X VALUE "N".                   DCUPDCTL
00167      03  ALIAS-SW       PICTURE X VALUE "N".                         CL**2
00168      03  CATG-DEL-FOUND     PICTURE X VALUE "N".                     CL**2
00169      03  LINE-DEL-FOUND     PICTURE X VALUE "N".                     CL**2
00170      03  HOLD-DATA-LINE    PICTURE X(167) VALUE SPACES.              CL**2
00257  PROCEDURE DIVISION.                                              DCUPDCTL
00258 ***********************************************************          CL**2
00259 ***********************************************************          CL**2
00260 *                                                                 DCUPDCTL
00261 *       I N I T I L A I Z A T I O N                               DCUPDCTL
00262 *                                                                 DCUPDCTL
00263 ***********************************************************          CL**2
00264 ***********************************************************          CL**2
00265  START-PROGRAM.                                                   DCUPDCTL
00266      MOVE 1 TO MSG.                                                  CL**2
00267      OPEN INPUT TRANS-FILE.                                          CL**2
00268      OPEN OUTPUT SYSPRINT.                                           CL**2
           IF INTERACTIVE MOVE "Y" TO ON-LINE-SW. 
           MOVE ZEROS TO RETURN-CODE NUM-ENTRIES NUM-LINES. 
00269      MOVE SPACES TO PRINT-LINE.                                      CL**2
00270      MOVE "C" TO FUNC.                                               CL**2
00271      PERFORM CTL-OPT-CALL.                                           CL**2
00272      IF FUNC EQUAL TO HIGH-VALUE                                     CL**2
00273          GO TO CTL-OPT-EOJ.                                          CL**2
00276  START-PROGRAM-10.                                                   CL**2
00277      PERFORM READ-TRANS THRU READ-TRANS-XIT.                         CL**2
           IF TX-POS (1) EQUAL "-"
00279          MOVE CERR-900F TO DISP-MSG-ERR2                             CL**2
00280          GO TO CTL-OPT-EOJ-10.                                       CL**2
00281      MOVE 1 TO TX.                                                   CL**2
00282      MOVE SPACE TO STATUS-SW.                                        CL**2
00283      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                           CL**2
00284      IF VAL-8 NOT EQUAL TO "$UPDATE "                                CL**2
00285          MOVE CERR-900F TO DISP-MSG-ERR2                             CL**2
00286          GO TO CTL-OPT-EOJ-10.                                       CL**2
00287      PERFORM FIND-NON-BLANK THRU FIND-NON-BLANK-XIT.                 CL**2
00296  START-PROGRAM-20.                                                   CL**2
00297      PERFORM READ-TRANS THRU READ-TRANS-XIT.                         CL**2
           IF TX-POS (1) EQUAL "-"
00299          MOVE CERR-910F TO DISP-MSG-ERR2                             CL**2
00300          GO TO CTL-OPT-EOJ-10.                                       CL**2
00301      MOVE 1 TO TX.                                                   CL**2
00302      MOVE SPACE TO STATUS-SW.                                        CL**2
00303      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                           CL**2
00304      IF VAL-8 EQUAL TO "OPTIONS "                                    CL**2
00305          GO TO START-PROGRAM-30.                                     CL**2
00306      IF TX-4 EQUAL TO "OPT "                                         CL**2
00307          GO TO START-PROGRAM-30.                                     CL**2
00308 *                                                                    CL**2
00309 *     BYPASS OPTION PROCESSING IF NO OPT                             CL**2
00310 *                                                                    CL**2
00311      MOVE "A" TO FUNC.                                               CL**2
00312      GO TO START-PROGRAM-40.                                         CL**2
00313  START-PROGRAM-30.                                                   CL**2
00314      IF ON-LINE-SW EQUAL TO "N"                                      CL**2
00315          MOVE TX-IMAGE TO DISP-MSG-TX                                CL**2
00316          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                 CL**2
00317      PERFORM FIND-NON-BLANK THRU FIND-NON-BLANK-XIT.                 CL**2
00318      MOVE "O" TO FUNC.                                               CL**2
00319  START-PROGRAM-40.                                                   CL**2
00320      PERFORM CTL-OPT-CALL.                                           CL**2
00321      IF FUNC EQUAL TO HIGH-VALUE                                     CL**2
00322          GO TO CTL-OPT-EOJ.                                          CL**2
00323      MOVE QUOTE-OPT TO QUOTE-TYPE.                                   CL**2
00324      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00325      PERFORM DUMP-MSG-TABLE THRU DUMP-MSG-TABLE-XIT.                 CL**2
00326      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00327      OPEN I-O MAST1.                                                 CL**2
00328      PERFORM REL-IO-OPEN THRU REL-IO-OPEN-XIT.                       CL**2
00329      IF FUNC EQUAL TO "A"                                            CL**2
00330          MOVE SPACE TO FUNC                                          CL**2
00331          GO TO CTL-TX-READ-00.                                       CL**2
00332      GO TO CTL-TX-READ.                                              CL**2
00333  CTL-OPT-CALL.                                                       CL**2
           CALL "UPD00".
00336  CTL-OPT-EOJ.                                                     DCUPDCTL
00337      MOVE ERR-MSG (1) TO DISP-MSG-ERR2.                              CL**2
00338  CTL-OPT-EOJ-10.                                                  DCUPDCTL
00339      MOVE CERR-00 TO DISP-MSG-ERR1.                               DCUPDCTL
00340      MOVE "*ERROR*" TO DISP-MSG-ERRTAG.                              CL**2
00341      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCUPDCTL
00342      MOVE 12 TO RETURN-CODE.                                         CL**2
00343  CTL-OPT-EOJ-20.                                                     CL**2
00344      IF TOT-W NOT EQUAL TO ZERO                                      CL**2
00345          MOVE 8 TO RETURN-CODE.                                      CL**2
00346      IF TOT-S NOT EQUAL TO ZERO                                      CL**2
00347          MOVE 8 TO RETURN-CODE.                                      CL**2
00348      CLOSE SYSPRINT.                                                 CL**2
00349      CLOSE TRANS-FILE.                                               CL**2
           PERFORM RETURN-CODE-00 THRU RETURN-CODE-XIT. 
00350      STOP RUN.                                                    DCUPDCTL
*CALL RETCODE 
00351  READ-TRANS.                                                      DCUPDCTL
00352      IF ON-LINE-SW EQUAL TO "Y"                                      CL**2
00353          MOVE 1 TO LINE-CT                                           CL**2
00354          MOVE "INPUT ?" TO DISP-MSG-TX                               CL**2
00355          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                 CL**2
00356      READ TRANS-FILE AT END                                       DCUPDCTL
               MOVE "-" TO TX-POS (1) 
00358          GO TO READ-TRANS-XIT.                                    DCUPDCTL
00359      MOVE TRANS TO TX-IMAGE.                                      DCUPDCTL
00360  READ-TRANS-XIT. EXIT.                                            DCUPDCTL
00362 **********************************************************           CL**2
00363 *                                                                    CL**2
00364 *     ERROR WRITE MESSAGE ROUTINE                                    CL**2
00365 *                                                                    CL**2
00366 **********************************************************           CL**2
00367 *                                                                    CL**2
00368  CTL-TX-ERR.                                                         CL**2
00369      MOVE CERR-00 TO DISP-MSG-ERR1.                                  CL**2
00370      MOVE "*ERROR*" TO DISP-MSG-ERRTAG.                              CL**2
00371      IF DISP-MSG-ERR-LEV EQUAL TO "S"                                CL**2
00372          ADD 1 TO TOT-S.                                             CL**2
00373      IF DISP-MSG-ERR-LEV EQUAL TO "W"                                CL**2
00374          ADD 1 TO TOT-W.                                             CL**2
00375      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00376      IF STATUS-SW EQUAL TO "C"                                       CL**2
00377          MOVE SPACE TO STATUS-SW                                     CL**2
00379          GO TO CTL-TX-ENT.                                           CL**2
00380 ***********************************************************          CL**2
00381 ************************************************************         CL**2
00382 *                                                                 DCUPDCTL
00383 *     R E A D   T R A N S A C T I O N S                              CL**2
00384 *                                                                 DCUPDCTL
00385 ***********************************************************          CL**2
00386 ************************************************************         CL**2
00387 * ALL TX"S ARE READ HERE EXCEPT FOR LINE CONTINUATIONS.              CL**2
00388 * TEST FOR TX TYPE AND GO TO PROCESS ROUTINES.                       CL**2
00389  CTL-TX-READ.                                                     DCUPDCTL
            IF TX-POS (1) EQUAL "-" 
00391          GO TO CTL-END-TX.                                           CL**2
00392      PERFORM READ-TRANS THRU READ-TRANS-XIT.                      DCUPDCTL
           IF TX-POS (1) EQUAL "-"
00394          GO TO CTL-END-TX.                                        DCUPDCTL
00395  CTL-TX-READ-00.                                                     CL**2
00396      IF TX-POS (1) NOT EQUAL TO "*"                                  CL**2
00397          GO TO CTL-TX-READ-20.                                       CL**2
00398  CTL-TX-READ-10.                                                     CL**2
00399      MOVE TX-IMAGE TO DISP-MSG-TX.                                   CL**2
00400      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00401      GO TO CTL-TX-READ.                                              CL**2
00402  CTL-TX-READ-20.                                                     CL**2
00403      ADD 1 TO TOT-TX-READ.                                           CL**2
           IF TX-POS (1) NUMERIC
00405          GO TO CTL-TX-LINE.                                       DCUPDCTL
00406      IF TX-4 EQUAL TO "ADD " OR "CHG " OR "DEL "                     CL**2
00407          GO TO CTL-TX-ENT.                                           CL**2
00408      IF TX-8 EQUAL TO SPACES                                         CL**2
00409          GO TO CTL-TX-READ-10.                                       CL**2
00410      IF TX-4 EQUAL TO "OPT "                                         CL**2
00411          GO TO CTL-TX-READ-10.                                       CL**2
00412      IF TX-8 EQUAL TO "OPTIONS " OR "$UPDATE "                       CL**2
00413          GO TO CTL-TX-READ-10.                                       CL**2
00414      GO TO CTL-TX-CATG.                                           DCUPDCTL
00415 ************************************************************         CL**2
00416 ************************************************************         CL**2
00417 *                                                                 DCUPDCTL
00418 *     E N T R Y   E D I T  +  P R O C E S S                          CL**2
00419 *                                                                 DCUPDCTL
00420 ************************************************************         CL**2
00421 ************************************************************         CL**2
00422 * IF AN ENTRY HAS BEEN READ- CLOSE IT OFF BEFORE                     CL**2
00423 * PROCESSING THE NEW ONE.                                            CL**2
00424  CTL-TX-ENT.                                                      DCUPDCTL
00425      IF ENTRY-FOUND EQUAL TO "N"                                  DCUPDCTL
00426          GO TO CTL-TX-ENT-CLOSE-END.                                 CL**2
00427 *****************************************************************    CL**2
00428 *                                                                    CL**2
00429 *     C L O S E   O F F   L A S T   E N T R Y                        CL**2
00430 *                                                                    CL**2
00431 *****************************************************************    CL**2
00432 * IF FUNCTION IS ADD THE LAST DATA LINE                              CL**2
00433 *    HAS BEEN WRITTEN OUT,                                           CL**2
00434 *    CLOSE ENTRY AND WRITE REL RECORD.                               CL**2
00435 * IF FUNCTION IS CHANGE THE LAST DATA LINE                           CL**2
00436 *    HAS BEEN WRITTEN IF INSERT                                      CL**2
00437 *    HAS NOT IF A CHANGE - WRITE IT                                  CL**2
00438 *    WRITE REST OF INPUT RECORD AND CLOSE                            CL**2
00439 * IF EDIT ONLY - SKIP OVER ROUTINE.                                  CL**2
00440  CTL-TX-ENT-CLOSE.                                                   CL**2
00441      IF EDIT-OPT EQUAL TO "Y"                                        CL**2
00442          GO TO CTL-TX-ENT-CLOSE-XIT.                                 CL**2
00443       IF ADD-CHG EQUAL TO "C"                                        CL**2
00444           GO TO CTL-TX-ENT-CLOSE-CHG.                                CL**2
00445      PERFORM CLOSE-DATA-REC THRU CLOSE-DATA-REC-XIT.                 CL**2
00446      MOVE SPACES TO REL-ANSWER.                                      CL**2
00447      MOVE CATAL-NAME TO REL-ENTRY-NAME.                              CL**2
00448      MOVE ENT-ID TO REL-ENTRY-TYPE.                                  CL**2
00449      IF ALIAS-SW EQUAL TO "Y"                                        CL**2
00450          MOVE 1 TO REL-ENTRY-ALIAS.                                  CL**2
00451      PERFORM REL-ADD THRU REL-ADD-XIT.                               CL**2
00452      ADD 1 TO TOT-ENT-ADD.                                           CL**2
00453      MOVE SPACES TO REL-ANSWER.                                      CL**2
00454      MOVE ALL-NAMES-LITERAL TO REL-ENTRY-NAME.                       CL**2
00455      MOVE CATAL-NAME TO REL-POINTER-NAME.                            CL**2
00456      MOVE ENT-ID TO REL-POINTER-TYPE.                                CL**2
00457      IF ALIAS-SW EQUAL TO "Y"                                        CL**2
00458          MOVE 1 TO REL-POINTER-ALIAS.                                CL**2
00459      PERFORM REL-ADD-PTR THRU REL-ADD-PTR-XIT.                       CL**2
00460      IF REL-RETURN-CODE NOT EQUAL TO 0                               CL**2
00461          MOVE CERR-850S TO DISP-MSG-ERR2                             CL**2
00462          MOVE "ADD SYS" TO DISP-MSG-ERR3                             CL**2
               MOVE CERR-00 TO DISP-MSG-ERR1
               MOVE "*ERROR*" TO DISP-MSG-ERRTAG
               ADD 1 TO TOT-S 
               PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.
00464      GO TO CTL-TX-ENT-CLOSE-XIT.                                     CL**2
00465  CTL-TX-ENT-CLOSE-CHG.                                               CL**2
00466      IF DATA-RETURN-CODE EQUAL 1                                     CL**2
00467          GO TO CTL-TX-ENT-CLOSE-CHG-10.                              CL**2
00468      IF INS-LINE-SW EQUAL TO "Y"                                     CL**2
00469          MOVE HOLD-DATA-LINE TO CAT-WORK-AREAS                       CL**2
00470          MOVE "N" TO INS-LINE-SW.                                    CL**2
00471      PERFORM WRITE-DATA-LINE THRU WRITE-DATA-LINE-XIT.               CL**2
           IF NUM-LINES GREATER THAN ZERO 
               PERFORM WRITE-MULTI-LINES THRU WRITE-MULTI-LINES-EXIT
           END-IF 
00472      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00473      IF DATA-RETURN-CODE EQUAL TO 0 OR 2                             CL**2
00474          GO TO CTL-TX-ENT-CLOSE-CHG.                                 CL**2
00475  CTL-TX-ENT-CLOSE-CHG-10.                                            CL**2
00476      PERFORM CLOSE-DATA-REC THRU CLOSE-DATA-REC-XIT.                 CL**2
00477      ADD 1 TO TOT-ENT-CHG.                                           CL**2
00478 *     EXIT USED BY END OF TX -ONLY                                   CL**2
00479  CTL-TX-ENT-CLOSE-XIT. EXIT.                                         CL**2
00480  CTL-TX-ENT-CLOSE-END.                                               CL**2
00481      MOVE ZERO TO O-DATA-NEXT-REC.                                   CL**2
00482      MOVE SPACES TO O-DATA-RECORD.                                   CL**2
00483      MOVE 1 TO D-OUT.                                                CL**2
00484      MOVE ZEROS TO CAT-ID.                                           CL**2
00485      MOVE SPACES TO REL-LAST-ENTRY-NAME.                             CL**2
00486      MOVE SPACES TO REL-ANSWER.                                      CL**2
00487      MOVE SPACES TO DATA-LAST-ENTRY-NAME.                            CL**2
00489      MOVE "N" TO INS-LINE-SW.                                        CL**2
00490 *     EXIT USED BY STEP DOWN IN CATG -ONLY                           CL**2
00491  CTL-TX-ENT-CLOSE-STEPDWN-XIT  . EXIT.                               CL**2
00492 *                                                                    CL**2
00493 *     PRINT NEW ENTRY HEADER                                         CL**2
00494 *                                                                    CL**2
00495  CTL-TX-ENT-10.                                                      CL**2
00496      MOVE "N" TO ENTRY-FOUND CATG-FOUND LINE-FOUND.                  CL**2
00497      MOVE "N" TO ALIAS-SW.                                           CL**2
00498      IF ON-LINE-SW EQUAL TO "Y"                                      CL**2
00499          GO TO CTL-TX-ENT-20.                                        CL**2
00500      MOVE ALL "*" TO DISP-MSG-TX.                                    CL**2
00501      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCUPDCTL
00502      MOVE "*" TO DISP-MSG-TX.                                        CL**2
00503      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00504      MOVE TX-IMAGE TO DISP-MSG-TX.                                DCUPDCTL
00505      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCUPDCTL
00506      MOVE "*" TO DISP-MSG-TX.                                        CL**2
00507      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00508      MOVE ALL "*" TO DISP-MSG-TX.                                    CL**2
00509      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCUPDCTL
00510  CTL-TX-ENT-20.                                                      CL**2
00511      MOVE TX-POS (1) TO ADD-CHG.                                     CL**2
00512      MOVE SPACES TO HOLD-DELETE.                                     CL**2
00513      ADD 1 TO TOT-ENT-PROC.                                          CL**2
00514 ***********************************************************          CL**2
00515 *                                                                    CL**2
00516 *     PROCESS ENTRY DELETE                                           CL**2
00517 *                                                                    CL**2
00518 ***********************************************************          CL**2
00519 * FILES ARE CLOSED AND DELETE ROUTINE IS CALLED.                     CL**2
00520 * UPON RETURN MESSAGES ARE PRINTED, FILES OPENED                     CL**2
00521 * AND PROCESSING IS CONTINUED WITH TX READ.                          CL**2
00522      IF ADD-CHG NOT EQUAL TO "D"                                     CL**2
00523          GO TO CTL-TX-LOC-ENT.                                       CL**2
00524      CLOSE MAST1.                                                    CL**2
00525      CLOSE MAST2.                                                    CL**2
00526      MOVE SPACE TO FUNC.                                             CL**2
00527  CTL-TX-ENT-DEL.                                                     CL**2
           CALL "UPDDEL". 
00530      PERFORM DUMP-MSG-TABLE THRU DUMP-MSG-TABLE-XIT.                 CL**2
00531      IF FUNC EQUAL TO "D" GO TO CTL-TX-ENT-DEL.                      CL**2
00532      OPEN I-O MAST1.                                                 CL**2
00533      OPEN I-O MAST2.                                                 CL**2
00534      GO TO CTL-TX-READ.                                              CL**2
00535 *                                                                 DCUPDCTL
00536 *     EDIT NEW ENTRY HEADER                                          CL**2
00537 *                                                                 DCUPDCTL
00538 * ENTRY HEADER FUNCTION HAS BEEN FOUND                               CL**2
00539 * LOCATE ENTRY TYPE AND CATAL NAME                                   CL**2
00540 * DELETES HAVE BEEN DEALT WITH                                       CL**2
00541  CTL-TX-LOC-ENT.                                                  DCUPDCTL
00542      MOVE 4 TO TX.                                                   CL**2
00543      PERFORM FIND-NON-BLANK THRU FIND-NON-BLANK-XIT.                 CL**2
00544      MOVE "=" TO STATUS-SW.                                          CL**2
00545      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                           CL**2
00546      IF VA GREATER THAN 16                                           CL**2
00547          MOVE CERR-410S TO DISP-MSG-ERR2                             CL**2
00548          GO TO CTL-TX-ERR.                                           CL**2
00549      MOVE 1 TO TAB.                                               DCUPDCTL
00550  CTL-TX-LOC-ENT30.                                                DCUPDCTL
00551      IF ENTRY-NAME (TAB) EQUAL TO VAL-AREA                           CL**2
00552          GO TO CTL-TX-LOC-ENT40.                                  DCUPDCTL
00553      IF VAL (4) EQUAL TO SPACE   AND                                 CL**2
00554          ENTRY-NAME3 (TAB) EQUAL TO VAL-3                            CL**2
00555              GO TO CTL-TX-LOC-ENT40.                                 CL**2
00556      IF ENTRY-NAME3 (TAB) EQUAL TO HIGH-VALUES                       CL**2
00557          MOVE CERR-405S TO DISP-MSG-ERR2                             CL**2
00558           GO TO CTL-TX-ERR.                                          CL**2
00559      ADD 1 TO TAB.                                                DCUPDCTL
00560      GO TO CTL-TX-LOC-ENT30.                                      DCUPDCTL
00561  CTL-TX-LOC-ENT40.                                                DCUPDCTL
00562      MOVE ENTRY-ID (TAB) TO ENT-ID.                               DCUPDCTL
      *    CALL UPD00 TO LOAD CATEGORY AND FIELD TABLES 
      *    FOR THIS ENTITY
           MOVE "T" TO FUNC.
           PERFORM CTL-OPT-CALL.
           IF FUNC EQUAL TO HIGH-VALUE
               GO TO CTL-OPT-EOJ. 
           IF ENT-ID = 03 ADD 1 TO TOT-03 GO TO ENT-40-DONE.
           IF ENT-ID = 05 ADD 1 TO TOT-05 GO TO ENT-40-DONE.
           IF ENT-ID = 10 ADD 1 TO TOT-10 GO TO ENT-40-DONE.
           IF ENT-ID = 13 ADD 1 TO TOT-13 GO TO ENT-40-DONE.
           IF ENT-ID = 19 ADD 1 TO TOT-19 GO TO ENT-40-DONE.
           IF ENT-ID = 20 ADD 1 TO TOT-20 GO TO ENT-40-DONE.
           IF ENT-ID = 22 ADD 1 TO TOT-22 GO TO ENT-40-DONE.
           IF ENT-ID = 24 ADD 1 TO TOT-24 GO TO ENT-40-DONE.
           IF ENT-ID = 26 ADD 1 TO TOT-26 GO TO ENT-40-DONE.
           IF ENT-ID = 32 ADD 1 TO TOT-32 GO TO ENT-40-DONE.
           IF ENT-ID = 35 ADD 1 TO TOT-35 GO TO ENT-40-DONE.
           IF ENT-ID = 40 ADD 1 TO TOT-40 GO TO ENT-40-DONE.
           IF ENT-ID = 45 ADD 1 TO TOT-45 GO TO ENT-40-DONE.
           IF ENT-ID = 50 ADD 1 TO TOT-50 GO TO ENT-40-DONE.
           IF ENT-ID = 55 ADD 1 TO TOT-55 GO TO ENT-40-DONE.
           IF ENT-ID = 60 ADD 1 TO TOT-60 GO TO ENT-40-DONE.
           IF ENT-ID = 65 ADD 1 TO TOT-65 GO TO ENT-40-DONE.
00605 *                                                                 DCUPDCTL
00606 *     LOCATE CATALOGUE NAME                                       DCUPDCTL
00607 *                                                                 DCUPDCTL
       ENT-40-DONE. 
00608      ADD 1 TO TX.                                                    CL**2
00609      MOVE SPACE TO STATUS-SW.                                        CL**2
           IF TX-POS (TX) EQUAL SPACE 
               ADD 1 TO TX. 
00610      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                           CL**2
00611      MOVE VAL-AREA TO CATAL-NAME.                                    CL**2
00612      IF VA GREATER THAN 33                                           CL**2
00613          MOVE CERR-415S TO DISP-MSG-ERR2                             CL**2
00614          GO TO CTL-TX-ERR.                                           CL**2
00615 *                                                                    CL**2
00616 *     CHECK CAT NAME FOR RESERVED WORDS                              CL**2
00617 *                                                                    CL**2
00618      MOVE 1 TO TAB.                                                  CL**2
00619      IF CATAL-NAME EQUAL TO "DAT " OR "DATA " OR "ENT " OR           CL**2
00620          "ENTRY " OR "PRO " OR "PROCEDURE "                          CL**2
00621          GO TO CTL-TX-LOC-ENT50.                                     CL**2
00622  CTL-TX-LOC-ENT45.                                                   CL**2
00623      IF ENTRY-NAME (TAB) EQUAL TO CATAL-NAME                         CL**2
00624          GO TO CTL-TX-LOC-ENT50.                                     CL**2
00625      IF VAL (4) EQUAL TO SPACE   AND                                 CL**2
00626          ENTRY-NAME3 (TAB) EQUAL TO VAL-3                            CL**2
00627          GO TO CTL-TX-LOC-ENT50.                                     CL**2
00628      IF ENTRY-NAME3 (TAB) EQUAL TO HIGH-VALUES                       CL**2
00629          GO TO CTL-TX-LOC-ENT55.                                     CL**2
00630      ADD 1 TO TAB.                                                   CL**2
00631      GO TO CTL-TX-LOC-ENT45.                                         CL**2
00632  CTL-TX-LOC-ENT50.                                                   CL**2
00633      MOVE CERR-445S TO DISP-MSG-ERR2.                                CL**2
00634      GO TO CTL-TX-ERR.                                               CL**2
00635  CTL-TX-LOC-ENT55.                                                   CL**2
00636      PERFORM FIND-NON-BLANK THRU FIND-NON-BLANK-XIT.                 CL**2
00637      IF STATUS-SW EQUAL TO "E"                                       CL**2
00638          GO TO CTL-TX-LOC-ENT60.                                     CL**2
00639      IF ADD-CHG NOT EQUAL TO "D"                                     CL**2
00640          MOVE CERR-435S TO DISP-MSG-ERR2                             CL**2
00641           GO TO CTL-TX-ERR.                                          CL**2
00642  CTL-TX-LOC-ENT60.                                                DCUPDCTL
00643 *                                                                 DCUPDCTL
00644 *     SEE IF ENTRY ALLREADY EXISTS ON REL FILE                    DCUPDCTL
00645 *                                                                 DCUPDCTL
00646      MOVE CATAL-NAME TO REL-ENTRY-NAME.                              CL**2
00647      MOVE SPACE TO REL-ENTRY-FUNCTION.                               CL**2
00648      PERFORM REL-READ THRU REL-READ-XIT.                             CL**2
           IF REL-RETURN-CODE EQUAL TO 2
00650         GO TO CTL-TX-NO-ENT.                                      DCUPDCTL
00651      IF ADD-CHG EQUAL TO "A"                                      DCUPDCTL
00652          MOVE CERR-420S TO DISP-MSG-ERR2                             CL**2
00653           GO TO CTL-TX-ERR.                                          CL**2
00654      IF REL-ENTRY-TYPE NOT EQUAL TO ENT-ID                           CL**2
00655          MOVE CERR-425S TO DISP-MSG-ERR2                             CL**2
00656          GO TO CTL-TX-ERR.                                           CL**2
00657      GO TO CTL-FILE-ADD.                                          DCUPDCTL
00658  CTL-TX-NO-ENT.                                                   DCUPDCTL
00659      IF ADD-CHG EQUAL TO "C"                                      DCUPDCTL
00660          MOVE CERR-425S TO DISP-MSG-ERR2                             CL**2
00661           GO TO CTL-TX-ERR.                                          CL**2
00662 *                                                                 DCUPDCTL
00663 *     ADD AN ENTRY - SETUP                                        DCUPDCTL
00664 *                                                                 DCUPDCTL
00665  CTL-FILE-ADD.                                                    DCUPDCTL
00666      MOVE "Y" TO ENTRY-FOUND.                                     DCUPDCTL
00667      IF ADD-CHG NOT EQUAL TO "A" GO TO CTL-FILE-CHG.              DCUPDCTL
00668      MOVE ENT-ID TO O-DATA-HDR-ENT-ID.                            DCUPDCTL
00669      MOVE USER-OPT TO O-DATA-HDR-NAME-LST.                        DCUPDCTL
00670      MOVE PASS-WORD TO O-DATA-HDR-PWD-LST.                        DCUPDCTL
00671      MOVE HOLD-REV TO O-DATA-HDR-REV-ADD.                         DCUPDCTL
00672      MOVE CUR-DATE TO O-DATA-HDR-DATE-ADD.                           CL**2
00673      MOVE CUR-DATE TO O-DATA-HDR-DATE-LST.                           CL**2
00674      MOVE ZERO TO O-DATA-HDR-USAGE.                                  CL**2
00675      GO TO CTL-TX-READ.                                              CL**2
00676 *                                                                 DCUPDCTL
00677 *     CHANGE AN ENTRY                                                CL**2
00678 *                                                                 DCUPDCTL
00679  CTL-FILE-CHG.                                                    DCUPDCTL
00680      MOVE CATAL-NAME TO DATA-ENTRY-NAME.                             CL**2
00681      PERFORM READ-FIRST-DATA THRU READ-FIRST-DATA-XIT.               CL**2
00682      IF EDIT-OPT NOT EQUAL TO "Y"                                    CL**2
00683          OPEN OUTPUT TEMP1.                                          CL**2
00684      MOVE DATA-HEADER TO O-DATA-HEADER.                              CL**2
00685      MOVE USER-OPT TO O-DATA-HDR-NAME-LST.                           CL**2
00686      MOVE PASS-WORD TO O-DATA-HDR-PWD-LST.                           CL**2
00687      MOVE CUR-DATE TO O-DATA-HDR-DATE-LST.                           CL**2
00688      MOVE HOLD-REV TO O-DATA-HDR-REV-ADD.                            CL**2
00689      SUBTRACT 1 FROM O-DATA-HDR-REV-ADD.                             CL**2
00690      ADD 1 TO O-DATA-HDR-USAGE.                                      CL**2
00691 *    STEP DOWN IN CATEGORY WONT GET PAST HERE                        CL**2
00692  CTL-FILE-CHG-10.                                                    CL**2
00693      GO TO CTL-TX-READ.                                           DCUPDCTL
00695 ************************************************************         CL**2
00696 ************************************************************         CL**2
00697 *                                                                 DCUPDCTL
00698 *     C A T E G O R Y   E D I T  +  P R O C E S S                    CL**2
00699 *                                                                 DCUPDCTL
00700 ************************************************************         CL**2
00701 ************************************************************         CL**2
00702  CTL-TX-CATG.                                                     DCUPDCTL
00703      IF ON-LINE-SW EQUAL TO "N"                                      CL**2
00704          MOVE TX-IMAGE TO DISP-MSG-TX                                CL**2
00705          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                 CL**2
00706      IF ENTRY-FOUND EQUAL TO "N"                                  DCUPDCTL
00707          MOVE CERR-400S TO DISP-MSG-ERR2                             CL**2
00708           GO TO CTL-TX-ERR.                                          CL**2
00709      IF CATG-FOUND EQUAL TO "N"                                   DCUPDCTL
00710          GO TO CTL-TX-CATG-10.                                    DCUPDCTL
00711      IF LINE-FOUND EQUAL TO "N"                                   DCUPDCTL
00712          MOVE CERR-600S TO DISP-MSG-ERR2                             CL**2
00713          MOVE CERR-00 TO DISP-MSG-ERR1                               CL**2
00714          MOVE "*ERROR*" TO DISP-MSG-ERRTAG                           CL**2
00715          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                 CL**2
00716  CTL-TX-CATG-10.                                                  DCUPDCTL
00717      MOVE SPACES TO HOLD-DELETE.                                     CL**2
00718      MOVE "N" TO CATG-FOUND.                                      DCUPDCTL
00719      MOVE 1 TO TX.                                                   CL**2
00720      MOVE SPACE TO STATUS-SW.                                        CL**2
00721      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                           CL**2
00722      MOVE 1 TO TAB.                                                  CL**2
00723  CTL-TX-CATG-20.                                                     CL**2
00724      IF CATG-NAME (TAB) EQUAL TO HIGH-VALUE                          CL**2
00725          MOVE CERR-505S TO DISP-MSG-ERR2                             CL**2
00726          GO TO CTL-TX-ERR.                                           CL**2
00727      IF CATG-NAME (TAB) EQUAL TO VAL-AREA                            CL**2
00728          GO TO CTL-TX-CATG-30.                                       CL**2
00729      IF VAL (4) EQUAL TO SPACE   AND                                 CL**2
00730          CATG-NAME3 (TAB) EQUAL TO VAL-3                             CL**2
00731              GO TO CTL-TX-CATG-30.                                   CL**2
00732      ADD 1 TO TAB.                                                   CL**2
00733      GO TO CTL-TX-CATG-20.                                           CL**2
00734  CTL-TX-CATG-30.                                                     CL**2
00735      PERFORM FIND-NON-BLANK THRU FIND-NON-BLANK-XIT.                 CL**2
00736      IF STATUS-SW EQUAL TO "E"                                       CL**2
00737          GO TO CTL-TX-CATG-40.                                       CL**2
00738      MOVE SPACE TO STATUS-SW.                                        CL**2
00739      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                           CL**2
00740      IF VAL-AREA EQUAL TO "DEL " OR "DELETE "                        CL**2
00741          MOVE VAL-AREA TO HOLD-DELETE                                CL**2
00742          GO TO CTL-TX-CATG-40.                                       CL**2
00743      MOVE CERR-515S TO DISP-MSG-ERR2.                                CL**2
00744      GO TO CTL-TX-ERR.                                               CL**2
00745  CTL-TX-CATG-40.                                                     CL**2
00746      MOVE 1 TO WK.                                                   CL**2
00747  CTL-TX-CATG-50.                                                     CL**2
00748      IF CATG-ENT (TAB, WK) EQUAL TO ENT-ID                           CL**2
00749          GO TO CTL-TX-CATG-60.                                       CL**2
00750      ADD 1 TO WK.                                                    CL**2
           IF WK LESS THAN 18 
00752          GO TO CTL-TX-CATG-50.                                       CL**2
00753      MOVE CERR-510S TO DISP-MSG-ERR2.                                CL**2
00754      GO TO CTL-TX-ERR.                                               CL**2
00755  CTL-TX-CATG-60.                                                     CL**2
00756 *                                                                    CL**2
00757 *     STEP DOWN IN CATEGORY TEST AND PROCESS                         CL**2
00758 *                                                                    CL**2
00759      IF CATG-ID (TAB) GREATER THAN CAT-ID                            CL**2
00760          GO TO CTL-TX-CATG-70.                                       CL**2
00761      IF EDIT-OPT EQUAL TO "Y"                                        CL**2
00762          MOVE HOLD-WK TO WK                                          CL**2
00763          GO TO CTL-TX-CATG-70.                                       CL**2
00764      MOVE WK TO HOLD-WK.                                             CL**2
00765      PERFORM CTL-TX-ENT-CLOSE THRU CTL-TX-ENT-CLOSE-STEPDWN-XIT  .   CL**2
00766      SUBTRACT 1 FROM TOT-ENT-CHG.                                    CL**2
00767      PERFORM CTL-FILE-CHG.                                           CL**2
00768      MOVE "C" TO ADD-CHG.                                            CL**2
00769      MOVE HOLD-WK TO WK.                                             CL**2
00770  CTL-TX-CATG-70.                                                     CL**2
00771      MOVE CATG-LENGTH (TAB, WK) TO HOLD-CAT-LENGTH.                  CL**2
00772      MOVE "Y" TO CATG-FOUND.                                      DCUPDCTL
00773      MOVE "N" TO LINE-FOUND.                                      DCUPDCTL
00774      MOVE ZEROS TO LINE-NO.                                       DCUPDCTL
00775      MOVE CATG-ID (TAB) TO CAT-ID.                                DCUPDCTL
00776      IF HOLD-DELETE EQUAL TO SPACES                                  CL**2
00777          GO TO CTL-TX-READ.                                          CL**2
00778      MOVE "Y" TO LINE-FOUND.                                         CL**2
00779 ***********************************************************          CL**2
00780 *                                                                    CL**2
00781 *     PROCESS CATEGORY DELETE                                        CL**2
00782 *                                                                    CL**2
00783 ***********************************************************          CL**2
      *  IF CATEGORY IS CONTROL, STRUCTURE, PROCESS, RELATION,
      *    AREAKEY, ACCESS, SSREL, CONSTRAINT OR JOIN - 
      *    IN OTHER WORDS ANYTHING CAUSING REL-POINTERS TO BE 
      *    ADDED - NO DELETE IS ALLOWED 
           IF CAT-ID EQUAL TO 010 OR 300 OR 400 OR 425 OR 450 
             OR 500 OR 525 OR 550 OR 575 OR 800 
00787          MOVE CERR-520S TO DISP-MSG-ERR2                             CL**2
00788          GO TO CTL-TX-ERR.                                           CL**2
           IF ADD-CHG EQUAL "A" 
               MOVE CERR-530S TO DISP-MSG-ERR2
               GO TO CTL-TX-ERR.
00789      MOVE "N" TO CATG-DEL-FOUND.                                     CL**2
00790  CTL-TX-CATG-DEL.                                                    CL**2
00791      IF DATA-RETURN-CODE EQUAL TO 1                                  CL**2
00792          GO TO CTL-TX-CATG-DEL-00.                                   CL**2
00793      IF INS-LINE-SW EQUAL TO "Y"                                     CL**2
00794           MOVE HOLD-DATA-LINE TO CAT-WORK-AREAS                      CL**2
00795          MOVE "N" TO INS-LINE-SW.                                    CL**2
00796      IF CAT-CATEGORY LESS THAN CAT-ID                                CL**2
00797          GO TO CTL-TX-CATG-DEL-10.                                   CL**2
00798      IF CAT-CATEGORY EQUAL TO CAT-ID                                 CL**2
00799          GO TO CTL-TX-CATG-DEL-20.                                   CL**2
00800  CTL-TX-CATG-DEL-00.                                                 CL**2
00801      IF CATG-DEL-FOUND EQUAL TO "N"                                  CL**2
00802          MOVE CERR-525S TO DISP-MSG-ERR2                             CL**2
00803          GO TO CTL-TX-ERR.                                           CL**2
00804      GO TO CTL-TX-READ.                                              CL**2
00805  CTL-TX-CATG-DEL-10.                                                 CL**2
00806      PERFORM WRITE-DATA-LINE THRU WRITE-DATA-LINE-XIT.               CL**2
00807      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00808      IF DATA-RETURN-CODE EQUAL TO 0 OR 2                             CL**2
00809          GO TO CTL-TX-CATG-DEL.                                      CL**2
00810      MOVE CERR-525S TO DISP-MSG-ERR2.                                CL**2
00811      GO TO CTL-TX-ERR.                                               CL**2
00812  CTL-TX-CATG-DEL-20.                                                 CL**2
00813      MOVE "Y" TO CATG-DEL-FOUND.                                     CL**2
00814      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00815      GO TO CTL-TX-CATG-DEL.                                          CL**2
00818 ************************************************************         CL**2
00819 *                                                                 DCUPDCTL
00820 *     L I N E   E D I T  +  P R O C E S S                            CL**2
00821 *                                                                 DCUPDCTL
00822 ************************************************************         CL**2
00824  CTL-TX-LINE.                                                     DCUPDCTL
00825      MOVE SPACE TO TYPE-CATAL-NAME.                                  CL**2
00826      IF ON-LINE-SW EQUAL TO "N"                                      CL**2
00827          MOVE TX-IMAGE TO DISP-MSG-TX                                CL**2
00828          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                 CL**2
00829      IF ENTRY-FOUND EQUAL TO "N"                                  DCUPDCTL
00830          MOVE CERR-400S TO DISP-MSG-ERR2                             CL**2
00831           GO TO CTL-TX-ERR.                                          CL**2
00832      IF CATG-FOUND EQUAL TO "N"                                   DCUPDCTL
00833          MOVE CERR-500S TO DISP-MSG-ERR2                             CL**2
00834           GO TO CTL-TX-ERR.                                          CL**2
00835      MOVE SPACE TO STATUS-SW.                                        CL**2
00836      MOVE 1 TO TX.                                                   CL**2
00837      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                           CL**2
00838      IF VA GREATER THAN 5                                            CL**2
00839          MOVE CERR-610S TO DISP-MSG-ERR2                             CL**2
00840          GO TO CTL-TX-ERR.                                           CL**2
00841      PERFORM VALID-NUMERIC THRU VALID-NUMERIC-XIT.                   CL**2
00842      IF NUM-HOLD NOT GREATER THAN LINE-NO                            CL**2
00843          MOVE CERR-615S TO DISP-MSG-ERR2                             CL**2
00844          GO TO CTL-TX-ERR.                                           CL**2
00845      MOVE TX TO HOLD-WK.                                             CL**2
00846      PERFORM FIND-NON-BLANK THRU FIND-NON-BLANK-XIT.                 CL**2
00847      IF STATUS-SW EQUAL TO "E"                                       CL**2
00848          MOVE CERR-635S TO DISP-MSG-ERR2                             CL**2
00849          GO TO CTL-TX-ERR.                                           CL**2
00850      IF CAT-ID EQUAL TO 030                                          CL**2
00851          MOVE HOLD-WK TO TX                                          CL**2
00852          ADD 1 TO TX.                                                CL**2
00853      MOVE NUM-HOLD TO LINE-NO.                                    DCUPDCTL
00854      MOVE TX TO HOLD-WK.                                             CL**2
00855      MOVE HIGH-VALUE TO STATUS-SW.                                   CL**2
00856      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                           CL**2
00857      MOVE HOLD-WK TO TX.                                             CL**2
00858      IF VAL-4 EQUAL TO "DEL "                                        CL**2
00859          ADD 3 TO TX                                                 CL**2
00860          GO TO CTL-TX-LINE-10.                                       CL**2
           IF VAL-5 EQUAL "$DEL " 
               ADD 4 TO TX
               GO TO CTL-TX-LINE-10.
00861      IF VAL-7 EQUAL TO "DELETE "                                     CL**2
00862          ADD 6 TO TX                                                 CL**2
00863          GO TO CTL-TX-LINE-10.                                       CL**2
           IF VAL-8 EQUAL TO "$DELETE " 
               ADD 7 TO TX
               GO TO CTL-TX-LINE-10.
00864      MOVE "Y" TO LINE-FOUND.                                         CL**2
00865      GO TO CTL-TX-LINE-NODEL.                                        CL**2
00866  CTL-TX-LINE-10.                                                     CL**2
00867 *                                                                    CL**2
00868 *     TEST FOR RANGE DELETE                                          CL**2
00869 *                                                                    CL**2
00870      IF ADD-CHG EQUAL TO "A"                                         CL**2
00871          MOVE CERR-530S TO DISP-MSG-ERR2                             CL**2
00872          GO TO CTL-TX-ERR.                                           CL**2
00873      PERFORM FIND-NON-BLANK THRU FIND-NON-BLANK-XIT.                 CL**2
00874      IF STATUS-SW EQUAL TO "E"                                       CL**2
00875          GO TO CTL-TX-LINE-DELETE.                                   CL**2
00876      MOVE SPACE TO STATUS-SW.                                        CL**2
00877      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                           CL**2
00878      IF VAL-AREA NOT EQUAL TO "THRU"                                 CL**2
00879          MOVE CERR-625S TO DISP-MSG-ERR2                             CL**2
00880          GO TO CTL-TX-ERR.                                           CL**2
00881      PERFORM FIND-NON-BLANK THRU FIND-NON-BLANK-XIT.                 CL**2
00882      IF STATUS-SW EQUAL TO "E"                                       CL**2
00883          MOVE CERR-625S TO DISP-MSG-ERR2                             CL**2
00884          GO TO CTL-TX-ERR.                                           CL**2
00885      MOVE SPACE TO STATUS-SW.                                        CL**2
00886      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                           CL**2
00887      PERFORM VALID-NUMERIC THRU VALID-NUMERIC-XIT.                   CL**2
           IF NUM-HOLD LESS THAN LINE-NO
00889          MOVE CERR-630S TO DISP-MSG-ERR2                             CL**2
00890          GO TO CTL-TX-ERR.                                           CL**2
00891  CTL-TX-LINE-DELETE.                                                 CL**2
00892      MOVE "Y" TO LINE-FOUND.                                         CL**2
00893      MOVE "N" TO CATG-DEL-FOUND.                                     CL**2
00894      MOVE "N" TO LINE-DEL-FOUND.                                     CL**2
00895 ***********************************************************          CL**2
00896 *                                                                    CL**2
00897 *     PROCESS LINE DELETE                                            CL**2
00898 *                                                                    CL**2
00899 ***********************************************************          CL**2
      *  IF CATEGORY IS CONTROL, STRUCTURE, PROCESS, RELATION,
      *    AREAKEY,ACCESS,SSREL,CONSTRAINT OR JOIN
00901 *    POINTERS ARE DELETED ON REL FILE DURING                         CL**2
00902 *    LINE DELETE - EVEN IF RANGE DELETE.                             CL**2
00903  CTL-TX-LINE-DEL.                                                    CL**2
00904      IF DATA-RETURN-CODE EQUAL TO 1                                  CL**2
00905          GO TO CTL-TX-LINE-DEL-05.                                   CL**2
00906      IF INS-LINE-SW EQUAL TO "Y"                                     CL**2
00907          MOVE HOLD-DATA-LINE TO CAT-WORK-AREAS                       CL**2
00908          MOVE "N" TO INS-LINE-SW.                                    CL**2
00909      IF CAT-CATEGORY LESS THAN CAT-ID                                CL**2
00910          PERFORM WRITE-DATA-LINE THRU WRITE-DATA-LINE-XIT            CL**2
00911          GO TO CTL-TX-LINE-DEL-40.                                   CL**2
00912      IF CAT-CATEGORY EQUAL TO CAT-ID                                 CL**2
00913          GO TO CTL-TX-LINE-DEL-10.                                   CL**2
00914  CTL-TX-LINE-DEL-00.                                                 CL**2
00915      IF CATG-DEL-FOUND EQUAL TO "N"                                  CL**2
00916          MOVE CERR-525S TO DISP-MSG-ERR2                             CL**2
00917          GO TO CTL-TX-ERR.                                           CL**2
00918  CTL-TX-LINE-DEL-05.                                                 CL**2
00919      IF LINE-DEL-FOUND EQUAL TO "N"                                  CL**2
00920          MOVE CERR-640S TO DISP-MSG-ERR2                             CL**2
00921          GO TO CTL-TX-ERR.                                           CL**2
00922      GO TO CTL-TX-READ.                                              CL**2
00923  CTL-TX-LINE-DEL-10.                                                 CL**2
00924      MOVE "Y" TO CATG-DEL-FOUND.                                     CL**2
00925      IF CAT-LINE LESS THAN LINE-NO                                   CL**2
00926          PERFORM WRITE-DATA-LINE THRU WRITE-DATA-LINE-XIT            CL**2
00927          GO TO CTL-TX-LINE-DEL-40.                                   CL**2
00928      IF CAT-LINE EQUAL TO LINE-NO                                    CL**2
00929          GO TO CTL-TX-LINE-DEL-20.                                   CL**2
00930      IF LINE-DEL-FOUND EQUAL TO "N"                                  CL**2
00931          MOVE CERR-640S TO DISP-MSG-ERR2                             CL**2
00932          GO TO CTL-TX-ERR.                                           CL**2
           IF CAT-LINE GREATER THAN NUM-HOLD
00934          GO TO CTL-TX-READ.                                          CL**2
00935  CTL-TX-LINE-DEL-20.                                                 CL**2
00936      MOVE "Y" TO LINE-DEL-FOUND.                                     CL**2
00937      IF DESC-FLAG EQUAL TO "*"                                       CL**2
00938          GO TO CTL-TX-LINE-DEL-40.                                   CL**2
00939      IF STC-CNAME EQUAL TO SPACES OR "FILLER"                        CL**2
00940          GO TO CTL-TX-LINE-DEL-40.                                   CL**2
           MOVE SPACE TO TYPE-PUSE. 
           MOVE SPACES TO NEW-CATAL-NAME. 
00941      IF CAT-CATEGORY EQUAL TO 10 OR 800                              CL**2
00942          GO TO CTL-TX-LINE-DEL-30.                                   CL**2
      * 
      *    GROUPS AND RECORDS ENTITIES
      *    STRUCTURE CATEGORY 
      * 
           IF ENT-ID EQUAL TO 10 OR 13
             AND CAT-CATEGORY EQUAL TO 300
      * 
      *    OCCURS LINE
      * 
               IF STC-LINE-TYPE EQUAL TO "O"
                   PERFORM DEL-OCCURS-POINTERS THRU 
                       DEL-OCCURS-POINTERS-EXIT 
                   GO TO CTL-TX-LINE-DEL-40 
               END-IF 
      * 
      *    DEPEND QUALIFIERS LINE 
      * 
               IF STC-LINE-TYPE EQUAL TO "D"
                   PERFORM DEL-DEPEND-QUAL THRU 
                       DEL-DEPEND-QUAL-EXIT 
                   GO TO CTL-TX-LINE-DEL-40 
               END-IF 
      * 
      *    OCCURS KEY LINE
      * 
               IF STC-LINE-TYPE EQUAL TO "K"
                   MOVE "C" TO TYPE-PUSE
                   GO TO CTL-TX-LINE-DEL-30 
               END-IF 
      * 
      *    RENAME AND THRU LINES
      * 
               IF STC-LINE-TYPE EQUAL TO "R" OR "T" 
                   PERFORM DEL-RE-POINTERS THRU DEL-RE-POINTERS-EXIT
                   GO TO CTL-TX-LINE-DEL-40 
               END-IF 
      * 
      *    RENAME AND THRU QUALIFIERS 
      * 
               IF STC-LINE-TYPE EQUAL "Q" OR  "2" 
                   PERFORM DEL-QUAL-POINTERS THRU DEL-QUAL-POINTERS-EXIT
                   GO TO CTL-TX-LINE-DEL-40 
               END-IF 
      * 
      *    STANDARD STRUCTURE LINE
      * 
               IF STC-LINE-TYPE EQUAL TO "A"
                   GO TO CTL-TX-LINE-DEL-30 
               END-IF 
           END-IF 
      * 
      *    AREA ENTITY
      *    AAREAKEY CATEGORY
      * 
           IF ENT-ID EQUAL 22 
               IF CAT-CATEGORY EQUAL TO 500 
      * 
      *    REGULAR KEY OR CONCATENATED KEY COMPONENT
      * 
                   IF CAT-LINE-TYPE EQUAL TO "K" OR "I" 
                       PERFORM DELETE-POINTERS THRU 
                           DELETE-POINTERS-EXIT 
                   END-IF 
                   GO TO CTL-TX-LINE-DEL-40 
               END-IF 
           END-IF 
      * 
      *    AREA AND SCHEMA ENTITY 
      *    MDINFO CATEGORY
      * 
           IF CAT-CATEGORY EQUAL TO 450 
               IF ENT-ID EQUAL TO 22 OR 26
                 AND CAT-LINE-TYPE NOT EQUAL "L"
                   GO TO CTL-TX-LINE-DEL-30 
               ELSE 
                   GO TO CTL-TX-LINE-DEL-40 
               END-IF 
           END-IF 
      * 
      *    ACCESS CATEGORY
      * 
           IF CAT-CATEGORY EQUAL TO 425 
               IF CAT-LINE-TYPE EQUAL "L" 
                 AND ACC-TYPE EQUAL "P" 
                   GO TO CTL-TX-LINE-DEL-30 
               ELSE 
                   GO TO CTL-TX-LINE-DEL-40 
               END-IF 
           END-IF 
      * 
      *    PROCESS CATEGORY 
      * 
           IF CAT-CATEGORY EQUAL TO 400 
               IF CAT-LINE-TYPE EQUAL TO "R"
                   PERFORM DELETE-POINTERS THRU DELETE-POINTERS-EXIT
                   GO TO CTL-TX-LINE-DEL-40 
               ELSE 
                   GO TO CTL-TX-LINE-DEL-30 
               END-IF 
           END-IF 
      * 
      *    SUBSCHEMA ENTITY 
      *    SSREL CATEGORY 
      * 
           IF ENT-ID EQUAL TO 24
               IF CAT-CATEGORY EQUAL TO 525 
      * 
      *    RESTRICT NAME LINE 
      * 
                   IF CAT-LINE-TYPE EQUAL TO "R"
                       PERFORM RESTRICT-DEL THRU RESTRICT-DEL-EXIT
                   ELSE 
      * 
      *    IDENTIFIER LINE
      * 
                       IF CAT-LINE-TYPE EQUAL TO "I"
                           PERFORM DEL-ID-PTRS THRU DEL-ID-PTRS-EXIT
                       ELSE 
      * 
      *    ALL RESTRICT QUALIFIER LINES 
      * 
                           PERFORM DEL-QUAL-PTRS THRU DEL-QUAL-PTRS-EXIT
                       END-IF 
                   END-IF 
                   GO TO CTL-TX-LINE-DEL-40 
               END-IF 
           END-IF 
      * 
      *    SCHEMA ENTITY
      *    BOND CATEGORY
      * 
           IF ENT-ID EQUAL TO 26
               IF CAT-CATEGORY EQUAL TO 550 
      * 
      *    CONSTRAINT NAME LINE 
      * 
                   IF CAT-LINE-TYPE EQUAL TO "N"
                       PERFORM DEL-CONSTRAINT-PTR THRU
                           DEL-CONSTRAINT-PTR-EXIT
                       GO TO CTL-TX-LINE-DEL-40 
                   END-IF 
      * 
      *    DEPEND NAME
      * 
                   IF CAT-LINE-TYPE EQUAL TO "O"
                       PERFORM DELETE-POINTERS THRU 
                           DELETE-POINTERS-EXIT 
                       GO TO CTL-TX-LINE-DEL-40 
                   END-IF 
               END-IF 
      * 
      *    JOIN CATEGORY
      * 
               IF CAT-CATEGORY EQUAL TO 575 
                   IF CAT-LINE-TYPE EQUAL TO "B" OR "C" 
                       PERFORM DEL-JOIN-PTRS THRU DEL-JOIN-PTRS-EXIT
                   END-IF 
                   GO TO CTL-TX-LINE-DEL-40 
               END-IF 
           END-IF 
           IF CAT-CATEGORY NOT EQUAL TO 300 
               GO TO CTL-TX-LINE-DEL-40 
           END-IF 
00963  CTL-TX-LINE-DEL-30.                                                 CL**2
00964      MOVE "X" TO TYPE-CATAL-NAME.                                    CL**2
00965      MOVE SPACES TO NEW-CATAL-NAME.                                  CL**2
00966      MOVE CAT-CNAME TO OLD-CATAL-NAME.                               CL**2
00967      PERFORM UPD-REL-REC THRU UPD-REL-REC-XIT.                       CL**2
00968  CTL-TX-LINE-DEL-40.                                                 CL**2
00969      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00970      IF DATA-RETURN-CODE EQUAL TO 0 OR 2                             CL**2
00971          GO TO CTL-TX-LINE-DEL.                                      CL**2
00972      IF DATA-RETURN-CODE EQUAL TO 1                                  CL**2
00973          GO TO CTL-TX-LINE-DEL-00.                                   CL**2
00974      MOVE CERR-640S TO DISP-MSG-ERR2.                                CL**2
00975      GO TO CTL-TX-ERR.                                               CL**2
00976 ************************************************************         CL**2
00977 *                                                                    CL**2
00978 *     PROCESS CHG OR ADD A LINE                                      CL**2
00979 *                                                                    CL**2
00980 ************************************************************         CL**2
00981 * IF ADDING AN ENTRY GO TO EDIT MODULE.                              CL**2
00982  CTL-TX-LINE-NODEL.                                                  CL**2
00983      IF ADD-CHG EQUAL TO "A"                                         CL**2
00984          MOVE SPACES TO CAT-DETAIL                                   CL**2
00985          GO TO CTL-CALL-EDIT.                                        CL**2
00986 ************************************************************         CL**2
00987 *                                                                    CL**2
00988 *     INSERT OR CHAMGE A LINE - FILE POSITION                        CL**2
00989 *                                                                    CL**2
00990 ************************************************************         CL**2
00991 * IF NOT A LINE DELETE OR ENTRY ADD IT MUST BE A                     CL**2
00992 *    CHANGE OR INSERT.                                               CL**2
00993 * THE FOLLOWING ROUTINE WILL POSITION FILE THEN                      CL**2
00994 *    CALL EDIT MODULE.                                               CL**2
00995 * POINTERS WILL BE ADDED TO REL FILE IF IT IS                        CL**2
      *    CONTROL, STRUCTURE, PROCESS, OR RELATIONAL CATEGORY
      *    AND ALL CATEGORIES HAVING CLAUSES USING CAT-NAMES
00997 *    WHEN EDIT IS CONPLETE.                                          CL**2
00998  CTL-TX-DATA.                                                        CL**2
00999      IF DATA-RETURN-CODE EQUAL TO 1                                  CL**2
01000          MOVE "Y" TO INS-LINE-SW                                     CL**2
01001          MOVE SPACES TO CAT-DETAIL                                   CL**2
01002          GO TO CTL-CALL-EDIT.                                        CL**2
01003      IF INS-LINE-SW EQUAL TO "Y"                                     CL**2
01004          MOVE HOLD-DATA-LINE TO CAT-WORK-AREAS                       CL**2
01005          MOVE "N" TO INS-LINE-SW.                                    CL**2
01006      IF CAT-CATEGORY EQUAL TO CAT-ID                                 CL**2
01007          GO TO CTL-TX-DATA-10.                                       CL**2
01008      IF CAT-CATEGORY GREATER THAN CAT-ID                             CL**2
01009          MOVE CAT-WORK-AREAS TO HOLD-DATA-LINE                       CL**2
01010          MOVE "Y" TO INS-LINE-SW                                     CL**2
01011          MOVE SPACES TO CAT-DETAIL                                   CL**2
01012          GO TO CTL-CALL-EDIT.                                        CL**2
01013      PERFORM WRITE-DATA-LINE THRU WRITE-DATA-LINE-XIT.               CL**2
01014      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
01015      GO TO CTL-TX-DATA.                                              CL**2
01016  CTL-TX-DATA-10.                                                     CL**2
01017      IF CAT-LINE EQUAL TO LINE-NO                                    CL**2
01018          GO TO CTL-CALL-EDIT.                                        CL**2
01019      IF CAT-LINE GREATER THAN LINE-NO                                CL**2
01020          MOVE CAT-WORK-AREAS TO HOLD-DATA-LINE                       CL**2
01021          MOVE "Y" TO INS-LINE-SW                                     CL**2
01022          MOVE SPACES TO CAT-DETAIL                                   CL**2
01023          GO TO CTL-CALL-EDIT.                                        CL**2
01024      PERFORM WRITE-DATA-LINE THRU WRITE-DATA-LINE-XIT.               CL**2
01025      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
01026      GO TO CTL-TX-DATA.                                              CL**2
01029 *************************************************************        CL**2
01030 *                                                                 DCUPDCTL
01031 *     C A L L   E N T R Y   E D I T I N G                         DCUPDCTL
01032 *                                                                 DCUPDCTL
01033 *************************************************************        CL**2
01035  CTL-CALL-EDIT.                                                   DCUPDCTL
           IF CAT-COMMENT = "*" AND ADD-CHG = "C" 
               MOVE CAT-WORK-AREAS TO HOLD-COMMENT
               MOVE SPACES TO CAT-WORK-AREAS
           ELSE 
               MOVE SPACES TO HOLD-COMMENT. 
01036      MOVE SPACE TO FUNC.                                             CL**2
01037      MOVE 1 TO MSG REV.                                              CL**2
01038      MOVE LINE-NO TO CAT-LINE.                                       CL**2
01039      MOVE CAT-ID TO CAT-CATEGORY.                                    CL**2
01040      MOVE HOLD-REV TO CAT-REV.                                       CL**2
01041      MOVE SPACES TO OLD-CATAL-NAME NEW-CATAL-NAME.                   CL**2
01042      MOVE SPACE TO TYPE-CATAL-NAME.                                  CL**2
01043 *                                                                    CL**2
01044 *     WRITE COMMENT LINES ON FILE                                    CL**2
01045 *                                                                    CL**2
01046      MOVE HOLD-CAT-LENGTH TO CAT-LENGTH.                             CL**2
01047      IF CAT-ID EQUAL TO 30 GO TO CTL-CALL-EDIT-10.                   CL**2
01048      IF TX-POS (TX) NOT EQUAL TO "*"                                 CL**2
01049          GO TO CTL-CALL-EDIT-10.                                     CL**2
01050      MOVE 1 TO VA.                                                   CL**2
01051  CTL-CALL-EDIT-LOOP.                                                 CL**2
01052      MOVE TX-POS (TX) TO DETAIL-LINE (VA).                           CL**2
01053      ADD 1 TO TX VA.                                                 CL**2
01054      IF VA LESS THAN 68 GO TO CTL-CALL-EDIT-LOOP.                    CL**2
01055      MOVE 67 TO CAT-LENGTH.                                          CL**2
01056      GO TO CTL-END-WRITE.                                            CL**2
01057  CTL-CALL-EDIT-10.                                                   CL**2
01058      IF ENT-ID EQUAL TO 05                                        DCUPDCTL
           CALL "UPD05" GO TO CTL-CALL-END. 
01061      IF ENT-ID EQUAL TO 10                                        DCUPDCTL
           CALL "UPD10" GO TO CTL-CALL-END. 
01067      IF ENT-ID EQUAL TO 20                                        DCUPDCTL
           CALL "UPD20" GO TO CTL-CALL-END. 
01070      IF ENT-ID EQUAL TO 35                                        DCUPDCTL
           CALL "UPD35" GO TO CTL-CALL-END. 
01073      IF ENT-ID EQUAL TO 40                                        DCUPDCTL
           CALL "UPD40" GO TO CTL-CALL-END. 
01076      IF ENT-ID EQUAL TO 45                                        DCUPDCTL
           CALL "UPD45" GO TO CTL-CALL-END. 
01079      IF ENT-ID EQUAL TO 50                                        DCUPDCTL
           CALL "UPD50" GO TO CTL-CALL-END. 
01082      IF ENT-ID EQUAL TO 55                                        DCUPDCTL
           CALL "UPD55" GO TO CTL-CALL-END. 
01085      IF ENT-ID EQUAL TO 60                                        DCUPDCTL
           CALL "UPD60" GO TO CTL-CALL-END. 
01088      IF ENT-ID EQUAL TO 65                                        DCUPDCTL
           CALL "UPD65" GO TO CTL-CALL-END. 
01091 *                                                                    CL**2
      *            CDCS ENTRY CALLS 
      *            ENT-ID 03 = DBPROC 
      *            ENT-ID 22 = AREA 
      *            ENT-ID 24 = SUBSCHEMA
      *            ENT-ID 26 = SCHEMA 
      * 
           IF ENT-ID EQUAL 03 
               CALL "UPD03" 
               GO TO CTL-CALL-END.
           IF ENT-ID EQUAL 22 
               CALL "UPD22" 
               GO TO CTL-CALL-END.
           IF ENT-ID EQUAL 24 
               CALL "UPD24" 
               GO TO CTL-CALL-END.
           IF ENT-ID EQUAL 26 
               CALL "UPD26" 
               GO TO CTL-CALL-END.
01093 *                                                                    CL**2
01106 *                                                                    CL**2
01107 *        TOTAL ENTRY CALLS                                           CL**2
01108 *                                                                    CL**2
01109      IF ENT-ID EQUAL 13                                              CL**2
           CALL "UPD13" GO TO CTL-CALL-END. 
01112      IF ENT-ID EQUAL 19                                              CL**2
           CALL "UPD19" GO TO CTL-CALL-END. 
01115      IF ENT-ID EQUAL 32                                              CL**2
           CALL "UPD32" GO TO CTL-CALL-END. 
01118 *                                                                    CL**2
01120 *                                                                    CL**2
01132 *************************************************************        CL**2
01133 *                                                                 DCUPDCTL
01134 *     R E T U R N   F R O M   E N T R Y   E D I T                 DCUPDCTL
01135 *                                                                 DCUPDCTL
01136 *************************************************************        CL**2
01138 * UPON RETURN FROM EDIT MODULE THR                                   CL**2
01139 *   MESSAGES ARE PRINTED                                             CL**2
01140 *   REQUESTS TO CHECK CAT NAME ARE PROCESSED                         CL**2
01141 *   REQUESTS TO READ TX FOR CONTINUE AREA PROCESSED                  CL**2
01142 *   LINES AREA WRITTEN TO DATA FILE IF ENTRY ADD                     CL**2
01143 *     OR LINE INSERT.                                                CL**2
      *    REQUESTS FOR GETTING A NEW BLOCK FOR MULTI-BLOCK LINES 
      *        ARE PROCESSED  (FUNC = B)
      *    POINTERS FOR CLAUSES ARE PROCESSED FROM TABLE BUILT IN 
      *        EDITING SEGMENTS (FUNC = T)
01144 *                                                                 DCUPDCTL
01145  CTL-CALL-END.                                                    DCUPDCTL
01146 ******************************************************               CL**2
01147 *                                                                    CL**2
01148 *     DUMP MESSAGE TABLE                                             CL**2
01149 *                                                                    CL**2
01150 *****************************************************                CL**2
01151      IF MSG-POS3 (1) NOT EQUAL TO SPACES                             CL**2
01152          PERFORM DUMP-MSG-TABLE THRU DUMP-MSG-TABLE-XIT.             CL**2
01153 ****************************************************              DCUPDCTL
01154 *                                                                 DCUPDCTL
01155 *     REQUEST WRITE OF LINE ON DATA FILE                          DCUPDCTL
01156 *                                                                 DCUPDCTL
01157 *     TEST FOR AND WRITE REVISION RECORDS                            CL**2
01158 *                                                                    CL**2
01159 ****************************************************              DCUPDCTL
01160      IF FUNC NOT EQUAL TO "W"                                        CL**2
               GO TO CTL-NEW-READ.
01162  CTL-END-WRITE.                                                   DCUPDCTL
      * 
      *    VALUES ARE SET FOR ADD OR DELETE OF POINTERS IN THE
      *    EDIT MODULES.  IF VALUES ARE BEING CHANGED, ENTRIES
      *    ARE MADE IN THE REL-TABLE. 
      * 
           IF CAT-ID EQUAL TO 010 OR
             (CAT-ID GREATER THAN 299 AND LESS THAN 899)
01164          PERFORM UPD-REL-REC THRU UPD-REL-REC-XIT.                   CL**2
      * 
      *    SEE IF ENTRIES IN REL-TABLE
      *    IF SO, MUST ADD THESE TO REL-FILE
      * 
           IF NUM-ENTRIES GREATER THAN ZERO 
               PERFORM PROCESS-REL-TABLE THRU PROCESS-EXIT. 
           IF CAT-DETAIL EQUAL SPACES AND NUM-LINES EQUAL ZERO
01166          MOVE CERR-215W TO DISP-MSG-ERR2                             CL**2
01167          GO TO CTL-TX-ERR.                                           CL**2
01168      IF CAT-LINE-TYPE NOT EQUAL TO SPACE                             CL**2
01169          AND CAT-FIRST-146 EQUAL TO SPACE                            CL**2
01170          MOVE CERR-215W TO DISP-MSG-ERR2                             CL**2
01171          GO TO CTL-TX-ERR.                                           CL**2
01172 *                                                                    CL**2
01173 *    TEST TO SEE IF ALL FIELD ON VARYING STRUCTURE                   CL**2
01174 *         LINES WERE DELETED                                         CL**2
01175 *                                                                    CL**2
           IF ADD-CHG EQUAL TO "A"
             OR INS-LINE-SW EQUAL TO "Y"
               IF CAT-DETAIL NOT EQUAL SPACES 
                   PERFORM WRITE-DATA-LINE THRU WRITE-DATA-LINE-XIT 
               END-IF 
               IF  NUM-LINES NOT EQUAL TO 0 
                   PERFORM WRITE-MULTI-LINES THRU 
                     WRITE-MULTI-LINES-EXIT 
               END-IF 
           END-IF 
01178      GO TO CTL-TX-READ.                                              CL**2
      ****************************************************************
      *    CTL-NEW-READ IS REQUIRED TO FIND THE PROPER LINETYPE WITHIN
      *    A MULTI-BLOCK LINE NUMBER.  IT CALLS READ-NEXT-DATA AND
      *    THEN RETURNS TO THE SEGMENT VIA CTL-CALL-EDIT. 
      *     FUNC IS SET TO "B" WHEN THIS SEVICE IS REQUIRED.
      ***************************************************************** 
       CTL-NEW-READ.
           IF FUNC NOT EQUAL TO "B" 
               GO TO CTL-END-CKCAT. 
           PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.
           GO TO CTL-CALL-EDIT-10.
01179 ****************************************************              DCUPDCTL
01180 *                                                                 DCUPDCTL
01181 *     REQUEST VERIFY CATALOGUE NAME                               DCUPDCTL
01182 *                                                                 DCUPDCTL
01183 ****************************************************              DCUPDCTL
01184  CTL-END-CKCAT.                                                      CL**2
01185      IF FUNC NOT EQUAL TO "C"                                        CL**2
               GO TO CTL-END-TABLE. 
01187  CTL-END-CKCAT-10.                                                   CL**2
01188      MOVE CK-CATAL-NAME TO REL-ENTRY-NAME.                           CL**2
01189      MOVE SPACE TO REL-ENTRY-FUNCTION.                               CL**2
01190      PERFORM REL-READ THRU REL-READ-XIT.                             CL**2
01191      IF REL-RETURN-CODE EQUAL TO 2                                   CL**2
01192          MOVE HIGH-VALUE TO STATUS-SW                                CL**2
01193          GO TO CTL-CALL-EDIT-10.                                     CL**2
01194      IF CAT-ID EQUAL TO 010   AND                                    CL**2
01195          REL-ENTRY-TYPE EQUAL TO ENT-ID                              CL**2
01196              GO TO CTL-END-CKCAT-20.                                 CL**2
01200 *    TOTAL DATASET TEST                                              CL**2
01201      IF ENT-ID EQUAL 19                                              CL**2
01202      AND CAT-ID EQUAL 210                                            CL**2
01203          GO TO IMS-MODULE-USE.                                       CL**2
01204 *    CHECK IMBEDDED ENTRY TYPES                                      CL**2
01205      IF ENT-ID NOT EQUAL TO REL-ENTRY-TYPE                           CL**2
01206          GO TO CTL-END-CKCAT-15.                                     CL**2
01207      IF ENT-ID EQUAL TO 10 OR 40 OR 45 OR 50 OR 55 OR 60 OR 65       CL**2
01209          GO TO CTL-END-CKCAT-20.                                     CL**2
01210  CTL-END-CKCAT-15.                                                   CL**2
01211      IF ENT-ID NOT GREATER THAN REL-ENTRY-TYPE                       CL**2
01212          MOVE "G" TO STATUS-SW                                       CL**2
01213          GO TO CTL-CALL-EDIT-10.                                     CL**2
01214  CTL-END-CKCAT-20.                                                   CL**2
01215      MOVE SPACE TO STATUS-SW.                                        CL**2
01216      GO TO CTL-CALL-EDIT-10.                                         CL**2
01265 *    CHECK FOR CATALOGUE NAME REFERENCING A MODULE                   CL**2
01266  IMS-MODULE-USE.                                                     CL**2
01267      IF REL-ENTRY-TYPE NOT EQUAL TO 50                               CL**2
01268          GO TO CTL-ENT-HIER-ERR.                                     CL**2
01269      GO TO CTL-END-CKCAT-20.                                         CL**2
01288  CTL-ENT-HIER-ERR.                                                   CL**2
01289      MOVE "G" TO STATUS-SW.                                          CL**2
01290      GO TO CTL-CALL-EDIT-10.                                         CL**2
      * 
      *    FUNC = T MEANS REL-TABLE IS FULL 
      *    SO MUST EMPTY IT 
      * 
       CTL-END-TABLE. 
           IF FUNC NOT EQUAL TO "T" 
               GO TO CTL-END-READ.
           PERFORM PROCESS-REL-TABLE THRU PROCESS-EXIT. 
           GO TO CTL-CALL-EDIT-10.
       CLEAN-UP-REL.
           IF CAT-ID EQUAL TO 10 OR 300 OR 800 OR 255 
               PERFORM UPD-REL-REC THRU UPD-REL-REC-XIT.
01291 ****************************************************              DCUPDCTL
01292 *                                                                 DCUPDCTL
01293 *     READ A CONTINUED LINE                                       DCUPDCTL
01294 *                                                                 DCUPDCTL
01295 ****************************************************              DCUPDCTL
01296  CTL-END-READ.                                                    DCUPDCTL
01297      PERFORM READ-TRANS THRU READ-TRANS-XIT.                      DCUPDCTL
           IF TX-POS (1) EQUAL TO "-" 
01299          MOVE CERR-620S TO DISP-MSG-ERR2                             CL**2
01300          GO TO CTL-TX-ERR.                                           CL**2
01301      IF ON-LINE-SW EQUAL TO "N"                                      CL**2
01302          MOVE TX-IMAGE TO DISP-MSG-TX                                CL**2
01303          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                 CL**2
01304      IF TX-POS (1) EQUAL TO "*"                                      CL**2
01305          GO TO CTL-END-READ.                                         CL**2
           ADD 1 TO TOT-TX-READ.
01306      IF TX-4 EQUAL TO "ADD " OR "CHG " OR "DEL "                     CL**2
01307          MOVE CERR-645S TO DISP-MSG-ERR2                             CL**2
01308          MOVE "C" TO STATUS-SW                                       CL**2
01309          GO TO CTL-TX-ERR.                                           CL**2
01310      MOVE 1 TO TX.                                                   CL**2
01311      IF TX-POS (1) NOT EQUAL TO SPACE                                CL**2
               PERFORM CLEAN-UP-REL 
01312          MOVE CERR-645S TO DISP-MSG-ERR2                             CL**2
01313          GO TO CTL-TX-ERR.                                           CL**2
01314      PERFORM FIND-NON-BLANK THRU FIND-NON-BLANK-XIT.                 CL**2
01315      IF STATUS-SW EQUAL TO "E"                                       CL**2
01316          MOVE CERR-645S TO DISP-MSG-ERR2                             CL**2
01317          GO TO CTL-TX-ERR.                                           CL**2
01318      MOVE SPACE TO FUNC.                                             CL**2
01319      GO TO CTL-CALL-EDIT-10.                                         CL**2
01322 **************************************************************       CL**2
01323 *                                                                    CL**2
01324 *     E N D   O F   J O B                                            CL**2
01325 *                                                                    CL**2
01326 **************************************************************       CL**2
01328  CTL-END-TX.                                                         CL**2
01329      IF ENTRY-FOUND EQUAL TO "N"                                     CL**2
01330          GO TO CTL-END-TX-20.                                        CL**2
01331      PERFORM CTL-TX-ENT-CLOSE THRU CTL-TX-ENT-CLOSE-XIT.             CL**2
01332  CTL-END-TX-20.                                                      CL**2
01333      CLOSE MAST1.                                                    CL**2
01334      CLOSE MAST2.                                                    CL**2
01335      MOVE "E" TO FUNC.                                               CL**2
01336      IF ON-LINE-SW EQUAL TO "N"                                      CL**2
01337          MOVE 99 TO LINE-CT                                          CL**2
01338          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                 CL**2
01339  CTL-END-TX-25.                                                      CL**2
           CALL "UPD00".
01341      IF ON-LINE-SW EQUAL TO "N"                                      CL**2
01342          PERFORM DUMP-MSG-TABLE THRU DUMP-MSG-TABLE-XIT.             CL**2
01343      MOVE 1 TO MSG.                                                  CL**2
01344      IF FUNC EQUAL TO "D"                                            CL**2
01345          GO TO CTL-END-TX-25.                                        CL**2
01346      GO TO CTL-OPT-EOJ-20.                                           CL**2
*CALL     DISPLAYLN 
*CALL     WRITELN 
01349 *****************************************************                CL**2
01350 *                                                                    CL**2
01351 *     FIND NON BLANK SEARCH                                          CL**2
01352 *                                                                    CL**2
01353 ****************************************************                 CL**2
01354  FIND-NON-BLANK.                                                     CL**2
01355      MOVE SPACE TO STATUS-SW.                                        CL**2
01356  FIND-NON-BLANK-10.                                                  CL**2
01357      ADD 1 TO TX.                                                    CL**2
01358      IF TX-POS (TX) NOT EQUAL TO SPACE                               CL**2
01359          GO TO FIND-NON-BLANK-XIT.                                   CL**2
01360      IF TX LESS THAN 72                                              CL**2
01361          GO TO FIND-NON-BLANK-10.                                    CL**2
01362      MOVE "E" TO STATUS-SW.                                          CL**2
01363  FIND-NON-BLANK-XIT. EXIT.                                           CL**2
01364 *******************************************************              CL**2
01365 *                                                                    CL**2
01366 *     FIND A CHARACTER WHILE MOVING TO VAL-AREA                      CL**2
01367 *                                                                    CL**2
01368 ********************************************************             CL**2
01369  FIND-CHAR.                                                          CL**2
01370      MOVE SPACES TO VAL-AREA.                                        CL**2
01371      MOVE 1 TO VA.                                                   CL**2
01372  FIND-CHAR-10.                                                       CL**2
01373      MOVE TX-POS (TX) TO VAL (VA).                                   CL**2
01374      ADD 1 TO TX VA.                                                 CL**2
01375      IF STATUS-SW EQUAL TO HIGH-VALUE    AND                         CL**2
01376          VA EQUAL TO 10                                              CL**2
01377              GO TO FIND-CHAR-XIT.                                    CL**2
01378      IF VA GREATER THAN 39 GO TO FIND-CHAR-XIT.                      CL**2
01379      IF TX GREATER THAN 72                                           CL**2
01380          GO TO FIND-CHAR-XIT.                                        CL**2
01381      IF TX-POS (TX) NOT EQUAL TO STATUS-SW                           CL**2
01382          GO TO FIND-CHAR-10.                                         CL**2
01383  FIND-CHAR-XIT. EXIT.                                                CL**2
      * 
      **************************************************************
      * 
      *    THE FOLLOWING PROCEDURES HANDLE THE LINES (BLOCKS) WHICH 
      *    DO NOT FIT IN THE STANDARD FORMAT OF HAVING ALL CATNAMES 
      *    WHICH CAUSE POINTERS TO BE CREATED IN THE SECOND FIELD OF
      *    THE BLOCK AFTER THE LINE-TYPE.  ALL THIS PROCESSING IS FOR 
      *    CDCS TYPES EXCEPT THE STRUCTURE CATEGORY  OF GROUPS AND
      *    RECORDS AND THESE CATEGORIES WERE EXPANDED AT THE TIME OF
      *    INCLUDING CDCS IN DATA CATALOGUE.
      * 
      *************************************************************** 
      * 
       DEL-OCCURS-POINTERS. 
           IF STC-TO IS NOT NUMERIC 
             AND STC-TO NOT EQUAL SPACES
               MOVE STC-TO TO OLD-CATAL-NAME
               PERFORM CHECK-NAME THRU CHECK-NAME-EXIT
           END-IF 
           IF STC-DEPEND IS NOT EQUAL TO SPACES 
               MOVE STC-DEPEND TO OLD-CATAL-NAME
               PERFORM CHECK-NAME THRU CHECK-NAME-EXIT
           END-IF 
           IF STC-DEP-QUAL-FLAG EQUAL 0 
               GO TO DEL-OCCURS-POINTERS-EXIT.
           IF STC-DEPEND-QUAL1 NOT EQUAL TO SPACES
               MOVE STC-DEPEND-QUAL1 TO OLD-CATAL-NAME
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
           IF STC-DEPEND-QUAL2 NOT EQUAL TO SPACES
               MOVE STC-DEPEND-QUAL2 TO OLD-CATAL-NAME
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
       DEL-OCCURS-POINTERS-EXIT.
           EXIT.
       DEL-DEPEND-QUAL. 
           IF STC-DEPEND-QUAL3 NOT EQUAL SPACES 
               MOVE STC-DEPEND-QUAL3 TO OLD-CATAL-NAME
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
           IF STC-DEPEND-QUAL4 NOT EQUAL SPACES 
               MOVE STC-DEPEND-QUAL4 TO OLD-CATAL-NAME
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
           IF STC-DEPEND-QUAL5 NOT EQUAL SPACES 
               MOVE STC-DEPEND-QUAL5 TO OLD-CATAL-NAME
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
       DEL-DEPEND-QUAL-EXIT.
           EXIT.
       DEL-RE-POINTERS. 
           IF STC-NAME NOT EQUAL TO SPACES
               MOVE STC-NAME TO OLD-CATAL-NAME
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
           IF STC-QUAL-COUNT EQUAL TO 0 
               GO TO DEL-RE-POINTERS-EXIT 
           END-IF 
           IF STC-QUAL1 NOT EQUAL TO SPACES 
               MOVE STC-QUAL1 TO OLD-CATAL-NAME 
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
           IF STC-QUAL2 NOT EQUAL TO SPACES 
               MOVE STC-QUAL2 TO OLD-CATAL-NAME 
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
           IF STC-QUAL3 NOT EQUAL TO SPACES 
               MOVE STC-QUAL3 TO OLD-CATAL-NAME 
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
       DEL-RE-POINTERS-EXIT.
           EXIT.
       DEL-QUAL-POINTERS. 
           IF STC-QUAL4 NOT EQUAL TO SPACES 
               MOVE STC-QUAL4 TO OLD-CATAL-NAME 
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
           IF STC-QUAL5 NOT EQUAL TO SPACES 
               MOVE STC-QUAL5 TO OLD-CATAL-NAME 
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
       DEL-QUAL-POINTERS-EXIT.
           EXIT.
       DELETE-POINTERS. 
           IF GEN-NAME NOT EQUAL TO SPACES
               MOVE GEN-NAME TO OLD-CATAL-NAME
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
           IF GEN-QUAL NOT EQUAL TO SPACES
               MOVE GEN-QUAL TO OLD-CATAL-NAME
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
       DELETE-POINTERS-EXIT.
           EXIT.
       RESTRICT-DEL.
           IF RESTRICT-NAME NOT EQUAL TO SPACES 
               MOVE RESTRICT-NAME TO OLD-CATAL-NAME 
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
       RESTRICT-DEL-EXIT. 
           EXIT.
       DEL-ID-PTRS. 
           IF ID1 NOT EQUAL TO SPACES 
               MOVE ID1 TO OLD-CATAL-NAME 
               PERFORM CHECK-NAME THRU CHECK-NAME-EXIT
           END-IF 
           IF ID2 NOT EQUAL TO SPACES 
             AND ID2-TYPE EQUAL "C" 
               MOVE ID2 TO OLD-CATAL-NAME 
               PERFORM CHECK-NAME THRU CHECK-NAME-EXIT
           END-IF 
       DEL-ID-PTRS-EXIT.
           EXIT.
       DEL-QUAL-PTRS. 
           IF SS-QUAL1 NOT EQUAL TO SPACES
               MOVE SS-QUAL1 TO OLD-CATAL-NAME
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
           IF SS-QUAL2 NOT EQUAL TO SPACES
               MOVE SS-QUAL2 TO OLD-CATAL-NAME
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
           IF SS-QUAL3 NOT EQUAL TO SPACES
               MOVE SS-QUAL3 TO OLD-CATAL-NAME
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
       DEL-QUAL-PTRS-EXIT.
           EXIT.
       DEL-CONSTRAINT-PTR.
           IF CON-NAME NOT EQUAL TO SPACES
               MOVE CON-NAME TO OLD-CATAL-NAME
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
           IF CON-CATNAME NOT EQUAL TO SPACES 
               MOVE CON-CATNAME TO OLD-CATAL-NAME 
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
           IF CON-QUAL NOT EQUAL TO SPACES
               MOVE CON-QUAL TO OLD-CATAL-NAME
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
       DEL-CONSTRAINT-PTR-EXIT. 
           EXIT.
       DEL-JOIN-PTRS. 
           IF JOIN-ID NOT EQUAL TO SPACES 
               MOVE JOIN-ID TO OLD-CATAL-NAME 
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
           IF JOIN-QUAL1 NOT EQUAL TO SPACES
               MOVE JOIN-QUAL1 TO OLD-CATAL-NAME
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
       DEL-JOIN-PTRS-EXIT.
           EXIT.
      * 
      *    PROCEDURE CHECK-NAME ATTEMPTS A READ OF MAST2
      *    TO DETERMINE IF THE NAME IS A CATALOGUE NAME.
      *    THE FOLLOWING FIELDS MAY BE EITHER A DATA NAME 
      *    OR A CATALOGUE NAME -
      *        OCCURS TO
      *        OCCURS DEPENDING ON
      *        SSREL ID1 AND ID2
      *    IF THE NAME IS A CATALOGUE NAME, PROC FIX-POINTERS 
      *    IS CALLED TO REQUEST THE DELETION OF THE NAME
      *    IT IS ASSUMED THAT THE FIELD NAME HAS BEEN 
      *    STORED IN OLD-CATAL-NAME.
      * 
       CHECK-NAME.
           MOVE OLD-CATAL-NAME TO REL-ENTRY-NAME. 
           MOVE SPACE TO REL-ENTRY-FUNCTION.
           PERFORM REL-READ THRU REL-READ-XIT.
           IF REL-RETURN-CODE IS NOT GREATER THAN 1 
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
       CHECK-NAME-EXIT. 
           EXIT.
       FIX-POINTERS.
           MOVE SPACES TO NEW-CATAL-NAME. 
           MOVE "X" TO TYPE-CATAL-NAME. 
           MOVE "C" TO TYPE-PUSE. 
           PERFORM UPD-REL-REC THRU UPD-REL-REC-XIT.
       FIX-POINTERS-EXIT. 
           EXIT.
      * 
      *    PROC WRITE-MULTI-LINES CHECKS FOR INFORMATION STORED 
      *    IN THE AUXIALIARY LINES USED FOR QUALIFIERS. IF ANY
      *    VALUES ARE FOUND, THE LINES ARE MOVED TO CAT-DETAIL
      *    AND WRITTEN OUT. 
       WRITE-MULTI-LINES. 
           IF AQUAL-DETAIL NOT EQUAL TO SPACES
               MOVE AQUAL-DETAIL TO CAT-DETAIL
               PERFORM WRITE-DATA-LINE THRU WRITE-DATA-LINE-XIT 
               MOVE SPACES TO AQUAL-DETAIL
           END-IF 
           IF AQUAL4-DETAIL NOT EQUAL TO SPACES 
               MOVE AQUAL4-DETAIL TO CAT-DETAIL 
               PERFORM WRITE-DATA-LINE THRU WRITE-DATA-LINE-XIT 
               MOVE SPACES TO AQUAL4-DETAIL 
           END-IF 
           IF BQUAL-DETAIL NOT EQUAL TO SPACES
               MOVE BQUAL-DETAIL TO CAT-DETAIL
               PERFORM WRITE-DATA-LINE THRU WRITE-DATA-LINE-XIT 
               MOVE SPACES TO BQUAL-DETAIL
           END-IF 
           IF BQUAL4-DETAIL NOT EQUAL TO SPACES 
               MOVE BQUAL4-DETAIL TO CAT-DETAIL 
               PERFORM WRITE-DATA-LINE THRU WRITE-DATA-LINE-XIT 
               MOVE SPACES TO BQUAL4-DETAIL 
           END-IF 
           MOVE ZERO TO NUM-LINES.
       WRITE-MULTI-LINES-EXIT.
           EXIT.
01384 **************************************************************       CL**2
01385 *                                                                    CL**2
01386 *     DUMP MESSAGE TABLE ROUTINE                                     CL**2
01387 *                                                                    CL**2
01388 **************************************************************       CL**2
01389  DUMP-MSG-TABLE.                                                     CL**2
01390      MOVE 1 TO MSG.                                                  CL**2
01391  DUMP-MSG-TABLE-10.                                                  CL**2
01392      MOVE ERR-MSG (MSG) TO DISP-MSG-ERR.                             CL**2
           IF TX-POS (1) EQUAL TO "-" 
01394          GO TO DUMP-MSG-TABLE-20.                                    CL**2
01395      IF DISP-MSG-ERR-LEV EQUAL TO "S"                                CL**2
01396          MOVE "*ERROR*" TO DISP-MSG-ERRTAG                           CL**2
01397          ADD 1 TO TOT-S.                                             CL**2
01398      IF DISP-MSG-ERR-LEV EQUAL TO "W"                                CL**2
01399          MOVE "*ERROR*" TO DISP-MSG-ERRTAG                           CL**2
01400          ADD 1 TO TOT-W.                                             CL**2
01401  DUMP-MSG-TABLE-20.                                                  CL**2
01402      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01403      MOVE SPACES TO ERR-MSG (MSG).                                   CL**2
01404      ADD 1 TO MSG.                                                   CL**2
           IF MSG GREATER THAN 20 
               GO TO DUMP-MSG-TABLE-XIT 
           END-IF 
01405      IF MSG-POS1 (MSG) NOT EQUAL TO SPACES                           CL**2
01406          GO TO DUMP-MSG-TABLE-10.                                    CL**2
01407      IF ERR-MSG (MSG) NOT EQUAL TO SPACES                            CL**2
01408          GO TO DUMP-MSG-TABLE-10.                                    CL**2
01409      MOVE 1 TO MSG.                                                  CL**2
01410  DUMP-MSG-TABLE-XIT. EXIT.                                           CL**2
      * 
      **************************************************************
      *    PROCESS-REL-TABLE PROCEDURE
      * 
      *    WRITE RELATIONAL RECORDS FOR CATALOGUE NAMES 
      *    APPEARING IN CLAUSES IN VARIOUS CATEGORIES.
      *    THE TABLE IS BUILT DURING ENTITY EDITING.
      *    SINCE OCCURS CLAUSE PHRASES MAY USE DATANAMES
      *    AS WELL AS CATNAMES, FIRST CHECK THAT IT IS A
      *    CATNAME AND THEN ADD TO THE REL-FILE.  ALL 
      *    ENTRIES CREATED FROM THIS PROCEDURE WILL HAVE
      *    HAVE REL-DTL-ENT-PTR SET TO "C"
      * 
      *************************************************************** 
       PROCESS-REL-TABLE. 
           PERFORM VARYING COUNTER FROM 1 BY 1
             UNTIL COUNTER > NUM-ENTRIES
               MOVE REL-NAME (COUNTER) TO REL-ENTRY-NAME
               MOVE SPACE TO REL-ENTRY-FUNCTION 
               PERFORM REL-READ THRU REL-READ-XIT 
      * 
      *    NOW MOVE THE ENTITY TYPE OF THE POINTER
      * 
               IF REL-RETURN-CODE NOT EQUAL TO 2
                   MOVE SPACES TO REL-ANSWER
                   MOVE PTR-ENT-TYPE (COUNTER) TO REL-POINTER-TYPE
                   MOVE REL-NAME (COUNTER) TO REL-ENTRY-NAME
                   MOVE PTR-NAME (COUNTER) TO REL-POINTER-NAME
                   MOVE "C" TO REL-PUSE TYPE-CATAL-NAME 
                   IF REL-FUNCTION (COUNTER) NOT EQUAL "D"
                       PERFORM REL-ADD-PTR THRU REL-ADD-PTR-XIT 
                   ELSE 
                       PERFORM REL-DEL-PTR THRU REL-DEL-PTR-XIT 
                   END-IF 
               END-IF 
           END-PERFORM
           MOVE SPACES TO REL-TABLE.
           MOVE ZEROS TO NUM-ENTRIES. 
       PROCESS-EXIT.
           EXIT.
01411 ************************************************************         CL**2
01412 *                                                                    CL**2
01413 *     WRITE A LINE OF DATA - DATA FILE                               CL**2
01414 *                                                                    CL**2
01415 ****************************************************                 CL**2
01416  WRITE-DATA-LINE.                                                    CL**2
01417      IF EDIT-OPT EQUAL TO "Y"                                        CL**2
01418          GO TO WRITE-DATA-LINE-XIT.                                  CL**2
01419      IF ADD-CHG NOT EQUAL TO "A"                                     CL**2
01420          MOVE CAT-WORK-AREAS TO WORK-REC                             CL**2
01421          WRITE WORK-REC                                              CL**2
01422          GO TO WRITE-DATA-LINE-XIT.                                  CL**2
01423      PERFORM MOVE-DATA-REC THRU MOVE-DATA-REC-XIT.                   CL**2
01424      IF STATUS-SW NOT EQUAL TO "F"                                   CL**2
01425          GO TO WRITE-DATA-LINE-XIT.                                  CL**2
           MOVE "*" TO STATUS-SW. 
           PERFORM SET-END-DATA.
           MOVE CATAL-NAME TO DATA-ENTRY-NAME.
           MOVE O-DATA-NEXT-REC TO DATA-NEXT-REC. 
           PERFORM DATAALG THRU DATAALG-XIT.
           MOVE DATA-KEY TO O-DATA-KEY. 
01430      PERFORM WRITE-REW-DATA-FILE THRU WRITE-REW-DATA-FILE-XIT.       CL**2
01431      ADD 1 TO O-DATA-NEXT-REC.                                       CL**2
           MOVE 1 TO D-OUT. 
01433      MOVE O-DATA-HEADER TO DATA-HEADER.                              CL**2
01434      MOVE SPACES TO O-DATA-RECORD.                                   CL**2
01435      MOVE DATA-HEADER TO O-DATA-HEADER.                              CL**2
01436      GO TO WRITE-DATA-LINE.                                          CL**2
01437  WRITE-DATA-LINE-XIT. EXIT.                                          CL**2
01438 ****************************************************                 CL**2
01439 *                                                                    CL**2
01440 *    MOVE CAT-WROK-AREA TO OUTPUT RECORD - DATA FILE                 CL**2
01441 *                                                                    CL**2
01442 *****************************************************                CL**2
01443  MOVE-DATA-REC.                                                      CL**2
01444      MOVE SPACE TO STATUS-SW.                                        CL**2
01445      MOVE D-OUT TO HOLD-USED-BYTES.                                  CL**2
01446      ADD CAT-LENGTH TO HOLD-USED-BYTES.                              CL**2
           ADD 15 TO HOLD-USED-BYTES. 
           ADD 6 TO HOLD-USED-BYTES.
01449      IF HOLD-USED-BYTES GREATER THAN DATA-LIMIT                      CL**2
01450          MOVE "F" TO STATUS-SW                                       CL**2
01451          GO TO MOVE-DATA-REC-XIT.                                    CL**2
01452      MOVE 1 TO WK.                                                   CL**2
           SUBTRACT 6 FROM HOLD-USED-BYTES. 
01454  MOVE-DATA-REC-10.                                                   CL**2
01455      MOVE CAT-WK-BYTE (WK) TO O-DATA-DETAIL (D-OUT).                 CL**2
01456      ADD 1 TO WK  D-OUT.                                             CL**2
01457      IF D-OUT NOT EQUAL TO HOLD-USED-BYTES                           CL**2
01458          GO TO MOVE-DATA-REC-10.                                     CL**2
01459  MOVE-DATA-REC-XIT. EXIT.                                            CL**2
01460 *************************************************************        CL**2
01461 *                                                                    CL**2
01462 *     CLOSE RECORD - DATA FILE                                       CL**2
01463 *                                                                    CL**2
01464 *************************************************************        CL**2
01465  CLOSE-DATA-REC.                                                     CL**2
01466      MOVE CATAL-NAME TO DATA-ENTRY-NAME.                             CL**2
01467      IF ADD-CHG EQUAL TO "C" GO TO CLOSE-DATA-REC-CHG.               CL**2
01468  CLOSE-DATA-REC-10.                                                  CL**2
           MOVE O-DATA-NEXT-REC TO O-DATA-REC-ID-TRLR.
           MOVE DATA-ENTRY-NAME TO O-DATA-REC-ID. 
           MOVE HIGH-VALUES TO STATUS-SW. 
           PERFORM SET-END-DATA.
           MOVE O-DATA-NEXT-REC TO DATA-NEXT-REC. 
           PERFORM DATAALG THRU DATAALG-XIT.
           MOVE DATA-KEY TO O-DATA-KEY. 
01472      PERFORM WRITE-REW-DATA-FILE THRU WRITE-REW-DATA-FILE-XIT.       CL**2
01473      GO TO CLOSE-DATA-REC-XIT.                                       CL**2
01474  CLOSE-DATA-REC-CHG.                                                 CL**2
01475      MOVE DATA-NEXT-REC TO O-DATA-NEXT-REC.                          CL**2
01476      MOVE ZERO TO DATA-NEXT-REC.                                     CL**2
01477      MOVE 1 TO D-OUT.                                                CL**2
01478      CLOSE TEMP1.                                                    CL**2
           MOVE DATA-KEY TO O-DATA-KEY. 
01479      OPEN INPUT TEMP1.                                               CL**2
01480  CLOSE-DATA-REC-CHG-10.                                              CL**2
01481      READ TEMP1 AT END GO TO CLOSE-DATA-REC-CHG-END.                 CL**2
01482      MOVE WORK-REC TO CAT-WORK-AREAS.                                CL**2
01483  CLOSE-DATA-REC-CHG-15.                                              CL**2
01484      PERFORM MOVE-DATA-REC THRU MOVE-DATA-REC-XIT.                   CL**2
01485      IF STATUS-SW NOT EQUAL TO "F"                                   CL**2
01486          GO TO CLOSE-DATA-REC-CHG-10.                                CL**2
           MOVE "*" TO STATUS-SW. 
           PERFORM SET-END-DATA.
01489      PERFORM DATAALG THRU DATAALG-XIT.                               CL**2
           MOVE DATA-KEY TO O-DATA-KEY. 
01490      PERFORM WRITE-REW-DATA-FILE THRU WRITE-REW-DATA-FILE-XIT.       CL**2
01491      ADD 1 TO DATA-NEXT-REC.                                         CL**2
01492      GO TO CLOSE-DATA-REC-CHG-15.                                    CL**2
01493  CLOSE-DATA-REC-CHG-END.                                             CL**2
01494      CLOSE TEMP1.                                                    CL**2
           MOVE HIGH-VALUES TO STATUS-SW. 
           PERFORM SET-END-DATA.
01497      PERFORM DATAALG THRU DATAALG-XIT.                               CL**2
           MOVE DATA-KEY TO O-DATA-KEY. 
01498      PERFORM WRITE-REW-DATA-FILE THRU WRITE-REW-DATA-FILE-XIT.       CL**2
01499      IF DATA-NEXT-REC NOT LESS THAN O-DATA-NEXT-REC                  CL**2
01500          GO TO CLOSE-DATA-REC-XIT.                                   CL**2
           ADD 1 TO DATA-NEXT-REC.
01501  CLOSE-DATA-REC-CHG-END-10.                                          CL**2
           IF DATA-NEXT-REC NOT GREATER THAN O-DATA-NEXT-REC
               PERFORM DATAALG THRU DATAALG-XIT 
               PERFORM DELETE-DATA-FILE 
               ADD 1 TO DATA-NEXT-REC 
               GO TO CLOSE-DATA-REC-CHG-END-10. 
01509  CLOSE-DATA-REC-XIT. EXIT.                                           CL**2
01510 ************************************************************         CL**2
01511 *                                                                    CL**2
01512 *     HOUSE KEEPING  - DATA FILE                                     CL**2
01513 *                                                                    CL**2
01514 *************************************************************        CL**2
       SET-END-DATA.
           MOVE STATUS-SW TO O-DATA-DETAIL (D-OUT). 
           ADD 1 TO D-OUT.
           MOVE STATUS-SW TO O-DATA-DETAIL (D-OUT). 
           ADD 1 TO D-OUT.
           MOVE STATUS-SW TO O-DATA-DETAIL (D-OUT). 
01527 *                                                                    CL**2
01528 *     WRITE OR REWRITE MAST1                                         CL**2
01529 *                                                                    CL**2
01530  WRITE-REW-DATA-FILE.                                                CL**2
01531      MOVE 1 TO D-OUT.                                                CL**2
01532      READ MAST1  INVALID KEY                                         CL**2
01533          GO TO WRITE-REW-DATA-FILE-NF.                               CL**2
01534      REWRITE DATA-RECORD FROM O-DATA-RECORD                          CL**2
01535          INVALID KEY                                                 CL**2
01536          MOVE "REWRITE " TO DISP-MSG-ERR3                            CL**2
01537          PERFORM DATA-INV-KEY.                                       CL**2
01538      GO TO WRITE-REW-DATA-FILE-XIT.                                  CL**2
01539  WRITE-REW-DATA-FILE-NF.                                             CL**2
01540      WRITE DATA-RECORD FROM O-DATA-RECORD                            CL**2
01541          INVALID KEY                                                 CL**2
01542          MOVE "WRITE  " TO DISP-MSG-ERR3                             CL**2
01543          PERFORM DATA-INV-KEY.                                       CL**2
01544  WRITE-REW-DATA-FILE-XIT. EXIT.                                      CL**2
      ******************************************************* 
      * 
      *        MAST1 DELETE 
      * 
      ******************************************************* 
       DELETE-DATA-FILE.
           DELETE MAST1 INVALID KEY 
               MOVE "DELETE  " TO DISP-MSG-ERR3 
               PERFORM DATA-INV-KEY.
01545 *                                                                    CL**2
01546 *    MAST1 INVALID KEY                                               CL**2
01547 *                                                                    CL**2
01548  DATA-INV-KEY.                                                       CL**2
01549      MOVE CERR-800S TO DISP-MSG-ERR3IO.                              CL**2
01550      MOVE "*ERROR*" TO DISP-MSG-ERRTAG.                              CL**2
01551      MOVE CERR-00 TO DISP-MSG-ERR1.                                  CL**2
01552      ADD 1 TO TOT-S.                                                 CL**2
01553      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01554 ***************************************************                  CL**2
01555 *                                                                    CL**2
01556 *     UPDATE REL RECORD POINTERS                                     CL**2
01557 *                                                                    CL**2
01558 *     TEST FOR AND WRITE REVISION RECORDS                            CL**2
01559 *                                                                    CL**2
01560 **************************************************                   CL**2
01561  UPD-REL-REC.                                                        CL**2
01562      IF EDIT-OPT EQUAL TO "Y"                                        CL**2
01563          GO TO UPD-REL-REC-XIT.                                      CL**2
01564      IF TYPE-CATAL-NAME EQUAL TO SPACES                              CL**2
01565          GO TO UPD-REL-REC-XIT.                                      CL**2
01566      IF OLD-CATAL-NAME EQUAL TO SPACES                               CL**2
01567          GO TO UPD-REL-REC-NEW.                                      CL**2
01568      IF NEW-CATAL-NAME EQUAL TO SPACES                               CL**2
01569          GO TO UPD-REL-REC-DEL.                                      CL**2
01570 ****TEMP CODE TO FIX CHG OF STC/REL COMMENT LINE                     CL**2
01571      MOVE OLD-CATAL-NAME TO VAL (1).                                 CL**2
01572      IF VAL (1) EQUAL TO "*" GO TO UPD-REL-REC-NEW.                  CL**2
01573      MOVE OLD-CATAL-NAME TO REL-ENTRY-NAME.                          CL**2
01574      MOVE ENT-ID TO REL-POINTER-TYPE.                                CL**2
01575      MOVE CATAL-NAME TO REL-POINTER-NAME.                            CL**2
01576      PERFORM REL-DEL-PTR THRU REL-DEL-PTR-XIT.                       CL**2
01577      IF REL-RETURN-CODE NOT EQUAL 0                                  CL**2
01578          MOVE CERR-850S TO DISP-MSG-ERR2                             CL**2
01579          MOVE "DEL PTR" TO DISP-MSG-ERR3                             CL**2
01580          GO TO CTL-TX-ERR.                                           CL**2
01581  UPD-REL-REC-NEW.                                                    CL**2
01582      MOVE SPACES TO REL-ANSWER.                                      CL**2
01583      MOVE NEW-CATAL-NAME TO REL-ENTRY-NAME.                          CL**2
01584      MOVE CATAL-NAME TO REL-POINTER-NAME.                            CL**2
01585      MOVE ENT-ID TO REL-POINTER-TYPE.                                CL**2
01586      IF TYPE-CATAL-NAME EQUAL TO "A"                                 CL**2
01587          MOVE 1 TO REL-POINTER-ALIAS                                 CL**2
01588          MOVE "Y" TO ALIAS-SW.                                       CL**2
01589      IF TYPE-CATAL-NAME EQUAL TO "R"   AND                           CL**2
01590          CAT-PUSE EQUAL TO "P"                                       CL**2
01591          MOVE "P" TO REL-PUSE.                                       CL**2
           IF TYPE-CATAL-NAME EQUAL TO "S"
               MOVE "S" TO REL-PUSE 
           END-IF 
01592      PERFORM REL-ADD-PTR THRU REL-ADD-PTR-XIT.                       CL**2
01593      IF REL-RETURN-CODE NOT EQUAL 0                                  CL**2
01594          MOVE CERR-850S TO DISP-MSG-ERR2                             CL**2
01595          MOVE "ADD PTR" TO DISP-MSG-ERR3                             CL**2
01596          GO TO CTL-TX-ERR.                                           CL**2
01597      GO TO UPD-REL-REC-XIT.                                          CL**2
01598  UPD-REL-REC-DEL.                                                    CL**2
01599 **** TEMP CODE  TO FIX DELETE OF STRUCTURE/RELATIONAL COMMENT LINE   CL**2
01600      MOVE OLD-CATAL-NAME TO VAL (1).                                 CL**2
01601      IF VAL (1) EQUAL TO "*" GO TO UPD-REL-REC-XIT.                  CL**2
01602      MOVE OLD-CATAL-NAME TO REL-ENTRY-NAME.                          CL**2
01603      MOVE CATAL-NAME TO REL-POINTER-NAME.                            CL**2
01604      MOVE ENT-ID TO REL-POINTER-TYPE.                                CL**2
01605      PERFORM REL-DEL-PTR THRU REL-DEL-PTR-XIT.                       CL**2
01606      IF REL-RETURN-CODE NOT EQUAL 0                                  CL**2
01607          MOVE CERR-850S TO DISP-MSG-ERR2                             CL**2
01608          MOVE "DEL PTR" TO DISP-MSG-ERR3                             CL**2
01609          GO TO CTL-TX-ERR.                                           CL**2
01610  UPD-REL-REC-XIT. EXIT.                                              CL**2
01611 *************************************************                    CL**2
01612 *                                                                    CL**2
01613 *     VALIDATE NUMERICS 1 TO 4 LONG                                  CL**2
01614 *                                                                    CL**2
01615 *************************************************                    CL**2
01616  VALID-NUMERIC.                                                      CL**2
           MOVE ZEROES TO NUM-HOLD. 
           PERFORM VARYING VA FROM 1 BY 1 
             UNTIL VAL (VA) EQUAL TO SPACES 
               IF VAL (VA) IS NOT NUMERIC 
                   GO TO VALID-NUM-ERR
               END-IF 
           END-PERFORM. 
           SUBTRACT 1 FROM VA.
      * 
      *    COMPUTE START POSITION AS FIELD LENGTH (10)
      *    MINUS NUMBER OF DIGITS PLUS ONE
      *    FIELD LENGTH IS ALWAYS 10 SO JUST ADD ONE
      *    AND SUBTRACT COUNT 
      * 
           COMPUTE START-POS = 11 - VA. 
           MOVE VAL-AREA (1 : VA) TO NUM-HOLD-X (START-POS : VA). 
       VALID-NUMERIC-XIT. 
           EXIT.
01645  VALID-NUM-ERR.                                                      CL**2
01646      MOVE CERR-605S TO DISP-MSG-ERR2.                                CL**2
01647      GO TO CTL-TX-ERR.                                               CL**2
01649  USER-ROUTINE.                                                       CL**2
01650      GO TO USER-ROUTINE-XIT.                                         CL**2
01651  USER-ROUTINE-XIT.                                                   CL**2
01652      EXIT.                                                           CL**2
*CALL     RELCOM
*CALL     RELUPD
*CALL     MAST1EXT
*CALL     RELALG
*CALL     MAST1RFL
      ********** DATA FILE (MAST1) I/O - MAST1RND  *************
      * 
      * 
      *    READ NEXT LINE OF SAME ENTRY                                *
      ******************************************************************
      ******************************************************************
       READ-NEXT-DATA.
           MOVE "0" TO DATA-RETURN-CODE.
           MOVE 6 TO WORK-LENGTH. 
           PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.
           IF CAT-STORE EQUAL TO HIGH-VALUES
               MOVE "1" TO DATA-RETURN-CODE 
               GO TO READ-NEXT-DATA-XIT.
           IF CAT-STORE NOT = "***" 
               GO TO RETRIEVE-LINE. 
      ******************************************************************
      *    END OF PHYSICAL RECORD - NOT ENTRY - GET NEXT RECORD        *
      ******************************************************************
           ADD 1 TO DATA-NEXT-REC.
           PERFORM DATA-READ THRU DATA-READ-XIT.
           IF DATA-RETURN-CODE NOT EQUAL TO "0" 
               GO TO READ-NEXT-DATA-XIT.
           MOVE DATA-RECORD TO HOLD-DATA-RECORD.
           GO TO READ-NEXT-DATA.
       RETRIEVE-LINE. 
           MOVE LENGTH-STORE TO CAT-LENGTH. 
           IF CAT-STORE NOT EQUAL TO CAT-CATEGORY 
               IF FUNC EQUAL "B"
                   GO TO READ-NEXT-DATA-XIT 
               END-IF 
               MOVE "2" TO DATA-RETURN-CODE 
               MOVE CAT-STORE TO CAT-CATEGORY 
           END-IF 
           MOVE 9 TO WORK-LENGTH. 
           PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.
           IF FUNC EQUAL TO "B" 
             AND LINE-STORE NOT EQUAL TO CAT-LINE 
               GO TO READ-NEXT-DATA-XIT 
           END-IF 
           MOVE REV-STORE TO CAT-REV. 
           MOVE LINE-STORE TO CAT-LINE. 
           MOVE CAT-LENGTH TO WORK-LENGTH.
           PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.
      * 
      *    THIS SECTION OF CODE IS EXECUTED WHENEVER ONE
      *    OF THE EDIT SEGMENTS WHICH USES MULTI-BLOCK LINES
      *    NEEDS A BLOCK IN ONE OF THE AUXILIARY STORAGE AREAS
      * 
           IF FUNC EQUAL "B"
      * 
      *    GROUP AND RECORD ENTITIES NEED QUALIFIER BLOCKS
      *    FOR RENAMES, THRU AND DEPEND 
      * 
               IF ENT-ID EQUAL 10 OR 13 
                 AND CAT-CATEGORY EQUAL 300 
                   IF WORK-LINE-TYPE EQUAL "Q" OR "2" OR "D"
                       MOVE WORK-LINE TO AQUAL-DETAIL 
                   END-IF 
               ELSE 
      * 
      *    SUBSCHEMA RESTRICT (SSREL) USES ALL FOUR AUXILIARY 
      *    BLOCKS 
      * 
                   IF ENT-ID EQUAL 24 
                     AND CAT-CATEGORY EQUAL 525 
                       IF WORK-LINE-TYPE EQUAL "Q"
                           MOVE WORK-LINE TO AQUAL-DETAIL 
                           GO TO READ-NEXT-DATA 
                       ELSE 
                           IF WORK-LINE-TYPE EQUAL "2"
                               MOVE WORK-LINE TO AQUAL4-DETAIL
                               GO TO READ-NEXT-DATA 
                           ELSE 
                               IF WORK-LINE-TYPE EQUAL "B"
                                   MOVE WORK-LINE TO BQUAL-DETAIL 
                                   GO TO READ-NEXT-DATA 
                               ELSE 
                                   IF WORK-LINE-TYPE EQUAL "3"
                                       MOVE WORK-LINE TO BQUAL4-DETAIL
                                       GO TO READ-NEXT-DATA-XIT 
                                   END-IF 
                               END-IF 
                           END-IF 
                       END-IF 
                   END-IF 
               END-IF 
           END-IF 
           MOVE WORK-LINE TO DETAIL-WORK. 
       READ-NEXT-DATA-XIT.
           EXIT.
*CALL     MAST1READ 
*CALL     MAST1ALG
