*DECK     DCUTL300
00001  IDENTIFICATION DIVISION.                                         10/03/78
       PROGRAM-ID.   UTL300.
00003 ******************************************************************   LV002
00004 *                                                                    CL**2
00005 *       THIS PROGRAM IMPLEMENTS THE RENAME AND RENUMBER FACILITIES   CL**2
00006 *        IT IS CALLED BY DCUTL                                       CL**2
00007 *        IT MAY RETURN TO READ CONTINUATION TRANSACTIONS             CL**2
00008 *                                                                    CL**2
00009 ******************************************************************   CL**2
00010                                                                      CL**2
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION. 
       SOURCE-COMPUTER.   CYBER.
       OBJECT-COMPUTER.   CYBER.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT MAST1 ASSIGN TO "MAST1" 
               ORGANIZATION IS DIRECT 
               ACCESS MODE IS RANDOM
              RECORD KEY IS DATA-KEY. 
           SELECT MAST2 ASSIGN TO "MAST2" 
               ACCESS MODE IS RANDOM
               ORGANIZATION IS DIRECT 
               RECORD KEY IS REL-KEY. 
           SELECT MAST3 ASSIGN TO "MAST3" 
               ORGANIZATION IS RELATIVE 
               ACCESS MODE IS RANDOM
               RELATIVE KEY IS CONTROL-NOM-KEY
               USE "PRUF=YES".
           SELECT SYSPRINT ASSIGN TO "OUTPUT".
           SELECT WORK-FILE ASSIGN TO "WRKFILE" 
               ACCESS MODE IS RANDOM
               ORGANIZATION IS DIRECT 
               RECORD KEY IS WORK-KEY 
               BLOCK COUNT IS 11. 
00014  DATA DIVISION.                                                      CL**2
00015  FILE SECTION.                                                       CL**2
*CALL     MAST1FD                                                          CL**2
*CALL     MAST2FD                                                          CL**2
*CALL     MAST3FD                                                          CL**2
*CALL     SYSPRTFD                                                         CL**2
       FD  WORK-FILE
           LABEL RECORDS ARE OMITTED
           BLOCK CONTAINS 630 RECORDS 
           DATA RECORDS ARE WORK-RECORD.
       01  WORK-RECORD. 
           03  WORK-KEY                  PICTURE X(32). 
       COMMON-STORAGE SECTION.
  
       77 RETURN-CODE   PICTURE 99. 
  
  
       01 WKPRINT-UTL.
*CALL WKPRINT 
               10 ERROR-LINE REDEFINES STD-REPORT-REC.
                 15 FILLER   PICTURE X(20). 
                 15 ERROR-POS1   PICTURE X(6).
                 15 ERROR-POS2   PICTURE X(90). 
                 15 FILLER       PICTURE X(16). 
       01 UNUSED-COMMON.
           02  FILLER     PICTURE X OCCURS 533 TIMES. 
       01 TRANS-AREA. 
           05 COMMAND-TYPE. 
               10 CONT-TYPE   PICTURE XX. 
               10 FILLER      PICTURE X.
           05 FILLER          PICTURE X(69).
       01 TRANS-OP REDEFINES TRANS-AREA.
           05 FILLER   PICTURE XX.
           05 TX-POS   PICTURE X  OCCURS 70 TIMES.
       01 UTL-TABLE-RNM.
           05 CTL-PRIME-NUM1   PICTURE 9(5).
           05 CTL-PRIME-NUM2   PICTURE 9(5).
           05 FUNCTION-CODE   PICTURE X.
*CALL     WRKSTG77                                                         CL**2
00021  77  MAX-POS                    PICTURE 99 COMP SYNC VALUE 70.       CL**2
       77  WORK-KEY-FLAG                 PICTURE 9. 
           88  WORK-KEY-VALID            VALUE 0. 
           88  WORK-KEY-INVALID          VALUE 1. 
*CALL     WRKSTG01                                                         CL**2
*CALL     MAST1WS                                                          CL**2
*CALL     TESTWACOM                                                        CL**2
*CALL DCDPTRS 
           02  ACCESS-LINE REDEFINES CAT-DETAIL.
               03  FILLER                PICTURE X. 
               03  ACC-A-LOCK            PICTURE X(32). 
               03  ACC-A-TYPE            PICTURE X. 
       01 SAVE-DATA-RECORD. 
            03 SAVE-HDR.
              05 SAVE-KEY.
                07 SAVE-REC-ID   PICTURE X(32). 
                07 SAVE-TRLR     PICTURE 9999.
              05 FILLER          PICTURE X(32). 
            03 FILLER            PICTURE X(1197). 
       01  MULT-CAT-SAVE-AREAS. 
           02  CAT-NAME-1                PICTURE X(32). 
           02  CAT-NAME-2                PICTURE X(32). 
           02  CAT-NAME-3                PICTURE X(32). 
           02  CAT-NAME-4                PICTURE X(32). 
           02  CAT-NAME-5                PICTURE X(32). 
00026                                                                    DCUTL30
       01 CONTROL-NOM-KEY   PICTURE 999   VALUE ZEROS.
00028  01  WORK-AREAS.                                                     CL**2
00029      05  PROG-ID                 PICTURE X(6) VALUE "DCUTL-".        CL**2
00030      05  ERROR-MESSAGES.                                             CL**2
00031          10  ERROR-MSG1.                                             CL**2
00032              15  FILLER          PICTURE X(13) VALUE                 CL**2
00033              "500-S *ERROR ".                                        CL**2
00034              15  FILLER          PICTURE X(15) VALUE                 CL**2
00035              "ILLEGAL KEYWORD".                                      CL**2
00036          10  ERROR-MSG2.                                             CL**2
00037              15  FILLER          PICTURE X(13) VALUE                 CL**2
00038              "505-S *ERROR ".                                        CL**2
00039              15  FILLER          PICTURE X(20) VALUE                 CL**2
00040              "OLD NAME NOT ON FILE".                                 CL**2
00041          10  ERROR-MSG3.                                             CL**2
00042              15  FILLER          PICTURE X(13) VALUE                 CL**2
00043              "510-S *ERROR ".                                        CL**2
00044              15  FILLER          PICTURE X(24) VALUE                 CL**2
00045              "NEW NAME ALREADY ON FILE".                             CL**2
00046          10  ERROR-MSG4.                                             CL**2
00047              15  FILLER          PICTURE X(13) VALUE                 CL**2
00048              "515-S *ERROR ".                                        CL**2
00049              15  FILLER          PICTURE X(30) VALUE                 CL**2
00050              "EQUAL SIGN MUST FOLLOW KEYWORD".                       CL**2
00051          10  ERROR-MSG5.                                             CL**2
00052              15  FILLER          PICTURE X(13) VALUE                 CL**2
00053              "520-S *ERROR ".                                        CL**2
00054              15  FILLER          PICTURE X(20) VALUE                 CL**2
00055              "VALUE MUST BE Y OR N".                                 CL**2
00056          10  ERROR-MSG6.                                             CL**2
00057              15  FILLER          PICTURE X(13) VALUE                 CL**2
00058              "525-S *ERROR ".                                        CL**2
00059              15  FILLER          PICTURE X(14) VALUE                 CL**2
00060              "ILLEGAL SYNTAX".                                       CL**2
00061          10  ERROR-MSG7.                                             CL**2
00062              15  FILLER          PICTURE X(13) VALUE                 CL**2
00063              "535-S *ERROR ".                                        CL**2
00064              15  FILLER          PICTURE X(20) VALUE                 CL**2
00065              "INCOMPATIBLE OPTIONS".                                 CL**2
00066          10  ERROR-MSG8.                                             CL**2
00067              15  FILLER          PICTURE X(24) VALUE                 CL**2
00068              "800-S *ERROR MAST1-RNM".                               CL**2
00069              15  IO-NAME1        PICTURE X(32).                      CL**2
00070              15  IO-REASON1      PICTURE X(9).                       CL**2
00071          10  ERROR-MSG9.                                             CL**2
00072              15  FILLER          PICTURE X(24) VALUE                 CL**2
00073              "850-S *ERROR MAST2-RNM".                               CL**2
00074              15  IO-NAME2        PICTURE X(32).                      CL**2
00075              15  IO-REASON2      PICTURE X(9).                       CL**2
00076          10  ERROR-MSG10.                                            CL**2
00077              15  FILLER          PICTURE X(13) VALUE                 CL**2
00078              "530-S *ERROR ".                                        CL**2
00079              15  FILLER          PICTURE X(32) VALUE                 CL**2
00080              "INVALID CONTINUATION TRANSACTION".                     CL**2
00081          10  ERROR-MSG11.                                            CL**2
00082              15  FILLER          PICTURE X(13) VALUE                 CL**2
00083                  "540-S *ERROR".                                     CL**2
00084              15  FILLER          PICTURE X(21) VALUE                 CL**2
00085                  "VALUE MUST BE NUMERIC".                            CL**2
00086          10  ERROR-MSG12.                                            CL**2
00087              15  FILLER          PICTURE X(13) VALUE                 CL**2
00088                  "545-S *ERROR".                                     CL**2
00089              15  CATEGORY-MISSING PICTURE X(15).                     CL**2
00090          15  FILLER         PICTURE X(21) VALUE                      CL**2
00091                  " CATEGORY NOT PRESENT".                            CL**2
00092          10   ERROR-MSG13.                                           CL**2
00093              15  FILLER           PICTURE X(13) VALUE                CL**2
00094                  "555-S *ERROR".                                     CL**2
00095              15  FILLER           PICTURE X(5) VALUE "LINE".         CL**2
00096              15  LINE-MISSING     PICTURE XXXX.                      CL**2
00097              15  FILLER            PICTURE X(12) VALUE               CL**2
00098                  " NOT PRESENT".                                     CL**2
00099           10  ERROR-MSG14.                                           CL**2
00100              15  FILLER           PICTURE X(13) VALUE                CL**2
00101                  "560-S *ERROR".                                     CL**2
00102              15  FILLER           PICTURE X(5) VALUE "LINE".         CL**2
00103              15  LINE-MISSING1     PICTURE XXXX.                     CL**2
00104              15  FILLER            PICTURE X(16) VALUE               CL**2
00105                  " ALREADY PRESENT".                                 CL**2
00106          10  ERROR-MSG15.                                            CL**2
00107              15  FILLER            PICTURE X(13) VALUE               CL**2
00108                  "550-S *ERROR".                                     CL**2
00109              15  FILLER             PICTURE X(16) VALUE              CL**2
00110                  "INVALID CATEGORY".                                 CL**2
00111      05  SUB-SCRIPTS.                                                CL**2
00112          10  TX-SUB              PICTURE 99 COMP SYNC.               CL**2
00113          10  OPT-SUB             PICTURE 99 COMP SYNC.               CL**2
00114          10  MOVE-SUB           PICTURE S9999.                       CL**2
00115          10  SAVE-DATA-SUB      PICTURE S9999.                       CL**2
00116      05  FLAGS.                                                      CL**2
00117          10  CHAR-NOT-FOUND      PICTURE X.                          CL**2
00118          10  END-OF-CARD         PICTURE X VALUE "N".                CL**2
00119          10  DEL-OLD-FLAG        PICTURE X.                          CL**2
00120          10  CHG-REF-FLAG        PICTURE X.                          CL**2
00121          10  ALL-CAT-FLAG                PICTURE X.                  CL**2
00122          10  REWRITE-FLAG                PICTURE X.                  CL**2
00123      05  TEST-TYPES.                                                 CL**2
00124          10  TEST-CHAR           PICTURE X.                          CL**2
00125          10  EQUAL-SIGN          PICTURE X VALUE "=".                CL**2
00126          10  COMMA-CHAR          PICTURE X VALUE ",".                CL**2
00127          10  NUMBER-TYPE         PICTURE XXX VALUE "NUM".            CL**2
00128      05  RUN-OPTIONS.                                                CL**2
00129          10  OLD-NAME            PICTURE X(32).                      CL**2
00130          10  NEW-NAME.                                               CL**2
00131              15  NAME-NEW-SUB           PICTURE X OCCURS 32 TIMES.   CL**2
00132          10  SAVE-ENTRY-TYPE                  PICTURE 99.            CL**2
00133          10  CAT-NUM                           PICTURE 999.          CL**2
00134          10  BYLINE         PICTURE 9(4).                            CL**2
00135          10  FROMLINE                           PICTURE X(4).        CL**2
00136          10  TOLINE                           PICTURE X(4).          CL**2
00137          10  STARTLINE      PICTURE 9(4).                            CL**2
00138          10  LINESTART REDEFINES STARTLINE                           CL**2
00139          PICTURE 9   OCCURS 4 TIMES.                                 CL**2
00140          10  CAT-NAME                          PICTURE X(15).        CL**2
00141          10  SAVE-STARTLINE  PICTURE 9(4).                           CL**2
00142          10  SAVE-KEYWORD PICTURE X(3).                              CL**2
00143          10  SAVE-OPERAND PICTURE X(4).                              CL**2
               10  TYPE-PUSE  PICTURE X.
