*COMDECK  DCUPDKW 
00001 **DCUPDKW BEGIN**                                                 08/03/78
00002 ************************************************************      DCUPDKW 
00003 ************************************************************         LV001
00004 *                                                                 DCUPDKW 
00005 *     C O M M O N   E D I T   C O N T R O L                          CL**2
00006 *                                                                 DCUPDKW 
00007 ************************************************************         CL**2
00008 ************************************************************         CL**2
00009 *                                                                 DCUPDKW 
00010  CATEGORY-START.                                                  DCUPDKW 
00011 ***********************************************************       DCUPDKW 
00012 *                                                                 DCUPDKW 
00013 *     L O C A T E   K E Y W O R D                                    CL**2
00014 *                                                                 DCUPDKW 
00015 ***********************************************************       DCUPDKW 
00016 *                                                                 DCUPDKW:  
00017 *     AFTER PROCESSING A KEYWORD AND VALUE                        DCUPDKW 
00018 *     CONTROL IS PASSED BACK TO HERE.                             DCUPDKW 
00019 *                                                                 DCUPDKW 
00020      IF FUNC EQUAL TO "C"                                            CL**2
00021          GO TO CK-CATNAME-20.                                        CL**2
           MOVE 1 TO FLD. 
00022  CAT-LOC-KW.                                                      DCUPDKW 
      * 
      *    FUNCTION = T MEANS RETURN FROM DUMPING REL-TABLE 
      * 
           IF FUNC EQUAL TO "T" 
               MOVE SPACE TO FUNC 
               GO TO SET-REL-TABLE
           END-IF 
      * 
      *    FUNCTION = B MEANS RETURN FROM GETTING NEXT BLOCK
      *    OF MULTI-BLOCK LINE. 
      * 
           IF FUNC EQUAL TO "B" 
               MOVE SPACE TO FUNC 
               GO TO GET-NEXT-BLOCK 
           END-IF 
00023      IF CAT-ID EQUAL TO 20 OR 30 OR 900                              CL**2
00024          GO TO KEY-EDIT.                                             CL**2
00025      MOVE SPACES TO VAL-AREA.                                     DCUPDKW 
00026      MOVE 1 TO VA.                                                DCUPDKW 
00027  CAT-LOC-KW10.                                                       CL**2
00028      IF TX GREATER THAN 72                                           CL**2
00029          AND CONTINUE-SW EQUAL TO "Y"                                CL**2
00030              MOVE "R" TO FUNC                                        CL**2
00031                  GO TO CAT-END-TEST-BACK.                            CL**2
00032      IF TX-POS (TX) EQUAL TO SPACE                                   CL**2
00033          ADD 1 TO TX                                                 CL**2
00034              GO TO CAT-LOC-KW10.                                     CL**2
00035  CAT-LOC-KW20.                                                    DCUPDKW 
00036      MOVE TX-POS (TX) TO VAL (VA).                                DCUPDKW 
00037      ADD 1 TO TX VA.                                                 CL**2
00038      IF TX LESS THAN 73                                              CL**2
00039          GO TO CAT-LOC-KW-30.                                        CL**2
00040      IF CONTINUE-SW EQUAL TO "Y" AND VAL (1) EQUAL TO SPACE          CL**2
00041          MOVE "R" TO FUNC                                            CL**2
00042          GO TO CAT-END-TEST-BACK.                                    CL**2
00043      MOVE CERR-685S TO MSG-POS5 (MSG).                               CL**2
00044      MOVE "685-S" TO MSG-POS2 (MSG).                                 CL**2
00045      MOVE VAL-AREA TO KEY-WORD.                                      CL**2
00046      MOVE "N" TO CONTINUE-SW.                                        CL**2
00047      GO TO CAT-MVC-MSG-ERR.                                          CL**2
00048  CAT-LOC-KW-30.                                                      CL**2
00049      IF TX-POS (TX) EQUAL TO "="                                  DCUPDKW 
00050          GO TO CAT-LOC-TAB.                                       DCUPDKW 
00051      IF TX-POS (TX) EQUAL TO ","                                     CL**2
00052          GO TO CAT-LOC-TAB20.                                        CL**2
00053      GO TO CAT-LOC-KW20.                                             CL**2
00054 *                                                                    CL**2
00055 *     LOCATE KEYWORD IN FIELD TABLE                               DCUPDKW 
00056 *                                                                 DCUPDKW 
00057  CAT-LOC-TAB.                                                     DCUPDKW 
00058      MOVE 1 TO FLD.                                               DCUPDKW 
00059      MOVE VAL-AREA TO KEY-WORD.                                      CL**2
           IF CAT-ID LESS THAN 100 OR CAT-ID EQUAL 900
