*DECK     DCUPD40 
00001  IDENTIFICATION DIVISION.                                         07/14/78
       PROGRAM-ID. UPD40. 
00003 ******************************************************               LV001
00004 *                                                                 DCUPD40 
00005 *     R E P O R T   E N T R Y   E D I T I N G                     DCUPD40 
00006 *                                                                 DCUPD40 
00007 ******************************************************            DCUPD40 
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION. 
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
       DATA DIVISION. 
*CALL UPDCS 
*CALL DCDWA40 
*CALL QUALINE 
*CALL     DCUPDSWS                                                         CL**5
00009  01  MED-CODES            PICTURE X(16) VALUE                        CL**2
00010      "DMPST0123456789/".                                             CL**2
00011  01  MODE1-CODES            PICTURE X(16) VALUE                      CL**2
00012     "BDMFR0123456789/".                                              CL**2
00013  01  TIME-RET-CODES      PICTURE X(18) VALUE                         CL**2
00014      "DWMQSAI0123456789/".                                           CL**2
00019  PROCEDURE DIVISION.                                                 CL**2
*CALL     DCUPDKW                                                          CL**5
00022 ******************************************************            DCUPD40 
00023 *                                                                 DCUPD40 
00024 *     R E P O R T   E N T R Y   E D I T I N G                     DCUPD40 
00025 *                                                                 DCUPD40 
00026 ******************************************************            DCUPD40 
00027 *                                                                 DCUPD40 
00028 *                                                                 DCUPD40 
00029 ******************************************************            DCUPD40 
00030 *                                                                 DCUPD40 
00031 *     RESPONSIBILITY CATEGORY                                     DCUPD40 
00032 *                                                                 DCUPD40 
00033 ******************************************************            DCUPD40 
00034  RESP-EDIT.                                                       DCUPD40 
           MOVE SPACE TO NUM-EDIT.