00144      05  MESSAGES.                                                   CL**2
00145          10  BASIC-MSG.                                              CL**2
00146              15  FILLER          PICTURE X(8)  VALUE                 CL**2
00147              "600-I * ".                                             CL**2
00148              15  RENAME1         PICTURE X(32).                      CL**2
00149              15  BASIC-MSG1      PICTURE X(12) VALUE                 CL**2
00150              " RENAMED TO ".                                         CL**2
00151              15  RENAME2         PICTURE X(32).                      CL**2
00152          10  MSG2.                                                   CL**2
00153              15  FILLER          PICTURE X(8)  VALUE                 CL**2
00154              "610-I * ".                                             CL**2
00155              15  RENAME3         PICTURE X(32).                      CL**2
00156              15  FILLER          PICTURE X(23) VALUE                 CL**2
00157              " IS NOW A COMPONENT OF ".                              CL**2
00158              15  RENAME4         PICTURE X(32).                      CL**2
00159          10  MSG3.                                                   CL**2
00160              15  FILLER          PICTURE X(8)  VALUE                 CL**2
00161              "620-I * ".                                             CL**2
00162              15  RENAME5         PICTURE X(32).                      CL**2
00163              15  FILLER          PICTURE X VALUE SPACE.              CL**2
00164              15  FILLER             PICTURE X(11) VALUE              CL**2
00165              "WAS DELETED".                                          CL**2
00166          10  MSG4.                                                   CL**2
00167              15  FILLER             PICTURE X(8) VALUE               CL**2
00168                  "630-I *".                                          CL**2
00169              15  RENUM1             PICTURE X(32).                   CL**2
00170              15  FILLER             PICTURE X VALUE SPACE.           CL**2
00171              15  FILLER     PICTURE X(20) VALUE                      CL**2
00172                  " HAS BEEN RENUMBERED".                             CL**2
00173      05  AREA-SCAN.                                                  CL**2
00174          10  SCAN-FIELD-32.                                          CL**2
00175              15  SCAN-FIELD-4.                                       CL**2
00176                  17  SCAN-FIELD-3.                                   CL**2
00177                  20  SCAN-FIELD-1 PICTURE X.                         CL**2
00178              20  SCAN-FIELD-2ND    PICTURE X.                        CL**2
00179              20  SCAN-FIELD-3RD    PICTURE X.                        CL**2
00180          17  SCAN-FIELD-4TH        PICTURE X.                        CL**2
00181              15  FILLER             PICTURE X(28).                   CL**2
00182          10  FILLER              PICTURE X(40).                      CL**2
00183      05  SCAN-AREA REDEFINES AREA-SCAN PICTURE X OCCURS 72 TIMES.    CL**2
00184  01  CAT-TABLE.                                                      CL**2
           03 CATEGORY OCCURS 31 TIMES. 
              05 CATEGORY-NAME        PICTURE XXX.
              05 FILLER               PICTURE X(12).
              05 CATEGORY-ID          PICTURE XXX.
              05 CATEGORY-LOC  OCCURS 17 TIMES. 
                 07 ENTRY-TYPE        PICTURE 99. 
                 07 ENTRY-LENGTH      PICTURE 999.
           03 FILLER                  PICTURE XX. 
       01  BIN-ZERO                   PICTURE 999 COMP-1 VALUE ZERO.
       01  ANOTHER-BIN REDEFINES  BIN-ZERO. 
           02  SIX-BIT-ZERO           PICTURE X.
           02  FILLER                 PICTURE X(9). 
       01  BIN-ONE                    PICTURE 999 COMP-1 VALUE 1. 
       01  DUMMY-FIT. 
           02  LFN                    PICTURE X(7). 
           02  FIT-STAT               PICTURE 9(4) COMP-4.
           02  WORD-1                 PICTURE 99 COMP-1.
           02  WORD-2                 PICTURE 99 COMP-1.
           02  WORD-3                 PICTURE 99 COMP-1.
           02  WORD-4                 PICTURE 99 COMP-1.
00193                                                                    DCUTL30
00214                                                                    DCUTL30
00215  PROCEDURE DIVISION.                                                 CL**2
       OLD-ENTRY. 
      ******************************************************* 
      *    OPEN WORK FILE 
      ******************************************************* 
           MOVE "WRKFILE" TO LFN. 
           INSPECT LFN REPLACING ALL " " BY SIX-BIT-ZERO. 
           ENTER FTN5 "EVICT" USING DUMMY-FIT, BIN-ONE. 
           OPEN OUTPUT WORK-FILE. 
           MOVE "********************************" TO 
               WORK-KEY.
           PERFORM  WRITE-WORK-FILE THRU WRITE-WORK-FILE-XIT. 
           CLOSE WORK-FILE. 
           OPEN I-O WORK-FILE.
00220      IF FUNCTION-CODE EQUAL "R"                                      CL**2
00221          MOVE TRANS-AREA TO STD-REPORT-REC                           CL**2
00222          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT                  CL**2
00223          GO TO GET-NEXT-CARD-RETURN.                                 CL**2
00224      MOVE "N" TO END-OF-CARD.                                        CL**2
00227      OPEN I-O MAST1.                                                 CL**2
00228      OPEN I-O MAST2.                                                 CL**2
00229      MOVE SPACES TO REL-ARG-LIST.                                    CL**2
00230      MOVE SPACES TO REL-LAST-ENTRY-NAME.                             CL**2
00231      MOVE ZERO TO REL-NEXT-REC.                                      CL**2
00232      OPEN OUTPUT SYSPRINT.                                           CL**2
00233      IF COMMAND-TYPE EQUAL NUMBER-TYPE                               CL**2
00234          GO TO PROCESS-NUMBER.                                       CL**2
00235                                                                    DCUTL30
00236 ******************************************************************   CL**2
00237 *                                                                    CL**2
00238 * P R O C E S S  R E N A M E   T R A N S A C T I O N                 CL**2
00239 *       EDIT FOR OLD AND NEW NAMES                                   CL**2
00240 *                                                                    CL**2
00241 ******************************************************************   CL**2
00242  EDIT-RENAME.                                                        CL**2
00243      MOVE ZERO TO TX-SUB.                                            CL**2
00244      MOVE SPACE TO TEST-CHAR.                                        CL**2
00245      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                           CL**2
00246      PERFORM FIND-BLANK THRU FIND-BLANK-XIT.                         CL**2
00247      MOVE EQUAL-SIGN TO TEST-CHAR.                                   CL**2
00248      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                           CL**2
00249      IF CHAR-NOT-FOUND NOT EQUAL "Y"                                 CL**2
00250          GO TO ILLEGAL-RENAME-SYNTAX.                                CL**2
00251      IF SCAN-FIELD-3 NOT EQUAL "CAT"                                 CL**2
00252          MOVE ERROR-MSG1 TO ERROR-POS2                               CL**2
00253          GO TO PRINT-FATAL-ERROR.                                    CL**2
00254      PERFORM FIND-BLANK THRU FIND-BLANK-XIT.                         CL**2
00255      MOVE COMMA-CHAR TO TEST-CHAR.                                   CL**2
00256      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                           CL**2
00257      IF CHAR-NOT-FOUND NOT EQUAL "Y"                                 CL**2
00258          GO TO ILLEGAL-RENAME-SYNTAX.                                CL**2
00259      MOVE SCAN-FIELD-32 TO OLD-NAME.                                 CL**2
00260      MOVE OLD-NAME TO REL-ENTRY-NAME.                                CL**2
00261      MOVE SPACE TO REL-ENTRY-FUNCTION.                               CL**2
00262      PERFORM REL-READ THRU REL-READ-XIT.                             CL**2
00263      IF REL-RETURN-CODE NOT EQUAL ZERO                               CL**2
00264          MOVE ERROR-MSG2 TO ERROR-POS2                               CL**2
00265          GO TO PRINT-FATAL-ERROR.                                    CL**2
00266      MOVE REL-ENTRY-TYPE TO SAVE-ENTRY-TYPE.                         CL**2
00267      PERFORM FIND-BLANK THRU FIND-BLANK-XIT.                         CL**2
00268      IF END-OF-CARD EQUAL "Y"                                        CL**2
00269          PERFORM GET-NEXT-CARD THRU GET-NEXT-CARD-XIT.               CL**2
00270      MOVE EQUAL-SIGN TO TEST-CHAR.                                   CL**2
00271      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                           CL**2
00272      IF CHAR-NOT-FOUND NOT EQUAL "Y"                                 CL**2
00273          GO TO ILLEGAL-RENAME-SYNTAX.                                CL**2
00274      IF SCAN-FIELD-3 NOT EQUAL "NEW"                                 CL**2
00275          MOVE ERROR-MSG1 TO ERROR-POS2                               CL**2
00276          GO TO PRINT-FATAL-ERROR.                                    CL**2
00277      PERFORM FIND-BLANK THRU FIND-BLANK-XIT.                         CL**2
00278      MOVE COMMA-CHAR TO TEST-CHAR.                                   CL**2
00279      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                           CL**2
00280      MOVE SCAN-FIELD-32 TO NEW-NAME.                                 CL**2
00281      MOVE NEW-NAME TO REL-ENTRY-NAME.                                CL**2
00282      MOVE SPACE TO REL-ENTRY-FUNCTION.                               CL**2
00283      PERFORM REL-READ THRU REL-READ-XIT.                             CL**2
00284      IF REL-RETURN-CODE EQUAL ZERO                                   CL**2
00285          MOVE ERROR-MSG3 TO ERROR-POS2                               CL**2
00286          GO TO PRINT-FATAL-ERROR.                                    CL**2
00287      IF CHAR-NOT-FOUND NOT EQUAL "Y"                                 CL**2
00288          MOVE "Y" TO DEL-OLD-FLAG                                    CL**2
00289          MOVE "Y" TO CHG-REF-FLAG                                    CL**2
00290          GO TO PROCESS-RENAME.                                       CL**2
00291                                                                    DCUTL30
00292 *****************************************************************    CL**2
00293 *      LOOK FOR OPTIONS                                              CL**2
00294 ****************************************************************     CL**2
00295  EDIT-RENAME-500.                                                    CL**2
00296      PERFORM FIND-BLANK THRU FIND-BLANK-XIT.                         CL**2
00297      IF END-OF-CARD EQUAL "Y"                                        CL**2
00298          PERFORM GET-NEXT-CARD THRU GET-NEXT-CARD-XIT.               CL**2
00299      MOVE EQUAL-SIGN TO TEST-CHAR.                                   CL**2
00300      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                           CL**2
00301      IF CHAR-NOT-FOUND NOT EQUAL "Y"                                 CL**2
00302          MOVE ERROR-MSG4 TO ERROR-POS2                               CL**2
00303          GO TO PRINT-FATAL-ERROR.                                    CL**2
00304      IF SCAN-FIELD-3 EQUAL "DEL"                                     CL**2
00305          GO TO EDIT-RENAME-2000.                                     CL**2
00306      IF SCAN-FIELD-3 NOT EQUAL TO "CHG"                              CL**2
00307          MOVE ERROR-MSG1 TO ERROR-POS2                               CL**2
00308          GO TO PRINT-FATAL-ERROR.                                    CL**2
00309 ****************************************************************     CL**2
00310 *     EDIT CHG                                                       CL**2
00311 ****************************************************************     CL**2
00312      MOVE COMMA-CHAR TO TEST-CHAR.                                   CL**2
00313      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                           CL**2
00314      IF SCAN-FIELD-1 EQUAL "Y" OR "N"                                CL**2
00315          MOVE SCAN-FIELD-1 TO CHG-REF-FLAG                           CL**2
00316          GO TO EDIT-RENAME-1000.                                     CL**2
00317  EDIT-RENAME-700.                                                    CL**2
00318      MOVE ERROR-MSG5 TO ERROR-POS2.                                  CL**2
00319      GO TO PRINT-FATAL-ERROR.                                        CL**2
00320  EDIT-RENAME-1000.                                                   CL**2
00321      IF CHAR-NOT-FOUND NOT EQUAL "Y"                                 CL**2
00322          MOVE "Y" TO DEL-OLD-FLAG                                    CL**2
00323          GO TO PROCESS-RENAME.                                       CL**2
00324      PERFORM FIND-BLANK THRU FIND-BLANK-XIT.                         CL**2
00325      IF END-OF-CARD EQUAL "Y"                                        CL**2
00326           PERFORM GET-NEXT-CARD THRU GET-NEXT-CARD-XIT.              CL**2
00327      MOVE EQUAL-SIGN TO TEST-CHAR.                                   CL**2
00328      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                           CL**2
00329      IF CHAR-NOT-FOUND NOT EQUAL "Y"                                 CL**2
00330           MOVE ERROR-MSG4 TO ERROR-POS2                              CL**2
00331           GO TO PRINT-FATAL-ERROR.                                   CL**2
00332      IF SCAN-FIELD-3 NOT EQUAL "DEL"                                 CL**2
00333           MOVE ERROR-MSG1 TO ERROR-POS2                              CL**2
00334      PERFORM FIND-BLANK THRU FIND-BLANK-XIT.                         CL**2
00335      ADD 1 TO TX-SUB.                                                CL**2
00336      IF TX-POS (TX-SUB) EQUAL "Y" OR "N"                             CL**2
00337          MOVE TX-POS (TX-SUB) TO DEL-OLD-FLAG                        CL**2
00338           GO TO PROCESS-RENAME.                                      CL**2
00339      GO TO EDIT-RENAME-700.                                          CL**2
00340  EDIT-RENAME-2000.                                                   CL**2
00341      MOVE COMMA-CHAR TO TEST-CHAR.                                   CL**2
00342      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                           CL**2
00343      IF SCAN-FIELD-1 EQUAL "Y" OR "N"                                CL**2
00344          MOVE SCAN-FIELD-1 TO DEL-OLD-FLAG                           CL**2
00345          GO TO EDIT-RENAME-2500.                                     CL**2
00346      GO TO EDIT-RENAME-700.                                          CL**2
00347  EDIT-RENAME-2500.                                                   CL**2
00348      IF CHAR-NOT-FOUND NOT EQUAL "Y"                                 CL**2
00349          MOVE "Y" TO CHG-REF-FLAG                                    CL**2
00350          GO TO PROCESS-RENAME.                                       CL**2
00351 ****************************************************************     CL**2
00352 *    EDIT DEL                                                        CL**2
00353 ****************************************************************     CL**2
00354      PERFORM FIND-BLANK THRU FIND-BLANK-XIT.                         CL**2
00355      IF END-OF-CARD EQUAL "Y"                                        CL**2
00356          PERFORM GET-NEXT-CARD THRU GET-NEXT-CARD-XIT.               CL**2
00357      MOVE EQUAL-SIGN TO TEST-CHAR.                                   CL**2
00358      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                           CL**2
00359      IF CHAR-NOT-FOUND NOT EQUAL "Y"                                 CL**2
00360          MOVE ERROR-MSG4 TO ERROR-POS2                               CL**2
00361          GO TO PRINT-FATAL-ERROR.                                    CL**2
00362      IF SCAN-FIELD-3 NOT EQUAL "CHG"                                 CL**2
00363          MOVE ERROR-MSG1 TO ERROR-POS2                               CL**2
00364          GO TO PRINT-FATAL-ERROR.                                    CL**2
00365      PERFORM FIND-BLANK THRU FIND-BLANK-XIT.                         CL**2
00366      ADD 1 TO TX-SUB.                                                CL**2
00367      IF TX-POS (TX-SUB) EQUAL "Y" OR "N"                             CL**2
00368          MOVE TX-POS (TX-SUB) TO CHG-REF-FLAG                        CL**2
00369          GO TO PROCESS-RENAME.                                       CL**2
00370      GO TO EDIT-RENAME-700.                                          CL**2
00371                                                                    DCUTL30
00372 ****************************************************************     CL**2
00373 *     TRRANSACTION IS VALID  - RENAME THE ENTRY                      CL**2
00374 *****************************************************************    CL**2
00375  PROCESS-RENAME.                                                     CL**2
00376      IF CHG-REF-FLAG EQUAL "N"                                       CL**2
00377      AND DEL-OLD-FLAG EQUAL "Y"                                      CL**2
00378          MOVE ERROR-MSG7 TO ERROR-POS2                               CL**2
00379          GO TO PRINT-FATAL-ERROR.                                    CL**2
00380 ****************************************************************     CL**2
00381 *      RENAME ENTRY FOR MAST1                                        CL**2
00382 ****************************************************************     CL**2
00383      MOVE ZERO TO DATA-NEXT-REC.                                     CL**2
00384  PROCESS-RENAME-100.                                                 CL**2
00385      MOVE OLD-NAME TO DATA-ENTRY-NAME.                               CL**2
00386      MOVE ZERO TO DATA-RETURN-CODE.                                  CL**2
00387      PERFORM DATA-READ THRU DATA-READ-XIT.                           CL**2
00388      IF DATA-RETURN-CODE NOT EQUAL ZERO                              CL**2
00389          GO TO PROCESS-CHG.                                          CL**2
00390      MOVE DATA-RECORD TO SAVE-DATA-RECORD.                           CL**2
           MOVE DATA-NEXT-REC TO SAVE-TRLR. 
           MOVE NEW-NAME TO SAVE-REC-ID.