00061          GO TO CAT-LOC-TAB20.                                        CL**2
00062  CAT-LOC-TAB05.                                                      CL**2
00063      IF FLD-NAME3 (FLD) EQUAL TO HIGH-VALUE                          CL**2
00064          GO TO CAT-LOC-TAB30.                                        CL**2
00065      IF FLD-NAME3 (FLD) NOT EQUAL TO LOW-VALUE                       CL**2
00066          ADD 1 TO FLD                                                CL**2
00067          GO TO CAT-LOC-TAB05.                                        CL**2
00068  CAT-LOC-TAB10.                                                      CL**2
00069      IF FLD-ENT-TYPE (FLD) NOT EQUAL TO ENT-ID                       CL**2
00070           ADD 1 TO FLD                                               CL**2
00071           GO TO CAT-LOC-TAB05.                                       CL**2
00072      IF FLD-CAT-TYPE (FLD) NOT EQUAL TO CAT-ID                       CL**2
00073           ADD 1 TO FLD                                               CL**2
00074           GO TO CAT-LOC-TAB05.                                       CL**2
00075      ADD 1 TO FLD.                                                   CL**2
00076  CAT-LOC-TAB20.                                                      CL**2
00077      IF FLD-NAME (FLD) EQUAL TO KEY-WORD                             CL**2
00078           GO TO CAT-LOC-VAL.                                         CL**2
00079      MOVE VAL-AREA TO KW-3-POS.                                      CL**2
00080      IF VAL (4) EQUAL TO SPACE   AND                                 CL**2
00081          FLD-NAME3 (FLD) EQUAL TO KW-3-POS                           CL**2
00082              GO TO CAT-LOC-VAL.                                      CL**2
00083      ADD 1 TO FLD.                                                   CL**2
00084      IF FLD-NAME3 (FLD) EQUAL TO HIGH-VALUE                          CL**2
00085          GO TO CAT-LOC-TAB30.                                        CL**2
00086      IF FLD-NAME3 (FLD) NOT EQUAL TO LOW-VALUE                       CL**2
               GO TO CAT-LOC-TAB20
           ELSE 
               GO TO CAT-LOC-TAB05
           END-IF 
00092  CAT-LOC-TAB30.                                                      CL**2
00093      MOVE CERR-650S TO MSG-POS5 (MSG).                               CL**2
00094      MOVE "650-S" TO MSG-POS2 (MSG).                                 CL**2
           MOVE VAL-AREA TO KEY-WORD. 
           SUBTRACT 1 FROM TX.
00095  CAT-LOC-KW-40.                                                      CL**2
00096      ADD 1 TO TX.                                                    CL**2
00097      IF TX GREATER THAN 72                                           CL**2
00098          MOVE "N" TO CONTINUE-SW                                     CL**2
00099          GO TO CAT-MVC-MSG-ERR.                                      CL**2
00100      IF TX-POS (TX) EQUAL TO QUOTE-TYPE                              CL**2
00101          GO TO CAT-LOC-KW-50.                                        CL**2
00102      IF TX-POS (TX) EQUAL TO ","                                     CL**2
00103          MOVE "Y" TO CONTINUE-SW                                     CL**2
00104          GO TO CAT-MVC-MSG-ERR.                                      CL**2
00105      GO TO CAT-LOC-KW-40.                                            CL**2
00106  CAT-LOC-KW-50.                                                      CL**2
00107      ADD 1 TO TX.                                                    CL**2
00108      IF TX GREATER THAN 72                                           CL**2
00109          MOVE "N" TO CONTINUE-SW                                     CL**2
00110          GO TO CAT-MVC-MSG-ERR.                                      CL**2
00111      IF TX-POS (TX) NOT EQUAL TO QUOTE-TYPE                          CL**2
00112          GO TO CAT-LOC-KW-50.                                        CL**2
00113      ADD 1 TO TX.                                                    CL**2
00114      IF TX-POS (TX) EQUAL TO ","                                     CL**2
00115          MOVE "Y" TO CONTINUE-SW                                     CL**2
00116          ELSE                                                        CL**2
00117          MOVE "N" TO CONTINUE-SW.                                    CL**2
00118      GO TO CAT-MVC-MSG-ERR.                                          CL**2
00119 *****************************************************                CL**2
00120 *                                                                 DCUPDKW 
00121 *     L O C A T E   V A L U E                                        CL**2
00122 *                                                                 DCUPDKW 
00123 *****************************************************                CL**2
00124  CAT-LOC-VAL.                                                     DCUPDKW 
           MOVE "N" TO SUB-PRESENT. 
           MOVE ZEROS TO SUB-HOLD.
           MOVE "N" TO QUOTE-SW LAST-QUOTE. 
00125      MOVE FLD-ID (FLD) TO FIELD-ID.                               DCUPDKW 
00126      MOVE SPACES TO VAL-AREA.                                     DCUPDKW 
00127      ADD 1 TO TX.                                                 DCUPDKW 
           MOVE 1 TO VA HOLD-VA-MAX.
00129      IF TX-POS (TX) EQUAL TO QUOTE-TYPE                              CL**2
00130          ADD 1 TO TX                                                 CL**2
               MOVE "Y" TO QUOTE-SW 
               MOVE "N" TO LAST-QUOTE 