00035      IF CAT-ID NOT EQUAL TO 140 GO TO NAME-EDIT.                  DCUPD40 
00036 *                                                                 DCUPD40 
00037 *     RESPONSIBILITY - STATUS                                     DCUPD40 
00038 *                                                                 DCUPD40 
00039  RESP-EDIT-STAT.                                                  DCUPD40 
00040      IF FIELD-ID NOT EQUAL TO 005 GO TO RESP-EDIT-FUNC.           DCUPD40 
00041      MOVE RESP-R-STATUS TO OLD-VALUE.                             DCUPD40 
00042      IF VAL (1) EQUAL TO "$" GO TO RESP-DEL-STAT.                 DCUPD40 
00043      MOVE STAT-CODES TO VALID-CODE-TABLE.                         DCUPD40 
00044      PERFORM VALID-CODE THRU VALID-CODE-XIT.                      DCUPD40 
00045      MOVE VAL-AREA TO RESP-R-STATUS.                              DCUPD40 
00046      GO TO CAT-MVC-MSG-CHG.                                       DCUPD40 
00047  RESP-DEL-STAT.                                                   DCUPD40 
00048      IF RESP-R-STATUS EQUAL TO SPACES                             DCUPD40 
00049          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD40 
00050      MOVE SPACES TO RESP-R-STATUS.                                DCUPD40 
00051      GO TO CAT-MVC-MSG-DEL.                                       DCUPD40 
00052 *                                                                 DCUPD40 
00053 *     RESPONSIBILITY - FUNCTION                                   DCUPD40 
00054 *                                                                 DCUPD40 
00055  RESP-EDIT-FUNC.                                                  DCUPD40 
00056      IF FIELD-ID NOT EQUAL TO 010 GO TO RESP-EDIT-DPT.            DCUPD40 
00057      MOVE RESP-R-FUNC TO OLD-VALUE.                               DCUPD40 
00058      IF VAL (1) EQUAL TO "$" GO TO RESP-DEL-FUNC.                 DCUPD40 
00059      MOVE FUNC-CODES TO VALID-CODE-TABLE.                         DCUPD40 
00060      PERFORM VALID-CODE THRU VALID-CODE-XIT.                      DCUPD40 
00061      MOVE VAL-AREA TO RESP-R-FUNC.                                DCUPD40 
00062      GO TO CAT-MVC-MSG-CHG.                                       DCUPD40 
00063  RESP-DEL-FUNC.                                                   DCUPD40 
00064      IF RESP-R-FUNC EQUAL TO SPACES                               DCUPD40 
00065          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD40 
00066      MOVE SPACES TO RESP-R-FUNC.                                  DCUPD40 
00067      GO TO CAT-MVC-MSG-DEL.                                       DCUPD40 
00068 *                                                                 DCUPD40 
00069 *     RESPOSSIBILITY - DEPT                                       DCUPD40 
00070 *                                                                 DCUPD40 
00071  RESP-EDIT-DPT.                                                   DCUPD40 
00072      IF FIELD-ID NOT EQUAL TO 015 GO TO RESP-EDIT-PER.            DCUPD40 
00073      MOVE RESP-R-DEPT TO OLD-VALUE.                               DCUPD40 
00074      IF VAL (1) EQUAL TO "$" GO TO RESP-DEL-DPT.                  DCUPD40 
00075      MOVE VAL-AREA TO RESP-R-DEPT.                                DCUPD40 
00076      GO TO CAT-MVC-MSG-CHG.                                       DCUPD40 
00077  RESP-DEL-DPT.                                                    DCUPD40 
00078      IF RESP-R-DEPT EQUAL TO SPACES                               DCUPD40 
00079          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD40 
00080      MOVE SPACES TO RESP-R-DEPT.                                  DCUPD40 
00081      GO TO CAT-MVC-MSG-DEL.                                       DCUPD40 
00082 *                                                                 DCUPD40 
00083 *     RESPONSIBILITY - PERSON                                     DCUPD40 
00084 *                                                                 DCUPD40 
00085  RESP-EDIT-PER.                                                   DCUPD40 
00086      IF FIELD-ID NOT EQUAL TO 020 GO TO RESP-EDIT-PHONE.          DCUPD40 
00087      MOVE RESP-R-PERSON TO OLD-VALUE.                             DCUPD40 
00088      IF VAL (1) EQUAL TO "$" GO TO RESP-DEL-PER.                  DCUPD40 
00089      MOVE VAL-AREA TO RESP-R-PERSON.                              DCUPD40 
00090      GO TO CAT-MVC-MSG-CHG.                                       DCUPD40 
00091  RESP-DEL-PER.                                                    DCUPD40 
00092      IF RESP-R-PERSON EQUAL TO SPACES                             DCUPD40 
00093          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD40 
00094      MOVE SPACES TO RESP-R-PERSON.                                DCUPD40 
00095      GO TO CAT-MVC-MSG-DEL.                                       DCUPD40 
00096 *                                                                 DCUPD40 
00097 *     RESPONSIBILITY - PHONE                                      DCUPD40 
00098 *                                                                    CL**2
00099  RESP-EDIT-PHONE.                                                 DCUPD40 
00100      IF FIELD-ID NOT EQUAL TO 025 GO TO RESP-EDIT-TIT.            DCUPD40 
00101      MOVE RESP-R-PHONE TO OLD-VALUE.                              DCUPD40 
00102      IF VAL (1) EQUAL TO "$" GO TO RESP-DEL-PHONE.                DCUPD40 
00103      MOVE VAL-AREA TO RESP-R-PHONE.                               DCUPD40 
00104      GO TO CAT-MVC-MSG-CHG.                                       DCUPD40 
00105  RESP-DEL-PHONE.                                                  DCUPD40 
00106      IF RESP-R-PHONE EQUAL TO SPACES                              DCUPD40 
00107          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD40 
00108      MOVE SPACES TO RESP-R-PHONE.                                 DCUPD40 
00109      GO TO CAT-MVC-MSG-DEL.                                       DCUPD40 
00110 *                                                                 DCUPD40 
00111 *     RESPONSIBILITY - TITLE                                      DCUPD40 
00112 *                                                                 DCUPD40 
00113  RESP-EDIT-TIT.                                                   DCUPD40 
00114      IF FIELD-ID NOT EQUAL TO 030 GO TO RESP-EDIT-MAIL.           DCUPD40 
00115      MOVE RESP-R-TITLE TO OLD-VALUE.                              DCUPD40 
00116      IF VAL (1) EQUAL TO "$" GO TO RESP-DEL-TIT.                  DCUPD40 
00117      MOVE VAL-AREA TO RESP-R-TITLE.                               DCUPD40 
00118      GO TO CAT-MVC-MSG-CHG.                                       DCUPD40 
00119  RESP-DEL-TIT.                                                    DCUPD40 
00120      IF RESP-R-TITLE EQUAL TO SPACES                              DCUPD40 
00121          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD40 
00122      MOVE SPACES TO RESP-R-TITLE.                                 DCUPD40 
00123      GO TO CAT-MVC-MSG-DEL.                                       DCUPD40 
00124 *                                                                 DCUPD40 
00125 *     RESPONSIBILITY - MAIL                                       DCUPD40 
00126 *                                                                 DCUPD40 
00127  RESP-EDIT-MAIL.                                                  DCUPD40 
00128      IF FIELD-ID NOT EQUAL TO 035 GO TO RESP-EDIT-DATE.           DCUPD40 
00129      MOVE RESP-R-MAIL TO OLD-VALUE.                               DCUPD40 
00130      IF VAL (1) EQUAL TO "$" GO TO RESP-DEL-MAIL.                 DCUPD40 
00131      MOVE VAL-AREA TO RESP-R-MAIL.                                DCUPD40 
00132      GO TO CAT-MVC-MSG-CHG.                                       DCUPD40 
00133  RESP-DEL-MAIL.                                                   DCUPD40 
00134      IF RESP-R-MAIL EQUAL TO SPACES                               DCUPD40 
00135          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD40 
00136      MOVE SPACES TO RESP-R-MAIL.                                  DCUPD40 
00137      GO TO CAT-MVC-MSG-DEL.                                       DCUPD40 
00138 *                                                                 DCUPD40 
00139 *     RESPONSIBILITY - DATE                                       DCUPD40 
00140 *                                                                 DCUPD40 
00141  RESP-EDIT-DATE.                                                  DCUPD40 
00142      IF FIELD-ID NOT EQUAL TO 040 GO TO FLD-ERR.                  DCUPD40 
00143      MOVE RESP-R-DATE TO OLD-VALUE.                               DCUPD40 
00144      IF VAL (1) EQUAL TO "$" GO TO RESP-DEL-DATE.                 DCUPD40 
00145      MOVE VAL-AREA TO RESP-R-DATE.                                DCUPD40 
00146      GO TO CAT-MVC-MSG-CHG.                                       DCUPD40 
00147  RESP-DEL-DATE.                                                   DCUPD40 
00148      IF RESP-R-DATE EQUAL TO SPACES                               DCUPD40 
00149          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD40 
00150      MOVE SPACES TO RESP-R-DATE.                                  DCUPD40 
00151      GO TO CAT-MVC-MSG-DEL.                                       DCUPD40 
00152 *****************************************************             DCUPD40 
00153 *                                                                 DCUPD40 
00154 *     NAME CATEGORY                                               DCUPD40 
00155 *                                                                 DCUPD40 
00156 *****************************************************             DCUPD40 
00157  NAME-EDIT.                                                       DCUPD40 
00158      IF CAT-ID NOT EQUAL TO 200 GO TO ATTR-EDIT.                  DCUPD40 
00159 *                                                                 DCUPD40 
00160 *     NAME - REPORT NAME                                          DCUPD40 
00161 *                                                                 DCUPD40 
00162  NAME-EDIT-RN.                                                       CL**2
00163      IF FIELD-ID NOT EQUAL TO 05 GO TO NAME-EDIT-NO.              DCUPD40 
00164      MOVE NAME-R-REPORT TO OLD-VALUE.                             DCUPD40 
00165      IF VAL (1) EQUAL TO "$" GO TO NAME-DEL-RN.                      CL**2
00166      MOVE VAL-AREA TO NAME-R-REPORT.                              DCUPD40 
00167      GO TO CAT-MVC-MSG-CHG.                                       DCUPD40 
00168  NAME-DEL-RN.                                                        CL**2
00169      IF NAME-R-REPORT EQUAL TO SPACES                             DCUPD40 
00170          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD40 
00171      MOVE SPACES TO NAME-R-REPORT.                                DCUPD40 
00172      GO TO CAT-MVC-MSG-DEL.                                       DCUPD40 
00173 *                                                                 DCUPD40 
00174 *     NAME - REPORT NO                                            DCUPD40 
00175 *                                                                 DCUPD40 
00176  NAME-EDIT-NO.                                                    DCUPD40 
00177      IF FIELD-ID NOT EQUAL TO 10 GO TO NAME-EDIT-FORM.            DCUPD40 
00178      MOVE NAME-R-REPORT-NO TO OLD-VALUE.                          DCUPD40 
00179      IF VAL (1) EQUAL TO "$" GO TO NAME-DEL-NO.                   DCUPD40 
00180      MOVE VAL-AREA TO NAME-R-REPORT-NO.                           DCUPD40 
00181      GO TO CAT-MVC-MSG-CHG.                                       DCUPD40 
00182  NAME-DEL-NO.                                                     DCUPD40 
00183      IF NAME-R-REPORT-NO EQUAL TO SPACES                          DCUPD40 
00184          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD40 
00185      MOVE SPACES TO NAME-R-REPORT-NO.                             DCUPD40 
00186      GO TO CAT-MVC-MSG-DEL.                                       DCUPD40 
00187 *                                                                 DCUPD40 
00188 *                                                                 DCUPD40 
00189 *     NAME - FORM                                                 DCUPD40 
00190 *                                                                 DCUPD40 
00191  NAME-EDIT-FORM.                                                  DCUPD40 
00192      IF FIELD-ID NOT EQUAL TO 15 GO TO FLD-ERR.                   DCUPD40 
00193      MOVE NAME-R-FORM TO OLD-VALUE.                               DCUPD40 
00194      IF VAL (1) EQUAL TO "$" GO TO NAME-DEL-FN.                   DCUPD40 
00195      MOVE VAL-AREA TO NAME-R-FORM.                                DCUPD40 
00196      GO TO CAT-MVC-MSG-CHG.                                       DCUPD40 
00197  NAME-DEL-FN.                                                     DCUPD40 
00198      IF NAME-R-FORM EQUAL TO SPACES                               DCUPD40 
00199          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD40 
00200      MOVE SPACES TO NAME-R-FORM.                                  DCUPD40 
00201      GO TO CAT-MVC-MSG-DEL.                                       DCUPD40 
00202 ****************************************************              DCUPD40 
00203 *                                                                 DCUPD40 
00204 *     ATTRIBUTE CATEGORY                                          DCUPD40 
00205 *                                                                 DCUPD40 
00206 ***************************************************               DCUPD40 
00207  ATTR-EDIT.                                                       DCUPD40 
00208      IF CAT-ID NOT EQUAL TO 210 GO TO FLOW-EDIT.                  DCUPD40 
00209 *                                                                 DCUPD40 
00210 *     ATTR - MED                                                  DCUPD40 
00211 *                                                                 DCUPD40 
00212  ATTR-EDIT-MED.                                                   DCUPD40 
00213      IF FIELD-ID NOT EQUAL TO 05 GO TO ATTR-EDIT-PARTS.           DCUPD40 
00214      MOVE ATTR-R-MEDIUM TO OLD-VALUE.                                CL**2
00215      IF VAL (1) EQUAL TO "$" GO TO ATTR-DEL-MED.                  DCUPD40 
00216      MOVE MED-CODES TO VALID-CODE-TABLE.                          DCUPD40 
00217      PERFORM VALID-CODE THRU VALID-CODE-XIT.                      DCUPD40 
00218      MOVE VAL (1) TO ATTR-R-MEDIUM.                                  CL**2
00219      GO TO CAT-MVC-MSG-CHG.                                       DCUPD40 
00220  ATTR-DEL-MED.                                                    DCUPD40 
00221      IF ATTR-R-MEDIUM EQUAL TO SPACES                                CL**2
00222          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD40 
00223      MOVE SPACES TO ATTR-R-MEDIUM.                                   CL**2
00224      GO TO CAT-MVC-MSG-DEL.                                       DCUPD40 
00225 *                                                                 DCUPD40 
00226 *     ATTR - PARTS                                                DCUPD40 
00227 *                                                                 DCUPD40 
00228  ATTR-EDIT-PARTS.                                                 DCUPD40 
00229      IF FIELD-ID NOT EQUAL TO 10 GO TO FLD-ERR.                   DCUPD40 
00230      MOVE ATTR-R-PARTS TO OLD-VALUE.                              DCUPD40 
00231      IF VAL (1) EQUAL TO "$" GO TO ATTR-DEL-PARTS.                DCUPD40 
00232      PERFORM MOVE-NUM THRU VALID-NUM-XIT.                         DCUPD40 
           MOVE NUM-HOLD-X TO ATTR-R-PARTS. 