00398          WRITE DATA-RECORD FROM SAVE-DATA-RECORD                     CL**2
00399          INVALID KEY                                                 CL**2
00400             MOVE "WRITE" TO IO-REASON1                               CL**2
00401             GO TO PROCESS-RENAME-200.                                CL**2
00407      ADD 1 TO DATA-NEXT-REC.                                         CL**2
00408      GO TO PROCESS-RENAME-100.                                       CL**2
00409  PROCESS-RENAME-200.                                                 CL**2
00410      MOVE NEW-NAME TO IO-NAME1.                                      CL**2
00411       MOVE ERROR-MSG8 TO ERROR-POS2.                                 CL**2
00412      GO TO PRINT-FATAL-ERROR.                                        CL**2
00413                                                                    DCUTL30
00414 ******************************************************************   CL**2
00415 *                                                                    CL**2
00416 *     CHANGE REFERENCES                                              CL**2
00417 *       1. DC2-ALL-NAMES                                             CL**2
00418 *       2. MAST2 RECORD FOR OLD NAME                                 CL**2
00419 *       3. MAST2 POINTERS TO OLD NAME                                CL**2
00420 *       4. STRUCTURE LINES*                                          CL**2
00421 *                                                                    CL**2
00422 ******************************************************************   CL**2
00423  PROCESS-CHG.                                                        CL**2
00424      MOVE OLD-NAME TO RENAME1.                                       CL**2
00425      MOVE NEW-NAME TO RENAME2.                                       CL**2
00426      MOVE BASIC-MSG TO ERROR-POS2.                                   CL**2
00427      MOVE PROG-ID TO ERROR-POS1.                                     CL**2
00428      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00429 ******************************************************************   CL**2
00430 *                                                                    CL**2
00431 *       DC2-ALL-NAMES                                                CL**2
00432 *                                                                    CL**2
00433 ******************************************************************   CL**2
00434      MOVE ALL-NAMES-LITERAL TO REL-ENTRY-NAME.                       CL**2
00435      MOVE NEW-NAME TO REL-POINTER-NAME.                              CL**2
00436      MOVE SAVE-ENTRY-TYPE TO REL-POINTER-TYPE.                       CL**2
00437      PERFORM REL-ADD-PTR THRU REL-ADD-PTR-XIT.                       CL**2
00438      IF CHG-REF-FLAG EQUAL "N"                                       CL**2
00439          MOVE NEW-NAME TO REL-ENTRY-NAME                             CL**2
               MOVE SAVE-ENTRY-TYPE TO REL-ENTRY-TYPE 
00440          PERFORM REL-ADD THRU REL-ADD-XIT                            CL**2
00441          GO TO PROCESS-DELETE.                                       CL**2
00442      MOVE ZERO TO REL-NEXT-REC.                                      CL**2
00443 ****************************************************************     CL**2
00444 *       MAST2 RECORD FOR OLD NAME                                    CL**2
00445 ****************************************************************     CL**2
00446  PROCESS-CHG-100.                                                    CL**2
00447      MOVE OLD-NAME TO REL-ENTRY-NAME.                                CL**2
00448      PERFORM RELALG THRU RELALG-XIT.                                 CL**2
00449      READ MAST2                                                      CL**2
00450          INVALID KEY GO TO REPLACE-STC-LINES.                        CL**2
           MOVE REL-HDR-ENTRY-TYPE TO REL-ENTRY-TYPE. 
00452      MOVE REL-HDR-ALIAS TO REL-ENTRY-ALIAS.                          CL**2
00453      MOVE NEW-NAME TO REL-ENTRY-NAME.                                CL**2
00454      PERFORM REL-WRITE THRU REL-WRITE-XIT.                           CL**2
00455      MOVE OLD-NAME TO REL-ENTRY-NAME.                                CL**2
00456      PERFORM REL-SET-UP THRU REL-SET-UP-XIT.                         CL**2
00457      IF REL-NEXT-REC NOT EQUAL ZERO                                  CL**2
           DELETE MAST2 GO TO PROCESS-CHG-105.
00459      PERFORM REL-REWRITE THRU REL-REWRITE-XIT.                       CL**2
       PROCESS-CHG-105. 
00460      ADD 1 TO REL-NEXT-REC.                                          CL**2
00461      GO TO PROCESS-CHG-100.                                          CL**2
00462  REPLACE-STC-LINES.                                                  CL**2
00463      MOVE OLD-NAME TO DATA-ENTRY-NAME.                               CL**2
00464 ***********************************************************          CL**2
00465 ***********************************************************          CL**2
00466 *       MAST2 POINTERS TO OLD NAME                                   CL**2
00467 *                                                                    CL**2
00468 ************************************************************         CL**2
00469 ***********************************************************          CL**2
00470      PERFORM RNM-READ-FIRST-DATA THRU RNM-READ-FIRST-DATA-XIT.       CL**2
00471      IF DATA-RETURN-CODE EQUAL TO 0 OR 1 OR 2                        CL**2
00472          GO TO DEL-WU-15.                                            CL**2
00473      MOVE OLD-NAME TO IO-NAME1.                                      CL**2
00474      MOVE "READ" TO IO-REASON1.                                      CL**2
00475      MOVE ERROR-MSG8 TO ERROR-POS2.                                  CL**2
00476      GO TO PRINT-FATAL-ERROR.                                        CL**2
  
       DEL-WU-10. 
  
      *    CHECK IF ANY INFORMATION WAS STORED IN THE 
      *    SAVE-AREA FOR LINES THAT CONTAIN MORE THAN 
      *    ONE CATNAME. 
  
           IF CAT-NAME-1 IS NOT EQUAL TO SPACES 
           THEN 
              MOVE CAT-NAME-1 TO WORK-KEY 
              PERFORM READ-WORK-FILE THRU READ-WORK-FILE-XIT
              IF WORK-KEY-INVALID 
              THEN
                 MOVE CAT-NAME-1 TO REL-ENTRY-NAME
                 MOVE SPACES TO CAT-NAME-1
                 GO TO DEL-WU-30
              END-IF
           END-IF.
           IF CAT-NAME-2 IS NOT EQUAL TO SPACES 
           THEN 
              MOVE CAT-NAME-2 TO WORK-KEY 
              PERFORM READ-WORK-FILE THRU READ-WORK-FILE-XIT
              IF WORK-KEY-INVALID 
              THEN
                 MOVE CAT-NAME-2 TO REL-ENTRY-NAME
                 MOVE SPACES TO CAT-NAME-2
                 GO TO DEL-WU-30
              END-IF
           END-IF.
           IF CAT-NAME-3 IS NOT EQUAL TO SPACES 
           THEN 
              MOVE CAT-NAME-3 TO WORK-KEY 
              PERFORM READ-WORK-FILE THRU READ-WORK-FILE-XIT
              IF WORK-KEY-INVALID 
              THEN
                 MOVE CAT-NAME-3 TO REL-ENTRY-NAME
                 MOVE SPACES TO CAT-NAME-3
                 GO TO DEL-WU-30
              END-IF
           END-IF.
           IF CAT-NAME-4 IS NOT EQUAL TO SPACES 
           THEN 
              MOVE CAT-NAME-4 TO WORK-KEY 
              PERFORM READ-WORK-FILE THRU READ-WORK-FILE-XIT
              IF WORK-KEY-INVALID 
              THEN
                 MOVE CAT-NAME-4 TO REL-ENTRY-NAME
                 MOVE SPACES TO CAT-NAME-4
                 GO TO DEL-WU-30
              END-IF
           END-IF.
           IF CAT-NAME-5 IS NOT EQUAL TO SPACES 
           THEN 
              MOVE CAT-NAME-5 TO WORK-KEY 
              PERFORM READ-WORK-FILE THRU READ-WORK-FILE-XIT
              IF WORK-KEY-INVALID 
              THEN
                 MOVE CAT-NAME-5 TO REL-ENTRY-NAME
                 MOVE SPACES TO CAT-NAME-5
                 GO TO DEL-WU-30
              END-IF
           END-IF.
      * 
      *    FIND CATEGORY LINES IN DATA ENTRY
      *    BUT FIRST, INITIALIZE CAT-DETAIL 
      * 
           MOVE SPACES TO CAT-DETAIL. 
00481      PERFORM RNM-READ-NEXT-DATA THRU RNM-READ-NEXT-DATA-XIT.         CL**2
           MOVE SPACES TO MULT-CAT-SAVE-AREAS.
