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