*DECK     DCUTL200
00001  IDENTIFICATION DIVISION.                                         10/05/78
       PROGRAM-ID.    UTL200. 
00003  ENVIRONMENT DIVISION.                                               LV002
00004  CONFIGURATION SECTION.                                              CL**2
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
00007  INPUT-OUTPUT SECTION.                                               CL**2
00008  FILE-CONTROL.                                                       CL**2
           SELECT MAST3 ASSIGN TO "MAST3" 
               ORGANIZATION IS RELATIVE 
           ACCESS MODE IS RANDOM
               RELATIVE KEY IS CONTROL-NOM-KEY
           USE "PRUF=YES".
           SELECT SYSPRINT ASSIGN TO "OUTPUT".
00013                                                                    DCUTL20
00014  DATA DIVISION.                                                      CL**2
00015  FILE SECTION.                                                       CL**2
*CALL     MAST3FD                                                          CL**3
*CALL     SYSPRTFD                                                         CL**3
       COMMON-STORAGE SECTION.
  
       77 RETURN-CODE   PICTURE 99. 
       01 WKPRINT-UTL.
*CALL WKPRINT 
             10 ERROR-LINE REDEFINES STD-REPORT-REC.
               15 FILLER   PICTURE X(20). 
               15 ERROR-POS1   PICTURE X(6).
               15 ERROR-POS2   PICTURE X(60). 
               15 FILLER       PICTURE X(46). 
       01  UC-BACKUP-R                 PICTURE X(533).
       01  UC-RENAME1                  PICTURE X(72). 
       01  UC-RENAME2                  PICTURE X(11). 
       01  UC-STDS                     PICTURE X. 
       01 UTL-TABLE-OPT.
              10 LINK-OPT-REC.
                   15 LINK-TYPE-LINES  PICTURE XXX. 
               15 LINES-LINK   PICTURE X(77). 
              10 LINK-REC1 REDEFINES LINK-OPT-REC.
                   15 LINK-TYPE-MSG    PICTURE XXX. 
                   15   MSG-LINK         PICTURE X(77). 
              10 LINK-REC2 REDEFINES LINK-OPT-REC.
                   15 LINK-TYPE-NAME   PICTURE XXX. 
               15 NAME-LINK    PICTURE X(77). 
              10 LINK-REC3 REDEFINES LINK-OPT-REC.
                   15 LINK-TYPE-ADDRESS  PICTURE XXX. 
               15 ADDRESS-LINK PICTURE X(77). 
              10 NAME-TYPE               PICTURE XXX. 
              10 ADDRESS-TYPE            PICTURE XXX. 
              10 LINES-TYPE              PICTURE XXX. 
              10 ENDMSG-TYPE             PICTURE XXX. 
*CALL     WRKSTG77                                                         CL**3
00019  77  OPT-SUB-LIMIT            PICTURE S99 COMP SYNC.                 CL**2
00020  77  TX-SUB                   PICTURE S99 COMP SYNC.                 CL**2
00021  77  MAX-POS                          PICTURE S99 COMP VALUE +66.    CL**2
00022  77  OPT-SUB                  PICTURE S99 COMP.                      CL**2
00023                                                                    DCUTL20
00024 ******************************************************************   CL**2
00025 *                                                                *   CL**2
00026 *  PROGRAM WORK AREAS                                            *   CL**2
00027 *                                                                *   CL**2
00028 ******************************************************************   CL**2
       01 CONTROL-NOM-KEY   PICTURE 999   VALUE ZEROS.