00235      GO TO CAT-MVC-MSG-CHG.                                       DCUPD40 
00236  ATTR-DEL-PARTS.                                                  DCUPD40 
00237      IF ATTR-R-PARTS EQUAL TO SPACES                              DCUPD40 
00238          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD40 
00239      MOVE SPACES TO ATTR-R-PARTS.                                 DCUPD40 
00240      GO TO CAT-MVC-MSG-DEL.                                       DCUPD40 
00241 *****************************************************             DCUPD40 
00242 *                                                                 DCUPD40 
00243 *     FLOW CATEGORY                                               DCUPD40 
00244 *                                                                 DCUPD40 
00245 ****************************************************              DCUPD40 
00246  FLOW-EDIT.                                                       DCUPD40 
00247      IF CAT-ID NOT EQUAL TO 240 GO TO REL-EDIT.                      CL**2
00248 *                                                                 DCUPD40 
00249 *     FLOW - DEPT                                                 DCUPD40 
00250 *                                                                 DCUPD40 
00251  FLOW-EDIT-DEPT.                                                  DCUPD40 
00252      IF FIELD-ID NOT EQUAL TO 05 GO TO FLOW-EDIT-PER.             DCUPD40 
00253      MOVE FLOW-R-DEPT TO OLD-VALUE.                               DCUPD40 
00254      IF VAL (1) EQUAL TO "$" GO TO FLOW-DEL-DEPT.                 DCUPD40 
00255      MOVE VAL-AREA TO FLOW-R-DEPT.                                DCUPD40 
00256      GO TO CAT-MVC-MSG-CHG.                                       DCUPD40 
00257   FLOW-DEL-DEPT.                                                  DCUPD40 
00258      IF FLOW-R-DEPT EQUAL TO SPACES                               DCUPD40 
00259          GO TO CAT-MVC-MSG-ERR-DEL.                                  CL**2
00260      MOVE SPACES TO FLOW-R-DEPT.                                  DCUPD40:  
00261      GO TO CAT-MVC-MSG-DEL.                                       DCUPD40 
00262 *                                                                 DCUPD40 
00263 *     FLOW - PERSON                                               DCUPD40 
00264 *                                                                 DCUPD40 
00265  FLOW-EDIT-PER.                                                   DCUPD40 
00266      IF FIELD-ID NOT EQUAL TO 10 GO TO FLOW-EDIT-PHO.             DCUPD40 
00267      MOVE FLOW-R-PERSON TO OLD-VALUE.                             DCUPD40 
00268      IF VAL (1) EQUAL TO "$" GO TO FLOW-DEL-PER.                     CL**2
00269      MOVE VAL-AREA TO FLOW-R-PERSON.                              DCUPD40 
00270      GO TO CAT-MVC-MSG-CHG.                                       DCUPD40 
00271  FLOW-DEL-PER.                                                    DCUPD40 
00272      IF FLOW-R-PERSON EQUAL TO SPACES                             DCUPD40 
00273          GO TO CAT-MVC-MSG-ERR-DEL.                                  CL**2
00274      MOVE SPACES TO FLOW-R-PERSON.                                DCUPD40 
00275      GO TO CAT-MVC-MSG-DEL.                                       DCUPD40 
00276 *                                                                 DCUPD40 
00277 *     FLOW - PHONE                                                DCUPD40 
00278 *                                                                 DCUPD40 
00279  FLOW-EDIT-PHO.                                                   DCUPD40 
00280      IF FIELD-ID NOT EQUAL TO 15 GO TO FLOW-EDIT-COPIES.             CL**2
00281      MOVE FLOW-R-PHONE TO OLD-VALUE.                              DCUPD40 
00282      IF VAL (1) EQUAL TO "$" GO TO FLOW-DEL-PHO.                  DCUPD40 
00283      MOVE VAL-AREA TO FLOW-R-PHONE.                               DCUPD40 
00284      GO TO CAT-MVC-MSG-CHG.                                       DCUPD40 
00285  FLOW-DEL-PHO.                                                    DCUPD40 
00286      IF FLOW-R-PHONE EQUAL TO SPACES                              DCUPD40 
00287          GO TO CAT-MVC-MSG-ERR-DEL.                                  CL**2
00288      MOVE SPACES TO FLOW-R-PHONE.                                 DCUPD40 
00289      GO TO CAT-MVC-MSG-DEL.                                       DCUPD40 
00290 *                                                                 DCUPD40 
00291 *     FLOW - COPIES                                               DCUPD40 
00292 *                                                                 DCUPD40 
00293  FLOW-EDIT-COPIES.                                                DCUPD40 
00294      IF FIELD-ID NOT EQUAL TO 20 GO TO FLOW-EDIT-M1.                 CL**2
00295      MOVE FLOW-R-COPIES TO OLD-VALUE.                             DCUPD40 
00296      IF VAL (1) EQUAL TO "$" GO TO FLOW-DEL-COPIES.               DCUPD40 
00297      PERFORM MOVE-NUM THRU VALID-NUM-XIT.                            CL**2
           MOVE NUM-HOLD-X TO FLOW-R-COPIES.