00131          GO TO CAT-LOC-VAL-20.                                       CL**2
00132  CAT-LOC-VAL-05.                                                     CL**2
00133      IF TX-POS (TX) EQUAL TO SPACE                                   CL**2
00134          ADD 1 TO TX                                                 CL**2
00135              GO TO CAT-LOC-VAL-05.                                   CL**2
00136  CAT-LOC-VAL-10.                                                     CL**2
           IF TX-POS (TX) EQUAL TO "["
               PERFORM MOVE-SUB THRU MOVE-SUB-EXIT
               MOVE "Y" TO SUB-PRESENT
               GO CAT-LOC-VAL-15
           END-IF 
00137      MOVE TX-POS (TX) TO VAL (VA).                                   CL**2
           IF VAL (VA) NOT = SPACE
              MOVE VA TO HOLD-VA-MAX. 
00138      ADD 1 TO TX VA.                                                 CL**2
       CAT-LOC-VAL-15.
           IF TX GREATER THAN 72
00140          MOVE "N" TO CONTINUE-SW                                     CL**2
00141          GO TO CAT-CK-LEN.                                           CL**2
00142      IF TX-POS (TX) EQUAL TO ","                                     CL**2
00143          MOVE "Y" TO CONTINUE-SW                                     CL**2
00144          GO TO CAT-CK-LEN.                                           CL**2
00145      GO TO CAT-LOC-VAL-10.                                           CL**2
00146  CAT-LOC-VAL-20.                                                     CL**2
00147      MOVE TX-POS (TX) TO VAL (VA).                                   CL**2
00148      ADD 1 TO TX VA.                                                 CL**2
00149      IF TX GREATER THAN 72                                           CL**2
00150          MOVE CERR-690S TO MSG-POS5 (MSG)                            CL**2
00151          MOVE "690-S" TO MSG-POS2 (MSG)                              CL**2
00152          MOVE "N" TO CONTINUE-SW                                     CL**2
00153          GO TO CAT-MVC-MSG-ERR.                                      CL**2
      * 
      *    CHECK TO SEE IF TWO CONSECUTIVE QUOTES.
      *    IF SO, STORE ONE OF THEM IN THE LITERAL. 
      * 
           IF TX-POS (TX) EQUAL QUOTE-TYPE
               ADD 1 TO TX
               IF TX-POS (TX) EQUAL TO QUOTE-TYPE 
                   GO TO CAT-LOC-VAL-20 
               ELSE 
                   MOVE "Y" TO LAST-QUOTE 
               END-IF 
           END-IF 
           IF TX-POS (TX) EQUAL ","  AND  LAST-QUOTE = "Y"
               MOVE "Y" TO CONTINUE-SW
               GO TO CAT-CK-LEN 
           ELSE 
               IF TX-POS (TX) = " " AND LAST-QUOTE = "Y"
                   MOVE "N" TO CONTINUE-SW
                   GO TO CAT-CK-LEN 
               END-IF 
           END-IF 
           GO TO CAT-LOC-VAL-20.
00161 ************************************************************      DCUPDKW 
00162 *                                                                 DCUPDKW 
00163 *     C H E C K   V A L U E   L E N G T H                            CL**2
00164 *                                                                 DCUPDKW 
00165 ************************************************************      DCUPDKW 
00166 *                                                                 DCUPDKW 
00167 *     AFTER CHECKING FOR $DEL OR VALUE LENGTH                     DCUPDKW 
00168 *     CATEGORY-EDIT WILL BE BRANCHED TO.                          DCUPDKW 
00169 *     ALL THE EDITING FOR THE KEYWORD FOUND IS                    DCUPDKW 
00170 *     DONE THERE.                                                 DCUPDKW 
00171 *                                                                 DCUPDKW 
00172  CAT-CK-LEN.                                                      DCUPDKW 
           MOVE HOLD-VA-MAX TO VA.
00173      IF VAL-AREA EQUAL TO "DEL " OR "DELETE "                        CL**2
00174          GO TO CAT-CK-LEN-00.                                        CL**2
00175      GO TO CAT-CK-LEN10.                                             CL**2
00176  CAT-CK-LEN-00.                                                   DCUPDKW 
00177      IF ADD-CHG EQUAL TO "A"                                      DCUPDKW 
00178          MOVE CERR-680S TO MSG-POS5 (MSG)                            CL**2
00179          MOVE "680-S" TO MSG-POS2 (MSG)                              CL**2
00180          GO TO CAT-MVC-MSG-ERR.                                   DCUPDKW 
00181      MOVE "$" TO VAL (1).                                            CL**2
00182      GO TO CATEGORY-EDIT.                                            CL**2
00183  CAT-CK-LEN10.                                                    DCUPDKW 
           IF FLD-FORM (FLD) EQUAL TO "C" OR "P"
00185          GO TO CATEGORY-EDIT.                                        CL**2
00189      IF VA NOT GREATER THAN FLD-LEN (FLD)                            CL**2
00190          GO TO CATEGORY-EDIT.                                     DCUPDKW 
       CAT-CK-LEN15.
