*DECK     DCUPD65 
00001  IDENTIFICATION DIVISION.                                         04/10/78
       PROGRAM-ID. UPD65. 
00003 ******DCUPD65***************************************                 LV001
00004 ******************************************************            DCUPD65 
00005 *                                                                 DCUPD65 
00006 *     M A N A G E M E N T   U N I T   E N T R Y                   DCUPD65 
00007 *                                                                 DCUPD65 
00008 ******************************************************            DCUPD65 
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION. 
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
       DATA DIVISION. 
*CALL UPDCS 
*CALL DCDWA65 
*CALL QUALINE 
  
  
*CALL     DCUPDSWS                                                         CL**5
00010  01  UPD-CODES            PICTURE X(13) VALUE                        CL**2
00011      "YN0123456789/".                                                CL**2
00016  PROCEDURE DIVISION.                                                 CL**2
*CALL     DCUPDKW                                                          CL**5
00019 ******************************************************            DCUPD65 
00020 *                                                                 DCUPD65 
00021 *     M A N A G E M E N T   U N I T   E N T R Y                   DCUPD65 
00022 *                                                                 DCUPD65 
00023 ******************************************************            DCUPD65 
00024 *                                                                 DCUPD65 
00025 *                                                                 DCUPD65 
00026 ******************************************************            DCUPD65 
00027 *                                                                 DCUPD65 
00028 *     PERSONELL CATEGORY                                          DCUPD65 
00029 *                                                                 DCUPD65 
00030 ******************************************************            DCUPD65 
00031  PER-EDIT.                                                        DCUPD65 
00032      IF CAT-ID NOT EQUAL TO 700 GO TO REL-EDIT.                      CL**2
00033 *                                                                 DCUPD65 
00034 *     PERSONEL - UNIT                                             DCUPD65 
00035 *                                                                 DCUPD65 
00036  PER-EDIT-UNIT.                                                   DCUPD65 
00037      IF FIELD-ID NOT EQUAL TO 05 GO TO PER-EDIT-FUNC.             DCUPD65 
00038      MOVE PERSON-UNIT TO OLD-VALUE.                               DCUPD65 
00039      IF VAL (1) EQUAL TO "$" GO TO PER-DEL-UNIT.                  DCUPD65 
00040      MOVE VAL-AREA TO PERSON-UNIT.                                DCUPD65 
00041      GO TO CAT-MVC-MSG-CHG.                                       DCUPD65 
00042  PER-DEL-UNIT.                                                    DCUPD65 
00043      IF PERSON-UNIT EQUAL TO SPACES                               DCUPD65 
00044          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD65 
00045      MOVE SPACES TO PERSON-UNIT.                                  DCUPD65 
00046      GO TO CAT-MVC-MSG-DEL.                                       DCUPD65 
00047                                                                   DCUPD65 
00048 *                                                                 DCUPD65 
00049 *     PERSONEL - FUNCTION                                         DCUPD65 
00050 *                                                                 DCUPD65 
00051  PER-EDIT-FUNC.                                                   DCUPD65 
00052      IF FIELD-ID NOT EQUAL TO 10 GO TO PER-EDIT-PER.              DCUPD65 
00053      MOVE PERSON-FUNC TO OLD-VALUE.                               DCUPD65 
00054      IF VAL (1) EQUAL TO "$" GO TO PER-DEL-FUNC.                  DCUPD65 
00055      MOVE FUNC-CODES TO VALID-CODE-TABLE.                            CL**2
00056      PERFORM VALID-CODE THRU VALID-CODE-XIT.                         CL**2
00057      MOVE VAL-AREA TO PERSON-FUNC.                                DCUPD65 
00058      GO TO CAT-MVC-MSG-CHG.                                       DCUPD65 
00059  PER-DEL-FUNC.                                                    DCUPD65 
00060      IF PERSON-FUNC EQUAL TO SPACES                               DCUPD65 
00061          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD65 
00062      MOVE SPACES TO PERSON-FUNC.                                  DCUPD65 
00063      GO TO CAT-MVC-MSG-DEL.                                       DCUPD65 
00064                                                                   DCUPD65 
00065 *                                                                 DCUPD65 
00066 *     PERSONEL - PERSON                                           DCUPD65 
00067 *                                                                 DCUPD65 
00068  PER-EDIT-PER.                                                    DCUPD65 
00069      IF FIELD-ID NOT EQUAL TO 15 GO TO PER-EDIT-TIT.              DCUPD65 
00070      MOVE PERSON-PERSON TO OLD-VALUE.                             DCUPD65 
00071      IF VAL (1) EQUAL TO "$" GO TO PER-DEL-PER.                   DCUPD65 
00072      MOVE VAL-AREA TO PERSON-PERSON.                              DCUPD65 
00073      GO TO CAT-MVC-MSG-CHG.                                       DCUPD65 
00074  PER-DEL-PER.                                                     DCUPD65 
00075      IF PERSON-PERSON EQUAL TO SPACES                             DCUPD65 
00076          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD65 
00077      MOVE SPACES TO PERSON-PERSON.                                DCUPD65 
00078      GO TO CAT-MVC-MSG-DEL.                                       DCUPD65 
00079                                                                   DCUPD65 
00080 *                                                                 DCUPD65 
00081 *     PERSONEL - TITLE                                            DCUPD65 
00082 *                                                                 DCUPD65 
00083  PER-EDIT-TIT.                                                    DCUPD65 
00084      IF FIELD-ID NOT EQUAL TO 20 GO TO PER-EDIT-PHONE.            DCUPD65 
00085      MOVE PERSON-TITLE TO OLD-VALUE.                              DCUPD65 
00086      IF VAL (1) EQUAL TO "$" GO TO PER-DEL-TIT.                   DCUPD65 
00087      MOVE VAL-AREA TO PERSON-TITLE.                               DCUPD65 
00088      GO TO CAT-MVC-MSG-CHG.                                       DCUPD65 
00089  PER-DEL-TIT.                                                     DCUPD65 
00090      IF PERSON-TITLE EQUAL TO SPACES                              DCUPD65 
00091          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD65 
00092      MOVE SPACES TO PERSON-TITLE.                                 DCUPD65 
00093      GO TO CAT-MVC-MSG-DEL.                                       DCUPD65 
00094                                                                   DCUPD65 
00095 *                                                                 DCUPD65 
00096 *     PERSONEL - PHONE                                            DCUPD65 
00097 *                                                                 DCUPD65 
00098  PER-EDIT-PHONE.                                                  DCUPD65 
00099      IF FIELD-ID NOT EQUAL TO 25 GO TO PER-EDIT-MAIL.             DCUPD65 
00100      MOVE PERSON-PHONE TO OLD-VALUE.                              DCUPD65 
00101      IF VAL (1) EQUAL TO "$" GO TO PER-DEL-PHONE.                 DCUPD65 
00102      MOVE VAL-AREA TO PERSON-PHONE.                               DCUPD65 
00103      GO TO CAT-MVC-MSG-CHG.                                       DCUPD65 
00104  PER-DEL-PHONE.                                                   DCUPD65 
00105      IF PERSON-PHONE EQUAL TO SPACES                              DCUPD65 
00106          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD65 
00107      MOVE SPACES TO PERSON-PHONE.                                 DCUPD65 
00108      GO TO CAT-MVC-MSG-DEL.                                       DCUPD65 
00109                                                                   DCUPD65 
00110 *                                                                    CL**2
00111 *     PERSONEL - MAIL                                                CL**2
00112 *                                                                    CL**2
00113   PER-EDIT-MAIL.                                                  DCUPD65 
           IF FIELD-ID NOT = 30 GO TO FLD-ERR.
