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