00191      MOVE CERR-660S TO MSG-POS5 (MSG).                               CL**2
00192      MOVE "660-S" TO MSG-POS2 (MSG).                                 CL**2
00193      GO TO CAT-MVC-MSG-ERR.                                       DCUPDKW 
00194 ************************************************************      DCUPDKW 
00195 *                                                                 DCUPDKW 
00196 *     A F T E R   E D I T   R E T U R N   H E R E                    CL**2
00197 *                                                                 DCUPDKW 
00198 ************************************************************      DCUPDKW 
00199 *     ERROR MESSAGES FORMATTED AND TABLED                         DCUPDKW 
00200 *     REVISION IMPACT TESTS MADE                                  DCUPDKW 
00201 *     CHANGE    OR     DELETE MESSAGES FORMATTED AND TABLED       DCUPDKW 
00202 *     CONTINUED LINE TESTS                                        DCUPDKW 
00203 *                                                                 DCUPDKW 
00204  CAT-ERR.                                                         DCUPDKW 
00205      MOVE CERR-675S TO MSG-POS5 (MSG).                               CL**2
00206      MOVE "675-S" TO MSG-POS2 (MSG).                                 CL**2
00207      GO TO CAT-MVC-MSG-ERR.                                       DCUPDKW 
00208  FLD-ERR.                                                         DCUPDKW 
00209      MOVE CERR-670S TO MSG-POS5 (MSG).                               CL**2
00210      MOVE "670-S" TO MSG-POS2 (MSG).                                 CL**2
00211      GO TO CAT-MVC-MSG-ERR.                                       DCUPDKW 
00212  CAT-MVC-MSG-ERR-DEL.                                             DCUPDKW 
00213      MOVE CERR-220W TO MSG-POS5 (MSG).                               CL**2
00214      MOVE "220-W" TO MSG-POS2 (MSG).                                 CL**2
00215  CAT-MVC-MSG-ERR.                                                 DCUPDKW 
00216      MOVE "*ERROR" TO MSG-POS3 (MSG).                             DCUPDKW 
00217  CAT-MVC-MSG-KW.                                                  DCUPDKW 
00218      MOVE KEY-WORD TO MSG-POS4 (MSG).                             DCUPDKW 
00219      GO TO CAT-MVC-MSG.                                           DCUPDKW 
00220  CAT-MVC-MSG-CHG.                                                 DCUPDKW 
00221      IF ADD-CHG EQUAL TO "A" OR INS-LINE-SW EQUAL "Y"                CL**2
00222          GO TO CAT-END-TEST.                                      DCUPDKW 
00223      MOVE "CHANGE" TO MSG-POS3 (MSG).                             DCUPDKW 
00224      MOVE "010-I" TO MSG-POS2 (MSG).                                 CL**2
00225      MOVE "C" TO REV-REASON-TYPE (REV).                           DCUPDKW 
00226      GO TO CAT-MVC-MSG-BOTH.                                      DCUPDKW 
00227  CAT-MVC-MSG-DEL.                                                 DCUPDKW 
00228      IF FLD-STD (FLD) EQUAL TO "Y"                                   CL**2
00229          MOVE CERR-00 TO MSG-POS1 (MSG)                              CL**2
00230          MOVE CERR-230W TO MSG-POS5 (MSG)                            CL**2
00231          MOVE "230-W" TO MSG-POS2 (MSG)                              CL**2
00232           MOVE KEY-WORD TO MSG-POS4 (MSG)                            CL**2
00233           MOVE "*ERROR" TO MSG-POS3 (MSG)                            CL**2
00234           ADD 1 TO MSG.                                              CL**2
00235      MOVE "020-I" TO MSG-POS2 (MSG).                                 CL**2
00236      MOVE "DELETE" TO MSG-POS3 (MSG).                             DCUPDKW 
00237      MOVE "D" TO REV-REASON-TYPE (REV).                           DCUPDKW 
00238  CAT-MVC-MSG-BOTH.                                                DCUPDKW 
00239      MOVE KEY-WORD TO REV-STD-NAME (REV).                         DCUPDKW 
00240      MOVE ADD-CHG TO REV-REASON (REV).                            DCUPDKW 
           IF ADD-CHG = "C" AND HOLD-COM = "*"
              MOVE HOLD-COM-LINE TO MSG-POS8 (MSG)
           ELSE 
              MOVE OLD-VALUE TO MSG-POS8 (MSG). 