00030  01  WORK-AREA.                                                      CL**2
00031      05  TYPE-CON.                                                   CL**2
00032          10  PROG-ID           PICTURE X(6) VALUE "DCUTL-".          CL**2
00033      05  FUNCTION-OPERAND.                                           CL**2
00034          10  TX-POS           PICTURE X OCCURS 67 TIMES.             CL**2
00035      05  FUNCTION-OPT.                                               CL**2
00036          10  OPT-AREA         PICTURE X OCCURS 27 TIMES.             CL**2
00037      05  NUM-WORK-AREA.                                              CL**2
00038          10  DIGIT-1              PICTURE X.                         CL**2
00039          10  DIGIT-2              PICTURE X.                         CL**2
00040      05  H-NUM-1 REDEFINES NUM-WORK-AREA.                            CL**2
00041          10  NUM-LEN-1     PICTURE 9.                                CL**2
00042          10  FILLER                  PICTURE X.                      CL**2
00043      05  H-NUM-2 REDEFINES NUM-WORK-AREA.                            CL**2
00044          10  NUM-LEN-2           PICTURE 99.                         CL**2
00045      05  NUM-HOLD                    PICTURE 99.                     CL**2
00046      05  MSG-LINES.                                                  CL**2
00047      10  LINES-MSG.                                                  CL**2
00048           15  FILLER             PICTURE X(29) VALUE                 CL**2
00049              " LINES PER PAGE ALTERED FROM ".                        CL**2
00050          15  OLD-LINES           PICTURE Z9.                         CL**2
00051          15  FILLER              PICTURE X(4)                        CL**2
00052              VALUE " TO".                                            CL**2
00053          15  NEW-LINES           PICTURE Z9.                         CL**2
00054      10  MSG-1                   PICTURE X(28) VALUE                 CL**2
00055          " END OF PAGE MESSAGE ALTERED".                             CL**2
00056      10  MSG-2.                                                      CL**2
00057          15  FILLER              PICTURE X(9) VALUE                  CL**2
00058              "   FROM- ".                                            CL**2
00059          15  OLD-MSG             PICTURE X(54).                      CL**2
00060      10  MSG-3.                                                      CL**2
00061          15  FILLER              PICTURE X(9) VALUE                  CL**2
00062             "   TO-".                                                CL**2
00063          15  NEW-MSG             PICTURE X(54).                      CL**2
00064      10  NAME-MSG.                                                   CL**2
00065          15  FILLER              PICTURE X(19) VALUE                 CL**2
00066              " NAME ALTERED FROM ".                                  CL**2
00067          15  OLD-NAME            PICTURE X(27).                      CL**2
00068          15  FILLER              PICTURE X(4)                        CL**2
00069              VALUE " TO".                                            CL**2
00070          15  NEW-NAME            PICTURE X(27).                      CL**2
00071      10  ADDRESS-MSG.                                                CL**2
00072          15  FILLER              PICTURE X(22) VALUE                 CL**2
00073              " ADDRESS ALTERED FROM".                                CL**2
00074          15  OLD-ADDRESS         PICTURE X(27).                      CL**2
00075          15  FILLER              PICTURE X(4)                        CL**2
00076              VALUE " TO".                                            CL**2
00077          15  NEW-ADDRESS         PICTURE X(27).                      CL**2
00078          10  BAD-KEY                 PICTURE X(50) VALUE             CL**2
00079              "950-F *ERROR MAST3-READ CLIENT RECORD".                CL**2
00080      10  LINE-ERR-MSG        PICTURE X(50) VALUE                     CL**2
00081             "460-S *ERROR LINES PARAMETER MUST BE NUMERIC".          CL**2
00082                                                                    DCUTL20
00114                                                                    DCUTL20
00115 ***************************************************************** DCUTL200
00116 *                                                                 DCUTL200
00117 *      THIS MODULE WILL ALTER THE FOLLOWINF SYSTEM PARAMETERS     DCUTL200
00118 *           LINES                                                 DCUTL200
00119 *           END MESSAGE                                           DCUTL200
00120 *           NAME                                                  DCUTL200
00121 *           ADDRESS                                               DCUTL200
00122 *                                                                 DCUTL200
00123 ***************************************************************** DCUTL200
00124  PROCEDURE DIVISION.                                              DCUTL200
       OLD-ENTRY. 
