*DECK     DCUPDDEL
00001  IDENTIFICATION DIVISION.                                         08/31/78
       PROGRAM-ID.   UPDDEL.
00003 ***********************************************************          LV002
00004 ***********************************************************          CL**2
00005 *                                                                 DCUPDDEL
00006 *     D A T A   C A T A L O G U E   2                             DCUPDDEL
00007 *                                                                 DCUPDDEL
00008 *       U P D A T E   P R O G R A M                               DCUPDDEL
00009 *                                                                 DCUPDDEL
00010 *                                                                 DCUPDDEL
00011 *    E N T R Y   D E L E T E   R O U T I N E                      DCUPDDEL
00012 *                                                                 DCUPDDEL
00013 ***********************************************************          CL**2
00014 ***********************************************************          CL**2
00015  ENVIRONMENT DIVISION.                                            DCUPDDEL
00016  CONFIGURATION SECTION.                                           DCUPDDEL
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
00019  INPUT-OUTPUT SECTION.                                            DCUPDDEL
00020  FILE-CONTROL.                                                    DCUPDDEL
           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. 
00027  DATA DIVISION.                                                   DCUPDDEL
00028  FILE SECTION.                                                    DCUPDDEL
*CALL     MAST1FD 
*CALL     MAST2FD 
       COMMON-STORAGE SECTION.
       77  RETURN-CODE PICTURE 99.
  
  
*CALL DCUPDLNK
       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  FILLER              PICTURE XXX. 
       01  CATG-TABLE.
           03  FILLER  PICTURE X(3780). 
       01 LINK-AREA-OPT.
           03 RUN-OPTIONS.
             05 HOLD-REV       PICTURE 9(5).
             05 EDIT-OPT       PICTURE X. 
             05 ON-LINE-SW     PICTURE X. 
             05 PASS-WORD      PICTURE X(5).
             05 USER-OPT       PICTURE XXX. 
             05  QUOTE-OPT PICTURE X. 
           03  HOLD-DBMS PICTURE X. 
           03 CUST-NAME        PICTURE X(27). 
           03 CUST-ADDR        PICTURE X(27). 
           03 CUR-DATE         PICTURE X(6).
           03  FILLER PICTURE X(5). 
           03 CTL-PRIME-NUM    PICTURE 9(5).
           03 CTL-PRIME-NUM-REL  PICTURE 9(5).
           03  FILLER PICTURE X(10).
           03 TOT-ENT-CHG      PICTURE 9(5).
           03 TOT-ENT-DEL      PICTURE 9(5).
           03  FILLER  PICTURE X(135).
*CALL WKPRINT 
*CALL TESTWACOM 
*CALL DCDPTRS 
*CALL QUALINE 
*CALL     WRKSTG77
00032  77  CERR-030I             PICTURE X(35) VALUE                       CL**2
00033      "030-I DELETE SUCCESSFULLY COMPLETED".                          CL**2
00034  77  CERR-040I            PICTURE X(43) VALUE                        CL**2
00035      "040-I DELETE OF REFERENCE TO THIS ENTRY IN-".                  CL**2
00036  77  CERR-050I            PICTURE X(53) VALUE                        CL**2
00037      "050-I DELETE                                 REF IN-".         CL**2
00038  77  CERR-060I           PICTURE X(13) VALUE                         CL**2
           "060-I DELETE ". 
00040  77  CERR-405S          PICTURE X(31) VALUE                          CL**2
00041      "405-S *ERROR UNKNOWN ENTRY TYPE".                              CL**2
00042  77  CERR-410S          PICTURE X(47) VALUE                          CL**2
00043      "410-S *ERROR SYNTAX-UNABLE TO LOCATE ENTRY TYPE".              CL**2
00044  77  CERR-415S          PICTURE X(43) VALUE                          CL**2
00045      "415-S *ERROR CATALOGUE NAME LONGER THAN 32".                   CL**2
00046  77  CERR-430S          PICTURE X(40) VALUE                          CL**2
00047      "430-S *ERROR DEL FOR NON-EXISTENT ENTRY".                      CL**2
00048  77  CERR-440S          PICTURE X(53) VALUE                          CL**2
00049      "440-S *ERROR DELETE MUST BE WHEREUSED USING OR GLOBAL".        CL**2
00050  77  CERR-700S          PICTURE X(55) VALUE                          CL**2
00051      "700-S *ERROR NOT DELETED DUE TO REFERENCE IN-".                CL**2
00052  77  CERR-705S            PICTURE X(46) VALUE                        CL**2
00053      "705-S *ERROR NOT DELETED DUE TO REFERENCE IN-".                CL**2
00054  77  CERR-710S            PICTURE X(38) VALUE                        CL**2
00055      "710-S *ERROR HIERARCHY TABLE OVERFLOW".                        CL**2
00056  77  CERR-800S          PICTURE X(24) VALUE                          CL**2
00057      "800-S *ERROR MAST1-DEL ".                                      CL**2
00058  77  CERR-850S          PICTURE X(24) VALUE                          CL**2
00059      "850-S *ERROR MAST2-DEL ".                                      CL**2
*CALL     WRKSTG01
*CALL     MAST1WS 
*CALL     MAST1OUT
00063  01  ERROR-FND-SW          PICTURE X VALUE "N".                      CL**2
00064  01  HOLD-SUB             PICTURE S999 COMP SYNC.                    CL**2
00065  01  HIERARCHY-TABLE.                                                CL**2
00066      03  HIER-TABLE    OCCURS 40 TIMES.                              CL**2
00067          05  TABL-CATNAME       PICTURE X(32).                       CL**2
00068          05  TABL-STCNAME       PICTURE X(32).                       CL**2
00069  01  HOLD-CAT-LENGTH   PICTURE S999 .                              DCUPDDE
00070  01  HOLD-USED-BYTES   PICTURE S9(4) .                             DCUPDDE
00071  01  O-DATA-NEXT-REC        PICTURE S9(5) .                        DCUPDDE
00072  01  HOLD-DELETE      PICTURE X(9) VALUE SPACES.                     CL**2
00073  01  WK                    PICTURE S999 COMP SYNC.                DCUPDDEL
00074  01  TAB                   PICTURE S99  COMP SYNC.                DCUPDDEL
00075  01  D-OUT                 PICTURE S9999 COMP SYNC VALUE 1.       DCUPDDEL
00076  01  LINE-NO               PICTURE 9(4)  VALUE ZEROS.             DCUPDDEL
00077  01  VAL-AREA.                                                    DCUPDDEL
00078      03  VAL-3POS.                                                DCUPDDEL
00079          05  VAL-3         PICTURE X(3).                          DCUPDDEL
00080          05  FILLER        PICTURE X(37).                         DCUPDDEL
00081      03  VAL-4POS REDEFINES VAL-3POS.                             DCUPDDEL
00082          05  VAL-4         PICTURE X(4).                          DCUPDDEL
00083          05  FILLER        PICTURE X(36).                         DCUPDDEL
00084      03  VAL-5POS REDEFINES VAL-4POS.                             DCUPDDEL
00085          05  VAL-5         PICTURE X(5).                          DCUPDDEL
00086          05  FILLER        PICTURE X(35).                         DCUPDDEL
00087      03  VAL-8POS REDEFINES VAL-4POS.                             DCUPDDEL
00088          05  VAL-8         PICTURE X(8).                          DCUPDDEL
00089          05  FILLER        PICTURE X(32).                         DCUPDDEL
00090      03  VAL-POS  REDEFINES VAL-4POS.                             DCUPDDEL
00091          05  VAL           PICTURE X OCCURS 40 TIMES.             DCUPDDEL
00092  01  DISP-MSG-ERR.                                                   CL**2
00093      03  DISP-MSG-ERR1        PICTURE X(6).                          CL**2
00094      03  DISP-MSG-ERR2        PICTURE X(57).                         CL**2
00095      03  DISP-MSG-ERR-IO REDEFINES DISP-MSG-ERR2.                    CL**2
00096          05  FILLER           PICTURE X(24).                         CL**2
00097          05  DISP-MSG-ERR3    PICTURE X(8).                          CL**2
00098          05  FILLER       PICTURE X(27).                             CL**2
00099      03  DISP-MSG-ERR-NAME  REDEFINES DISP-MSG-ERR2.                 CL**2
00100          05  FILLER         PICTURE X(32).                           CL**2
00101          05  DISP-MSG-ERR4  PICTURE X(27).                           CL**2
00102      03  DISP-MSG-ERR-REF REDEFINES DISP-MSG-ERR2.                   CL**2
00103          05  FILLER           PICTURE X(13).                         CL**2
00104          05  DISP-MSG-ERR5    PICTURE X(32).                         CL**2
00105          05  DISP-MSG-ERR6   PICTURE X(4).                           CL**2
00106  01  CONTROL-STATUS.                                              DCUPDDEL
00107      03  END-OF-FILE        PICTURE X VALUE "N".                  DCUPDDEL
00108      03  ENTRY-FOUND       PICTURE X VALUE "N".                   DCUPDDEL
           03  DELETE-RC           PICTURE 9. 
           03  ID1FLAG             PICTURE X. 
           03  ID2FLAG             PICTURE X. 
           03  FINIS               PICTURE X. 
           03  TRADE               PICTURE X. 
00150                                                                    DCUPDDE
00151  PROCEDURE DIVISION.                                                 CL**2
       OLD-ENTRY. 
00154 ***********************************************************          CL**2
00155 ***********************************************************          CL**2
00156 *                                                                 DCUPDDEL
00157 *       I N I T I L A I Z A T I O N                               DCUPDDEL
00158 *                                                                 DCUPDDEL
00159 ***********************************************************          CL**2
00160 ***********************************************************          CL**2
00161      IF FUNC EQUAL TO "D"                                            CL**2
00162          GO TO DEL-MSG-SUB-IN.                                    DCUPDDEL
00163      OPEN I-O MAST1.                                                 CL**2
00164      OPEN I-O MAST2.                                                 CL**2
00167      MOVE SPACES TO DISP-MSG-ERR.                                    CL**2
00168      MOVE SPACES TO MESSAGE-TABLE.                                   CL**2
           MOVE ZERO TO O-DATA-NEXT-REC.
           MOVE SPACES TO O-DATA-RECORD.
           MOVE 1 TO D-OUT. 
           MOVE SPACES TO REL-LAST-ENTRY-NAME.
           MOVE SPACES TO REL-ANSWER. 
           MOVE SPACES TO HOLD-DELETE.
00169 ***********************************************************          CL**2
00170 ***********************************************************          CL**2
00171 *                                                                    CL**2
00172 *     E D I T   D E L E T E   R E Q U E S T                          CL**2
00173 *                                                                    CL**2
00174 ***********************************************************          CL**2
00175 ***********************************************************          CL**2
00176 *                                                                 DCUPDDEL
00177 *     LOCATE ENTRY TYPE                                           DCUPDDEL
00178 *                                                                 DCUPDDEL
00179  DEL-LOC-ENT.                                                     DCUPDDEL
00180      MOVE 4 TO TX.                                                   CL**2
00181      PERFORM FIND-NON-BLANK THRU FIND-NON-BLANK-XIT.                 CL**2
00182      MOVE "=" TO STATUS-SW.                                       DCUPDDEL
00183      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                        DCUPDDEL
00184      IF VA GREATER THAN 16                                        DCUPDDEL
00185          MOVE CERR-410S TO DISP-MSG-ERR2                             CL**2
00186          GO TO DEL-TX-ERR.                                        DCUPDDEL
00187      MOVE 1 TO FLD.                                               DCUPDDEL
00188  DEL-LOC-ENT30.                                                   DCUPDDEL
00189      IF ENTRY-NAME (FLD) EQUAL TO VAL-AREA                           CL**2
00190          GO TO DEL-LOC-ENT40.                                     DCUPDDEL
00191      IF VAL (4) EQUAL TO SPACE    AND                                CL**2
00192          ENTRY-NAME3 (FLD) EQUAL TO VAL-3                            CL**2
00193              GO TO DEL-LOC-ENT40.                                    CL**2
00194      IF ENTRY-NAME (FLD) EQUAL TO HIGH-VALUE                      DCUPDDEL
00195          MOVE CERR-405S TO DISP-MSG-ERR2                             CL**2
00196           GO TO DEL-TX-ERR.                                       DCUPDDEL
00197      ADD 1 TO FLD.                                                DCUPDDEL
00198      GO TO DEL-LOC-ENT30.                                         DCUPDDEL
00199  DEL-LOC-ENT40.                                                   DCUPDDEL
00200      MOVE ENTRY-ID (FLD) TO ENT-ID.                               DCUPDDEL
00201 *                                                                 DCUPDDEL
00202 *     LOCATE CATALOGUE NAME                                       DCUPDDEL
00203 *                                                                 DCUPDDEL
00204      ADD 1 TO TX.                                                 DCUPDDEL
00205      MOVE SPACE TO STATUS-SW.                                     DCUPDDEL
00206      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                        DCUPDDEL
00207      MOVE VAL-AREA TO CATAL-NAME.                                 DCUPDDEL
00208      IF VA GREATER THAN 33                                        DCUPDDEL
00209          MOVE CERR-415S TO DISP-MSG-ERR2                             CL**2
00210          GO TO DEL-TX-ERR.                                        DCUPDDEL
00211      PERFORM FIND-NON-BLANK THRU FIND-NON-BLANK-XIT.              DCUPDDEL
00212      IF STATUS-SW EQUAL TO "E"                                    DCUPDDEL
00213          GO TO DEL-LOC-ENT60.                                     DCUPDDEL
00214      MOVE SPACE TO STATUS-SW.                                     DCUPDDEL
00215      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                        DCUPDDEL
00216      IF VAL-AREA EQUAL TO "WHEREUSED" OR "USING" OR "GLOBAL"      DCUPDDEL
00217          MOVE VAL-AREA TO HOLD-DELETE                             DCUPDDEL
00218          GO TO DEL-LOC-ENT60.                                     DCUPDDEL
00219      MOVE CERR-440S TO DISP-MSG-ERR2.                                CL**2
00220       GO TO DEL-TX-ERR.                                           DCUPDDEL
00221  DEL-LOC-ENT60.                                                   DCUPDDEL
00222 *                                                                 DCUPDDEL
00223 *     SEE IF ENTRY ALLREADY EXISTS ON REL FILE                    DCUPDDEL
00224 *                                                                 DCUPDDEL
00225      MOVE CATAL-NAME TO REL-ENTRY-NAME.                           DCUPDDEL
00226      MOVE "N" TO REL-ENTRY-FUNCTION.                              DCUPDDEL
00227      PERFORM REL-READ THRU REL-READ-XIT.                          DCUPDDEL
           IF REL-RETURN-CODE EQUAL TO 2