00242      MOVE KEY-WORD TO MSG-POS4 (MSG).                             DCUPDKW 
00243      MOVE ",OLD VALUE=" TO MSG-POS7 (MSG).                        DCUPDKW 
00244  CAT-MVC-MSG.                                                     DCUPDKW 
00245      MOVE CERR-00 TO MSG-POS1 (MSG).                              DCUPDKW 
00246      ADD 1 TO REV.                                                DCUPDKW 
00247      MOVE HIGH-VALUES TO REV-STD-NAME (REV).                      DCUPDKW 
00248      IF CODE-ERR-SW EQUAL TO "N"                                     CL**2
00249          GO TO CAT-MVC-MSG-20.                                       CL**2
00250      MOVE "N" TO CODE-ERR-SW.                                        CL**2
00251      ADD 1 TO MSG.                                                   CL**2
00252      MOVE SPACES TO VAL-AREA.                                        CL**2
00253      MOVE " CODES" TO MSG-POS3 (MSG).                                CL**2
00254      MOVE "ALLOWED-" TO MSG-POS4 (MSG).                              CL**2
00255      MOVE 1 TO VC VA.                                                CL**2
           IF CODE-ERR-SW EQUAL "B" 
               GO TO CAT-MVC-MSG-15.
00256  CAT-MVC-MSG-10.                                                     CL**2
00257      MOVE V-CODE (VC) TO VAL (VA).                                   CL**2
00258      ADD 1 TO VA VC.                                                 CL**2
00259      IF V-CODE (VC) NOT EQUAL TO "/"                                 CL**2
00260          GO TO CAT-MVC-MSG-10.                                       CL**2
00261      MOVE VAL-AREA TO MSG-POS6 (MSG).                                CL**2
           GO TO CAT-MVC-MSG-20.
       CAT-MVC-MSG-15.
           PERFORM VARYING COUNTER FROM 1 BY 1
             UNTIL LITTLE-CODE (COUNTER) = "/  "
               CONTINUE 
           END-PERFORM
           SUBTRACT 1 FROM COUNTER. 
           MULTIPLY 3 BY COUNTER. 
           IF COUNTER GREATER THAN 36 
               MOVE 36 TO COUNTER.
           MOVE BIG-CODES (1 : COUNTER) TO MSG-POS6 (MSG).
00262  CAT-MVC-MSG-20.                                                     CL**2
00263      ADD 1 TO MSG.                                                DCUPDKW 
00264      MOVE SPACES TO ERR-MSG (MSG).                                   CL**2
00265 *                                                                    CL**2
00266 *     END OF CLAUSE TESTS                                            CL**2
00267 *                                                                    CL**2
00268  CAT-END-TEST.                                                    DCUPDKW 
00269      IF CONTINUE-SW EQUAL TO "N"                                     CL**2
00270          MOVE "W" TO FUNC                                            CL**2
00271          GO TO CAT-END-TEST-BACK.                                    CL**2
00272      IF CONTINUE-SW EQUAL TO "Y"                                     CL**2
00273          ADD 1 TO TX                                                 CL**2
00274          GO TO CAT-LOC-KW.                                           CL**2
00275      MOVE "R" TO FUNC.                                               CL**2
00276  CAT-END-TEST-BACK.                                                  CL**2
           IF CAT-DETAIL = SPACES AND FUNC = "W"
               MOVE HOLD-COMMENT TO CAT-WORK-AREAS
               MOVE SPACES TO HOLD-COMMENT. 
00277      EXIT PROGRAM.                                                 DCUPDKW
00278 **************************************************************       CL**2
00279 **************************************************************       CL**2
00280 *                                                                 DCUPDKW 
00281 *     C O M M O N   S U B R O U T I N E S                         DCUPDKW 
00282 *                                                                 DCUPDKW 
00283 **************************************************************       CL**2
00284 **************************************************************       CL**2
00285 *                                                                 DCUPDKW 
00286 *     MOVE NUMERIC AND VALIDATE SUB-ROUTINE                       DCUPDKW 
00287 *                                                                 DCUPDKW 
00288  MOVE-NUM.                                                        DCUPDKW 
           MOVE ZEROES TO NUM-HOLD. 
           PERFORM VARYING COUNTER FROM 1 BY 1
             UNTIL VAL (COUNTER) EQUAL TO SPACE 
               IF VAL (COUNTER) IS NOT NUMERIC
                 AND NUM-EDIT NOT EQUAL TO SPACE
                 AND VAL (COUNTER) NOT EQUAL TO NUM-EDIT
                 AND VAL (COUNTER) NOT EQUAL TO "-" 
                   GO TO MOVE-NUM-ERR 
               END-IF 
           END-PERFORM
           IF VAL (1) EQUAL "-" 
               MOVE VAL (1) TO NUM-HOLD-X (1 : 1) 
               MOVE 2 TO NUM-SPOT 
               SUBTRACT 1 FROM COUNTER
           ELSE 
               MOVE 1 TO NUM-SPOT 
           END-IF 
           SUBTRACT 1 FROM COUNTER. 
           COMPUTE START-SPOT = FLD-LEN (FLD) - COUNTER + 1.
           MOVE VAL-AREA  (NUM-SPOT : COUNTER) TO 
               NUM-HOLD-X (START-SPOT : COUNTER). 
           GO TO VALID-NUM-XIT. 