00300      GO TO CAT-MVC-MSG-CHG.                                       DCUPD40 
00301  FLOW-DEL-COPIES.                                                 DCUPD40 
00302      IF FLOW-R-COPIES EQUAL TO SPACES                             DCUPD40 
00303          GO TO CAT-MVC-MSG-ERR-DEL.                                  CL**2
00304      MOVE SPACES TO FLOW-R-COPIES.                                DCUPD40 
00305      GO TO CAT-MVC-MSG-DEL.                                       DCUPD40 
00306 *                                                                 DCUPD40 
00307 *     FLOW - MODE                                                 DCUPD40 
00308 *                                                                 DCUPD40 
00309  FLOW-EDIT-M1.                                                       CL**2
00310      IF FIELD-ID NOT EQUAL TO 25 GO TO FLOW-EDIT-M2.                 CL**2
00311      MOVE FLOW-R-MODE1 TO OLD-VALUE.                                 CL**2
00312      IF VAL (1) EQUAL TO "$" GO TO FLOW-DEL-M1.                      CL**2
00313      MOVE MODE1-CODES TO VALID-CODE-TABLE.                           CL**2
00314      PERFORM VALID-CODE THRU VALID-CODE-XIT.                         CL**2
00315      MOVE VAL (1) TO FLOW-R-MODE1.                                   CL**2
00316      GO TO CAT-MVC-MSG-CHG.                                          CL**2
00317  FLOW-DEL-M1.                                                        CL**2
00318      IF FLOW-R-MODE1 EQUAL TO SPACES                                 CL**2
00319          GO TO CAT-MVC-MSG-ERR-DEL.                                  CL**2
00320      MOVE SPACE TO FLOW-R-MODE1.                                     CL**2
00321      GO TO CAT-MVC-MSG-DEL.                                          CL**2
00322  FLOW-EDIT-M2.                                                       CL**2
00323      IF FIELD-ID NOT EQUAL TO 30 GO TO FLOW-EDIT-M3.                 CL**2
00324      MOVE FLOW-R-MODE2 TO OLD-VALUE.                                 CL**2
00325      IF VAL (1) EQUAL TO "$" GO TO FLOW-DEL-M2.                      CL**2
00326      MOVE MODE1-CODES TO VALID-CODE-TABLE.                           CL**2
00327      PERFORM VALID-CODE THRU VALID-CODE-XIT.                         CL**2
00328      MOVE VAL (1) TO FLOW-R-MODE2.                                   CL**2
00329      GO TO CAT-MVC-MSG-CHG.                                          CL**2
00330  FLOW-DEL-M2.                                                        CL**2
00331      IF FLOW-R-MODE2 EQUAL TO SPACES                                 CL**2
00332          GO TO CAT-MVC-MSG-ERR-DEL.                                  CL**2
00333      MOVE SPACE TO FLOW-R-MODE2.                                     CL**2
00334      GO TO CAT-MVC-MSG-DEL.                                          CL**2
00335  FLOW-EDIT-M3.                                                       CL**2
00336      IF FIELD-ID NOT EQUAL TO 35 GO TO FLOW-EDIT-M4.                 CL**2
00337      MOVE FLOW-R-MODE3 TO OLD-VALUE.                                 CL**2
00338      IF VAL (1) EQUAL TO "$" GO TO FLOW-DEL-M3.                      CL**2
00339      MOVE MODE1-CODES TO VALID-CODE-TABLE.                           CL**2
00340      PERFORM VALID-CODE THRU VALID-CODE-XIT.                         CL**2
00341      MOVE VAL (1) TO FLOW-R-MODE3.                                   CL**2
00342      GO TO CAT-MVC-MSG-CHG.                                          CL**2
00343  FLOW-DEL-M3.                                                        CL**2
00344      IF FLOW-R-MODE3 EQUAL TO SPACES                                 CL**2
00345          GO TO CAT-MVC-MSG-ERR-DEL.                                  CL**2
00346      MOVE SPACE TO FLOW-R-MODE3.                                     CL**2
00347      GO TO CAT-MVC-MSG-DEL.                                          CL**2
00348  FLOW-EDIT-M4.                                                       CL**2
00349      IF FIELD-ID NOT EQUAL TO 40 GO TO FLOW-EDIT-M5.                 CL**2
00350      MOVE FLOW-R-MODE4 TO OLD-VALUE.                                 CL**2
00351      IF VAL (1) EQUAL TO "$" GO TO FLOW-DEL-M4.                      CL**2
00352      MOVE MODE1-CODES TO VALID-CODE-TABLE.                           CL**2
00353      PERFORM VALID-CODE THRU VALID-CODE-XIT.                         CL**2
00354      MOVE VAL (1) TO FLOW-R-MODE4.                                   CL**2
00355      GO TO CAT-MVC-MSG-CHG.                                          CL**2
00356  FLOW-DEL-M4.                                                        CL**2
00357      IF FLOW-R-MODE4 EQUAL TO SPACES                                 CL**2
00358          GO TO CAT-MVC-MSG-ERR-DEL.                                  CL**2
00359      MOVE SPACE TO FLOW-R-MODE4.                                     CL**2
00360      GO TO CAT-MVC-MSG-DEL.                                          CL**2
00361  FLOW-EDIT-M5.                                                       CL**2
00362      IF FIELD-ID NOT EQUAL TO 45 GO TO FLOW-EDIT-SDAY.               CL**2
00363      MOVE FLOW-R-MODE5 TO OLD-VALUE.                                 CL**2
00364      IF VAL (1) EQUAL TO "$" GO TO FLOW-DEL-M5.                      CL**2
00365      MOVE MODE1-CODES TO VALID-CODE-TABLE.                           CL**2
00366      PERFORM VALID-CODE THRU VALID-CODE-XIT.                         CL**2
00367      MOVE VAL (1) TO FLOW-R-MODE5.                                   CL**2
00368      GO TO CAT-MVC-MSG-CHG.                                          CL**2
00369  FLOW-DEL-M5.                                                        CL**2
00370      IF FLOW-R-MODE5 EQUAL TO SPACES                                 CL**2
00371          GO TO CAT-MVC-MSG-ERR-DEL.                                  CL**2
00372      MOVE SPACE TO FLOW-R-MODE5.                                     CL**2
00373      GO TO CAT-MVC-MSG-DEL.                                          CL**2
00374 *                                                                 DCUPD40 
00375 *     FLOW - DISTION DAY                                          DCUPD40 
00376 *                                                                 DCUPD40 
00377  FLOW-EDIT-SDAY.                                                  DCUPD40 
00378      IF FIELD-ID NOT EQUAL TO 50 GO TO FLOW-EDIT-RTIME.              CL**2
00379      MOVE FLOW-R-DIST-DAY TO OLD-VALUE.                           DCUPD40 
00380      IF VAL (1) EQUAL TO "$" GO TO FLOW-DEL-SDAY.                 DCUPD40 
00381      MOVE VAL-AREA TO FLOW-R-DIST-DAY.                               CL**2
00382      GO TO CAT-MVC-MSG-CHG.                                       DCUPD40 
00383  FLOW-DEL-SDAY.                                                   DCUPD40 
00384      IF FLOW-R-DIST-DAY EQUAL TO SPACES                           DCUPD40 
00385          GO TO CAT-MVC-MSG-ERR-DEL.                                  CL**2
00386      MOVE SPACES TO FLOW-R-DIST-DAY.                              DCUPD40 
00387      GO TO CAT-MVC-MSG-DEL.                                       DCUPD40 
00388 *                                                                 DCUPD40 
00389 *     FLOW - RETAIN TIME                                          DCUPD40 
00390 *                                                                 DCUPD40 
00391  FLOW-EDIT-RTIME.                                                 DCUPD40 
00392      IF FIELD-ID NOT EQUAL TO 55 GO TO FLOW-EDIT-RUNIT.              CL**2
00393      MOVE FLOW-R-RETAIN-TIME TO OLD-VALUE.                        DCUPD40 
00394      IF VAL (1) EQUAL TO "$" GO TO FLOW-DEL-RTIME.                DCUPD40 
00395      PERFORM MOVE-NUM THRU VALID-NUM-XIT.                         DCUPD40 
           MOVE NUM-HOLD-X TO FLOW-R-RETAIN-TIME. 