00229          MOVE CERR-430S TO DISP-MSG-ERR2                             CL**2
00230           GO TO DEL-TX-ERR.                                       DCUPDDEL
00231      MOVE ZERO TO O-DATA-NEXT-REC.                                   CL**2
00232                                                                    DCUPDDE
00233      IF HOLD-DELETE NOT EQUAL TO SPACES                           DCUPDDEL
00234          GO TO DEL-WUSED.                                         DCUPDDEL
00235 ***********************************************************          CL**2
00236 ***********************************************************          CL**2
00237 *                                                                 DCUPDDEL
00238 *     R E G U L A R   D E L E T E   P R O C E S S I N G           DCUPDDEL
00239 *                                                                 DCUPDDEL
00240 ***********************************************************          CL**2
00241 ***********************************************************          CL**2
00242 *    RECORD HAS BEEN READ                                         DCUPDDEL
00243      IF REL-RETURN-CODE EQUAL TO 1                                   CL**2
00244          GO TO DEL-REG-05.                                           CL**2
00245 *                                                                    CL**2
00246 *    CANT DELETE DUE TO REFFERENCE                                   CL**2
00247 *                                                                    CL**2
00248      MOVE 1 TO MSG.                                                  CL**2
00249      MOVE CERR-700S TO DISP-MSG-ERR2.                                CL**2
00250      MOVE "DCUPD-" TO DISP-MSG-ERR1.                                 CL**2
00251      MOVE DISP-MSG-ERR TO ERR-MSG (MSG).                             CL**2
00252      ADD 1 TO MSG.                                                   CL**2
00253  DEL-REG-00.                                                         CL**2
00254      MOVE REL-POINTER-NAME TO MSG-POS5 (MSG).                        CL**2
00255      ADD 1 TO MSG.                                                   CL**2
00256      IF MSG EQUAL TO 20                                              CL**2
00257          PERFORM DEL-MSG-SUB THRU DEL-MSG-SUB-XIT.                   CL**2
00258      MOVE "N" TO REL-ENTRY-FUNCTION.                                 CL**2
00259      PERFORM REL-READ THRU REL-READ-XIT.                             CL**2
00260      IF REL-RETURN-CODE NOT EQUAL TO 1                               CL**2
00261          GO TO DEL-REG-00.                                           CL**2
00262      MOVE HIGH-VALUES TO FUNC.                                       CL**2
00263      MOVE SPACES TO ERR-MSG (MSG).                                   CL**2
00264      GO TO DEL-TX-END.                                               CL**2
00265  DEL-REG-05.                                                         CL**2
00266 *                                                                    CL**2
00267 *     DELETE REL ENTRY                                               CL**2
00268 *                                                                    CL**2
00269      IF EDIT-OPT EQUAL TO "Y"                                        CL**2
               GO TO DEL-REG-END-20.
00273      MOVE ZERO TO REL-RETURN-CODE.                                   CL**2
00274      PERFORM REL-DELETE THRU REL-DELETE-XIT.                         CL**2
00275      IF REL-RETURN-CODE NOT EQUAL TO 0                            DCUPDDEL
00276          MOVE CERR-850S TO DISP-MSG-ERR2                             CL**2
00277           MOVE "DELETE" TO DISP-MSG-ERR3                             CL**2
00278           MOVE REL-ENTRY-NAME TO DISP-MSG-ERR4                       CL**2
00279          GO TO DEL-TX-ERR.                                        DCUPDDEL
00280 *                                                                    CL**2
00281 *     READ DATA ENTRY                                                CL**2
00282 *                                                                    CL**2
00283      MOVE CATAL-NAME TO DATA-ENTRY-NAME.                          DCUPDDEL
00285      PERFORM READ-FIRST-DATA THRU READ-FIRST-DATA-XIT.            DCUPDDEL
00286      GO TO DEL-REG-15.                                               CL**2
00287  DEL-REG-10.                                                         CL**2
00288      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00289  DEL-REG-15.                                                         CL**2
00290      IF DATA-RETURN-CODE EQUAL TO 1                               DCUPDDEL
00291          GO TO DEL-REG-END.                                       DCUPDDEL
00293      IF CAT-COMMENT EQUAL TO "*"                                     CL**2
00294          GO TO DEL-REG-10.                                           CL**2
           IF CAT-CATEGORY EQUAL TO 010 OR 300 OR 
             GREATER THAN 399 
00296          GO TO DEL-REG-20.                                           CL**2
00297      GO TO DEL-REG-10.                                               CL**2
00298  DEL-REG-20.                                                         CL**2
00299 *                                                                    CL**2
00300 *     DELETE REL PTRS TO THIS ENTRY                                  CL**2
00301 *                                                                    CL**2
           MOVE SPACE TO TYPE-PUSE. 
           PERFORM DELETE-DECISION THRU DELETE-DECISION-EXIT. 
           IF DELETE-RC EQUAL TO 0
               GO TO DEL-REG-10 
           END-IF 
00325      IF CTL-ALY-VER EQUAL TO SPACES OR "FILLER "                     CL**2
00326          GO TO DEL-REG-10.                                           CL**2
00327      MOVE CTL-ALY-VER TO REL-ENTRY-NAME.                          DCUPDDEL
00328      MOVE CATAL-NAME TO REL-POINTER-NAME.                         DCUPDDEL
00329      MOVE ENT-ID TO REL-POINTER-TYPE.                             DCUPDDEL
00330      PERFORM REL-DEL-PTR THRU REL-DEL-PTR-XIT.                       CL**2
00331      IF REL-RETURN-CODE NOT EQUAL TO 0                            DCUPDDEL
00332          MOVE CERR-850S TO DISP-MSG-ERR2                             CL**2
00333          MOVE "DEL PTR" TO DISP-MSG-ERR3                             CL**2
00334          MOVE REL-POINTER-NAME TO DISP-MSG-ERR4                      CL**2
00335          GO TO DEL-TX-ERR.                                        DCUPDDEL
00336      GO TO DEL-REG-10.                                               CL**2
00337  DEL-REG-END.                                                     DCUPDDEL
00338 *                                                                    CL**2
00339 *     DELETE DATA ENTRY                                              CL**2
00340 *                                                                    CL**2
           PERFORM DELETE-DATA-REC THRU DELETE-DATA-REC-XIT.
00342  DEL-REG-END-10.                                                     CL**2
00343      MOVE ALL-NAMES-LITERAL TO REL-ENTRY-NAME.                       CL**2
00344      MOVE CATAL-NAME TO REL-POINTER-NAME.                            CL**2
           MOVE SPACE TO TYPE-PUSE. 
00345      PERFORM REL-DEL-PTR THRU REL-DEL-PTR-XIT.                       CL**2
00346      IF REL-RETURN-CODE NOT EQUAL TO 0                               CL**2
00347          MOVE CERR-850S TO DISP-MSG-ERR2                             CL**2
00348          MOVE "DEL SYS" TO DISP-MSG-ERR3                             CL**2
00349          GO TO DEL-TX-ERR.                                           CL**2
       DEL-REG-END-20.
00350      MOVE CERR-030I TO DISP-MSG-ERR2.                                CL**2
00351      MOVE "DCUPD-" TO DISP-MSG-ERR1.                                 CL**2
00352      MOVE DISP-MSG-ERR TO ERR-MSG (1).                               CL**2
00353      MOVE SPACE TO FUNC.                                          DCUPDDEL
00354      ADD 1 TO TOT-ENT-DEL.                                           CL**2
00355      GO TO DEL-TX-END.                                            DCUPDDEL
00356                                                                    DCUPDDE
00357 ***********************************************************          CL**2
00358 ***********************************************************          CL**2
00359 *                                                                 DCUPDDEL
00360 *     D E L E T E   W H E R E   U S E D                           DCUPDDEL
00361 *                                                                 DCUPDDEL
00362 ************************************************************         CL**2
00363 ***********************************************************          CL**2
00364  DEL-WUSED.                                                       DCUPDDEL
00365      IF HOLD-DELETE NOT EQUAL TO "WHEREUSED"                         CL**2
00366          GO TO DEL-USING.                                            CL**2
00369      MOVE CATAL-NAME TO DATA-ENTRY-NAME.                             CL**2
00372      PERFORM READ-FIRST-DATA THRU READ-FIRST-DATA-XIT.               CL**2
00373      IF DATA-RETURN-CODE EQUAL TO 0 OR 1 OR 2                        CL**2
00374          GO TO DEL-WU-15.                                            CL**2
00375      MOVE CERR-800S TO DISP-MSG-ERR2.                                CL**2
00376      MOVE "READ" TO DISP-MSG-ERR3.                                   CL**2
00377      GO TO DEL-TX-ERR.                                               CL**2
00378  DEL-WU-10.                                                          CL**2
00379 *                                                                    CL**2
00380 *     FIND CON STC OR REL LINES IN DATA ENTRY                        CL**2
00381 *                                                                    CL**2
00382      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00383  DEL-WU-15.                                                          CL**2
00384      IF DATA-RETURN-CODE EQUAL TO 1                                  CL**2
00385          GO TO DEL-WU-30.                                            CL**2
00387      IF CAT-COMMENT EQUAL TO "*"                                     CL**2
00388          GO TO DEL-WU-10.                                            CL**2
           IF CAT-CATEGORY EQUAL TO 010 OR 300 OR 
             GREATER THAN 399 
00390          GO TO DEL-WU-20.                                            CL**2
00391      GO TO DEL-WU-10.                                                CL**2
00392  DEL-WU-20.                                                          CL**2
00393 *                                                                    CL**2
00394 *     DELETE THE REL FILE POINTERS                                   CL**2
00395 *                                                                    CL**2
00396      IF EDIT-OPT EQUAL TO "Y"                                        CL**2
           MOVE SPACE TO TYPE-PUSE. 
           PERFORM DELETE-DECISION THRU DELETE-DECISION-EXIT. 
           IF DELETE-RC EQUAL TO 0
               GO TO DEL-WU-10. 
00421      IF CTL-ALY-VER EQUAL TO SPACES OR "FILLER "                     CL**2
00422          GO TO DEL-WU-10.                                            CL**2
00423      MOVE CTL-ALY-VER TO REL-ENTRY-NAME.                             CL**2
00424      MOVE CATAL-NAME TO REL-POINTER-NAME.                            CL**2
00425      PERFORM REL-DEL-PTR THRU REL-DEL-PTR-XIT.                       CL**2
00426      IF REL-RETURN-CODE NOT EQUAL TO 0                               CL**2
00427          MOVE CERR-850S TO DISP-MSG-ERR2                             CL**2
00428          MOVE "DEL PTR" TO DISP-MSG-ERR3                             CL**2
00429          MOVE REL-POINTER-NAME TO DISP-MSG-ERR4                      CL**2
00430          GO TO DEL-TX-ERR.                                           CL**2
00431      GO TO DEL-WU-10.                                                CL**2
00432  DEL-WU-30.                                                          CL**2
00433 *                                                                    CL**2
00434 *     DELETE DATA ENTRY                                              CL**2
00435 *                                                                    CL**2
00436      IF EDIT-OPT EQUAL TO "Y"                                        CL**2
00437          GO TO DEL-WU-110.                                           CL**2
           PERFORM DELETE-DATA-REC THRU DELETE-DATA-REC-XIT.