00331  MOVE-NUM-ERR.                                                    DCUPDKW 
00332      MOVE CERR-225W TO MSG-POS5 (MSG).                               CL**2
00333      MOVE "225-W" TO MSG-POS2 (MSG).                                 CL**2
00334          GO TO CAT-MVC-MSG-ERR.                                   DCUPDKW 
00335  VALID-NUM-XIT. EXIT.                                             DCUPDKW 
00336 *                                                                 DCUPDKW 
00337 *     CODE VALIDATION SUB-ROUTINE                                 DCUPDKW 
00338 *                                                                 DCUPDKW 
00339  VALID-CODE.                                                      DCUPDKW 
00340      MOVE 1 TO VC.                                                DCUPDKW 
00341  VALID-CODE-10.                                                   DCUPDKW 
00342      IF VAL (1) EQUAL TO V-CODE (VC)                              DCUPDKW 
00343          GO TO VALID-CODE-XIT.                                    DCUPDKW 
00344      ADD 1 TO VC.                                                 DCUPDKW 
00345      IF V-CODE (VC) EQUAL TO "/"                                  DCUPDKW 
               MOVE "Y" TO CODE-ERR-SW
               GO TO VALIDATION-ERROR.
00351  VALID-CODE-XIT. EXIT.                                            DCUPDKW 
      * 
      *    SET UP VALIDATION ERROR MESSAGE
      * 
       VALIDATION-ERROR.
           MOVE CERR-235W TO MSG-POS5 (MSG).
           MOVE "235-W" TO MSG-POS2 (MSG).
           GO TO CAT-MVC-MSG-ERR. 
      * 
      *    ADD AN ENTRY TO REL-TABLE
      * 
       SET-REL-TABLE. 
           ADD 1 TO NUM-ENTRIES.
           IF NUM-ENTRIES GREATER THAN 20 
               MOVE "T" TO FUNC 
               SUBTRACT 1 FROM NUM-ENTRIES
               EXIT PROGRAM 
           END-IF 
           MOVE SAVE-NAME TO REL-NAME (NUM-ENTRIES).
           MOVE CATAL-NAME TO PTR-NAME (NUM-ENTRIES). 
           MOVE SAVE-ENT-TYPE TO PTR-ENT-TYPE (NUM-ENTRIES).
           MOVE SAVE-FUNCTION TO REL-FUNCTION (NUM-ENTRIES).
       SET-REL-TABLE-EXIT.
           EXIT.
      **************************************************************
      *    PROCEDURE GET-NEXT-BLOCK EXITS THE PROGRAM IF THE
      *    FUNCTION CODE IS SET TO "R" THEREBY REQUESTING THE 
      *    READ OF THE NEXT BLOCK OF DATA.
      *    IF THE FUNCTION CODE IS EQUAL TO SPACE, THE READ 
      *    IS COMPLETE AND EXIT THE PROCEDURE.
      **************************************************************
       GET-NEXT-BLOCK.
           IF FUNC EQUAL TO "B" 
               EXIT PROGRAM 
           END-IF 
       GET-NEXT-BLOCK-EXIT. 
           EXIT.
      ********************************************************
      *    PROCEDURE CHANGE-DELETE CHECKS TO SEE IF AN
      *    EXISTING VALUE IS BEING CHANGED.  IF SO, INFORMATION 
      *    ABOUT THE EXISTING ENTRY IS ADDED TO THE REL-TABLE 
      *    SO THAT THE POINTERS IN MAST2 ARE MAINTAINED 
      *    CORRECTLY. 
      * 
      *    IT IS ASSUMED THAT THE VALUE FROM THE FIELD IS 
      *    STORED IN *OLD-VALUE* BEFORE THE PROCEDURE IS
      *    CALLED.
      ********************************************************* 
       CHANGE-DELETE. 
           IF ADD-CHG EQUAL "C" 
             AND OLD-VALUE NOT EQUAL SPACES 
               MOVE "D" TO SAVE-FUNCTION
               MOVE OLD-VALUE TO SAVE-NAME
               PERFORM SET-REL-TABLE THRU SET-REL-TABLE-EXIT
           END-IF 
           MOVE "A" TO SAVE-FUNCTION. 
       CHANGE-DELETE-EXIT.
           EXIT.
  
      ************************************************* 
      *    PROCEDURE FIELD-DELETE SETS UP THE VALUES
      *    REQUIRED SO THAT *UPD-REL-REC* IN THE MAIN 
      *    PROGRAM WILL DELETE POINTERS 
      * 
      *    IT IS ASSUMED THAT THE VALUE OF THE FIELD IS 
      *    STORED IN *OLD-VALUE* BEFORE THE PROCEDURE 
      *    IS CALLED. 
      **************************************************
  
       FIELD-DELETE.
           MOVE SPACES TO NEW-CATAL-NAME. 
           MOVE "X" TO TYPE-CATAL-NAME. 
           MOVE OLD-VALUE TO OLD-CATAL-NAME.
       FIELD-DELETE-EXIT. 
           EXIT.
      ******************************************************************* 
      *    THIS PROCEDURE SEPARATES OUT UP TO THREE LEVELS OF SUBSCRIPTS
      *    AND STORES THEM IN A TEMPORARY ARRAY WHICH MAY THEN BE USED
      *    TO MOVE THEM TO THE PROPER LOCATION WITHIN THE BLOCKS. 
      ******************************************************************* 
       MOVE-SUB.
           MOVE 1 TO  SUB-NUM.
           ADD 1 TO TX. 
           MOVE TX TO START-SPOT. 
           PERFORM VARYING COUNTER FROM TX BY 1 
             UNTIL COUNTER GREATER THAN 72
               IF TX-POS (COUNTER) = "," OR "]" 
                   COMPUTE SUB-LENGTH = COUNTER - START-SPOT
                   MOVE TX-IMAGE (START-SPOT : SUB-LENGTH)
                       TO SUBSCRIPT (SUB-NUM) 
                   ADD 1 TO SUB-NUM 
                   IF TX-POS (COUNTER) = "]"
                       ADD 1 TO COUNTER 
                       MOVE COUNTER TO TX 
                       GO TO MOVE-SUB-EXIT
                   END-IF 
                   ADD 1, COUNTER GIVING START-SPOT 
               END-IF 
           END-PERFORM. 
       MOVE-SUB-EXIT. 
           EXIT.
