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