00482  DEL-WU-15.                                                          CL**2
00483      IF DATA-RETURN-CODE EQUAL TO 1                                  CL**2
00484          GO TO REPLACE-STC-1000.                                     CL**2
00485      IF CAT-COMMENT EQUAL TO "*"                                     CL**2
00486          GO TO DEL-WU-10.                                            CL**2
      * 
      *    CHECK IF THE CATEGORY IN THE DETAIL LINE IS ONE OF 
      *    THE CATEGORIES THAT REQUIRES FURTHER PROCESSING. 
      *    IF NOT, READ NEXT DETAIL LINE. THE CATEGORIES
      *    THAT REQUIRE FURTHER PROCESSING ARE: 
      * 
      *        010    CONTROL (EALIASOF/VERSION)
      *        300    STRUCTURE 
      *        400    PROCESS 
      *        425    ACCESS
      *        450    MDINFO
      *        500    AREAKEYS
      *        525    SSREL 
      *        550    CONSTRAINTS 
      *        575    JOINS 
      *        800    RELATIONAL
      * 
  
           IF ( CAT-CATEGORY IS NOT EQUAL TO
              010 AND 300 AND 400 AND 425 AND 450 AND 500 
              AND 525 AND 550 AND 575 AND 800 ) 
           THEN 
              GO TO DEL-WU-10 
           END-IF.
  
      *    CHECK IF THE STRUCTURE LINE FOUND BELONGS
      *    TO THE TOTAL RECORD, LINE TYPES: B OR C
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 13 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 300 )
              AND ( CTL-LINE-TYPE IS EQUAL TO "B" OR "C" )) 
              GO TO DEL-WU-10 
           END-IF.
  
      *    IF THE ENTITY IS AN AREA AND THE CATEGORY IS 
      *    ACCESS, THEN IF THE LINE-TYPE IS "M" OR IF THE 
      *    LOCK IN THE "L" LINE-TYPE IS A LITERAL, RETURN TO
      *    READ THE NEXT DATA LINE. 
  
           IF DATA-HDR-ENT-ID IS EQUAL TO 22
              AND CAT-CATEGORY IS EQUAL TO 425
           THEN 
              IF CTL-LINE-TYPE IS EQUAL TO "M"
               GO TO DEL-WU-10
              END-IF
              IF (( CTL-LINE-TYPE IS EQUAL TO "L" ) 
                 AND ACC-A-TYPE IS EQUAL TO "L" ) 
                 GO TO DEL-WU-10
              END-IF
           END-IF.
  
      *    IF THE ENTITY IS A FILE AND THE CATEGORY 
      *    IS MDINFO, RETURN TO READ ANOTHER DATA LINE. 
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 20 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 450 )) 
           THEN 
              GO TO DEL-WU-10 
           END-IF.
  
      *    IF THE ENTITY IS A SUBSCHEMA AND THE CATEGORY
      *    IS MDINFO, RETURN TO READ ANOTHER DATA LINE. 
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 24 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 450 )) 
           THEN 
              GO TO DEL-WU-10 
           END-IF.
  
      * 
      *    DELETE RELATIONAL FILE POINTERS
      * 
  
       DEL-WU-20. 
  
      *     DBPROCS USED BY ELEMENTS, RECORDS OR AREAS. 
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 05 OR 13 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 400 )) 
              GO TO DEL-WU-25 
           END-IF.
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 22 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 400 )
              AND ( CTL-LINE-TYPE IS EQUAL TO "P" ))
              GO TO DEL-WU-25 
           END-IF.
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 22 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 425 )
              AND ( CTL-LINE-TYPE IS EQUAL TO "L" ))
              GO TO DEL-WU-25 
           END-IF.
  
      *    ELEMENT OR GROUP USED BY GROUP 
      *    OR RECORD STRUCTURE
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 10 OR 13 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 300 )) 
           THEN 
              IF ( CTL-LINE-TYPE IS EQUAL TO "A" )
              THEN
                 IF ( STC-REDEFINES IS NOT EQUAL TO SPACES )
                     MOVE STC-REDEFINES TO CAT-NAME-1 
                 END-IF 
                 GO TO DEL-WU-25
              END-IF
              IF CTL-LINE-TYPE IS EQUAL TO "O"
              THEN
                 IF (( STC-TO IS NOT EQUAL TO SPACES )
                    AND ( STC-TO IS NOT NUMERIC ))
                    MOVE STC-TO TO REL-ENTRY-NAME 
                 END-IF 
                 IF STC-DEPEND IS NOT EQUAL TO SPACES 
                    MOVE STC-DEPEND TO CAT-NAME-2 
                 END-IF 
                 IF STC-DEPEND-QUAL1 IS NOT EQUAL TO SPACES 
                    MOVE STC-DEPEND-QUAL1 TO CAT-NAME-3 
                 END-IF 
                 IF STC-DEPEND-QUAL2 IS NOT EQUAL TO SPACES 
                    MOVE STC-DEPEND-QUAL2 TO CAT-NAME-3 
                 END-IF 
                 GO TO DEL-WU-30
              END-IF
              IF CTL-LINE-TYPE IS EQUAL TO "D"
              THEN
                 IF STC-DEPEND-QUAL4 IS NOT EQUAL TO SPACES 
                    MOVE STC-DEPEND-QUAL4 TO CAT-NAME-1 
                 END-IF 
                 IF STC-DEPEND-QUAL5 IS NOT EQUAL TO SPACES 
                    MOVE STC-DEPEND-QUAL5 TO CAT-NAME-2 
                 END-IF 
                 GO TO DEL-WU-25
              END-IF
              IF CTL-LINE-TYPE IS EQUAL TO "K"
                 GO TO DEL-WU-30
              END-IF
              IF ( CTL-LINE-TYPE IS EQUAL TO "R" OR "T" ) 
              THEN
                 IF STC-QUAL1 IS NOT EQUAL TO SPACES
                    MOVE STC-QUAL1 TO CAT-NAME-1
                 END-IF 
                 IF STC-QUAL2 IS NOT EQUAL TO SPACES
                    MOVE STC-QUAL2 TO CAT-NAME-2
                 END-IF 
                 IF STC-QUAL3 IS NOT EQUAL TO SPACES
                    MOVE STC-QUAL3 TO CAT-NAME-3
                 END-IF 
                 GO TO DEL-WU-25
              END-IF
              IF ( CTL-LINE-TYPE IS EQUAL TO "Q" OR "2")
              THEN
                 IF STC-QUAL5 IS NOT EQUAL TO SPACES
                    MOVE STC-QUAL5 TO CAT-NAME-1
                 END-IF 
                 GO TO DEL-WU-25
           END-IF.
  
      *    ELEMENT, GROUP, OR RECORD USED BY AREAS
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 22 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 400 )
              AND ( CTL-LINE-TYPE IS EQUAL TO "R" ))
           THEN 
              IF GEN-QUAL IS NOT EQUAL TO SPACES
                 MOVE GEN-QUAL TO CAT-NAME-1
              END-IF
              GO TO DEL-WU-25 
           END-IF.
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 22 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 500 )
              AND ( CTL-LINE-TYPE IS EQUAL TO "K" OR "I" )) 
           THEN 
              IF GEN-QUAL IS NOT EQUAL TO SPACES
                 MOVE GEN-QUAL TO CAT-NAME-1
              END-IF
              GO TO DEL-WU-25 
           END-IF.
  
      *    ELEMENT, GROUP OR RECORD USED BY SUBSCHEMAS
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 24 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 525 )) 
           THEN 
              IF ( CTL-LINE-TYPE IS EQUAL TO "R" )
                 MOVE RESTRICT-NAME TO REL-ENTRY-NAME 
                 GO TO DEL-WU-30
              END-IF
              IF ( CTL-LINE-TYPE IS EQUAL TO "I" )
              THEN
                 IF (( ID1 IS NOT EQUAL TO SPACES ) 
                    AND ( ID1-TYPE IS EQUAL TO "C" )) 
                    MOVE ID1 TO REL-ENTRY-NAME
                 END-IF 
                 IF (( ID2 IS NOT EQUAL TO SPACES ) 
                    AND ( ID2-TYPE IS EQUAL TO "C" )) 
                    MOVE ID2 TO CAT-NAME-1
                 END-IF 
                 GO TO DEL-WU-30
              END-IF
              IF ( CTL-LINE-TYPE IS EQUAL TO "Q" OR "2" OR "B" OR "3" ) 
              THEN
                 IF SS-QUAL2 IS NOT EQUAL TO SPACES 
                    MOVE SS-QUAL2 TO CAT-NAME-1 
                 END-IF 
                 IF SS-QUAL3 IS NOT EQUAL TO SPACES 
                    MOVE SS-QUAL3 TO CAT-NAME-2 
                 END-IF 
                 GO TO DEL-WU-25
           END-IF.
  
      *    IF THE CURRENT ENTITY IS A SCHEMA AND THE
      *    CATEGORY IS MDINFO, SKIP THE SCHEMA LFN
      *    LINE TYPE. 
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 26 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 450 )
              AND ( CTL-LINE-TYPE IS EQUAL TO "L" ))
           THEN 
              GO TO DEL-WU-10 
           END-IF.
  
      *    ELEMENT, GROUP OR RECORD USED BY SCHEMAS 
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 26 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 550 )) 
           THEN 
              IF CTL-LINE-TYPE IS EQUAL TO "N"
              THEN
                 IF CON-QUAL IS NOT EQUAL TO SPACES 
                    MOVE CON-QUAL TO CAT-NAME-1 
                 END-IF 
                 MOVE CON-CATNAME TO REL-ENTRY-NAME 
                 GO TO DEL-WU-30
              END-IF
              IF CTL-LINE-TYPE IS EQUAL TO "O"
              THEN
                 IF GEN-QUAL IS NOT EQUAL TO SPACES 
                    MOVE GEN-QUAL TO CAT-NAME-1 
                 END-IF 
                 GO TO DEL-WU-25
              END-IF
           END-IF.
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 26 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 575 )) 
           THEN 
              IF ( CTL-LINE-TYPE IS EQUAL TO "B" OR "C" ) 
              THEN
                 IF ( JOIN-QUAL1 IS NOT EQUAL TO SPACES ) 
                 THEN 
                    MOVE JOIN-QUAL1 TO CAT-NAME-1 
                    GO TO DEL-WU-25 
                 END-IF 
              ELSE
                 GO TO DEL-WU-10
           END-IF.
  
      *    RECORD USED BY AREA STRUCTURE
  
           IF ((  DATA-HDR-ENT-ID IS EQUAL TO 22 )
              AND ( CAT-CATEGORY IS EQUAL TO 300 )) 
              GO TO DEL-WU-25 
           END-IF.
  
      *    FILE USED BY AREA MDINFO 
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 22 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 450 )
              AND ( CTL-LINE-TYPE IS EQUAL TO "A" ))
              GO TO DEL-WU-25 
           END-IF.
  
      *    FILE USED BY SCHEMA MDINFO 
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 26 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 450 )) 
           THEN 
              IF ( CTL-LINE-TYPE IS EQUAL TO "P" OR "T" 
              OR "R" OR "J" OR "Q" )
              GO TO DEL-WU-25 
           ELSE 
              GO TO DEL-WU-10 
           END-IF.
  
  
       DEL-WU-25. 
  
           IF CTL-ALY-VER IS EQUAL TO SPACES OR "FILLER"
              GO TO DEL-WU-10 
           END-IF.
  
  
           MOVE CTL-ALY-VER TO REL-ENTRY-NAME.
  
       DEL-WU-30. 
  
00513      PERFORM REL-CHG-PTR THRU REL-CHG-PTR-XIT.                       CL**2
00514      MOVE REL-ENTRY-NAME TO RENAME3.                                 CL**2
00515      MOVE NEW-NAME TO RENAME4.                                       CL**2
00516      MOVE MSG2 TO ERROR-POS2.                                        CL**2
00517      MOVE PROG-ID TO ERROR-POS1.                                     CL**2
00518      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
           MOVE REL-ENTRY-NAME TO WORK-KEY. 
           PERFORM READ-WORK-FILE THRU READ-WORK-FILE-XIT.
           IF WORK-KEY-VALID
           THEN 
              GO TO DEL-WU-10 
           ELSE 
              PERFORM WRITE-WORK-FILE THRU WRITE-WORK-FILE-XIT
           END-IF.
           IF REL-RETURN-CODE IS EQUAL TO 1 
00520          MOVE REL-POINTER-NAME TO IO-NAME2                           CL**2
00521          MOVE "DEL-PTR" TO IO-REASON2                                CL**2
00522          MOVE ERROR-MSG9 TO ERROR-POS2                               CL**2
00523          GO TO PRINT-FATAL-ERROR.                                    CL**2
00524      GO TO DEL-WU-10.                                                CL**2
00525 *                                                                    CL**2
00526 *                                                                    CL**2
00527 *                                                                    CL**2
00528  REPLACE-STC-1000.                                                   CL**2
00529      MOVE NEW-NAME TO REL-ENTRY-NAME.                                CL**2
00530      MOVE "N" TO REL-ENTRY-FUNCTION.                                 CL**2
00531      PERFORM REL-READ THRU REL-READ-XIT.                             CL**2
00532      IF REL-RETURN-CODE NOT EQUAL ZERO                               CL**2
00533          GO TO PROCESS-DELETE.                                       CL**2
00534      MOVE REL-POINTER-NAME TO DATA-ENTRY-NAME.                       CL**2
00535 ***********************************************************          CL**2
00536 ***********************************************************          CL**2
00537 *                                                                    CL**2
      * 
      *       EXAMINE CATEGORY DETAIL LINES 
      * 
00539 *                                                                    CL**2
00540 ************************************************************         CL**2
00541 ***********************************************************          CL**2
00542      PERFORM RNM-READ-FIRST-DATA THRU RNM-READ-FIRST-DATA-XIT.       CL**2
00543      IF DATA-RETURN-CODE EQUAL TO 0 OR 1 OR 2                        CL**2
00544          GO TO REPLACE-STC-1200.                                     CL**2
00545      MOVE "READ" TO IO-REASON1.                                      CL**2
00546      GO TO PRINT-FATAL-ERROR.                                        CL**2
00547  REPLACE-STC-1100.                                                   CL**2
00548 *                                                                    CL**2
      * 
      *    FIND CONTROL, STRUCTURE, PROCESS, ACCESS,
      *    MDINFO, AREAKEYS, SSREL, CONSTRAINTS AND 
      *    JOINS CATEGORY LINES IN DATA FILE. 