00128      OPEN I-O MAST3.                                              DCUTL200
00129      OPEN OUTPUT SYSPRINT.                                        DCUTL200
00130      MOVE SPACE TO PRINT-LINE.                                    DCUTL200
00131      MOVE SPACE TO STD-REPORT-REC.                                   CL**2
00132      MOVE 1 TO PRT-CTL.                                           DCUTL200
00133      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
           MOVE 1 TO CONTROL-NOM-KEY. 
00135      READ MAST3                                                   DCUTL200
00136          INVALID KEY GO TO OPT-ABORT.                                CL**2
00137      IF LINK-TYPE-LINES NOT EQUAL LINES-TYPE                         CL**2
00138         GO TO MSG-100.                                            DCUTL200
00139 ******************************************************************DCUTL200
00140 *       PROCESS LINES PARAMETER                                   DCUTL200
00141 ***************************************************************** DCUTL200
00142      MOVE LINES-LINK TO FUNCTION-OPERAND.                         DCUTL200
00143      MOVE ZERO TO TX-SUB.                                         DCUTL200
00144      PERFORM FIND-BLANK THRU FIND-BLANK-XIT.                      DCUTL200
00145      MOVE 3 TO OPT-SUB-LIMIT.                                     DCUTL200
00146      PERFORM FIND-OPT THRU FIND-OPT-XIT.                          DCUTL200
00147      PERFORM MOVE-NUM THRU MOVE-NUM-XIT.                          DCUTL200
00148      IF RETURN-CODE NOT EQUAL ZERO                                DCUTL200
00149          GO TO LINE-ERROR.                                        DCUTL200
00150      MOVE CTL-LINES TO OLD-LINES.                                 DCUTL200
00151      MOVE NUM-HOLD TO CTL-LINES NEW-LINES.                        DCUTL200
00152      MOVE LINES-MSG TO STD-REPORT-REC.                            DCUTL200
00153      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCUTL200
00154      GO TO EOJ.                                                   DCUTL200
00155                                                                    DCUTL20
00156 ******************************************************************DCUTL200
00157 *       PROCESS MESSAGE PAARMETER                                 DCUTL200
00158 ******************************************************************DCUTL200
00159  MSG-100.                                                         DCUTL200
00160      IF LINK-TYPE-MSG NOT EQUAL ENDMSG-TYPE                          CL**2
00161         GO TO NAME-100.                                           DCUTL200
00162      MOVE CTL-EOP-MSG TO OLD-MSG.                                 DCUTL200
00163      MOVE MSG-LINK TO FUNCTION-OPERAND.                              CL**2
00164      MOVE ZERO TO TX-SUB.                                            CL**2
00165      PERFORM FIND-BLANK THRU FIND-BLANK-XIT.                         CL**2
00166      MOVE 28 TO OPT-SUB-LIMIT.                                       CL**2
00167      PERFORM FIND-OPT THRU FIND-OPT-XIT.                             CL**2
00168      IF FUNCTION-OPT EQUAL "NONE   "                                 CL**2
00169           MOVE SPACE TO CTL-EOP-MSG                                  CL**2
           ELSE MOVE FUNCTION-OPT TO CTL-EOP-MSG. 