00115      MOVE PERSON-MAIL TO OLD-VALUE.                               DCUPD65 
00116      IF VAL (1) EQUAL TO "$" GO TO PER-DEL-MAIL.                  DCUPD65 
00117      MOVE VAL-AREA TO PERSON-MAIL.                                DCUPD65 
00118      GO TO CAT-MVC-MSG-CHG.                                       DCUPD65 
00119  PER-DEL-MAIL.                                                    DCUPD65 
00120      IF PERSON-MAIL EQUAL TO SPACES                               DCUPD65 
00121          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD65 
00122      MOVE SPACES TO PERSON-MAIL.                                  DCUPD65 
00123      GO TO CAT-MVC-MSG-DEL.                                       DCUPD65 
00124 *****************************************************             DCUPD65 
00125 *                                                                 DCUPD65 
00126 *     RELATIONAL CATEGORY                                         DCUPD65 
00127 *                                                                 DCUPD65 
00128 *****************************************************             DCUPD65 
00129  REL-EDIT.                                                        DCUPD65 
00130      IF CAT-ID NOT EQUAL TO 800 GO TO CAT-ERR.                       CL**2
00131 *                                                                 DCUPD65 
00132 *     RELATIONAL - CAT NAME                                       DCUPD65 
00133 *                                                                 DCUPD65 
00134  REL-EDIT-CN.                                                     DCUPD65 
00135      IF FIELD-ID NOT EQUAL TO 05 GO TO REL-EDIT-PUSE.             DCUPD65 
00136      MOVE REL-UNIT-CNAME TO OLD-CATAL-NAME.                          CL**2
00137      MOVE REL-UNIT-CNAME TO OLD-VALUE.                            DCUPD65 
00138      IF VAL (1) EQUAL TO "$" GO TO REL-DEL-CN.                    DCUPD65 
00139      PERFORM CK-CATNAME THRU CK-CATNAME-XIT.                         CL**2
00140      MOVE "R" TO TYPE-CATAL-NAME.                                    CL**2
00141      MOVE VAL-AREA TO NEW-CATAL-NAME.                                CL**2
00142      MOVE VAL-AREA TO REL-UNIT-CNAME.                             DCUPD65 
00143      GO TO CAT-MVC-MSG-CHG.                                       DCUPD65 
00144  REL-DEL-CN.                                                         CL**2
00145      IF REL-UNIT-CNAME EQUAL TO SPACES                            DCUPD65 
00146          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD65 
00147      MOVE "R" TO TYPE-CATAL-NAME.                                    CL**2
00148      MOVE SPACES TO REL-UNIT-CNAME.                               DCUPD65 
00149      MOVE SPACES TO NEW-CATAL-NAME.                                  CL**2
00150      GO TO CAT-MVC-MSG-DEL.                                       DCUPD65 
00151                                                                   DCUPD65 
00152 *                                                                 DCUPD65 
00153 *      RELATIONAL - PARTIAL USE                                   DCUPD65 
00154 *                                                                 DCUPD65 
00155  REL-EDIT-PUSE.                                                   DCUPD65 
00156      IF FIELD-ID NOT EQUAL TO 10 GO TO REL-EDIT-PER.              DCUPD65 
00157      MOVE REL-UNIT-PUSE TO OLD-VALUE.                             DCUPD65 
00158      IF VAL (1) EQUAL TO "$" GO TO REL-DEL-PUSE.                  DCUPD65 
00159      MOVE PUSE-CODES TO VALID-CODE-TABLE.                            CL**2
00160      PERFORM VALID-CODE THRU VALID-CODE-XIT.                         CL**2
00161      MOVE VAL-AREA TO REL-UNIT-PUSE.                              DCUPD65 
00162      GO TO CAT-MVC-MSG-CHG.                                       DCUPD65 
00163  REL-DEL-PUSE.                                                    DCUPD65:  
00164      IF REL-UNIT-PUSE EQUAL TO SPACES                             DCUPD65 
00165          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD65 
00166      MOVE SPACES TO REL-UNIT-PUSE.                                DCUPD65 
00167      GO TO CAT-MVC-MSG-DEL.                                       DCUPD65 
00168                                                                   DCUPD65 
00169 *                                                                 DCUPD65 
00170 *     RELATIONAL - PERSON                                         DCUPD65 
00171 *                                                                 DCUPD65 
00172  REL-EDIT-PER.                                                    DCUPD65 
00173      IF FIELD-ID NOT EQUAL TO 15 GO TO REL-EDIT-UPD.                 CL**2
00174      MOVE REL-UNIT-PERSON TO OLD-VALUE.                           DCUPD65 
00175      IF VAL (1) EQUAL TO "$" GO TO REL-DEL-PER.                   DCUPD65 
00176      MOVE VAL-AREA TO REL-UNIT-PERSON.                            DCUPD65 
00177      GO TO CAT-MVC-MSG-CHG.                                       DCUPD65 
00178  REL-DEL-PER.                                                     DCUPD65 
00179      IF REL-UNIT-PERSON EQUAL TO SPACES                           DCUPD65 
00180          GO TO CAT-MVC-MSG-ERR-DEL.                               DCUPD65 
00181      MOVE SPACES TO REL-UNIT-PERSON.                              DCUPD65 
00182      GO TO CAT-MVC-MSG-DEL.                                       DCUPD65 
00183 *                                                                    CL**2
00184 *     RELATIONAL - UPDATE                                            CL**2
00185 *                                                                    CL**2
00186  REL-EDIT-UPD.                                                       CL**2
00187      IF FIELD-ID NOT EQUAL TO 20 GO TO FLD-ERR.                      CL**2
00188      MOVE REL-UNIT-UPDATE TO OLD-VALUE.                              CL**2
00189      IF VAL (1) EQUAL TO "$" GO TO REL-DEL-UPD.                      CL**2
00190      MOVE UPD-CODES TO VALID-CODE-TABLE.                             CL**2
00191      PERFORM VALID-CODE THRU VALID-CODE-XIT.                         CL**2
00192      MOVE VAL (1) TO REL-UNIT-UPDATE.                                CL**2
00193      GO TO CAT-MVC-MSG-CHG.                                          CL**2
00194  REL-DEL-UPD.                                                        CL**2
00195      IF REL-UNIT-UPDATE EQUAL TO SPACE                               CL**2
00196          GO TO CAT-MVC-MSG-ERR-DEL.                                  CL**2
00197      MOVE SPACE TO REL-UNIT-UPDATE.                                  CL**2
00198      GO TO CAT-MVC-MSG-DEL.                                          CL**2
