00001  IDENTIFICATION DIVISION.                                         01/16/04
00002  PROGRAM-ID.             DTSCS71.                                 DTSCS71
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV015
00004  DATE-WRITTEN.           MAY 1994.                                DTSCS71
00005  DATE-COMPILED.                                                   DTSCS71
00006      SKIP3                                                        DTSCS71
00007 *****                                                             DTSCS71
00008 *                                                                 DTSCS71
00009 *    FUNCTION:  NOTE PAD INQUIRY/UPDATE                           DTSCS71
00010 *               SCREEN PROCESSOR.                                 DTSCS71
00011 *                                                                 DTSCS71
00012 *                                                                 DTSCS71
00013 *    MODIFICATION LOG:                                            DTSCS71
00014 *                                                                 DTSCS71
00015 *    09/23/1998  INITIAL DEVELOPMENT.   COPIED FROM MACCS71.      DTSCS71
00016 *                REFERENCE RFP:                   PROGRAMMER: ZL1 DTSCS71
00017 *                                                                 DTSCS71
00018 *    03/04/2003  MODIFIED TO PREVENT CHANGES TO AND DELETION OF   DTSCS71
00019 *                EXISTING NOTES.  NEW NOTES MAY BE ADDED, BUT     DTSCS71
00020 *                NOTES ALREADY ON FILE REMAIN AS A STATIC ARCHIVE.DTSCS71
00021 *                REFERENCE RFP:                   PROGRAMMER: GD  DTSCS71
00022 *                                                                 DTSCS71
00023 *    01/16/2004  MODIFIED TO PREVENT CHANGES TO AND DELETION OF   DTSCS71
00024 *                NOTES BY PERSON WHO CREATED THEM.                DTSCS71
00025 *                REFERENCE RFP:                   PROGRAMMER: GD  DTSCS71
00026 *                                                                 DTSCS71
00027 *    XX/XX/XXXX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS71
00028 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS71
00029 *                WORK ORDER:                      PROGRAMMER: XXX DTSCS71
00030 *                                                                 DTSCS71
00031 *                                                                 DTSCS71
00032 *  DESCRIPTION:                                                   DTSCS71
00033 *                                                                 DTSCS71
00034 *    CLEAR:                                                       DTSCS71
00035 *                                                                 DTSCS71
00036 *      FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO).            DTSCS71
00037 *                                                                 DTSCS71
00038 *                                                                 DTSCS71
00039 *    JUMP:                                                        DTSCS71
00040 *                                                                 DTSCS71
00041 *      F17  REGISTRATION INQUIRY (11).                            DTSCS71
00042 *      F19  QUARTER INQUIRY (31).                                 DTSCS71
00043 *      F20  COLLECTIONS INQUIRY (41).                             DTSCS71
00044 *                                                                 DTSCS71
00045 *                                                                 DTSCS71
00046 *    INQUIRY:                                                     DTSCS71
00047 *                                                                 DTSCS71
00048 *      CONTROL FIELD(S): MAP-EMP-NO.                              DTSCS71
00049 *                                                                 DTSCS71
00050 *      JUMP IN:  IF LCCM-EMP-NO = LCCM-SCR71-HOLD-AREA EMP-NO     DTSCS71
00051 *                  DISPLAY RECORD INDICATED BY                    DTSCS71
00052 *                  LCCM-SCR71-HOLD-AREA                           DTSCS71
00053 *                ELSE                                             DTSCS71
00054 *                  DISPLAY LAST PAGE OF DATA ASSOCIATED           DTSCS71
00055 *                  WITH LCCM-EMP-NO.                              DTSCS71
00056 *                                                                 DTSCS71
00057 *      ENTER, F05, F06, F07, F08: STANDARD PAGING.                DTSCS71
00058 *                                                                 DTSCS71
00059 *               DISPLAY SEQUENCE: ASCENDING ON                    DTSCS71
00060 *                                 MNTE-KEY-ESTB-ABSTIME.          DTSCS71
00061 *                                                                 DTSCS71
00062 *       PAGE INITIALLY DISPLAYED: LAST.                           DTSCS71
00063 *                                                                 DTSCS71
00064 *                                                                 DTSCS71
00065 *      JUMP OUT:  STANDARD LCCM-EMP-NO MAINTENANCE.               DTSCS71
00066 *                                                                 DTSCS71
00067 *                 STORE INFORMATION REPRESENTING PAGE             DTSCS71
00068 *                 CURRENTLY DISPLAYED IN LCCM-SCR71-HOLD-AREA.    DTSCS71
00069 *                                                                 DTSCS71
00070 *                                                                 DTSCS71
00071 *      STORE PAGING CONTROL INFORMATION IN LCCM-SCR-HOLD-AREA.    DTSCS71
00072 *                                                                 DTSCS71
00073 *                                                                 DTSCS71
00074 *    UPDATE:                                                      DTSCS71
00075 *                                                                 DTSCS71
00076 *      ADD                                                        DTSCS71
00077 *      MOD                                                        DTSCS71
00078 *      DEL                                                        DTSCS71
00079 *                                                                 DTSCS71
00080 *                                                                 DTSCS71
00081 *    RECORDS READ:                                                DTSCS71
00082 *                                                                 DTSCS71
00083 *      MASTER:                                                    DTSCS71
00084 *                                                                 DTSCS71
00085 *        MPRF                                                     DTSCS71
00086 *        MNTE                                                     DTSCS71
00087 *                                                                 DTSCS71
00088 *                                                                 DTSCS71
00089 *      ALTERNATE INDEX:                                           DTSCS71
00090 *                                                                 DTSCS71
00091 *        NONE.                                                    DTSCS71
00092 *                                                                 DTSCS71
00093 *                                                                 DTSCS71
00094 *      REFERENCE:                                                 DTSCS71
00095 *                                                                 DTSCS71
00096 *        NONE.                                                    DTSCS71
00097 *                                                                 DTSCS71
00098 *                                                                 DTSCS71
00099 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS71
00100 *                                                                 DTSCS71
00101 *        NONE.                                                    DTSCS71
00102 *                                                                 DTSCS71
00103 *                                                                 DTSCS71
00104 *    RECORDS UPDATED:                                             DTSCS71
00105 *                                                                 DTSCS71
00106 *      MASTER:                                                    DTSCS71
00107 *                                                                 DTSCS71
00108 *        MNTE (ADD, REWRITE, DELETE)                              DTSCS71
00109 *                                                                 DTSCS71
00110 *                                                                 DTSCS71
00111 *      REFERENCE:                                                 DTSCS71
00112 *                                                                 DTSCS71
00113 *        NONE.                                                    DTSCS71
00114 *                                                                 DTSCS71
00115 *                                                                 DTSCS71
00116 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS71
00117 *                                                                 DTSCS71
00118 *        NONE.                                                    DTSCS71
00119 *                                                                 DTSCS71
00120 *                                                                 DTSCS71
00121 *    ON-LINE ACTIVITY FILE RECORDS WRITTEN:                       DTSCS71
00122 *                                                                 DTSCS71
00123 *      NONE.                                                      DTSCS71
00124 *                                                                 DTSCS71
00125 *                                                                 DTSCS71
00126 *    TEMPORARY STORAGE USAGE:                                     DTSCS71
00127 *                                                                 DTSCS71
00128 *      NONE                                                       DTSCS71
00129 *                                                                 DTSCS71
00130 *                                                                 DTSCS71
00131 *    MODULES LINKED TO:                                           DTSCS71
00132 *                                                                 DTSCS71
00133 *                                                                 DTSCS71
00134 *      DTSCU001  DATE EDIT/CONVERSION.                            DTSCS71
00135 *      DTSCU018  EMPLOYER NUMBER FROM SCREEN FORMAT/EDIT.         DTSCS71
00136 *      DTSCU082  OPERATOR ID EDIT/LOOKUP.                         DTSCS71
00137 *      DTSCU221  MPRF-UPDATE DATA ELEMENT MAINTENANCE.            DTSCS71
00138 *      DTSCU810  MASTER FILE INPUT/OUTPUT.                        DTSCS71
00139 *                                                                 DTSCS71
00140 *                                                                 DTSCS71
00141 *    VERMONT REFERENCE:                                           DTSCS71
00142 *                                                                 DTSCS71
00143 *        TXC630C.                                                 DTSCS71
00144 *                                                                 DTSCS71
00145 *                                                                 DTSCS71
00146 *    NOTES TO JEFF:                                               DTSCS71
00147 *                                                                 DTSCS71
00148 *    .  THE ONLY DEPARTURE FROM VERMONT FUNCTIONALITY IS THE      DTSCS71
00149 *       CONCEPT OF A SINGLE "PRIORITY" NOTE ATTACHED TO A         DTSCS71
00150 *       GIVEN EMPLOYER.  THE PRIORITY NOTE WILL HAVE A VALUE      DTSCS71
00151 *       OF ALL NINES IN MNTE-KEY-ESTB-ABSTIME.                    DTSCS71
00152 *                                                                 DTSCS71
00153 *    .  THE PRIORITY? FIELD ON THE SCREEN SHOULD BE PROTECTED     DTSCS71
00154 *       WHEN THE SCREEN IS IN "INQUIRY" MODE.  THAT IS, THE       DTSCS71
00155 *       DECISION TO MAKE A NOTE A "PRIORITY" NOTE MUST BE MADE    DTSCS71
00156 *       AT "ADD" TIME.  AFTER THE NOTE IS ADDED, THE NOTE MAY     DTSCS71
00157 *       NOT BE CHANGED FROM/TO "PRIORITY".                        DTSCS71
00158 *                                                                 DTSCS71
00159 *    .  AN ATTEMPT TO "ADD" A SECOND PRIORITY NOTE TO A GIVEN     DTSCS71
00160 *       EMPLOYER SHOULD BE REPORTED AS A SCREEN SPECIFIC ERROR.   DTSCS71
00161 *                                                                 DTSCS71
00162 *    .  IF I WERE DOING THIS SCREEN, I WOULD START FROM A SCREEN  DTSCS71
00163 *       LIKE 51, WHICH HAS FULL PAGING AND HAS ADD, MOD, AND DEL. DTSCS71
00164 *                                                                 DTSCS71
00165 *                                                                 DTSCS71
00166 *****                                                             DTSCS71
00167                                                                   DTSCS71
00168  ENVIRONMENT DIVISION.                                            DTSCS71
00169                                                                   DTSCS71
00170  DATA DIVISION.                                                   DTSCS71
00171                                                                   DTSCS71
00172  WORKING-STORAGE SECTION.                                         DTSCS71
001725 77  PAN-VALET PICTURE X(24) VALUE '015DTSCS71   01/16/04'.       DTSCS71
00173                                                                   DTSCS71
00174  01  WRK-AREA.                                                    DTSCS71
00175      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'S71 '.    DTSCS71
00176                                                                   DTSCS71
00177      05  WRK-SCR-ID.                                              DTSCS71
00178          10  WRK-SCR-ID-N            PIC  9(02)  VALUE 71.        DTSCS71
00179                                                                   DTSCS71
00180      05  WRK-F03-SCR-ID              PIC  X(02)  VALUE '70'.      DTSCS71
00181                                                                   DTSCS71
00182      05  WRK-PRIORITY-ABSTIME-LIT    PIC S9(15)  COMP-3           DTSCS71
00183                                        VALUE +999999999999999.    DTSCS71
00184                                                                   DTSCS71
00185      05  SCR-ACCESS-IND              PIC X(01).                   DTSCS71
00186          88  SCR-ACCESS-INQ                  VALUE '1'.           DTSCS71
00187          88  SCR-ACCESS-UPDATE               VALUE '2'.           DTSCS71
00188                                                                   DTSCS71
00189      05  CURSOR-SET-IND              PIC X(01).                   DTSCS71
00190          88  CURSOR-SET-YES                  VALUE 'Y'.           DTSCS71
00191          88  CURSOR-SET-NO                   VALUE 'N'.           DTSCS71
00192          88  CURSOR-SET-GOTO                 VALUE 'G'.           DTSCS71
00193                                                                   DTSCS71
00194      05  REQ-IND                     PIC X(01).                   DTSCS71
00195          88  REQ-ERROR                       VALUE 'O'.           DTSCS71
00196          88  REQ-JUMP                        VALUE 'J'.           DTSCS71
00197          88  REQ-INQUIRE                     VALUE 'I'.           DTSCS71
00198          88  REQ-CLEAR                       VALUE 'C'.           DTSCS71
00199          88  REQ-EDIT                        VALUE 'E'.           DTSCS71
00200          88  REQ-UPDATE                      VALUE 'U'.           DTSCS71
00201          88  REQ-CURSOR-TO-GOTO              VALUE 'G'.           DTSCS71
00202                                                                   DTSCS71
00203      05  RESP-IND                    PIC X(01).                   DTSCS71
00204          88  RESP-SEND-MSGONLY               VALUE 'O'.           DTSCS71
00205          88  RESP-SEND-MAP                   VALUE 'M'.           DTSCS71
00206          88  RESP-JUMP                       VALUE 'J'.           DTSCS71
00207          88  RESP-CURSOR-TO-GOTO             VALUE 'G'.           DTSCS71
00208                                                                   DTSCS71
00209      05  WRK-MSG-AREA                PIC  X(64).                  DTSCS71
00210                                                                   DTSCS71
00211      05  WRK-ATB-AN               PIC  X(01).                     DTSCS71
00212      05  WRK-ATB-NUM                 PIC  X(01).                  DTSCS71
00213                                                                   DTSCS71
00214      05  WRK-EMP-NO                  PIC S9(07)  COMP-3.          DTSCS71
00215                                                                   DTSCS71
00216      05  WRK-SUB                     PIC S9(04)  COMP.            DTSCS71
00217                                                                   DTSCS71
00218      05  WRK-SUB2                    PIC S9(04)  COMP.            DTSCS71
00219                                                                   DTSCS71
00220      05  WRK-COLON                   PIC  X(01)  VALUE ':'.       DTSCS71
00221                                                                   DTSCS71
00222      05  WRK-MPRF-IND                PIC  X(01).                  DTSCS71
00223          88  WRK-MPRF-YES-88                VALUE 'Y'.            DTSCS71
00224          88  WRK-MPRF-NO-88                 VALUE 'N'.            DTSCS71
00225                                                                   DTSCS71
00226      05  WRK-DISPLAY                 PIC 9(11).                   DTSCS71
00227                                                                   DTSCS71
00228      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS71
00229          10  FILLER                  PIC X(05).                   DTSCS71
00230          10  WRK-DISPLAY-EMP-NO-1    PIC X(03).                   DTSCS71
00231          10  WRK-DISPLAY-EMP-NO-2    PIC X(03).                   DTSCS71
00232                                                                   DTSCS71
00233                                                                   DTSCS71
00234      05  INQUIRY-CONTROL-AREA.                                    DTSCS71
00235          10  LAST-REC-NUM            PIC S9(08)  COMP.            DTSCS71
00236          10  WS-REC-NUM              PIC S9(08)  COMP.            DTSCS71
00237                                                                   DTSCS71
00238          10  LAST-REC-KEY-AREA       PIC  X(16).                  DTSCS71
00239          10  SCR-REC-KEY-AREA        PIC  X(16).                  DTSCS71
00240                                                                   DTSCS71
00241          10  WS-REC-FOUND-IND        PIC  X(01).                  DTSCS71
00242      EJECT                                                        DTSCS71
00243                                                                   DTSCS71
00244  01  MSG-LITERALS.                                                DTSCS71
00245                                                                   DTSCS71
00246      05  MSG-E711-AREA.                                           DTSCS71
00247          10  FILLER                  PIC  X(04)  VALUE 'E711'.    DTSCS71
00248          10  FILLER                  PIC  X(30)                   DTSCS71
00249                VALUE 'PRIORITY NOTE ALREADY EXISTS. '.            DTSCS71
00250          10  FILLER                  PIC  X(30)                   DTSCS71
00251                VALUE '                              '.            DTSCS71
00252                                                                   DTSCS71
00253      05  MSG-E712-AREA.                                           DTSCS71
00254          10  FILLER                  PIC  X(04)  VALUE 'E712'.    DTSCS71
00255          10  FILLER                  PIC  X(30)                   DTSCS71
00256                VALUE 'UPDATE NOT ALLOWED - NOTE ENTE'.            DTSCS71
00257          10  FILLER                  PIC  X(30)                   DTSCS71
00258                VALUE 'RED BY DIFFERENT OPERATOR     '.            DTSCS71
00259                                                                   DTSCS71
00260      EJECT                                                        DTSCS71
00261  01  L001-COMM-AREA.                                              DTSCS71
00262  ++INCLUDE DTSIL001                                               DTSCS71
00263      EJECT                                                        DTSCS71
00264  01  L018-COMM-AREA.                                              DTSCS71
00265  ++INCLUDE DTSIL018                                               DTSCS71
00266      EJECT                                                        DTSCS71
00267  01  L082-COMM-AREA.                                              DTSCS71
00268  ++INCLUDE DTSIL082                                               DTSCS71
00269      EJECT                                                        DTSCS71
00270  01  L221-COMM-AREA.                                              DTSCS71
00271  ++INCLUDE DTSIL221                                               DTSCS71
00272      EJECT                                                        DTSCS71
00273  01  L805-COMM-AREA.                                              DTSCS71
00274  ++INCLUDE DTSIL805                                               DTSCS71
00275      EJECT                                                        DTSCS71
00276  01  L810-COMM-AREA.                                              DTSCS71
00277      05  L810-CONTROL-BLOCK.                                      DTSCS71
00278  ++INCLUDE DTSIL810                                               DTSCS71
00279      EJECT                                                        DTSCS71
00280      05  MSKL-REC.                                                DTSCS71
00281  ++INCLUDE DTSIMSKL                                               DTSCS71
00282      EJECT                                                        DTSCS71
00283  01  MPRF-REC.                                                    DTSCS71
00284  ++INCLUDE DTSIMPRF                                               DTSCS71
00285      EJECT                                                        DTSCS71
00286  01  MNTE-REC.                                                    DTSCS71
00287  ++INCLUDE DTSIMNTE                                               DTSCS71
00288      EJECT                                                        DTSCS71
00289  01  L851-COMM-AREA.                                              DTSCS71
00290  ++INCLUDE DTSIL851                                               DTSCS71
00291                                                                   DTSCS71
00292      05  MAP-AREA REDEFINES L851-MAP-AREA.                        DTSCS71
00293  ++INCLUDE DTSIS71                                                DTSCS71
00294      EJECT                                                        DTSCS71
00295  01  CATB-LITERALS.                                               DTSCS71
00296  ++INCLUDE DTSICATB                                               DTSCS71
00297                                                                   DTSCS71
00298  01  CFKD-LITERALS.                                               DTSCS71
00299  ++INCLUDE DTSICFKD                                               DTSCS71
00300                                                                   DTSCS71
00301  01  CECD-LITERALS.                                               DTSCS71
00302  ++INCLUDE DTSICECD                                               DTSCS71
00303                                                                   DTSCS71
00304  01  CPCD-LITERALS.                                               DTSCS71
00305  ++INCLUDE DTSICPCD                                               DTSCS71
00306                                                                   DTSCS71
00307  01  MMAX-LITERALS.                                               DTSCS71
00308  ++INCLUDE DTSIMMAX                                               DTSCS71
00309      EJECT                                                        DTSCS71
00310  LINKAGE SECTION.                                                 DTSCS71
00311                                                                   DTSCS71
00312  01  DFHCOMMAREA.                                                 DTSCS71
00313  ++INCLUDE DTSILCCM                                               DTSCS71
00314      EJECT                                                        DTSCS71
00315 ******************************************************************DTSCS71
00316 *                                                                *DTSCS71
00317 ******************************************************************DTSCS71
00318                                                                   DTSCS71
00319  PROCEDURE DIVISION.                                              DTSCS71
00320                                                                   DTSCS71
00321      MOVE +0 TO WRK-EMP-NO.                                       DTSCS71
00322      SET WRK-MPRF-NO-88 TO TRUE.                                  DTSCS71
00323                                                                   DTSCS71
00324      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS71
00325                                                                   DTSCS71
00326      SET CURSOR-SET-NO TO TRUE.                                   DTSCS71
00327                                                                   DTSCS71
00328      MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N)                  DTSCS71
00329        TO SCR-ACCESS-IND.                                         DTSCS71
00330                                                                   DTSCS71
00331      MOVE SPACE TO REQ-IND.                                       DTSCS71
00332                                                                   DTSCS71
00333      PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT.               DTSCS71
00334                                                                   DTSCS71
00335 *-----------------------------------------------------            DTSCS71
00336 *    P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE           DTSCS71
00337 *    "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT             DTSCS71
00338 *    REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE             DTSCS71
00339 *    OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED.         DTSCS71
00340 *                                                                 DTSCS71
00341 *    THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE                DTSCS71
00342 *    PROCESSED.                                                   DTSCS71
00343 *                                                                 DTSCS71
00344 *    THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND,         DTSCS71
00345 *    INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE            DTSCS71
00346 *    WORK STATION OPERATOR.                                       DTSCS71
00347 *-----------------------------------------------------            DTSCS71
00348                                                                   DTSCS71
00349      MOVE SPACE TO RESP-IND.                                      DTSCS71
00350                                                                   DTSCS71
00351      IF REQ-ERROR                                                 DTSCS71
00352         PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT               DTSCS71
00353      ELSE                                                         DTSCS71
00354      IF REQ-JUMP                                                  DTSCS71
00355         PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT                DTSCS71
00356      ELSE                                                         DTSCS71
00357      IF REQ-CLEAR                                                 DTSCS71
00358         PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT               DTSCS71
00359      ELSE                                                         DTSCS71
00360      IF REQ-CURSOR-TO-GOTO                                        DTSCS71
00361         PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT              DTSCS71
00362      ELSE                                                         DTSCS71
00363      IF REQ-INQUIRE                                               DTSCS71
00364         PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT             DTSCS71
00365      ELSE                                                         DTSCS71
00366      IF REQ-EDIT                                                  DTSCS71
00367         PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT                DTSCS71
00368      ELSE                                                         DTSCS71
00369      IF REQ-UPDATE                                                DTSCS71
00370         PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT              DTSCS71
00371      ELSE                                                         DTSCS71
00372         GO TO S899-ABEND.                                         DTSCS71
00373                                                                   DTSCS71
00374 *-----------------------------------------------------            DTSCS71
00375 *    THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED             DTSCS71
00376 *    IN RESP-IND THE TYPE OF RESPONSE TO BE MADE.                 DTSCS71
00377 *-----------------------------------------------------            DTSCS71
00378                                                                   DTSCS71
00379      IF RESP-SEND-MAP                                             DTSCS71
00380          PERFORM S9300-SEND-MAP THRU S9300-EXIT                   DTSCS71
00381          SET LCCM-END-TASK-88 TO TRUE                             DTSCS71
00382      ELSE                                                         DTSCS71
00383      IF RESP-SEND-MSGONLY                                         DTSCS71
00384          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS71
00385          SET LCCM-END-TASK-88 TO TRUE                             DTSCS71
00386      ELSE                                                         DTSCS71
00387      IF RESP-JUMP                                                 DTSCS71
00388          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS71
00389      ELSE                                                         DTSCS71
00390      IF RESP-CURSOR-TO-GOTO                                       DTSCS71
00391          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS71
00392          SET LCCM-END-TASK-88 TO TRUE                             DTSCS71
00393      ELSE                                                         DTSCS71
00394          GO TO S899-ABEND.                                        DTSCS71
00395                                                                   DTSCS71
00396  MAINLINE-EXIT.                                                   DTSCS71
00397                                                                   DTSCS71
00398      EXEC CICS                                                    DTSCS71
00399          RETURN                                                   DTSCS71
00400      END-EXEC.                                                    DTSCS71
00401                                                                   DTSCS71
00402      GOBACK.                                                      DTSCS71
00403      EJECT                                                        DTSCS71
00404 /*****************************************************************DTSCS71
00405 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION         *DTSCS71
00406 ******************************************************************DTSCS71
00407  P1000-ANALYZE-REQUEST.                                           DTSCS71
00408                                                                   DTSCS71
00409 *-----------------------------------------------------            DTSCS71
00410 *     IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE)         DTSCS71
00411 *     THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE               DTSCS71
00412 *     REPLACED WITH ENTER)                                        DTSCS71
00413 *-----------------------------------------------------            DTSCS71
00414      IF LCCM-SCR-ID NOT = WRK-SCR-ID                              DTSCS71
00415         SET LCCM-ENTER-88 TO TRUE                                 DTSCS71
00416         IF LCCM-EMP-NO > ZERO                                     DTSCS71
00417             SET REQ-INQUIRE TO TRUE                               DTSCS71
00418             MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                    DTSCS71
00419             MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2                    DTSCS71
00420         ELSE                                                      DTSCS71
00421             SET REQ-INQUIRE TO TRUE                               DTSCS71
00422         END-IF                                                    DTSCS71
00423         GO TO P1000-EXIT.                                         DTSCS71
00424                                                                   DTSCS71
00425 *-----------------------------------------------------            DTSCS71
00426 *      MAP IS RECEIVED                                            DTSCS71
00427 *-----------------------------------------------------            DTSCS71
00428      PERFORM S9100-RECEIVE THRU S9100-EXIT.                       DTSCS71
00429                                                                   DTSCS71
00430 *-----------------------------------------------------            DTSCS71
00431 *    CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE            DTSCS71
00432 *    WORK STATION                                                 DTSCS71
00433 *-----------------------------------------------------            DTSCS71
00434      IF LCCM-CLEAR-88                                             DTSCS71
00435         SET REQ-CLEAR TO TRUE                                     DTSCS71
00436         GO TO P1000-EXIT.                                         DTSCS71
00437                                                                   DTSCS71
00438 *-----------------------------------------------------            DTSCS71
00439 *    IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED             DTSCS71
00440 *-----------------------------------------------------            DTSCS71
00441      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS71
00442         PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT               DTSCS71
00443         GO TO P1000-EXIT.                                         DTSCS71
00444                                                                   DTSCS71
00445 *-----------------------------------------------------            DTSCS71
00446 *    PA2 IS A REQUEST TO POSITION CURSOR AT GO TO:                DTSCS71
00447 *-----------------------------------------------------            DTSCS71
00448      IF LCCM-PA2-88                                               DTSCS71
00449          SET REQ-CURSOR-TO-GOTO TO TRUE                           DTSCS71
00450          GO TO P1000-EXIT.                                        DTSCS71
00451                                                                   DTSCS71
00452 *-----------------------------------------------------            DTSCS71
00453 *    ALL OTHER PA KEYS ARE NOT ACTIVE                             DTSCS71
00454 *-----------------------------------------------------            DTSCS71
00455      IF LCCM-PA-88                                                DTSCS71
00456        PERFORM S804-INVALID-KEY THRU S804-EXIT                    DTSCS71
00457        SET REQ-ERROR TO TRUE                                      DTSCS71
00458        GO TO P1000-EXIT.                                          DTSCS71
00459                                                                   DTSCS71
00460 *-----------------------------------------------------            DTSCS71
00461 *    F12 IS PRESSED AND UPDATE MODE NOT IN PROGRESS               DTSCS71
00462 *    CLEAR SCREEN                                                 DTSCS71
00463 *-----------------------------------------------------            DTSCS71
00464      IF LCCM-F12-88                                               DTSCS71
00465         MOVE LOW-VALUES TO MAP-AREA                               DTSCS71
00466         SET REQ-CLEAR TO TRUE                                     DTSCS71
00467         GO TO P1000-EXIT.                                         DTSCS71
00468                                                                   DTSCS71
00469 *-----------------------------------------------------            DTSCS71
00470 *    IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION            DTSCS71
00471 *-----------------------------------------------------            DTSCS71
00472      IF LCCM-F03-88                                               DTSCS71
00473         MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID                    DTSCS71
00474         SET REQ-JUMP TO TRUE                                      DTSCS71
00475         GO TO P1000-EXIT.                                         DTSCS71
00476                                                                   DTSCS71
00477 *-----------------------------------------------------            DTSCS71
00478 *    IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN         DTSCS71
00479 *-----------------------------------------------------            DTSCS71
00480      IF LCCM-F04-88                                               DTSCS71
00481         MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID                 DTSCS71
00482         SET REQ-JUMP TO TRUE                                      DTSCS71
00483         GO TO P1000-EXIT.                                         DTSCS71
00484                                                                   DTSCS71
00485 *-----------------------------------------------------            DTSCS71
00486 *    IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO                DTSCS71
00487 *    CORRESPONDENCE SCREEN.                                       DTSCS71
00488 *-----------------------------------------------------            DTSCS71
00489      IF LCCM-F14-88                                               DTSCS71
00490         MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID                  DTSCS71
00491         SET REQ-JUMP TO TRUE                                      DTSCS71
00492         GO TO P1000-EXIT.                                         DTSCS71
00493                                                                   DTSCS71
00494 *-----------------------------------------------------            DTSCS71
00495 *    IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO               DTSCS71
00496 *    REQUESTED SCREEN TYPE                                        DTSCS71
00497 *-----------------------------------------------------            DTSCS71
00498      IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID             DTSCS71
00499         NEXT SENTENCE                                             DTSCS71
00500      ELSE                                                         DTSCS71
00501        MOVE MAP-GOTO TO LCCM-REQ-SCR-ID                           DTSCS71
00502        SET REQ-JUMP TO TRUE                                       DTSCS71
00503        GO TO P1000-EXIT.                                          DTSCS71
00504                                                                   DTSCS71
00505 *-----------------------------------------------------            DTSCS71
00506 *    IF REQUEST TO UPDATE THE DATA (ADD,MOD,DEL)                  DTSCS71
00507 *          VERIFY USER ACCESS TO PERFORM UPDATE                   DTSCS71
00508 *-----------------------------------------------------            DTSCS71
00509      IF LCCM-F09-88                                               DTSCS71
00510      OR LCCM-F10-88                                               DTSCS71
00511 *&   OR LCCM-F23-88                                               DTSCS71
00512         IF SCR-ACCESS-UPDATE                                      DTSCS71
00513            SET REQ-EDIT TO TRUE                                   DTSCS71
00514            GO TO P1000-EXIT                                       DTSCS71
00515         ELSE                                                      DTSCS71
00516            PERFORM S804-INVALID-KEY THRU S804-EXIT                DTSCS71
00517            SET REQ-ERROR TO TRUE                                  DTSCS71
00518            GO TO P1000-EXIT.                                      DTSCS71
00519                                                                   DTSCS71
00520 *-----------------------------------------------------            DTSCS71
00521 *    IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7,              DTSCS71
00522 *          OR F8), INDICATE INQUIRY REQUEST                       DTSCS71
00523 *-----------------------------------------------------            DTSCS71
00524      IF LCCM-INQUIRY-88                                           DTSCS71
00525          SET REQ-INQUIRE TO TRUE                                  DTSCS71
00526          GO TO P1000-EXIT.                                        DTSCS71
00527                                                                   DTSCS71
00528 *-----------------------------------------------------            DTSCS71
00529 *     ANY OTHER KEY IS INVALID                                    DTSCS71
00530 *-----------------------------------------------------            DTSCS71
00531      PERFORM S804-INVALID-KEY THRU S804-EXIT.                     DTSCS71
00532      SET REQ-ERROR TO TRUE.                                       DTSCS71
00533  P1000-EXIT.                                                      DTSCS71
00534      EXIT.                                                        DTSCS71
00535                                                                   DTSCS71
00536 ******************************************************************DTSCS71
00537 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS71
00538 ******************************************************************DTSCS71
00539                                                                   DTSCS71
00540  P1100-UPDATE-LOCKED.                                             DTSCS71
00541 *-----------------------------------------------------            DTSCS71
00542 *    IF THE SCREEN IS "LOCKED FOR UPDATE", THEN                   DTSCS71
00543 *    THE ONLY VALID OPERATOR REQUESTS ARE ENTER                   DTSCS71
00544 *    (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE).              DTSCS71
00545 *-----------------------------------------------------            DTSCS71
00546      IF LCCM-ENTER-88 OR LCCM-F12-88                              DTSCS71
00547         SET REQ-UPDATE TO TRUE                                    DTSCS71
00548      ELSE                                                         DTSCS71
00549         SET REQ-ERROR TO TRUE                                     DTSCS71
00550         IF LCCM-SCR-ADD-LOCKED                                    DTSCS71
00551            MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID                   DTSCS71
00552         ELSE                                                      DTSCS71
00553            IF LCCM-SCR-MOD-LOCKED                                 DTSCS71
00554               MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID                DTSCS71
00555 *&         ELSE                                                   DTSCS71
00556 *&            IF LCCM-SCR-DEL-LOCKED                              DTSCS71
00557 *&               MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID             DTSCS71
00558               ELSE                                                DTSCS71
00559                  GO TO S899-ABEND.                                DTSCS71
00560  P1100-EXIT.                                                      DTSCS71
00561      EXIT.                                                        DTSCS71
00562 /*****************************************************************DTSCS71
00563 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS71
00564 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN.                      *DTSCS71
00565 ******************************************************************DTSCS71
00566                                                                   DTSCS71
00567  P2000-REQUEST-ERROR.                                             DTSCS71
00568      IF LCCM-MSG                                                  DTSCS71
00569         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS71
00570      ELSE                                                         DTSCS71
00571         GO TO S899-ABEND.                                         DTSCS71
00572  P2000-EXIT.                                                      DTSCS71
00573      EXIT.                                                        DTSCS71
00574 /*****************************************************************DTSCS71
00575 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED                  *DTSCS71
00576 ******************************************************************DTSCS71
00577                                                                   DTSCS71
00578  P3000-REQUEST-JUMP.                                              DTSCS71
00579 *-----------------------------------------------------            DTSCS71
00580 *    VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE    DTSCS71
00581 *    BY USER                                                      DTSCS71
00582 *-----------------------------------------------------            DTSCS71
00583      PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT.                 DTSCS71
00584                                                                   DTSCS71
00585 *-----------------------------------------------------            DTSCS71
00586 *    VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED               DTSCS71
00587 *-----------------------------------------------------            DTSCS71
00588      IF LCCM-MSG                                                  DTSCS71
00589         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS71
00590         SET CURSOR-SET-GOTO TO TRUE                               DTSCS71
00591         GO TO P3000-EXIT.                                         DTSCS71
00592      SKIP3                                                        DTSCS71
00593      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS71
00594      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS71
00595      IF L018-VALID                                                DTSCS71
00596          MOVE L018-EMP-NO TO LCCM-EMP-NO.                         DTSCS71
00597                                                                   DTSCS71
00598 *-----------------------------------------------------            DTSCS71
00599 *    CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING      DTSCS71
00600 *-----------------------------------------------------            DTSCS71
00601      MOVE LOW-VALUES TO LCCM-SCR-STATUS                           DTSCS71
00602                         LCCM-SCR-HOLD-AREA.                       DTSCS71
00603      MOVE +0 TO LCCM-SCR-ABSTIME.                                 DTSCS71
00604      SET RESP-JUMP TO TRUE.                                       DTSCS71
00605  P3000-EXIT.                                                      DTSCS71
00606      EXIT.                                                        DTSCS71
00607 /*****************************************************************DTSCS71
00608 * CLEAR KEY WAS PRESSED                                          *DTSCS71
00609 ******************************************************************DTSCS71
00610                                                                   DTSCS71
00611  P4000-REQUEST-CLEAR.                                             DTSCS71
00612                                                                   DTSCS71
00613 *-----------------------------------------------------            DTSCS71
00614 *   CLEAN UP INDICATORS AND PAGING STORAGE.  RESET KEY            DTSCS71
00615 *   FIELDS FROM EARLIER REQUESTS                                  DTSCS71
00616 *-----------------------------------------------------            DTSCS71
00617      IF LCCM-EMP-NO > ZERO                                        DTSCS71
00618          MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                       DTSCS71
00619          MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2.                      DTSCS71
00620                                                                   DTSCS71
00621      MOVE ZERO TO LCCM-EMP-NO.                                    DTSCS71
00622                                                                   DTSCS71
00623      MOVE LOW-VALUES TO LCCM-SCR71-HOLD-AREA.                     DTSCS71
00624                                                                   DTSCS71
00625      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS71
00626                                                                   DTSCS71
00627      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS71
00628                                                                   DTSCS71
00629      IF SCR-ACCESS-UPDATE                                         DTSCS71
00630          PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT           DTSCS71
00631      ELSE                                                         DTSCS71
00632          PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.             DTSCS71
00633                                                                   DTSCS71
00634      SET RESP-SEND-MAP TO TRUE.                                   DTSCS71
00635  P4000-EXIT.                                                      DTSCS71
00636      EXIT.                                                        DTSCS71
00637 /*****************************************************************DTSCS71
00638 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED                   *DTSCS71
00639 ******************************************************************DTSCS71
00640                                                                   DTSCS71
00641  P5000-CURSOR-TO-GOTO.                                            DTSCS71
00642      SET CURSOR-SET-GOTO TO TRUE.                                 DTSCS71
00643      SET RESP-CURSOR-TO-GOTO TO TRUE.                             DTSCS71
00644  P5000-EXIT.                                                      DTSCS71
00645      EXIT.                                                        DTSCS71
00646 /*****************************************************************DTSCS71
00647 * INQUIRY WAS REQUESTED                                          *DTSCS71
00648 ******************************************************************DTSCS71
00649                                                                   DTSCS71
00650  P6000-REQUEST-INQUIRE.                                           DTSCS71
00651      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS71
00652      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS71
00653      MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA.                  DTSCS71
00654                                                                   DTSCS71
00655      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS71
00656      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS71
00657                                                                   DTSCS71
00658      SET RESP-SEND-MAP TO TRUE.                                   DTSCS71
00659                                                                   DTSCS71
00660      IF SCR-ACCESS-UPDATE                                         DTSCS71
00661          PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT           DTSCS71
00662      ELSE                                                         DTSCS71
00663          PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.             DTSCS71
00664                                                                   DTSCS71
00665      MOVE LCCM-SCR71-HOLD-AREA TO SCR-REC-KEY-AREA.               DTSCS71
00666      MOVE LOW-VALUES TO LCCM-SCR71-HOLD-AREA.                     DTSCS71
00667                                                                   DTSCS71
00668      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS71
00669      IF LCCM-MSG                                                  DTSCS71
00670          GO TO P6000-EXIT.                                        DTSCS71
00671                                                                   DTSCS71
00672      MOVE WRK-EMP-NO TO LCCM-EMP-NO.                              DTSCS71
00673                                                                   DTSCS71
00674      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCS71
00675      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCS71
00676      SET MSKL-NTE-88 TO TRUE.                                     DTSCS71
00677      PERFORM S810-COUNT THRU S810-EXIT.                           DTSCS71
00678                                                                   DTSCS71
00679      IF L810-RECORD-CNT = +0                                      DTSCS71
00680          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS71
00681          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS71
00682          GO TO P6000-EXIT.                                        DTSCS71
00683                                                                   DTSCS71
00684      MOVE L810-RECORD-CNT TO LAST-REC-NUM.                        DTSCS71
00685      MOVE MSKL-KEY-AREA TO LAST-REC-KEY-AREA.                     DTSCS71
00686                                                                   DTSCS71
00687      PERFORM P6100-LOCATE-REC THRU P6100-EXIT.                    DTSCS71
00688      IF LCCM-MSG                                                  DTSCS71
00689          GO TO P6000-EXIT.                                        DTSCS71
00690                                                                   DTSCS71
00691      PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT.              DTSCS71
00692                                                                   DTSCS71
00693      MOVE MNTE-KEY-AREA TO LCCM-SCR71-HOLD-AREA.                  DTSCS71
00694                                                                   DTSCS71
00695      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS71
00696                                                                   DTSCS71
00697      IF SCR-ACCESS-UPDATE                                         DTSCS71
00698          PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.          DTSCS71
00699  P6000-EXIT.                                                      DTSCS71
00700      EXIT.                                                        DTSCS71
00701      EJECT                                                        DTSCS71
00702                                                                   DTSCS71
00703  P6100-LOCATE-REC.                                                DTSCS71
00704 *------------------------------------------------------------     DTSCS71
00705 *    IF, AT THE LAST USE OF THIS SCREEN, A RECORD FOR             DTSCS71
00706 *    EMPLOYER NUMBER LCCM-EMP-NO WAS DISPLAYED ON THE             DTSCS71
00707 *    SCREEN, THEN BASE THE PAGING LOGIC ON THE LAST RECORD        DTSCS71
00708 *    DISPLAYED ON THIS SCREEN; OTHERWISE, DISPLAY THE             DTSCS71
00709 *    RECORD WITH THE GREATEST MNTE-ESTB-DATE                      DTSCS71
00710 *------------------------------------------------------------     DTSCS71
00711                                                                   DTSCS71
00712      IF SCR-REC-KEY-AREA = LOW-VALUES                             DTSCS71
00713          PERFORM P6140-LAST-REC THRU P6140-EXIT                   DTSCS71
00714          GO TO P6100-EXIT.                                        DTSCS71
00715                                                                   DTSCS71
00716      MOVE SCR-REC-KEY-AREA TO MNTE-KEY-AREA.                      DTSCS71
00717                                                                   DTSCS71
00718      IF WRK-EMP-NO = MNTE-EMP-NO                                  DTSCS71
00719          NEXT SENTENCE                                            DTSCS71
00720      ELSE                                                         DTSCS71
00721          PERFORM P6140-LAST-REC THRU P6140-EXIT                   DTSCS71
00722          GO TO P6100-EXIT.                                        DTSCS71
00723                                                                   DTSCS71
00724      IF LCCM-F05-88                                               DTSCS71
00725          PERFORM P6110-FIRST-REC THRU P6110-EXIT                  DTSCS71
00726          GO TO P6100-EXIT.                                        DTSCS71
00727                                                                   DTSCS71
00728      IF LCCM-F06-88                                               DTSCS71
00729          PERFORM P6140-LAST-REC THRU P6140-EXIT                   DTSCS71
00730          GO TO P6100-EXIT.                                        DTSCS71
00731                                                                   DTSCS71
00732      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCS71
00733      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCS71
00734      SET MSKL-NTE-88 TO TRUE.                                     DTSCS71
00735      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS71
00736      IF L810-NO-REC-88                                            DTSCS71
00737          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS71
00738          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS71
00739          GO TO P6100-EXIT.                                        DTSCS71
00740                                                                   DTSCS71
00741      MOVE +0 TO WS-REC-NUM.                                       DTSCS71
00742      MOVE 'N' TO WS-REC-FOUND-IND.                                DTSCS71
00743      PERFORM P6190-BROWSE-MNTE THRU P6190-EXIT                    DTSCS71
00744          UNTIL (L810-NO-REC-88)                                   DTSCS71
00745                    OR                                             DTSCS71
00746                (WS-REC-FOUND-IND = 'Y').                          DTSCS71
00747                                                                   DTSCS71
00748      IF L810-NO-REC-88                                            DTSCS71
00749          PERFORM P6140-LAST-REC THRU P6140-EXIT                   DTSCS71
00750          GO TO P6100-EXIT.                                        DTSCS71
00751                                                                   DTSCS71
00752      IF LCCM-ENTER-88                                             DTSCS71
00753          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS71
00754          GO TO P6100-EXIT.                                        DTSCS71
00755                                                                   DTSCS71
00756      IF LCCM-F07-88                                               DTSCS71
00757          PERFORM P6120-PREV-REC THRU P6120-EXIT                   DTSCS71
00758          GO TO P6100-EXIT.                                        DTSCS71
00759                                                                   DTSCS71
00760      IF LCCM-F08-88                                               DTSCS71
00761          PERFORM P6130-NEXT-REC THRU P6130-EXIT                   DTSCS71
00762          GO TO P6100-EXIT.                                        DTSCS71
00763                                                                   DTSCS71
00764      GO TO S899-ABEND.                                            DTSCS71
00765  P6100-EXIT.                                                      DTSCS71
00766      EXIT.                                                        DTSCS71
00767                                                                   DTSCS71
00768  P6110-FIRST-REC.                                                 DTSCS71
00769      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCS71
00770      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCS71
00771      SET MSKL-NTE-88 TO TRUE.                                     DTSCS71
00772      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS71
00773      IF L810-NO-REC-88                                            DTSCS71
00774          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS71
00775          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS71
00776          GO TO P6110-EXIT.                                        DTSCS71
00777                                                                   DTSCS71
00778      PERFORM S810-END-BROWSE THRU S810-EXIT.                      DTSCS71
00779                                                                   DTSCS71
00780      MOVE MSKL-REC TO MNTE-REC.                                   DTSCS71
00781                                                                   DTSCS71
00782      MOVE +1 TO WS-REC-NUM.                                       DTSCS71
00783  P6110-EXIT.                                                      DTSCS71
00784      EXIT.                                                        DTSCS71
00785                                                                   DTSCS71
00786  P6120-PREV-REC.                                                  DTSCS71
00787      PERFORM S810-READ-PREV THRU S810-EXIT.                       DTSCS71
00788      IF L810-NO-REC-88                                            DTSCS71
00789          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS71
00790          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS71
00791          GO TO P6120-EXIT.                                        DTSCS71
00792                                                                   DTSCS71
00793      PERFORM S810-READ-PREV THRU S810-EXIT.                       DTSCS71
00794      IF L810-NO-REC-88                                            DTSCS71
00795          GO TO P6120-EXIT.                                        DTSCS71
00796                                                                   DTSCS71
00797      PERFORM S810-END-BROWSE THRU S810-EXIT.                      DTSCS71
00798                                                                   DTSCS71
00799      SUBTRACT 1 FROM WS-REC-NUM.                                  DTSCS71
00800                                                                   DTSCS71
00801      MOVE MSKL-REC TO MNTE-REC.                                   DTSCS71
00802  P6120-EXIT.                                                      DTSCS71
00803      EXIT.                                                        DTSCS71
00804                                                                   DTSCS71
00805  P6130-NEXT-REC.                                                  DTSCS71
00806      IF MNTE-KEY-AREA > SCR-REC-KEY-AREA                          DTSCS71
00807          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS71
00808          GO TO P6130-EXIT.                                        DTSCS71
00809                                                                   DTSCS71
00810      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS71
00811                                                                   DTSCS71
00812      IF L810-NO-REC-88                                            DTSCS71
00813          GO TO P6130-EXIT.                                        DTSCS71
00814                                                                   DTSCS71
00815      PERFORM S810-END-BROWSE THRU S810-EXIT.                      DTSCS71
00816                                                                   DTSCS71
00817      ADD +1 TO WS-REC-NUM.                                        DTSCS71
00818                                                                   DTSCS71
00819      MOVE MSKL-REC TO MNTE-REC.                                   DTSCS71
00820  P6130-EXIT.                                                      DTSCS71
00821      EXIT.                                                        DTSCS71
00822                                                                   DTSCS71
00823  P6140-LAST-REC.                                                  DTSCS71
00824      MOVE LAST-REC-KEY-AREA TO MSKL-KEY-AREA.                     DTSCS71
00825      PERFORM S810-READ THRU S810-EXIT.                            DTSCS71
00826      IF L810-NO-REC-88                                            DTSCS71
00827          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS71
00828          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS71
00829          GO TO P6140-EXIT.                                        DTSCS71
00830                                                                   DTSCS71
00831      MOVE MSKL-REC TO MNTE-REC.                                   DTSCS71
00832                                                                   DTSCS71
00833      MOVE LAST-REC-NUM TO WS-REC-NUM.                             DTSCS71
00834  P6140-EXIT.                                                      DTSCS71
00835      EXIT.                                                        DTSCS71
00836                                                                   DTSCS71
00837  P6190-BROWSE-MNTE.                                               DTSCS71
00838      MOVE MSKL-REC TO MNTE-REC.                                   DTSCS71
00839      ADD +1 TO WS-REC-NUM.                                        DTSCS71
00840      IF MNTE-KEY-AREA NOT < SCR-REC-KEY-AREA                      DTSCS71
00841          MOVE 'Y' TO WS-REC-FOUND-IND                             DTSCS71
00842      ELSE                                                         DTSCS71
00843          PERFORM S810-READ-NEXT THRU S810-EXIT.                   DTSCS71
00844  P6190-EXIT.                                                      DTSCS71
00845      EXIT.                                                        DTSCS71
00846 /*****************************************************************DTSCS71
00847 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS            *DTSCS71
00848 ******************************************************************DTSCS71
00849                                                                   DTSCS71
00850  P6900-CONSTRUCT-SCREEN.                                          DTSCS71
00851      PERFORM P6910-FROM-MNTE THRU P6910-EXIT.                     DTSCS71
00852                                                                   DTSCS71
00853      PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT.                   DTSCS71
00854  P6900-EXIT.                                                      DTSCS71
00855      EXIT.                                                        DTSCS71
00856                                                                   DTSCS71
00857  P6910-FROM-MNTE.                                                 DTSCS71
00858      IF MNTE-KEY-ESTB-ABSTIME = WRK-PRIORITY-ABSTIME-LIT          DTSCS71
00859         MOVE 'Y' TO MAP-PRIORITY                                  DTSCS71
00860      ELSE                                                         DTSCS71
00861         MOVE 'N' TO MAP-PRIORITY                                  DTSCS71
00862      END-IF.                                                      DTSCS71
00863                                                                   DTSCS71
00864      MOVE MNTE-ESTB-DATE             TO L001-FED-8-DATE-9.        DTSCS71
00865      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSCS71
00866      MOVE L001-SLASH-DATE            TO MAP-ESTB-DATE             DTSCS71
00867                                                                   DTSCS71
00868      MOVE MNTE-CHNG-DATE             TO L001-FED-8-DATE-9.        DTSCS71
00869      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSCS71
00870      MOVE L001-SLASH-DATE            TO MAP-CHNG-DATE.            DTSCS71
00871                                                                   DTSCS71
00872      MOVE MNTE-SUBJECT               TO MAP-SUBJECT.              DTSCS71
00873                                                                   DTSCS71
00874      PERFORM P6911-MOVE-TEXT      THRU P6911-EXIT                 DTSCS71
00875      VARYING WRK-SUB FROM 1 BY 1                                  DTSCS71
00876      UNTIL WRK-SUB > MNTE-TEXT-CNT.                               DTSCS71
00877                                                                   DTSCS71
00878      MOVE MNTE-ESTB-OP-ID            TO MAP-ESTB-OP-ID.           DTSCS71
00879      MOVE MNTE-CHNG-OP-ID            TO MAP-CHNG-OP-ID.           DTSCS71
00880                                                                   DTSCS71
00881  P6910-EXIT.                                                      DTSCS71
00882      EXIT.                                                        DTSCS71
00883                                                                   DTSCS71
00884  P6911-MOVE-TEXT.                                                 DTSCS71
00885      MOVE MNTE-TEXT(WRK-SUB)         TO MAP-TEXT(WRK-SUB).        DTSCS71
00886  P6911-EXIT. EXIT.                                                DTSCS71
00887                                                                   DTSCS71
00888  P6990-PAGE-NUMBER.                                               DTSCS71
00889      MOVE WS-REC-NUM TO MAP-CURR-PAGE.                            DTSCS71
00890      MOVE LAST-REC-NUM TO MAP-LAST-PAGE.                          DTSCS71
00891                                                                   DTSCS71
00892      IF WS-REC-NUM = +1                                           DTSCS71
00893          IF LAST-REC-NUM = +1                                     DTSCS71
00894              MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA                 DTSCS71
00895          ELSE                                                     DTSCS71
00896              MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA                DTSCS71
00897      ELSE                                                         DTSCS71
00898          IF WS-REC-NUM = LAST-REC-NUM                             DTSCS71
00899              MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA.                DTSCS71
00900  P6990-EXIT.                                                      DTSCS71
00901      EXIT.                                                        DTSCS71
00902 /*****************************************************************DTSCS71
00903 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED.        *DTSCS71
00904 ******************************************************************DTSCS71
00905                                                                   DTSCS71
00906  P7000-REQUEST-EDIT.                                              DTSCS71
00907      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS71
00908                                                                   DTSCS71
00909      IF LCCM-F09-88                                               DTSCS71
00910         PERFORM P7100-EDIT-ADD THRU P7100-EXIT                    DTSCS71
00911      ELSE                                                         DTSCS71
00912         IF LCCM-F10-88                                            DTSCS71
00913            PERFORM P7200-EDIT-MOD THRU P7200-EXIT                 DTSCS71
00914 *&      ELSE                                                      DTSCS71
00915 *&         IF LCCM-F23-88                                         DTSCS71
00916 *&            PERFORM P7300-EDIT-DEL THRU P7300-EXIT              DTSCS71
00917            ELSE                                                   DTSCS71
00918               GO TO S899-ABEND.                                   DTSCS71
00919                                                                   DTSCS71
00920 *------------------------------------------------------           DTSCS71
00921 *  SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED.          DTSCS71
00922 *  IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST          DTSCS71
00923 *  REMAIN IN 'INQUIRE' STATUS.                                    DTSCS71
00924 *------------------------------------------------------           DTSCS71
00925                                                                   DTSCS71
00926      IF LCCM-MSG                                                  DTSCS71
00927         NEXT SENTENCE                                             DTSCS71
00928      ELSE                                                         DTSCS71
00929         PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT              DTSCS71
00930         IF LCCM-F09-88                                            DTSCS71
00931            SET LCCM-SCR-ADD-LOCKED TO TRUE                        DTSCS71
00932            MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID                   DTSCS71
00933         ELSE                                                      DTSCS71
00934            IF LCCM-F10-88                                         DTSCS71
00935               SET LCCM-SCR-MOD-LOCKED TO TRUE                     DTSCS71
00936               MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID                DTSCS71
00937            ELSE                                                   DTSCS71
00938               IF LCCM-F23-88                                      DTSCS71
00939                  SET LCCM-SCR-DEL-LOCKED TO TRUE                  DTSCS71
00940                  MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID.            DTSCS71
00941                                                                   DTSCS71
00942      SET RESP-SEND-MAP TO TRUE.                                   DTSCS71
00943  P7000-EXIT.                                                      DTSCS71
00944      EXIT.                                                        DTSCS71
00945 /*****************************************************************DTSCS71
00946 * ADD FUNCTION WAS REQUESTED                                     *DTSCS71
00947 ******************************************************************DTSCS71
00948                                                                   DTSCS71
00949  P7100-EDIT-ADD.                                                  DTSCS71
00950 *-----------------------------------------------------            DTSCS71
00951 *    ADDITION REQUIRES THAT THE SCREEN WAS CLEARED FIRST          DTSCS71
00952 *-----------------------------------------------------            DTSCS71
00953      IF NOT LCCM-SCR-CLEAR                                        DTSCS71
00954         MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID                     DTSCS71
00955         GO TO P7100-EXIT.                                         DTSCS71
00956                                                                   DTSCS71
00957 *-----------------------------------------------------            DTSCS71
00958 *    MAP-EMP-NO MAY NOT BE CHANGED DURING THE ADD                 DTSCS71
00959 *-----------------------------------------------------            DTSCS71
00960      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS71
00961      IF LCCM-MSG                                                  DTSCS71
00962          GO TO P7100-EXIT.                                        DTSCS71
00963                                                                   DTSCS71
00964      PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT.                  DTSCS71
00965  P7100-EXIT.                                                      DTSCS71
00966      EXIT.                                                        DTSCS71
00967 /*****************************************************************DTSCS71
00968 * MODIFICATION FUNCTION WAS REQUESTED                            *DTSCS71
00969 ******************************************************************DTSCS71
00970                                                                   DTSCS71
00971  P7200-EDIT-MOD.                                                  DTSCS71
00972 *-----------------------------------------------------            DTSCS71
00973 *    MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY         DTSCS71
00974 *    INQUIRED                                                     DTSCS71
00975 *-----------------------------------------------------            DTSCS71
00976      IF NOT LCCM-SCR-INQUIRE                                      DTSCS71
00977         MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID                     DTSCS71
00978         GO TO P7200-EXIT.                                         DTSCS71
00979                                                                   DTSCS71
00980 *-----------------------------------------------------            DTSCS71
00981 *    MAP-EMP-NO MAY NOT BE CHANGED DURING THE MOD                 DTSCS71
00982 *-----------------------------------------------------            DTSCS71
00983      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS71
00984      IF LCCM-MSG                                                  DTSCS71
00985          GO TO P7200-EXIT.                                        DTSCS71
00986                                                                   DTSCS71
00987      IF LCCM-EMP-NO NOT = WRK-EMP-NO                              DTSCS71
00988          MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA         DTSCS71
00989          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS71
00990          GO TO P7200-EXIT.                                        DTSCS71
00991                                                                   DTSCS71
00992      MOVE LCCM-SCR71-HOLD-AREA TO MSKL-KEY-AREA.                  DTSCS71
00993      PERFORM S810-READ THRU S810-EXIT.                            DTSCS71
00994      IF L810-NO-REC-88                                            DTSCS71
00995          GO TO S899-ABEND.                                        DTSCS71
00996                                                                   DTSCS71
00997      MOVE MSKL-REC TO MNTE-REC.                                   DTSCS71
00998      IF LCCM-OP-ID NOT = MNTE-ESTB-OP-ID                          DTSCS71
00999          MOVE MSG-E712-AREA TO WRK-MSG-AREA                       DTSCS71
01000          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS71
01001          GO TO P7200-EXIT.                                        DTSCS71
01002                                                                   DTSCS71
01003      PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT.                  DTSCS71
01004                                                                   DTSCS71
01005  P7200-EXIT.                                                      DTSCS71
01006      EXIT.                                                        DTSCS71
01007 /*****************************************************************DTSCS71
01008 * DELETE FUNCTION WAS REQUESTED                                  *DTSCS71
01009 ******************************************************************DTSCS71
01010                                                                   DTSCS71
01011  P7300-EDIT-DEL.                                                  DTSCS71
01012 *-----------------------------------------------------            DTSCS71
01013 *    DELETION REQUIRES THAT A RECORD WAS SUCCESSFULLY             DTSCS71
01014 *    INQUIRED                                                     DTSCS71
01015 *-----------------------------------------------------            DTSCS71
01016      IF NOT LCCM-SCR-INQUIRE                                      DTSCS71
01017         MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID                     DTSCS71
01018         GO TO P7300-EXIT.                                         DTSCS71
01019                                                                   DTSCS71
01020 *-----------------------------------------------------            DTSCS71
01021 *    MAP-EMP-NO MAY NOT BE CHANGED DURING THE DEL                 DTSCS71
01022 *-----------------------------------------------------            DTSCS71
01023      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS71
01024      IF LCCM-MSG                                                  DTSCS71
01025          GO TO P7300-EXIT.                                        DTSCS71
01026                                                                   DTSCS71
01027      IF LCCM-EMP-NO NOT = WRK-EMP-NO                              DTSCS71
01028          MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA         DTSCS71
01029          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS71
01030          GO TO P7300-EXIT.                                        DTSCS71
01031                                                                   DTSCS71
01032  P7300-EXIT.                                                      DTSCS71
01033      EXIT.                                                        DTSCS71
01034 /*****************************************************************DTSCS71
01035 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED       *DTSCS71
01036 ******************************************************************DTSCS71
01037                                                                   DTSCS71
01038  P8000-REQUEST-UPDATE.                                            DTSCS71
01039                                                                   DTSCS71
01040      IF LCCM-SCR-ADD-LOCKED                                       DTSCS71
01041         PERFORM P8100-ADD THRU P8100-EXIT                         DTSCS71
01042      ELSE                                                         DTSCS71
01043         IF LCCM-SCR-MOD-LOCKED                                    DTSCS71
01044            PERFORM P8200-MOD THRU P8200-EXIT                      DTSCS71
01045 *&      ELSE                                                      DTSCS71
01046 *&         IF LCCM-SCR-DEL-LOCKED                                 DTSCS71
01047 *&            PERFORM P8300-DEL THRU P8300-EXIT                   DTSCS71
01048            ELSE                                                   DTSCS71
01049               GO TO S899-ABEND.                                   DTSCS71
01050                                                                   DTSCS71
01051      SET RESP-SEND-MAP TO TRUE.                                   DTSCS71
01052  P8000-EXIT.                                                      DTSCS71
01053      EXIT.                                                        DTSCS71
01054 /*****************************************************************DTSCS71
01055 *                                                                *DTSCS71
01056 ******************************************************************DTSCS71
01057                                                                   DTSCS71
01058  P8100-ADD.                                                       DTSCS71
01059      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS71
01060                                                                   DTSCS71
01061      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS71
01062                                                                   DTSCS71
01063      IF LCCM-F12-88                                               DTSCS71
01064         MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID                     DTSCS71
01065         GO TO P8100-EXIT.                                         DTSCS71
01066                                                                   DTSCS71
01067      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS71
01068                                                                   DTSCS71
01069      MOVE 'A' TO L221-UPDATE-FUNCTION.                            DTSCS71
01070      PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT.                 DTSCS71
01071      IF LCCM-MSG                                                  DTSCS71
01072          GO TO P8100-EXIT.                                        DTSCS71
01073                                                                   DTSCS71
01074                                                                   DTSCS71
01075      PERFORM P8110-CONSTRUCT-MNTE THRU P8110-EXIT.                DTSCS71
01076                                                                   DTSCS71
01077      PERFORM S221-EMP-UNLOCK THRU S221-EXIT.                      DTSCS71
01078                                                                   DTSCS71
01079                                                                   DTSCS71
01080      MOVE MNTE-KEY-AREA TO LCCM-SCR71-HOLD-AREA.                  DTSCS71
01081      SET LCCM-ENTER-88 TO TRUE.                                   DTSCS71
01082      PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT.               DTSCS71
01083                                                                   DTSCS71
01084      MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID.                     DTSCS71
01085                                                                   DTSCS71
01086      MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS71
01087  P8100-EXIT.                                                      DTSCS71
01088      EXIT.                                                        DTSCS71
01089                                                                   DTSCS71
01090  P8110-CONSTRUCT-MNTE.                                            DTSCS71
01091      MOVE LOW-VALUES                 TO MNTE-REC.                 DTSCS71
01092      MOVE WRK-EMP-NO                 TO MNTE-EMP-NO.              DTSCS71
01093      SET MNTE-NTE-88                 TO TRUE.                     DTSCS71
01094                                                                   DTSCS71
01095      MOVE +0                         TO MNTE-PURGE-DATE.          DTSCS71
01096                                                                   DTSCS71
01097      SET MNTE-NOT-CONVERTED-88       TO TRUE.                     DTSCS71
01098                                                                   DTSCS71
01099      MOVE LCCM-CURR-RUN-DATE         TO MNTE-ESTB-DATE.           DTSCS71
01100      MOVE LCCM-CURR-RUN-DATE         TO MNTE-CHNG-DATE.           DTSCS71
01101                                                                   DTSCS71
01102      IF MAP-PRIORITY-YES                                          DTSCS71
01103         MOVE WRK-PRIORITY-ABSTIME-LIT   TO MNTE-KEY-ESTB-ABSTIME  DTSCS71
01104      ELSE                                                         DTSCS71
01105         MOVE LCCM-TASK-START-ABSTIME    TO MNTE-KEY-ESTB-ABSTIME  DTSCS71
01106      END-IF.                                                      DTSCS71
01107                                                                   DTSCS71
01108      MOVE LCCM-TASK-START-ABSTIME    TO MNTE-DATA-ESTB-ABSTIME.   DTSCS71
01109      MOVE LCCM-TASK-START-ABSTIME    TO MNTE-CHNG-ABSTIME.        DTSCS71
01110      MOVE MAP-SUBJECT                TO MNTE-SUBJECT.             DTSCS71
01111      MOVE LCCM-OP-ID                 TO MNTE-ESTB-OP-ID.          DTSCS71
01112      MOVE LCCM-OP-ID                 TO MNTE-CHNG-OP-ID.          DTSCS71
01113                                                                   DTSCS71
01114      MOVE 0 TO WRK-SUB2                                           DTSCS71
01115      PERFORM P8111-MOVE-TEXT      THRU P8111-EXIT                 DTSCS71
01116      VARYING WRK-SUB FROM 1 BY 1                                  DTSCS71
01117      UNTIL WRK-SUB > MMAX-NTE-TEXT-MAX.                           DTSCS71
01118                                                                   DTSCS71
01119      MOVE WRK-SUB2   TO   MNTE-TEXT-CNT.                          DTSCS71
01120                                                                   DTSCS71
01121      MOVE MNTE-REC TO MSKL-REC.                                   DTSCS71
01122      PERFORM S810-WRITE THRU S810-EXIT.                           DTSCS71
01123                                                                   DTSCS71
01124  P8110-EXIT.                                                      DTSCS71
01125      EXIT.                                                        DTSCS71
01126                                                                   DTSCS71
01127  P8111-MOVE-TEXT.                                                 DTSCS71
01128      INSPECT MAP-TEXT (WRK-SUB)                                   DTSCS71
01129          CONVERTING LOW-VALUES TO SPACES.                         DTSCS71
01130                                                                   DTSCS71
01131      IF MAP-TEXT(WRK-SUB) = SPACES                                DTSCS71
01132         MOVE SPACES   TO MNTE-TEXT(WRK-SUB)                       DTSCS71
01133      ELSE                                                         DTSCS71
01134         MOVE  WRK-SUB TO WRK-SUB2                                 DTSCS71
01135         MOVE MAP-TEXT(WRK-SUB) TO MNTE-TEXT(WRK-SUB)              DTSCS71
01136      END-IF.                                                      DTSCS71
01137                                                                   DTSCS71
01138  P8111-EXIT. EXIT.                                                DTSCS71
01139 /*****************************************************************DTSCS71
01140 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS        *DTSCS71
01141 ******************************************************************DTSCS71
01142                                                                   DTSCS71
01143  P8200-MOD.                                                       DTSCS71
01144      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS71
01145                                                                   DTSCS71
01146      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS71
01147                                                                   DTSCS71
01148      IF LCCM-F12-88                                               DTSCS71
01149         MOVE PMSG-MOD-CANCELED        TO LCCM-MSG-ID              DTSCS71
01150         GO TO P8200-EXIT.                                         DTSCS71
01151                                                                   DTSCS71
01152      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS71
01153                                                                   DTSCS71
01154      MOVE 'M' TO L221-UPDATE-FUNCTION.                            DTSCS71
01155      PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT.                 DTSCS71
01156      IF LCCM-MSG                                                  DTSCS71
01157          GO TO P8200-EXIT.                                        DTSCS71
01158                                                                   DTSCS71
01159      PERFORM P8210-CONSTRUCT-MNTE THRU P8210-EXIT.                DTSCS71
01160                                                                   DTSCS71
01161      PERFORM S221-EMP-UNLOCK THRU S221-EXIT.                      DTSCS71
01162                                                                   DTSCS71
01163      MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID.                     DTSCS71
01164                                                                   DTSCS71
01165      MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS71
01166  P8200-EXIT.                                                      DTSCS71
01167      EXIT.                                                        DTSCS71
01168      EJECT                                                        DTSCS71
01169  P8210-CONSTRUCT-MNTE.                                            DTSCS71
01170      MOVE LCCM-SCR71-HOLD-AREA TO MSKL-KEY-AREA.                  DTSCS71
01171      PERFORM S810-READ THRU S810-EXIT.                            DTSCS71
01172      IF L810-NO-REC-88                                            DTSCS71
01173          GO TO S899-ABEND.                                        DTSCS71
01174                                                                   DTSCS71
01175      MOVE MSKL-REC TO MNTE-REC.                                   DTSCS71
01176                                                                   DTSCS71
01177      PERFORM                                                      DTSCS71
01178         VARYING WRK-SUB FROM 1 BY 1                               DTSCS71
01179         UNTIL WRK-SUB > MMAX-NTE-TEXT-MAX                         DTSCS71
01180            MOVE SPACES TO MNTE-TEXT(WRK-SUB)                      DTSCS71
01181      END-PERFORM.                                                 DTSCS71
01182                                                                   DTSCS71
01183      MOVE 0 TO WRK-SUB2                                           DTSCS71
01184      PERFORM P8111-MOVE-TEXT      THRU P8111-EXIT                 DTSCS71
01185      VARYING WRK-SUB FROM 1 BY 1                                  DTSCS71
01186      UNTIL WRK-SUB > 16.                                          DTSCS71
01187                                                                   DTSCS71
01188      MOVE WRK-SUB2 TO MNTE-TEXT-CNT.                              DTSCS71
01189                                                                   DTSCS71
01190      MOVE LCCM-OP-ID                 TO MNTE-CHNG-OP-ID.          DTSCS71
01191      MOVE LCCM-CURR-RUN-DATE         TO MNTE-CHNG-DATE.           DTSCS71
01192      MOVE LCCM-TASK-START-ABSTIME    TO MNTE-CHNG-ABSTIME.        DTSCS71
01193                                                                   DTSCS71
01194      MOVE MNTE-REC TO MSKL-REC.                                   DTSCS71
01195      PERFORM S810-REWRITE THRU S810-EXIT.                         DTSCS71
01196  P8210-EXIT.                                                      DTSCS71
01197      EXIT.                                                        DTSCS71
01198 /*****************************************************************DTSCS71
01199 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS        *DTSCS71
01200 ******************************************************************DTSCS71
01201                                                                   DTSCS71
01202  P8300-DEL.                                                       DTSCS71
01203      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS71
01204                                                                   DTSCS71
01205      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS71
01206                                                                   DTSCS71
01207      IF LCCM-F12-88                                               DTSCS71
01208         MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID                     DTSCS71
01209         GO TO P8300-EXIT.                                         DTSCS71
01210                                                                   DTSCS71
01211      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS71
01212                                                                   DTSCS71
01213      MOVE 'D' TO L221-UPDATE-FUNCTION.                            DTSCS71
01214      PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT.                 DTSCS71
01215      IF LCCM-MSG                                                  DTSCS71
01216          GO TO P8300-EXIT.                                        DTSCS71
01217                                                                   DTSCS71
01218                                                                   DTSCS71
01219      MOVE LCCM-SCR71-HOLD-AREA TO MSKL-KEY-AREA.                  DTSCS71
01220      PERFORM S810-READ THRU S810-EXIT.                            DTSCS71
01221      IF L810-NO-REC-88                                            DTSCS71
01222          GO TO S899-ABEND.                                        DTSCS71
01223                                                                   DTSCS71
01224      MOVE MSKL-REC TO MNTE-REC.                                   DTSCS71
01225                                                                   DTSCS71
01226      PERFORM S810-DELETE THRU S810-EXIT.                          DTSCS71
01227                                                                   DTSCS71
01228      PERFORM S221-EMP-UNLOCK THRU S221-EXIT.                      DTSCS71
01229                                                                   DTSCS71
01230      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS71
01231                                                                   DTSCS71
01232      MOVE WRK-EMP-NO TO WRK-DISPLAY.                              DTSCS71
01233      MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1.                   DTSCS71
01234      MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2.                   DTSCS71
01235                                                                   DTSCS71
01236      PERFORM S1110-READ-MPRF THRU S1110-EXIT.                     DTSCS71
01237                                                                   DTSCS71
01238      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS71
01239                                                                   DTSCS71
01240      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS71
01241                                                                   DTSCS71
01242      MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS71
01243                                                                   DTSCS71
01244      MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID.                     DTSCS71
01245  P8300-EXIT.                                                      DTSCS71
01246      EXIT.                                                        DTSCS71
01247      EJECT                                                        DTSCS71
01248  P8810-LOCK-EMPLOYER.                                             DTSCS71
01249      MOVE WRK-EMP-NO TO L221-EMP-NO.                              DTSCS71
01250      MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME.                   DTSCS71
01251      MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID.                    DTSCS71
01252      MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID.                        DTSCS71
01253      MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID.                DTSCS71
01254      MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME.               DTSCS71
01255      MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE.         DTSCS71
01256      MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME.         DTSCS71
01257      MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID.                       DTSCS71
01258                                                                   DTSCS71
01259      PERFORM S221-EMP-LOCK THRU S221-EXIT.                        DTSCS71
01260  P8810-EXIT.                                                      DTSCS71
01261      EXIT.                                                        DTSCS71
01262 /*****************************************************************DTSCS71
01263 * LINKS TO UTILITY MODULES                                        DTSCS71
01264 ******************************************************************DTSCS71
01265                                                                   DTSCS71
01266  S001-FROM-FED-8.                                                 DTSCS71
01267      SET L001-FROM-FED-8 TO TRUE.                                 DTSCS71
01268      GO TO S001-DATE.                                             DTSCS71
01269                                                                   DTSCS71
01270  S001-FROM-ABS-DATE.                                              DTSCS71
01271      SET L001-FROM-ABS-DAY TO TRUE.                               DTSCS71
01272      GO TO S001-DATE.                                             DTSCS71
01273                                                                   DTSCS71
01274  S001-DATE.                                                       DTSCS71
01275      EXEC CICS LINK                                               DTSCS71
01276          PROGRAM('DTSCU001')                                      DTSCS71
01277          COMMAREA(L001-COMM-AREA)                                 DTSCS71
01278      END-EXEC.                                                    DTSCS71
01279  S001-EXIT.                                                       DTSCS71
01280      EXIT.                                                        DTSCS71
01281                                                                   DTSCS71
01282  S018-EMP-NO-FROM-SCREEN.                                         DTSCS71
01283      EXEC CICS LINK                                               DTSCS71
01284          PROGRAM('DTSCU018')                                      DTSCS71
01285          COMMAREA(L018-COMM-AREA)                                 DTSCS71
01286      END-EXEC.                                                    DTSCS71
01287  S018-EXIT.                                                       DTSCS71
01288      EXIT.                                                        DTSCS71
01289                                                                   DTSCS71
01290  S082-OP-ID-LOOKUP.                                               DTSCS71
01291      EXEC CICS LINK                                               DTSCS71
01292          PROGRAM('DTSCU082')                                      DTSCS71
01293          COMMAREA(L082-COMM-AREA)                                 DTSCS71
01294      END-EXEC.                                                    DTSCS71
01295                                                                   DTSCS71
01296      IF L082-FILE-CLOSED                                          DTSCS71
01297          MOVE L082-MSG-AREA TO LCCM-MSG-AREA                      DTSCS71
01298          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS71
01299          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS71
01300          GO TO MAINLINE-EXIT.                                     DTSCS71
01301                                                                   DTSCS71
01302  S082-EXIT.                                                       DTSCS71
01303      EXIT.                                                        DTSCS71
01304                                                                   DTSCS71
01305  S221-EMP-LOCK.                                                   DTSCS71
01306      SET L221-START-UPDATE TO TRUE.                               DTSCS71
01307      GO TO S221-EMP-LOCK-UNLOCK.                                  DTSCS71
01308                                                                   DTSCS71
01309  S221-EMP-UNLOCK.                                                 DTSCS71
01310      SET L221-END-UPDATE TO TRUE.                                 DTSCS71
01311      GO TO S221-EMP-LOCK-UNLOCK.                                  DTSCS71
01312                                                                   DTSCS71
01313  S221-EMP-LOCK-UNLOCK.                                            DTSCS71
01314      EXEC CICS LINK                                               DTSCS71
01315          PROGRAM('DTSCU221')                                      DTSCS71
01316          COMMAREA(L221-COMM-AREA)                                 DTSCS71
01317      END-EXEC.                                                    DTSCS71
01318                                                                   DTSCS71
01319      IF L221-FILE-CLOSED                                          DTSCS71
01320          MOVE L221-MSG-AREA TO LCCM-MSG-AREA                      DTSCS71
01321          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS71
01322          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS71
01323          GO TO MAINLINE-EXIT.                                     DTSCS71
01324                                                                   DTSCS71
01325      IF L221-NOT-OK                                               DTSCS71
01326          MOVE L221-MSG-AREA TO LCCM-MSG-AREA.                     DTSCS71
01327  S221-EXIT.                                                       DTSCS71
01328      EXIT.                                                        DTSCS71
01329                                                                   DTSCS71
01330                                                                   DTSCS71
01331  S803-REQ-SCR-ID-EDIT.                                            DTSCS71
01332      EXEC CICS LINK                                               DTSCS71
01333          PROGRAM ('DTSCU803')                                     DTSCS71
01334          COMMAREA (DFHCOMMAREA)                                   DTSCS71
01335      END-EXEC.                                                    DTSCS71
01336  S803-EXIT.                                                       DTSCS71
01337      EXIT.                                                        DTSCS71
01338                                                                   DTSCS71
01339  S804-INVALID-KEY.                                                DTSCS71
01340      EXEC CICS LINK                                               DTSCS71
01341          PROGRAM ('DTSCU804')                                     DTSCS71
01342          COMMAREA (DFHCOMMAREA)                                   DTSCS71
01343      END-EXEC.                                                    DTSCS71
01344  S804-EXIT.                                                       DTSCS71
01345      EXIT.                                                        DTSCS71
01346                                                                   DTSCS71
01347  S805-MSG-AREA.                                                   DTSCS71
01348      MOVE LCCM-MSG-AREA TO L805-MSG-AREA                          DTSCS71
01349                                                                   DTSCS71
01350      EXEC CICS LINK                                               DTSCS71
01351          PROGRAM ('DTSCU805')                                     DTSCS71
01352          COMMAREA (L805-COMM-AREA)                                DTSCS71
01353      END-EXEC.                                                    DTSCS71
01354                                                                   DTSCS71
01355      MOVE L805-S-MSG-AREA TO MAP-MSG-AREA.                        DTSCS71
01356  S805-EXIT.                                                       DTSCS71
01357      EXIT.                                                        DTSCS71
01358      EJECT                                                        DTSCS71
01359  S810-READ.                                                       DTSCS71
01360      SET L810-READ-88 TO TRUE.                                    DTSCS71
01361      GO TO S810-IO.                                               DTSCS71
01362                                                                   DTSCS71
01363  S810-START-BROWSE.                                               DTSCS71
01364      SET L810-START-BROWSE-88 TO TRUE.                            DTSCS71
01365      GO TO S810-IO.                                               DTSCS71
01366                                                                   DTSCS71
01367  S810-READ-NEXT.                                                  DTSCS71
01368      SET L810-READ-NEXT-88 TO TRUE.                               DTSCS71
01369      GO TO S810-IO.                                               DTSCS71
01370                                                                   DTSCS71
01371  S810-READ-PREV.                                                  DTSCS71
01372      SET L810-READ-PREV-88 TO TRUE.                               DTSCS71
01373      GO TO S810-IO.                                               DTSCS71
01374                                                                   DTSCS71
01375  S810-END-BROWSE.                                                 DTSCS71
01376      SET L810-END-BROWSE-88 TO TRUE.                              DTSCS71
01377      GO TO S810-IO.                                               DTSCS71
01378                                                                   DTSCS71
01379  S810-COUNT.                                                      DTSCS71
01380      SET L810-COUNT-88 TO TRUE.                                   DTSCS71
01381      GO TO S810-IO.                                               DTSCS71
01382                                                                   DTSCS71
01383  S810-REWRITE.                                                    DTSCS71
01384      SET L810-REWRITE-88 TO TRUE.                                 DTSCS71
01385      GO TO S810-IO.                                               DTSCS71
01386                                                                   DTSCS71
01387  S810-WRITE.                                                      DTSCS71
01388      SET L810-WRITE-88 TO TRUE.                                   DTSCS71
01389      GO TO S810-IO.                                               DTSCS71
01390                                                                   DTSCS71
01391  S810-DELETE.                                                     DTSCS71
01392      SET L810-DELETE-88 TO TRUE.                                  DTSCS71
01393      GO TO S810-IO.                                               DTSCS71
01394                                                                   DTSCS71
01395  S810-IO.                                                         DTSCS71
01396                                                                   DTSCS71
01397      EXEC CICS LINK                                               DTSCS71
01398          PROGRAM ('DTSCU810')                                     DTSCS71
01399          COMMAREA (L810-COMM-AREA)                                DTSCS71
01400      END-EXEC.                                                    DTSCS71
01401                                                                   DTSCS71
01402      IF L810-FILE-CLOSED-88                                       DTSCS71
01403          MOVE L810-MSG-AREA TO LCCM-MSG-AREA                      DTSCS71
01404          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS71
01405          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS71
01406          GO TO MAINLINE-EXIT.                                     DTSCS71
01407  S810-EXIT.                                                       DTSCS71
01408      EXIT.                                                        DTSCS71
01409      EJECT                                                        DTSCS71
01410  S851-SCREEN-PROCESSING.                                          DTSCS71
01411      EXEC CICS LINK                                               DTSCS71
01412          PROGRAM ('DTSCU851')                                     DTSCS71
01413          COMMAREA (L851-COMM-AREA)                                DTSCS71
01414      END-EXEC.                                                    DTSCS71
01415  S851-EXIT.                                                       DTSCS71
01416      EXIT.                                                        DTSCS71
01417                                                                   DTSCS71
01418  S899-ABEND.                                                      DTSCS71
01419      EXEC CICS ABEND                                              DTSCS71
01420          ABCODE(WRK-ABEND-CD)                                     DTSCS71
01421      END-EXEC.                                                    DTSCS71
01422  S899-EXIT.                                                       DTSCS71
01423      EXIT.                                                        DTSCS71
01424 /*****************************************************************DTSCS71
01425 *    EDIT THE INFORMATION ON THE SCREEN.                         *DTSCS71
01426 ******************************************************************DTSCS71
01427                                                                   DTSCS71
01428  S1000-SCREEN-EDITS.                                              DTSCS71
01429                                                                   DTSCS71
01430                                                                   DTSCS71
01431       PERFORM S1200-SUBJECT            THRU S1200-EXIT.           DTSCS71
01432       PERFORM S1300-PRIORITY           THRU S1300-EXIT.           DTSCS71
01433       PERFORM S1400-TEXT               THRU S1400-EXIT            DTSCS71
01434       VARYING WRK-SUB FROM 1 BY 1                                 DTSCS71
01435       UNTIL WRK-SUB > MMAX-NTE-TEXT-MAX.                          DTSCS71
01436                                                                   DTSCS71
01437      IF LCCM-MSG                                                  DTSCS71
01438         GO TO S1000-EXIT.                                         DTSCS71
01439                                                                   DTSCS71
01440      PERFORM S2000-MISC-EDITS THRU S2000-EXIT.                    DTSCS71
01441  S1000-EXIT. EXIT.                                                DTSCS71
01442      EJECT                                                        DTSCS71
01443                                                                   DTSCS71
01444  S1100-EDIT-KEY.                                                  DTSCS71
01445      PERFORM S1101-EMP-NO              THRU S1101-EXIT.           DTSCS71
01446  S1100-EXIT. EXIT.                                                DTSCS71
01447 /*****************************************************************DTSCS71
01448 *                                                                 DTSCS71
01449 ******************************************************************DTSCS71
01450  S1101-EMP-NO.                                                    DTSCS71
01451      MOVE MAP-EMP-NO-AREA            TO L018-S-EMP-NO-AREA.       DTSCS71
01452      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS71
01453                                                                   DTSCS71
01454      IF L018-NO-ENTRY                                             DTSCS71
01455         MOVE EMSG-FIELD-REQUIRED     TO WRK-MSG-AREA              DTSCS71
01456         PERFORM S1199-ERROR          THRU S1199-EXIT              DTSCS71
01457         GO TO S1101-EXIT.                                         DTSCS71
01458                                                                   DTSCS71
01459      IF L018-NOT-VALID                                            DTSCS71
01460         MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA              DTSCS71
01461         PERFORM S1199-ERROR          THRU S1199-EXIT              DTSCS71
01462         GO TO S1101-EXIT.                                         DTSCS71
01463                                                                   DTSCS71
01464      MOVE L018-EMP-NO                TO WRK-EMP-NO.               DTSCS71
01465      PERFORM S1110-READ-MPRF THRU S1110-EXIT.                     DTSCS71
01466  S1101-EXIT. EXIT.                                                DTSCS71
01467                                                                   DTSCS71
01468  S1110-READ-MPRF.                                                 DTSCS71
01469      MOVE LOW-VALUES     TO MPRF-KEY-AREA.                        DTSCS71
01470      MOVE WRK-EMP-NO     TO MPRF-EMP-NO.                          DTSCS71
01471      SET MPRF-PRF-88     TO TRUE.                                 DTSCS71
01472      MOVE MPRF-KEY-AREA  TO MSKL-KEY-AREA.                        DTSCS71
01473      PERFORM S810-READ   THRU S810-EXIT.                          DTSCS71
01474      IF L810-NO-REC-88                                            DTSCS71
01475          MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA                    DTSCS71
01476          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS71
01477      ELSE                                                         DTSCS71
01478          MOVE MSKL-REC TO MPRF-REC                                DTSCS71
01479          SET WRK-MPRF-YES-88 TO TRUE.                             DTSCS71
01480  S1110-EXIT.                                                      DTSCS71
01481      EXIT.                                                        DTSCS71
01482                                                                   DTSCS71
01483  S1199-ERROR.                                                     DTSCS71
01484      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A            DTSCS71
01485                                         MAP-EMP-NO-2-A.           DTSCS71
01486      IF LCCM-NO-MSG                                               DTSCS71
01487         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS71
01488         MOVE CATB-CURSOR             TO MAP-EMP-NO-1-L            DTSCS71
01489         SET CURSOR-SET-YES TO TRUE.                               DTSCS71
01490  S1199-EXIT. EXIT.                                                DTSCS71
01491                                                                   DTSCS71
01492 /*****************************************************************DTSCS71
01493 *                                                                *DTSCS71
01494 ******************************************************************DTSCS71
01495  S1200-SUBJECT.                                                   DTSCS71
01496      IF MAP-SUBJECT EQUAL LOW-VALUES OR SPACES                    DTSCS71
01497         MOVE SPACES TO MAP-SUBJECT.                               DTSCS71
01498  S1200-EXIT. EXIT.                                                DTSCS71
01499                                                                   DTSCS71
01500 *S1201-ERROR.                                                     DTSCS71
01501 *    MOVE CATB-UNPROT-NORM-AN-MDTON                               DTSCS71
01502 *                                    TO MAP-SUBJECT-A.            DTSCS71
01503 *    IF LCCM-NO-MSG                                               DTSCS71
01504 *       MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS71
01505 *       MOVE CATB-CURSOR             TO MAP-SUBJECT-L             DTSCS71
01506 *       SET CURSOR-SET-YES TO TRUE.                               DTSCS71
01507 *S1201-EXIT. EXIT.                                                DTSCS71
01508 /*****************************************************************DTSCS71
01509 *                                                                *DTSCS71
01510 ******************************************************************DTSCS71
01511  S1300-PRIORITY.                                                  DTSCS71
01512      IF MAP-PRIORITY EQUAL LOW-VALUES OR SPACES                   DTSCS71
01513         MOVE 'N' TO MAP-PRIORITY                                  DTSCS71
01514      ELSE                                                         DTSCS71
01515      IF MAP-PRIORITY-YES   OR MAP-PRIORITY-NO                     DTSCS71
01516         IF MAP-PRIORITY-YES                                       DTSCS71
01517            PERFORM S1305-CHECK-FOR-OTHER THRU S1305-EXIT          DTSCS71
01518         END-IF                                                    DTSCS71
01519      ELSE                                                         DTSCS71
01520         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS71
01521         PERFORM S1301-ERROR THRU S1301-EXIT.                      DTSCS71
01522  S1300-EXIT.                                                      DTSCS71
01523      EXIT.                                                        DTSCS71
01524                                                                   DTSCS71
01525  S1301-ERROR.                                                     DTSCS71
01526      IF LCCM-F10-88                                               DTSCS71
01527          MOVE CATB-ASKIP-NORM-MDTON TO  MAP-PRIORITY-A            DTSCS71
01528      ELSE                                                         DTSCS71
01529          MOVE CATB-UNPROT-NORM-AN-MDTON                           DTSCS71
01530                                      TO MAP-PRIORITY-A            DTSCS71
01531      IF LCCM-NO-MSG                                               DTSCS71
01532         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS71
01533         MOVE CATB-CURSOR             TO MAP-PRIORITY-L            DTSCS71
01534         SET CURSOR-SET-YES TO TRUE.                               DTSCS71
01535  S1301-EXIT. EXIT.                                                DTSCS71
01536                                                                   DTSCS71
01537  S1305-CHECK-FOR-OTHER.                                           DTSCS71
01538                                                                   DTSCS71
01539      MOVE LOW-VALUES               TO MNTE-KEY-AREA.              DTSCS71
01540      MOVE WRK-EMP-NO               TO MNTE-EMP-NO.                DTSCS71
01541      SET MNTE-NTE-88               TO TRUE.                       DTSCS71
01542      MOVE WRK-PRIORITY-ABSTIME-LIT TO MNTE-KEY-ESTB-ABSTIME.      DTSCS71
01543                                                                   DTSCS71
01544      MOVE MNTE-KEY-AREA       TO MSKL-KEY-AREA.                   DTSCS71
01545                                                                   DTSCS71
01546      PERFORM S810-READ THRU S810-EXIT.                            DTSCS71
01547                                                                   DTSCS71
01548      IF L810-OK-88                                                DTSCS71
01549         MOVE MSG-E711-AREA TO WRK-MSG-AREA                        DTSCS71
01550         PERFORM S1301-ERROR THRU S1301-EXIT                       DTSCS71
01551      END-IF.                                                      DTSCS71
01552                                                                   DTSCS71
01553  S1305-EXIT. EXIT.                                                DTSCS71
01554 /*****************************************************************DTSCS71
01555 *                                                                *DTSCS71
01556 ******************************************************************DTSCS71
01557  S1400-TEXT.                                                      DTSCS71
01558      INSPECT MAP-TEXT (WRK-SUB)                                   DTSCS71
01559          CONVERTING LOW-VALUES TO SPACES.                         DTSCS71
01560                                                                   DTSCS71
01561      IF MAP-TEXT(WRK-SUB) EQUAL SPACES                            DTSCS71
01562         IF WRK-SUB = 1                                            DTSCS71
01563            MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA               DTSCS71
01564            PERFORM S1401-ERROR THRU S1401-EXIT                    DTSCS71
01565         ELSE                                                      DTSCS71
01566            NEXT SENTENCE.                                         DTSCS71
01567  S1400-EXIT. EXIT.                                                DTSCS71
01568                                                                   DTSCS71
01569  S1401-ERROR.                                                     DTSCS71
01570      MOVE CATB-UNPROT-NORM-AN-MDTON                               DTSCS71
01571                                      TO MAP-TEXT-A(WRK-SUB).      DTSCS71
01572      IF LCCM-NO-MSG                                               DTSCS71
01573         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS71
01574         MOVE CATB-CURSOR             TO MAP-TEXT-L(WRK-SUB)       DTSCS71
01575         SET CURSOR-SET-YES TO TRUE.                               DTSCS71
01576  S1401-EXIT. EXIT.                                                DTSCS71
01577                                                                   DTSCS71
01578 /*****************************************************************DTSCS71
01579 *                                                                *DTSCS71
01580 ******************************************************************DTSCS71
01581  S2000-MISC-EDITS.                                                DTSCS71
01582  S2000-EXIT. EXIT.                                                DTSCS71
01583                                                                   DTSCS71
01584 /*****************************************************************DTSCS71
01585 * LOCK SCREEN FOR UPDATE CONFIRMATION                            *DTSCS71
01586 ******************************************************************DTSCS71
01587  S5100-SET-LOCK-ATTRB.                                            DTSCS71
01588      MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN                      DTSCS71
01589                                 WRK-ATB-NUM.                      DTSCS71
01590                                                                   DTSCS71
01591      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS71
01592                                                                   DTSCS71
01593      MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A                  DTSCS71
01594                                 MAP-EMP-NO-2-A                    DTSCS71
01595                                 MAP-GOTO-A.                       DTSCS71
01596  S5100-EXIT.                                                      DTSCS71
01597      EXIT.                                                        DTSCS71
01598                                                                   DTSCS71
01599 ******************************************************************DTSCS71
01600 * SET ATTIBUTE BYTES FOR UPDATE ACCESS                           *DTSCS71
01601 ******************************************************************DTSCS71
01602  S5200-SET-UPDATE-ATTRB.                                          DTSCS71
01603      MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN.                 DTSCS71
01604      MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM.               DTSCS71
01605                                                                   DTSCS71
01606      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS71
01607                                                                   DTSCS71
01608      IF LCCM-SCR-INQUIRE                                          DTSCS71
01609          MOVE CATB-ASKIP-BRT-MDTON TO MAP-PRIORITY-A              DTSCS71
01610      END-IF.                                                      DTSCS71
01611  S5200-EXIT.                                                      DTSCS71
01612      EXIT.                                                        DTSCS71
01613                                                                   DTSCS71
01614 ******************************************************************DTSCS71
01615 *  SET ATTRIBUTE BYTES FOR INQUIRY STATUS                        *DTSCS71
01616 ******************************************************************DTSCS71
01617  S5300-SET-INQ-ATTRB.                                             DTSCS71
01618      MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN                     DTSCS71
01619                                    WRK-ATB-NUM.                   DTSCS71
01620                                                                   DTSCS71
01621      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS71
01622  S5300-EXIT.                                                      DTSCS71
01623      EXIT.                                                        DTSCS71
01624                                                                   DTSCS71
01625  S5900-SET-ATTRB.                                                 DTSCS71
01626      MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A             DTSCS71
01627                                        MAP-EMP-NO-2-A.            DTSCS71
01628      MOVE WRK-ATB-AN TO                                           DTSCS71
01629                  MAP-PRIORITY-A                                   DTSCS71
01630                  MAP-SUBJECT-A.                                   DTSCS71
01631                                                                   DTSCS71
01632      PERFORM                                                      DTSCS71
01633         VARYING WRK-SUB FROM 1 BY 1                               DTSCS71
01634            UNTIL WRK-SUB > MMAX-NTE-TEXT-MAX                      DTSCS71
01635               MOVE WRK-ATB-AN                                     DTSCS71
01636                 TO MAP-TEXT-A(WRK-SUB)                            DTSCS71
01637               MOVE WRK-COLON TO MAP-COLON(WRK-SUB)                DTSCS71
01638               MOVE CATB-ASKIP-NORM-MDTOFF TO MAP-COLON-A(WRK-SUB) DTSCS71
01639      END-PERFORM.                                                 DTSCS71
01640                                                                   DTSCS71
01641      MOVE CATB-ASKIP-BRT-MDTON TO                                 DTSCS71
01642                               MAP-PRIMARY-NAME-A                  DTSCS71
01643                               MAP-CURR-PAGE-A                     DTSCS71
01644                               MAP-LAST-PAGE-A                     DTSCS71
01645                               MAP-CHNG-DATE-A                     DTSCS71
01646                               MAP-CHNG-OP-ID-A                    DTSCS71
01647                               MAP-ESTB-DATE-A                     DTSCS71
01648                               MAP-ESTB-OP-ID-A.                   DTSCS71
01649                                                                   DTSCS71
01650      MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A.                 DTSCS71
01651  S5900-EXIT.                                                      DTSCS71
01652      EXIT.                                                        DTSCS71
01653      EJECT                                                        DTSCS71
01654 /*****************************************************************DTSCS71
01655 * MAP ROUTINES                                                   *DTSCS71
01656 ******************************************************************DTSCS71
01657  S9100-RECEIVE.                                                   DTSCS71
01658      SET L851-RECEIVE-88 TO TRUE.                                 DTSCS71
01659                                                                   DTSCS71
01660      MOVE WRK-SCR-ID TO L851-SCR-ID.                              DTSCS71
01661                                                                   DTSCS71
01662      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS71
01663                                                                   DTSCS71
01664      MOVE L851-AID TO LCCM-AID.                                   DTSCS71
01665      MOVE L851-CURSOR TO LCCM-CURSOR.                             DTSCS71
01666  S9100-EXIT.                                                      DTSCS71
01667      EXIT.                                                        DTSCS71
01668                                                                   DTSCS71
01669  S9200-SEND-DATAONLY.                                             DTSCS71
01670      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS71
01671                                                                   DTSCS71
01672      IF LCCM-NO-MSG                                               DTSCS71
01673          NEXT SENTENCE                                            DTSCS71
01674      ELSE                                                         DTSCS71
01675          PERFORM S805-MSG-AREA THRU S805-EXIT.                    DTSCS71
01676                                                                   DTSCS71
01677      IF CURSOR-SET-GOTO                                           DTSCS71
01678          MOVE CATB-CURSOR TO MAP-GOTO-L                           DTSCS71
01679      ELSE                                                         DTSCS71
01680          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCS71
01681                                                                   DTSCS71
01682      SET L851-SEND-DATAONLY-88 TO TRUE.                           DTSCS71
01683                                                                   DTSCS71
01684      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS71
01685                                                                   DTSCS71
01686      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS71
01687  S9200-EXIT.                                                      DTSCS71
01688      EXIT.                                                        DTSCS71
01689                                                                   DTSCS71
01690  S9300-SEND-MAP.                                                  DTSCS71
01691      MOVE  LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE.             DTSCS71
01692      MOVE  SPACES TO MAP-SYS-TIME.                                DTSCS71
01693      MOVE  LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME.             DTSCS71
01694      MOVE  LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME.         DTSCS71
01695                                                                   DTSCS71
01696      IF SCR-ACCESS-UPDATE                                         DTSCS71
01697          PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT               DTSCS71
01698      ELSE                                                         DTSCS71
01699          PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.             DTSCS71
01700                                                                   DTSCS71
01701      PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT.                   DTSCS71
01702                                                                   DTSCS71
01703      PERFORM S805-MSG-AREA THRU S805-EXIT.                        DTSCS71
01704                                                                   DTSCS71
01705      IF CURSOR-SET-NO                                             DTSCS71
01706          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCS71
01707                                                                   DTSCS71
01708      SET L851-SEND-88 TO TRUE.                                    DTSCS71
01709                                                                   DTSCS71
01710      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS71
01711                                                                   DTSCS71
01712      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS71
01713  S9300-EXIT.                                                      DTSCS71
01714      EXIT.                                                        DTSCS71
01715                                                                   DTSCS71
01716  S9310-UPDATE-FKEYS.                                              DTSCS71
01717      PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.                 DTSCS71
01718                                                                   DTSCS71
01719                                                                   DTSCS71
01720      IF LCCM-SCR-CLEAR                                            DTSCS71
01721          MOVE CFKD-ADD TO MAP-KEY-ADD                             DTSCS71
01722      ELSE                                                         DTSCS71
01723      IF LCCM-SCR-INQUIRE                                          DTSCS71
01724          MOVE CFKD-MOD TO MAP-KEY-MOD                             DTSCS71
01725 *&       MOVE CFKD-DEL TO MAP-KEY-DEL                             DTSCS71
01726      ELSE                                                         DTSCS71
01727      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS71
01728          MOVE LOW-VALUES TO MAP-KEY-FIRST                         DTSCS71
01729                             MAP-KEY-LAST                          DTSCS71
01730                             MAP-KEY-BACK                          DTSCS71
01731                             MAP-KEY-FWRD.                         DTSCS71
01732  S9310-EXIT.                                                      DTSCS71
01733      EXIT.                                                        DTSCS71
01734                                                                   DTSCS71
01735  S9320-INQUIRY-FKEYS.                                             DTSCS71
01736      MOVE CFKD-FIRST     TO MAP-KEY-FIRST.                        DTSCS71
01737      MOVE CFKD-LAST      TO MAP-KEY-LAST.                         DTSCS71
01738      MOVE CFKD-BACKWARD  TO MAP-KEY-BACK.                         DTSCS71
01739      MOVE CFKD-FORWARD   TO MAP-KEY-FWRD.                         DTSCS71
01740                                                                   DTSCS71
01741      MOVE LOW-VALUES TO MAP-KEY-ADD                               DTSCS71
01742                         MAP-KEY-MOD                               DTSCS71
01743                         MAP-KEY-DEL.                              DTSCS71
01744                                                                   DTSCS71
01745  S9320-EXIT.                                                      DTSCS71
01746      EXIT.                                                        DTSCS71
01747                                                                   DTSCS71
01748  S9330-DSCR-FIELDS.                                               DTSCS71
01749      IF WRK-MPRF-YES-88                                           DTSCS71
01750          MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME               DTSCS71
01751      END-IF.                                                      DTSCS71
01752                                                                   DTSCS71
01753      IF MAP-ESTB-OP-ID = LOW-VALUES OR SPACES                     DTSCS71
01754          MOVE LOW-VALUES TO MAP-ESTB-OP-ID-DESC                   DTSCS71
01755      ELSE                                                         DTSCS71
01756      IF MAP-ESTB-OP-ID = LCCM-OP-ID                               DTSCS71
01757          MOVE LCCM-OP-NAME TO MAP-ESTB-OP-ID-DESC                 DTSCS71
01758      ELSE                                                         DTSCS71
01759          MOVE MAP-ESTB-OP-ID TO L082-OP-ID                        DTSCS71
01760          PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT                 DTSCS71
01761          MOVE L082-NAME TO MAP-ESTB-OP-ID-DESC.                   DTSCS71
01762                                                                   DTSCS71
01763      IF MAP-CHNG-OP-ID = LOW-VALUES OR SPACES                     DTSCS71
01764          MOVE LOW-VALUES TO MAP-CHNG-OP-ID-DESC                   DTSCS71
01765      ELSE                                                         DTSCS71
01766      IF MAP-CHNG-OP-ID = LCCM-OP-ID                               DTSCS71
01767          MOVE LCCM-OP-NAME TO MAP-CHNG-OP-ID-DESC                 DTSCS71
01768      ELSE                                                         DTSCS71
01769          MOVE MAP-CHNG-OP-ID TO L082-OP-ID                        DTSCS71
01770          PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT                 DTSCS71
01771          MOVE L082-NAME TO MAP-CHNG-OP-ID-DESC.                   DTSCS71
01772                                                                   DTSCS71
01773  S9330-EXIT. EXIT.                                                DTSCS71
01774                                                                   DTSCS71
01775  S9900-PREPARE-SEND.                                              DTSCS71
01776      MOVE WRK-SCR-ID TO L851-SCR-ID                               DTSCS71
01777                         LCCM-SCR-ID.                              DTSCS71
01778      MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND.                    DTSCS71
01779      MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE.                         DTSCS71
01780  S9900-EXIT.                                                      DTSCS71
01781      EXIT.                                                        DTSCS71