00550 *                                                                    CL**2
00551      PERFORM RNM-READ-NEXT-DATA THRU RNM-READ-NEXT-DATA-XIT.         CL**2
00552  REPLACE-STC-1200.                                                   CL**2
00553      IF DATA-RETURN-CODE EQUAL TO 1                                  CL**2
00554          GO TO REPLACE-STC-1000.                                     CL**2
00555      IF CAT-COMMENT EQUAL TO "*"                                     CL**2
00556          GO TO REPLACE-STC-1100.                                     CL**2
  
           IF ( CAT-CATEGORY IS NOT EQUAL TO
               010 AND 300 AND 400 AND 425 AND 450 AND 500
               AND 525 AND 550 AND 575 AND 800 )
           THEN 
               GO TO REPLACE-STC-1100 
           END-IF.
  
      *    CHECK IF THE STRUCTURE LINE FOUND BELONGS
      *    TO THE TOTAL RECORD, LINE TYPES: B OR C
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 13 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 300 )
              AND ( CTL-LINE-TYPE IS EQUAL TO "B" OR "C" )) 
              GO TO REPLACE-STC-1100
           END-IF.
  
      *    IF THE ENTITY IS AN AREA AND THE CATEGORY IS 
      *    ACCESS, THEN, IF THE LINE-TYPE IS "M" OR IF THE
      *    LOCK IS A LITERAL, RETURN TO READ THE NEXT DATA
      *    LINE.
  
           IF DATA-HDR-ENT-ID IS EQUAL TO 22
              AND CAT-CATEGORY IS EQUAL TO 425
           THEN 
              IF CTL-LINE-TYPE IS EQUAL TO "M"
               GO TO REPLACE-STC-1100 
              END-IF
              IF CTL-LINE-TYPE IS EQUAL TO "L"
                 AND ACC-A-TYPE IS EQUAL TO "L" 
                 GO TO REPLACE-STC-1100 
              END-IF
           END-IF.
  
      *    IF THE ENTITY IS A SUBSCHEMA AND THE CATEGORY
      *    IS MDINFO, RETURN TO READ ANOTHER DATA LINE. 
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 24 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 450 )) 
           THEN 
              GO TO REPLACE-STC-1100
           END-IF.
00561  REPLACE-STC-1300.                                                   CL**2
      * 
      *    DELETE THE DATA FILE REFERENCES
      * 
      *     DBPROCS USED BY ELEMENTS, RECORDS OR AREAS. 
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 05 OR 13 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 400 )) 
              GO TO REPLACE-STC-1350
           END-IF.
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 22 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 400 )
              AND ( CTL-LINE-TYPE IS EQUAL TO "P" ))
              GO TO REPLACE-STC-1350
           END-IF.
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 22 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 425 )
              AND ( CTL-LINE-TYPE IS EQUAL TO "L" ))
              GO TO REPLACE-STC-1350
           END-IF.
  
      *    ELEMENT OR GROUP USED BY GROUP 
      *    OR RECORD STRUCTURE
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 10 OR 13 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 300 )) 
           THEN 
              IF ( CTL-LINE-TYPE IS EQUAL TO "A" )
                 AND ( CTL-ALY-VER IS NOT EQUAL TO OLD-NAME ) 
                 AND ( STC-REDEFINES IS EQUAL TO OLD-NAME ) 
                 ADD 40 TO SAVE-DATA-SUB
                 GO TO REPLACE-STC-1377 
              END-IF
              IF CTL-LINE-TYPE IS EQUAL TO "O"
              THEN
                 IF STC-TO IS EQUAL TO OLD-NAME 
                    ADD 4 TO SAVE-DATA-SUB
                    GO TO REPLACE-STC-1377
                 END-IF 
                 IF STC-DEPEND IS EQUAL TO OLD-NAME 
                    ADD 40 TO SAVE-DATA-SUB 
                    GO TO REPLACE-STC-1377
                 END-IF 
                 IF STC-DEPEND-QUAL1 IS EQUAL TO OLD-NAME 
                    ADD 77 TO SAVE-DATA-SUB 
                    GO TO REPLACE-STC-1377
                 END-IF 
                 IF STC-DEPEND-QUAL2 IS EQUAL TO OLD-NAME 
                    ADD 109 TO SAVE-DATA-SUB
                    GO TO REPLACE-STC-1377
                 END-IF 
              END-IF
              IF CTL-LINE-TYPE IS EQUAL TO "D"
              THEN
                 IF STC-DEPEND-QUAL4 IS EQUAL TO OLD-NAME 
                    ADD 32 TO SAVE-DATA-SUB 
                    GO TO REPLACE-STC-1377
                 END-IF 
                 IF STC-DEPEND-QUAL5 IS EQUAL TO OLD-NAME 
                    ADD 64 TO SAVE-DATA-SUB 
                    GO TO REPLACE-STC-1377
                 END-IF 
              END-IF
              IF CTL-LINE-TYPE IS EQUAL TO "K"
                 GO TO REPLACE-STC-1350 
              END-IF
              IF ( CTL-LINE-TYPE IS EQUAL TO "R" OR "T" ) 
              THEN
                 IF STC-QUAL1 IS EQUAL TO OLD-NAME
                    ADD 37 TO SAVE-DATA-SUB 
                    GO TO REPLACE-STC-1377
                 END-IF 
                 IF STC-QUAL2 IS EQUAL TO OLD-NAME
                    ADD 69 TO SAVE-DATA-SUB 
                    GO TO REPLACE-STC-1377
                 END-IF 
                 IF STC-QUAL3 IS EQUAL TO OLD-NAME
                    ADD 101 TO SAVE-DATA-SUB
                    GO TO REPLACE-STC-1377
                 END-IF 
                 GO TO REPLACE-STC-1350 
              END-IF
              IF ( CTL-LINE-TYPE IS EQUAL TO "Q" OR "2" ) 
              THEN
                 IF STC-QUAL4 IS EQUAL TO OLD-NAME
                    GO TO REPLACE-STC-1350
                 END-IF 
                 IF STC-QUAL5 IS EQUAL TO OLD-NAME
                    ADD 32 TO SAVE-DATA-SUB 
                    GO TO REPLACE-STC-1377
                 END-IF 
              END-IF
           END-IF.
  
      *    ELEMENT, GROUP, OR RECORD USED BY AREAS
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 22 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 400 )
              AND ( CTL-LINE-TYPE IS EQUAL TO "R" ))
           THEN 
              IF GEN-QUAL IS EQUAL TO OLD-NAME
                 ADD 36 TO SAVE-DATA-SUB
                 GO TO REPLACE-STC-1377 
              END-IF
              GO TO REPLACE-STC-1350
           END-IF.
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 22 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 500 )
              AND ( CTL-LINE-TYPE IS EQUAL TO "K" OR "I" )) 
           THEN 
              IF GEN-QUAL IS EQUAL TO OLD-NAME
                 ADD 36 TO SAVE-DATA-SUB
                 GO TO REPLACE-STC-1377 
              END-IF
              GO TO REPLACE-STC-1350
           END-IF.
  
      *    ELEMENT, GROUP OR RECORD USED BY SUBSCHEMAS
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 24 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 525 )) 
           THEN 
              IF (( CTL-LINE-TYPE IS EQUAL TO "R" ) 
                 AND ( RESTRICT-NAME IS EQUAL TO OLD-NAME ))
                 ADD 30 TO SAVE-DATA-SUB
                 GO TO REPLACE-STC-1377 
              END-IF
              IF CTL-LINE-TYPE IS EQUAL TO "I"
              THEN
                 IF ID2 IS EQUAL TO OLD-NAME
                    ADD 57 TO SAVE-DATA-SUB 
                    GO TO REPLACE-STC-1377
                 END-IF 
                 IF ID1 IS EQUAL TO OLD-NAME
                    ADD 5 TO SAVE-DATA-SUB
                    GO TO REPLACE-STC-1377
                 END-IF 
              END-IF
              IF ( CTL-LINE-TYPE IS EQUAL TO "Q" OR "2" OR "B" OR "3" ) 
              THEN
                 IF SS-QUAL1 IS EQUAL TO OLD-NAME 
                    GO TO REPLACE-STC-1350
                 END-IF 
                 IF SS-QUAL2 IS EQUAL TO OLD-NAME 
                    ADD 44 TO SAVE-DATA-SUB 
                    GO TO REPLACE-STC-1377
                 END-IF 
                 IF SS-QUAL3 IS EQUAL TO OLD-NAME 
                    ADD 88 TO SAVE-DATA-SUB 
                    GO TO REPLACE-STC-1377
                 END-IF 
              END-IF
           END-IF.
  
      *    ELEMENT, GROUP OR RECORD USED BY SCHEMAS 
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 26 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 550 )) 
           THEN 
              IF CTL-LINE-TYPE IS EQUAL TO "N"
              THEN
                 IF CON-QUAL IS EQUAL TO OLD-NAME 
                    ADD 66 TO SAVE-DATA-SUB 
                    GO TO REPLACE-STC-1377
                 END-IF 
                 IF CON-CATNAME IS EQUAL TO OLD-NAME
                    ADD 30 TO SAVE-DATA-SUB 
                    GO TO REPLACE-STC-1377
                 END-IF 
              END-IF
              IF CTL-LINE-TYPE IS EQUAL TO "O"
              THEN
                 IF GEN-QUAL IS EQUAL TO OLD-NAME 
                    ADD 36 TO SAVE-DATA-SUB 
                    GO TO REPLACE-STC-1377
                 END-IF 
                 GO TO REPLACE-STC-1350 
              END-IF
           END-IF.
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 26 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 575 )) 
           THEN 
              IF ( CTL-LINE-TYPE IS EQUAL TO "B" OR "C" ) 
              THEN
                 IF JOIN-QUAL1 IS EQUAL TO OLD-NAME 
                    ADD 48 TO SAVE-DATA-SUB 
                    GO TO REPLACE-STC-1377
                 END-IF 
              ELSE
                 GO TO REPLACE-STC-1100 
           END-IF.
  
      *    RECORD USED BY AREA STRUCTURE
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 22 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 300 )) 
              GO TO REPLACE-STC-1350
           END-IF.
  
      *    FILE USED BY AREA MDINFO 
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 22 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 450 )
              AND ( CTL-LINE-TYPE IS EQUAL TO "A" ))
              GO TO REPLACE-STC-1350
           END-IF.
  
      *    FILE USED BY SCHEMA MDINFO 
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 26 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 450 )
              AND ( CTL-LINE-TYPE IS EQUAL TO "P" OR "T"
              OR "R" OR "J" OR "Q" )) 
              GO TO REPLACE-STC-1350
           END-IF.
  
      *    AREA USED BY SUBSCHEMA AND SCHEMAS 
      *    OR SUBSCHEMAS USED BY SCHEMAS
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 24 OR 26 ) 
              AND ( CAT-CATEGORY IS EQUAL TO 300 )) 
              GO TO REPLACE-STC-1350
           END-IF.
       REPLACE-STC-1350.
  
           IF CTL-ALY-VER IS EQUAL TO SPACES OR "FILLER"
              GO TO REPLACE-STC-1100
           END-IF.
  
           IF CTL-ALY-VER IS NOT EQUAL TO OLD-NAME
              GO TO REPLACE-STC-1100
           END-IF.
  
       REPLACE-STC-1377.
  
           MOVE 1 TO MOVE-SUB.
      *    WE ADD TWO TO SAVE-DATA-SUB TO PREVENT OVERWRITING 
      *    THE LINE-TYPE THAT PRECEEDS THE NAME IN VERSION 2.0. 
           ADD 2 TO SAVE-DATA-SUB.
  
00586  REPLACE-STC-1400.                                                   CL**2
00587      MOVE NAME-NEW-SUB (MOVE-SUB) TO DATA-DETAIL (SAVE-DATA-SUB).    CL**2
00588      ADD 1 TO MOVE-SUB.                                              CL**2
00589      ADD 1 TO SAVE-DATA-SUB.                                         CL**2
00590      IF MOVE-SUB LESS THAN 33                                        CL**2
00591            GO TO REPLACE-STC-1400.                                   CL**2
00592  REPLACE-STC-1500.                                                   CL**2
00593      MOVE NEW-NAME TO RENAME3.                                       CL**2
00594      MOVE REL-POINTER-NAME TO RENAME4.                               CL**2
00595      MOVE MSG2 TO ERROR-POS2.                                        CL**2
00596      MOVE PROG-ID TO ERROR-POS1.                                     CL**2
00597      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00598      GO TO REPLACE-STC-1100.                                         CL**2
00599                                                                    DCUTL30
00600  PROCESS-DELETE.                                                     CL**2
           MOVE 0 TO DATA-RETURN-CODE.
00601      IF DEL-OLD-FLAG EQUAL "N"                                       CL**2
00602          GO TO FINISH-PROCESS.                                       CL**2
00603 ********************************************************             CL**2
00604 *                                                                    CL**2
00605 *     DELETE REL DATA AND SYS                                        CL**2
00606 *                                                                    CL**2
00607 ********************************************************             CL**2
00608  DEL-REL-DATA.                                                       CL**2
00609      MOVE OLD-NAME TO REL-ENTRY-NAME.                                CL**2
00610      PERFORM REL-DELETE THRU REL-DELETE-XIT.                         CL**2
00611      IF REL-RETURN-CODE NOT EQUAL TO ZERO                            CL**2
00612          MOVE OLD-NAME TO IO-NAME2                                   CL**2
00613          MOVE "DELETE" TO IO-REASON2                                 CL**2
00614          MOVE ERROR-MSG9 TO ERROR-POS2                               CL**2
00615          GO TO PRINT-FATAL-ERROR.                                    CL**2
00616      MOVE ZERO TO DATA-NEXT-REC.                                     CL**2
00617  DEL-REL-DATA-100.                                                   CL**2
00618      MOVE OLD-NAME TO DATA-ENTRY-NAME.                               CL**2
00619      PERFORM DATA-READ THRU DATA-READ-XIT.                           CL**2
           IF DATA-RETURN-CODE NOT = 0 GO TO DEL-REL-DATA-200.
           PERFORM DELETE-DATA THRU DELETE-DATA-XIT.
