00001  IDENTIFICATION DIVISION.                                         12/09/04
00002  PROGRAM-ID.             DTSCS35.                                 DTSCS35
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV008
00004  DATE-WRITTEN.           JUNE 1994.                               DTSCS35
00005  DATE-COMPILED.                                                   DTSCS35
00006                                                                   DTSCS35
00007 *****                                                             DTSCS35
00008 *                                                                 DTSCS35
00009 *    FUNCTION:  ADJUSTMENT INQUIRY SCREEN PROCESSOR.              DTSCS35
00010 *                                                                 DTSCS35
00011 *                                                                 DTSCS35
00012 *    MODIFICATION LOG:                                            DTSCS35
00013 *                                                                 DTSCS35
00014 *    12/28/98  INITIAL DEVELOPMENT           COPIED FROM MACCS35  DTSCS35
00015 *              WORK ORDER:                      PROGRAMMER: ZL1   DTSCS35
00016 *                                                                 DTSCS35
00017 *    05/18/1999  PICKUP MODIFICATIONS.                            DTSCS35
00018 *                REFERENCE: PICKUP DIR          PROGRAMMER: EHH   DTSCS35
00019 *                                                                 DTSCS35
00020 *    08/13/1999  CHANGED MISCELLANEOUS AREA LABELS FROM 'ASTR'    DTSCS35
00021 *                TO 'WSTR' AND FROM 'AEND' TO 'WEND', PER DC      DTSCS35
00022 *                SPECIFICATIONS.  OVER LOOKED DURING INITIAL      DTSCS35
00023 *                DEVELOPMENT (FROM MT CODE).                      DTSCS35
00024 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSCS35
00025 *                                                                 DTSCS35
00026 *    04/29/2004  CHANGED MISCELLANEOUS AREA TO DISPLAY CMPRMISE   DTSCS35
00027 *                WHEN CMP-ESTB-ABSTIME > ZERO                     DTSCS35
00028 *                REFERENCE: COMP SETELEMENT     PROGRAMMER: ZL1   DTSCS35
00029 *                                                                 DTSCS35
00030 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS35
00031 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS35
00032 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSCS35
00033 *                                                                 DTSCS35
00034 *                                                                 DTSCS35
00035 *  DESCRIPTION:                                                   DTSCS35
00036 *                                                                 DTSCS35
00037 *    CLEAR:                                                       DTSCS35
00038 *                                                                 DTSCS35
00039 *      FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO).            DTSCS35
00040 *                                                                 DTSCS35
00041 *                                                                 DTSCS35
00042 *    JUMP:                                                        DTSCS35
00043 *                                                                 DTSCS35
00044 *      F09  QUARTER INQUIRY (31).                                 DTSCS35
00045 *      F10  REPORT INQUIRY (33).                                  DTSCS35
00046 *      F11  PAYMENT INQUIRY (34).                                 DTSCS35
00047 *                                                                 DTSCS35
00048 *                                                                 DTSCS35
00049 *    INQUIRY:                                                     DTSCS35
00050 *                                                                 DTSCS35
00051 *      CONTROL FIELD(S): MAP-EMP-NO                               DTSCS35
00052 *                        MAP-YRQ.                                 DTSCS35
00053 *                                                                 DTSCS35
00054 *                                                                 DTSCS35
00055 *      JUMP IN:  IF LCCM-EMP-NO = LCCM-SCR35-HOLD-AREA  EMP-NO    DTSCS35
00056 *                    IF LCCM-YRQ = LCCM-SCR35-HOLD-AREA  YRQ      DTSCS35
00057 *                        DISPLAY THE PAGE INDICATED IN            DTSCS35
00058 *                        LCCM-SCR35-HOLD-AREA                     DTSCS35
00059 *                    ELSE                                         DTSCS35
00060 *                        IF LCCM-YRQ = 0                          DTSCS35
00061 *                            DISPLAY PAGE 1 OF "ALL QUARTERS"     DTSCS35
00062 *                        ELSE                                     DTSCS35
00063 *                            DISPLAY PAGE 1 OF "LCCM-YRQ"         DTSCS35
00064 *                ELSE                                             DTSCS35
00065 *                IF LCCM-EMP-NO = 0                               DTSCS35
00066 *                    DISPLAY 'PLEASE ENTER' MESSAGE               DTSCS35
00067 *                ELSE                                             DTSCS35
00068 *                    IF LCCM-YRQ = 0                              DTSCS35
00069 *                        DISPLAY PAGE 1 OF "ALL QUARTERS"         DTSCS35
00070 *                    ELSE                                         DTSCS35
00071 *                        DISPLAY PAGE 1 OF "LCCM-YRQ".            DTSCS35
00072 *                                                                 DTSCS35
00073 *                                                                 DTSCS35
00074 *      ENTER, F05, F06, F07, F08:                                 DTSCS35
00075 *                                                                 DTSCS35
00076 *               DISPLAY SEQUENCE: SEE SCREEN DESCRIPTION.         DTSCS35
00077 *                                                                 DTSCS35
00078 *       PAGE INITIALLY DISPLAYED: FIRST.                          DTSCS35
00079 *                                                                 DTSCS35
00080 *                                                                 DTSCS35
00081 *      CONSTRUCTION OF THE PAGES IS SO COMPLEX THAT IT            DTSCS35
00082 *      WILL PROBABLY BE NECESSARY TO CONSTRUCT PAGES              DTSCS35
00083 *      OF INFORMATION IN TS Q 'S'.                                DTSCS35
00084 *                                                                 DTSCS35
00085 *                                                                 DTSCS35
00086 *      JUMP OUT:  STORE INFORMATION REPRESENTING PAGE             DTSCS35
00087 *                 CURRENTLY DISPLAYED IN LCCM-SCR35-HOLD-AREA.    DTSCS35
00088 *                                                                 DTSCS35
00089 *                 DELETE TEMPORARY STORAGE QUEUE 'S'.             DTSCS35
00090 *                                                                 DTSCS35
00091 *                                                                 DTSCS35
00092 *    LCCM-MISC-CONTROL-AREA MAINTENANCE:                          DTSCS35
00093 *                                                                 DTSCS35
00094 *      LCCM-EMP-NO                                                DTSCS35
00095 *                                                                 DTSCS35
00096 *      LCCM-YRQ                                                   DTSCS35
00097 *                                                                 DTSCS35
00098 *                                                                 DTSCS35
00099 *    UPDATE:                                                      DTSCS35
00100 *                                                                 DTSCS35
00101 *      NONE.                                                      DTSCS35
00102 *                                                                 DTSCS35
00103 *                                                                 DTSCS35
00104 *    RECORDS READ:                                                DTSCS35
00105 *                                                                 DTSCS35
00106 *      MASTER:                                                    DTSCS35
00107 *                                                                 DTSCS35
00108 *        MPRF                                                     DTSCS35
00109 *        MADJ                                                     DTSCS35
00110 *                                                                 DTSCS35
00111 *                                                                 DTSCS35
00112 *      ALTERNATE INDEX:                                           DTSCS35
00113 *                                                                 DTSCS35
00114 *        NONE.                                                    DTSCS35
00115 *                                                                 DTSCS35
00116 *                                                                 DTSCS35
00117 *      REFERENCE:                                                 DTSCS35
00118 *                                                                 DTSCS35
00119 *        NONE.                                                    DTSCS35
00120 *                                                                 DTSCS35
00121 *                                                                 DTSCS35
00122 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS35
00123 *                                                                 DTSCS35
00124 *        NONE.                                                    DTSCS35
00125 *                                                                 DTSCS35
00126 *                                                                 DTSCS35
00127 *    RECORDS UPDATED:                                             DTSCS35
00128 *                                                                 DTSCS35
00129 *      MASTER:                                                    DTSCS35
00130 *                                                                 DTSCS35
00131 *        NONE.                                                    DTSCS35
00132 *                                                                 DTSCS35
00133 *                                                                 DTSCS35
00134 *      REFERENCE:                                                 DTSCS35
00135 *                                                                 DTSCS35
00136 *        NONE.                                                    DTSCS35
00137 *                                                                 DTSCS35
00138 *                                                                 DTSCS35
00139 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS35
00140 *                                                                 DTSCS35
00141 *        NONE.                                                    DTSCS35
00142 *                                                                 DTSCS35
00143 *                                                                 DTSCS35
00144 *    ON-LINE ACTIVITY FILE RECORDS WRITTEN:                       DTSCS35
00145 *                                                                 DTSCS35
00146 *      NONE.                                                      DTSCS35
00147 *                                                                 DTSCS35
00148 *                                                                 DTSCS35
00149 *    TEMPORARY STORAGE USAGE:                                     DTSCS35
00150 *                                                                 DTSCS35
00151 *      S  IF NECESSARY FOR PAGE CONSTRUCTION/CONTROL.             DTSCS35
00152 *                                                                 DTSCS35
00153 *                                                                 DTSCS35
00154 *    MODULES LINKED TO:                                           DTSCS35
00155 *                                                                 DTSCS35
00156 *      DTSCU001  DATE EDIT/CONVERSION.                            DTSCS35
00157 *      DTSCU004  QUARTER EDIT/CONVERSION.                         DTSCS35
00158 *      DTSCU029  YEAR/QUARTER FROM SCREEN FORMAT/EDIT.            DTSCS35
00159 *      DTSCU018  EMPLOYER NUMBER FROM SCREEN FORMAT/EDIT.         DTSCS35
00160 *      DTSCU056  RATE DISPLAY.                                    DTSCS35
00161 *      DTSCU810  MASTER FILE INPUT/OUTPUT.                        DTSCS35
00162 *      DTSCU829  TEMPORARY STORAGE INPUT/OUTPUT.                  DTSCS35
00163 *                                                                 DTSCS35
00164 *                                                                 DTSCS35
00165 *    VERMONT REFERENCE:                                           DTSCS35
00166 *                                                                 DTSCS35
00167 *      TXC230C.                                                   DTSCS35
00168 *                                                                 DTSCS35
00169 *                                                                 DTSCS35
00170 *  NOTES FOR JEFF:                                                DTSCS35
00171 *                                                                 DTSCS35
00172 *    .  PLEASE CLONE MACCS35 FROM MACCS33.  OBVIOUSLY, MACCS33    DTSCS35
00173 *       IS "COLUMN" ORIENTED WHILE MACCS35 IS "ROW" ORIENTED,     DTSCS35
00174 *       BUT THAT IS A MINOR CHANGE.                               DTSCS35
00175 *                                                                 DTSCS35
00176 *                                                                 DTSCS35
00177 *    .  AFTER YOU DETERMINE THE LENGTH OF "PAGE-AREA", YOU WILL   DTSCS35
00178 *       BE ABLE TO DETERMINE THE NUMBER OF LCCM-SCR-HOLD-PAGE     DTSCS35
00179 *       AREA OCCURRENCES.                                         DTSCS35
00180 *                                                                 DTSCS35
00181 *                                                                 DTSCS35
00182 *    .  THE P7000 LOGIC IN MACCS35 SHOULD BE SIMPLER THAN IN      DTSCS35
00183 *       MACCS33.  SCREEN 35 SPECIFICATIONS STATES "SEQUENCE OF    DTSCS35
00184 *       DISPLAY IS DESCENDING ON "DOCUMENT"".  THUS, YOU NEED     DTSCS35
00185 *       ONLY DO A L810-COUNT-88 TO FIND THE THE KEY OF THE LAST   DTSCS35
00186 *       MADJ AND THEN DO A START BROWSE/READ PREV TO POSITION     DTSCS35
00187 *       YOURSELF.  THEN READ PREVS WILL DO THE TRICK.             DTSCS35
00188 *                                                                 DTSCS35
00189 *                                                                 DTSCS35
00190 *    .  SCREEN 35 SCREEN DESCRIPTION STATES THAT "IF A VALUE IS   DTSCS35
00191 *       ENTERED IN YR/Q, THEN ONLY ADJUSTMENT TRANSACTIONS FOR    DTSCS35
00192 *       THE SPECIFIED QUARTER ARE DISPLAYED".  THIS JUST MEANS    DTSCS35
00193 *       THAT IF WRK-YRQ IS NOT EQUAL TO ZER, THEN THE DISPLAY     DTSCS35
00194 *       IS LIMITED TO THOSE MADJ RECORDS WITH MADJ-APPLIC-YRQ     DTSCS35
00195 *       EQUAL TO WRK-YRQ.                                         DTSCS35
00196 *                                                                 DTSCS35
00197 *                                                                 DTSCS35
00198 *    .  A GIVEN MADJ RECORD MAY OCCUPY MORE THAN ONE (ACTUALLY    DTSCS35
00199 *       UP TO FOUR LINES) ON THE SCREEN.  SEE THE DESCRIPTION     DTSCS35
00200 *       OF THE "MISCELLANEOUS" AREA (DISPLAYED ON THE RIGHT       DTSCS35
00201 *       SIDE OF THE SCREEN).  DISPLAY A FOUR CHARACTER "LABEL"    DTSCS35
00202 *       (DESCRIBING THE DATA ELEMENT BEING DISPLAYED IN THIS      DTSCS35
00203 *       LINES "MISCELLANEOUS") AREA AND DISPLAY THE DATA          DTSCS35
00204 *       ELEMENT VALUE.  SCR35.DSC LISTS THE "LABELS" TO BE        DTSCS35
00205 *       USED.                                                     DTSCS35
00206 *                                                                 DTSCS35
00207 *                                                                 DTSCS35
00208 *    .  WHEN MORE THAN ONE LINE OF "MISCELLANEOUS" DATA IS        DTSCS35
00209 *       DISPLAYED FOR ONE MADJ RECORD, PLEASE "GROUP INDICATE"    DTSCS35
00210 *       THE INFORMATION DISPLAYED TO THE LEFT OF THE              DTSCS35
00211 *       "MISCELLANEOUS" DATA.                                     DTSCS35
00212 *                                                                 DTSCS35
00213 *                                                                 DTSCS35
00214 *****                                                             DTSCS35
00215  ENVIRONMENT DIVISION.                                            DTSCS35
00216                                                                   DTSCS35
00217  DATA DIVISION.                                                   DTSCS35
00218                                                                   DTSCS35
00219  WORKING-STORAGE SECTION.                                         DTSCS35
002195 77  PAN-VALET PICTURE X(24) VALUE '008DTSCS35   12/09/04'.       DTSCS35
00220                                                                   DTSCS35
00221  01  WRK-AREA.                                                    DTSCS35
00222      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'S35 '.    DTSCS35
00223                                                                   DTSCS35
00224      05  WRK-SCR-ID.                                              DTSCS35
00225          10  WRK-SCR-ID-N            PIC  9(02)  VALUE 35.        DTSCS35
00226                                                                   DTSCS35
00227      05  WRK-F03-SCR-ID              PIC  X(02)  VALUE '30'.      DTSCS35
00228                                                                   DTSCS35
00229      05  ROWS-PER-PAGE               PIC S9(04)  COMP  VALUE +16. DTSCS35
00230                                                                   DTSCS35
00231      05  ALL-NINES-YRQ               PIC S9(05)  COMP-3           DTSCS35
00232                                                  VALUE +99999.    DTSCS35
00233                                                                   DTSCS35
00234      05  SCR-ACCESS-IND              PIC X(01).                   DTSCS35
00235          88  SCR-ACCESS-INQ                  VALUE '1'.           DTSCS35
00236          88  SCR-ACCESS-UPDATE               VALUE '2'.           DTSCS35
00237                                                                   DTSCS35
00238      05  CURSOR-SET-IND              PIC X(01).                   DTSCS35
00239          88  CURSOR-SET-YES                  VALUE 'Y'.           DTSCS35
00240          88  CURSOR-SET-NO                   VALUE 'N'.           DTSCS35
00241          88  CURSOR-SET-GOTO                 VALUE 'G'.           DTSCS35
00242                                                                   DTSCS35
00243      05  REQ-IND                     PIC X(01).                   DTSCS35
00244          88  REQ-ERROR                       VALUE 'O'.           DTSCS35
00245          88  REQ-JUMP                        VALUE 'J'.           DTSCS35
00246          88  REQ-INQUIRE                     VALUE 'I'.           DTSCS35
00247          88  REQ-CLEAR                       VALUE 'C'.           DTSCS35
00248          88  REQ-CURSOR-TO-GOTO              VALUE 'G'.           DTSCS35
00249                                                                   DTSCS35
00250      05  RESP-IND                    PIC X(01).                   DTSCS35
00251          88  RESP-SEND-MSGONLY               VALUE 'O'.           DTSCS35
00252          88  RESP-SEND-MAP                   VALUE 'M'.           DTSCS35
00253          88  RESP-JUMP                       VALUE 'J'.           DTSCS35
00254          88  RESP-CURSOR-TO-GOTO             VALUE 'G'.           DTSCS35
00255                                                                   DTSCS35
00256      05  WRK-MSG-AREA                PIC  X(64).                  DTSCS35
00257                                                                   DTSCS35
00258      05  WRK-ATB-AN                  PIC  X(01).                  DTSCS35
00259      05  WRK-ATB-NUM                 PIC  X(01).                  DTSCS35
00260                                                                   DTSCS35
00261      05  WRK-EMP-NO                  PIC S9(07)  COMP-3.          DTSCS35
00262                                                                   DTSCS35
00263      05  WRK-MPRF-IND                PIC  X(01).                  DTSCS35
00264          88  WRK-MPRF-YES-88                VALUE 'Y'.            DTSCS35
00265          88  WRK-MPRF-NO-88                 VALUE 'N'.            DTSCS35
00266                                                                   DTSCS35
00267      05  WRK-YRQ                     PIC S9(05)  COMP-3.          DTSCS35
00268                                                                   DTSCS35
00269      05  PROCESS-YRQ                 PIC S9(05)  COMP-3.          DTSCS35
00270                                                                   DTSCS35
00271      05  WRK-DISPLAY                 PIC 9(11).                   DTSCS35
00272                                                                   DTSCS35
00273      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS35
00274          10  FILLER                  PIC X(05).                   DTSCS35
00275          10  WRK-DISPLAY-EMP-NO-1    PIC X(03).                   DTSCS35
00276          10  WRK-DISPLAY-EMP-NO-2    PIC X(03).                   DTSCS35
00277                                                                   DTSCS35
00278      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS35
00279          10  FILLER                  PIC X(08).                   DTSCS35
00280          10  WRK-DISPLAY-YRQ-YR      PIC X(02).                   DTSCS35
00281          10  WRK-DISPLAY-YRQ-Q       PIC X(01).                   DTSCS35
00282                                                                   DTSCS35
00283      05  ROW-OCC                     PIC S9(04)  COMP.            DTSCS35
00284                                                                   DTSCS35
00285      05  SCR-HOLD-AREA.                                           DTSCS35
00286          10  SCR-HOLD-EMP-NO         PIC S9(07)  COMP-3.          DTSCS35
00287          10  SCR-HOLD-YRQ            PIC S9(05)  COMP-3.          DTSCS35
00288          10  SCR-HOLD-CURR-PAGE-NUM  PIC S9(04)  COMP.            DTSCS35
00289                                                                   DTSCS35
00290      05  INQUIRY-CONTROL-AREA.                                    DTSCS35
00291          10  ITEM-LENGTH         PIC S9(04)  COMP VALUE +722.     DTSCS35
00292                                                                   DTSCS35
00293          10  ITEM-MAX            PIC S9(05)  COMP VALUE +32760.   DTSCS35
00294                                                                   DTSCS35
00295          10  ITEM-MAX-LCCM       PIC S9(04)  COMP VALUE +2.       DTSCS35
00296                                                                   DTSCS35
00297          10  CURR-PAGE-NUM       PIC S9(04)  COMP.                DTSCS35
00298                                                                   DTSCS35
00299          10  ITEM-SUB            PIC S9(04)  COMP.                DTSCS35
00300                                                                   DTSCS35
00301          10  ITEM-CNT            PIC S9(04)  COMP.                DTSCS35
00302                                                                   DTSCS35
00303 *****                                                             DTSCS35
00304 *                                                                 DTSCS35
00305 *    IF THE LENGTH OF PAGE-AREA IS MODIFIED, THEN MAKE            DTSCS35
00306 *    CORRESPONDING MODIFICATIONS TO ITEM-LENGTH, L829-REC,        DTSCS35
00307 *    AND LCCM-SCR-HOLD-PAGE-AREA.                                 DTSCS35
00308 *                                                                 DTSCS35
00309 *****                                                             DTSCS35
00310                                                                   DTSCS35
00311      05  PAGE-AREA               PIC  X(722).                     DTSCS35
00312                                                                   DTSCS35
00313      05  FILLER REDEFINES PAGE-AREA.                              DTSCS35
00314          10  PAGE-ROW-CNT        PIC S9(04)  COMP.                DTSCS35
00315                                                                   DTSCS35
00316          10  PAGE-ROW OCCURS 16 TIMES.                            DTSCS35
00317              15  PAGE-ADJ-TYPE            PIC  X(02).             DTSCS35
00318              15  PAGE-DOC-NO.                                     DTSCS35
00319                  20  PAGE-BATCH-NO        PIC S9(05)       COMP-3.DTSCS35
00320                  20  PAGE-ITEM-NO         PIC S9(03)       COMP-3.DTSCS35
00321              15  PAGE-AMT                 PIC S9(09)V9(02) COMP-3.DTSCS35
00322              15  PAGE-RECEIVED-DATE       PIC S9(09)       COMP-3.DTSCS35
00323              15  PAGE-PROCESSED-DATE      PIC S9(09)       COMP-3.DTSCS35
00324              15  PAGE-APPLIC-YRQ          PIC S9(05)       COMP-3.DTSCS35
00325              15  PAGE-APPLIC-IND          PIC X(02).              DTSCS35
00326              15  PAGE-APPLIC-DOC-NO.                              DTSCS35
00327                  20  PAGE-APPLIC-BATCH-NO                         DTSCS35
00328                                          PIC S9(05)        COMP-3.DTSCS35
00329                  20  PAGE-APPLIC-ITEM-NO PIC S9(03)        COMP-3.DTSCS35
00330              15  PAGE-MISC-1             PIC  X(04).              DTSCS35
00331              15  PAGE-MISC-2             PIC  X(08).              DTSCS35
00332 *****EJECT                                                        DTSCS35
00333 *01  MSG-LITERALS.                                                DTSCS35
00334 *****05  MSG-E351-AREA.                                           DTSCS35
00335 *****    10  FILLER                  PIC  X(04)  VALUE 'E351'.    DTSCS35
00336 *****    10  FILLER                  PIC  X(30)                   DTSCS35
00337 *****          VALUE '                              '.            DTSCS35
00338 *****    10  FILLER                  PIC  X(30)                   DTSCS35
00339 *****          VALUE '                              '.            DTSCS35
00340      EJECT                                                        DTSCS35
00341  01  L001-COMM-AREA.                                              DTSCS35
00342  ++INCLUDE DTSIL001                                               DTSCS35
00343      EJECT                                                        DTSCS35
00344  01  L004-COMM-AREA.                                              DTSCS35
00345  ++INCLUDE DTSIL004                                               DTSCS35
00346      EJECT                                                        DTSCS35
00347  01  L018-COMM-AREA.                                              DTSCS35
00348  ++INCLUDE DTSIL018                                               DTSCS35
00349      EJECT                                                        DTSCS35
00350  01  L029-COMM-AREA.                                              DTSCS35
00351  ++INCLUDE DTSIL029                                               DTSCS35
00352      EJECT                                                        DTSCS35
00353  01  L056-COMM-AREA.                                              DTSCS35
00354  ++INCLUDE DTSIL056                                               DTSCS35
00355      EJECT                                                        DTSCS35
00356  01  L805-COMM-AREA.                                              DTSCS35
00357  ++INCLUDE DTSIL805                                               DTSCS35
00358      EJECT                                                        DTSCS35
00359  01  L810-COMM-AREA.                                              DTSCS35
00360      05  L810-CONTROL-BLOCK.                                      DTSCS35
00361  ++INCLUDE DTSIL810                                               DTSCS35
00362      EJECT                                                        DTSCS35
00363      05  MSKL-REC.                                                DTSCS35
00364  ++INCLUDE DTSIMSKL                                               DTSCS35
00365      EJECT                                                        DTSCS35
00366  01  MPRF-REC.                                                    DTSCS35
00367  ++INCLUDE DTSIMPRF                                               DTSCS35
00368      EJECT                                                        DTSCS35
00369  01  MADJ-REC.                                                    DTSCS35
00370  ++INCLUDE DTSIMADJ                                               DTSCS35
00371      EJECT                                                        DTSCS35
00372  01  L829-COMM-AREA.                                              DTSCS35
00373      05  L829-CONTROL-BLOCK.                                      DTSCS35
00374  ++INCLUDE DTSIL829                                               DTSCS35
00375                                                                   DTSCS35
00376      05  L829-REC                 PIC  X(722).                    DTSCS35
00377      EJECT                                                        DTSCS35
00378  01  L851-COMM-AREA.                                              DTSCS35
00379  ++INCLUDE DTSIL851                                               DTSCS35
00380                                                                   DTSCS35
00381      05  MAP-AREA REDEFINES L851-MAP-AREA.                        DTSCS35
00382  ++INCLUDE DTSIS35                                                DTSCS35
00383      EJECT                                                        DTSCS35
00384  01  CATB-LITERALS.                                               DTSCS35
00385  ++INCLUDE DTSICATB                                               DTSCS35
00386                                                                   DTSCS35
00387  01  CFKD-LITERALS.                                               DTSCS35
00388  ++INCLUDE DTSICFKD                                               DTSCS35
00389                                                                   DTSCS35
00390  01  CECD-LITERALS.                                               DTSCS35
00391  ++INCLUDE DTSICECD                                               DTSCS35
00392                                                                   DTSCS35
00393  01  CPCD-LITERALS.                                               DTSCS35
00394  ++INCLUDE DTSICPCD                                               DTSCS35
00395      EJECT                                                        DTSCS35
00396  LINKAGE SECTION.                                                 DTSCS35
00397                                                                   DTSCS35
00398  01  DFHCOMMAREA.                                                 DTSCS35
00399  ++INCLUDE DTSILCCM                                               DTSCS35
00400                                                                   DTSCS35
00401              15  FILLER REDEFINES LCCM-SCR-HOLD-AREA.             DTSCS35
00402                  20  LCCM-SCR-HOLD-CONTROL-AREA.                  DTSCS35
00403                      25  LCCM-SCR-HOLD-EMP-NO  PIC S9(07)  COMP-3.DTSCS35
00404                      25  LCCM-SCR-HOLD-YRQ     PIC S9(05)  COMP-3.DTSCS35
00405                      25  LCCM-SCR-HOLD-ABSTIME PIC S9(15)  COMP-3.DTSCS35
00406                      25  LCCM-SCR-HOLD-LAST-PAGE-NUM              DTSCS35
00407                                                PIC S9(04)  COMP.  DTSCS35
00408                  20  LCCM-SCR-HOLD-PAGE-AREA OCCURS 2 TIMES       DTSCS35
00409                                                PIC  X(722).       DTSCS35
00410      EJECT                                                        DTSCS35
00411 ******************************************************************DTSCS35
00412 *                                                                *DTSCS35
00413 ******************************************************************DTSCS35
00414                                                                   DTSCS35
00415  PROCEDURE DIVISION.                                              DTSCS35
00416                                                                   DTSCS35
00417      MOVE +0 TO WRK-EMP-NO.                                       DTSCS35
00418                                                                   DTSCS35
00419      SET WRK-MPRF-NO-88 TO TRUE.                                  DTSCS35
00420                                                                   DTSCS35
00421      MOVE +0 TO WRK-YRQ.                                          DTSCS35
00422                                                                   DTSCS35
00423      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS35
00424                                                                   DTSCS35
00425      SET CURSOR-SET-NO TO TRUE.                                   DTSCS35
00426                                                                   DTSCS35
00427      MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N)                  DTSCS35
00428        TO SCR-ACCESS-IND.                                         DTSCS35
00429                                                                   DTSCS35
00430      MOVE SPACE TO REQ-IND.                                       DTSCS35
00431                                                                   DTSCS35
00432      PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT.               DTSCS35
00433                                                                   DTSCS35
00434 *-----------------------------------------------------            DTSCS35
00435 *    P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE           DTSCS35
00436 *    "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT             DTSCS35
00437 *    REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE             DTSCS35
00438 *    OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED.         DTSCS35
00439 *                                                                 DTSCS35
00440 *    THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE                DTSCS35
00441 *    PROCESSED.                                                   DTSCS35
00442 *                                                                 DTSCS35
00443 *    THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND,         DTSCS35
00444 *    INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE            DTSCS35
00445 *    WORK STATION OPERATOR.                                       DTSCS35
00446 *-----------------------------------------------------            DTSCS35
00447                                                                   DTSCS35
00448      MOVE SPACE TO RESP-IND.                                      DTSCS35
00449                                                                   DTSCS35
00450      IF REQ-ERROR                                                 DTSCS35
00451         PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT               DTSCS35
00452      ELSE                                                         DTSCS35
00453      IF REQ-JUMP                                                  DTSCS35
00454         PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT                DTSCS35
00455      ELSE                                                         DTSCS35
00456      IF REQ-CLEAR                                                 DTSCS35
00457         PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT               DTSCS35
00458      ELSE                                                         DTSCS35
00459      IF REQ-CURSOR-TO-GOTO                                        DTSCS35
00460         PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT              DTSCS35
00461      ELSE                                                         DTSCS35
00462      IF REQ-INQUIRE                                               DTSCS35
00463         PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT             DTSCS35
00464      ELSE                                                         DTSCS35
00465 *****IF REQ-EDIT                                                  DTSCS35
00466 *****   PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT                DTSCS35
00467 *****ELSE                                                         DTSCS35
00468 *****IF REQ-UPDATE                                                DTSCS35
00469 *****   PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT              DTSCS35
00470 *****ELSE                                                         DTSCS35
00471         GO TO S899-ABEND.                                         DTSCS35
00472                                                                   DTSCS35
00473 *-----------------------------------------------------            DTSCS35
00474 *    THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED             DTSCS35
00475 *    IN RESP-IND THE TYPE OF RESPONSE TO BE MADE.                 DTSCS35
00476 *-----------------------------------------------------            DTSCS35
00477                                                                   DTSCS35
00478      IF RESP-SEND-MAP                                             DTSCS35
00479          PERFORM S9300-SEND-MAP THRU S9300-EXIT                   DTSCS35
00480          SET LCCM-END-TASK-88 TO TRUE                             DTSCS35
00481      ELSE                                                         DTSCS35
00482      IF RESP-SEND-MSGONLY                                         DTSCS35
00483          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS35
00484          SET LCCM-END-TASK-88 TO TRUE                             DTSCS35
00485      ELSE                                                         DTSCS35
00486      IF RESP-JUMP                                                 DTSCS35
00487          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS35
00488      ELSE                                                         DTSCS35
00489      IF RESP-CURSOR-TO-GOTO                                       DTSCS35
00490          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS35
00491          SET LCCM-END-TASK-88 TO TRUE                             DTSCS35
00492      ELSE                                                         DTSCS35
00493          GO TO S899-ABEND.                                        DTSCS35
00494                                                                   DTSCS35
00495  MAINLINE-EXIT.                                                   DTSCS35
00496                                                                   DTSCS35
00497      EXEC CICS                                                    DTSCS35
00498          RETURN                                                   DTSCS35
00499      END-EXEC.                                                    DTSCS35
00500                                                                   DTSCS35
00501      GOBACK.                                                      DTSCS35
00502      EJECT                                                        DTSCS35
00503 /*****************************************************************DTSCS35
00504 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION         *DTSCS35
00505 ******************************************************************DTSCS35
00506  P1000-ANALYZE-REQUEST.                                           DTSCS35
00507                                                                   DTSCS35
00508 *-----------------------------------------------------            DTSCS35
00509 *     IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE)         DTSCS35
00510 *     THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE               DTSCS35
00511 *     REPLACED WITH ENTER)                                        DTSCS35
00512 *-----------------------------------------------------            DTSCS35
00513      IF LCCM-SCR-ID NOT = WRK-SCR-ID                              DTSCS35
00514          MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA                    DTSCS35
00515          SET LCCM-ENTER-88 TO TRUE                                DTSCS35
00516          IF LCCM-EMP-NO = +0                                      DTSCS35
00517              MOVE +0 TO LCCM-YRQ                                  DTSCS35
00518              MOVE PMSG-KEY-EMP-NO TO LCCM-MSG-AREA                DTSCS35
00519              SET REQ-CLEAR TO TRUE                                DTSCS35
00520          ELSE                                                     DTSCS35
00521              SET REQ-INQUIRE TO TRUE                              DTSCS35
00522              MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                   DTSCS35
00523              MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2                   DTSCS35
00524              PERFORM P1100-CHECK-LCCM-YRQ THRU P1100-EXIT         DTSCS35
00525          END-IF                                                   DTSCS35
00526          GO TO P1000-EXIT.                                        DTSCS35
00527                                                                   DTSCS35
00528 *-----------------------------------------------------            DTSCS35
00529 *      MAP IS RECEIVED                                            DTSCS35
00530 *-----------------------------------------------------            DTSCS35
00531      PERFORM S9100-RECEIVE THRU S9100-EXIT.                       DTSCS35
00532                                                                   DTSCS35
00533 *-----------------------------------------------------            DTSCS35
00534 *    CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE            DTSCS35
00535 *    WORK STATION                                                 DTSCS35
00536 *-----------------------------------------------------            DTSCS35
00537      IF LCCM-CLEAR-88                                             DTSCS35
00538         SET REQ-CLEAR TO TRUE                                     DTSCS35
00539         GO TO P1000-EXIT.                                         DTSCS35
00540                                                                   DTSCS35
00541 *-----------------------------------------------------            DTSCS35
00542 *    PA2 IS A REQUEST TO POSITION CURSOR AT GO TO:                DTSCS35
00543 *-----------------------------------------------------            DTSCS35
00544      IF LCCM-PA2-88                                               DTSCS35
00545          SET REQ-CURSOR-TO-GOTO TO TRUE                           DTSCS35
00546          GO TO P1000-EXIT.                                        DTSCS35
00547                                                                   DTSCS35
00548 *-----------------------------------------------------            DTSCS35
00549 *    ALL OTHER PA KEYS ARE NOT ACTIVE                             DTSCS35
00550 *-----------------------------------------------------            DTSCS35
00551      IF LCCM-PA-88                                                DTSCS35
00552        PERFORM S804-INVALID-KEY THRU S804-EXIT                    DTSCS35
00553        SET REQ-ERROR TO TRUE                                      DTSCS35
00554        GO TO P1000-EXIT.                                          DTSCS35
00555                                                                   DTSCS35
00556 *-----------------------------------------------------            DTSCS35
00557 *    IF PF12 KEY IS PRESSED CLEAR SCREEN                          DTSCS35
00558 *-----------------------------------------------------            DTSCS35
00559      IF LCCM-F12-88                                               DTSCS35
00560         MOVE LOW-VALUES TO MAP-AREA                               DTSCS35
00561         SET REQ-CLEAR TO TRUE                                     DTSCS35
00562         GO TO P1000-EXIT.                                         DTSCS35
00563                                                                   DTSCS35
00564 *-----------------------------------------------------            DTSCS35
00565 *    IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION            DTSCS35
00566 *-----------------------------------------------------            DTSCS35
00567      IF LCCM-F03-88                                               DTSCS35
00568         MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID                    DTSCS35
00569         SET REQ-JUMP TO TRUE                                      DTSCS35
00570         GO TO P1000-EXIT.                                         DTSCS35
00571                                                                   DTSCS35
00572 *-----------------------------------------------------            DTSCS35
00573 *    IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN         DTSCS35
00574 *-----------------------------------------------------            DTSCS35
00575      IF LCCM-F04-88                                               DTSCS35
00576         MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID                 DTSCS35
00577         SET REQ-JUMP TO TRUE                                      DTSCS35
00578         GO TO P1000-EXIT.                                         DTSCS35
00579                                                                   DTSCS35
00580 *-----------------------------------------------------            DTSCS35
00581 *    IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO                DTSCS35
00582 *    CORRESPONDENCE SCREEN                                        DTSCS35
00583 *-----------------------------------------------------            DTSCS35
00584      IF LCCM-F14-88                                               DTSCS35
00585         MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID                  DTSCS35
00586         SET REQ-JUMP TO TRUE                                      DTSCS35
00587         GO TO P1000-EXIT.                                         DTSCS35
00588                                                                   DTSCS35
00589 *    IF LCCM-F09-88                                               DTSCS35
00590 *        MOVE '31' TO LCCM-REQ-SCR-ID                             DTSCS35
00591 *        SET REQ-JUMP TO TRUE                                     DTSCS35
00592 *        GO TO P1000-EXIT.                                        DTSCS35
00593 *                                                                 DTSCS35
00594 *    IF LCCM-F10-88                                               DTSCS35
00595 *        MOVE '33' TO LCCM-REQ-SCR-ID                             DTSCS35
00596 *        SET REQ-JUMP TO TRUE                                     DTSCS35
00597 *        GO TO P1000-EXIT.                                        DTSCS35
00598 *                                                                 DTSCS35
00599 *    IF LCCM-F11-88                                               DTSCS35
00600 *        MOVE '34' TO LCCM-REQ-SCR-ID                             DTSCS35
00601 *        SET REQ-JUMP TO TRUE                                     DTSCS35
00602 *        GO TO P1000-EXIT.                                        DTSCS35
00603 *                                                                 DTSCS35
00604 *-----------------------------------------------------            DTSCS35
00605 *    IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO               DTSCS35
00606 *    REQUESTED SCREEN TYPE                                        DTSCS35
00607 *-----------------------------------------------------            DTSCS35
00608      IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID             DTSCS35
00609         NEXT SENTENCE                                             DTSCS35
00610      ELSE                                                         DTSCS35
00611        MOVE MAP-GOTO TO LCCM-REQ-SCR-ID                           DTSCS35
00612        SET REQ-JUMP TO TRUE                                       DTSCS35
00613        GO TO P1000-EXIT.                                          DTSCS35
00614                                                                   DTSCS35
00615 *-----------------------------------------------------            DTSCS35
00616 *    IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7,              DTSCS35
00617 *          F8), INDICATE INQUIRY REQUEST                          DTSCS35
00618 *-----------------------------------------------------            DTSCS35
00619      IF LCCM-INQUIRY-88                                           DTSCS35
00620          SET REQ-INQUIRE TO TRUE                                  DTSCS35
00621          GO TO P1000-EXIT.                                        DTSCS35
00622                                                                   DTSCS35
00623 *-----------------------------------------------------            DTSCS35
00624 *     ANY OTHER KEY IS INVALID                                    DTSCS35
00625 *-----------------------------------------------------            DTSCS35
00626      PERFORM S804-INVALID-KEY THRU S804-EXIT.                     DTSCS35
00627      SET REQ-ERROR TO TRUE.                                       DTSCS35
00628  P1000-EXIT.                                                      DTSCS35
00629      EXIT.                                                        DTSCS35
00630                                                                   DTSCS35
00631  P1100-CHECK-LCCM-YRQ.                                            DTSCS35
00632      IF LCCM-YRQ = ALL-NINES-YRQ                                  DTSCS35
00633          MOVE +0 TO LCCM-YRQ                                      DTSCS35
00634          GO TO P1100-EXIT.                                        DTSCS35
00635                                                                   DTSCS35
00636      IF LCCM-YRQ < LCCM-PICKUP-YRQ                                DTSCS35
00637          MOVE +0 TO LCCM-YRQ                                      DTSCS35
00638          GO TO P1100-EXIT.                                        DTSCS35
00639                                                                   DTSCS35
00640      IF LCCM-YRQ > +0                                             DTSCS35
00641          PERFORM P1110-DISPLAY-YRQ THRU P1110-EXIT                DTSCS35
00642          GO TO P1100-EXIT.                                        DTSCS35
00643                                                                   DTSCS35
00644 *****MOVE LCCM-SCR35-HOLD-AREA TO SCR-HOLD-AREA.                  DTSCS35
00645 *****IF SCR-HOLD-AREA  NOT =  LOW-VALUES                          DTSCS35
00646 *********IF SCR-HOLD-EMP-NO = LCCM-EMP-NO                         DTSCS35
00647 ***********IF SCR-HOLD-YRQ > +0                                   DTSCS35
00648 *************MOVE SCR-HOLD-YRQ TO LCCM-YRQ                        DTSCS35
00649 *************PERFORM P1110-DISPLAY-YRQ THRU P1110-EXIT.           DTSCS35
00650  P1100-EXIT.                                                      DTSCS35
00651      EXIT.                                                        DTSCS35
00652                                                                   DTSCS35
00653  P1110-DISPLAY-YRQ.                                               DTSCS35
00654      IF LCCM-YRQ = LCCM-PICKUP-YRQ                                DTSCS35
00655          MOVE 'PU' TO MAP-YRQ-YR                                  DTSCS35
00656          MOVE ' ' TO MAP-YRQ-Q                                    DTSCS35
00657      ELSE                                                         DTSCS35
00658          MOVE LCCM-YRQ TO WRK-DISPLAY                             DTSCS35
00659          MOVE WRK-DISPLAY-YRQ-YR TO MAP-YRQ-YR                    DTSCS35
00660          MOVE WRK-DISPLAY-YRQ-Q TO MAP-YRQ-Q.                     DTSCS35
00661  P1110-EXIT.                                                      DTSCS35
00662      EXIT.                                                        DTSCS35
00663 /*****************************************************************DTSCS35
00664 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS35
00665 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN.                      *DTSCS35
00666 ******************************************************************DTSCS35
00667                                                                   DTSCS35
00668  P2000-REQUEST-ERROR.                                             DTSCS35
00669      IF LCCM-MSG                                                  DTSCS35
00670         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS35
00671      ELSE                                                         DTSCS35
00672         GO TO S899-ABEND.                                         DTSCS35
00673  P2000-EXIT.                                                      DTSCS35
00674      EXIT.                                                        DTSCS35
00675 /*****************************************************************DTSCS35
00676 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED                  *DTSCS35
00677 ******************************************************************DTSCS35
00678                                                                   DTSCS35
00679  P3000-REQUEST-JUMP.                                              DTSCS35
00680 *-----------------------------------------------------            DTSCS35
00681 *    VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE    DTSCS35
00682 *    BY USER                                                      DTSCS35
00683 *-----------------------------------------------------            DTSCS35
00684      PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT.                 DTSCS35
00685                                                                   DTSCS35
00686 *-----------------------------------------------------            DTSCS35
00687 *    VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED               DTSCS35
00688 *-----------------------------------------------------            DTSCS35
00689      IF LCCM-MSG                                                  DTSCS35
00690         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS35
00691         SET CURSOR-SET-GOTO TO TRUE                               DTSCS35
00692         GO TO P3000-EXIT.                                         DTSCS35
00693      SKIP3                                                        DTSCS35
00694      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS35
00695      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS35
00696      IF L018-VALID                                                DTSCS35
00697          MOVE L018-EMP-NO TO LCCM-EMP-NO                          DTSCS35
00698                                                                   DTSCS35
00699          MOVE MAP-YRQ-AREA TO L029-S-YRQ-AREA                     DTSCS35
00700          PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT              DTSCS35
00701          IF L029-VALID                                            DTSCS35
00702              MOVE L029-YRQ TO LCCM-YRQ.                           DTSCS35
00703                                                                   DTSCS35
00704 *-----------------------------------------------------            DTSCS35
00705 *    IF PAGES OF INFORMATION ARE IN TS, THEN BEFORE               DTSCS35
00706 *    JUMPING OUT OF THIS MODULE, DELETE THE TS QUEUE.             DTSCS35
00707 *-----------------------------------------------------            DTSCS35
00708                                                                   DTSCS35
00709      IF LCCM-SCR-HOLD-CONTROL-AREA = LOW-VALUES                   DTSCS35
00710          NEXT SENTENCE                                            DTSCS35
00711      ELSE                                                         DTSCS35
00712          IF LCCM-SCR-HOLD-LAST-PAGE-NUM > ITEM-MAX-LCCM           DTSCS35
00713              PERFORM S829-DELETE-QUEUE THRU S829-EXIT.            DTSCS35
00714                                                                   DTSCS35
00715 *-----------------------------------------------------            DTSCS35
00716 *    CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING      DTSCS35
00717 *-----------------------------------------------------            DTSCS35
00718      MOVE LOW-VALUES TO LCCM-SCR-STATUS                           DTSCS35
00719                         LCCM-SCR-HOLD-AREA.                       DTSCS35
00720      MOVE +0 TO LCCM-SCR-ABSTIME.                                 DTSCS35
00721      SET RESP-JUMP TO TRUE.                                       DTSCS35
00722  P3000-EXIT.                                                      DTSCS35
00723      EXIT.                                                        DTSCS35
00724 /*****************************************************************DTSCS35
00725 * CLEAR KEY WAS PRESSED                                          *DTSCS35
00726 ******************************************************************DTSCS35
00727                                                                   DTSCS35
00728  P4000-REQUEST-CLEAR.                                             DTSCS35
00729 *-----------------------------------------------------            DTSCS35
00730 *   CLEAN UP INDICATORS AND PAGING STORAGE.  RESET KEY            DTSCS35
00731 *   FIELDS FROM EARLIER REQUESTS                                  DTSCS35
00732 *-----------------------------------------------------            DTSCS35
00733      IF LCCM-EMP-NO > ZERO                                        DTSCS35
00734          MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                       DTSCS35
00735          MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2.                      DTSCS35
00736                                                                   DTSCS35
00737      MOVE ZERO TO LCCM-EMP-NO                                     DTSCS35
00738                   LCCM-YRQ.                                       DTSCS35
00739                                                                   DTSCS35
00740      MOVE LOW-VALUES TO LCCM-SCR35-HOLD-AREA.                     DTSCS35
00741                                                                   DTSCS35
00742                                                                   DTSCS35
00743                                                                   DTSCS35
00744      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS35
00745                                                                   DTSCS35
00746      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS35
00747                                                                   DTSCS35
00748      PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.                 DTSCS35
00749                                                                   DTSCS35
00750      SET RESP-SEND-MAP TO TRUE.                                   DTSCS35
00751  P4000-EXIT.                                                      DTSCS35
00752      EXIT.                                                        DTSCS35
00753 /*****************************************************************DTSCS35
00754 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED                   *DTSCS35
00755 ******************************************************************DTSCS35
00756                                                                   DTSCS35
00757  P5000-CURSOR-TO-GOTO.                                            DTSCS35
00758      SET CURSOR-SET-GOTO TO TRUE.                                 DTSCS35
00759      SET RESP-CURSOR-TO-GOTO TO TRUE.                             DTSCS35
00760  P5000-EXIT.                                                      DTSCS35
00761      EXIT.                                                        DTSCS35
00762 /*****************************************************************DTSCS35
00763 * INQUIRY WAS REQUESTED                                          *DTSCS35
00764 ******************************************************************DTSCS35
00765                                                                   DTSCS35
00766  P6000-REQUEST-INQUIRE.                                           DTSCS35
00767 *------------------------------------------------------------     DTSCS35
00768 *    CLEAR MAP-AREA WHILE PRESERVING MAP-EMP-NO-AREA AND          DTSCS35
00769 *    MAP-YRQ-AREA.                                                DTSCS35
00770 *------------------------------------------------------------     DTSCS35
00771                                                                   DTSCS35
00772      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS35
00773                                                                   DTSCS35
00774      MOVE MAP-YRQ-AREA TO L029-S-YRQ-AREA.                        DTSCS35
00775                                                                   DTSCS35
00776      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS35
00777                                                                   DTSCS35
00778      MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA.                  DTSCS35
00779                                                                   DTSCS35
00780      MOVE L029-S-YRQ-AREA TO MAP-YRQ-AREA.                        DTSCS35
00781                                                                   DTSCS35
00782                                                                   DTSCS35
00783      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS35
00784                                                                   DTSCS35
00785      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS35
00786                                                                   DTSCS35
00787      SET RESP-SEND-MAP TO TRUE.                                   DTSCS35
00788                                                                   DTSCS35
00789      PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.                 DTSCS35
00790                                                                   DTSCS35
00791                                                                   DTSCS35
00792 *------------------------------------------------------------     DTSCS35
00793 *    IF LAST ACTION WAS A SCREEN 33 DISPLAY, THEN LCCM-SCR35      DTSCS35
00794 *    HOLD-AREA CONTAINS EMP NO, YRQ AND PAGE NUMBER LAST          DTSCS35
00795 *    DISPLAYED.                                                   DTSCS35
00796 *------------------------------------------------------------     DTSCS35
00797                                                                   DTSCS35
00798      MOVE LCCM-SCR35-HOLD-AREA TO SCR-HOLD-AREA.                  DTSCS35
00799                                                                   DTSCS35
00800      MOVE LOW-VALUES TO LCCM-SCR35-HOLD-AREA.                     DTSCS35
00801                                                                   DTSCS35
00802                                                                   DTSCS35
00803 *------------------------------------------------------------     DTSCS35
00804 *    EDIT MAP-EMP-NO-AREA AND MAP-YRQ-AREA FOR VALIDITY.          DTSCS35
00805 *------------------------------------------------------------     DTSCS35
00806                                                                   DTSCS35
00807      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS35
00808      IF LCCM-MSG                                                  DTSCS35
00809          NEXT SENTENCE                                            DTSCS35
00810      ELSE                                                         DTSCS35
00811          MOVE WRK-EMP-NO TO LCCM-EMP-NO.                          DTSCS35
00812                                                                   DTSCS35
00813      PERFORM S1200-YRQ THRU S1200-EXIT.                           DTSCS35
00814      IF LCCM-MSG                                                  DTSCS35
00815          GO TO P6000-EXIT.                                        DTSCS35
00816                                                                   DTSCS35
00817      MOVE WRK-YRQ TO LCCM-YRQ.                                    DTSCS35
00818                                                                   DTSCS35
00819                                                                   DTSCS35
00820 *------------------------------------------------------------     DTSCS35
00821 *    THIS MODULE CONSTRUCTS PAGES OF INFORMATION INTO             DTSCS35
00822 *    LCCM-SCR-HOLD-AREA (WITH ANY OVERFLOW STORED IN TS)          DTSCS35
00823 *    AND RETAINS THIS INFORMATION BETWEEN TASKS.                  DTSCS35
00824 *                                                                 DTSCS35
00825 *    IF LCCM-SCR-HOLD-AREA CONTAINS INFORMATION FOR THE EMP-NO    DTSCS35
00826 *    AND YRQ SPECIFIED ON THE SCREEN AND THE EMPLOYER'S           DTSCS35
00827 *    RECORDS HAVE NOT BEEN UPDATED SINCE THE LCCM-SCR-HOLD-AREA   DTSCS35
00828 *    WAS CONSTRUCTED, THEN THE INFORMATION IN LCCM-SCR-HOLD-AREA  DTSCS35
00829 *    MAY BE USED FOR PAGING AND DISPLAY - IT IS NOT NECESSARY     DTSCS35
00830 *    TO REBUILD LCCM-SCR-HOLD-AREA.                               DTSCS35
00831 *------------------------------------------------------------     DTSCS35
00832                                                                   DTSCS35
00833      IF (LCCM-SCR-HOLD-CONTROL-AREA = LOW-VALUES)                 DTSCS35
00834            OR                                                     DTSCS35
00835         (WRK-EMP-NO NOT = LCCM-SCR-HOLD-EMP-NO)                   DTSCS35
00836            OR                                                     DTSCS35
00837         (WRK-YRQ NOT = LCCM-SCR-HOLD-YRQ)                         DTSCS35
00838            OR                                                     DTSCS35
00839         (LCCM-SCR-HOLD-ABSTIME < MPRF-UPDATE-END-ABSTIME)         DTSCS35
00840          PERFORM P7000-CONSTRUCT-PAGES THRU P7000-EXIT.           DTSCS35
00841                                                                   DTSCS35
00842                                                                   DTSCS35
00843 *------------------------------------------------------------     DTSCS35
00844 *    IF NO INFORMATION IS AVAILABLE FOR DISPLAY, THEN YOU         DTSCS35
00845 *    ARE DONE.                                                    DTSCS35
00846 *------------------------------------------------------------     DTSCS35
00847                                                                   DTSCS35
00848      IF LCCM-SCR-HOLD-LAST-PAGE-NUM = +0                          DTSCS35
00849          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS35
00850          PERFORM S1299-ERROR THRU S1299-EXIT                      DTSCS35
00851          GO TO P6000-EXIT.                                        DTSCS35
00852                                                                   DTSCS35
00853                                                                   DTSCS35
00854 *------------------------------------------------------------     DTSCS35
00855 *    DETERMINE WHICH PAGE TO DISPLAY.                             DTSCS35
00856 *------------------------------------------------------------     DTSCS35
00857                                                                   DTSCS35
00858      PERFORM P6200-LOCATE-PAGE THRU P6200-EXIT.                   DTSCS35
00859      IF LCCM-MSG                                                  DTSCS35
00860          GO TO P6000-EXIT.                                        DTSCS35
00861                                                                   DTSCS35
00862                                                                   DTSCS35
00863 *------------------------------------------------------------     DTSCS35
00864 *    PLACE INFORMATION INTO MAP-AREA.                             DTSCS35
00865 *------------------------------------------------------------     DTSCS35
00866                                                                   DTSCS35
00867      PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT.              DTSCS35
00868                                                                   DTSCS35
00869                                                                   DTSCS35
00870      MOVE WRK-EMP-NO TO SCR-HOLD-EMP-NO.                          DTSCS35
00871                                                                   DTSCS35
00872      MOVE WRK-YRQ TO SCR-HOLD-YRQ.                                DTSCS35
00873                                                                   DTSCS35
00874      MOVE CURR-PAGE-NUM TO SCR-HOLD-CURR-PAGE-NUM.                DTSCS35
00875                                                                   DTSCS35
00876      MOVE SCR-HOLD-AREA TO LCCM-SCR35-HOLD-AREA.                  DTSCS35
00877                                                                   DTSCS35
00878                                                                   DTSCS35
00879      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS35
00880  P6000-EXIT.                                                      DTSCS35
00881      EXIT.                                                        DTSCS35
00882      EJECT                                                        DTSCS35
00883  P6200-LOCATE-PAGE.                                               DTSCS35
00884      IF (SCR-HOLD-AREA = LOW-VALUES)                              DTSCS35
00885            OR                                                     DTSCS35
00886         (SCR-HOLD-EMP-NO NOT = WRK-EMP-NO)                        DTSCS35
00887            OR                                                     DTSCS35
00888         (SCR-HOLD-YRQ NOT = WRK-YRQ)                              DTSCS35
00889          MOVE +1 TO CURR-PAGE-NUM                                 DTSCS35
00890          GO TO P6200-EXIT.                                        DTSCS35
00891                                                                   DTSCS35
00892      IF LCCM-ENTER-88                                             DTSCS35
00893          MOVE SCR-HOLD-CURR-PAGE-NUM TO CURR-PAGE-NUM             DTSCS35
00894      ELSE                                                         DTSCS35
00895      IF LCCM-F05-88                                               DTSCS35
00896          MOVE +1 TO CURR-PAGE-NUM                                 DTSCS35
00897      ELSE                                                         DTSCS35
00898      IF LCCM-F06-88                                               DTSCS35
00899          MOVE LCCM-SCR-HOLD-LAST-PAGE-NUM TO CURR-PAGE-NUM        DTSCS35
00900      ELSE                                                         DTSCS35
00901      IF LCCM-F07-88                                               DTSCS35
00902          COMPUTE CURR-PAGE-NUM = SCR-HOLD-CURR-PAGE-NUM - 1       DTSCS35
00903      ELSE                                                         DTSCS35
00904      IF LCCM-F08-88                                               DTSCS35
00905          COMPUTE CURR-PAGE-NUM = SCR-HOLD-CURR-PAGE-NUM + 1       DTSCS35
00906      ELSE                                                         DTSCS35
00907          GO TO S899-ABEND.                                        DTSCS35
00908                                                                   DTSCS35
00909      IF CURR-PAGE-NUM < +1                                        DTSCS35
00910          MOVE +1 TO CURR-PAGE-NUM                                 DTSCS35
00911      ELSE                                                         DTSCS35
00912      IF CURR-PAGE-NUM > LCCM-SCR-HOLD-LAST-PAGE-NUM               DTSCS35
00913          MOVE LCCM-SCR-HOLD-LAST-PAGE-NUM TO CURR-PAGE-NUM.       DTSCS35
00914  P6200-EXIT.                                                      DTSCS35
00915      EXIT.                                                        DTSCS35
00916 /*****************************************************************DTSCS35
00917 *                                                                *DTSCS35
00918 ******************************************************************DTSCS35
00919                                                                   DTSCS35
00920  P6900-CONSTRUCT-SCREEN.                                          DTSCS35
00921 *--------------------------------------------------------------   DTSCS35
00922 *    PAGES OF INFORMATION HAVE BEEN ASSEMBLED AND PLACED INTO     DTSCS35
00923 *    LCCM-SCR-HOLD-AREA AND A PAGE (CURR-PAGE-NUM) HAS BEEN       DTSCS35
00924 *    SELECTED FOR DISPLAY.  THUS, ALL THAT IS LEFT IS TO RETRIEVE DTSCS35
00925 *    THE SELECTED PAGE OF INFORMATION FROM LCCM-SCR-HOLD-AREA     DTSCS35
00926 *    (OR THE TS OVERFLOW) INTO PAGE-AREA AND MOVE DATA ELEMENTS   DTSCS35
00927 *    FROM PAGE-AREA TO MAP-AREA.                                  DTSCS35
00928 *--------------------------------------------------------------   DTSCS35
00929                                                                   DTSCS35
00930      MOVE CURR-PAGE-NUM TO ITEM-SUB.                              DTSCS35
00931                                                                   DTSCS35
00932      PERFORM P8200-RETREIVE-PAGE-AREA THRU P8200-EXIT.            DTSCS35
00933                                                                   DTSCS35
00934      PERFORM P6910-PAGE-AREA-TO-MAP THRU P6910-EXIT               DTSCS35
00935          VARYING ROW-OCC FROM 1 BY 1                              DTSCS35
00936          UNTIL ROW-OCC > PAGE-ROW-CNT.                            DTSCS35
00937                                                                   DTSCS35
00938      PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT.                   DTSCS35
00939  P6900-EXIT.                                                      DTSCS35
00940      EXIT.                                                        DTSCS35
00941                                                                   DTSCS35
00942  P6910-PAGE-AREA-TO-MAP.                                          DTSCS35
00943      MOVE SPACES TO MAP-LINE(ROW-OCC).                            DTSCS35
00944                                                                   DTSCS35
00945      MOVE PAGE-MISC-1(ROW-OCC) TO MAP-MISC-1(ROW-OCC).            DTSCS35
00946      MOVE PAGE-MISC-2(ROW-OCC) TO MAP-MISC-2(ROW-OCC).            DTSCS35
00947                                                                   DTSCS35
00948 *                       *--------------------------------------   DTSCS35
00949 *-----------------------* THE FOLLOWING SENTENCE PERFORMS THE     DTSCS35
00950 *                       * GROUP INDICATE FUNCTION                 DTSCS35
00951 *                       *--------------------------------------   DTSCS35
00952      IF ROW-OCC = 1                                               DTSCS35
00953         NEXT SENTENCE                                             DTSCS35
00954      ELSE                                                         DTSCS35
00955      IF PAGE-DOC-NO (ROW-OCC) = PAGE-DOC-NO (ROW-OCC - 1)         DTSCS35
00956         GO TO P6910-EXIT                                          DTSCS35
00957      ELSE                                                         DTSCS35
00958         NEXT SENTENCE.                                            DTSCS35
00959                                                                   DTSCS35
00960      MOVE PAGE-ADJ-TYPE (ROW-OCC) TO MAP-ADJ-TYPE (ROW-OCC).      DTSCS35
00961                                                                   DTSCS35
00962      MOVE PAGE-BATCH-NO (ROW-OCC) TO MAP-BATCH-NO (ROW-OCC).      DTSCS35
00963      MOVE PAGE-ITEM-NO (ROW-OCC) TO MAP-ITEM-NO (ROW-OCC).        DTSCS35
00964                                                                   DTSCS35
00965      IF PAGE-APPLIC-YRQ (ROW-OCC) > +0                            DTSCS35
00966         MOVE PAGE-APPLIC-YRQ (ROW-OCC) TO L004-QTR-5-9            DTSCS35
00967         PERFORM P6911-SLASH-YRQ THRU P6911-EXIT                   DTSCS35
00968         MOVE L004-SLASH-QTR TO MAP-APPLIC-YRQ (ROW-OCC).          DTSCS35
00969                                                                   DTSCS35
00970                                                                   DTSCS35
00971        IF PAGE-APPLIC-BATCH-NO (ROW-OCC) > +0                     DTSCS35
00972        OR PAGE-APPLIC-ITEM-NO (ROW-OCC) > +0                      DTSCS35
00973           MOVE PAGE-APPLIC-BATCH-NO (ROW-OCC)                     DTSCS35
00974             TO MAP-APPLIC-BATCH-NO (ROW-OCC)                      DTSCS35
00975           MOVE PAGE-APPLIC-ITEM-NO (ROW-OCC)                      DTSCS35
00976             TO MAP-APPLIC-ITEM-NO (ROW-OCC).                      DTSCS35
00977                                                                   DTSCS35
00978      MOVE PAGE-APPLIC-IND (ROW-OCC)                               DTSCS35
00979        TO MAP-APPLIC-IND (ROW-OCC).                               DTSCS35
00980                                                                   DTSCS35
00981      MOVE PAGE-PROCESSED-DATE (ROW-OCC) TO L001-FED-8-DATE-9.     DTSCS35
00982      PERFORM P6912-SLASH-DATE THRU P6912-EXIT.                    DTSCS35
00983      MOVE L001-SLASH-DATE TO MAP-PROCESSED-DATE (ROW-OCC).        DTSCS35
00984                                                                   DTSCS35
00985      MOVE PAGE-RECEIVED-DATE (ROW-OCC) TO L001-FED-8-DATE-9.      DTSCS35
00986      PERFORM P6912-SLASH-DATE THRU P6912-EXIT.                    DTSCS35
00987      MOVE L001-SLASH-DATE TO MAP-RECEIVED-DATE (ROW-OCC).         DTSCS35
00988                                                                   DTSCS35
00989      MOVE PAGE-AMT (ROW-OCC) TO MAP-AMT-Z (ROW-OCC).              DTSCS35
00990                                                                   DTSCS35
00991  P6910-EXIT.                                                      DTSCS35
00992      EXIT.                                                        DTSCS35
00993                                                                   DTSCS35
00994  P6911-SLASH-YRQ.                                                 DTSCS35
00995      IF L004-QTR-5-9 = +0                                         DTSCS35
00996          MOVE SPACES TO L004-SLASH-QTR                            DTSCS35
00997      ELSE                                                         DTSCS35
00998      IF L004-QTR-5-9 = LCCM-PICKUP-YRQ                            DTSCS35
00999          MOVE 'PKUP' TO L004-SLASH-QTR                            DTSCS35
01000      ELSE                                                         DTSCS35
01001          MOVE L004-QTR-5-YR TO L004-SLASH-YR                      DTSCS35
01002          MOVE '/' TO L004-SLASH-LIT                               DTSCS35
01003          MOVE L004-QTR-5-Q TO L004-SLASH-Q.                       DTSCS35
01004  P6911-EXIT.                                                      DTSCS35
01005      EXIT.                                                        DTSCS35
01006                                                                   DTSCS35
01007  P6912-SLASH-DATE.                                                DTSCS35
01008      IF L001-FED-8-DATE-9 = +0                                    DTSCS35
01009          MOVE SPACES TO L001-SLASH-DATE                           DTSCS35
01010      ELSE                                                         DTSCS35
01011          MOVE '  /  /  ' TO L001-SLASH-DATE                       DTSCS35
01012          MOVE L001-FED-8-MO TO L001-SLASH-MO                      DTSCS35
01013          MOVE L001-FED-8-DA TO L001-SLASH-DA                      DTSCS35
01014          MOVE L001-FED-8-YR TO L001-SLASH-YR.                     DTSCS35
01015  P6912-EXIT.                                                      DTSCS35
01016      EXIT.                                                        DTSCS35
01017                                                                   DTSCS35
01018  P6990-PAGE-NUMBER.                                               DTSCS35
01019      MOVE CURR-PAGE-NUM TO MAP-CURR-PAGE.                         DTSCS35
01020      MOVE LCCM-SCR-HOLD-LAST-PAGE-NUM TO MAP-LAST-PAGE.           DTSCS35
01021                                                                   DTSCS35
01022      IF CURR-PAGE-NUM = +1                                        DTSCS35
01023          IF LCCM-SCR-HOLD-LAST-PAGE-NUM = +1                      DTSCS35
01024              MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA                 DTSCS35
01025          ELSE                                                     DTSCS35
01026              MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA                DTSCS35
01027      ELSE                                                         DTSCS35
01028          IF CURR-PAGE-NUM = LCCM-SCR-HOLD-LAST-PAGE-NUM           DTSCS35
01029              MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA.                DTSCS35
01030  P6990-EXIT.                                                      DTSCS35
01031      EXIT.                                                        DTSCS35
01032      EJECT                                                        DTSCS35
01033  P7000-CONSTRUCT-PAGES.                                           DTSCS35
01034 *--------------------------------------------------------------   DTSCS35
01035 *    INQUIRY FOR WRK-EMP-NO AND WRK-YRQ HAS BEEN REQUESTED.       DTSCS35
01036 *    P7000 ASSEMBLES PAGES OF INFORMATION INTO LCCM-SCR-HOLD-AREA DTSCS35
01037 *    (WITH OVERFLOW INTO TS).                                     DTSCS35
01038 *                                                                 DTSCS35
01039 *    THE PRINCIPLE DIFFICULTY IS WITH THE SEQUENCE IN WHICH MADJ  DTSCS35
01040 *    RECORDS MUST BE DISPLAYED: ASCENDING ON DOC NO.              DTSCS35
01041 *                                                                 DTSCS35
01042 *    IF WRK-YRQ IS EQUAL TO ZERO, THEN ALL MADJ RECORDS FOR EMP   DTSCS35
01043 *    NO MUST BE DISPLAYED.                                        DTSCS35
01044 *                                                                 DTSCS35
01045 *    IF WRK-YRQ IS NOT EQUAL TO ZERO, THEN ONLY THOSE MADJ        DTSCS35
01046 *    RECORDS WITH MADJ-YRQ EQUAL TO WRK-YRQ ARE DISPLAYED.        DTSCS35
01047 *--------------------------------------------------------------   DTSCS35
01048      IF LCCM-SCR-HOLD-CONTROL-AREA = LOW-VALUES                   DTSCS35
01049          NEXT SENTENCE                                            DTSCS35
01050      ELSE                                                         DTSCS35
01051          IF LCCM-SCR-HOLD-LAST-PAGE-NUM > ITEM-MAX-LCCM           DTSCS35
01052              PERFORM S829-DELETE-QUEUE THRU S829-EXIT.            DTSCS35
01053                                                                   DTSCS35
01054      MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA.                       DTSCS35
01055                                                                   DTSCS35
01056      MOVE WRK-EMP-NO TO LCCM-SCR-HOLD-EMP-NO.                     DTSCS35
01057      MOVE WRK-YRQ TO LCCM-SCR-HOLD-YRQ.                           DTSCS35
01058      MOVE MPRF-UPDATE-END-ABSTIME TO LCCM-SCR-HOLD-ABSTIME.       DTSCS35
01059      MOVE +0 TO LCCM-SCR-HOLD-LAST-PAGE-NUM.                      DTSCS35
01060                                                                   DTSCS35
01061      MOVE +0 TO ITEM-CNT.                                         DTSCS35
01062                                                                   DTSCS35
01063      PERFORM P7100-ALL-QUARTERS THRU P7100-EXIT                   DTSCS35
01064                                                                   DTSCS35
01065      MOVE ITEM-CNT TO LCCM-SCR-HOLD-LAST-PAGE-NUM.                DTSCS35
01066  P7000-EXIT.                                                      DTSCS35
01067      EXIT.                                                        DTSCS35
01068                                                                   DTSCS35
01069  P7100-ALL-QUARTERS.                                              DTSCS35
01070 *--------------------------------------------------------------   DTSCS35
01071 *    PROCESS ALL MADJ RECORDS, WHILE MEETING THE "DESCENDING      DTSCS35
01072 *    ON DOC NO" REQUIREMENT.                                      DTSCS35
01073 *--------------------------------------------------------------   DTSCS35
01074      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCS35
01075      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCS35
01076      SET MSKL-ADJ-88 TO TRUE.                                     DTSCS35
01077      PERFORM S810-COUNT THRU S810-EXIT.                           DTSCS35
01078      IF L810-RECORD-CNT = +0                                      DTSCS35
01079          GO TO P7100-EXIT.                                        DTSCS35
01080                                                                   DTSCS35
01081      MOVE +0 TO PAGE-ROW-CNT.                                     DTSCS35
01082                                                                   DTSCS35
01083      MOVE MSKL-KEY-AREA TO MADJ-KEY-AREA.                         DTSCS35
01084                                                                   DTSCS35
01085                                                                   DTSCS35
01086      PERFORM P7900-PROCESS-YRQ THRU P7900-EXIT.                   DTSCS35
01087                                                                   DTSCS35
01088                                                                   DTSCS35
01089      IF PAGE-ROW-CNT > +0                                         DTSCS35
01090          PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT.           DTSCS35
01091  P7100-EXIT.                                                      DTSCS35
01092      EXIT.                                                        DTSCS35
01093                                                                   DTSCS35
01094  P7900-PROCESS-YRQ.                                               DTSCS35
01095      MOVE MADJ-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS35
01096      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS35
01097      IF L810-NO-REC-88                                            DTSCS35
01098         GO TO P7900-EXIT.                                         DTSCS35
01099      PERFORM S810-READ-PREV THRU S810-EXIT.                       DTSCS35
01100                                                                   DTSCS35
01101      PERFORM P7910-SCAN-MADJ THRU P7910-EXIT                      DTSCS35
01102          UNTIL L810-NO-REC-88.                                    DTSCS35
01103  P7900-EXIT.                                                      DTSCS35
01104      EXIT.                                                        DTSCS35
01105                                                                   DTSCS35
01106  P7910-SCAN-MADJ.                                                 DTSCS35
01107      MOVE MSKL-REC TO MADJ-REC.                                   DTSCS35
01108                                                                   DTSCS35
01109      IF WRK-YRQ = +0                                              DTSCS35
01110      OR MADJ-APPLIC-YRQ = WRK-YRQ                                 DTSCS35
01111          NEXT SENTENCE                                            DTSCS35
01112      ELSE                                                         DTSCS35
01113          PERFORM S810-READ-PREV THRU S810-EXIT                    DTSCS35
01114          GO TO P7910-EXIT.                                        DTSCS35
01115                                                                   DTSCS35
01116      IF PAGE-ROW-CNT < ROWS-PER-PAGE                              DTSCS35
01117          NEXT SENTENCE                                            DTSCS35
01118      ELSE                                                         DTSCS35
01119          PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT            DTSCS35
01120          MOVE +0 TO PAGE-ROW-CNT.                                 DTSCS35
01121                                                                   DTSCS35
01122      PERFORM P7911-MADJ-TO-PAGE-AREA THRU P7911-EXIT.             DTSCS35
01123                                                                   DTSCS35
01124      PERFORM S810-READ-PREV THRU S810-EXIT.                       DTSCS35
01125  P7910-EXIT.                                                      DTSCS35
01126      EXIT.                                                        DTSCS35
01127                                                                   DTSCS35
01128 * STORE THE DATA FOR ALL FIELDS FOR EACH PAGE                     DTSCS35
01129  P7911-MADJ-TO-PAGE-AREA.                                         DTSCS35
01130      PERFORM P7913-NORMAL-INFO THRU P7913-EXIT                    DTSCS35
01131                                                                   DTSCS35
01132      IF MADJ-DUE-DATE-88                                          DTSCS35
01133         MOVE 'RDUE' TO PAGE-MISC-1(PAGE-ROW-CNT)                  DTSCS35
01134         MOVE MADJ-DATE-1 TO L001-FED-8-DATE-9                     DTSCS35
01135         PERFORM P6912-SLASH-DATE THRU P6912-EXIT                  DTSCS35
01136         MOVE L001-SLASH-DATE TO PAGE-MISC-2(PAGE-ROW-CNT)         DTSCS35
01137         PERFORM P7914-CHECK-PAGE THRU P7914-EXIT                  DTSCS35
01138         PERFORM P7913-NORMAL-INFO THRU P7913-EXIT                 DTSCS35
01139         MOVE 'TDUE' TO PAGE-MISC-1(PAGE-ROW-CNT)                  DTSCS35
01140         MOVE MADJ-DATE-2 TO L001-FED-8-DATE-9                     DTSCS35
01141         PERFORM P6912-SLASH-DATE THRU P6912-EXIT                  DTSCS35
01142         MOVE L001-SLASH-DATE TO PAGE-MISC-2(PAGE-ROW-CNT)         DTSCS35
01143      ELSE                                                         DTSCS35
01144      IF MADJ-WAIVE-DATE-88                                        DTSCS35
01145         MOVE 'WSTR' TO PAGE-MISC-1(PAGE-ROW-CNT)                  DTSCS35
01146         MOVE MADJ-DATE-1  TO L001-FED-8-DATE-9                    DTSCS35
01147         PERFORM P6912-SLASH-DATE THRU P6912-EXIT                  DTSCS35
01148         MOVE L001-SLASH-DATE TO PAGE-MISC-2(PAGE-ROW-CNT)         DTSCS35
01149         PERFORM P7914-CHECK-PAGE THRU P7914-EXIT                  DTSCS35
01150         PERFORM P7913-NORMAL-INFO THRU P7913-EXIT                 DTSCS35
01151         MOVE 'WEND' TO PAGE-MISC-1(PAGE-ROW-CNT)                  DTSCS35
01152         MOVE MADJ-DATE-2  TO L001-FED-8-DATE-9                    DTSCS35
01153         PERFORM P6912-SLASH-DATE THRU P6912-EXIT                  DTSCS35
01154         MOVE L001-SLASH-DATE TO PAGE-MISC-2(PAGE-ROW-CNT)         DTSCS35
01155      ELSE                                                         DTSCS35
01156      IF MADJ-INT-DATE-88                                          DTSCS35
01157         MOVE 'ISTR' TO PAGE-MISC-1(PAGE-ROW-CNT)                  DTSCS35
01158         MOVE MADJ-DATE-1  TO L001-FED-8-DATE-9                    DTSCS35
01159         PERFORM P6912-SLASH-DATE THRU P6912-EXIT                  DTSCS35
01160         MOVE L001-SLASH-DATE TO PAGE-MISC-2(PAGE-ROW-CNT)         DTSCS35
01161         PERFORM P7914-CHECK-PAGE THRU P7914-EXIT                  DTSCS35
01162         PERFORM P7913-NORMAL-INFO THRU P7913-EXIT                 DTSCS35
01163         MOVE 'IEND' TO PAGE-MISC-1(PAGE-ROW-CNT)                  DTSCS35
01164         MOVE MADJ-DATE-2  TO L001-FED-8-DATE-9                    DTSCS35
01165         PERFORM P6912-SLASH-DATE THRU P6912-EXIT                  DTSCS35
01166         MOVE L001-SLASH-DATE TO PAGE-MISC-2(PAGE-ROW-CNT)         DTSCS35
01167         PERFORM P7914-CHECK-PAGE THRU P7914-EXIT                  DTSCS35
01168         PERFORM P7913-NORMAL-INFO THRU P7913-EXIT                 DTSCS35
01169         MOVE 'ISPN' TO PAGE-MISC-1(PAGE-ROW-CNT)                  DTSCS35
01170         MOVE MADJ-INT-SPAN-IND TO PAGE-MISC-2(PAGE-ROW-CNT)       DTSCS35
01171         PERFORM P7914-CHECK-PAGE THRU P7914-EXIT                  DTSCS35
01172         PERFORM P7913-NORMAL-INFO THRU P7913-EXIT                 DTSCS35
01173         MOVE 'IRTE' TO PAGE-MISC-1(PAGE-ROW-CNT)                  DTSCS35
01174         MOVE MADJ-INT-RATE TO L056-RATE                           DTSCS35
01175         PERFORM S056-DISP1-RIGHT THRU S056-EXIT                   DTSCS35
01176         MOVE L056-DISP-RATE TO PAGE-MISC-2(PAGE-ROW-CNT)          DTSCS35
01177      ELSE                                                         DTSCS35
01178      IF MADJ-CMP-ESTB-ABSTIME > ZERO                              DTSCS35
01179         MOVE 'CMPRMISE' TO PAGE-MISC-2(PAGE-ROW-CNT)              DTSCS35
01180      ELSE                                                         DTSCS35
01181         MOVE SPACES TO PAGE-MISC-1(PAGE-ROW-CNT)                  DTSCS35
01182         MOVE SPACES TO PAGE-MISC-2(PAGE-ROW-CNT).                 DTSCS35
01183  P7911-EXIT.                                                      DTSCS35
01184      EXIT.                                                        DTSCS35
01185      EJECT                                                        DTSCS35
01186  P7913-NORMAL-INFO.                                               DTSCS35
01187      ADD +1 TO PAGE-ROW-CNT.                                      DTSCS35
01188      MOVE MADJ-DOC-NO        TO PAGE-DOC-NO(PAGE-ROW-CNT).        DTSCS35
01189      MOVE MADJ-ADJ-TYPE      TO PAGE-ADJ-TYPE(PAGE-ROW-CNT).      DTSCS35
01190      MOVE MADJ-AMT           TO PAGE-AMT(PAGE-ROW-CNT).           DTSCS35
01191      MOVE MADJ-RECEIVED-DATE TO PAGE-RECEIVED-DATE(PAGE-ROW-CNT). DTSCS35
01192      MOVE MADJ-ESTB-DATE     TO PAGE-PROCESSED-DATE(PAGE-ROW-CNT).DTSCS35
01193      MOVE MADJ-APPLIC-YRQ    TO PAGE-APPLIC-YRQ(PAGE-ROW-CNT).    DTSCS35
01194      MOVE MADJ-APPLIC-IND    TO PAGE-APPLIC-IND(PAGE-ROW-CNT).    DTSCS35
01195      MOVE MADJ-APPLIC-DOC-NO TO PAGE-APPLIC-DOC-NO(PAGE-ROW-CNT). DTSCS35
01196  P7913-EXIT. EXIT.                                                DTSCS35
01197                                                                   DTSCS35
01198  P7914-CHECK-PAGE.                                                DTSCS35
01199      IF PAGE-ROW-CNT < ROWS-PER-PAGE                              DTSCS35
01200          NEXT SENTENCE                                            DTSCS35
01201      ELSE                                                         DTSCS35
01202          PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT            DTSCS35
01203          MOVE +0 TO PAGE-ROW-CNT.                                 DTSCS35
01204  P7914-EXIT. EXIT.                                                DTSCS35
01205      EJECT                                                        DTSCS35
01206  P8100-STORE-PAGE-AREA.                                           DTSCS35
01207      IF ITEM-CNT < ITEM-MAX-LCCM                                  DTSCS35
01208          ADD +1 TO ITEM-CNT                                       DTSCS35
01209          MOVE PAGE-AREA TO LCCM-SCR-HOLD-PAGE-AREA (ITEM-CNT)     DTSCS35
01210          GO TO P8100-EXIT.                                        DTSCS35
01211                                                                   DTSCS35
01212      IF ITEM-CNT < ITEM-MAX                                       DTSCS35
01213          ADD +1 TO ITEM-CNT                                       DTSCS35
01214          MOVE PAGE-AREA TO L829-REC                               DTSCS35
01215          PERFORM S829-WRITE THRU S829-EXIT.                       DTSCS35
01216  P8100-EXIT.                                                      DTSCS35
01217      EXIT.                                                        DTSCS35
01218                                                                   DTSCS35
01219  P8200-RETREIVE-PAGE-AREA.                                        DTSCS35
01220      IF ITEM-SUB > ITEM-MAX-LCCM                                  DTSCS35
01221          COMPUTE L829-ITEM-NO = ITEM-SUB - ITEM-MAX-LCCM          DTSCS35
01222          PERFORM S829-READ-ITEM THRU S829-EXIT                    DTSCS35
01223          IF L829-NO-REC-88                                        DTSCS35
01224              GO TO S899-ABEND                                     DTSCS35
01225          ELSE                                                     DTSCS35
01226              MOVE L829-REC TO PAGE-AREA                           DTSCS35
01227      ELSE                                                         DTSCS35
01228          MOVE LCCM-SCR-HOLD-PAGE-AREA (ITEM-SUB) TO PAGE-AREA.    DTSCS35
01229  P8200-EXIT.                                                      DTSCS35
01230      EXIT.                                                        DTSCS35
01231 /*****************************************************************DTSCS35
01232 * LINKS TO UTILITY MODULES                                        DTSCS35
01233 ******************************************************************DTSCS35
01234                                                                   DTSCS35
01235 *S001-FROM-FED-8.                                                 DTSCS35
01236 *****SET L001-FROM-FED-8 TO TRUE.                                 DTSCS35
01237 *****GO TO S001-DATE.                                             DTSCS35
01238                                                                   DTSCS35
01239 *S001-FROM-ABS-DATE.                                              DTSCS35
01240 *****SET L001-FROM-ABS-DAY TO TRUE.                               DTSCS35
01241 *****GO TO S001-DATE.                                             DTSCS35
01242                                                                   DTSCS35
01243 *S001-DATE.                                                       DTSCS35
01244 *****EXEC CICS LINK                                               DTSCS35
01245 *****    PROGRAM('MACCU001')                                      DTSCS35
01246 *****    COMMAREA(L001-COMM-AREA)                                 DTSCS35
01247 *****    LENGTH(L001-LENGTH)                                      DTSCS35
01248 *****END-EXEC.                                                    DTSCS35
01249 *S001-EXIT.                                                       DTSCS35
01250 *****EXIT.                                                        DTSCS35
01251                                                                   DTSCS35
01252 *S004-FROM-5.                                                     DTSCS35
01253 *****SET L004-FROM-5 TO TRUE.                                     DTSCS35
01254 *****GO TO S004-QTR.                                              DTSCS35
01255                                                                   DTSCS35
01256 *S004-FROM-ABS.                                                   DTSCS35
01257 *****SET L004-FROM-ABS TO TRUE.                                   DTSCS35
01258 *****GO TO S004-QTR.                                              DTSCS35
01259                                                                   DTSCS35
01260 *S004-QTR.                                                        DTSCS35
01261 *****EXEC CICS LINK                                               DTSCS35
01262 *****    PROGRAM('MACCU004')                                      DTSCS35
01263 *****    COMMAREA(L004-COMM-AREA)                                 DTSCS35
01264 *****    LENGTH(L004-LENGTH)                                      DTSCS35
01265 *****END-EXEC.                                                    DTSCS35
01266 *S004-EXIT.                                                       DTSCS35
01267 *****EXIT.                                                        DTSCS35
01268                                                                   DTSCS35
01269  S018-EMP-NO-FROM-SCREEN.                                         DTSCS35
01270      EXEC CICS LINK                                               DTSCS35
01271          PROGRAM('DTSCU018')                                      DTSCS35
01272          COMMAREA(L018-COMM-AREA)                                 DTSCS35
01273      END-EXEC.                                                    DTSCS35
01274  S018-EXIT.                                                       DTSCS35
01275      EXIT.                                                        DTSCS35
01276                                                                   DTSCS35
01277  S029-YRQ-FROM-SCREEN.                                            DTSCS35
01278      EXEC CICS LINK                                               DTSCS35
01279          PROGRAM('DTSCU029')                                      DTSCS35
01280          COMMAREA(L029-COMM-AREA)                                 DTSCS35
01281      END-EXEC.                                                    DTSCS35
01282  S029-EXIT.                                                       DTSCS35
01283      EXIT.                                                        DTSCS35
01284                                                                   DTSCS35
01285  S056-DISP1-RIGHT.                                                DTSCS35
01286      SET L056-DISP1-RIGHT-88 TO TRUE.                             DTSCS35
01287      GO TO S056-RATE-DISPLAY.                                     DTSCS35
01288                                                                   DTSCS35
01289  S056-RATE-DISPLAY.                                               DTSCS35
01290      EXEC CICS LINK                                               DTSCS35
01291          PROGRAM('DTSCU056')                                      DTSCS35
01292          COMMAREA(L056-COMM-AREA)                                 DTSCS35
01293      END-EXEC.                                                    DTSCS35
01294  S056-EXIT.                                                       DTSCS35
01295      EXIT.                                                        DTSCS35
01296                                                                   DTSCS35
01297  S803-REQ-SCR-ID-EDIT.                                            DTSCS35
01298      EXEC CICS LINK                                               DTSCS35
01299          PROGRAM ('DTSCU803')                                     DTSCS35
01300          COMMAREA (DFHCOMMAREA)                                   DTSCS35
01301      END-EXEC.                                                    DTSCS35
01302  S803-EXIT.                                                       DTSCS35
01303      EXIT.                                                        DTSCS35
01304                                                                   DTSCS35
01305  S804-INVALID-KEY.                                                DTSCS35
01306      EXEC CICS LINK                                               DTSCS35
01307          PROGRAM ('DTSCU804')                                     DTSCS35
01308          COMMAREA (DFHCOMMAREA)                                   DTSCS35
01309      END-EXEC.                                                    DTSCS35
01310  S804-EXIT.                                                       DTSCS35
01311      EXIT.                                                        DTSCS35
01312                                                                   DTSCS35
01313  S805-MSG-AREA.                                                   DTSCS35
01314      MOVE LCCM-MSG-AREA TO L805-MSG-AREA                          DTSCS35
01315                                                                   DTSCS35
01316      EXEC CICS LINK                                               DTSCS35
01317          PROGRAM ('DTSCU805')                                     DTSCS35
01318          COMMAREA (L805-COMM-AREA)                                DTSCS35
01319      END-EXEC.                                                    DTSCS35
01320                                                                   DTSCS35
01321      MOVE L805-S-MSG-AREA TO MAP-MSG-AREA.                        DTSCS35
01322  S805-EXIT.                                                       DTSCS35
01323      EXIT.                                                        DTSCS35
01324      EJECT                                                        DTSCS35
01325  S810-READ.                                                       DTSCS35
01326      SET L810-READ-88 TO TRUE.                                    DTSCS35
01327      GO TO S810-IO.                                               DTSCS35
01328                                                                   DTSCS35
01329  S810-START-BROWSE.                                               DTSCS35
01330      SET L810-START-BROWSE-88 TO TRUE.                            DTSCS35
01331      GO TO S810-IO.                                               DTSCS35
01332                                                                   DTSCS35
01333 *S810-READ-NEXT.                                                  DTSCS35
01334 *****SET L810-READ-NEXT-88 TO TRUE.                               DTSCS35
01335 *****GO TO S810-IO.                                               DTSCS35
01336                                                                   DTSCS35
01337  S810-READ-PREV.                                                  DTSCS35
01338      SET L810-READ-PREV-88 TO TRUE.                               DTSCS35
01339      GO TO S810-IO.                                               DTSCS35
01340                                                                   DTSCS35
01341 *S810-END-BROWSE.                                                 DTSCS35
01342 *****SET L810-END-BROWSE-88 TO TRUE.                              DTSCS35
01343 *****GO TO S810-IO.                                               DTSCS35
01344                                                                   DTSCS35
01345  S810-COUNT.                                                      DTSCS35
01346      SET L810-COUNT-88 TO TRUE.                                   DTSCS35
01347      GO TO S810-IO.                                               DTSCS35
01348                                                                   DTSCS35
01349 *S810-REWRITE.                                                    DTSCS35
01350 *****SET L810-REWRITE-88 TO TRUE.                                 DTSCS35
01351 *****GO TO S810-IO.                                               DTSCS35
01352 *****                                                             DTSCS35
01353 *S810-WRITE.                                                      DTSCS35
01354 *****SET L810-WRITE-88 TO TRUE.                                   DTSCS35
01355 *****GO TO S810-IO.                                               DTSCS35
01356 *****                                                             DTSCS35
01357 *S810-DELETE.                                                     DTSCS35
01358 *****SET L810-DELETE-88 TO TRUE.                                  DTSCS35
01359 *****GO TO S810-IO.                                               DTSCS35
01360                                                                   DTSCS35
01361  S810-IO.                                                         DTSCS35
01362                                                                   DTSCS35
01363      EXEC CICS LINK                                               DTSCS35
01364          PROGRAM ('DTSCU810')                                     DTSCS35
01365          COMMAREA (L810-COMM-AREA)                                DTSCS35
01366      END-EXEC.                                                    DTSCS35
01367                                                                   DTSCS35
01368      IF L810-FILE-CLOSED-88                                       DTSCS35
01369          MOVE L810-MSG-AREA TO LCCM-MSG-AREA                      DTSCS35
01370          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS35
01371          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS35
01372          GO TO MAINLINE-EXIT.                                     DTSCS35
01373  S810-EXIT.                                                       DTSCS35
01374      EXIT.                                                        DTSCS35
01375      EJECT                                                        DTSCS35
01376  S829-READ-ITEM.                                                  DTSCS35
01377      SET L829-READ-ITEM-88 TO TRUE.                               DTSCS35
01378      GO TO S829-IO.                                               DTSCS35
01379                                                                   DTSCS35
01380  S829-WRITE.                                                      DTSCS35
01381      SET L829-WRITE-88 TO TRUE.                                   DTSCS35
01382      GO TO S829-IO.                                               DTSCS35
01383                                                                   DTSCS35
01384  S829-DELETE-QUEUE.                                               DTSCS35
01385      SET L829-DELETE-QUEUE-88 TO TRUE.                            DTSCS35
01386      GO TO S829-IO.                                               DTSCS35
01387                                                                   DTSCS35
01388  S829-IO.                                                         DTSCS35
01389      MOVE LCCM-TS-NAME-PREFIX TO L829-QUEUE-NAME-PREFIX.          DTSCS35
01390      MOVE 'S' TO L829-QUEUE-NAME-SUFFIX.                          DTSCS35
01391      MOVE ITEM-LENGTH TO L829-REC-LENGTH.                         DTSCS35
01392      SET L829-DEFAULT-STORAGE-88 TO TRUE.                         DTSCS35
01393                                                                   DTSCS35
01394      EXEC CICS                                                    DTSCS35
01395          LINK                                                     DTSCS35
01396              PROGRAM ('DTSCU829')                                 DTSCS35
01397              COMMAREA (L829-COMM-AREA)                            DTSCS35
01398      END-EXEC.                                                    DTSCS35
01399  S829-EXIT.                                                       DTSCS35
01400      EXIT.                                                        DTSCS35
01401      EJECT                                                        DTSCS35
01402  S851-SCREEN-PROCESSING.                                          DTSCS35
01403      EXEC CICS LINK                                               DTSCS35
01404          PROGRAM ('DTSCU851')                                     DTSCS35
01405          COMMAREA (L851-COMM-AREA)                                DTSCS35
01406      END-EXEC.                                                    DTSCS35
01407  S851-EXIT.                                                       DTSCS35
01408      EXIT.                                                        DTSCS35
01409                                                                   DTSCS35
01410  S899-ABEND.                                                      DTSCS35
01411      EXEC CICS ABEND                                              DTSCS35
01412          ABCODE(WRK-ABEND-CD)                                     DTSCS35
01413      END-EXEC.                                                    DTSCS35
01414  S899-EXIT.                                                       DTSCS35
01415      EXIT.                                                        DTSCS35
01416      EJECT                                                        DTSCS35
01417  S1100-EDIT-KEY.                                                  DTSCS35
01418      PERFORM S1101-EMP-NO              THRU S1101-EXIT.           DTSCS35
01419  S1100-EXIT. EXIT.                                                DTSCS35
01420 /*****************************************************************DTSCS35
01421 *                                                                 DTSCS35
01422 ******************************************************************DTSCS35
01423  S1101-EMP-NO.                                                    DTSCS35
01424      MOVE MAP-EMP-NO-AREA            TO L018-S-EMP-NO-AREA.       DTSCS35
01425      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS35
01426                                                                   DTSCS35
01427      IF L018-NO-ENTRY                                             DTSCS35
01428         MOVE EMSG-FIELD-REQUIRED     TO WRK-MSG-AREA              DTSCS35
01429         PERFORM S1199-ERROR          THRU S1199-EXIT              DTSCS35
01430         GO TO S1101-EXIT.                                         DTSCS35
01431                                                                   DTSCS35
01432      IF L018-NOT-VALID                                            DTSCS35
01433         MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA              DTSCS35
01434         PERFORM S1199-ERROR          THRU S1199-EXIT              DTSCS35
01435         GO TO S1101-EXIT.                                         DTSCS35
01436                                                                   DTSCS35
01437      MOVE L018-EMP-NO                TO WRK-EMP-NO.               DTSCS35
01438                                                                   DTSCS35
01439      PERFORM S1110-READ-MPRF THRU S1110-EXIT.                     DTSCS35
01440  S1101-EXIT. EXIT.                                                DTSCS35
01441                                                                   DTSCS35
01442  S1110-READ-MPRF.                                                 DTSCS35
01443      MOVE LOW-VALUES TO MPRF-KEY-AREA.                            DTSCS35
01444      MOVE WRK-EMP-NO TO MPRF-EMP-NO.                              DTSCS35
01445      SET MPRF-PRF-88 TO TRUE.                                     DTSCS35
01446      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS35
01447      PERFORM S810-READ THRU S810-EXIT.                            DTSCS35
01448      IF L810-NO-REC-88                                            DTSCS35
01449          MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA                    DTSCS35
01450          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS35
01451      ELSE                                                         DTSCS35
01452          MOVE MSKL-REC TO MPRF-REC                                DTSCS35
01453          SET WRK-MPRF-YES-88 TO TRUE.                             DTSCS35
01454  S1110-EXIT.                                                      DTSCS35
01455      EXIT.                                                        DTSCS35
01456                                                                   DTSCS35
01457  S1199-ERROR.                                                     DTSCS35
01458      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A            DTSCS35
01459                                         MAP-EMP-NO-2-A.           DTSCS35
01460      IF LCCM-NO-MSG                                               DTSCS35
01461         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS35
01462         MOVE CATB-CURSOR             TO MAP-EMP-NO-1-L            DTSCS35
01463         SET CURSOR-SET-YES TO TRUE.                               DTSCS35
01464  S1199-EXIT. EXIT.                                                DTSCS35
01465 /*****************************************************************DTSCS35
01466 *                                                                 DTSCS35
01467 ******************************************************************DTSCS35
01468  S1200-YRQ.                                                       DTSCS35
01469      MOVE MAP-YRQ-AREA TO L029-S-YRQ-AREA.                        DTSCS35
01470      PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT.                 DTSCS35
01471                                                                   DTSCS35
01472      IF L029-NO-ENTRY                                             DTSCS35
01473          MOVE +0 TO WRK-YRQ                                       DTSCS35
01474      ELSE                                                         DTSCS35
01475      IF L029-VALID                                                DTSCS35
01476          MOVE L029-YRQ TO WRK-YRQ                                 DTSCS35
01477      ELSE                                                         DTSCS35
01478          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS35
01479          PERFORM S1299-ERROR THRU S1299-EXIT.                     DTSCS35
01480  S1200-EXIT.                                                      DTSCS35
01481      EXIT.                                                        DTSCS35
01482                                                                   DTSCS35
01483  S1299-ERROR.                                                     DTSCS35
01484      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-YRQ-YR-A               DTSCS35
01485                                        MAP-YRQ-Q-A.               DTSCS35
01486                                                                   DTSCS35
01487      IF LCCM-NO-MSG                                               DTSCS35
01488          MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                       DTSCS35
01489          MOVE CATB-CURSOR TO MAP-YRQ-YR-L                         DTSCS35
01490          SET CURSOR-SET-YES TO TRUE.                              DTSCS35
01491  S1299-EXIT.                                                      DTSCS35
01492      EXIT.                                                        DTSCS35
01493 /*****************************************************************DTSCS35
01494 *  SET ATTRIBUTE BYTES FOR INQUIRY STATUS                        *DTSCS35
01495 ******************************************************************DTSCS35
01496  S5300-SET-INQ-ATTRB.                                             DTSCS35
01497      MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN                     DTSCS35
01498                                    WRK-ATB-NUM.                   DTSCS35
01499                                                                   DTSCS35
01500      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS35
01501  S5300-EXIT.                                                      DTSCS35
01502      EXIT.                                                        DTSCS35
01503                                                                   DTSCS35
01504  S5900-SET-ATTRB.                                                 DTSCS35
01505      MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A             DTSCS35
01506                                        MAP-EMP-NO-2-A.            DTSCS35
01507                                                                   DTSCS35
01508      MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-YRQ-YR-A                DTSCS35
01509                                       MAP-YRQ-Q-A.                DTSCS35
01510                                                                   DTSCS35
01511      MOVE CATB-ASKIP-BRT-MDTOFF  TO MAP-PRIMARY-NAME-A            DTSCS35
01512                                     MAP-CURR-PAGE-A               DTSCS35
01513                                     MAP-LAST-PAGE-A.              DTSCS35
01514                                                                   DTSCS35
01515      PERFORM                                                      DTSCS35
01516        VARYING ROW-OCC FROM 1 BY 1                                DTSCS35
01517        UNTIL ROW-OCC > ROWS-PER-PAGE                              DTSCS35
01518          MOVE CATB-ASKIP-BRT-MDTOFF                               DTSCS35
01519             TO MAP-LINE-A(ROW-OCC)                                DTSCS35
01520      END-PERFORM.                                                 DTSCS35
01521                                                                   DTSCS35
01522      MOVE CATB-UNPROT-BRT-AN-MDTOFF TO MAP-GOTO-A.                DTSCS35
01523  S5900-EXIT.                                                      DTSCS35
01524      EXIT.                                                        DTSCS35
01525 /*****************************************************************DTSCS35
01526 * MAP ROUTINES                                                   *DTSCS35
01527 ******************************************************************DTSCS35
01528  S9100-RECEIVE.                                                   DTSCS35
01529      SET L851-RECEIVE-88 TO TRUE.                                 DTSCS35
01530                                                                   DTSCS35
01531      MOVE WRK-SCR-ID TO L851-SCR-ID.                              DTSCS35
01532                                                                   DTSCS35
01533      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS35
01534                                                                   DTSCS35
01535      MOVE L851-AID TO LCCM-AID.                                   DTSCS35
01536      MOVE L851-CURSOR TO LCCM-CURSOR.                             DTSCS35
01537  S9100-EXIT.                                                      DTSCS35
01538      EXIT.                                                        DTSCS35
01539                                                                   DTSCS35
01540  S9200-SEND-DATAONLY.                                             DTSCS35
01541      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS35
01542                                                                   DTSCS35
01543      IF LCCM-NO-MSG                                               DTSCS35
01544          NEXT SENTENCE                                            DTSCS35
01545      ELSE                                                         DTSCS35
01546          PERFORM S805-MSG-AREA THRU S805-EXIT.                    DTSCS35
01547                                                                   DTSCS35
01548      IF CURSOR-SET-GOTO                                           DTSCS35
01549          MOVE CATB-CURSOR TO MAP-GOTO-L                           DTSCS35
01550      ELSE                                                         DTSCS35
01551          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCS35
01552                                                                   DTSCS35
01553      SET L851-SEND-DATAONLY-88 TO TRUE.                           DTSCS35
01554                                                                   DTSCS35
01555      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS35
01556                                                                   DTSCS35
01557      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS35
01558  S9200-EXIT.                                                      DTSCS35
01559      EXIT.                                                        DTSCS35
01560                                                                   DTSCS35
01561  S9300-SEND-MAP.                                                  DTSCS35
01562      MOVE  LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE.             DTSCS35
01563      MOVE  LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME.             DTSCS35
01564      MOVE  LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME.         DTSCS35
01565                                                                   DTSCS35
01566      PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.                 DTSCS35
01567                                                                   DTSCS35
01568      PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT.                   DTSCS35
01569                                                                   DTSCS35
01570      PERFORM S805-MSG-AREA THRU S805-EXIT.                        DTSCS35
01571                                                                   DTSCS35
01572      IF CURSOR-SET-NO                                             DTSCS35
01573          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCS35
01574                                                                   DTSCS35
01575      SET L851-SEND-88 TO TRUE.                                    DTSCS35
01576                                                                   DTSCS35
01577      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS35
01578                                                                   DTSCS35
01579      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS35
01580  S9300-EXIT.                                                      DTSCS35
01581      EXIT.                                                        DTSCS35
01582                                                                   DTSCS35
01583  S9320-INQUIRY-FKEYS.                                             DTSCS35
01584      MOVE CFKD-FIRST TO MAP-KEY-FIRST.                            DTSCS35
01585      MOVE CFKD-LAST TO MAP-KEY-LAST.                              DTSCS35
01586      MOVE CFKD-BACKWARD TO MAP-KEY-BACK.                          DTSCS35
01587      MOVE CFKD-FORWARD TO MAP-KEY-FWRD.                           DTSCS35
01588                                                                   DTSCS35
01589 *    PERFORM S9321-JUMP-KEYS THRU S9321-EXIT.                     DTSCS35
01590  S9320-EXIT.                                                      DTSCS35
01591      EXIT.                                                        DTSCS35
01592                                                                   DTSCS35
01593 *S9321-JUMP-KEYS.                                                 DTSCS35
01594 *    MOVE 'F9=QTR' TO MAP-KEY-QTR-INQ.                            DTSCS35
01595 *    MOVE 'F11=PAY' TO MAP-KEY-PAY-INQ.                           DTSCS35
01596 *    MOVE 'F10=RPT' TO MAP-KEY-RPT-INQ.                           DTSCS35
01597 *S9321-EXIT.                                                      DTSCS35
01598 *    EXIT.                                                        DTSCS35
01599                                                                   DTSCS35
01600  S9330-DSCR-FIELDS.                                               DTSCS35
01601      IF WRK-MPRF-YES-88                                           DTSCS35
01602          MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME               DTSCS35
01603      ELSE                                                         DTSCS35
01604          MOVE LOW-VALUES TO MAP-PRIMARY-NAME.                     DTSCS35
01605  S9330-EXIT.                                                      DTSCS35
01606      EXIT.                                                        DTSCS35
01607                                                                   DTSCS35
01608  S9900-PREPARE-SEND.                                              DTSCS35
01609      MOVE WRK-SCR-ID TO L851-SCR-ID                               DTSCS35
01610                         LCCM-SCR-ID.                              DTSCS35
01611      MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND.                    DTSCS35
01612      MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE.                         DTSCS35
01613  S9900-EXIT.                                                      DTSCS35
01614      EXIT.                                                        DTSCS35