00352 *                                                                 DCUPDKW 
00353 *     VALIDATE CATALOGUE NAME                                     DCUPDKW 
00354 *                                                                 DCUPDKW 
00355  CK-CATNAME.                                                      DCUPDKW 
00356      MOVE "C" TO FUNC.                                            DCUPDKW 
00357      IF VAL-AREA EQUAL TO CATAL-NAME                                 CL**2
00358          MOVE CERR-210W TO MSG-POS5 (MSG)                            CL**2
00359          MOVE "210-W" TO MSG-POS2 (MSG)                              CL**2
00360          MOVE SPACE TO TYPE-CATAL-NAME                               CL**2
00361          MOVE SPACES TO NEW-CATAL-NAME                               CL**2
00362          GO TO CAT-MVC-MSG-ERR.                                      CL**2
00363      MOVE VAL-AREA TO CK-CATAL-NAME.                                 CL**2
00364      EXIT PROGRAM.                                                 DCUPDKW
00365  CK-CATNAME-20.                                                   DCUPDKW 
00366      IF STATUS-SW EQUAL TO HIGH-VALUE                                CL**2
00367          MOVE CERR-200W TO MSG-POS5 (MSG)                            CL**2
00368          MOVE "200-W" TO MSG-POS2 (MSG)                              CL**2
00369          GO TO CAT-MVC-MSG-ERR.                                   DCUPDKW 
00370      IF STATUS-SW EQUAL TO "G"                                       CL**2
00371          MOVE CERR-205W TO MSG-POS5 (MSG)                            CL**2
00372          MOVE "205-W" TO MSG-POS2 (MSG)                              CL**2
00373          GO TO CAT-MVC-MSG-ERR.                                      CL**2
00374  CK-CATNAME-XIT. EXIT.                                            DCUPDKW 
00375 **************************************************************       CL**2
00376 **************************************************************       CL**2
00377 *                                                                 DCUPDKW 
00378 *     C A T E G O R Y   E D I T I N G                             DCUPDKW 
00379 *                                                                 DCUPDKW 
00380 **************************************************************       CL**2
00381 **************************************************************       CL**2
00382  CATEGORY-EDIT.                                                   DCUPDKW 
00383 ****************************************************              DCUPDKW 
00384 *                                                                 DCUPDKW 
00385 *     CONTROL CATEGORY                                            DCUPDKW 
00386 *                                                                 DCUPDKW 
00387 ****************************************************              DCUPDKW 
00388      IF CAT-ID NOT EQUAL TO 010 GO TO COMMON-EDIT.                   CL**2
00389 *                                                                 DCUPDKW 
00390 *     CONRTOL - ALYSIS                                            DCUPDKW 
00391 *                                                                 DCUPDKW 
00392  CTL-EDIT.                                                        DCUPDKW 
00393      IF FIELD-ID NOT EQUAL TO 5 GO TO CTL-EDIT-STATUS.            DCUPDKW 
00394      MOVE CTL-ALY-VER TO OLD-VALUE.                               DCUPDKW 
00395      MOVE CTL-ALY-VER TO OLD-CATAL-NAME.                             CL**2
00396      IF VAL (1) EQUAL TO "$"                                      DCUPDKW 
00397          GO TO CTL-DEL-ALY.                                       DCUPDKW 
00398      PERFORM CK-CATNAME THRU CK-CATNAME-XIT.                      DCUPDKW 
00399      MOVE "A" TO TYPE-CATAL-NAME.                                    CL**2
00400      MOVE VAL-AREA TO NEW-CATAL-NAME.                                CL**2
00401      MOVE VAL-AREA TO CTL-ALY-VER.                                DCUPDKW 
00402      GO TO CAT-MVC-MSG-CHG.                                       DCUPDKW 
00403  CTL-DEL-ALY.                                                     DCUPDKW 
00404      IF CTL-ALY-VER EQUAL TO SPACES                               DCUPDKW 
00405          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPDKW 
00406      MOVE SPACES TO CTL-ALY-VER.                                  DCUPDKW 
00407      MOVE "A" TO TYPE-CATAL-NAME.                                    CL**2
00408      MOVE SPACES TO NEW-CATAL-NAME.                                  CL**2
00409      GO TO CAT-MVC-MSG-DEL.                                       DCUPDKW 
00410 *                                                                 DCUPDKW 
00411 *     CONTROL - STATUS                                            DCUPDKW 
00412 *                                                                 DCUPDKW 
00413  CTL-EDIT-STATUS.                                                 DCUPDKW 
00414      IF FIELD-ID NOT EQUAL TO 10 GO TO CTL-EDIT-SEC.              DCUPDKW 
00415      MOVE CTL-STATUS TO OLD-VALUE.                                DCUPDKW 
00416      IF VAL (1) EQUAL TO "$" GO TO CTL-DEL-STATUS.                DCUPDKW 
00417      MOVE STATUS-CODES TO VALID-CODE-TABLE.                       DCUPDKW 
00418      PERFORM VALID-CODE THRU VALID-CODE-XIT.                      DCUPDKW 
00419      MOVE VAL (1) TO CTL-STATUS.                                  DCUPDKW 
00420      GO TO CAT-MVC-MSG-CHG.                                       DCUPDKW 
00421  CTL-DEL-STATUS.                                                  DCUPDKW 
00422      IF CTL-STATUS EQUAL TO SPACE                                 DCUPDKW 
00423          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPDKW 
00424      MOVE SPACE TO CTL-STATUS.                                    DCUPDKW 
00425      GO TO CAT-MVC-MSG-DEL.                                       DCUPDKW 
00426 *                                                                 DCUPDKW 
00427 *     CONTROL - SECURITY                                          DCUPDKW 
00428 *                                                                 DCUPDKW 
00429  CTL-EDIT-SEC.                                                    DCUPDKW 
00430      IF FIELD-ID NOT EQUAL TO 15 GO TO CTL-EDIT-AUTH1.            DCUPDKW 
00431      MOVE CTL-SECURITY TO OLD-VALUE.                              DCUPDKW 
00432      IF VAL (1) EQUAL TO "$" GO TO CTL-DEL-SEC.                   DCUPDKW 
00433      MOVE VAL (1) TO NUM-HOLD.                                    DCUPDKW 
           MOVE SPACES TO NUM-EDIT. 