00622      ADD 1 TO DATA-NEXT-REC.                                         CL**2
00624          GO TO DEL-REL-DATA-100.                                     CL**2
00625  DEL-REL-DATA-200.                                                   CL**2
00626      MOVE REL-ENTRY-NAME TO REL-POINTER-NAME.                        CL**2
00627      MOVE ALL-NAMES-LITERAL TO REL-ENTRY-NAME.                       CL**2
00628      PERFORM REL-DEL-PTR THRU REL-DEL-PTR-XIT.                       CL**2
00629      IF REL-RETURN-CODE NOT EQUAL TO ZERO                            CL**2
00630          MOVE OLD-NAME TO IO-NAME2                                   CL**2
00631          MOVE "DEL SYS" TO IO-REASON2                                CL**2
00632          MOVE ERROR-MSG9 TO ERROR-POS2                               CL**2
00633          GO TO PRINT-FATAL-ERROR.                                    CL**2
00634      MOVE OLD-NAME TO RENAME5.                                       CL**2
00635      MOVE MSG3 TO ERROR-POS2.                                        CL**2
00636      MOVE PROG-ID TO ERROR-POS1.                                     CL**2
00637      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00638      GO TO FINISH-PROCESS.                                           CL**2
00639                                                                    DCUTL30
00640 ******************************************************************   CL**2
00641 * P R O C E S S   N U M B E R   T R A N S A C T I O N                CL**2
00642 ******************************************************************   CL**2
00643  PROCESS-NUMBER.                                                     CL**2
00644      MOVE 5 TO BYLINE.                                               CL**2
00645      MOVE "ALL" TO CAT-NAME.                                         CL**2
00646      MOVE SPACE TO FROMLINE.                                         CL**2
00647      MOVE 9999 TO TOLINE.                                            CL**2
00648      MOVE ZERO TO STARTLINE.                                         CL**2
00649      OPEN INPUT MAST3.                                               CL**2
           MOVE 4 TO CONTROL-NOM-KEY. 
00651      READ MAST3                                                      CL**2
00652          INVALID KEY                                                 CL**2
00653            MOVE "CONTROL" TO IO-REASON1                              CL**2
00654            GO TO PROCESS-RENAME-200.                                 CL**2
00655      MOVE CTL-RECORD-4 TO CAT-TABLE.                                 CL**2
00656      CLOSE MAST3.                                                    CL**2
00657 ******************************************************************   CL**2
00658 *                                                                    CL**2
00659 *        EDIT THE NUMBER TRANSACTION                                 CL**2
00660 *            FIRST FIND THE CATALOGUE NAME                           CL**2
00661 *                                                                    CL**2
00662 ******************************************************************   CL**2
00663      MOVE ZERO TO TX-SUB.                                            CL**2
00664      MOVE SPACE TO TEST-CHAR.                                        CL**2
00665      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                           CL**2
00666      PERFORM FIND-BLANK THRU FIND-BLANK-XIT.                         CL**2
00667      MOVE EQUAL-SIGN TO TEST-CHAR.                                   CL**2
00668      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                           CL**2
00669      IF CHAR-NOT-FOUND NOT EQUAL "Y"                                 CL**2
00670          GO TO ILLEGAL-RENAME-SYNTAX.                                CL**2
00671      IF SCAN-FIELD-3 NOT EQUAL "CAT"                                 CL**2
00672          MOVE ERROR-MSG1 TO ERROR-POS2                               CL**2
00673          GO TO PRINT-FATAL-ERROR.                                    CL**2
00674      PERFORM FIND-BLANK THRU FIND-BLANK-XIT.                         CL**2
00675      MOVE COMMA-CHAR TO TEST-CHAR.                                   CL**2
00676      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                           CL**2
00677      MOVE SCAN-FIELD-32 TO OLD-NAME.                                 CL**2
00678      MOVE OLD-NAME TO DATA-ENTRY-NAME.                               CL**2
00679      MOVE ZERO TO DATA-NEXT-REC.                                     CL**2
00680      MOVE ZERO TO DATA-RETURN-CODE.                                  CL**2
00681      PERFORM DATA-READ THRU DATA-READ-XIT.                           CL**2
00682      IF DATA-RETURN-CODE NOT EQUAL ZERO                              CL**2
00683          MOVE ERROR-MSG2 TO ERROR-POS2                               CL**2
00684          GO TO PRINT-FATAL-ERROR.                                    CL**2
00685      MOVE DATA-ENTRY-TYPE TO SAVE-ENTRY-TYPE.                        CL**2
00686      IF CHAR-NOT-FOUND NOT EQUAL "Y"                                 CL**2
00687          GO TO DO-NUMBER.                                            CL**2
00688 ******************************************************************   CL**2
00689 *     LOOK FOR OPTIONS                                               CL**2
00690 ******************************************************************   CL**2
00691  GET-NEXT-OPERAND.                                                   CL**2
00692      PERFORM FIND-BLANK THRU FIND-BLANK-XIT.                         CL**2
00693      IF END-OF-CARD EQUAL "Y"                                        CL**2
00694          PERFORM GET-NEXT-CARD THRU GET-NEXT-CARD-XIT.               CL**2
00695      MOVE EQUAL-SIGN TO TEST-CHAR.                                   CL**2
00696      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                           CL**2
00697      IF CHAR-NOT-FOUND NOT EQUAL "Y"                                 CL**2
00698          GO TO ILLEGAL-RENAME-SYNTAX.                                CL**2
00699      MOVE SCAN-FIELD-3 TO SAVE-KEYWORD.                              CL**2
00700      PERFORM FIND-BLANK THRU FIND-BLANK-XIT.                         CL**2
00701      MOVE COMMA-CHAR TO TEST-CHAR.                                   CL**2
00702      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                           CL**2
00703      MOVE SCAN-FIELD-4 TO SAVE-OPERAND.                              CL**2
00704      IF SAVE-KEYWORD EQUAL "CAT"                                     CL**2
00705          GO TO EDIT-CATEGORY.                                        CL**2
00706      IF SCAN-FIELD-4TH NOT EQUAL SPACE                               CL**2
00707          GO TO GET-NEXT-OPERAND-200.                                 CL**2
00708      MOVE SCAN-FIELD-3RD TO SCAN-FIELD-4TH.                          CL**2
00709      MOVE SCAN-FIELD-2ND TO SCAN-FIELD-3RD.                          CL**2
00710      MOVE SCAN-FIELD-1 TO SCAN-FIELD-2ND.                            CL**2
00711      MOVE ZERO TO SCAN-FIELD-1.                                      CL**2
00712      IF SCAN-FIELD-4TH NOT EQUAL SPACE                               CL**2
00713          GO TO GET-NEXT-OPERAND-200.                                 CL**2
00714      MOVE SCAN-FIELD-3RD TO SCAN-FIELD-4TH.                          CL**2
00715      MOVE SCAN-FIELD-2ND TO SCAN-FIELD-3RD.                          CL**2
00716      MOVE SCAN-FIELD-1 TO SCAN-FIELD-2ND.                            CL**2
00717      MOVE ZERO TO SCAN-FIELD-1.                                      CL**2
00718      IF SCAN-FIELD-4TH NOT EQUAL SPACE                               CL**2
00719          GO TO GET-NEXT-OPERAND-200.                                 CL**2
00720      MOVE SCAN-FIELD-3RD TO SCAN-FIELD-4TH.                          CL**2
00721      MOVE SCAN-FIELD-2ND TO SCAN-FIELD-3RD.                          CL**2
00722      MOVE SCAN-FIELD-1 TO SCAN-FIELD-2ND.                            CL**2
00723      MOVE ZERO TO SCAN-FIELD-1.                                      CL**2
00724  GET-NEXT-OPERAND-200.                                               CL**2
00725      MOVE SCAN-FIELD-4 TO SAVE-OPERAND.                              CL**2
00726      IF SAVE-OPERAND NOT NUMERIC                                     CL**2
00727          MOVE ERROR-MSG11 TO ERROR-POS2                              CL**2
00728          GO TO PRINT-FATAL-ERROR.                                    CL**2
00729      IF SAVE-KEYWORD EQUAL "BY"                                      CL**2
00730         MOVE SAVE-OPERAND TO BYLINE                                  CL**2
00731         GO TO CHECK-NEXT-OPERAND.                                    CL**2
00732      IF SAVE-KEYWORD EQUAL "FRO"                                     CL**2
00733         MOVE SAVE-OPERAND TO FROMLINE                                CL**2
00734         GO TO CHECK-NEXT-OPERAND.                                    CL**2
00735      IF SAVE-KEYWORD EQUAL "TOL"                                     CL**2
00736         MOVE SAVE-OPERAND TO TOLINE                                  CL**2
00737         GO TO CHECK-NEXT-OPERAND.                                    CL**2
00738      IF SAVE-KEYWORD EQUAL "STA"                                     CL**2
00739         MOVE SAVE-OPERAND TO STARTLINE                               CL**2
00740         GO TO CHECK-NEXT-OPERAND.                                    CL**2
00741      MOVE ERROR-MSG1 TO ERROR-POS2.                                  CL**2
00742      GO TO PRINT-FATAL-ERROR.                                        CL**2
00743  CHECK-NEXT-OPERAND.                                                 CL**2
00744      IF CHAR-NOT-FOUND NOT EQUAL "Y"                                 CL**2
00745          GO TO DO-NUMBER.                                            CL**2
00746      GO TO GET-NEXT-OPERAND.                                         CL**2
00747 ******************************************************************   CL**2
00748 *         EDIT CATEGORY KEYWORD                                      CL**2
00749 ******************************************************************   CL**2
00750  EDIT-CATEGORY.                                                      CL**2
00751      IF SAVE-OPERAND EQUAL "ALL"                                     CL**2
00752          GO TO CHECK-NEXT-OPERAND.                                   CL**2
00753      MOVE SAVE-OPERAND TO CAT-NAME.                                  CL**2
00754      MOVE 1 TO OPT-SUB.                                              CL**2
00755  EDIT-CATEGORY-100.                                                  CL**2
00756      IF SAVE-OPERAND EQUAL CATEGORY-NAME (OPT-SUB)                   CL**2
00757          MOVE CATEGORY-ID (OPT-SUB) TO CAT-NUM                       CL**2
00758          GO TO CHECK-NEXT-OPERAND.                                   CL**2
00759      ADD 1 TO OPT-SUB.                                               CL**2
           IF OPT-SUB IS LESS THAN 32 
00761          GO TO EDIT-CATEGORY-100.                                    CL**2
00762      MOVE ERROR-MSG15 TO ERROR-POS2.                                 CL**2
00763      GO TO PRINT-FATAL-ERROR.                                        CL**2
00764                                                                    DCUTL30
00765 ******************************************************************   CL**2
00766 *     TRANSACTION IS VALID                                           CL**2
00767 *         DO NUMBERING                                               CL**2
00768 ******************************************************************   CL**2
00769  DO-NUMBER.                                                          CL**2
00770      MOVE OLD-NAME TO DATA-ENTRY-NAME.                               CL**2
00771      MOVE ZERO TO DATA-NEXT-REC.                                     CL**2
00772      IF CAT-NAME EQUAL "ALL"                                         CL**2
00773           GO TO DO-NUMBER-ALL.                                       CL**2
00774 ******************************************************************   CL**2
00775 *           NUMBER A CATEGORY ONLY                                   CL**2
00776 *              FIRST CHECK THAT NUMBERING CAN BE DONE                CL**2
00777 ******************************************************************   CL**2
00778      MOVE CAT-NUM TO DATA-ENTRY-CAT.                                 CL**2
00779      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00780  DO-NUMBER-50.                                                       CL**2
00781      IF DATA-RETURN-CODE NOT EQUAL ZERO                              CL**2
00782          MOVE CAT-NAME TO CATEGORY-MISSING                           CL**2
00783          MOVE ERROR-MSG12 TO ERROR-POS2                              CL**2
00784          GO TO PRINT-FATAL-ERROR.                                    CL**2
00785      IF FROMLINE EQUAL SPACE                                         CL**2
00786           MOVE CAT-LINE TO FROMLINE                                  CL**2
00787           GO TO DO-NUMBER-200.                                       CL**2
00788  DO-NUMBER-100.                                                      CL**2
00789      IF CAT-LINE GREATER THAN FROMLINE                               CL**2
00790          GO TO DO-NUMBER-600.                                        CL**2
00791      IF CAT-LINE EQUAL FROMLINE                                      CL**2
00792          GO TO DO-NUMBER-200.                                        CL**2
00793       PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                CL**2
00794       IF DATA-RETURN-CODE EQUAL ZERO                                 CL**2
00795            GO TO DO-NUMBER-100.                                      CL**2
00796       GO TO DO-NUMBER-600.                                           CL**2
00797  DO-NUMBER-200.                                                      CL**2
00798      IF STARTLINE EQUAL ZERO                                         CL**2
00799           MOVE FROMLINE TO STARTLINE.                                CL**2
00800      MOVE STARTLINE TO SAVE-STARTLINE.                               CL**2
00801  DO-NUMBER-300.                                                      CL**2
00802      MOVE STARTLINE TO CAT-LINE.                                     CL**2
00803      ADD BYLINE TO STARTLINE.                                        CL**2
00804      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00805      IF DATA-RETURN-CODE NOT EQUAL ZERO                              CL**2
00806          GO TO DO-NUMBER-400.                                        CL**2
00807      IF CAT-LINE LESS THAN TOLINE                                    CL**2
00808      OR CAT-LINE EQUAL TO TOLINE                                     CL**2
00809          GO TO DO-NUMBER-300.                                        CL**2
00810       PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                CL**2
00811       IF DATA-RETURN-CODE NOT EQUAL ZERO                             CL**2
00812           GO TO DO-NUMBER-400.                                       CL**2
00813       SUBTRACT BYLINE FROM STARTLINE.                                CL**2
00814       IF STARTLINE LESS THAN CAT-LINE                                CL**2
00815          GO TO DO-NUMBER-400.                                        CL**2
00816 ******************************************************************   CL**2
00817 *     NUMBERING CANNOT BE DONE                                       CL**2
00818 *               BECAUSE WOULD PUT ENTRY OUT OF SEQUENCE              CL**2
00819 ******************************************************************   CL**2
00820      MOVE STARTLINE TO LINE-MISSING1.                                CL**2
00821      MOVE ERROR-MSG14 TO ERROR-POS2.                                 CL**2
00822      GO TO PRINT-FATAL-ERROR.                                        CL**2
00823 ******************************************************************   CL**2
00824 *      NUMBERING CAN BE DONE                                         CL**2
00825 ******************************************************************   CL**2
00826  DO-NUMBER-400.                                                      CL**2
00827      MOVE CAT-NUM TO DATA-ENTRY-CAT.                                 CL**2
00828      MOVE OLD-NAME TO DATA-ENTRY-NAME.                               CL**2
           MOVE SPACES TO DATA-REC-ID.