00398      GO TO CAT-MVC-MSG-CHG.                                       DCUPD40 
00399  FLOW-DEL-RTIME.                                                  DCUPD40 
00400      IF FLOW-R-RETAIN-TIME EQUAL TO SPACES                        DCUPD40 
00401          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD40 
00402      MOVE SPACES TO FLOW-R-RETAIN-TIME.                           DCUPD40 
00403      GO TO CAT-MVC-MSG-DEL.                                       DCUPD40 
00404 *                                                                 DCUPD40 
00405 *     FLOW - RETAIN UNIT                                          DCUPD40 
00406 *                                                                 DCUPD40 
00407  FLOW-EDIT-RUNIT.                                                 DCUPD40 
00408      IF FIELD-ID NOT EQUAL TO 60 GO TO FLD-ERR.                      CL**2
00409      MOVE FLOW-R-RETAIN-UNIT TO OLD-VALUE.                        DCUPD40 
00410      IF VAL (1) EQUAL TO "$" GO TO FLOW-DEL-RUNIT.                DCUPD40 
00411      MOVE TIME-RET-CODES TO VALID-CODE-TABLE.                        CL**2
00412      PERFORM VALID-CODE THRU VALID-CODE-XIT.                      DCUPD40 
00413      MOVE VAL (1) TO FLOW-R-RETAIN-UNIT.                          DCUPD40 
00414      GO TO CAT-MVC-MSG-CHG.                                       DCUPD40 
00415  FLOW-DEL-RUNIT.                                                  DCUPD40 
00416      IF FLOW-R-RETAIN-UNIT EQUAL TO SPACES                        DCUPD40 
00417          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD40 
00418      MOVE SPACES TO FLOW-R-RETAIN-UNIT.                           DCUPD40 
00419      GO TO CAT-MVC-MSG-DEL.                                       DCUPD40 
00420 ****************************************************              DCUPD40 
00421 *                                                                 DCUPD40 
00422 *     RELATIONAL CATEGORY                                         DCUPD40 
00423 *                                                                 DCUPD40 
00424 ****************************************************              DCUPD40 
00425  REL-EDIT.                                                        DCUPD40 
00426      IF CAT-ID NOT EQUAL TO 800 GO TO CAT-ERR.                    DCUPD40 
00427 *                                                                 DCUPD40 
00428 *     RELATIONAL - CAT NAME                                       DCUPD40 
00429 *                                                                 DCUPD40 
00430  REL-EDIT-CN.                                                     DCUPD40 
00431      IF FIELD-ID NOT EQUAL TO 05 GO TO REL-EDIT-PUSE.             DCUPD40 
00432      MOVE REL-R-CNAME TO OLD-VALUE.                               DCUPD40 
00433      MOVE REL-R-CNAME TO OLD-CATAL-NAME.                             CL**2
00434      IF VAL (1) EQUAL TO "$" GO TO REL-DEL-CN.                    DCUPD40 
00435      PERFORM CK-CATNAME THRU CK-CATNAME-XIT.                      DCUPD40 
00436      MOVE "R" TO TYPE-CATAL-NAME.                                    CL**2
00437      MOVE VAL-AREA TO NEW-CATAL-NAME.                                CL**2
00438      MOVE VAL-AREA TO REL-R-CNAME.                                DCUPD40 
00439      GO TO CAT-MVC-MSG-CHG.                                       DCUPD40 
00440  REL-DEL-CN.                                                      DCUPD40 
00441      IF REL-R-CNAME EQUAL TO SPACES                               DCUPD40 
00442          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD40 
00443      MOVE "R" TO TYPE-CATAL-NAME.                                    CL**2
00444      MOVE SPACES TO REL-R-CNAME.                                  DCUPD40 
00445      MOVE SPACES TO NEW-CATAL-NAME.                                  CL**2
00446      GO TO CAT-MVC-MSG-DEL.                                       DCUPD40 
00447 *                                                                 DCUPD40 
00448 *     RELATIONAL - PUSE                                           DCUPD40 
00449 *                                                                 DCUPD40 
00450  REL-EDIT-PUSE.                                                   DCUPD40 
00451      IF FIELD-ID NOT EQUAL TO 10 GO TO REL-EDIT-TYPE.             DCUPD40 
00452      MOVE REL-R-PUSE TO OLD-VALUE.                                DCUPD40 
00453      IF VAL (1) EQUAL TO "$" GO TO REL-DEL-PUSE.                  DCUPD40 
00454      MOVE PUSE-CODES TO VALID-CODE-TABLE.                         DCUPD40 
00455      PERFORM VALID-CODE THRU VALID-CODE-XIT.                      DCUPD40 
00456      MOVE VAL (1) TO REL-R-PUSE.                                  DCUPD40 
00457      GO TO CAT-MVC-MSG-CHG.                                       DCUPD40 
00458  REL-DEL-PUSE.                                                       CL**2
00459      IF REL-R-PUSE EQUAL TO SPACES                                DCUPD40 
00460          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD40 
00461      MOVE SPACES TO REL-R-PUSE.                                   DCUPD40 
00462      GO TO CAT-MVC-MSG-DEL.                                       DCUPD40 
00463 *                                                                 DCUPD40 
00464 *     RELATION - TYPE                                             DCUPD40 
00465 *                                                                 DCUPD40 
00466  REL-EDIT-TYPE.                                                   DCUPD40 
00467      IF FIELD-ID NOT EQUAL TO 15 GO TO REL-EDIT-PIC.                 CL**2
00468      MOVE REL-R-TYPE TO OLD-VALUE.                                   CL**2
00469      IF VAL (1) EQUAL TO "$" GO TO REL-DEL-TYPE.                     CL**2
00470      MOVE VAL-AREA TO REL-R-TYPE.                                    CL**2
00471      GO TO CAT-MVC-MSG-CHG.                                          CL**2
00472  REL-DEL-TYPE.                                                       CL**2
00473      IF REL-R-TYPE EQUAL TO SPACES                                   CL**2
00474          GO TO CAT-MVC-MSG-ERR-DEL.                                  CL**2
00475      MOVE SPACES TO REL-R-TYPE.                                      CL**2
00476      GO TO CAT-MVC-MSG-DEL.                                          CL**2
00477 *                                                                 DCUPD40 
00478 *     RELATION - PICTURE                                          DCUPD40 
00479 *                                                                 DCUPD40 
00480  REL-EDIT-PIC.                                                       CL**2
00481      IF FIELD-ID NOT EQUAL TO 20 GO TO REL-EDIT-START.               CL**2
00482      MOVE REL-R-PIC TO OLD-VALUE.                                    CL**2
00483      IF VAL (1) EQUAL TO "$" GO TO REL-DEL-PIC.                      CL**2
00484      MOVE VAL-AREA TO REL-R-PIC.                                     CL**2
00485      GO TO CAT-MVC-MSG-CHG.                                          CL**2
00486  REL-DEL-PIC.                                                        CL**2
00487      IF REL-R-PIC EQUAL TO SPACES                                    CL**2
00488          GO TO CAT-MVC-MSG-ERR-DEL.                                  CL**2
00489      MOVE SPACES TO REL-R-PIC.                                       CL**2
00490      GO TO CAT-MVC-MSG-DEL.                                          CL**2
00491 *                                                                 DCUPD40 
00492 *     RELATION - START                                               CL**2
00493 *                                                                 DCUPD40 
00494  REL-EDIT-START.                                                     CL**2
00495      IF FIELD-ID NOT EQUAL TO 25 GO TO REL-EDIT-END.                 CL**2
00496      MOVE REL-R-START TO OLD-VALUE.                                  CL**2
00497      IF VAL (1) EQUAL TO "$" GO TO REL-DEL-START.                    CL**2
00498      PERFORM MOVE-NUM THRU VALID-NUM-XIT.                            CL**2
           MOVE NUM-HOLD-X TO REL-R-START.