00434      PERFORM MOVE-NUM THRU VALID-NUM-XIT.                         DCUPDKW 
00435      MOVE VAL (1) TO CTL-SECURITY.                                DCUPDKW 
00436      GO TO CAT-MVC-MSG-CHG.                                       DCUPDKW 
00437  CTL-DEL-SEC.                                                     DCUPDKW 
00438      IF CTL-SECURITY EQUAL TO SPACE                               DCUPDKW 
00439          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPDKW 
00440      MOVE SPACE TO CTL-SECURITY.                                  DCUPDKW 
00441      GO TO CAT-MVC-MSG-DEL.                                       DCUPDKW 
00442 *                                                                 DCUPDKW 
00443 *     CONTROL - AUTH CODE 1                                       DCUPDKW 
00444 *                                                                 DCUPDKW 
00445  CTL-EDIT-AUTH1.                                                  DCUPDKW 
00446      GO TO FLD-ERR.                                               DCUPDKW 
00447 *******************************************************              CL**2
00448 *                                                                    CL**2
00449 *     CLASS., DESC, AND OTHER PROCESSING                             CL**2
00450 *                                                                    CL**2
00451 *******************************************************              CL**2
00452  KEY-EDIT.                                                           CL**2
00453      MOVE SPACES TO KEY-WORD.                                        CL**2
00454      MOVE "N" TO CONTINUE-SW.                                        CL**2
00455      MOVE SPACES TO VAL-AREA.                                        CL**2
00456      MOVE 1 TO VA.                                                   CL**2
00457  KEY-EDIT-10.                                                        CL**2
00458      MOVE TX-POS (TX) TO VAL (VA).                                   CL**2
00459      ADD 1 TO TX  VA.                                                CL**2
00460      IF TX LESS THAN 73                                              CL**2
00461          GO TO KEY-EDIT-10.                                          CL**2
00462      MOVE KEY-WORDS TO OLD-VALUE.                                    CL**2
00463      MOVE VAL-AREA TO KEY-WORDS.                                     CL**2
00464      GO TO CAT-MVC-MSG-CHG.                                          CL**2
00465  COMMON-EDIT.                                                     DCUPDKW 
00466 **DCUPDKW END**                                                      CL**2