00830      MOVE ZERO TO DATA-NEXT-REC.                                     CL**2
00831      PERFORM RNM-READ-CATEGORY THRU RNM-READ-CATEGORY-XIT.           CL**2
00832      MOVE SAVE-STARTLINE TO STARTLINE.                               CL**2
00833  DO-NUMBER-450.                                                      CL**2
00834      IF CAT-LINE GREATER THAN FROMLINE                               CL**2
00835           GO TO DO-NUMBER-500.                                       CL**2
00836      IF CAT-LINE EQUAL TO FROMLINE                                   CL**2
00837           GO TO DO-NUMBER-500.                                       CL**2
00838      PERFORM RNM-READ-NEXT-DATA THRU RNM-READ-NEXT-DATA-XIT.         CL**2
00839      IF DATA-RETURN-CODE EQUAL ZERO                                  CL**2
00840           GO TO DO-NUMBER-450.                                       CL**2
00841      GO TO DO-NUMBER-600.                                            CL**2
00842  DO-NUMBER-500.                                                      CL**2
00843      MOVE STARTLINE TO CAT-LINE.                                     CL**2
00844      MOVE 1 TO MOVE-SUB.                                             CL**2
00845      SUBTRACT 3 FROM SAVE-DATA-SUB.                                  CL**2
00846  DO-NUMBER-550.                                                      CL**2
00847      MOVE LINESTART (MOVE-SUB) TO DATA-DETAIL (SAVE-DATA-SUB).       CL**2
00848      ADD 1 TO MOVE-SUB.                                              CL**2
00849      ADD 1 TO SAVE-DATA-SUB.                                         CL**2
00850      IF MOVE-SUB LESS THAN 5                                         CL**2
00851           GO TO DO-NUMBER-550.                                       CL**2
00852      ADD BYLINE TO STARTLINE.                                        CL**2
00853      PERFORM RNM-READ-NEXT-DATA THRU RNM-READ-NEXT-DATA-XIT.         CL**2
00854      IF DATA-RETURN-CODE NOT EQUAL ZERO                              CL**2
00855          GO TO FINISH-NUMBER.                                        CL**2
00856      IF CAT-LINE LESS THAN TOLINE                                    CL**2
00857      OR CAT-LINE EQUAL TO TOLINE                                     CL**2
00858          GO TO DO-NUMBER-500.                                        CL**2
00859      PERFORM REWRITE-DATA THRU REWRITE-DATA-XIT.                     CL**2
00860  FINISH-NUMBER.                                                      CL**2
00861      MOVE OLD-NAME TO RENUM1.                                        CL**2
00862      MOVE MSG4 TO ERROR-POS2.                                        CL**2
00863      MOVE PROG-ID TO ERROR-POS1.                                     CL**2
00864      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00865      GO TO FINISH-PROCESS.                                           CL**2
00866 ******************************************************************   CL**2
00867 *        NUMBERING CANNOT BE DONE                                    CL**2
00868 *                 BECAUSE FROMLINE CANNOT BE FOUND                   CL**2
00869 ******************************************************************   CL**2
00870  DO-NUMBER-600.                                                      CL**2
00871      MOVE FROMLINE TO LINE-MISSING.                                  CL**2
00872      MOVE ERROR-MSG13 TO ERROR-POS2.                                 CL**2
00873      GO TO PRINT-FATAL-ERROR.                                        CL**2
00874                                                                    DCUTL30
00875 ******************************************************************   CL**2
00876 *         NUMBER AN ENTIRE ENTRY                                     CL**2
00877 ******************************************************************   CL**2
00878  DO-NUMBER-ALL.                                                      CL**2
00879      PERFORM RNM-READ-FIRST-DATA THRU RNM-READ-FIRST-DATA-XIT.       CL**2
00880      IF DATA-RETURN-CODE NOT EQUAL ZERO                              CL**2
00881          GO TO FINISH-NUMBER.                                        CL**2
00882      MOVE CAT-LINE TO STARTLINE.                                     CL**2
00883  DO-NUMBER-ALL-200.                                                  CL**2
00884      PERFORM RNM-READ-NEXT-DATA THRU RNM-READ-NEXT-DATA-XIT.         CL**2
00885      IF DATA-RETURN-CODE EQUAL 1                                     CL**2
00886          GO TO FINISH-NUMBER.                                        CL**2
           IF DATA-RETURN-CODE = 2 MOVE CAT-LINE TO STARTLINE.
00887      ADD BYLINE TO STARTLINE.                                        CL**2
00888      MOVE 1 TO MOVE-SUB.                                             CL**2
00889      SUBTRACT 3 FROM SAVE-DATA-SUB.                                  CL**2
00890  DO-NUMBER-ALL-300.                                                  CL**2
00891      MOVE LINESTART (MOVE-SUB) TO DATA-DETAIL (SAVE-DATA-SUB).       CL**2
00892      ADD 1 TO MOVE-SUB.                                              CL**2
00893      ADD 1 TO SAVE-DATA-SUB.                                         CL**2
00894      IF MOVE-SUB LESS THAN 5                                         CL**2
00895            GO TO DO-NUMBER-ALL-300.                                  CL**2
00896      GO TO DO-NUMBER-ALL-200.                                        CL**2
00897                                                                    DCUTL30
00898 *****************************************************************    CL**2
00899 ******************************************************************   CL**2
00900 *       COMMON ERROR MESSAGE PRINTING                                CL**2
00901 *****************************************************************    CL**2
00902  ILLEGAL-RENAME-SYNTAX.                                              CL**2
00903      MOVE ERROR-MSG6 TO ERROR-POS2.                                  CL**2
00904  PRINT-FATAL-ERROR.                                                  CL**2
00905      MOVE PROG-ID TO ERROR-POS1.                                     CL**2
00906      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00907      MOVE 8 TO RETURN-CODE.                                          CL**2
00908      GO TO FINISH-PROCESS.                                           CL**2
00909                                                                    DCUTL30
00910 ******************************************************************   CL**2
00911 *    END OF JOB                                                      CL**2
00912 ******************************************************************   CL**2
00913  FINISH-PROCESS.                                                     CL**2
00914      MOVE SPACE TO STD-REPORT-REC.                                   CL**2
00915      CLOSE MAST1.                                                    CL**2
00916      PERFORM REL-CLOSE THRU REL-CLOSE-XIT.                           CL**2
00917      CLOSE SYSPRINT.                                                 CL**2
           CLOSE WORK-FILE. 
00918      MOVE "N" TO FUNCTION-CODE.                                      CL**2
           EXIT PROGRAM.
00920                                                                    DCUTL30
00921 ******************************************************************   CL**2
00922 *                                                                    CL**2
00923 *       SCAN SUBROUTINES                                             CL**2
00924 *                                                                    CL**2
00925 ******************************************************************   CL**2
00926 *      FIND A NON-BLANK CHARACTER                                    CL**2
00927  FIND-BLANK.                                                         CL**2
00928      ADD 1 TO TX-SUB.                                                CL**2
00929      IF TX-SUB GREATER THAN MAX-POS                                  CL**2
00930         MOVE "Y" TO END-OF-CARD                                      CL**2
00931           GO TO FIND-BLANK-XIT.                                      CL**2
00932      IF TX-POS (TX-SUB) EQUAL SPACE                                  CL**2
00933          GO TO FIND-BLANK.                                           CL**2
00934      SUBTRACT 1 FROM TX-SUB.                                         CL**2
00935  FIND-BLANK-XIT.                                                     CL**2
00936      EXIT.                                                           CL**2
00937 *      FIND A PARTICULAR CHARACTER                                   CL**2
00938  FIND-CHAR.                                                          CL**2
00939      MOVE "N" TO CHAR-NOT-FOUND.                                     CL**2
00940      MOVE ZERO TO OPT-SUB.                                           CL**2
00941      ADD 1 TO TX-SUB.                                                CL**2
00942      MOVE SPACE TO AREA-SCAN.                                        CL**2
00943  FIND-CHAR-100.                                                      CL**2
00944      ADD 1 TO OPT-SUB.                                               CL**2
00945      IF TX-POS (TX-SUB) EQUAL TEST-CHAR                              CL**2
00946          MOVE "Y" TO CHAR-NOT-FOUND                                  CL**2
00947          GO TO FIND-CHAR-XIT.                                        CL**2
00948      MOVE TX-POS (TX-SUB) TO SCAN-AREA (OPT-SUB).                    CL**2
00949      ADD 1 TO TX-SUB.                                                CL**2
00950      IF TX-SUB GREATER THAN MAX-POS                                  CL**2
00951         MOVE "Y" TO END-OF-CARD                                      CL**2
00952          GO TO FIND-CHAR-XIT.                                        CL**2
00953      GO TO FIND-CHAR-100.                                            CL**2
00954  FIND-CHAR-XIT.                                                      CL**2
00955      EXIT.                                                           CL**2
00956 ******************************************************************   CL**2
00957 *       GET NEXT CARD                                                CL**2
00958 *****************************************************************    CL**2
00959  GET-NEXT-CARD.                                                      CL**2
00960      MOVE "N" TO END-OF-CARD.                                        CL**2
00961      MOVE "R" TO FUNCTION-CODE.                                      CL**2
           EXIT PROGRAM.
00963  GET-NEXT-CARD-RETURN.                                               CL**2
00964      MOVE "N" TO FUNCTION-CODE.                                      CL**2
00965      IF CONT-TYPE NOT EQUAL SPACE                                    CL**2
00966          MOVE ERROR-MSG10 TO ERROR-POS2                              CL**2
00967          GO TO PRINT-FATAL-ERROR.                                    CL**2
00968      MOVE ZERO TO TX-SUB.                                            CL**2
00969      PERFORM FIND-BLANK THRU FIND-BLANK-XIT.                         CL**2
00970  GET-NEXT-CARD-XIT.                                                  CL**2
00971      EXIT.                                                           CL**2
00972  USER-ROUTINE.                                                       CL**2
00973      GO TO USER-ROUTINE-XIT.                                         CL**2
00974  USER-ROUTINE-XIT.                                                   CL**2
00975      EXIT.                                                           CL**2
*CALL     RELCOM                                                           CL**2
*CALL     RELUPD                                                           CL**2
      **********************************************************
      *       READ WORK FILE SUBROUTINE 
      **********************************************************
       READ-WORK-FILE.
           MOVE ZERO TO WORK-KEY-FLAG.
           READ WORK-FILE 
               INVALID KEY MOVE 1 TO WORK-KEY-FLAG. 
       READ-WORK-FILE-XIT.
           EXIT.
      **********************************************************
      *       WRITE WORK FILE SUBROUTINE
      **********************************************************
       WRITE-WORK-FILE. 
           MOVE ZERO TO WORK-KEY-FLAG.
           WRITE WORK-RECORD
               INVALID KEY MOVE 1 TO WORK-KEY-FLAG. 
       WRITE-WORK-FILE-XIT. 
           EXIT.