00439 *                                                                    CL**2
00440 *     FIND UPWARD POINTERS                                           CL**2
00441 *                                                                    CL**2
00442  DEL-WU-50.                                                          CL**2
00443      MOVE CATAL-NAME TO REL-ENTRY-NAME.                              CL**2
00444      MOVE SPACES TO REL-LAST-ENTRY-NAME.                             CL**2
00445  DEL-WU-100.                                                         CL**2
00446      MOVE "N" TO REL-ENTRY-FUNCTION.                                 CL**2
00447  DEL-WU-105.                                                         CL**2
00448      PERFORM REL-READ THRU REL-READ-XIT.                             CL**2
00449      IF REL-RETURN-CODE NOT EQUAL TO 1                               CL**2
00450          PERFORM DEL-UP-REF THRU DEL-UP-REF-XIT                      CL**2
00451          GO TO DEL-WU-100.                                           CL**2
00452 *                                                                    CL**2
00453 *     AT END DELETE REL ENTRY                                        CL**2
00454 *                                                                    CL**2
00455      MOVE CATAL-NAME TO REL-ENTRY-NAME.                              CL**2
00456      PERFORM REL-DELETE THRU REL-DELETE-XIT.                         CL**2
00457      IF REL-RETURN-CODE NOT EQUAL TO 0                               CL**2
00458          MOVE CERR-850S TO DISP-MSG-ERR2                             CL**2
00459          MOVE "DELETE" TO DISP-MSG-ERR3                              CL**2
00460          MOVE REL-ENTRY-NAME TO DISP-MSG-ERR4                        CL**2
00461          GO TO DEL-TX-ERR.                                           CL**2
00462      MOVE ALL-NAMES-LITERAL TO REL-ENTRY-NAME.                       CL**2
00463      MOVE CATAL-NAME TO REL-POINTER-NAME.                            CL**2
           MOVE SPACE TO TYPE-PUSE. 
00464      PERFORM REL-DEL-PTR THRU REL-DEL-PTR-XIT.                       CL**2
00465      IF REL-RETURN-CODE NOT EQUAL TO 0                               CL**2
00466          MOVE CERR-850S TO DISP-MSG-ERR2                             CL**2
00467          MOVE "DEL SYS" TO DISP-MSG-ERR3                             CL**2
00468          GO TO DEL-TX-ERR.                                           CL**2
00469  DEL-WU-110.                                                         CL**2
00470      MOVE CERR-030I TO DISP-MSG-ERR2.                                CL**2
00471      MOVE "DCUPD-" TO DISP-MSG-ERR1.                                 CL**2
00472          MOVE DISP-MSG-ERR TO ERR-MSG (1).                           CL**2
00473      MOVE SPACE TO FUNC.                                             CL**2
00474      ADD 1 TO TOT-ENT-DEL.                                           CL**2
00475      GO TO DEL-TX-END.                                               CL**2
00476                                                                    DCUPDDE
00477 **********************************************************           CL**2
00478 **********************************************************           CL**2
00479 *                                                                    CL**2
00480 *     D E L E T E   U S I N G                                        CL**2
00481 *                                                                    CL**2
00482 **********************************************************           CL**2
00483 **********************************************************           CL**2
00484  DEL-USING.                                                          CL**2
00485      IF HOLD-DELETE NOT EQUAL TO "USING "                            CL**2
00486          GO TO DEL-GLOBAL.                                           CL**2
00487 *                                                                    CL**2
00488 *     CHECK FOR UPWARD POINTERS                                      CL**2
00489 *                                                                    CL**2
00490      MOVE "N" TO ERROR-FND-SW.                                       CL**2
00491      MOVE SPACES TO HIERARCHY-TABLE.                                 CL**2
00492      MOVE 1 TO TAB.                                                  CL**2
00493      MOVE CATAL-NAME TO TABL-CATNAME (TAB).                          CL**2
00494  DEL-USING-10.                                                       CL**2
00495      PERFORM FIND-POS THRU FIND-POS-XIT.                             CL**2
00496  DEL-USING-20.                                                       CL**2
00497      SUBTRACT 1 FROM TAB.                                            CL**2
00498      IF TAB EQUAL TO 0 GO TO DEL-USING-25.                           CL**2
00499      PERFORM FIND-NXT-POS THRU FIND-NXT-POS-XIT.                     CL**2
00500      IF STATUS-SW NOT EQUAL TO "E"                                   CL**2
00501          GO TO DEL-USING-10.                                         CL**2
00502      IF TAB NOT EQUAL TO 1                                           CL**2
00503          GO TO DEL-USING-20.                                         CL**2
00504  DEL-USING-25.                                                       CL**2
00505      IF ERROR-FND-SW EQUAL TO "Y"                                    CL**2
00506          GO TO DEL-USING-END.                                        CL**2
00507       IF EDIT-OPT EQUAL TO "Y"                                       CL**2
00508           GO TO DEL-USING-60.                                        CL**2
00509 *                                                                    CL**2
00510 *     DELETE THE ENTRIES                                             CL**2
00511 *                                                                    CL**2
00512      MOVE SPACES TO HIERARCHY-TABLE.                                 CL**2
00513      MOVE 1 TO TAB.                                                  CL**2
00514      MOVE CATAL-NAME TO TABL-CATNAME (TAB).                          CL**2
00515  DEL-USING-30.                                                       CL**2
00516      PERFORM FIND-POS THRU FIND-POS-XIT.                             CL**2
00517      PERFORM DEL-REL-DATA.                                           CL**2
00518  DEL-USING-40.                                                       CL**2
00519      SUBTRACT 1 FROM TAB.                                            CL**2
00520      IF TAB EQUAL TO ZERO                                            CL**2
00521          GO TO DEL-USING-60.                                         CL**2
00522      PERFORM FIND-NXT-POS THRU FIND-NXT-POS-XIT.                     CL**2
00523      IF STATUS-SW NOT EQUAL TO "E"                                   CL**2
00524          GO TO DEL-USING-30.                                         CL**2
00525      IF TAB NOT EQUAL TO 1                                           CL**2
00526          PERFORM DEL-REL-DATA                                        CL**2
00527          GO TO DEL-USING-40.                                         CL**2
00528  DEL-USING-50.                                                       CL**2
00529      PERFORM DEL-REL-DATA.                                           CL**2
00530  DEL-USING-60.                                                       CL**2
00531      MOVE CERR-030I TO DISP-MSG-ERR2.                                CL**2
00532      MOVE "DCUPD-" TO DISP-MSG-ERR1.                                 CL**2
00533      MOVE DISP-MSG-ERR TO ERR-MSG (1).                               CL**2
00534      MOVE SPACE TO FUNC.                                             CL**2
00535  DEL-USING-END.                                                      CL**2
00536      GO TO DEL-TX-END.                                               CL**2
00537                                                                    DCUPDDE
00538 ************************************************************         CL**2
00539 ************************************************************         CL**2
00540 ************************************************************         CL**2
00541 *                                                                    CL**2
00542 *     D E L E T E   G L O B A L                                      CL**2
00543 *                                                                    CL**2
00544 ************************************************************         CL**2
00545 ************************************************************         CL**2
00546  DEL-GLOBAL.                                                         CL**2
00547      IF EDIT-OPT EQUAL TO "Y"                                        CL**2
00548          GO TO DEL-GLOBAL-30.                                        CL**2
00549      MOVE SPACES TO HIERARCHY-TABLE.                                 CL**2
00550      MOVE 1 TO TAB.                                                  CL**2
00551      MOVE CATAL-NAME TO TABL-CATNAME (TAB).                          CL**2
00552  DEL-GLOBAL-10.                                                      CL**2
00553      PERFORM FIND-POS THRU FIND-POS-XIT.                             CL**2
00554      PERFORM DEL-REL-DATA.                                           CL**2
00555  DEL-GLOBAL-20.                                                      CL**2
00556      SUBTRACT 1 FROM TAB.                                            CL**2
00557      IF TAB EQUAL TO 0                                               CL**2
00558          GO TO DEL-GLOBAL-30.                                        CL**2
00559      PERFORM FIND-NXT-POS THRU FIND-NXT-POS-XIT.                     CL**2
00560      IF STATUS-SW NOT EQUAL TO "E"                                   CL**2
00561          GO TO DEL-GLOBAL-10.                                        CL**2
00562      PERFORM DEL-REL-DATA.                                           CL**2
00563      IF TAB NOT EQUAL TO 1                                           CL**2
00564          GO TO DEL-GLOBAL-20.                                        CL**2
00565  DEL-GLOBAL-30.                                                      CL**2
00566      MOVE CERR-030I TO DISP-MSG-ERR2.                                CL**2
00567      MOVE "DCUPD-" TO DISP-MSG-ERR1.                                 CL**2
00568      MOVE DISP-MSG-ERR TO ERR-MSG (1).                               CL**2
00569      MOVE SPACE TO FUNC.                                             CL**2
00570      GO TO DEL-TX-END.                                               CL**2
00571 ************************************************************         CL**2
00572 ************************************************************         CL**2
00573 *                                                                    CL**2
00574 *     READ REL AND DATA - GIVEN TABLE SET                            CL**2
00575 *                                                                    CL**2
00576 ************************************************************         CL**2
00577 ************************************************************         CL**2
00578  FIND-POS.                                                           CL**2
00579      MOVE 1 TO MSG.                                                  CL**2
00580      MOVE SPACE TO STATUS-SW.                                        CL**2
00581      MOVE "N" TO REL-ENTRY-FUNCTION.                                 CL**2
00582      MOVE TABL-CATNAME (TAB) TO REL-ENTRY-NAME.                      CL**2
00583      MOVE SPACES TO REL-LAST-ENTRY-NAME.                             CL**2
00584  FIND-POS-10.                                                        CL**2
00585      PERFORM REL-READ THRU REL-READ-XIT.                             CL**2
00586      IF REL-RETURN-CODE EQUAL TO 1                                   CL**2
00587          GO TO FIND-POS-20.                                          CL**2
00588 * CHECK TABLE TO SEE IF LINE BEING CHECKED                           CL**2
00589 * HAS BEEN LOOKED AT ALLREADY.                                       CL**2
00590      IF TAB EQUAL TO 1 GO TO FIND-POS-18.                            CL**2
00591      MOVE TAB TO HOLD-SUB.                                           CL**2
00592      MOVE 1 TO TAB.                                                  CL**2
00593  FIND-POS-14.                                                        CL**2
00594      IF REL-POINTER-NAME EQUAL TO TABL-CATNAME (TAB)                 CL**2
00595          MOVE HOLD-SUB TO TAB                                        CL**2
00596          GO TO FIND-POS-10.                                          CL**2
00597      ADD 1 TO TAB.                                                   CL**2
00598      IF TAB NOT EQUAL TO HOLD-SUB GO TO FIND-POS-14.                 CL**2
00599      MOVE HOLD-SUB TO TAB.                                           CL**2
00600  FIND-POS-18.                                                        CL**2
00601      IF HOLD-DELETE EQUAL TO "GLOBAL"                                CL**2
00602          PERFORM DEL-UP-REF THRU DEL-UP-REF-XIT                      CL**2
00603          GO TO FIND-POS-10.                                          CL**2
00604      MOVE "Y" TO ERROR-FND-SW.                                       CL**2
00605      MOVE CERR-705S TO DISP-MSG-ERR2.                                CL**2
00606      MOVE "DCUPD-" TO DISP-MSG-ERR1.                                 CL**2
00607      MOVE DISP-MSG-ERR TO ERR-MSG (MSG).                             CL**2
00608      ADD 1 TO MSG.                                                   CL**2
00609      MOVE SPACES TO DISP-MSG-ERR.                                    CL**2
00610      MOVE REL-POINTER-NAME TO DISP-MSG-ERR5.                         CL**2
00611      MOVE " TO-" TO DISP-MSG-ERR6.                                   CL**2
00612      MOVE DISP-MSG-ERR TO ERR-MSG (MSG).                             CL**2
00613      ADD 1 TO MSG.                                                   CL**2
00614      MOVE SPACES TO DISP-MSG-ERR.                                    CL**2
00615      MOVE REL-ENTRY-NAME TO DISP-MSG-ERR5.                           CL**2
00616      MOVE DISP-MSG-ERR TO ERR-MSG (MSG).                             CL**2
00617      ADD 1 TO MSG.                                                   CL**2
00618      PERFORM DEL-MSG-SUB THRU DEL-MSG-SUB-XIT.                       CL**2
00619      GO TO FIND-POS-10.                                              CL**2
00620  FIND-POS-20.                                                        CL**2
00621      MOVE TABL-CATNAME (TAB) TO DATA-ENTRY-NAME.                     CL**2
00622      PERFORM READ-FIRST-DATA THRU READ-FIRST-DATA-XIT.               CL**2
00623      GO TO FIND-POS-50.                                              CL**2
00624  FIND-POS-40.                                                        CL**2
00625      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00626  FIND-POS-50.                                                        CL**2
00627      IF DATA-RETURN-CODE EQUAL TO 1                                  CL**2
00628      GO TO FIND-POS-XIT.                                             CL**2
00629      IF CAT-COMMENT EQUAL TO "*"                                     CL**2
00630          GO TO FIND-POS-40.                                          CL**2
           IF CAT-CATEGORY EQUAL TO 010 OR 300
             OR 400 OR 425 OR 450 OR 800