00171      MOVE CTL-EOP-MSG TO NEW-MSG.                                    CL**2
00172      MOVE MSG-1 TO STD-REPORT-REC.                                DCUTL200
00173      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCUTL200
00174      MOVE MSG-2 TO STD-REPORT-REC.                                DCUTL200
00175      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCUTL200
00176      MOVE MSG-3 TO STD-REPORT-REC.                                DCUTL200
00177      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCUTL200
00178      GO TO EOJ.                                                   DCUTL200
00179                                                                    DCUTL20
00180 ***************************************************************** DCUTL200
00181 *           PROCESS NAME PARAMETER                                DCUTL200
00182 ***************************************************************** DCUTL200
00183  NAME-100.                                                        DCUTL200
00184      IF LINK-TYPE-NAME NOT EQUAL NAME-TYPE                           CL**2
00185          GO TO ADDRESS-100.                                          CL**2
00186      MOVE NAME-LINK TO FUNCTION-OPERAND.                          DCUTL200
00187      MOVE ZERO TO TX-SUB.                                         DCUTL200
00188      PERFORM FIND-BLANK THRU FIND-BLANK-XIT.                      DCUTL200
00189      MOVE 28 TO OPT-SUB-LIMIT.                                    DCUTL200
00190      PERFORM FIND-OPT THRU FIND-OPT-XIT.                          DCUTL200
00191      MOVE CTL-NAME TO OLD-NAME.                                   DCUTL200
00192      MOVE FUNCTION-OPT TO CTL-NAME NEW-NAME.                      DCUTL200
00193      MOVE NAME-MSG TO STD-REPORT-REC.                             DCUTL200
00194      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCUTL200
00195      GO TO EOJ.                                                   DCUTL200
00196                                                                    DCUTL20
00197 ***************************************************************** DCUTL200
00198 *           PROCESS ADDRESS PARAMETER                             DCUTL200
00199 ***************************************************************** DCUTL200
00200  ADDRESS-100.                                                     DCUTL200
00201      IF LINK-TYPE-ADDRESS NOT EQUAL ADDRESS-TYPE                     CL**2
00202          GO TO EOJ-100.                                              CL**2
00203      MOVE ADDRESS-LINK TO FUNCTION-OPERAND.                       DCUTL200
00204      MOVE ZERO TO TX-SUB.                                         DCUTL200
00205      PERFORM FIND-BLANK THRU FIND-BLANK-XIT.                      DCUTL200
00206      MOVE 28 TO OPT-SUB-LIMIT.                                    DCUTL200
00207      PERFORM FIND-OPT THRU FIND-OPT-XIT.                          DCUTL200
00208      MOVE CTL-ADDRESS TO OLD-ADDRESS.                             DCUTL200
00209      MOVE FUNCTION-OPT TO CTL-ADDRESS NEW-ADDRESS.                DCUTL200
00210      MOVE ADDRESS-MSG TO STD-REPORT-REC.                          DCUTL200
00211      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCUTL200
00212      GO TO EOJ.                                                   DCUTL200
00213                                                                    DCUTL20
00214 ***********************************************************          CL**2
00215 *                                                                    CL**2
00216 *          END OF JOB                                                CL**2
00217 *                                                                    CL**2
00218 *****************************************************************    CL**2
00219  EOJ.                                                             DCUTL200
00220      REWRITE CTL-RECORD-1                                         DCUTL200
00221         INVALID KEY MOVE BAD-KEY TO ERROR-POS2                    DCUTL200
00222         GO TO OPT-ABORT.                                          DCUTL200
00223  EOJ-100.                                                         DCUTL200
00224      MOVE SPACE TO PRINT-LINE.                                       CL**2
00225      MOVE SPACE TO STD-REPORT-REC.                                   CL**2
00226      CLOSE MAST3.                                                 DCUTL200
00227      CLOSE SYSPRINT.                                              DCUTL200
           EXIT PROGRAM.