00501      GO TO CAT-MVC-MSG-CHG.                                          CL**2
00502  REL-DEL-START.                                                      CL**2
00503      IF REL-R-START EQUAL TO SPACES                                  CL**2
00504          GO TO CAT-MVC-MSG-ERR-DEL.                                  CL**2
00505      MOVE SPACES TO REL-R-START.                                     CL**2
00506      GO TO CAT-MVC-MSG-DEL.                                          CL**2
00507 *                                                                 DCUPD40 
00508 *      RELATION - END                                             DCUPD40 
00509 *                                                                 DCUPD40 
00510  REL-EDIT-END.                                                    DCUPD40 
00511      IF FIELD-ID NOT EQUAL TO 30 GO TO FLD-ERR.                      CL**2
00512      MOVE REL-R-END TO OLD-VALUE.                                    CL**2
00513      IF VAL (1) EQUAL TO "$" GO TO REL-DEL-END.                      CL**2
00514      PERFORM MOVE-NUM THRU VALID-NUM-XIT.                            CL**2
           MOVE NUM-HOLD-X TO REL-R-END.
00517      GO TO CAT-MVC-MSG-CHG.                                          CL**2
00518  REL-DEL-END.                                                        CL**2
00519      IF REL-R-END EQUAL TO SPACES                                    CL**2
00520          GO TO CAT-MVC-MSG-ERR-DEL.                                  CL**2
00521      MOVE SPACES TO REL-R-END.                                       CL**2
00522      GO TO CAT-MVC-MSG-DEL.                                          CL**2