00632          GO TO FIND-POS-60.                                          CL**2
00633      GO TO FIND-POS-40.                                              CL**2
00634  FIND-POS-60.                                                        CL**2
           IF (DATA-HDR-ENT-ID EQUAL TO 10 OR 13) AND 
             (CAT-CATEGORY EQUAL 300 AND
              CAT-LINE-TYPE NOT EQUAL TO "A") 
               GO TO FIND-POS-40
           END-IF 
           IF CAT-CATEGORY EQUAL TO 400 
             AND (CAT-LINE-TYPE = "P" 
             AND CTL-ALY-VER = "SYSTEM")
               GO TO FIND-POS-40
           END-IF 
           IF CAT-CATEGORY EQUAL TO 425 
               IF CAT-LINE-TYPE NOT EQUAL TO "L"
                 OR (CAT-LINE-TYPE EQUAL "L"
                 AND ACC-TYPE NOT EQUAL "P")
               GO TO FIND-POS-40
               END-IF 
           END-IF 
           IF CAT-CATEGORY EQUAL TO 450 
               IF DATA-HDR-ENT-ID NOT EQUAL TO 22 AND 26
                   GO TO FIND-POS-40
               ELSE 
                   IF CAT-LINE-TYPE EQUAL "L" 
                       GO TO FIND-POS-40
                   END-IF 
               END-IF 
           END-IF 
00658      IF CTL-ALY-VER EQUAL TO SPACES OR "FILLER "                     CL**2
00659          GO TO FIND-POS-40.                                          CL**2
00660      MOVE CTL-ALY-VER TO TABL-STCNAME (TAB).                         CL**2
00661      ADD 1 TO TAB.                                                   CL**2
00662      IF TAB GREATER THAN 40                                          CL**2
00663          MOVE CERR-710S TO DISP-MSG-ERR2                             CL**2
00664          GO TO DEL-TX-ERR.                                           CL**2
00665      MOVE CTL-ALY-VER TO TABL-CATNAME (TAB).                         CL**2
00666      GO TO FIND-POS.                                                 CL**2
00667  FIND-POS-XIT. EXIT.                                                 CL**2
00668 ************************************************************         CL**2
00669 ************************************************************         CL**2
00670 *                                                                    CL**2
00671 *     REPOSITION DATA - GIVEN TABLE SET                              CL**2
00672 *                                                                    CL**2
00673 ************************************************************         CL**2
00674 ************************************************************         CL**2
00675  FIND-NXT-POS.                                                       CL**2
00676      MOVE SPACE TO STATUS-SW.                                        CL**2
00677      MOVE TABL-CATNAME (TAB) TO DATA-ENTRY-NAME.                     CL**2
00678      PERFORM READ-FIRST-DATA THRU READ-FIRST-DATA-XIT.               CL**2
00679      GO TO FIND-NXT-POS-20.                                          CL**2
00680  FIND-NXT-POS-10.                                                    CL**2
00681      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00682  FIND-NXT-POS-20.                                                    CL**2
00683      IF DATA-RETURN-CODE EQUAL TO 1                                  CL**2
00684          MOVE "E" TO STATUS-SW                                       CL**2
00685          GO TO FIND-NXT-POS-XIT.                                     CL**2
00686      IF CAT-COMMENT EQUAL TO "*"                                     CL**2
00687          GO TO FIND-NXT-POS-10.                                      CL**2
           IF CAT-CATEGORY EQUAL TO 010 OR 300 OR 
             400 OR 425 OR 450 OR 800 
00689          GO TO FIND-NXT-POS-30.                                      CL**2
00690      GO TO FIND-NXT-POS-10.                                          CL**2
00691  FIND-NXT-POS-30.                                                    CL**2
           IF (DATA-HDR-ENT-ID EQUAL TO 10 OR 13) AND 
             (CAT-CATEGORY EQUAL 300 AND
              CAT-LINE-TYPE NOT EQUAL TO "A") 
               GO TO FIND-NXT-POS-10
           END-IF 
           IF CAT-CATEGORY EQUAL TO 400 
             AND (CAT-LINE-TYPE = "P" 
             AND CTL-ALY-VER = "SYSTEM")
               GO TO FIND-NXT-POS-10
           END-IF 
           IF CAT-CATEGORY EQUAL TO 425 
               IF CAT-LINE-TYPE NOT EQUAL TO "L"
                 OR (CAT-LINE-TYPE EQUAL "L"
                 AND ACC-TYPE NOT EQUAL "P")
               GO TO FIND-NXT-POS-10
               END-IF 
           END-IF 
           IF CAT-CATEGORY EQUAL TO 450 
               IF DATA-HDR-ENT-ID NOT EQUAL TO 22 AND 26
                   GO TO FIND-NXT-POS-10
               ELSE 
                   IF CAT-LINE-TYPE EQUAL "L" 
                       GO TO FIND-NXT-POS-10
                   END-IF 
               END-IF 
           END-IF 
00692      IF CTL-ALY-VER NOT EQUAL TO TABL-STCNAME (TAB)                  CL**2
00693          GO TO FIND-NXT-POS-10.                                      CL**2
       FIND-NXT-POS-40. 
00694      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00697      IF DATA-RETURN-CODE EQUAL TO 1                                  CL**2
00698          MOVE "E" TO STATUS-SW                                       CL**2
00699          GO TO FIND-NXT-POS-XIT.                                     CL**2
00700      IF CTL-ALY-VER EQUAL TO SPACES OR "FILLER "                     CL**2
00701         GO TO FIND-NXT-POS-10.                                       CL**2
           IF CAT-CATEGORY NOT EQUAL TO 010 AND 300 
             AND 400 AND 425 AND 450 AND 800
               GO TO FIND-NXT-POS-40
           END-IF 
           IF (DATA-HDR-ENT-ID EQUAL TO 10 OR 13) AND 
             (CAT-CATEGORY EQUAL 300 AND
              CAT-LINE-TYPE NOT EQUAL TO "A") 
               GO TO FIND-NXT-POS-40
           END-IF 
           IF CAT-CATEGORY EQUAL TO 400 
             AND (CAT-LINE-TYPE = "P" 
             AND CTL-ALY-VER = "SYSTEM")
               GO TO FIND-NXT-POS-40
           END-IF 
           IF CAT-CATEGORY EQUAL TO 425 
               IF CAT-LINE-TYPE NOT EQUAL TO "L"
                 OR (CAT-LINE-TYPE EQUAL "L"
                 AND ACC-TYPE NOT EQUAL "P")
               GO TO FIND-NXT-POS-40
               END-IF 
           END-IF 
           IF CAT-CATEGORY EQUAL TO 450 
               IF DATA-HDR-ENT-ID NOT EQUAL TO 22 AND 26
                   GO TO FIND-NXT-POS-40
               ELSE 
                   IF CAT-LINE-TYPE EQUAL "L" 
                       GO TO FIND-NXT-POS-40
                   END-IF 
               END-IF 
           END-IF 
00702      MOVE CTL-ALY-VER TO TABL-STCNAME (TAB).                         CL**2
00703      ADD 1 TO TAB.                                                   CL**2
00704      MOVE CTL-ALY-VER TO TABL-CATNAME (TAB).                         CL**2
00705  FIND-NXT-POS-XIT. EXIT.                                             CL**2
00706 *****************************************************************    CL**2
00707 *****************************************************************    CL**2
00708 *                                                                    CL**2
00709 *     DELETE UPWARD REF AND THE STC LINE                             CL**2
00710 *                                                                    CL**2
00711 *****************************************************************    CL**2
00712 *****************************************************************    CL**2
00713 * WILL READ HIGHER LEVEL DATA ENTRY AND DELETE                       CL**2
00714 * STC LINES AND REL FILE POINTERS TO THEM.                           CL**2
00715  DEL-UP-REF.                                                         CL**2
00716      MOVE SPACES TO O-DATA-RECORD.                                   CL**2
00717      MOVE REL-POINTER-NAME TO DATA-ENTRY-NAME.                       CL**2
00718      PERFORM READ-FIRST-DATA THRU READ-FIRST-DATA-XIT.               CL**2
00719      MOVE DATA-HEADER TO O-DATA-HEADER.                              CL**2
00720      MOVE 1 TO D-OUT.                                                CL**2
00721      MOVE ZERO TO O-DATA-NEXT-REC.                                   CL**2
00722      ADD 1 TO O-DATA-HDR-USAGE.                                      CL**2
00723      MOVE USER-OPT TO O-DATA-HDR-NAME-LST.                           CL**2
00724      GO TO DEL-UP-REF-20.                                            CL**2
00725  DEL-UP-REF-10.                                                      CL**2
00726      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00727  DEL-UP-REF-20.                                                      CL**2
00728      IF DATA-RETURN-CODE EQUAL TO 1                                  CL**2
               GO TO DEL-UP-REF-35. 
00730      IF CAT-COMMENT EQUAL TO "*"                                     CL**2
00731          PERFORM WRITE-DATA-LINE THRU WRITE-DATA-LINE-XIT            CL**2
00732          GO TO DEL-UP-REF-10.                                        CL**2
           IF CAT-CATEGORY EQUAL TO 010 OR 800
00734          GO TO DEL-UP-REF-25.                                        CL**2
           IF CAT-CATEGORY EQUAL TO 300 
               IF DATA-HDR-ENT-ID  EQUAL TO 10 OR 13
                   PERFORM STC-DELETE THRU STC-DELETE-EXIT
                   GO TO DEL-UP-REF-20
               ELSE 
                   GO TO DEL-UP-REF-25
               END-IF 
           END-IF 
           IF CAT-CATEGORY EQUAL 400
               IF CAT-LINE-TYPE EQUAL "P" 
                   IF CTL-ALY-VER NOT EQUAL "SYSTEM"
                       GO TO DEL-UP-REF-25
                   END-IF 
               ELSE 
                   IF CAT-LINE-TYPE EQUAL "R" 
                       PERFORM PROCESS-RC-DELETE
                          THRU PROCESS-RC-DELETE-EXIT 
                       GO TO DEL-UP-REF-20
                   END-IF 
               END-IF 
           END-IF 
           IF CAT-CATEGORY EQUAL 425
             AND CAT-LINE-TYPE EQUAL "L"
             AND ACC-TYPE EQUAL "P" 
               GO TO DEL-UP-REF-25
           END-IF 
           IF CAT-CATEGORY EQUAL TO 450 AND 
             (DATA-HDR-ENT-ID EQUAL TO 22 OR 26)
             AND CAT-LINE-TYPE NOT EQUAL "L"
               GO TO DEL-UP-REF-25. 
           IF CAT-CATEGORY EQUAL TO 500 
               IF CAT-LINE-TYPE NOT EQUAL TO "C"
                   PERFORM AREAKEY-DELETE THRU AREAKEY-DELETE-EXIT
                   GO TO DEL-UP-REF-20
               END-IF 
           END-IF 
           IF CAT-CATEGORY EQUAL TO 525 
               PERFORM SSREL-DELETE THRU SSREL-DELETE-EXIT
               GO TO DEL-UP-REF-20
           END-IF 
           IF CAT-CATEGORY EQUAL TO 550 
               PERFORM CONSTRAINT-DELETE THRU CONSTRAINT-DELETE-EXIT
               GO TO DEL-UP-REF-20
           END-IF 
           IF CAT-CATEGORY EQUAL TO 575 
               IF CAT-LINE-TYPE NOT EQUAL TO "A"
                   PERFORM JOIN-DELETE THRU JOIN-DELETE-EXIT
                   GO TO DEL-UP-REF-20
               END-IF 
           END-IF 
00735      PERFORM WRITE-DATA-LINE THRU WRITE-DATA-LINE-XIT.               CL**2
00736      GO TO DEL-UP-REF-10.                                            CL**2
00737  DEL-UP-REF-25.                                                      CL**2
00738      IF CTL-ALY-VER NOT EQUAL TO REL-ENTRY-NAME                      CL**2
               PERFORM WRITE-DATA-LINE THRU WRITE-DATA-LINE-XIT 
               GO TO DEL-UP-REF-10
           END-IF 