00229                                                                    DCUTL20
00230 ******************************************************************   CL**2
00231 *                                                                    CL**2
00232 *       SCAN SUBROUTINES                                             CL**2
00233 *                                                                    CL**2
00234 ******************************************************************   CL**2
00235  FIND-BLANK.                                                         CL**2
00236      ADD 1 TO TX-SUB.                                                CL**2
00237      IF TX-SUB GREATER THAN MAX-POS                                  CL**2
00238           GO TO FIND-BLANK-XIT.                                      CL**2
00239      IF TX-POS (TX-SUB) EQUAL SPACE                                  CL**2
00240          GO TO FIND-BLANK.                                           CL**2
00241  FIND-BLANK-XIT.                                                     CL**2
00242      EXIT.                                                           CL**2
00243  FIND-OPT.                                                           CL**2
00244      MOVE ZERO TO OPT-SUB.                                           CL**2
00245      MOVE SPACE TO FUNCTION-OPT.                                     CL**2
00246  FIND-OPT-100.                                                       CL**2
00247      ADD 1 TO OPT-SUB.                                               CL**2
00248      MOVE TX-POS (TX-SUB) TO OPT-AREA (OPT-SUB).                     CL**2
00249      ADD 1 TO TX-SUB.                                                CL**2
00250      IF TX-SUB GREATER THAN MAX-POS                                  CL**2
00251          GO TO FIND-OPT-XIT.                                         CL**2
00252      IF OPT-SUB LESS THAN OPT-SUB-LIMIT                              CL**2
00253          GO TO FIND-OPT-100.                                         CL**2
00254  FIND-OPT-XIT.                                                       CL**2
00255      EXIT.                                                           CL**2
00256                                                                      CL**2
00257  MOVE-NUM.                                                           CL**2
00258      MOVE ZERO TO NUM-HOLD.                                          CL**2
00259      IF OPT-AREA (1) NOT EQUAL SPACE                                 CL**2
00260          MOVE OPT-AREA (1) TO DIGIT-1                                CL**2
00261          ELSE MOVE 4 TO RETURN-CODE                                  CL**2
00262           GO TO MOVE-NUM-XIT.                                        CL**2
00263      IF OPT-AREA (2) EQUAL SPACE                                     CL**2
00264         MOVE NUM-LEN-1 TO NUM-HOLD                                   CL**2
00265         GO TO MOVE-NUM-XIT.                                          CL**2
00266      MOVE OPT-AREA (2) TO DIGIT-2.                                   CL**2
00267      MOVE NUM-WORK-AREA TO NUM-HOLD.                                 CL**2
00268  MOVE-NUM-XIT.                                                       CL**2
00269      EXIT.                                                           CL**2
00270                                                                    DCUTL20
*CALL     DISPLAYLN                                                        CL**3
*CALL     WRITELN                                                          CL**3
00273  USER-ROUTINE.                                                       CL**2
00274      GO TO USER-ROUTINE-XIT.                                         CL**2
00275  USER-ROUTINE-XIT.                                                   CL**2
00276      EXIT.                                                           CL**2
00277                                                                    DCUTL20
00278 ***************************************************************      CL**2
00279 *                                                                    CL**2
00280 *     ERROR ROUTINES                                                 CL**2
00281 *                                                                    CL**2
00282 ***************************************************************      CL**2
00283 ***************************************************************      CL**2
00284 *                                                                    CL**2
00285 *     CONTROL FILE BAD                                               CL**2
00286 *                                                                    CL**2
00287 ***************************************************************      CL**2
00288  OPT-ABORT.                                                          CL**2
00289      MOVE 12 TO RETURN-CODE.                                         CL**2
00290      MOVE BAD-KEY TO ERROR-POS2.                                     CL**2
00291  OPT-ABORT-100.                                                      CL**2
00292      MOVE PROG-ID TO ERROR-POS1.                                     CL**2
00293      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00294      GO TO EOJ-100.                                                  CL**2
00295 ************************************************************         CL**2
00296 *                                                                    CL**2
00297 *        LINES PARAMETER NOT NUMERIC                                 CL**2
00298                                                                      CL**2
00299 *                                                                    CL**2
00300 *********************************************************            CL**2
00301  LINE-ERROR.                                                         CL**2
00302      MOVE LINE-ERR-MSG TO ERROR-POS2.                                CL**2
00303      GO TO OPT-ABORT-100.                                            CL**2
