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