00741  DEL-UP-REF-30.                                                      CL**2
00742      PERFORM REL-DEL-PTR THRU REL-DEL-PTR-XIT.                       CL**2
               MOVE 1 TO MSG. 
      *    NO CHECK IS MADE FOR ERROR IN RETURN CODE SINCE
      *    SOME FIELDS MAY CONTAIN A DATA NAME RATHER THAN
      *    A CATNAME. 
      * 
           IF REL-RETURN-CODE EQUAL 0 
               IF HOLD-DELETE EQUAL TO "WHEREUSED"
                   MOVE CERR-040I TO DISP-MSG-ERR2
               ELSE 
                   MOVE CERR-050I TO DISP-MSG-ERR2
                   MOVE REL-ENTRY-NAME TO DISP-MSG-ERR5 
               END-IF 
               MOVE "DCUPD-" TO DISP-MSG-ERR1 
               MOVE DISP-MSG-ERR TO ERR-MSG (MSG) 
               ADD 1 TO MSG 
               MOVE DATA-ENTRY-NAME TO MSG-POS5 (MSG) 
               ADD 1 TO MSG 
               PERFORM DEL-MSG-SUB THRU DEL-MSG-SUB-XIT 
           END-IF 
           IF TRADE EQUAL "Y" 
               MOVE SAVE-NAME TO REL-ENTRY-NAME 
               MOVE "N" TO TRADE
           END-IF 
       DEL-UP-REF-32. 
           GO TO DEL-UP-REF-10. 
       DEL-UP-REF-35. 
00760      PERFORM CLOSE-DATA-REC THRU CLOSE-DATA-REC-XIT.                 CL**2
00761      ADD 1 TO TOT-ENT-CHG.                                           CL**2
00762  DEL-UP-REF-XIT. EXIT.                                               CL**2
00763 ************************************************************      DCUPDDEL
00764 *                                                                 DCUPDDEL
00765 *     D U M P   F U L L   M E S S A G E   T A B L E                  CL**2
00766 *                                                                 DCUPDDEL
00767 ************************************************************      DCUPDDEL
00768  DEL-MSG-SUB.                                                     DCUPDDEL
00769      IF MSG EQUAL TO 1 GO TO DEL-MSG-SUB-XIT.                        CL**2
00770      MOVE SPACES TO ERR-MSG (MSG).                                   CL**2
00771      MOVE "D" TO FUNC.                                               CL**2
           EXIT PROGRAM.
00773  DEL-MSG-SUB-IN.                                                  DCUPDDEL
00774      MOVE 1 TO MSG.                                                  CL**2
00775      MOVE SPACES TO MESSAGE-TABLE.                                   CL**2
00776      MOVE SPACE TO FUNC.                                             CL**2
00777  DEL-MSG-SUB-XIT. EXIT.                                           DCUPDDEL
00778 ********************************************************          DCUPDDEL
00779 *                                                                 DCUPDDEL
00780 *     E R R O R   P R O C E S S I N G                             DCUPDDEL
00781 *                                                                 DCUPDDEL
00782 ***************************************************************   DCUPDDEL
00783  DEL-TX-ERR.                                                      DCUPDDEL
00784      MOVE "DCUPD-" TO DISP-MSG-ERR1.                                 CL**2
00785      MOVE DISP-MSG-ERR TO ERR-MSG (1).                               CL**2
00786      MOVE SPACES TO DISP-MSG-ERR.                                    CL**2
00787       MOVE HIGH-VALUE TO FUNC.                                    DCUPDDEL
00788  DEL-TX-END.                                                      DCUPDDEL
00789       CLOSE MAST1.                                                DCUPDDEL
00790       CLOSE MAST2.                                                DCUPDDEL
           EXIT PROGRAM.
00792 *****************************************************             DCUPDDEL
00793 *                                                                 DCUPDDEL
00794 *     FIND NON BLANK SEARCH                                       DCUPDDEL
00795 *                                                                 DCUPDDEL
00796 ****************************************************              DCUPDDEL
00797  FIND-NON-BLANK.                                                  DCUPDDEL
00798      MOVE SPACE TO STATUS-SW.                                     DCUPDDEL
00799  FIND-NON-BLANK-10.                                               DCUPDDEL
00800      ADD 1 TO TX.                                                 DCUPDDEL
00801      IF TX-POS (TX) NOT EQUAL TO SPACE                            DCUPDDEL
00802          GO TO FIND-NON-BLANK-XIT.                                DCUPDDEL
00803      IF TX LESS THAN 73                                           DCUPDDEL
00804          GO TO FIND-NON-BLANK-10.                                 DCUPDDEL
00805      MOVE "E" TO STATUS-SW.                                       DCUPDDEL
00806  FIND-NON-BLANK-XIT. EXIT.                                        DCUPDDEL
00807 *******************************************************           DCUPDDEL
00808 *                                                                 DCUPDDEL
00809 *     FIND A CHARACTER WHILE MOVING TO VAL-AREA                   DCUPDDEL
00810 *                                                                 DCUPDDEL
00811 ********************************************************          DCUPDDEL
00812  FIND-CHAR.                                                       DCUPDDEL
00813      MOVE SPACES TO VAL-AREA.                                     DCUPDDEL
00814      MOVE 1 TO VA.                                                DCUPDDEL
00815  FIND-CHAR-10.                                                    DCUPDDEL
00816      MOVE TX-POS (TX) TO VAL (VA).                                DCUPDDEL
00817      ADD 1 TO TX VA.                                              DCUPDDEL
00818      IF TX GREATER THAN 72                                        DCUPDDEL
00819          GO TO FIND-CHAR-XIT.                                     DCUPDDEL
00820      IF TX-POS (TX) NOT EQUAL TO STATUS-SW                        DCUPDDEL
00821          GO TO FIND-CHAR-10.                                      DCUPDDEL
00822  FIND-CHAR-XIT. EXIT.                                             DCUPDDEL
00823                                                                    DCUPDDE
00824 ************************************************************         CL**2
00825 *                                                                    CL**2
00826 *     MOVE LINE TO OUPPUT RECORD - DATA FILE                         CL**2
00827 *                                                                    CL**2
00828 ****************************************************                 CL**2
00829  WRITE-DATA-LINE.                                                    CL**2
00830      IF EDIT-OPT EQUAL TO "Y"                                        CL**2
00831          GO TO WRITE-DATA-LINE-XIT.                                  CL**2
00832      MOVE D-OUT TO HOLD-USED-BYTES.                                  CL**2
00833      ADD CAT-LENGTH TO HOLD-USED-BYTES.                              CL**2
           ADD 15 TO HOLD-USED-BYTES. 
           ADD 6 TO HOLD-USED-BYTES.
00836      IF HOLD-USED-BYTES GREATER THAN DATA-LIMIT                      CL**2
00837          GO TO WRITE-DATA-NEW.                                       CL**2
00838      MOVE 1 TO WK.                                                   CL**2
           SUBTRACT 6 FROM HOLD-USED-BYTES. 
00840  WRITE-DATA-LINE-10.                                                 CL**2
00841      MOVE CAT-WK-BYTE (WK) TO O-DATA-DETAIL (D-OUT).                 CL**2
00842      ADD 1 TO WK  D-OUT.                                             CL**2
00843      IF D-OUT NOT EQUAL TO HOLD-USED-BYTES                           CL**2
00844          GO TO WRITE-DATA-LINE-10.                                   CL**2
00845      GO TO WRITE-DATA-LINE-XIT.                                      CL**2
00846  WRITE-DATA-NEW.                                                     CL**2
           MOVE "*" TO STATUS-SW. 
           PERFORM SET-END-DAT. 
00858      PERFORM O-DATAALG.                                              CL**2
00859      PERFORM REW-DATA-FILE.                                          CL**2
00860  WRITE-DATA-LINE-30.                                                 CL**2
00861      ADD 1 TO O-DATA-NEXT-REC.                                       CL**2
00862      MOVE 1 TO D-OUT.                                                CL**2
00865      MOVE SPACES TO O-DATA-RECORD.                                   CL**2
00866      MOVE DATA-HEADER TO O-DATA-HEADER.                              CL**2
           MOVE HOLD-DATA-RECORD TO DATA-RECORD.                        000140
00867      GO TO WRITE-DATA-LINE.                                          CL**2
00872  WRITE-DATA-LINE-XIT.                                                CL**2
00873      EXIT.                                                           CL**2
00874 *************************************************************        CL**2
00875 *                                                                    CL**2
00876 *     CLOSE RECORD - DATA FILE                                       CL**2
00877 *                                                                    CL**2
00878 *************************************************************        CL**2
00879  CLOSE-DATA-REC.                                                     CL**2
00880      MOVE HIGH-VALUE TO STATUS-SW.                                   CL**2
           PERFORM SET-END-DAT. 
00882      IF O-DATA-NEXT-REC EQUAL TO DATA-NEXT-REC                       CL**2
00883          GO TO CLOSE-DATA-REC-20.                                    CL**2
00884      PERFORM O-DATAALG.                                              CL**2
00886      PERFORM REW-DATA-FILE.                                          CL**2
00887  CLOSE-DATA-REC-10.                                                  CL**2
00888      ADD 1 TO O-DATA-NEXT-REC.                                       CL**2
00889      PERFORM O-DATAALG.                                              CL**2
           MOVE O-DATA-KEY TO DATA-KEY. 
           PERFORM DELETE-DATA-REC-20.
00893      IF O-DATA-NEXT-REC EQUAL TO DATA-NEXT-REC                       CL**2
00894          GO TO CLOSE-DATA-REC-XIT.                                   CL**2
00895      GO TO CLOSE-DATA-REC-10.                                        CL**2
00896  CLOSE-DATA-REC-20.                                                  CL**2
00897      PERFORM O-DATAALG.                                              CL**2
00898      PERFORM REW-DATA-FILE.                                          CL**2
00899  CLOSE-DATA-REC-XIT. EXIT.                                           CL**2
      **************************************************************
      **************************************************************
      * 
      * 
      *        DELETE RECORD  -  DATA FULL
       DELETE-DATA-REC. 
           PERFORM DATAALG THRU DATAALG-XIT.
           IF DATA-NEXT-REC = 0 PERFORM DELETE-DATA-REC-20
               GO TO DELETE-DATA-REC-XIT. 
       DELETE-DATA-REC-10.
           PERFORM DELETE-DATA-REC-20.
           SUBTRACT 1 FROM DATA-NEXT-REC. 
           GO TO DELETE-DATA-REC. 
       DELETE-DATA-REC-20.
           DELETE MAST1 INVALID KEY 
               MOVE CERR-800S TO DISP-MSG-ERR2
           MOVE "DELETE" TO DISP-MSG-ERR3 
           MOVE DATA-ENTRY-NAME TO DISP-MSG-ERR4
           GO TO DEL-TX-ERR.
       DELETE-DATA-REC-XIT. 
           EXIT.
00900 ************************************************************         CL**2
00901 *                                                                    CL**2
00902 *     HOUSE KEEPING  - DATA FILE                                     CL**2
00903 *                                                                    CL**2
00904 *************************************************************        CL**2
       SET-END-DAT. 
00906      MOVE STATUS-SW TO O-DATA-DETAIL (D-OUT).                        CL**2
00907      ADD 1 TO D-OUT.                                                 CL**2
00908      MOVE STATUS-SW TO O-DATA-DETAIL (D-OUT).                        CL**2
00909      ADD 1 TO D-OUT.                                                 CL**2
00910      MOVE STATUS-SW TO O-DATA-DETAIL (D-OUT).                        CL**2
00911  O-DATAALG.                                                          CL**2
           MOVE DATA-ENTRY-NAME TO O-DATA-REC-ID. 
           MOVE O-DATA-NEXT-REC TO O-DATA-REC-ID-TRLR.
00915      MOVE 1 TO BLNK-SUB.                                             CL**2
00917  REW-DATA-FILE.                                                      CL**2
00918      REWRITE DATA-RECORD FROM O-DATA-RECORD                          CL**2
00919          INVALID KEY                                                 CL**2
00920          MOVE CERR-800S TO DISP-MSG-ERR2                             CL**2
00921           MOVE "REWRITE" TO DISP-MSG-ERR3                            CL**2
00922           MOVE DATA-ENTRY-NAME TO DISP-MSG-ERR4                      CL**2
00923           GO TO DEL-TX-ERR.                                          CL**2
00924  READ-DATA-FILE.                                                     CL**2
00925       READ MAST1 INVALID KEY                                         CL**2
00926          MOVE CERR-800S TO DISP-MSG-ERR2                             CL**2
00927           MOVE "READ" TO DISP-MSG-ERR3                               CL**2
00928           MOVE DATA-ENTRY-NAME TO DISP-MSG-ERR4                      CL**2
00929           GO TO DEL-TX-ERR.                                          CL**2
00930 ********************************************************             CL**2
00931 *                                                                    CL**2
00932 *     DELETE REL DATA AND SYS                                        CL**2
00933 *                                                                    CL**2
00934 ********************************************************             CL**2
00935  DEL-REL-DATA.                                                       CL**2
00936       MOVE DATA-ENTRY-NAME TO REL-ENTRY-NAME.                        CL**2
00937      PERFORM REL-DELETE THRU REL-DELETE-XIT.                         CL**2
00938      IF REL-RETURN-CODE NOT EQUAL TO ZERO                            CL**2
00939          MOVE CERR-850S TO DISP-MSG-ERR2                             CL**2
00940          MOVE "DELETE" TO DISP-MSG-ERR3                              CL**2
00941          MOVE REL-ENTRY-NAME TO DISP-MSG-ERR4                        CL**2
               MOVE "DCUPD-" TO DISP-MSG-ERR1 
               MOVE DISP-MSG-ERR TO ERR-MSG (MSG) 
               ADD 1 TO MSG.
