*DECK     DCUPD45 
00001  IDENTIFICATION DIVISION.                                         04/10/78
       PROGRAM-ID. UPD45. 
00003 ******************************************************               LV001
00004 *                                                                 DCUPD45 
00005 *     E X T E R N A L   R E S O U R C E   E N T R Y               DCUPD45 
00006 *                                                                 DCUPD45 
00007 ******************************************************            DCUPD45 
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION. 
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
       DATA DIVISION. 
*CALL UPDCS 
*CALL DCDWA45 
*CALL QUALINE 
*CALL     DCUPDSWS                                                         CL**5
00009  01  TYPE-CODES            PICTURE X(18) VALUE                       CL**2
00010      "DFOLPST0123456789/".                                           CL**2
00015  PROCEDURE DIVISION.                                                 CL**2
*CALL     DCUPDKW                                                          CL**5
00018 ******************************************************            DCUPD45 
00019 *                                                                 DCUPD45 
00020 *     E X T E R N A L   R E S O U R C E   E N T R Y               DCUPD45 
00021 *                                                                 DCUPD45 
00022 ******************************************************            DCUPD45 
00023 *                                                                 DCUPD45 
00024 *                                                                 DCUPD45 
00025 ******************************************************            DCUPD45 
00026 *                                                                 DCUPD45 
00027 *     RESPONSIBILITY CATEGORY                                     DCUPD45 
00028 *                                                                 DCUPD45 
00029 ******************************************************            DCUPD45 
00030  RESP-XRES-EDIT.                                                  DCUPD45 
00031      IF CAT-ID NOT EQUAL TO 140 GO TO NAME-EDIT.                     CL**2
00032 *                                                                 DCUPD45 
00033 *     RESPONSIBILITY - STATUS                                     DCUPD45 
00034 *                                                                 DCUPD45 
00035  RESP-EDIT-STAT.                                                  DCUPD45 
00036      IF FIELD-ID NOT EQUAL TO 05 GO TO RESP-EDIT-FUNC.            DCUPD45 
00037      MOVE RESP-XRES-STATUS TO OLD-VALUE.                          DCUPD45 
00038      IF VAL (1) EQUAL TO "$" GO TO RESP-DEL-STAT.                 DCUPD45 
00039      MOVE STAT-CODES TO VALID-CODE-TABLE.                         DCUPD45 
00040      PERFORM VALID-CODE THRU VALID-CODE-XIT.                      DCUPD45 
00041      MOVE VAL-AREA TO RESP-XRES-STATUS.                           DCUPD45 
00042      GO TO CAT-MVC-MSG-CHG.                                       DCUPD45 
00043  RESP-DEL-STAT.                                                   DCUPD45 
00044      IF RESP-XRES-STATUS EQUAL TO SPACES                          DCUPD45 
00045          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD45 
00046      MOVE SPACES TO RESP-XRES-STATUS.                             DCUPD45 
00047      GO TO CAT-MVC-MSG-DEL.                                       DCUPD45 
00048 *                                                                 DCUPD45 
00049 *     RESPONSIBILITY - FUNCTION                                   DCUPD45 
00050 *                                                                 DCUPD45 
00051  RESP-EDIT-FUNC.                                                  DCUPD45 
00052      IF FIELD-ID NOT EQUAL TO 10 GO TO RESP-EDIT-DPT.             DCUPD45 
00053      MOVE RESP-XRES-FUNC TO OLD-VALUE.                            DCUPD45 
00054      IF VAL (1) EQUAL TO "$" GO TO RESP-DEL-FUNC.                 DCUPD45 
00055      MOVE FUNC-CODES TO VALID-CODE-TABLE.                         DCUPD45 
00056      PERFORM VALID-CODE THRU VALID-CODE-XIT.                      DCUPD45 
00057      MOVE VAL-AREA TO RESP-XRES-FUNC.                             DCUPD45 
00058      GO TO CAT-MVC-MSG-CHG.                                       DCUPD45 
00059  RESP-DEL-FUNC.                                                   DCUPD45 
00060      IF RESP-XRES-FUNC EQUAL TO SPACES                            DCUPD45 
00061          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD45 
00062      MOVE SPACES TO RESP-XRES-FUNC.                               DCUPD45 
00063      GO TO CAT-MVC-MSG-DEL.                                       DCUPD45 
00064 *                                                                 DCUPD45 
00065 *     RESPOSSIBILITY - DEPT                                       DCUPD45 
00066 *                                                                 DCUPD45 
00067  RESP-EDIT-DPT.                                                   DCUPD45 
00068      IF FIELD-ID NOT EQUAL TO 15 GO TO RESP-EDIT-PER.             DCUPD45 
00069      MOVE RESP-XRES-DEPT TO OLD-VALUE.                            DCUPD45 
00070      IF VAL (1) EQUAL TO "$" GO TO RESP-DEL-DPT.                  DCUPD45 
00071      MOVE VAL-AREA TO RESP-XRES-DEPT.                             DCUPD45 
00072      GO TO CAT-MVC-MSG-CHG.                                       DCUPD45 
00073  RESP-DEL-DPT.                                                    DCUPD45 
00074      IF RESP-XRES-DEPT EQUAL TO SPACES                            DCUPD45 
00075          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD45 
00076      MOVE SPACES TO RESP-XRES-DEPT.                               DCUPD45 
00077      GO TO CAT-MVC-MSG-DEL.                                       DCUPD45 
00078 *                                                                 DCUPD45 
00079 *     RESPONSIBILITY - PERSON                                     DCUPD45 
00080 *                                                                 DCUPD45 
00081  RESP-EDIT-PER.                                                   DCUPD45 
00082      IF FIELD-ID NOT EQUAL TO 20 GO TO RESP-EDIT-PHONE.           DCUPD45 
00083      MOVE RESP-XRES-PERSON TO OLD-VALUE.                          DCUPD45 
00084      IF VAL (1) EQUAL TO "$" GO TO RESP-DEL-PER.                  DCUPD45 
00085      MOVE VAL-AREA TO RESP-XRES-PERSON.                           DCUPD45 
00086      GO TO CAT-MVC-MSG-CHG.                                       DCUPD45 
00087  RESP-DEL-PER.                                                    DCUPD45 
00088      IF RESP-XRES-PERSON EQUAL TO SPACES                          DCUPD45 
00089          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD45 
00090      MOVE SPACES TO RESP-XRES-PERSON.                             DCUPD45 
00091      GO TO CAT-MVC-MSG-DEL.                                       DCUPD45 
00092 *                                                                 DCUPD45 
00093 *     RESPONSIBILITY - PHONE                                      DCUPD45 
00094 *                                                                    CL**2
00095  RESP-EDIT-PHONE.                                                 DCUPD45 
00096      IF FIELD-ID NOT EQUAL TO 25 GO TO RESP-EDIT-TIT.             DCUPD45 
00097      MOVE RESP-XRES-PHONE TO OLD-VALUE.                           DCUPD45 
00098      IF VAL (1) EQUAL TO "$" GO TO RESP-DEL-PHONE.                DCUPD45 
00099      MOVE VAL-AREA TO RESP-XRES-PHONE.                            DCUPD45 
00100      GO TO CAT-MVC-MSG-CHG.                                       DCUPD45 
00101  RESP-DEL-PHONE.                                                  DCUPD45 
00102      IF RESP-XRES-PHONE EQUAL TO SPACES                           DCUPD45 
00103          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD45 
00104      MOVE SPACES TO RESP-XRES-PHONE.                              DCUPD45 
00105      GO TO CAT-MVC-MSG-DEL.                                       DCUPD45 
00106 *                                                                 DCUPD45 
00107 *     RESPONSIBILITY - TITLE                                      DCUPD45 
00108 *                                                                 DCUPD45 
00109  RESP-EDIT-TIT.                                                   DCUPD45 
00110      IF FIELD-ID NOT EQUAL TO 30 GO TO RESP-EDIT-MAIL.            DCUPD45 
00111      MOVE RESP-XRES-TITLE TO OLD-VALUE.                           DCUPD45 
00112      IF VAL (1) EQUAL TO "$" GO TO RESP-DEL-TIT.                  DCUPD45 
00113      MOVE VAL-AREA TO RESP-XRES-TITLE.                            DCUPD45 
00114      GO TO CAT-MVC-MSG-CHG.                                       DCUPD45 
00115  RESP-DEL-TIT.                                                    DCUPD45 
00116      IF RESP-XRES-TITLE EQUAL TO SPACES                           DCUPD45 
00117          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD45 
00118      MOVE SPACES TO RESP-XRES-TITLE.                              DCUPD45 
00119      GO TO CAT-MVC-MSG-DEL.                                       DCUPD45 
00120 *                                                                 DCUPD45 
00121 *     RESPONSIBILITY - MAIL                                       DCUPD45 
00122 *                                                                 DCUPD45 
00123  RESP-EDIT-MAIL.                                                  DCUPD45 
00124      IF FIELD-ID NOT EQUAL TO 35 GO TO RESP-EDIT-DATE.            DCUPD45 
00125      MOVE RESP-XRES-MAIL TO OLD-VALUE.                            DCUPD45 
00126      IF VAL (1) EQUAL TO "$" GO TO RESP-DEL-MAIL.                 DCUPD45 
00127      MOVE VAL-AREA TO RESP-XRES-MAIL.                             DCUPD45 
00128      GO TO CAT-MVC-MSG-CHG.                                       DCUPD45 
00129  RESP-DEL-MAIL.                                                   DCUPD45 
00130      IF RESP-XRES-MAIL EQUAL TO SPACES                            DCUPD45 
00131          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD45 
00132      MOVE SPACES TO RESP-XRES-MAIL.                               DCUPD45 
00133      GO TO CAT-MVC-MSG-DEL.                                       DCUPD45 
00134 *                                                                 DCUPD45 
00135 *     RESPONSIBILITY - DATE                                       DCUPD45 
00136 *                                                                 DCUPD45 
00137  RESP-EDIT-DATE.                                                  DCUPD45 
00138      IF FIELD-ID NOT EQUAL TO 40 GO TO FLD-ERR.                   DCUPD45 
00139      MOVE RESP-XRES-DATE TO OLD-VALUE.                            DCUPD45 
00140      IF VAL (1) EQUAL TO "$" GO TO RESP-DEL-DATE.                 DCUPD45 
00141      MOVE VAL-AREA TO RESP-XRES-DATE.                             DCUPD45 
00142      GO TO CAT-MVC-MSG-CHG.                                       DCUPD45 
00143  RESP-DEL-DATE.                                                   DCUPD45 
00144      IF RESP-XRES-DATE EQUAL TO SPACES                            DCUPD45 
00145          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD45 
00146      MOVE SPACES TO RESP-XRES-DATE.                               DCUPD45 
00147      GO TO CAT-MVC-MSG-DEL.                                       DCUPD45 
00148 ******************************************************            DCUPD45 
00149 *                                                                 DCUPD45 
00150 *     NAME CATEGORY                                               DCUPD45 
00151 *                                                                 DCUPD45 
00152 ******************************************************            DCUPD45 
00153  NAME-EDIT.                                                       DCUPD45 
00154      IF CAT-ID NOT EQUAL TO 200 GO TO LOC-EDIT.                   DCUPD45 
00155 *                                                                 DCUPD45 
00156 *     NAME - XRES NAME                                            DCUPD45 
00157 *                                                                 DCUPD45 
00158  NAME-EDIT-XN.                                                    DCUPD45 
00159      IF FIELD-ID NOT EQUAL TO 05 GO TO NAME-EDIT-XID.             DCUPD45 
00160      MOVE NAME-XRES-NAME TO OLD-VALUE.                            DCUPD45 
00161      IF VAL (1) EQUAL TO "$" GO TO NAME-DEL-XN.                   DCUPD45 
00162      MOVE VAL-AREA TO NAME-XRES-NAME.                             DCUPD45 
00163      GO TO CAT-MVC-MSG-CHG.                                       DCUPD45 
00164  NAME-DEL-XN.                                                        CL**2
00165      IF NAME-XRES-NAME EQUAL TO SPACES                            DCUPD45:  
00166          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD45 
00167      MOVE SPACES TO NAME-XRES-NAME.                               DCUPD45 
00168      GO TO CAT-MVC-MSG-DEL.                                       DCUPD45 
00169 *                                                                 DCUPD45 
00170 *     NAME - XRES ID                                              DCUPD45 
00171 *                                                                 DCUPD45 
00172  NAME-EDIT-XID.                                                   DCUPD45 
00173      IF FIELD-ID NOT EQUAL TO 10 GO TO FLD-ERR.                   DCUPD45 
00174      MOVE NAME-XRES-ID TO OLD-VALUE.                              DCUPD45 
00175      IF VAL (1) EQUAL TO "$" GO TO NAME-DEL-XID.                  DCUPD45 
00176      MOVE VAL-AREA TO NAME-XRES-ID.                               DCUPD45 
00177      GO TO CAT-MVC-MSG-CHG.                                       DCUPD45 
00178  NAME-DEL-XID.                                                       CL**2
00179      IF NAME-XRES-ID EQUAL TO SPACES                              DCUPD45 
00180          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD45 
00181      MOVE SPACES TO NAME-XRES-ID.                                 DCUPD45 
00182      GO TO CAT-MVC-MSG-DEL.                                       DCUPD45 
00183 *****************************************************             DCUPD45 
00184 *                                                                 DCUPD45 
00185 *     LOCATION CATEGORY                                           DCUPD45 
00186 *                                                                 DCUPD45 
00187 *****************************************************             DCUPD45 
00188  LOC-EDIT.                                                        DCUPD45 
00189      IF CAT-ID NOT EQUAL 250 GO TO REL-EDIT.                         CL**2
00190 *                                                                 DCUPD45 
00191 *     LOCATION - TYPE                                             DCUPD45 
00192 *                                                                 DCUPD45 
00193  LOC-EDIT-TYPE.                                                   DCUPD45 
00194      IF FIELD-ID NOT EQUAL TO 05 GO TO LOC-EDIT-NAME.             DCUPD45 
00195      MOVE LOC-TYPE TO OLD-VALUE.                                  DCUPD45 
00196      IF VAL (1) EQUAL TO "$" GO TO LOC-DEL-TYPE.                  DCUPD45 
00197      MOVE TYPE-CODES TO VALID-CODE-TABLE.                         DCUPD45 
00198      PERFORM VALID-CODE THRU VALID-CODE-XIT.                         CL**2
00199      MOVE VAL (1) TO LOC-TYPE.                                    DCUPD45 
00200      GO TO CAT-MVC-MSG-CHG.                                       DCUPD45 
00201  LOC-DEL-TYPE.                                                    DCUPD45 
00202      IF LOC-TYPE EQUAL TO SPACES                                  DCUPD45 
00203          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD45 
00204      MOVE SPACE TO LOC-TYPE.                                      DCUPD45 
00205      GO TO CAT-MVC-MSG-DEL.                                       DCUPD45 
00206 *                                                                 DCUPD45 
00207 *     LOCATION - NAME                                             DCUPD45 
00208 *                                                                 DCUPD45 
00209  LOC-EDIT-NAME.                                                   DCUPD45 
00210      IF FIELD-ID NOT EQUAL TO 10 GO TO FLD-ERR.                   DCUPD45 
00211      MOVE LOC-NAME TO OLD-VALUE.                                  DCUPD45 
00212      IF VAL (1) EQUAL TO "$" GO TO LOC-DEL-NAME.                  DCUPD45 
00213      MOVE VAL-AREA TO LOC-NAME.                                   DCUPD45 
00214      GO TO CAT-MVC-MSG-CHG.                                       DCUPD45 
00215  LOC-DEL-NAME.                                                    DCUPD45 
00216      IF LOC-NAME EQUAL TO SPACES                                  DCUPD45 
00217          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD45 
00218      MOVE SPACE TO LOC-NAME.                                      DCUPD45 
00219      GO TO CAT-MVC-MSG-DEL.                                       DCUPD45 
00220 *                                                                 DCUPD45 
00221 *****************************************************             DCUPD45 
00222 *                                                                 DCUPD45 
00223 *     RELATIONAL CATEGORY                                         DCUPD45 
00224 *                                                                 DCUPD45 
00225 *****************************************************             DCUPD45 
00226  REL-EDIT.                                                        DCUPD45 
00227      IF CAT-ID NOT EQUAL TO 800 GO TO CAT-ERR.                    DCUPD45 
00228 *                                                                 DCUPD45 
00229 *     RELATIONAL - CAT NAME                                       DCUPD45 
00230 *                                                                 DCUPD45 
00231  REL-EDIT-CN.                                                     DCUPD45 
00232      IF FIELD-ID NOT EQUAL TO 05 GO TO REL-EDIT-PUSE.             DCUPD45 
00233      MOVE REL-XRES-CNAME TO OLD-VALUE.                            DCUPD45 
00234      MOVE REL-XRES-CNAME TO OLD-CATAL-NAME.                          CL**2
00235      IF VAL (1) EQUAL TO "$" GO TO REL-DEL-CN.                    DCUPD45 
00236      PERFORM CK-CATNAME THRU CK-CATNAME-XIT.                      DCUPD45 
00237      MOVE "R" TO TYPE-CATAL-NAME.                                    CL**2
00238      MOVE VAL-AREA TO NEW-CATAL-NAME.                                CL**2
00239      MOVE VAL-AREA TO REL-XRES-CNAME.                             DCUPD45 
00240      GO TO CAT-MVC-MSG-CHG.                                       DCUPD45 
00241  REL-DEL-CN.                                                      DCUPD45 
00242      IF REL-XRES-CNAME EQUAL TO SPACES                            DCUPD45 
00243          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD45 
00244      MOVE "R" TO TYPE-CATAL-NAME.                                    CL**2
00245      MOVE SPACES TO REL-XRES-CNAME.                               DCUPD45 
00246      MOVE SPACES TO NEW-CATAL-NAME.                                  CL**2
00247      GO TO CAT-MVC-MSG-DEL.                                       DCUPD45 
00248 *                                                                 DCUPD45 
00249 *     RELATIONAL - PARTIAL USE                                    DCUPD45 
00250 *                                                                 DCUPD45 
00251  REL-EDIT-PUSE.                                                   DCUPD45 
00252      IF FIELD-ID NOT EQUAL TO 108 GO TO FLD-ERR.                  DCUPD45 
00253      MOVE REL-XRES-PUSE TO OLD-VALUE.                             DCUPD45 
00254      IF VAL (1) EQUAL TO "$" GO TO REL-DEL-PUSE.                  DCUPD45 
00255      MOVE PUSE-CODES TO VALID-CODE-TABLE.                            CL**2
00256      PERFORM VALID-CODE THRU VALID-CODE-XIT.                         CL**2
00257      GO TO CAT-MVC-MSG-CHG.                                       DCUPD45 
00258  REL-DEL-PUSE.                                                    DCUPD45 
00259      IF REL-XRES-PUSE EQUAL TO SPACES                             DCUPD45 
00260          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD45 
00261      MOVE SPACES TO REL-XRES-PUSE.                                DCUPD45 
00262      GO TO CAT-MVC-MSG-DEL.                                       DCUPD45 