00978 ******************************************************************   CL**2
00979 ******************************************************************   CL**2
00980 *                                                                    CL**2
00981 *       CHANGE POINTERS ON MAST2                                     CL**2
00982 ******************************************************************   CL**2
00983 ******************************************************************   CL**2
00984  REL-CHG-PTR.                                                        CL**2
00985      MOVE ZERO TO REL-RETURN-CODE.                                   CL**2
00986      MOVE ZERO TO REL-NEXT-REC.                                      CL**2
00987  REL-CHG-PTR-100.                                                    CL**2
00988      PERFORM RELALG THRU RELALG-XIT.                                 CL**2
00989      READ MAST2                                                      CL**2
00990          INVALID KEY MOVE 1 TO REL-RETURN-CODE                       CL**2
00991          GO TO REL-CHG-PTR-XIT.                                      CL**2
00992      MOVE 1 TO REL-SUB.                                              CL**2
00993  REL-CHG-PTR-LOOP.                                                   CL**2
00994      IF REL-DTL-CATNAME (REL-SUB) NOT EQUAL OLD-NAME                 CL**2
00995          GO TO REL-CHG-PTR-LOOP-1.                                   CL**2
00996      MOVE NEW-NAME TO REL-DTL-CATNAME (REL-SUB).                     CL**2
00997      PERFORM REL-REWRITE THRU REL-REWRITE-XIT.                       CL**2
00998  REL-CHG-PTR-XIT.                                                    CL**2
00999      EXIT.                                                           CL**2
01000  REL-CHG-PTR-LOOP-1.                                                 CL**2
01001      ADD 1 TO REL-SUB.                                               CL**2
01002      IF REL-SUB NOT GREATER THAN REL-LIMIT                           CL**2
01003          GO TO REL-CHG-PTR-LOOP.                                     CL**2
01004      IF REL-HDR-CONT EQUAL ZERO                                      CL**2
01005          MOVE 2 TO REL-RETURN-CODE                                   CL**2
01006          GO TO REL-CHG-PTR-XIT.                                      CL**2
01007      ADD 1 TO REL-NEXT-REC.                                          CL**2
01008      GO TO REL-CHG-PTR-100.                                          CL**2
01009                                                                      CL**2
01010                                                                      CL**2
01011                                                                      CL**2
01012                                                                      CL**2
*CALL     RELALG                                                           CL**2
*CALL     MAST1EXT                                                         CL**2
01015 *      SPECIAL ROUTINE FOR THIS MODULE                               CL**2
01016 **********   DATA FILE I/O - MAST1RFL   **************               CL**2
01017 *                                                                    CL**2
01018  RNM-READ-FIRST-DATA.                                                CL**2
01019 ******************************************************************   CL**2
01020 ******************************************************************   CL**2
01021 *    TO READ FIRST LINE OF FIRST CATEGORY OF NAMED ENTRY         *   CL**2
01022 ******************************************************************   CL**2
01023 ******************************************************************   CL**2
01024      MOVE "0" TO DATA-RETURN-CODE.                                   CL**2
01025 ******************************************************************   CL**2
01026 *    DETERMINE IF NAMED ENTRY HAS ALREADY BEEN READ              *   CL**2
01027 ******************************************************************   CL**2
           IF DATA-ENTRY-NAME = DATA-REC-ID   AND 
01029          DATA-NEXT-REC EQUAL TO ZERO                                 CL**2
01030          MOVE ZERO TO DATA-SUB                                       CL**2
01031          GO TO RNM-MOVE-DATA-LINE.                                   CL**2
01032 ******************************************************************   CL**2
01033 *    GET NAMED ENTRY FROM FILE - CONTROL PROGRAM DOES THIS       *   CL**2
01034 ******************************************************************   CL**2
01035      MOVE ZERO TO DATA-NEXT-REC.                                     CL**2
01036      PERFORM DATA-READ THRU DATA-READ-XIT.                           CL**2
01037      IF DATA-RETURN-CODE NOT EQUAL TO "0"                            CL**2
01038          GO TO RNM-READ-FIRST-DATA-XIT.                              CL**2
01039  RNM-MOVE-DATA-LINE.                                                 CL**2
           MOVE 15 TO WORK-LENGTH 
01041      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                   CL**2
01042      MOVE HEADER-DETAIL TO CAT-HEADER.                               CL**2
01043      IF CAT-STORE EQUAL TO HIGH-VALUES                               CL**2
01044          MOVE 1 TO DATA-RETURN-CODE                                  CL**2
01045          GO TO RNM-READ-FIRST-DATA-XIT.                              CL**2
01046      MOVE CAT-LENGTH TO WORK-LENGTH.                                 CL**2
01047      MOVE DATA-SUB TO SAVE-DATA-SUB.                                 CL**2
01048      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                   CL**2
01049      MOVE WORK-LINE TO DETAIL-WORK.                                  CL**2
01050  RNM-READ-FIRST-DATA-XIT.                                            CL**2
01051      EXIT.                                                           CL**2
*CALL     MAST1ALG                                                         CL**2
*CALL     MAST1READ                                                        CL**2
01054 *       SPECIAL ROUTINE FOR THIS MODULE                              CL**2
01055 ********** DATA FILE (MAST1) I/O - MAST1RND  *************           CL**2
01056 *                                                                    CL**2
01057 *                                                                    CL**2
01058 *    READ NEXT LINE OF SAME ENTRY                                *   CL**2
01059 ******************************************************************   CL**2
01060 ******************************************************************   CL**2
01061  RNM-READ-NEXT-DATA.                                                 CL**2
01062      MOVE "0" TO DATA-RETURN-CODE.                                   CL**2
           MOVE  6 TO WORK-LENGTH 
01064      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                   CL**2
01065      IF CAT-STORE EQUAL TO HIGH-VALUES                               CL**2
01066          PERFORM REWRITE-DATA THRU REWRITE-DATA-XIT                  CL**2
01067          MOVE "1" TO DATA-RETURN-CODE                                CL**2
01068          GO TO RNM-READ-NEXT-DATA-XIT.                               CL**2
           IF CAT-STORE NOT = "***" 
01070          GO TO RNM-RETRIEVE-LINE.                                    CL**2
01071      PERFORM REWRITE-DATA THRU REWRITE-DATA-XIT.                     CL**2
01072 ******************************************************************   CL**2
01073 *    END OF PHYSICAL RECORD - NOT ENTRY - GET NEXT RECORD        *   CL**2
01074 ******************************************************************   CL**2
01075      ADD 1 TO DATA-NEXT-REC.                                         CL**2
01076      PERFORM DATA-READ THRU DATA-READ-XIT.                           CL**2
01077      IF DATA-RETURN-CODE NOT EQUAL TO "0"                            CL**2
01078          GO TO RNM-READ-NEXT-DATA-XIT.                               CL**2
01079      GO TO RNM-READ-NEXT-DATA.                                       CL**2
01080  RNM-RETRIEVE-LINE.                                                  CL**2
01081      MOVE LENGTH-STORE TO CAT-LENGTH.                                CL**2
01082      IF CAT-STORE NOT EQUAL TO CAT-CATEGORY                          CL**2
01083          PERFORM REWRITE-DATA THRU REWRITE-DATA-XIT                  CL**2
01084          MOVE "2" TO DATA-RETURN-CODE                                CL**2
01085          MOVE CAT-STORE TO CAT-CATEGORY.                             CL**2
           MOVE 9 TO WORK-LENGTH
01087      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                   CL**2
01088      MOVE REV-STORE TO CAT-REV.                                      CL**2
01089      MOVE LINE-STORE TO CAT-LINE.                                    CL**2
01090      MOVE CAT-LENGTH TO WORK-LENGTH.                                 CL**2
01091      MOVE DATA-SUB TO SAVE-DATA-SUB.                                 CL**2
01092      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                   CL**2
01093      MOVE WORK-LINE TO DETAIL-WORK.                                  CL**2
01094  RNM-READ-NEXT-DATA-XIT.                                             CL**2
01095      EXIT.                                                           CL**2
01096 ********** DATA FILE I/O - MAST1RFC  *********                       CL**2
01097 *                                                                    CL**2
01098 *    READ 1ST LINE OF SPECIFIC CATEGORY OF NAMED ENTRY           *   CL**2
01099 ******************************************************************   CL**2
01100 ******************************************************************   CL**2
01101  RNM-READ-CATEGORY.                                                  CL**2
01102      MOVE "0" TO DATA-RETURN-CODE.                                   CL**2
           IF DATA-ENTRY-NAME = DATA-REC-ID   AND 
01104      DATA-NEXT-REC EQUAL TO ZERO                                     CL**2
01105          MOVE ZERO TO DATA-SUB                                       CL**2
01106          GO TO RNM-READ-DATA-LINE.                                   CL**2
01107 ******************************************************************   CL**2
01108 *    GET NAMED ENTRY FROM FILE                                   *   CL**2
01109 ******************************************************************   CL**2
01110       MOVE ZERO TO DATA-NEXT-REC.                                    CL**2
01111  RNM-NEXT-RECORD-CAT.                                                CL**2
01112      PERFORM DATA-READ THRU DATA-READ-XIT.                           CL**2
01113      IF DATA-RETURN-CODE NOT EQUAL TO "0"                            CL**2
01114          GO TO RNM-READ-CATEGORY-XIT.                                CL**2
01115  RNM-READ-DATA-LINE.                                                 CL**2
           MOVE 6 TO WORK-LENGTH
01117      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                   CL**2
01118      IF CAT-STORE EQUAL TO DATA-ENTRY-CAT                            CL**2
01119          GO TO RNM-MOVE-LINE-CATEGORY.                               CL**2
01120      IF CAT-STORE EQUAL TO HIGH-VALUES                               CL**2
01121          PERFORM REWRITE-DATA THRU REWRITE-DATA-XIT                  CL**2
01122          MOVE "2" TO DATA-RETURN-CODE                                CL**2
01123          GO TO RNM-READ-CATEGORY-XIT.                                CL**2
           IF CAT-STORE = "***" 
01125          PERFORM REWRITE-DATA THRU REWRITE-DATA-XIT                  CL**2
01126          ADD 1 TO DATA-NEXT-REC                                      CL**2
01127          GO TO RNM-NEXT-RECORD-CAT.                                  CL**2
01128      IF CAT-STORE GREATER THAN DATA-ENTRY-CAT                        CL**2
01129          PERFORM REWRITE-DATA THRU REWRITE-DATA-XIT                  CL**2
01130          MOVE "2" TO DATA-RETURN-CODE                                CL**2
01131          GO TO RNM-READ-CATEGORY-XIT.                                CL**2
01132 ******************************************************************   CL**2
01133 *    HAVE TO SKIP OVER LINE  -  WRONG CATEGORY                   *   CL**2
01134 ******************************************************************   CL**2
           ADD 9 TO DATA-SUB. 
           MOVE LENGTH-STORE TO CAT-LENGTH, WORK-LENGTH.
01137      MOVE CAT-STORE TO CAT-CATEGORY.                                 CL**2
01139      ADD WORK-LENGTH TO DATA-SUB.                                    CL**2
01140      GO TO RNM-READ-DATA-LINE.                                       CL**2
01141  RNM-MOVE-LINE-CATEGORY.                                             CL**2
01142 ******************************************************************   CL**2
01143 *    HAVE GOOD CATEGORY - GET 1ST LINE                           *   CL**2
01144 ******************************************************************   CL**2
01145      MOVE CAT-STORE TO CAT-CATEGORY.                                 CL**2
           MOVE 9 TO WORK-LENGTH
01147      MOVE LENGTH-STORE TO CAT-LENGTH.                                CL**2
01148      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                   CL**2
01149      MOVE REV-STORE TO CAT-REV.                                      CL**2
01150      MOVE LINE-STORE TO CAT-LINE.                                    CL**2
01151      MOVE CAT-LENGTH TO WORK-LENGTH.                                 CL**2
01152      MOVE DATA-SUB TO SAVE-DATA-SUB.                                 CL**2
01153      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                   CL**2
01154      MOVE WORK-LINE TO DETAIL-WORK.                                  CL**2
01155  RNM-READ-CATEGORY-XIT.                                              CL**2
01156      EXIT.                                                           CL**2
01157                                                                    DCUTL30
01158 ******************************************************************   CL**2
01159 *         REWRITE MAST1 RECORD                                       CL**2
01160 ******************************************************************   CL**2
01161  REWRITE-DATA.                                                       CL**2
01162      REWRITE DATA-RECORD                                             CL**2
01163          INVALID KEY                                                 CL**2
01164              MOVE DATA-ENTRY-NAME TO IO-NAME1                        CL**2
01165              MOVE "REWRITE" TO IO-REASON1                            CL**2
01166              MOVE ERROR-MSG8 TO ERROR-POS2                           CL**2
01167              GO TO PRINT-FATAL-ERROR.                                CL**2
01168  REWRITE-DATA-XIT.                                                   CL**2
01169      EXIT.                                                           CL**2
      ******************************************************* 
      * 
      *        DELETE MAST1 RECORD
      * 
      ******************************************************* 
       DELETE-DATA. 
           DELETE MAST1 INVALID KEY 
               MOVE DATA-ENTRY-NAME TO IO-NAME1 
           MOVE "DELETE " TO IO-REASON1 
               MOVE ERROR-MSG8 TO ERROR-POS2
               GO TO PRINT-FATAL-ERROR. 
       DELETE-DATA-XIT. 
           EXIT.
*CALL     DISPLAYLN                                                        CL**2
*CALL     WRITELN                                                          CL**2
01172                                                                    DCUTL30
*CALL     MAST1RFC                                                         CL**2
*CALL     MAST1RNL                                                         CL**2
*CALL     MAST1RFL                                                         CL**2