00943      MOVE 1 TO D-OUT.                                                CL**2
00946      MOVE ZEROS TO O-DATA-NEXT-REC.                                  CL**2
           PERFORM DELETE-DATA-REC THRU DELETE-DATA-REC-XIT.
00948      MOVE REL-ENTRY-NAME TO REL-POINTER-NAME.                        CL**2
00949      MOVE ALL-NAMES-LITERAL TO REL-ENTRY-NAME.                       CL**2
           MOVE SPACES TO TYPE-PUSE.
00950      PERFORM REL-DEL-PTR THRU REL-DEL-PTR-XIT.                       CL**2
00951      IF REL-RETURN-CODE NOT EQUAL TO ZERO                            CL**2
00952          MOVE CERR-850S TO DISP-MSG-ERR2                             CL**2
00953          MOVE "DEL SYS" TO DISP-MSG-ERR3                             CL**2
               MOVE "DCUPD-" TO DISP-MSG-ERR1 
               MOVE DISP-MSG-ERR TO ERR-MSG (MSG) 
               ADD 1 TO MSG.
00955      MOVE SPACES TO DISP-MSG-ERR.                                    CL**2
00956      MOVE "DCUPD-" TO DISP-MSG-ERR1.                                 CL**2
00957      MOVE CERR-060I TO DISP-MSG-ERR2.                                CL**2
00958      MOVE DATA-ENTRY-NAME TO DISP-MSG-ERR5.                          CL**2
00959      MOVE DISP-MSG-ERR TO ERR-MSG (MSG).                             CL**2
00960      ADD 1 TO MSG.                                                   CL**2
00961      PERFORM DEL-MSG-SUB THRU DEL-MSG-SUB-XIT.                       CL**2
00962      ADD 1 TO TOT-ENT-DEL.                                           CL**2
      * 
      *********************************************************** 
      *    DELETE-DECISION
      * 
      *    THIS PROCEDURE DETERMINES FROM ENTITY TYPE,CATEGORY
      *    AND LINE TYPE WHETHER POINTERS SHOULD BE DELETED 
      *    AND WHETHER SPECIAL PROCESSING IS REQUIRED.
      * 
      *    ON RETURN -
      *    DELETE-RC = 0, PROCESSING NOT NEEDED 
      *                   OR ALREADY DONE 
      *              = 1, NAME IS IN FIRST POSITION (CTL-ALY-VER) 
      ************************************************************* 
       DELETE-DECISION. 
           IF CAT-CATEGORY EQUAL TO 010 OR 800
               MOVE 1 TO DELETE-RC
               GO TO DELETE-DECISION-EXIT.
           IF ENT-ID EQUAL TO 10 OR 13
             AND CAT-CATEGORY EQUAL TO 300
      * 
      *    GROUP OR RECORD ENTITY 
      *    OCCURS LINES OF STRUCTURE CATEGORY 
      * 
               IF STC-LINE-TYPE EQUAL TO "O"
                   PERFORM DEL-OCCURS-POINTERS THRU 
                       DEL-OCCURS-POINTERS-EXIT 
                   MOVE 0 TO DELETE-RC
                   GO TO DELETE-DECISION-EXIT 
               END-IF 
      * 
      *    DEPEND QUALIFIER LINE
      * 
               IF STC-LINE-TYPE EQUAL TO "D"
                   PERFORM DEL-DEPEND-QUALS THRU
                       DEL-DEPEND-QUALS-EXIT
                   MOVE 0 TO DELETE-RC
                   GO TO DELETE-DECISION-EXIT 
               END-IF 
      * 
      *    OCCURS KEY LINE
      * 
               IF STC-LINE-TYPE EQUAL TO "K"
                   MOVE "C" TO TYPE-PUSE
                   MOVE 1 TO DELETE-RC
                   GO TO DELETE-DECISION-EXIT 
               END-IF 
      * 
      *    RENAME AND THRU LINES
      * 
               IF STC-LINE-TYPE EQUAL TO "R" OR "T" 
                   PERFORM DEL-RE-POINTERS THRU DEL-RE-POINTERS-EXIT
                   MOVE 0 TO DELETE-RC
                   GO TO DELETE-DECISION-EXIT 
               END-IF 
      * 
      *    RENAME AND THRU QUALIFIER LINES
      * 
               IF  STC-LINE-TYPE EQUAL "Q" OR  "2"
                   PERFORM DEL-QUAL-POINTERS THRU DEL-QUAL-POINTERS-EXIT
                   MOVE 0 TO DELETE-RC
                   GO TO DELETE-DECISION-EXIT 
               END-IF 
      * 
      *    STANDARD STRUCTURE LINE
      * 
               IF STC-LINE-TYPE EQUAL TO "A"
                   MOVE 1 TO DELETE-RC
                   GO TO DELETE-DECISION-EXIT 
               END-IF 
           END-IF 
      * 
      *    STC LINES FOR ALL OTHER ENTITIES 
      * 
           IF CAT-CATEGORY EQUAL "300"
               MOVE 1 TO DELETE-RC
               GO TO DELETE-DECISION-EXIT 
           END-IF 
      * 
      *    PROCESS CATEGORY 
      * 
           IF CAT-CATEGORY EQUAL TO 400 
               IF CAT-LINE-TYPE EQUAL TO "R"
                   PERFORM DELETE-POINTERS THRU DELETE-POINTERS-EXIT
                   MOVE 0 TO DELETE-RC
               ELSE 
                   IF CAT-LINE-TYPE EQUAL "P" 
                     AND CTL-ALY-VER EQUAL "SYSTEM" 
                       MOVE 0 TO DELETE-RC
                   ELSE 
                       MOVE 1 TO DELETE-RC
                   END-IF 
               END-IF 
               GO TO DELETE-DECISION-EXIT 
           END-IF 
      * 
      *    ACCESS CATEGORY
  
           IF CAT-CATEGORY EQUAL TO 425 
               IF CAT-LINE-TYPE EQUAL "L" 
                 AND ACC-TYPE EQUAL "P" 
                   MOVE 1 TO DELETE-RC
               ELSE 
                   MOVE 0 TO DELETE-RC
               END-IF 
               GO TO DELETE-DECISION-EXIT 
           END-IF 
      * 
      *    MDINFO CATEGORY
      *    AREA AND SCHEMA ENTITY 
      * 
           IF CAT-CATEGORY EQUAL TO 450 
               IF (ENT-ID EQUAL TO 22 OR 26)
                 AND CAT-LINE-TYPE NOT EQUAL "L"
                   MOVE 1 TO DELETE-RC
               ELSE 
                   MOVE 0 TO DELETE-RC
               END-IF 
               GO TO DELETE-DECISION-EXIT 
           END-IF 
      * 
      *    AREAKEY CATEGORY 
      * 
           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 
               MOVE 0 TO DELETE-RC
               GO TO DELETE-DECISION-EXIT 
           END-IF 
      * 
      *    SSREL CATEGORY 
      * 
           IF CAT-CATEGORY EQUAL TO 525 
      * 
      *    RESTRICT NAME LINE 
      * 
               IF CAT-LINE-TYPE EQUAL TO "R"
                   PERFORM RESTRICT-DEL THRU RESTRICT-DEL-EXIT
               ELSE 
      * 
      *    RESTRICT IDS 
      * 
                   IF CAT-LINE-TYPE EQUAL TO "I"
                       PERFORM DEL-ID-PTRS THRU DEL-ID-PTRS-EXIT
                   ELSE 
      * 
      *    RESTRICT QUALIFIERS ALL LINES
      * 
                       PERFORM DEL-QUAL-PTRS THRU DEL-QUAL-PTRS-EXIT
                   END-IF 
               END-IF 
               MOVE 0 TO DELETE-RC
               GO TO DELETE-DECISION-EXIT 
           END-IF 
      * 
      *    BOND CATEGORY
      * 
           IF CAT-CATEGORY EQUAL TO 550 
      * 
      *    CONSTRAINT ID
      * 
               IF CAT-LINE-TYPE EQUAL TO "N"
                   PERFORM DEL-CONSTRAINT-PTR THRU
                       DEL-CONSTRAINT-PTR-EXIT
                   MOVE 0 TO DELETE-RC
                   GO TO DELETE-DECISION-EXIT 
               END-IF 
      * 
      *    DEPEND LINE
      * 
               IF CAT-LINE-TYPE EQUAL TO "O"
                   PERFORM DELETE-POINTERS THRU DELETE-POINTERS-EXIT
                   MOVE 0 TO DELETE-RC
                   GO TO DELETE-DECISION-EXIT 
               END-IF 
           END-IF 
      * 
      *    JOINS 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 
               MOVE 0 TO DELETE-RC
               GO TO DELETE-DECISION-EXIT 
           END-IF 
           IF CAT-CATEGORY NOT EQUAL TO 300 
               MOVE 0 TO DELETE-RC
               GO TO DELETE-DECISION-EXIT 
           END-IF 
       DELETE-DECISION-EXIT.
           EXIT.
      * 
      * 
      * 
      **************************************************************
      * 
      *    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 REL-ENTRY-NAME
               PERFORM CHECK-NAME THRU CHECK-NAME-EXIT
           END-IF 
           IF STC-DEPEND IS NOT EQUAL TO SPACES 
               MOVE STC-DEPEND TO REL-ENTRY-NAME
               PERFORM CHECK-NAME THRU CHECK-NAME-EXIT
           END-IF 
           IF STC-DEP-QUAL-FLAG EQUAL ZERO
               GO TO DEL-OCCURS-POINTERS-EXIT.
           IF STC-DEPEND-QUAL1 NOT EQUAL TO SPACES
               MOVE STC-DEPEND-QUAL1 TO REL-ENTRY-NAME
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
           IF STC-DEPEND-QUAL2 NOT EQUAL TO SPACES
               MOVE STC-DEPEND-QUAL2 TO REL-ENTRY-NAME
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
       DEL-OCCURS-POINTERS-EXIT.
           EXIT.
       DEL-DEPEND-QUALS.
           IF STC-DEPEND-QUAL3 NOT EQUAL TO SPACES
               MOVE STC-DEPEND-QUAL3 TO REL-ENTRY-NAME
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
           IF STC-DEPEND-QUAL4 NOT EQUAL TO SPACES
               MOVE STC-DEPEND-QUAL4 TO REL-ENTRY-NAME
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
           IF STC-DEPEND-QUAL5 NOT EQUAL TO SPACES
               MOVE STC-DEPEND-QUAL5 TO REL-ENTRY-NAME
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
       DEL-DEPEND-QUALS-EXIT. 
           EXIT.
       DEL-RE-POINTERS. 
           IF STC-NAME NOT EQUAL TO SPACES
               MOVE STC-NAME TO REL-ENTRY-NAME
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
           IF STC-QUAL1 NOT EQUAL TO SPACES 
               MOVE STC-QUAL1 TO REL-ENTRY-NAME 
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
           IF STC-QUAL2 NOT EQUAL TO SPACES 
               MOVE STC-QUAL2 TO REL-ENTRY-NAME 
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
           IF STC-QUAL3 NOT EQUAL TO SPACES 
               MOVE STC-QUAL3 TO REL-ENTRY-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 REL-ENTRY-NAME 
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
           IF STC-QUAL5 NOT EQUAL TO SPACES 
               MOVE STC-QUAL5 TO REL-ENTRY-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 REL-ENTRY-NAME
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
           IF GEN-QUAL NOT EQUAL TO SPACES
               MOVE GEN-QUAL TO REL-ENTRY-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 REL-ENTRY-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 REL-ENTRY-NAME 
               PERFORM CHECK-NAME THRU CHECK-NAME-EXIT
           END-IF 
           IF ID2 NOT EQUAL TO SPACES 
             AND ID2-TYPE EQUAL "C" 
               MOVE ID2 TO REL-ENTRY-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 REL-ENTRY-NAME
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
           IF SS-QUAL2 NOT EQUAL TO SPACES
               MOVE SS-QUAL2 TO REL-ENTRY-NAME
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
           IF SS-QUAL3 NOT EQUAL TO SPACES
               MOVE SS-QUAL3 TO REL-ENTRY-NAME
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
       DEL-QUAL-PTRS-EXIT.
           EXIT.
       DEL-CONSTRAINT-PTR.
           IF CON-CATNAME NOT EQUAL TO SPACES 
               MOVE CON-CATNAME TO REL-ENTRY-NAME 
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
           IF CON-QUAL NOT EQUAL TO SPACES
               MOVE CON-QUAL TO REL-ENTRY-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 REL-ENTRY-NAME 
               PERFORM FIX-POINTERS THRU FIX-POINTERS-EXIT
           END-IF 
           IF JOIN-QUAL1 NOT EQUAL TO SPACES
               MOVE JOIN-QUAL1 TO REL-ENTRY-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 REL-ENTRY-NAME.
      * 
       CHECK-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 CATAL-NAME TO REL-POINTER-NAME. 
           MOVE "X" TO TYPE-CATAL-NAME. 
           MOVE "C" TO TYPE-PUSE. 
           PERFORM REL-DEL-PTR THRU REL-DEL-PTR-XIT.
           IF REL-RETURN-CODE NOT EQUAL TO 0
               MOVE CERR-850S TO DISP-MSG-ERR2
               MOVE "DEL PTR" TO DISP-MSG-ERR3
               GO TO DEL-TX-ERR 
           END-IF 
       FIX-POINTERS-EXIT. 
           EXIT.
      * 
      *    THE FOLLOWING PROCEDURES DELETE ACTUAL DATA BLOCKS 
      *    OR IN SOME CASES JUST MOVE SPACES TO A NAME FIELD. 
      *    IF A DATANAME IS REMOVED, ALL QUALIFIERS ARE ALSO
      *    DELETED   IF A QUALIFIER MATCHES CATAL-NAME, SPACES
      *    ARE MOVED TO THAT FIELD. 
      * 
      *    STC-DELETE IS FOR ONLY STRUCTURE LINES FOR GROUPS AND
      *    RECORDS.  IF A THE STRUCTURE LINE TYPE "A" IS EQUAL
      *    TO THE NAME, THEN ALL STRUCTURE LINES WILL BE DELETED
      *    UNTIL A NEW LINETYPE "A" IS FOUND.  (ID1FLAG IS SET
      *    TO "Y" TO INDICATE THIS SITUATION.  IF THE NAME IS 
      *    FOUND AS JUST PART OF A CLAUSE THEN SPACES ARE 
      *    MOVED TO THE NAME AND THE LINE IS REWRITTEN. 
      * 
       STC-DELETE.
           MOVE "F" TO FINIS
           MOVE "N" TO ID1FLAG. 
           MOVE "N" TO TRADE. 
           PERFORM STC-LINE-DELETE THRU STC-LINE-DELETE-EXIT
             VARYING COUNTER FROM 1 BY 1 UNTIL FINIS EQUAL "T"
       STC-DELETE-EXIT. 
           EXIT.
       STC-LINE-DELETE. 
               IF CAT-LINE-TYPE  EQUAL TO "A" OR SPACES 
                   IF CTL-ALY-VER EQUAL TO REL-ENTRY-NAME 
                       MOVE "X" TO TYPE-PUSE
                       PERFORM DEL-UP-REF-30
                       MOVE "Y" TO ID1FLAG
                   ELSE 
                       PERFORM WRITE-DATA-LINE THRU WRITE-DATA-LINE-XIT 
                   END-IF 
                   GO TO STC-DELETE-READ
               END-IF 
               IF CAT-LINE-TYPE EQUAL "O" 
                   IF STC-TO EQUAL TO REL-ENTRY-NAME
                     OR (ID1FLAG EQUAL TO "Y" 
                     AND STC-TO NOT NUMERIC)
                       MOVE SPACES TO STC-TO
                       MOVE "C" TO TYPE-PUSE
                       PERFORM DEL-UP-REF-30
                   END-IF 
                   IF STC-DEPEND EQUAL TO REL-ENTRY-NAME
                     OR ID1FLAG EQUAL TO "Y"
                       MOVE SPACES TO STC-DEPEND
                       MOVE "C" TO TYPE-PUSE
                       PERFORM DEL-UP-REF-30
                   END-IF 
                   IF STC-DEP-QUAL-FLAG GREATER THAN 0
                       IF STC-DEPEND-QUAL1 NOT EQUAL TO REL-ENTRY-NAME
                           IF ID1FLAG EQUAL "Y" 
                             AND STC-DEPEND-QUAL1 NOT EQUAL SPACES
                               MOVE REL-ENTRY-NAME TO SAVE-NAME 
                               MOVE STC-DEPEND-QUAL1 TO REL-ENTRY-NAME
                               MOVE "Y" TO TRADE
                           END-IF 
                       END-IF 
                       IF STC-DEPEND-QUAL1 EQUAL TO REL-ENTRY-NAME
                         OR TRADE EQUAL TO "Y"
                           MOVE SPACES TO STC-DEPEND-QUAL1
                           MOVE "C" TO TYPE-PUSE
                           PERFORM DEL-UP-REF-30
                       END-IF 
                       IF STC-DEPEND-QUAL2 NOT EQUAL TO REL-ENTRY-NAME
                           IF ID1FLAG EQUAL "Y" 
                             AND STC-DEPEND-QUAL2 NOT EQUAL SPACES
                               MOVE REL-ENTRY-NAME TO SAVE-NAME 
                               MOVE STC-DEPEND-QUAL2 TO REL-ENTRY-NAME
                               MOVE "Y" TO TRADE
                           END-IF 
                       IF STC-DEPEND-QUAL2 EQUAL TO REL-ENTRY-NAME
                         OR TRADE EQUAL TO "Y"
                           MOVE SPACES TO STC-DEPEND-QUAL2
                           MOVE "C" TO TYPE-PUSE
                           PERFORM DEL-UP-REF-30
                       END-IF 
                   END-IF 
                   IF (STC-TO EQUAL SPACES
                     AND STC-DEPEND EQUAL SPACES) 
                     OR ID1FLAG EQUAL "Y" 
                       GO STC-DELETE-READ 
                   ELSE 
                       PERFORM WRITE-DATA-LINE THRU WRITE-DATA-LINE-XIT 
                   END-IF 
               END-IF 
               IF CAT-LINE-TYPE EQUAL "D" 
                   IF STC-DEPEND-QUAL3 NOT EQUAL TO REL-ENTRY-NAME
                       IF ID1FLAG EQUAL "Y" 
                         AND STC-DEPEND-QUAL3 NOT EQUAL TO SPACES 
                           MOVE REL-ENTRY-NAME TO SAVE-NAME 
                           MOVE STC-DEPEND-QUAL3 TO REL-ENTRY-NAME
                           MOVE "Y" TO TRADE
                       END-IF 
                   END-IF 
                   IF STC-DEPEND-QUAL3 EQUAL TO REL-ENTRY-NAME
                     OR TRADE EQUAL TO "Y"
                       MOVE SPACES TO STC-DEPEND-QUAL3
                       MOVE "C" TO TYPE-PUSE
                       PERFORM DEL-UP-REF-30
                   END-IF 
                   IF STC-DEPEND-QUAL4 NOT EQUAL TO REL-ENTRY-NAME
                       IF ID1FLAG EQUAL "Y" 
                         AND STC-DEPEND-QUAL4 NOT EQUAL TO SPACES 
                           MOVE REL-ENTRY-NAME TO SAVE-NAME 
                           MOVE STC-DEPEND-QUAL4 TO REL-ENTRY-NAME
                           MOVE "Y" TO TRADE
                       END-IF 
                   END-IF 
                   IF STC-DEPEND-QUAL4 EQUAL TO REL-ENTRY-NAME
                     OR TRADE EQUAL TO "Y"
                       MOVE SPACES TO STC-DEPEND-QUAL4
                       MOVE "C" TO TYPE-PUSE
                       PERFORM DEL-UP-REF-30
                   END-IF 
                   IF STC-DEPEND-QUAL5 NOT EQUAL TO REL-ENTRY-NAME
                       IF ID1FLAG EQUAL "Y" 
                         AND STC-DEPEND-QUAL5 NOT EQUAL TO SPACES 
                           MOVE REL-ENTRY-NAME TO SAVE-NAME 
                           MOVE STC-DEPEND-QUAL5 TO REL-ENTRY-NAME
                           MOVE "Y" TO TRADE
                       END-IF 
                   END-IF 
                   IF STC-DEPEND-QUAL5 EQUAL TO REL-ENTRY-NAME
                     OR TRADE EQUAL TO "Y"
                       MOVE SPACES TO STC-DEPEND-QUAL5
                       MOVE "C" TO TYPE-PUSE
                       PERFORM DEL-UP-REF-30
                   END-IF 
                   IF STC-DEPEND-QUAL3 NOT EQUAL SPACES 
                     OR STC-DEPEND-QUAL4 NOT EQUAL SPACES 
                     OR STC-DEPEND-QUAL5 NOT EQUAL SPACES 
                       PERFORM WRITE-DATA-LINE THRU WRITE-DATA-LINE-XIT 
                   END-IF 
                   GO TO STC-DELETE-READ
               END-IF 
               IF CAT-LINE-TYPE EQUAL TO "I"
                   IF ID1FLAG EQUAL "N" 
                       PERFORM WRITE-DATA-LINE THRU WRITE-DATA-LINE-XIT 
                   END-IF 
                   GO TO STC-DELETE-READ
               END-IF 
               IF CAT-LINE-TYPE EQUAL TO "K"
                   IF STC-KEY EQUAL TO REL-ENTRY-NAME 
                     OR ID1FLAG EQUAL "Y" 
                       MOVE "C" TO TYPE-PUSE
                       PERFORM DEL-UP-REF-30
                   ELSE 
                       PERFORM WRITE-DATA-LINE THRU WRITE-DATA-LINE-XIT 
                   END-IF 
                   GO TO STC-DELETE-READ
               END-IF 
               IF CAT-LINE-TYPE EQUAL TO "R" OR "T" 
                   IF STC-NAME EQUAL TO REL-ENTRY-NAME
                     OR ID1FLAG EQUAL "Y" 
                       MOVE "C" TO TYPE-PUSE
                       PERFORM DEL-UP-REF-30
                       MOVE SPACES TO STC-NAME
                   END-IF 
                   IF STC-QUAL-COUNT GREATER THAN 0 
                       IF STC-QUAL1 NOT EQUAL TO REL-ENTRY-NAME 
                           IF ID1FLAG EQUAL "Y" 
                             AND STC-QUAL1 NOT EQUAL TO SPACES
                               MOVE REL-ENTRY-NAME TO SAVE-NAME 
                               MOVE STC-QUAL1 TO REL-ENTRY-NAME 
                               MOVE "Y" TO TRADE
                           END-IF 
                       END-IF 
                       IF STC-QUAL1 EQUAL REL-ENTRY-NAME
                         OR TRADE EQUAL "Y" 
                           MOVE "C" TO TYPE-PUSE
                           PERFORM DEL-UP-REF-30
                           MOVE SPACES TO STC-QUAL1 
                       END-IF 
                       IF STC-QUAL2 NOT EQUAL TO REL-ENTRY-NAME 
                           IF ID1FLAG EQUAL "Y" 
                             AND STC-QUAL2 NOT EQUAL TO SPACES
                               MOVE REL-ENTRY-NAME TO SAVE-NAME 
                               MOVE STC-QUAL2 TO REL-ENTRY-NAME 
                               MOVE "Y" TO TRADE
                           END-IF 
                       END-IF 
                       IF STC-QUAL2 EQUAL REL-ENTRY-NAME
                         OR TRADE EQUAL "Y" 
                           MOVE "C" TO TYPE-PUSE
                           MOVE SPACES TO STC-QUAL2 
                           PERFORM DEL-UP-REF-30
                       END-IF 
                       IF STC-QUAL3 NOT EQUAL TO REL-ENTRY-NAME 
                           IF ID1FLAG EQUAL "Y" 
                             AND STC-QUAL3 NOT EQUAL TO SPACES
                               MOVE REL-ENTRY-NAME TO SAVE-NAME 
                               MOVE STC-QUAL3 TO REL-ENTRY-NAME 
                               MOVE "Y" TO TRADE
                           END-IF 
                       END-IF 
                       IF STC-QUAL3 EQUAL REL-ENTRY-NAME
                         OR TRADE EQUAL "Y" 
                           MOVE "C" TO TYPE-PUSE
                           MOVE SPACES TO STC-QUAL3 
                           PERFORM DEL-UP-REF-30
                       END-IF 
                   END-IF 
                   IF ID1FLAG EQUAL "N" 
                       PERFORM WRITE-DATA-LINE THRU WRITE-DATA-LINE-XIT 
                   END-IF 
                   GO TO STC-DELETE-READ
               END-IF 
               IF CAT-LINE-TYPE EQUAL TO "Q" OR "2" 
                   IF STC-QUAL4 NOT EQUAL TO REL-ENTRY-NAME 
                       IF ID1FLAG EQUAL "Y" 
                         AND STC-QUAL4 NOT EQUAL TO SPACES
                           MOVE REL-ENTRY-NAME TO SAVE-NAME 
                           MOVE STC-QUAL4 TO REL-ENTRY-NAME 
                           MOVE "Y" TO TRADE
                       END-IF 
                   END-IF 
                   IF STC-QUAL4 EQUAL TO REL-ENTRY-NAME 
                     OR TRADE EQUAL "Y" 
                       MOVE "C" TO TYPE-PUSE
                       MOVE SPACES TO STC-QUAL4 
                       PERFORM DEL-UP-REF-30
                   END-IF 
                   IF STC-QUAL5 NOT EQUAL TO REL-ENTRY-NAME 
                       IF ID1FLAG EQUAL "Y" 
                         AND STC-QUAL5 NOT EQUAL TO SPACES
                           MOVE REL-ENTRY-NAME TO SAVE-NAME 
                           MOVE STC-QUAL5 TO REL-ENTRY-NAME 
                           MOVE "Y" TO TRADE
                       END-IF 
                   END-IF 
                   IF STC-QUAL5 EQUAL TO REL-ENTRY-NAME 
                     OR TRADE EQUAL "Y" 
                       MOVE "C" TO TYPE-PUSE
                       MOVE SPACES TO STC-QUAL5 
                       PERFORM DEL-UP-REF-30
                   END-IF 
                   IF ID1FLAG EQUAL "N" 
                       PERFORM WRITE-DATA-LINE THRU WRITE-DATA-LINE-XIT 
                   END-IF 
               END-IF 
           END-IF 
       STC-DELETE-READ. 
           PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT 
           IF DATA-RETURN-CODE EQUAL 1
               GO TO DEL-UP-REF-35
           END-IF 
           IF CAT-CATEGORY NOT EQUAL TO 300 
             OR (CAT-LINE-TYPE EQUAL TO "A" OR SPACES)
               MOVE "T" TO FINIS
           END-IF 
       STC-LINE-DELETE-EXIT.
           EXIT.
       AREAKEY-DELETE.
           MOVE "F" TO FINIS
           MOVE "N" TO TRADE. 
           PERFORM AREA-LINE-DELETE THRU AREA-LINE-DELETE-EXIT
             VARYING COUNTER FROM 1 BY 1 UNTIL FINIS EQUAL "T"
       AREAKEY-DELETE-EXIT. 
           EXIT.
       AREA-LINE-DELETE.
           IF GEN-NAME EQUAL TO REL-ENTRY-NAME
               MOVE "C" TO TYPE-PUSE
               PERFORM DEL-UP-REF-30
               MOVE "Y" TO ID1FLAG
           ELSE 
               MOVE "N" TO ID1FLAG
           END-IF 
           IF GEN-QUAL NOT EQUAL TO REL-ENTRY-NAME
               IF ID1FLAG EQUAL "Y" 
                 AND GEN-QUAL NOT EQUAL TO SPACES 
                   MOVE REL-ENTRY-NAME TO SAVE-NAME 
                   MOVE GEN-QUAL TO REL-ENTRY-NAME
                   MOVE "Y" TO TRADE
               END-IF 
           END-IF 
           IF GEN-QUAL EQUAL TO REL-ENTRY-NAME
             OR TRADE EQUAL "Y" 
               MOVE SPACES TO GEN-QUAL
               MOVE "C" TO TYPE-PUSE
               PERFORM DEL-UP-REF-30
           END-IF 
           IF ID1FLAG EQUAL "N" 
               PERFORM WRITE-DATA-LINE THRU WRITE-DATA-LINE-XIT 
           END-IF 
           PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT 
           IF DATA-RETURN-CODE EQUAL TO 1 
               GO TO DEL-UP-REF-35
           END-IF 
       AREA-LINE-TEST.
           IF CAT-CATEGORY NOT EQUAL TO 500 
             OR CAT-LINE-TYPE EQUAL TO "C"
               MOVE "T" TO FINIS
           END-IF 
       AREA-LINE-DELETE-EXIT. 
           EXIT.
       PROCESS-RC-DELETE. 
           PERFORM AREA-LINE-DELETE.
       PROCESS-RC-DELETE-EXIT.
           EXIT.
       SSREL-DELETE.
           MOVE "F" TO FINIS. 
           MOVE "C" TO TYPE-PUSE. 
           PERFORM VARYING COUNTER FROM 1 BY 1
             UNTIL FINIS EQUAL "T"
               IF CAT-LINE-TYPE EQUAL "R" 
                   IF RESTRICT-NAME EQUAL REL-ENTRY-NAME
                       MOVE SPACES TO RESTRICT-NAME 
                       PERFORM DEL-UP-REF-30
                   ELSE 
                       PERFORM WRITE-DATA-LINE THRU WRITE-DATA-LINE-XIT 
                   END-IF 
               END-IF 
               IF CAT-LINE-TYPE EQUAL "I" 
                   MOVE "F" TO ID1FLAG ID2FLAG
                   IF ID1 EQUAL TO REL-ENTRY-NAME 
                       MOVE SPACES TO ID1 ID1-SUB 
                       MOVE "T" TO ID1FLAG
                       PERFORM DEL-UP-REF-30
                   END-IF 
                   IF ID2 EQUAL TO REL-ENTRY-NAME 
                       MOVE SPACES TO ID2 ID2-SUB 
                       MOVE "T" TO ID2FLAG
                       PERFORM DEL-UP-REF-30
                   END-IF 
                   IF ID1FLAG EQUAL "F" 
                     OR ID2FLAG EQUAL "F" 
                       PERFORM WRITE-DATA-LINE THRU WRITE-DATA-LINE-XIT 
                   END-IF 
               ELSE 
                   IF (CAT-LINE-TYPE EQUAL "Q" OR "2" 
                     AND ID1FLAG EQUAL "Y") 
                     OR (CAT-LINE-TYPE EQUAL "B" OR "3" 
                     AND ID2FLAG EQUAL "Y") 
                     AND SS-QUAL1 NOT EQUAL SPACES
                       MOVE "Y" TO TRADE
                       MOVE REL-ENTRY-NAME TO SAVE-NAME 
                       MOVE SS-QUAL1 TO REL-ENTRY-NAME
                   END-IF 
                   IF SS-QUAL1 EQUAL TO REL-ENTRY-NAME
                     OR TRADE EQUAL "Y" 
                       MOVE SPACES TO SS-QUAL1 SS-SUB1
                       PERFORM DEL-UP-REF-30
                   END-IF 
                   IF (CAT-LINE-TYPE EQUAL "Q" OR "2" 
                     AND ID1FLAG EQUAL "Y") 
                     OR (CAT-LINE-TYPE EQUAL "B" OR "3" 
                     AND ID2FLAG EQUAL "Y") 
                     AND SS-QUAL2 NOT EQUAL SPACES
                       MOVE "Y" TO TRADE
                       MOVE REL-ENTRY-NAME TO SAVE-NAME 
                       MOVE SS-QUAL2 TO REL-ENTRY-NAME
                   END-IF 
                   IF SS-QUAL2 EQUAL TO REL-ENTRY-NAME
                     OR TRADE EQUAL "Y" 
                       MOVE SPACES TO SS-QUAL2 SS-SUB2
                       PERFORM DEL-UP-REF-30
                   END-IF 
                   IF (CAT-LINE-TYPE EQUAL "Q" OR "2" 
                     AND ID1FLAG EQUAL "Y") 
                     OR (CAT-LINE-TYPE EQUAL "B" OR "3" 
                     AND ID2FLAG EQUAL "Y") 
                     AND SS-QUAL3 NOT EQUAL SPACES
                       MOVE "Y" TO TRADE
                       MOVE REL-ENTRY-NAME TO SAVE-NAME 
                       MOVE SS-QUAL3 TO REL-ENTRY-NAME
                   END-IF 
                   IF SS-QUAL3 EQUAL TO REL-ENTRY-NAME
                     OR TRADE EQUAL "Y" 
                       MOVE SPACES TO SS-QUAL3 SS-SUB3
                       PERFORM DEL-UP-REF-30
                   END-IF 
                   IF ((CAT-LINE-TYPE EQUAL "Q" OR "2") AND 
                     ID1FLAG EQUAL "F") OR
                     ((CAT-LINE-TYPE EQUAL "B" OR "3") AND
                     ID2FLAG EQUAL "F") 
                       PERFORM WRITE-DATA-LINE THRU WRITE-DATA-LINE-XIT 
                   END-IF 
               END-IF 
               PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT 
               IF DATA-RETURN-CODE EQUAL 1
                   GO TO DEL-UP-REF-35
               END-IF 
               IF CAT-CATEGORY NOT EQUAL TO 525 
                   MOVE "T" TO FINIS
               END-IF 
           END-PERFORM. 
       SSREL-DELETE-EXIT. 
           EXIT.
       CONSTRAINT-DELETE. 
           MOVE "C" TO TYPE-PUSE. 
           MOVE "N" TO ID1FLAG. 
           MOVE "N" TO TRADE. 
           IF CAT-LINE-TYPE EQUAL TO "N"
               IF CON-CATNAME EQUAL TO REL-ENTRY-NAME 
                   MOVE "Y" TO ID1FLAG
                   PERFORM DEL-UP-REF-30
               END-IF 
               IF CON-QUAL NOT EQUAL TO REL-ENTRY-NAME
                   IF ID1FLAG EQUAL "Y" 
                     AND CON-QUAL NOT EQUAL SPACES
                       MOVE "Y" TO TRADE
                       MOVE REL-ENTRY-NAME TO SAVE-NAME 
                       MOVE CON-QUAL TO REL-ENTRY-NAME
                   END-IF 
               END-IF 
               IF CON-QUAL EQUAL TO REL-ENTRY-NAME
                 OR TRADE EQUAL "Y" 
                   MOVE SPACES TO CON-QUAL
                   PERFORM DEL-UP-REF-30
               END-IF 
               IF ID1FLAG EQUAL "N" 
                   PERFORM WRITE-DATA-LINE THRU WRITE-DATA-LINE-XIT 
               END-IF 
           END-IF 
           IF CAT-LINE-TYPE EQUAL TO "O"
               IF GEN-NAME EQUAL TO REL-ENTRY-NAME
                   MOVE "Y" TO ID1FLAG
                   PERFORM DEL-UP-REF-30
               END-IF 
               IF GEN-QUAL NOT EQUAL TO REL-ENTRY-NAME
                   IF ID1FLAG EQUAL "Y" 
                     AND GEN-QUAL NOT EQUAL SPACES
                       MOVE "Y" TO TRADE
                       MOVE REL-ENTRY-NAME TO SAVE-NAME 
                       MOVE GEN-QUAL TO REL-ENTRY-NAME
                   END-IF 
               END-IF 
               IF GEN-QUAL EQUAL TO REL-ENTRY-NAME
                 OR TRADE EQUAL "Y" 
                   MOVE SPACES TO GEN-QUAL
                   PERFORM DEL-UP-REF-30
               END-IF 
               IF ID1FLAG EQUAL "N" 
                   PERFORM WRITE-DATA-LINE THRU WRITE-DATA-LINE-XIT 
               END-IF 
           END-IF 
           PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.
       CONSTRAINT-DELETE-EXIT.
           EXIT.
       JOIN-DELETE. 
           MOVE "N" TO ID1FLAG. 
           IF CAT-LINE-TYPE EQUAL TO "B" OR "C" 
               IF JOIN-ID EQUAL REL-ENTRY-NAME
                   MOVE "Y" TO ID1FLAG
                   PERFORM DEL-UP-REF-30
               END-IF 
           END-IF 
           IF JOIN-QUAL1 NOT EQUAL TO REL-ENTRY-NAME
               IF ID1FLAG EQUAL "Y" 
                 AND JOIN-QUAL1 NOT EQUAL SPACES
                   MOVE "Y" TO TRADE
                   MOVE REL-ENTRY-NAME TO SAVE-NAME 
                   MOVE JOIN-QUAL1 TO REL-ENTRY-NAME
               END-IF 
           END-IF 
           IF JOIN-QUAL1 EQUAL REL-ENTRY-NAME 
             OR TRADE EQUAL "Y" 
               MOVE SPACES TO JOIN-QUAL1
               PERFORM DEL-UP-REF-30
           END-IF 
           IF ID1FLAG EQUAL "N" 
               PERFORM WRITE-DATA-LINE THRU WRITE-DATA-LINE-XIT 
           END-IF 
           PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT 
       JOIN-DELETE-EXIT.
           EXIT.
*CALL     RELCOM
*CALL     RELUPD
*CALL     RELALG
*CALL     MAST1EXT
*CALL     MAST1RFL
*CALL     MAST1RNL
*CALL     MAST1ALG
*CALL     MAST1READ 
