00001  IDENTIFICATION DIVISION.                                         07/28/14
00002  PROGRAM-ID.             DTSCS31.                                 DTSCS31
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV031
00004  DATE-WRITTEN.           JUNE 1994.                               DTSCS31
00005  DATE-COMPILED.                                                   DTSCS31
00006      SKIP3                                                        DTSCS31
00007 *****                                                             DTSCS31
00008 *                                                                 DTSCS31
00009 *    FUNCTION:  QUARTER INQUIRY SCREEN PROCESSOR.                 DTSCS31
00010 *                                                                 DTSCS31
00011 *                                                                 DTSCS31
00012 *    MODIFICATION LOG:                                            DTSCS31
00013 *                                                                 DTSCS31
00014 *    12/22/98  INITIAL DEVELOPMENT.    COPIED FROM MACCS31.       DTSCS31
00015 *              WORK ORDER:                      PROGRAMMER: ZL1   DTSCS31
00016 *                                                                 DTSCS31
00017 *                                                                 DTSCS31
00018 *    05/17/1999  PICKUP MODIFICATIONS.                            DTSCS31
00019 *                REFERENCE: PICKUP DIR          PROGRAMMER: EHH   DTSCS31
00020 *                                                                 DTSCS31
00021 *    11/20/2003  CORRECTED PAGING PROBLEM (F8 WHEN ANNUAL QUARTER DTSCS31
00022 *                DISPLAYED. ADDED CODE TO P6000 TO RESET          DTSCS31
00023 *                WRK-FROM-YRQ TO QUARTER FOLLOWING END OF ANNUAL  DTSCS31
00024 *                REPORT.                                          DTSCS31
00025 *                REFERENCE:                     PROGRAMMER: GD    DTSCS31
00026 *                                                                 DTSCS31
00027 *                                                                 DTSCS31
00028 *    06/08/2005  COMPROMISE SETTLEMENT PROBLEM - WHEN QUARTER     DTSCS31
00029 *                DID NOT EXIST, P6910 ABENDED WHILE REFERENCING   DTSCS31
00030 *                MQTR-CMP-ESTB-ABSTIME.                           DTSCS31
00031 *                REFERENCE:                     PROGRAMMER: GD    DTSCS31
00032 *                                                                 DTSCS31
00033 *    02/20/2006  INTEREST CALCULATION MODIFIED - ONLY UI TAX      DTSCS31
00034 *                BALANCE USED IN CALCULATION - P6922, P7310.      DTSCS31
00035 *                REFERENCE: ADMIN ASSESSMENT    PROGRAMMER: GD    DTSCS31
00036 *                                                                 DTSCS31
00037 *    02/12/2008  INTEREST CALCULATION MODIFIED TO INCLUDE         DTSCS31
00038 *                SUR TAX IN CALCULATION - P6922, P7310.           DTSCS31
00039 *                REFERENCE: ADMIN ASSESSMENT    PROGRAMMER: ZL1   DTSCS31
00040 *                                                                 DTSCS31
00041 *                                                                 DTSCS31
00042 *    07/07/2014  MODIFIED P7100 NOT TO COUNT INACTIVE WIDTHDRAWN  DTSCS31
00043 *                SPANS OF LIABILITY IN #SPANS FIELD.              DTSCS31
00044 *                REFERENCE: SOL                 PROGRAMMER: ZL1   DTSCS31
00045 *                                                                 DTSCS31
00046 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS31
00047 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS31
00048 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSCS31
00049 *                                                                 DTSCS31
00050 *                                                                 DTSCS31
00051 *  DESCRIPTION:                                                   DTSCS31
00052 *                                                                 DTSCS31
00053 *    CLEAR:                                                       DTSCS31
00054 *                                                                 DTSCS31
00055 *      FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO).            DTSCS31
00056 *                                                                 DTSCS31
00057 *                                                                 DTSCS31
00058 *    JUMP:                                                        DTSCS31
00059 *                                                                 DTSCS31
00060 *      F09  NOTE PAD INQUIRY/UPDATE (71).                         DTSCS31
00061 *      F10  REPORT INQUIRY (33).                                  DTSCS31
00062 *      F11  PAYMENT INQUIRY (34).                                 DTSCS31
00063 *      F12  ADJUSTMENT INQUIRY (35).                              DTSCS31
00064 *      F17  REGISTRATION INQUIRY (11).                            DTSCS31
00065 *      F20  COLLECTIONS INQUIRY (41).                             DTSCS31
00066 *                                                                 DTSCS31
00067 *                                                                 DTSCS31
00068 *    INQUIRY:                                                     DTSCS31
00069 *                                                                 DTSCS31
00070 *      CONTROL FIELD(S): MAP-EMP-NO                               DTSCS31
00071 *                        MAP-START-YRQ                            DTSCS31
00072 *                        MAP-END-YRQ.                             DTSCS31
00073 *                                                                 DTSCS31
00074 *                                                                 DTSCS31
00075 *      JUMP IN:  IF LCCM-EMP-NO = +0                              DTSCS31
00076 *                    DISPLAY 'PLEASE ENTER' MESSAGE               DTSCS31
00077 *                ELSE                                             DTSCS31
00078 *                    IF LCCM-YRQ = +0                             DTSCS31
00079 *                        DISPLAY LAST PAGE OF DATA ASSOCIATED     DTSCS31
00080 *                        WITH LCCM-EMP-NO                         DTSCS31
00081 *                    ELSE                                         DTSCS31
00082 *                        IF LCCM-YRQ MQTR RECORD EXISTS           DTSCS31
00083 *                            DISPLAY THE LCCM-YRQ MQTR RECORD     DTSCS31
00084 *                        ELSE                                     DTSCS31
00085 *                            DISPLAY LAST PAGE OF DATA ASSOCIATED DTSCS31
00086 *                            WITH LCCM-EMP-NO.                    DTSCS31
00087 *                                                                 DTSCS31
00088 *                                                                 DTSCS31
00089 *                                                                 DTSCS31
00090 *      ENTER, F05, F06, F07, F08: PAGE THRU MQTR RECORD.          DTSCS31
00091 *                                                                 DTSCS31
00092 *                                 MAP-END-YRQ HAS NO EFFECT WHEN  DTSCS31
00093 *                                 A PAGING FUNCTION KEY IS        DTSCS31
00094 *                                 PRESSED.                        DTSCS31
00095 *                                                                 DTSCS31
00096 *               DISPLAY SEQUENCE: ASCENDING ON MQTR-YRQ           DTSCS31
00097 *                                 (SEE SCREEN DESCRIPTION         DTSCS31
00098 *                                  FOR DETAILS).                  DTSCS31
00099 *                                                                 DTSCS31
00100 *       PAGE INITIALLY DISPLAYED: LAST.                           DTSCS31
00101 *                                                                 DTSCS31
00102 *                                                                 DTSCS31
00103 *      TRY FOR SOME EFFICIENCY.                                   DTSCS31
00104 *                                                                 DTSCS31
00105 *        .  CONSTRUCT EMPLOYER LEVEL INFORMATION IN               DTSCS31
00106 *           LCCM-SCR-HOLD-AREA AND/OR IN TS.                      DTSCS31
00107 *                                                                 DTSCS31
00108 *        .  SCAN MQTR RECORDS ONCE (RATHER THAN TWICE: ONCE       DTSCS31
00109 *           WHILE BUILDING EMPLOYER LEVEL INFORMATION; AND        DTSCS31
00110 *           ONCE WHILE BUILDING QUARTER LEVEL INFORMATION).       DTSCS31
00111 *                                                                 DTSCS31
00112 *        .  UNTIL EMP-NO CHANGES, COMP-DATE CHANGES, OR THE       DTSCS31
00113 *           HELD INFOMATION IS OUT OF DATE, DISPLAY SCREENS FROM  DTSCS31
00114 *           INFORMATION STORED IN LCCM-SCR-HOLD-AREA AND/OR TS.   DTSCS31
00115 *                                                                 DTSCS31
00116 *                                                                 DTSCS31
00117 *      JUMP OUT:  STORE INFORMATION REPRESENTING PAGE             DTSCS31
00118 *                 CURRENTLY DISPLAYED IN LCCM-SCR31-HOLD-AREA.    DTSCS31
00119 *                                                                 DTSCS31
00120 *                 DELETE TEMPORARY STORAGE QUEUE 'S'.             DTSCS31
00121 *                                                                 DTSCS31
00122 *                                                                 DTSCS31
00123 *    LCCM-MISC-CONTROL-AREA MAINTENANCE:                          DTSCS31
00124 *                                                                 DTSCS31
00125 *      LCCM-EMP-NO                                                DTSCS31
00126 *                                                                 DTSCS31
00127 *      LCCM-YRQ                                                   DTSCS31
00128 *                                                                 DTSCS31
00129 *      LCCM-COMP-DATE                                             DTSCS31
00130 *                                                                 DTSCS31
00131 *                                                                 DTSCS31
00132 *    UPDATE:                                                      DTSCS31
00133 *                                                                 DTSCS31
00134 *      NONE.                                                      DTSCS31
00135 *                                                                 DTSCS31
00136 *                                                                 DTSCS31
00137 *    RECORDS READ:                                                DTSCS31
00138 *                                                                 DTSCS31
00139 *      MASTER:                                                    DTSCS31
00140 *                                                                 DTSCS31
00141 *        MPRF                                                     DTSCS31
00142 *        MSOL                                                     DTSCS31
00143 *        MQTR                                                     DTSCS31
00144 *        MAPL                                                     DTSCS31
00145 *        MLIN                                                     DTSCS31
00146 *        MDPC                                                     DTSCS31
00147 *        MCOL                                                     DTSCS31
00148 *                                                                 DTSCS31
00149 *                                                                 DTSCS31
00150 *      ALTERNATE INDEX:                                           DTSCS31
00151 *                                                                 DTSCS31
00152 *        NONE.                                                    DTSCS31
00153 *                                                                 DTSCS31
00154 *                                                                 DTSCS31
00155 *      REFERENCE:                                                 DTSCS31
00156 *                                                                 DTSCS31
00157 *        NONE.                                                    DTSCS31
00158 *                                                                 DTSCS31
00159 *                                                                 DTSCS31
00160 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS31
00161 *                                                                 DTSCS31
00162 *        NONE.                                                    DTSCS31
00163 *                                                                 DTSCS31
00164 *                                                                 DTSCS31
00165 *    RECORDS UPDATED:                                             DTSCS31
00166 *                                                                 DTSCS31
00167 *      MASTER:                                                    DTSCS31
00168 *                                                                 DTSCS31
00169 *        NONE.                                                    DTSCS31
00170 *                                                                 DTSCS31
00171 *                                                                 DTSCS31
00172 *      REFERENCE:                                                 DTSCS31
00173 *                                                                 DTSCS31
00174 *        NONE.                                                    DTSCS31
00175 *                                                                 DTSCS31
00176 *                                                                 DTSCS31
00177 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS31
00178 *                                                                 DTSCS31
00179 *        NONE.                                                    DTSCS31
00180 *                                                                 DTSCS31
00181 *                                                                 DTSCS31
00182 *    ON-LINE ACTIVITY FILE RECORDS WRITTEN:                       DTSCS31
00183 *                                                                 DTSCS31
00184 *      NONE.                                                      DTSCS31
00185 *                                                                 DTSCS31
00186 *                                                                 DTSCS31
00187 *    TEMPORARY STORAGE USAGE:                                     DTSCS31
00188 *                                                                 DTSCS31
00189 *      S  IF NECESSARY FOR PAGE CONSTRUCTION/CONTROL.             DTSCS31
00190 *                                                                 DTSCS31
00191 *                                                                 DTSCS31
00192 *    MODULES LINKED TO:                                           DTSCS31
00193 *                                                                 DTSCS31
00194 *      DTSCU001  DATE EDIT/CONVERSION.                            DTSCS31
00195 *      DTSCU004  QUARTER EDIT/CONVERSION.                         DTSCS31
00196 *      DTSCU015  DATE FROM SCREEN FORMAT/EDIT.                    DTSCS31
00197 *      DTSCU016  YEAR/QUARTER FROM SCREEN FORMAT/EDIT.            DTSCS31
00198 *      DTSCU018  EMPLOYER NUMBER FROM SCREEN FORMAT/EDIT.         DTSCS31
00199 *      DTSCU031  EMPLOYER REGISTRATION CODES EDIT/DESCRIPTION.    DTSCS31
00200 *      DTSCU032  ACCOUNTING CODES EDIT/DESCRIPTION.               DTSCS31
00201 *      DTSCU033  REPORT TYPE/PURSUED DESCRIPTION.                 DTSCS31
00202 *      DTSCU056  RATE DISPLAY.                                    DTSCS31
00203 *      DTSCU061  FIELD ZIP / FIELD REP ID.                        DTSCS31
00204 *      DTSCU101  INTEREST AND PENALTY CHARGE/ABATEMENT            DTSCS31
00205 *                CALCULATION.                                     DTSCS31
00206 *      DTSCU109  AFT, FLA, SUR RATE LOOKUP.                       DTSCS31
00207 *      DTSCU810  MASTER FILE INPUT/OUTPUT.                        DTSCS31
00208 *                                                                 DTSCS31
00209 *                                                                 DTSCS31
00210 *    VERMONT REFERENCE:                                           DTSCS31
00211 *                                                                 DTSCS31
00212 *      TXC210C.                                                   DTSCS31
00213 *                                                                 DTSCS31
00214 *****                                                             DTSCS31
00215                                                                   DTSCS31
00216  ENVIRONMENT DIVISION.                                            DTSCS31
00217                                                                   DTSCS31
00218  DATA DIVISION.                                                   DTSCS31
00219                                                                   DTSCS31
00220  WORKING-STORAGE SECTION.                                         DTSCS31
002205 77  PAN-VALET PICTURE X(24) VALUE '031DTSCS31   07/28/14'.       DTSCS31
00221  77  PAN-VALET PICTURE X(24) VALUE '003DTSCS31   07/07/14'.       DTSCS31
00222  77  PAN-VALET PICTURE X(24) VALUE '029DTSCS31   05/19/08'.       DTSCS31
00223                                                                   DTSCS31
00224  01  WRK-LITS.                                                    DTSCS31
00225      05  LIT-UI-SUB          PIC S9(04)  COMP  VALUE +1.          DTSCS31
00226      05  LIT-SUR-SUB         PIC S9(04)  COMP  VALUE +2.          DTSCS31
00227      05  LIT-TAX-SUB         PIC S9(04)  COMP  VALUE +3.          DTSCS31
00228      05  LIT-INT-SUB         PIC S9(04)  COMP  VALUE +4.          DTSCS31
00229      05  LIT-LATE-PEN-SUB    PIC S9(04)  COMP  VALUE +5.          DTSCS31
00230      05  LIT-NSF-PEN-SUB     PIC S9(04)  COMP  VALUE +6.          DTSCS31
00231      05  LIT-MISC-PEN-SUB    PIC S9(04)  COMP  VALUE +7.          DTSCS31
00232      05  LIT-TOT-SUB         PIC S9(04)  COMP  VALUE +8.          DTSCS31
00233                                                                   DTSCS31
00234      05  LIT-CHARGED         PIC S9(04)  COMP  VALUE +1.          DTSCS31
00235      05  LIT-PAID            PIC S9(04)  COMP  VALUE +2.          DTSCS31
00236      05  LIT-WAIVED          PIC S9(04)  COMP  VALUE +3.          DTSCS31
00237      05  LIT-WOFF-TOLER      PIC S9(04)  COMP  VALUE +4.          DTSCS31
00238      05  LIT-BALANCE         PIC S9(04)  COMP  VALUE +5.          DTSCS31
00239                                                                   DTSCS31
00240      05  LIT-ZERO-YRQ        PIC S9(05) COMP-3 VALUE +0.          DTSCS31
00241                                                                   DTSCS31
00242      05  LIT-9-YRQ           PIC S9(05) COMP-3 VALUE +99999.      DTSCS31
00243                                                                   DTSCS31
00244  01  WRK-AREA.                                                    DTSCS31
00245      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'S31 '.    DTSCS31
00246                                                                   DTSCS31
00247      05  WRK-SCR-ID.                                              DTSCS31
00248          10  WRK-SCR-ID-N            PIC  9(02)  VALUE 31.        DTSCS31
00249                                                                   DTSCS31
00250      05  WRK-F03-SCR-ID              PIC  X(02)  VALUE '30'.      DTSCS31
00251                                                                   DTSCS31
00252      05  ALL-NINES-DATE              PIC S9(09)  COMP-3           DTSCS31
00253                                             VALUE +999999999.     DTSCS31
00254                                                                   DTSCS31
00255      05  SCR-ACCESS-IND              PIC X(01).                   DTSCS31
00256          88  SCR-ACCESS-INQ                  VALUE '1'.           DTSCS31
00257          88  SCR-ACCESS-UPDATE               VALUE '2'.           DTSCS31
00258                                                                   DTSCS31
00259      05  CURSOR-SET-IND              PIC X(01).                   DTSCS31
00260          88  CURSOR-SET-YES                  VALUE 'Y'.           DTSCS31
00261          88  CURSOR-SET-NO                   VALUE 'N'.           DTSCS31
00262          88  CURSOR-SET-GOTO                 VALUE 'G'.           DTSCS31
00263                                                                   DTSCS31
00264      05  REQ-IND                     PIC X(01).                   DTSCS31
00265          88  REQ-CURSOR-TO-GOTO              VALUE 'G'.           DTSCS31
00266          88  REQ-ERROR                       VALUE 'O'.           DTSCS31
00267          88  REQ-JUMP                        VALUE 'J'.           DTSCS31
00268          88  REQ-UPDATE                      VALUE 'U'.           DTSCS31
00269          88  REQ-INQUIRE                     VALUE 'I'.           DTSCS31
00270          88  REQ-CLEAR                       VALUE 'C'.           DTSCS31
00271          88  REQ-EDIT                        VALUE 'E'.           DTSCS31
00272                                                                   DTSCS31
00273      05  RESP-IND                    PIC X(01).                   DTSCS31
00274          88  RESP-SEND-MSGONLY               VALUE 'O'.           DTSCS31
00275          88  RESP-SEND-MAP                   VALUE 'M'.           DTSCS31
00276          88  RESP-JUMP                       VALUE 'J'.           DTSCS31
00277          88  RESP-CURSOR-TO-GOTO             VALUE 'G'.           DTSCS31
00278                                                                   DTSCS31
00279      05  WRK-MSG-AREA                PIC  X(64).                  DTSCS31
00280                                                                   DTSCS31
00281      05  WRK-ATB-AN                  PIC  X(01).                  DTSCS31
00282                                                                   DTSCS31
00283      05  WRK-ATB-NUM                 PIC  X(01).                  DTSCS31
00284                                                                   DTSCS31
00285      05  WRK-EMP-NO                  PIC S9(07)  COMP-3.          DTSCS31
00286                                                                   DTSCS31
00287      05  WRK-KEY-AREA                PIC  X(16).                  DTSCS31
00288                                                                   DTSCS31
00289      05  WRK-ROW                     PIC S9(04)  COMP.            DTSCS31
00290                                                                   DTSCS31
00291      05  WRK-COL                     PIC S9(04)  COMP.            DTSCS31
00292                                                                   DTSCS31
00293      05  WRK-FROM-YRQ                PIC S9(05)  COMP-3.          DTSCS31
00294          88  WRK-FROM-NO-ENTRY   VALUE +99998.                    DTSCS31
00295                                                                   DTSCS31
00296      05  WRK-TO-YRQ                  PIC S9(05)  COMP-3.          DTSCS31
00297          88  WRK-TO-NO-ENTRY     VALUE +1.                        DTSCS31
00298                                                                   DTSCS31
00299      05  WRK-HOLD-FROM-YRQ-AREA      PIC  X(09).                  DTSCS31
00300      05  WRK-HOLD-TO-YRQ-AREA        PIC  X(09).                  DTSCS31
00301                                                                   DTSCS31
00302      05  WRK-MPRF-IND                PIC  X(01).                  DTSCS31
00303          88  WRK-MPRF-YES-88                VALUE 'Y'.            DTSCS31
00304          88  WRK-MPRF-NO-88                 VALUE 'N'.            DTSCS31
00305                                                                   DTSCS31
00306      05  WRK-MQTR-IND                PIC  X(01).                  DTSCS31
00307          88  WRK-MQTR-YES-88                VALUE 'Y'.            DTSCS31
00308          88  WRK-MQTR-NO-88                 VALUE 'N'.            DTSCS31
00309                                                                   DTSCS31
00310      05  WRK-RANGE-IND               PIC  X(01).                  DTSCS31
00311          88  WRK-RANGE-YES                  VALUE 'Y' 'A'.        DTSCS31
00312          88  WRK-RANGE-NO                   VALUE 'N'.            DTSCS31
00313          88  WRK-RANGE-ANNUAL               VALUE 'A'.            DTSCS31
00314                                                                   DTSCS31
00315      05  WRK-SUPPRESS-ANN-RANGE-IND   PIC  X(01).                 DTSCS31
00316          88 WRK-SUPPRESS-ANN-RANGE-YES      VALUE 'Y'.            DTSCS31
00317          88 WRK-SUPPRESS-ANN-RANGE-NO       VALUE 'N'.            DTSCS31
00318                                                                   DTSCS31
00319      05  WRK-DISPLAY-ZEROS-IND       PIC  X(01).                  DTSCS31
00320          88  WRK-DISPLAY-ZEROS-YES          VALUE 'Y'.            DTSCS31
00321          88  WRK-DISPLAY-ZEROS-NO           VALUE 'N'.            DTSCS31
00322                                                                   DTSCS31
00323      05  WRK-DISPLAY                 PIC 9(11).                   DTSCS31
00324                                                                   DTSCS31
00325      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS31
00326          10  FILLER                  PIC X(05).                   DTSCS31
00327          10  WRK-DISPLAY-EMP-NO-1    PIC X(03).                   DTSCS31
00328          10  WRK-DISPLAY-EMP-NO-2    PIC X(03).                   DTSCS31
00329                                                                   DTSCS31
00330      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS31
00331          10  FILLER                  PIC X(05).                   DTSCS31
00332          10  WRK-DISPLAY-YR          PIC X(02).                   DTSCS31
00333          10  WRK-DISPLAY-MO          PIC X(02).                   DTSCS31
00334          10  WRK-DISPLAY-DA          PIC X(02).                   DTSCS31
00335                                                                   DTSCS31
00336      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS31
00337          10  FILLER                  PIC X(08).                   DTSCS31
00338          10  WRK-DISPLAY-YRQ-YR      PIC X(02).                   DTSCS31
00339          10  WRK-DISPLAY-YRQ-Q       PIC X(01).                   DTSCS31
00340                                                                   DTSCS31
00341                                                                   DTSCS31
00342      05  HOLD-EMP-AREA.                                           DTSCS31
00343          10  HOLD-EMP-EMP-NO         PIC S9(07)  COMP-3.          DTSCS31
00344          10  HOLD-EMP-COMP-DATE      PIC S9(09)  COMP-3.          DTSCS31
00345          10  HOLD-EMP-ABSTIME        PIC S9(15)  COMP-3.          DTSCS31
00346                                                                   DTSCS31
00347          10  HOLD-EMP-CLASS-DSCR     PIC  X(10).                  DTSCS31
00348          10  HOLD-EMP-STATUS-DSCR    PIC  X(10).                  DTSCS31
00349                                                                   DTSCS31
00350          10  HOLD-EMP-RECENT-SOL.                                 DTSCS31
00351              15  HOLD-EMP-RECENT-FROM-YRQ    PIC  X(04).          DTSCS31
00352              15  HOLD-EMP-RECENT-COLON       PIC  X(01).          DTSCS31
00353              15  HOLD-EMP-RECENT-TO-YRQ      PIC  X(04).          DTSCS31
00354                                                                   DTSCS31
00355          10  HOLD-EMP-NBR-SPANS      PIC S9(04)  COMP.            DTSCS31
00356                                                                   DTSCS31
00357          10  HOLD-EMP-FLD-REP-ID     PIC  X(02).                  DTSCS31
00358                                                                   DTSCS31
00359          10  HOLD-EMP-OPEN-APL-IND   PIC  X(01).                  DTSCS31
00360              88  HOLD-EMP-OPEN-APL-YES-88   VALUE 'A'.            DTSCS31
00361          10  HOLD-EMP-OPEN-LIN-IND   PIC  X(01).                  DTSCS31
00362              88  HOLD-EMP-OPEN-LIN-YES-88   VALUE 'L'.            DTSCS31
00363          10  HOLD-EMP-OPEN-DPC-IND   PIC  X(01).                  DTSCS31
00364              88  HOLD-EMP-OPEN-DPC-YES-88   VALUE 'D'.            DTSCS31
00365                                                                   DTSCS31
00366          10  HOLD-EMP-PICKUP-DUE-IND PIC  X(01).                  DTSCS31
00367              88  HOLD-EMP-PICKUP-DUE-YES-88 VALUE 'Y'.            DTSCS31
00368                                                                   DTSCS31
00369          10  HOLD-EMP-SUBPOENA-CD    PIC  X(01).                  DTSCS31
00370          10  HOLD-EMP-SUBPOENA-DATE  PIC  X(08).                  DTSCS31
00371                                                                   DTSCS31
00372          10  HOLD-EMP-TOT-DUE-AMT    PIC S9(09)V9(02)  COMP-3.    DTSCS31
00373                                                                   DTSCS31
00374          10  HOLD-EMP-PER-MONTH-INT  PIC S9(05)V9(02)  COMP-3.    DTSCS31
00375                                                                   DTSCS31
00376          10  HOLD-EMP-LAST-KEY-AREA  PIC  X(16).                  DTSCS31
00377                                                                   DTSCS31
00378          10  HOLD-EMP-LAST-PAGE      PIC S9(04)        COMP.      DTSCS31
00379                                                                   DTSCS31
00380                                                                   DTSCS31
00381      05  HOLD-SCR-AREA.                                           DTSCS31
00382          10  HOLD-SCR-KEY-AREA       PIC  X(16).                  DTSCS31
00383          10  HOLD-SCR-PAGE           PIC S9(04)  COMP.            DTSCS31
00384          10  HOLD-SCR-ANN-RANGE-IND  PIC  X(01).                  DTSCS31
00385              88  HOLD-SCR-ANN-RANGE-YES  VALUE 'Y'.               DTSCS31
00386              88  HOLD-SCR-ANN-RANGE-NO   VALUE 'N'.               DTSCS31
00387                                                                   DTSCS31
00388                                                                   DTSCS31
00389      05  WRK-REC-FOUND-IND           PIC  X(01).                  DTSCS31
00390                                                                   DTSCS31
00391      05  WRK-CURR-PAGE               PIC S9(04)  COMP.            DTSCS31
00392                                                                   DTSCS31
00393                                                                   DTSCS31
00394      05  RECS-IN-RANGE-CNT           PIC S9(04)  COMP.            DTSCS31
00395                                                                   DTSCS31
00396      05  FIRST-REC-IN-RANGE-YRQ      PIC S9(05)  COMP-3.          DTSCS31
00397                                                                   DTSCS31
00398      05  LAST-REC-IN-RANGE-YRQ       PIC S9(05)  COMP-3.          DTSCS31
00399                                                                   DTSCS31
00400                                                                   DTSCS31
00401      05  WRK-QTR-OPEN-APL-IND        PIC  X(01).                  DTSCS31
00402          88  WRK-QTR-OPEN-APL-YES-88        VALUE 'A'.            DTSCS31
00403                                                                   DTSCS31
00404      05  WRK-QTR-OPEN-LIN-IND        PIC  X(01).                  DTSCS31
00405          88  WRK-QTR-OPEN-LIN-YES-88        VALUE 'L'.            DTSCS31
00406                                                                   DTSCS31
00407      05  WRK-QTR-OPEN-DPC-IND        PIC  X(01).                  DTSCS31
00408          88  WRK-QTR-OPEN-DPC-YES-88        VALUE 'D'.            DTSCS31
00409                                                                   DTSCS31
00410      05  WRK-CURR-RPT-TYPE           PIC  X(01).                  DTSCS31
00411          88  WRK-CURR-RPT-TYPE-NULL-88  VALUE SPACES.             DTSCS31
00412                                                                   DTSCS31
00413                                                                   DTSCS31
00414  01  WRK-BUCKETS.                                                 DTSCS31
00415      05  WRK-BUCKET-ROWS OCCURS 8 TIMES.                          DTSCS31
00416          10  WRK-BUCKET-COLS OCCURS 5 TIMES.                      DTSCS31
00417              15  WRK-BUCKET          PIC S9(09)V9(02) COMP-3.     DTSCS31
00418                                                                   DTSCS31
00419  01  WRK-WAGE-BUCKETS.                                            DTSCS31
00420      05  WRK-TOT-WAGE-BUCKET         PIC S9(09)V9(02) COMP-3.     DTSCS31
00421      05  WRK-TAX-WAGE-BUCKET         PIC S9(09)V9(02) COMP-3.     DTSCS31
00422      05  WRK-EXCESS-WAGE-BUCKET      PIC S9(09)V9(02) COMP-3.     DTSCS31
00423      EJECT                                                        DTSCS31
00424  01  SCREEN-TITLE-AREA.                                           DTSCS31
00425      05  WRK-SCREEN-TITLE            PIC  X(30).                  DTSCS31
00426          88  WRK-ANNUAL-SCREEN-TITLE                              DTSCS31
00427                VALUE '**  ANNUAL QUARTER INQUIRY ** '.            DTSCS31
00428          88  WRK-QTRLY-SCREEN-TITLE                               DTSCS31
00429                VALUE 'QUARTER INQUIRY               '.            DTSCS31
00430                                                                   DTSCS31
00431  01  MSG-LITERALS.                                                DTSCS31
00432                                                                   DTSCS31
00433      05  MSG-E311-AREA.                                           DTSCS31
00434          10  FILLER                  PIC  X(04)  VALUE 'E311'.    DTSCS31
00435          10  FILLER                  PIC  X(30)                   DTSCS31
00436                VALUE 'NO QUARTERS WITHIN SELECTED RA'.            DTSCS31
00437          10  FILLER                  PIC  X(30)                   DTSCS31
00438                VALUE 'NGE                           '.            DTSCS31
00439                                                                   DTSCS31
00440      05  MSG-E312-AREA.                                           DTSCS31
00441          10  FILLER                  PIC  X(04)  VALUE 'E312'.    DTSCS31
00442          10  FILLER                  PIC  X(30)                   DTSCS31
00443                VALUE 'IF RANGE OF QUARTERS REQUESTED'.            DTSCS31
00444          10  FILLER                  PIC  X(30)                   DTSCS31
00445                VALUE ', THEN PAGING IS NOT VALID    '.            DTSCS31
00446      EJECT                                                        DTSCS31
00447  01  L001-COMM-AREA.                                              DTSCS31
00448  ++INCLUDE DTSIL001                                               DTSCS31
00449      EJECT                                                        DTSCS31
00450  01  L004-COMM-AREA.                                              DTSCS31
00451  ++INCLUDE DTSIL004                                               DTSCS31
00452      EJECT                                                        DTSCS31
00453  01  L015-COMM-AREA.                                              DTSCS31
00454  ++INCLUDE DTSIL015                                               DTSCS31
00455      EJECT                                                        DTSCS31
00456 *01  L016-COMM-AREA.                                              DTSCS31
00457 ***INCLUDE DTSIL016                                               DTSCS31
00458      EJECT                                                        DTSCS31
00459  01  L018-COMM-AREA.                                              DTSCS31
00460  ++INCLUDE DTSIL018                                               DTSCS31
00461      EJECT                                                        DTSCS31
00462  01  L029-COMM-AREA.                                              DTSCS31
00463  ++INCLUDE DTSIL029                                               DTSCS31
00464      EJECT                                                        DTSCS31
00465  01  L031-COMM-AREA.                                              DTSCS31
00466  ++INCLUDE DTSIL031                                               DTSCS31
00467      EJECT                                                        DTSCS31
00468  01  L032-COMM-AREA.                                              DTSCS31
00469  ++INCLUDE DTSIL032                                               DTSCS31
00470      EJECT                                                        DTSCS31
00471  01  L033-COMM-AREA.                                              DTSCS31
00472  ++INCLUDE DTSIL033                                               DTSCS31
00473      EJECT                                                        DTSCS31
00474  01  L056-COMM-AREA.                                              DTSCS31
00475  ++INCLUDE DTSIL056                                               DTSCS31
00476      EJECT                                                        DTSCS31
00477  01  L061-COMM-AREA.                                              DTSCS31
00478  ++INCLUDE DTSIL061                                               DTSCS31
00479      EJECT                                                        DTSCS31
00480  01  L101-COMM-AREA.                                              DTSCS31
00481  ++INCLUDE DTSIL101                                               DTSCS31
00482      EJECT                                                        DTSCS31
00483  01  L109-COMM-AREA.                                              DTSCS31
00484  ++INCLUDE DTSIL109                                               DTSCS31
00485      EJECT                                                        DTSCS31
00486  01  L410-COMM-AREA.                                              DTSCS31
00487  ++INCLUDE DTSIL410                                               DTSCS31
00488      EJECT                                                        DTSCS31
00489  01  L805-COMM-AREA.                                              DTSCS31
00490  ++INCLUDE DTSIL805                                               DTSCS31
00491      EJECT                                                        DTSCS31
00492  01  L810-COMM-AREA.                                              DTSCS31
00493      05  L810-CONTROL-BLOCK.                                      DTSCS31
00494  ++INCLUDE DTSIL810                                               DTSCS31
00495      EJECT                                                        DTSCS31
00496      05  MSKL-REC.                                                DTSCS31
00497  ++INCLUDE DTSIMSKL                                               DTSCS31
00498      EJECT                                                        DTSCS31
00499  01  MPRF-REC.                                                    DTSCS31
00500  ++INCLUDE DTSIMPRF                                               DTSCS31
00501      EJECT                                                        DTSCS31
00502  01  MSOL-REC.                                                    DTSCS31
00503  ++INCLUDE DTSIMSOL                                               DTSCS31
00504      EJECT                                                        DTSCS31
00505  01  MQTR-REC.                                                    DTSCS31
00506  ++INCLUDE DTSIMQTR                                               DTSCS31
00507      EJECT                                                        DTSCS31
00508  01  MAPL-REC.                                                    DTSCS31
00509  ++INCLUDE DTSIMAPL                                               DTSCS31
00510      EJECT                                                        DTSCS31
00511  01  MLIN-REC.                                                    DTSCS31
00512  ++INCLUDE DTSIMLIN                                               DTSCS31
00513      EJECT                                                        DTSCS31
00514  01  MDPC-REC.                                                    DTSCS31
00515  ++INCLUDE DTSIMDPC                                               DTSCS31
00516      EJECT                                                        DTSCS31
00517  01  MCOL-REC.                                                    DTSCS31
00518  ++INCLUDE DTSIMCOL                                               DTSCS31
00519      EJECT                                                        DTSCS31
00520  01  L851-COMM-AREA.                                              DTSCS31
00521  ++INCLUDE DTSIL851                                               DTSCS31
00522                                                                   DTSCS31
00523      05  MAP-AREA REDEFINES L851-MAP-AREA.                        DTSCS31
00524  ++INCLUDE DTSIS31                                                DTSCS31
00525      EJECT                                                        DTSCS31
00526  01  CATB-LITERALS.                                               DTSCS31
00527  ++INCLUDE DTSICATB                                               DTSCS31
00528                                                                   DTSCS31
00529  01  CFKD-LITERALS.                                               DTSCS31
00530  ++INCLUDE DTSICFKD                                               DTSCS31
00531                                                                   DTSCS31
00532  01  CECD-LITERALS.                                               DTSCS31
00533  ++INCLUDE DTSICECD                                               DTSCS31
00534                                                                   DTSCS31
00535  01  CPCD-LITERALS.                                               DTSCS31
00536  ++INCLUDE DTSICPCD                                               DTSCS31
00537      EJECT                                                        DTSCS31
00538  LINKAGE SECTION.                                                 DTSCS31
00539                                                                   DTSCS31
00540  01  DFHCOMMAREA.                                                 DTSCS31
00541  ++INCLUDE DTSILCCM                                               DTSCS31
00542      EJECT                                                        DTSCS31
00543 ******************************************************************DTSCS31
00544 *                                                                *DTSCS31
00545 ******************************************************************DTSCS31
00546                                                                   DTSCS31
00547  PROCEDURE DIVISION.                                              DTSCS31
00548                                                                   DTSCS31
00549      MOVE +0 TO WRK-EMP-NO.                                       DTSCS31
00550                                                                   DTSCS31
00551      SET WRK-MPRF-NO-88 TO TRUE.                                  DTSCS31
00552                                                                   DTSCS31
00553      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS31
00554                                                                   DTSCS31
00555      SET CURSOR-SET-NO TO TRUE.                                   DTSCS31
00556                                                                   DTSCS31
00557      MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N)                  DTSCS31
00558        TO SCR-ACCESS-IND.                                         DTSCS31
00559                                                                   DTSCS31
00560      MOVE SPACE TO REQ-IND.                                       DTSCS31
00561                                                                   DTSCS31
00562      PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT.               DTSCS31
00563                                                                   DTSCS31
00564 *-----------------------------------------------------            DTSCS31
00565 *    P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE           DTSCS31
00566 *    "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT             DTSCS31
00567 *    REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE             DTSCS31
00568 *    OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED.         DTSCS31
00569 *                                                                 DTSCS31
00570 *    THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE                DTSCS31
00571 *    PROCESSED.                                                   DTSCS31
00572 *                                                                 DTSCS31
00573 *    THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND,         DTSCS31
00574 *    INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE            DTSCS31
00575 *    WORK STATION OPERATOR.                                       DTSCS31
00576 *-----------------------------------------------------            DTSCS31
00577                                                                   DTSCS31
00578      MOVE SPACE TO RESP-IND.                                      DTSCS31
00579                                                                   DTSCS31
00580      IF REQ-ERROR                                                 DTSCS31
00581         PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT               DTSCS31
00582      ELSE                                                         DTSCS31
00583      IF REQ-JUMP                                                  DTSCS31
00584         PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT                DTSCS31
00585      ELSE                                                         DTSCS31
00586      IF REQ-CLEAR                                                 DTSCS31
00587         PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT               DTSCS31
00588      ELSE                                                         DTSCS31
00589      IF REQ-CURSOR-TO-GOTO                                        DTSCS31
00590         PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT              DTSCS31
00591      ELSE                                                         DTSCS31
00592      IF REQ-INQUIRE                                               DTSCS31
00593         PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT             DTSCS31
00594      ELSE                                                         DTSCS31
00595         GO TO S899-ABEND.                                         DTSCS31
00596                                                                   DTSCS31
00597 *-----------------------------------------------------            DTSCS31
00598 *    THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED             DTSCS31
00599 *    IN RESP-IND THE TYPE OF RESPONSE TO BE MADE.                 DTSCS31
00600 *-----------------------------------------------------            DTSCS31
00601                                                                   DTSCS31
00602      IF RESP-SEND-MAP                                             DTSCS31
00603          PERFORM S9300-SEND-MAP THRU S9300-EXIT                   DTSCS31
00604          SET LCCM-END-TASK-88 TO TRUE                             DTSCS31
00605      ELSE                                                         DTSCS31
00606      IF RESP-SEND-MSGONLY                                         DTSCS31
00607          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS31
00608          SET LCCM-END-TASK-88 TO TRUE                             DTSCS31
00609      ELSE                                                         DTSCS31
00610      IF RESP-JUMP                                                 DTSCS31
00611          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS31
00612      ELSE                                                         DTSCS31
00613      IF RESP-CURSOR-TO-GOTO                                       DTSCS31
00614          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS31
00615          SET LCCM-END-TASK-88 TO TRUE                             DTSCS31
00616      ELSE                                                         DTSCS31
00617          GO TO S899-ABEND.                                        DTSCS31
00618                                                                   DTSCS31
00619  MAINLINE-EXIT.                                                   DTSCS31
00620                                                                   DTSCS31
00621      EXEC CICS                                                    DTSCS31
00622          RETURN                                                   DTSCS31
00623      END-EXEC.                                                    DTSCS31
00624                                                                   DTSCS31
00625      GOBACK.                                                      DTSCS31
00626      EJECT                                                        DTSCS31
00627 /*****************************************************************DTSCS31
00628 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION         *DTSCS31
00629 ******************************************************************DTSCS31
00630  P1000-ANALYZE-REQUEST.                                           DTSCS31
00631                                                                   DTSCS31
00632 *-----------------------------------------------------            DTSCS31
00633 *     IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE)         DTSCS31
00634 *     THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE               DTSCS31
00635 *     REPLACED WITH ENTER)                                        DTSCS31
00636 *-----------------------------------------------------            DTSCS31
00637      IF LCCM-SCR-ID NOT = WRK-SCR-ID                              DTSCS31
00638         MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA                     DTSCS31
00639         SET LCCM-ENTER-88 TO TRUE                                 DTSCS31
00640         IF LCCM-EMP-NO = +0                                       DTSCS31
00641            MOVE +0 TO LCCM-YRQ                                    DTSCS31
00642            MOVE PMSG-KEY-EMP-NO TO LCCM-MSG-AREA                  DTSCS31
00643            SET REQ-CLEAR TO TRUE                                  DTSCS31
00644         ELSE                                                      DTSCS31
00645            SET REQ-INQUIRE TO TRUE                                DTSCS31
00646            MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                     DTSCS31
00647            MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2                     DTSCS31
00648            PERFORM P1100-CHECK-LCCM-YRQ THRU P1100-EXIT           DTSCS31
00649         END-IF                                                    DTSCS31
00650         GO TO P1000-EXIT.                                         DTSCS31
00651                                                                   DTSCS31
00652 *-----------------------------------------------------            DTSCS31
00653 *      MAP IS RECEIVED                                            DTSCS31
00654 *-----------------------------------------------------            DTSCS31
00655      PERFORM S9100-RECEIVE THRU S9100-EXIT.                       DTSCS31
00656                                                                   DTSCS31
00657 *-----------------------------------------------------            DTSCS31
00658 *    CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE            DTSCS31
00659 *    WORK STATION                                                 DTSCS31
00660 *-----------------------------------------------------            DTSCS31
00661      IF LCCM-CLEAR-88                                             DTSCS31
00662         SET REQ-CLEAR TO TRUE                                     DTSCS31
00663         GO TO P1000-EXIT.                                         DTSCS31
00664                                                                   DTSCS31
00665 *-----------------------------------------------------            DTSCS31
00666 *    PA2 IS A REQUEST TO POSITION CURSOR AT GO TO:                DTSCS31
00667 *-----------------------------------------------------            DTSCS31
00668      IF LCCM-PA2-88                                               DTSCS31
00669          SET REQ-CURSOR-TO-GOTO TO TRUE                           DTSCS31
00670          GO TO P1000-EXIT.                                        DTSCS31
00671                                                                   DTSCS31
00672 *-----------------------------------------------------            DTSCS31
00673 *    ALL OTHER PA KEYS ARE NOT ACTIVE                             DTSCS31
00674 *-----------------------------------------------------            DTSCS31
00675      IF LCCM-PA-88                                                DTSCS31
00676        PERFORM S804-INVALID-KEY THRU S804-EXIT                    DTSCS31
00677        SET REQ-ERROR TO TRUE                                      DTSCS31
00678        GO TO P1000-EXIT.                                          DTSCS31
00679                                                                   DTSCS31
00680 *-----------------------------------------------------            DTSCS31
00681 *    IF F12 KEY IS PRESSED AND UPDATE NOT IN PROGRESS             DTSCS31
00682 *    CLEAR SCREEN                                                 DTSCS31
00683 *-----------------------------------------------------            DTSCS31
00684      IF LCCM-F12-88                                               DTSCS31
00685         MOVE LOW-VALUES TO MAP-AREA                               DTSCS31
00686         SET REQ-CLEAR TO TRUE                                     DTSCS31
00687         GO TO P1000-EXIT.                                         DTSCS31
00688                                                                   DTSCS31
00689 *-----------------------------------------------------            DTSCS31
00690 *    IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION            DTSCS31
00691 *-----------------------------------------------------            DTSCS31
00692      IF LCCM-F03-88                                               DTSCS31
00693         MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID                    DTSCS31
00694         SET REQ-JUMP TO TRUE                                      DTSCS31
00695         GO TO P1000-EXIT.                                         DTSCS31
00696                                                                   DTSCS31
00697 *-----------------------------------------------------            DTSCS31
00698 *    IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN         DTSCS31
00699 *-----------------------------------------------------            DTSCS31
00700      IF LCCM-F04-88                                               DTSCS31
00701         MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID                 DTSCS31
00702         SET REQ-JUMP TO TRUE                                      DTSCS31
00703         GO TO P1000-EXIT.                                         DTSCS31
00704                                                                   DTSCS31
00705 *---------------------------------------------------------        DTSCS31
00706 *    IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO                DTSCS31
00707 *    CORRESPONDENCE SCREEN.                                       DTSCS31
00708 *---------------------------------------------------------        DTSCS31
00709                                                                   DTSCS31
00710      IF LCCM-F14-88                                               DTSCS31
00711         MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID                  DTSCS31
00712         SET REQ-JUMP TO TRUE                                      DTSCS31
00713         GO TO P1000-EXIT.                                         DTSCS31
00714                                                                   DTSCS31
00715 *-----------------------------------------------------            DTSCS31
00716 *    IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO               DTSCS31
00717 *    REQUESTED SCREEN TYPE                                        DTSCS31
00718 *-----------------------------------------------------            DTSCS31
00719 *                                                                 DTSCS31
00720 *    IF LCCM-F09-88                                               DTSCS31
00721 *       MOVE '71' TO LCCM-REQ-SCR-ID                              DTSCS31
00722 *       SET REQ-JUMP TO TRUE                                      DTSCS31
00723 *       GO TO P1000-EXIT.                                         DTSCS31
00724 *                                                                 DTSCS31
00725 *    IF LCCM-F10-88                                               DTSCS31
00726 *       MOVE '33' TO LCCM-REQ-SCR-ID                              DTSCS31
00727 *       SET REQ-JUMP TO TRUE                                      DTSCS31
00728 *       GO TO P1000-EXIT.                                         DTSCS31
00729 *                                                                 DTSCS31
00730 *    IF LCCM-F11-88                                               DTSCS31
00731 *       MOVE '34' TO LCCM-REQ-SCR-ID                              DTSCS31
00732 *       SET REQ-JUMP TO TRUE                                      DTSCS31
00733 *       GO TO P1000-EXIT.                                         DTSCS31
00734 *                                                                 DTSCS31
00735 *    IF LCCM-F12-88                                               DTSCS31
00736 *       MOVE '35' TO LCCM-REQ-SCR-ID                              DTSCS31
00737 *       SET REQ-JUMP TO TRUE                                      DTSCS31
00738 *       GO TO P1000-EXIT.                                         DTSCS31
00739 *                                                                 DTSCS31
00740 *    IF LCCM-F17-88                                               DTSCS31
00741 *       MOVE '11' TO LCCM-REQ-SCR-ID                              DTSCS31
00742 *       SET REQ-JUMP TO TRUE                                      DTSCS31
00743 *       GO TO P1000-EXIT.                                         DTSCS31
00744 *                                                                 DTSCS31
00745 *    IF LCCM-F20-88                                               DTSCS31
00746 *       MOVE '41' TO LCCM-REQ-SCR-ID                              DTSCS31
00747 *       SET REQ-JUMP TO TRUE                                      DTSCS31
00748 *       GO TO P1000-EXIT.                                         DTSCS31
00749 *                                                                 DTSCS31
00750 *-----------------------------------------------------            DTSCS31
00751 *    IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO               DTSCS31
00752 *    REQUESTED SCREEN TYPE                                        DTSCS31
00753 *-----------------------------------------------------            DTSCS31
00754      IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID             DTSCS31
00755         NEXT SENTENCE                                             DTSCS31
00756      ELSE                                                         DTSCS31
00757        MOVE MAP-GOTO TO LCCM-REQ-SCR-ID                           DTSCS31
00758        SET REQ-JUMP TO TRUE                                       DTSCS31
00759        GO TO P1000-EXIT.                                          DTSCS31
00760                                                                   DTSCS31
00761 *-----------------------------------------------------            DTSCS31
00762 *    IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7,              DTSCS31
00763 *          OR F8), INDICATE INQUIRY REQUEST                       DTSCS31
00764 *-----------------------------------------------------            DTSCS31
00765      IF LCCM-INQUIRY-88                                           DTSCS31
00766          SET REQ-INQUIRE TO TRUE                                  DTSCS31
00767          GO TO P1000-EXIT.                                        DTSCS31
00768                                                                   DTSCS31
00769 *-----------------------------------------------------            DTSCS31
00770 *     ANY OTHER KEY IS INVALID                                    DTSCS31
00771 *-----------------------------------------------------            DTSCS31
00772      PERFORM S804-INVALID-KEY THRU S804-EXIT.                     DTSCS31
00773      SET REQ-ERROR TO TRUE.                                       DTSCS31
00774  P1000-EXIT.                                                      DTSCS31
00775      EXIT.                                                        DTSCS31
00776                                                                   DTSCS31
00777                                                                   DTSCS31
00778  P1100-CHECK-LCCM-YRQ.                                            DTSCS31
00779      IF LCCM-YRQ = LIT-9-YRQ                                      DTSCS31
00780          MOVE +0 TO LCCM-YRQ                                      DTSCS31
00781          GO TO P1100-EXIT.                                        DTSCS31
00782                                                                   DTSCS31
00783      IF LCCM-YRQ < LCCM-PICKUP-YRQ                                DTSCS31
00784          MOVE +0 TO LCCM-YRQ                                      DTSCS31
00785          GO TO P1100-EXIT.                                        DTSCS31
00786                                                                   DTSCS31
00787      IF LCCM-YRQ > +0                                             DTSCS31
00788          PERFORM P1110-DISPLAY-YRQ THRU P1110-EXIT                DTSCS31
00789          GO TO P1100-EXIT.                                        DTSCS31
00790                                                                   DTSCS31
00791 *****MOVE LCCM-SCR31-HOLD-AREA TO HOLD-SCR-AREA.                  DTSCS31
00792 *****IF HOLD-SCR-KEY-AREA NOT = LOW-VALUES                        DTSCS31
00793 *****    MOVE HOLD-SCR-KEY-AREA TO MQTR-KEY-AREA                  DTSCS31
00794 *****    IF MQTR-EMP-NO = LCCM-EMP-NO                             DTSCS31
00795 *****      IF MQTR-YRQ > +0                                       DTSCS31
00796 *****        MOVE MQTR-YRQ TO LCCM-YRQ                            DTSCS31
00797 *****        PERFORM P1110-DISPLAY-YRQ THRU P1110-EXIT.           DTSCS31
00798  P1100-EXIT.                                                      DTSCS31
00799      EXIT.                                                        DTSCS31
00800                                                                   DTSCS31
00801                                                                   DTSCS31
00802  P1110-DISPLAY-YRQ.                                               DTSCS31
00803      IF LCCM-YRQ = LCCM-PICKUP-YRQ                                DTSCS31
00804          MOVE 'PU' TO MAP-FROM-YRQ-YR                             DTSCS31
00805          MOVE ' ' TO MAP-FROM-YRQ-Q                               DTSCS31
00806          GO TO P1110-EXIT.                                        DTSCS31
00807                                                                   DTSCS31
00808      MOVE LCCM-YRQ TO WRK-DISPLAY.                                DTSCS31
00809      MOVE WRK-DISPLAY-YRQ-YR TO MAP-FROM-YRQ-YR.                  DTSCS31
00810      MOVE WRK-DISPLAY-YRQ-Q TO MAP-FROM-YRQ-Q.                    DTSCS31
00811  P1110-EXIT.                                                      DTSCS31
00812      EXIT.                                                        DTSCS31
00813 /*****************************************************************DTSCS31
00814 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS31
00815 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN.                      *DTSCS31
00816 ******************************************************************DTSCS31
00817                                                                   DTSCS31
00818  P2000-REQUEST-ERROR.                                             DTSCS31
00819      IF LCCM-MSG                                                  DTSCS31
00820         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS31
00821      ELSE                                                         DTSCS31
00822         GO TO S899-ABEND.                                         DTSCS31
00823  P2000-EXIT.                                                      DTSCS31
00824      EXIT.                                                        DTSCS31
00825 /*****************************************************************DTSCS31
00826 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED                  *DTSCS31
00827 ******************************************************************DTSCS31
00828                                                                   DTSCS31
00829  P3000-REQUEST-JUMP.                                              DTSCS31
00830 *-----------------------------------------------------            DTSCS31
00831 *    VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE    DTSCS31
00832 *    BY USER                                                      DTSCS31
00833 *-----------------------------------------------------            DTSCS31
00834      PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT.                 DTSCS31
00835                                                                   DTSCS31
00836 *-----------------------------------------------------            DTSCS31
00837 *    VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED               DTSCS31
00838 *-----------------------------------------------------            DTSCS31
00839      IF LCCM-MSG                                                  DTSCS31
00840         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS31
00841         SET CURSOR-SET-GOTO TO TRUE                               DTSCS31
00842         GO TO P3000-EXIT.                                         DTSCS31
00843      SKIP3                                                        DTSCS31
00844      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS31
00845      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS31
00846      IF L018-VALID                                                DTSCS31
00847          MOVE L018-EMP-NO TO LCCM-EMP-NO                          DTSCS31
00848                                                                   DTSCS31
00849          MOVE MAP-FROM-YRQ-AREA TO L029-S-YRQ-AREA                DTSCS31
00850          PERFORM S029-YRQ-WITH-PU-FROM-SCREEN THRU S029-EXIT      DTSCS31
00851          IF L029-VALID                                            DTSCS31
00852              MOVE L029-YRQ TO LCCM-YRQ.                           DTSCS31
00853                                                                   DTSCS31
00854 *-----------------------------------------------------            DTSCS31
00855 *    CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING      DTSCS31
00856 *-----------------------------------------------------            DTSCS31
00857      MOVE LOW-VALUES TO LCCM-SCR-STATUS                           DTSCS31
00858                         LCCM-SCR-HOLD-AREA.                       DTSCS31
00859      MOVE +0 TO LCCM-SCR-ABSTIME.                                 DTSCS31
00860      SET RESP-JUMP TO TRUE.                                       DTSCS31
00861  P3000-EXIT.                                                      DTSCS31
00862      EXIT.                                                        DTSCS31
00863 /*****************************************************************DTSCS31
00864 * CLEAR KEY WAS PRESSED                                          *DTSCS31
00865 ******************************************************************DTSCS31
00866                                                                   DTSCS31
00867  P4000-REQUEST-CLEAR.                                             DTSCS31
00868                                                                   DTSCS31
00869 *-----------------------------------------------------            DTSCS31
00870 *   CLEAN UP INDICATORS AND PAGING STORAGE.  RESET KEY            DTSCS31
00871 *   FIELDS FROM EARLIER REQUESTS                                  DTSCS31
00872 *-----------------------------------------------------            DTSCS31
00873      IF LCCM-EMP-NO > ZERO                                        DTSCS31
00874          MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                       DTSCS31
00875          MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2.                      DTSCS31
00876                                                                   DTSCS31
00877      MOVE ZERO TO LCCM-EMP-NO                                     DTSCS31
00878                   LCCM-YRQ.                                       DTSCS31
00879                                                                   DTSCS31
00880      MOVE LOW-VALUES TO LCCM-SCR31-HOLD-AREA                      DTSCS31
00881                         LCCM-SCR-HOLD-AREA.                       DTSCS31
00882                                                                   DTSCS31
00883      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS31
00884                                                                   DTSCS31
00885      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS31
00886                                                                   DTSCS31
00887      PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.                 DTSCS31
00888                                                                   DTSCS31
00889      SET RESP-SEND-MAP TO TRUE.                                   DTSCS31
00890  P4000-EXIT.                                                      DTSCS31
00891      EXIT.                                                        DTSCS31
00892 /*****************************************************************DTSCS31
00893 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED                   *DTSCS31
00894 ******************************************************************DTSCS31
00895                                                                   DTSCS31
00896  P5000-CURSOR-TO-GOTO.                                            DTSCS31
00897      SET CURSOR-SET-GOTO TO TRUE.                                 DTSCS31
00898      SET RESP-CURSOR-TO-GOTO TO TRUE.                             DTSCS31
00899  P5000-EXIT.                                                      DTSCS31
00900      EXIT.                                                        DTSCS31
00901 /*****************************************************************DTSCS31
00902 * INQUIRY WAS REQUESTED                                          *DTSCS31
00903 ******************************************************************DTSCS31
00904                                                                   DTSCS31
00905  P6000-REQUEST-INQUIRE.                                           DTSCS31
00906 *                               *-------------------------------- DTSCS31
00907 *                               * SAVE 'KEY' INFORMATION FROM THE DTSCS31
00908 *------------------------------ * SCREEN PRIOR TO CLEARING IT     DTSCS31
00909 *                               * THEN PUT IT BACK                DTSCS31
00910 *                               *-------------------------------- DTSCS31
00911      MOVE MAP-EMP-NO-AREA           TO L018-S-EMP-NO-AREA.        DTSCS31
00912      MOVE MAP-COMP-DATE-AREA        TO L015-S-DATE-AREA.          DTSCS31
00913      MOVE MAP-FROM-YRQ-AREA         TO WRK-HOLD-FROM-YRQ-AREA.    DTSCS31
00914      MOVE MAP-TO-YRQ-AREA           TO WRK-HOLD-TO-YRQ-AREA.      DTSCS31
00915                                                                   DTSCS31
00916      MOVE LOW-VALUES                TO MAP-AREA.                  DTSCS31
00917                                                                   DTSCS31
00918      MOVE L018-S-EMP-NO-AREA        TO MAP-EMP-NO-AREA.           DTSCS31
00919      MOVE L015-S-DATE-AREA          TO MAP-COMP-DATE-AREA.        DTSCS31
00920      MOVE WRK-HOLD-FROM-YRQ-AREA    TO MAP-FROM-YRQ-AREA.         DTSCS31
00921      MOVE WRK-HOLD-TO-YRQ-AREA      TO MAP-TO-YRQ-AREA.           DTSCS31
00922                                                                   DTSCS31
00923 *                               *-------------------------------- DTSCS31
00924 *------------------------------ * SCREEN AREA INITIALIZATION      DTSCS31
00925 *                               *-------------------------------- DTSCS31
00926      SET LCCM-SCR-CLEAR              TO TRUE.                     DTSCS31
00927                                                                   DTSCS31
00928      MOVE LCCM-TASK-START-ABSTIME    TO LCCM-SCR-ABSTIME.         DTSCS31
00929                                                                   DTSCS31
00930      SET RESP-SEND-MAP               TO TRUE.                     DTSCS31
00931                                                                   DTSCS31
00932      PERFORM S5300-SET-INQ-ATTRB     THRU S5300-EXIT.             DTSCS31
00933                                                                   DTSCS31
00934      MOVE LCCM-SCR31-HOLD-AREA       TO HOLD-SCR-AREA.            DTSCS31
00935                                                                   DTSCS31
00936      MOVE LOW-VALUES                 TO LCCM-SCR31-HOLD-AREA.     DTSCS31
00937                                                                   DTSCS31
00938      MOVE LCCM-SCR-HOLD-AREA         TO HOLD-EMP-AREA.            DTSCS31
00939                                                                   DTSCS31
00940      MOVE LOW-VALUES                 TO LCCM-SCR-HOLD-AREA.       DTSCS31
00941                                                                   DTSCS31
00942      SET WRK-CURR-RPT-TYPE-NULL-88   TO TRUE.                     DTSCS31
00943                                                                   DTSCS31
00944 *                               *-------------------------------- DTSCS31
00945 *------------------------------ * EDIT SCREEN KEY AREAS           DTSCS31
00946 *                               *-------------------------------- DTSCS31
00947      PERFORM S1100-EDIT-KEY          THRU S1100-EXIT.             DTSCS31
00948                                                                   DTSCS31
00949      IF LCCM-MSG                                                  DTSCS31
00950          NEXT SENTENCE                                            DTSCS31
00951      ELSE                                                         DTSCS31
00952          MOVE WRK-EMP-NO TO LCCM-EMP-NO.                          DTSCS31
00953                                                                   DTSCS31
00954      PERFORM S1200-FROM-TO-YRQ       THRU S1200-EXIT.             DTSCS31
00955                                                                   DTSCS31
00956      PERFORM S1300-COMP-DATE         THRU S1300-EXIT.             DTSCS31
00957                                                                   DTSCS31
00958      IF LCCM-MSG                                                  DTSCS31
00959          GO TO P6000-EXIT.                                        DTSCS31
00960                                                                   DTSCS31
00961 *                               *-------------------------------- DTSCS31
00962 *------------------------------ * RANGE ONLY ALLOWED ON ENTER     DTSCS31
00963 *                               *-------------------------------- DTSCS31
00964                                                                   DTSCS31
00965      IF HOLD-SCR-ANN-RANGE-YES                                    DTSCS31
00966         NEXT SENTENCE                                             DTSCS31
00967      ELSE                                                         DTSCS31
00968      IF WRK-RANGE-YES                                             DTSCS31
00969         IF LCCM-ENTER-88                                          DTSCS31
00970            NEXT SENTENCE                                          DTSCS31
00971         ELSE                                                      DTSCS31
00972            MOVE MSG-E312-AREA TO WRK-MSG-AREA                     DTSCS31
00973            PERFORM S1201-ERROR THRU S1201-EXIT                    DTSCS31
00974            PERFORM S1202-ERROR THRU S1202-EXIT                    DTSCS31
00975            GO TO P6000-EXIT.                                      DTSCS31
00976                                                                   DTSCS31
00977 *                               *-------------------------------- DTSCS31
00978 *                               * DETERMINE IF EMPLOYER LEVEL     DTSCS31
00979 *                               * INFORMATION MUST BE ASSEMBLED   DTSCS31
00980 *------------------------------ * INTO HOLD-EMP-AREA.  IF THE     DTSCS31
00981 *                               * EMPLOYER LEVEL INFORMATION MUST DTSCS31
00982 *                               * BE ASSEMBLED, THEN DO SO.       DTSCS31
00983 *                               *-------------------------------- DTSCS31
00984                                                                   DTSCS31
00985      IF (HOLD-EMP-AREA = LOW-VALUES)                              DTSCS31
00986              OR                                                   DTSCS31
00987         (WRK-EMP-NO NOT = HOLD-EMP-EMP-NO)                        DTSCS31
00988              OR                                                   DTSCS31
00989         (LCCM-COMP-DATE NOT = HOLD-EMP-COMP-DATE)                 DTSCS31
00990              OR                                                   DTSCS31
00991         (HOLD-EMP-ABSTIME < MPRF-UPDATE-END-ABSTIME)              DTSCS31
00992          PERFORM P7000-REFRESH-HOLD-EMP-AREA THRU P7000-EXIT.     DTSCS31
00993                                                                   DTSCS31
00994      MOVE HOLD-EMP-AREA TO LCCM-SCR-HOLD-AREA.                    DTSCS31
00995                                                                   DTSCS31
00996      IF HOLD-EMP-LAST-PAGE = +0                                   DTSCS31
00997          PERFORM P6910-TOP-OF-SCREEN THRU P6910-EXIT              DTSCS31
00998          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS31
00999          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS31
01000          GO TO P6000-EXIT.                                        DTSCS31
01001                                                                   DTSCS31
01002      IF HOLD-SCR-ANN-RANGE-YES                                    DTSCS31
01003         IF (LCCM-F05-88                                           DTSCS31
01004         OR  LCCM-F06-88                                           DTSCS31
01005         OR  LCCM-F07-88                                           DTSCS31
01006         OR  LCCM-F08-88)                                          DTSCS31
01007            SET WRK-RANGE-NO TO TRUE                               DTSCS31
01008            IF LCCM-F08-88                                         DTSCS31
01009               MOVE WRK-TO-YRQ  TO L004-QTR-5-9                    DTSCS31
01010               PERFORM S004-FROM-5 THRU S004-EXIT                  DTSCS31
01011               ADD +1 TO L004-ABS-QTR                              DTSCS31
01012               PERFORM S004-FROM-ABS THRU S004-EXIT                DTSCS31
01013               MOVE L004-QTR-5-9 TO WRK-FROM-YRQ.                  DTSCS31
01014                                                                   DTSCS31
01015      IF WRK-RANGE-YES                                             DTSCS31
01016          PERFORM P6200-LOCATE-RANGE THRU P6200-EXIT               DTSCS31
01017          IF LCCM-MSG                                              DTSCS31
01018              PERFORM P6910-TOP-OF-SCREEN THRU P6910-EXIT          DTSCS31
01019              GO TO P6000-EXIT.                                    DTSCS31
01020                                                                   DTSCS31
01021      IF WRK-RANGE-NO                                              DTSCS31
01022          PERFORM P6100-LOCATE-REC THRU P6100-EXIT                 DTSCS31
01023          IF LCCM-MSG                                              DTSCS31
01024              PERFORM P6910-TOP-OF-SCREEN THRU P6910-EXIT          DTSCS31
01025              GO TO P6000-EXIT                                     DTSCS31
01026          ELSE                                                     DTSCS31
01027              MOVE MQTR-YRQ TO WRK-FROM-YRQ                        DTSCS31
01028                               WRK-TO-YRQ.                         DTSCS31
01029                                                                   DTSCS31
01030      SET WRK-QTRLY-SCREEN-TITLE TO TRUE.                          DTSCS31
01031      MOVE WRK-SCREEN-TITLE TO MAP-SCREEN-TITLE.                   DTSCS31
01032                                                                   DTSCS31
01033      IF WRK-SUPPRESS-ANN-RANGE-YES                                DTSCS31
01034         NEXT SENTENCE                                             DTSCS31
01035      ELSE                                                         DTSCS31
01036      IF MQTR-ANNUAL-YES-88                                        DTSCS31
01037            PERFORM P6010-SET-ANN-RANGE     THRU P6010-EXIT        DTSCS31
01038            PERFORM P6200-LOCATE-RANGE      THRU P6200-EXIT        DTSCS31
01039            IF LCCM-MSG                                            DTSCS31
01040                PERFORM P6910-TOP-OF-SCREEN THRU P6910-EXIT        DTSCS31
01041                GO TO P6000-EXIT                                   DTSCS31
01042             ELSE                                                  DTSCS31
01043                SET WRK-ANNUAL-SCREEN-TITLE TO TRUE                DTSCS31
01044                MOVE WRK-SCREEN-TITLE TO MAP-SCREEN-TITLE          DTSCS31
01045                MOVE CATB-ASKIP-BRT-MDTOFF                         DTSCS31
01046                                    TO MAP-SCREEN-TITLE-A.         DTSCS31
01047                                                                   DTSCS31
01048                                                                   DTSCS31
01049      PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT.              DTSCS31
01050                                                                   DTSCS31
01051      MOVE WRK-FROM-YRQ  TO LCCM-YRQ.                              DTSCS31
01052                                                                   DTSCS31
01053      IF WRK-RANGE-ANNUAL                                          DTSCS31
01054         SET  HOLD-SCR-ANN-RANGE-YES  TO TRUE                      DTSCS31
01055         PERFORM P6940-SET-RPT-TYPE   THRU P6940-EXIT              DTSCS31
01056      ELSE                                                         DTSCS31
01057         SET  HOLD-SCR-ANN-RANGE-NO   TO TRUE.                     DTSCS31
01058                                                                   DTSCS31
01059      SET WRK-CURR-RPT-TYPE-NULL-88   TO TRUE.                     DTSCS31
01060                                                                   DTSCS31
01061      MOVE HOLD-SCR-AREA TO LCCM-SCR31-HOLD-AREA.                  DTSCS31
01062                                                                   DTSCS31
01063      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS31
01064                                                                   DTSCS31
01065  P6000-EXIT.                                                      DTSCS31
01066      EXIT.                                                        DTSCS31
01067                                                                   DTSCS31
01068  P6010-SET-ANN-RANGE.                                             DTSCS31
01069      SET WRK-RANGE-ANNUAL      TO TRUE.                           DTSCS31
01070                                                                   DTSCS31
01071      MOVE MQTR-YRQ             TO L004-QTR-5-9.                   DTSCS31
01072      MOVE 1                    TO L004-QTR-5-Q.                   DTSCS31
01073      MOVE L004-QTR-5-9         TO WRK-FROM-YRQ.                   DTSCS31
01074      MOVE 4                    TO L004-QTR-5-Q.                   DTSCS31
01075      MOVE L004-QTR-5-9         TO WRK-TO-YRQ.                     DTSCS31
01076                                                                   DTSCS31
01077  P6010-EXIT.                                                      DTSCS31
01078      EXIT.                                                        DTSCS31
01079 /*****************************************************************DTSCS31
01080 *   A RANGE OF QUARTERS WAS NOT REQUESED.                        *DTSCS31
01081 ******************************************************************DTSCS31
01082  P6100-LOCATE-REC.                                                DTSCS31
01083 *------------------------------------------------------------     DTSCS31
01084 *                                                                 DTSCS31
01085 *------------------------------------------------------------     DTSCS31
01086                                                                   DTSCS31
01087      IF LCCM-F05-88                                               DTSCS31
01088          PERFORM P6110-FIRST-REC THRU P6110-EXIT                  DTSCS31
01089          GO TO P6100-EXIT.                                        DTSCS31
01090                                                                   DTSCS31
01091      IF LCCM-F06-88                                               DTSCS31
01092          PERFORM P6140-LAST-REC THRU P6140-EXIT                   DTSCS31
01093          GO TO P6100-EXIT.                                        DTSCS31
01094                                                                   DTSCS31
01095      IF WRK-FROM-NO-ENTRY                                         DTSCS31
01096          PERFORM P6140-LAST-REC THRU P6140-EXIT                   DTSCS31
01097          GO TO P6100-EXIT.                                        DTSCS31
01098                                                                   DTSCS31
01099                                                                   DTSCS31
01100      MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSCS31
01101      MOVE WRK-EMP-NO TO MQTR-EMP-NO.                              DTSCS31
01102      SET MQTR-QTR-88 TO TRUE.                                     DTSCS31
01103      MOVE WRK-FROM-YRQ TO MQTR-YRQ.                               DTSCS31
01104                                                                   DTSCS31
01105      IF HOLD-SCR-KEY-AREA = MQTR-KEY-AREA                         DTSCS31
01106          MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA                      DTSCS31
01107          PERFORM S810-START-BROWSE THRU S810-EXIT                 DTSCS31
01108          IF L810-OK-88                                            DTSCS31
01109              IF MSKL-KEY-AREA = MQTR-KEY-AREA                     DTSCS31
01110                  MOVE HOLD-SCR-PAGE TO WRK-CURR-PAGE              DTSCS31
01111                  MOVE MSKL-REC TO MQTR-REC                        DTSCS31
01112                  IF LCCM-ENTER-88                                 DTSCS31
01113                      PERFORM S810-END-BROWSE THRU S810-EXIT       DTSCS31
01114                      GO TO P6100-EXIT                             DTSCS31
01115                  ELSE                                             DTSCS31
01116                  IF LCCM-F07-88                                   DTSCS31
01117                      PERFORM P6120-PREV-REC THRU P6120-EXIT       DTSCS31
01118                      GO TO P6100-EXIT                             DTSCS31
01119                  ELSE                                             DTSCS31
01120                  IF LCCM-F08-88                                   DTSCS31
01121                      PERFORM P6130-NEXT-REC THRU P6130-EXIT       DTSCS31
01122                      GO TO P6100-EXIT                             DTSCS31
01123                  ELSE                                             DTSCS31
01124                      GO TO S899-ABEND                             DTSCS31
01125              ELSE                                                 DTSCS31
01126                  PERFORM S810-END-BROWSE THRU S810-EXIT.          DTSCS31
01127                                                                   DTSCS31
01128                                                                   DTSCS31
01129      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCS31
01130      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCS31
01131      SET MSKL-QTR-88 TO TRUE.                                     DTSCS31
01132                                                                   DTSCS31
01133      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS31
01134                                                                   DTSCS31
01135      IF L810-NO-REC-88                                            DTSCS31
01136          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS31
01137          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS31
01138          GO TO P6100-EXIT.                                        DTSCS31
01139                                                                   DTSCS31
01140      MOVE +0 TO WRK-CURR-PAGE.                                    DTSCS31
01141                                                                   DTSCS31
01142      MOVE 'N' TO WRK-REC-FOUND-IND.                               DTSCS31
01143                                                                   DTSCS31
01144      PERFORM P6190-BROWSE-MQTR THRU P6190-EXIT                    DTSCS31
01145          UNTIL (L810-NO-REC-88)                                   DTSCS31
01146                    OR                                             DTSCS31
01147                (WRK-REC-FOUND-IND = 'Y').                         DTSCS31
01148                                                                   DTSCS31
01149      IF L810-NO-REC-88                                            DTSCS31
01150          IF LCCM-ENTER-88                                         DTSCS31
01151              MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                  DTSCS31
01152              PERFORM S1201-ERROR THRU S1201-EXIT                  DTSCS31
01153          ELSE                                                     DTSCS31
01154              PERFORM P6140-LAST-REC THRU P6140-EXIT               DTSCS31
01155      ELSE                                                         DTSCS31
01156          IF LCCM-ENTER-88                                         DTSCS31
01157              PERFORM S810-END-BROWSE THRU S810-EXIT               DTSCS31
01158              IF MQTR-YRQ = WRK-FROM-YRQ                           DTSCS31
01159                  NEXT SENTENCE                                    DTSCS31
01160              ELSE                                                 DTSCS31
01161                  MOVE EMSG-NO-RECORD TO WRK-MSG-AREA              DTSCS31
01162                  PERFORM S1201-ERROR THRU S1201-EXIT              DTSCS31
01163          ELSE                                                     DTSCS31
01164          IF LCCM-F07-88                                           DTSCS31
01165              PERFORM P6120-PREV-REC THRU P6120-EXIT               DTSCS31
01166          ELSE                                                     DTSCS31
01167          IF LCCM-F08-88                                           DTSCS31
01168              PERFORM P6130-NEXT-REC THRU P6130-EXIT               DTSCS31
01169          ELSE                                                     DTSCS31
01170              GO TO S899-ABEND.                                    DTSCS31
01171  P6100-EXIT.                                                      DTSCS31
01172      EXIT.                                                        DTSCS31
01173                                                                   DTSCS31
01174 /*****************************************************************DTSCS31
01175 *                                                                *DTSCS31
01176 ******************************************************************DTSCS31
01177  P6110-FIRST-REC.                                                 DTSCS31
01178      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCS31
01179      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCS31
01180      SET MSKL-QTR-88 TO TRUE.                                     DTSCS31
01181      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS31
01182      IF L810-NO-REC-88                                            DTSCS31
01183          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS31
01184          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS31
01185          GO TO P6110-EXIT.                                        DTSCS31
01186                                                                   DTSCS31
01187      PERFORM S810-END-BROWSE THRU S810-EXIT.                      DTSCS31
01188                                                                   DTSCS31
01189      MOVE MSKL-REC TO MQTR-REC.                                   DTSCS31
01190                                                                   DTSCS31
01191      MOVE +1 TO WRK-CURR-PAGE.                                    DTSCS31
01192  P6110-EXIT.                                                      DTSCS31
01193      EXIT.                                                        DTSCS31
01194                                                                   DTSCS31
01195  P6120-PREV-REC.                                                  DTSCS31
01196      PERFORM S810-READ-PREV THRU S810-EXIT.                       DTSCS31
01197      IF L810-NO-REC-88                                            DTSCS31
01198          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS31
01199          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS31
01200          GO TO P6120-EXIT.                                        DTSCS31
01201                                                                   DTSCS31
01202      PERFORM S810-READ-PREV THRU S810-EXIT.                       DTSCS31
01203      IF L810-NO-REC-88                                            DTSCS31
01204          GO TO P6120-EXIT.                                        DTSCS31
01205                                                                   DTSCS31
01206      PERFORM S810-END-BROWSE THRU S810-EXIT.                      DTSCS31
01207                                                                   DTSCS31
01208      SUBTRACT 1 FROM WRK-CURR-PAGE.                               DTSCS31
01209                                                                   DTSCS31
01210      MOVE MSKL-REC TO MQTR-REC.                                   DTSCS31
01211  P6120-EXIT.                                                      DTSCS31
01212      EXIT.                                                        DTSCS31
01213                                                                   DTSCS31
01214  P6130-NEXT-REC.                                                  DTSCS31
01215      IF MQTR-YRQ > WRK-FROM-YRQ                                   DTSCS31
01216          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS31
01217          GO TO P6130-EXIT.                                        DTSCS31
01218                                                                   DTSCS31
01219      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS31
01220                                                                   DTSCS31
01221      IF L810-NO-REC-88                                            DTSCS31
01222          GO TO P6130-EXIT.                                        DTSCS31
01223                                                                   DTSCS31
01224      PERFORM S810-END-BROWSE THRU S810-EXIT.                      DTSCS31
01225                                                                   DTSCS31
01226      ADD +1 TO WRK-CURR-PAGE.                                     DTSCS31
01227                                                                   DTSCS31
01228      MOVE MSKL-REC TO MQTR-REC.                                   DTSCS31
01229  P6130-EXIT.                                                      DTSCS31
01230      EXIT.                                                        DTSCS31
01231                                                                   DTSCS31
01232  P6140-LAST-REC.                                                  DTSCS31
01233      MOVE HOLD-EMP-LAST-KEY-AREA TO MSKL-KEY-AREA.                DTSCS31
01234      PERFORM S810-READ THRU S810-EXIT.                            DTSCS31
01235      IF L810-NO-REC-88                                            DTSCS31
01236          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS31
01237          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS31
01238          GO TO P6140-EXIT.                                        DTSCS31
01239                                                                   DTSCS31
01240      MOVE MSKL-REC TO MQTR-REC.                                   DTSCS31
01241                                                                   DTSCS31
01242      MOVE HOLD-EMP-LAST-PAGE TO WRK-CURR-PAGE.                    DTSCS31
01243  P6140-EXIT.                                                      DTSCS31
01244      EXIT.                                                        DTSCS31
01245                                                                   DTSCS31
01246                                                                   DTSCS31
01247  P6190-BROWSE-MQTR.                                               DTSCS31
01248      MOVE MSKL-REC TO MQTR-REC.                                   DTSCS31
01249                                                                   DTSCS31
01250      ADD +1 TO WRK-CURR-PAGE.                                     DTSCS31
01251                                                                   DTSCS31
01252      IF MQTR-YRQ NOT < WRK-FROM-YRQ                               DTSCS31
01253          MOVE 'Y' TO WRK-REC-FOUND-IND                            DTSCS31
01254      ELSE                                                         DTSCS31
01255          PERFORM S810-READ-NEXT THRU S810-EXIT.                   DTSCS31
01256  P6190-EXIT.                                                      DTSCS31
01257      EXIT.                                                        DTSCS31
01258 /*****************************************************************DTSCS31
01259 *    A RANGE OF QUARTERS WAS REQUESTED                           *DTSCS31
01260 ******************************************************************DTSCS31
01261                                                                   DTSCS31
01262  P6200-LOCATE-RANGE.                                              DTSCS31
01263      MOVE +0 TO RECS-IN-RANGE-CNT.                                DTSCS31
01264                                                                   DTSCS31
01265      MOVE +0 TO FIRST-REC-IN-RANGE-YRQ                            DTSCS31
01266                 LAST-REC-IN-RANGE-YRQ.                            DTSCS31
01267                                                                   DTSCS31
01268      MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSCS31
01269      MOVE WRK-EMP-NO TO MQTR-EMP-NO.                              DTSCS31
01270      SET MQTR-QTR-88 TO TRUE.                                     DTSCS31
01271      MOVE WRK-FROM-YRQ TO MQTR-YRQ.                               DTSCS31
01272      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS31
01273      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS31
01274                                                                   DTSCS31
01275      PERFORM P6210-SCAN-MQTR THRU P6210-EXIT                      DTSCS31
01276          UNTIL L810-NO-REC-88.                                    DTSCS31
01277                                                                   DTSCS31
01278      IF RECS-IN-RANGE-CNT = +0                                    DTSCS31
01279          MOVE MSG-E311-AREA TO WRK-MSG-AREA                       DTSCS31
01280          PERFORM S1201-ERROR THRU S1201-EXIT                      DTSCS31
01281          PERFORM S1202-ERROR THRU S1202-EXIT                      DTSCS31
01282          GO TO P6200-EXIT.                                        DTSCS31
01283                                                                   DTSCS31
01284      IF RECS-IN-RANGE-CNT = +1                                    DTSCS31
01285          MOVE FIRST-REC-IN-RANGE-YRQ TO WRK-FROM-YRQ              DTSCS31
01286                                         WRK-TO-YRQ                DTSCS31
01287          SET WRK-RANGE-NO TO TRUE                                 DTSCS31
01288      ELSE                                                         DTSCS31
01289          MOVE FIRST-REC-IN-RANGE-YRQ TO WRK-FROM-YRQ              DTSCS31
01290          MOVE LAST-REC-IN-RANGE-YRQ TO WRK-TO-YRQ.                DTSCS31
01291  P6200-EXIT.                                                      DTSCS31
01292      EXIT.                                                        DTSCS31
01293                                                                   DTSCS31
01294                                                                   DTSCS31
01295  P6210-SCAN-MQTR.                                                 DTSCS31
01296      MOVE MSKL-REC TO MQTR-REC.                                   DTSCS31
01297                                                                   DTSCS31
01298      IF NOT MQTR-CURR-NOT-LIABLE-88                               DTSCS31
01299         MOVE MQTR-CURR-RPT-TYPE TO WRK-CURR-RPT-TYPE.             DTSCS31
01300                                                                   DTSCS31
01301      IF MQTR-YRQ > WRK-TO-YRQ                                     DTSCS31
01302          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS31
01303          SET L810-NO-REC-88 TO TRUE                               DTSCS31
01304          GO TO P6210-EXIT.                                        DTSCS31
01305                                                                   DTSCS31
01306      ADD +1 TO RECS-IN-RANGE-CNT.                                 DTSCS31
01307                                                                   DTSCS31
01308      IF FIRST-REC-IN-RANGE-YRQ = +0                               DTSCS31
01309          MOVE MQTR-YRQ TO FIRST-REC-IN-RANGE-YRQ.                 DTSCS31
01310                                                                   DTSCS31
01311      MOVE MQTR-YRQ TO LAST-REC-IN-RANGE-YRQ.                      DTSCS31
01312                                                                   DTSCS31
01313      IF MQTR-YRQ = WRK-TO-YRQ                                     DTSCS31
01314          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS31
01315          SET L810-NO-REC-88 TO TRUE                               DTSCS31
01316          GO TO P6210-EXIT.                                        DTSCS31
01317                                                                   DTSCS31
01318      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS31
01319  P6210-EXIT.                                                      DTSCS31
01320      EXIT.                                                        DTSCS31
01321 /*****************************************************************DTSCS31
01322 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS            *DTSCS31
01323 ******************************************************************DTSCS31
01324                                                                   DTSCS31
01325  P6900-CONSTRUCT-SCREEN.                                          DTSCS31
01326      PERFORM S109-SUR-TAX-QTR THRU S109-EXIT.                     DTSCS31
01327                                                                   DTSCS31
01328      PERFORM P6901-TO-FROM-YRQ THRU P6901-EXIT.                   DTSCS31
01329                                                                   DTSCS31
01330      PERFORM P6910-TOP-OF-SCREEN THRU P6910-EXIT.                 DTSCS31
01331                                                                   DTSCS31
01332      PERFORM P6920-CENTER-OF-SCREEN THRU P6920-EXIT.              DTSCS31
01333                                                                   DTSCS31
01334      IF WRK-RANGE-NO                                              DTSCS31
01335      OR WRK-RANGE-ANNUAL                                          DTSCS31
01336         PERFORM P6930-BOTTOM-OF-SCREEN THRU P6930-EXIT.           DTSCS31
01337                                                                   DTSCS31
01338      IF WRK-RANGE-NO                                              DTSCS31
01339         PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT                 DTSCS31
01340         MOVE MQTR-KEY-AREA TO HOLD-SCR-KEY-AREA                   DTSCS31
01341         MOVE WRK-CURR-PAGE TO HOLD-SCR-PAGE                       DTSCS31
01342      ELSE                                                         DTSCS31
01343         MOVE LOW-VALUES TO HOLD-SCR-AREA                          DTSCS31
01344         MOVE +0 TO HOLD-SCR-PAGE.                                 DTSCS31
01345  P6900-EXIT.                                                      DTSCS31
01346      EXIT.                                                        DTSCS31
01347      SKIP3                                                        DTSCS31
01348  P6901-TO-FROM-YRQ.                                               DTSCS31
01349      IF WRK-FROM-YRQ = LCCM-PICKUP-YRQ                            DTSCS31
01350          MOVE 'PU' TO MAP-FROM-YRQ-YR                             DTSCS31
01351          MOVE SPACE TO MAP-FROM-YRQ-Q                             DTSCS31
01352      ELSE                                                         DTSCS31
01353          MOVE WRK-FROM-YRQ TO WRK-DISPLAY                         DTSCS31
01354          MOVE WRK-DISPLAY-YRQ-YR TO MAP-FROM-YRQ-YR               DTSCS31
01355          MOVE WRK-DISPLAY-YRQ-Q TO MAP-FROM-YRQ-Q.                DTSCS31
01356                                                                   DTSCS31
01357      IF WRK-RANGE-YES                                             DTSCS31
01358          IF WRK-TO-YRQ = LCCM-PICKUP-YRQ                          DTSCS31
01359              MOVE 'PU' TO MAP-TO-YRQ-YR                           DTSCS31
01360              MOVE SPACE TO MAP-TO-YRQ-Q                           DTSCS31
01361          ELSE                                                     DTSCS31
01362              MOVE WRK-TO-YRQ TO WRK-DISPLAY                       DTSCS31
01363              MOVE WRK-DISPLAY-YRQ-YR TO MAP-TO-YRQ-YR             DTSCS31
01364              MOVE WRK-DISPLAY-YRQ-Q TO MAP-TO-YRQ-Q               DTSCS31
01365      ELSE                                                         DTSCS31
01366          MOVE LOW-VALUES TO MAP-TO-YRQ-YR                         DTSCS31
01367                             MAP-TO-YRQ-Q.                         DTSCS31
01368  P6901-EXIT.                                                      DTSCS31
01369      EXIT.                                                        DTSCS31
01370 /*****************************************************************DTSCS31
01371 *                                                                *DTSCS31
01372 ******************************************************************DTSCS31
01373  P6910-TOP-OF-SCREEN.                                             DTSCS31
01374      MOVE HOLD-EMP-CLASS-DSCR TO MAP-EMP-CLASS-DSCR.              DTSCS31
01375                                                                   DTSCS31
01376      MOVE MPRF-BANKRUPTCY-OPEN-IND TO MAP-BANKRUPTCY-OPEN-IND.    DTSCS31
01377                                                                   DTSCS31
01378      MOVE HOLD-EMP-PICKUP-DUE-IND TO MAP-PICKUP-DUE-IND.          DTSCS31
01379                                                                   DTSCS31
01380      MOVE HOLD-EMP-STATUS-DSCR TO MAP-EMP-STATUS-DSCR.            DTSCS31
01381                                                                   DTSCS31
01382      IF MPRF-WRITE-OFF-DATE > +0                                  DTSCS31
01383          MOVE MPRF-WRITE-OFF-DATE TO L001-FED-8-DATE-9            DTSCS31
01384          PERFORM S001-FROM-FED-8 THRU S001-EXIT                   DTSCS31
01385          MOVE L001-SLASH-DATE TO MAP-WRITEOFF-DATE.               DTSCS31
01386                                                                   DTSCS31
01387      IF MPRF-WRITE-OFF-DATE > +0                                  DTSCS31
01388          MOVE '   WRITTEN OFF' TO MAP-TOT-DUE-AMT                 DTSCS31
01389      ELSE                                                         DTSCS31
01390          MOVE HOLD-EMP-TOT-DUE-AMT TO MAP-TOT-DUE-AMT-Z.          DTSCS31
01391                                                                   DTSCS31
01392      IF HOLD-EMP-LAST-PAGE = +0                                   DTSCS31
01393         MOVE SPACES                TO MAP-COMPROMISE              DTSCS31
01394      ELSE                                                         DTSCS31
01395         IF MQTR-CMP-ESTB-ABSTIME > ZERO                           DTSCS31
01396            MOVE '** COMPROMISE **' TO MAP-COMPROMISE              DTSCS31
01397         ELSE                                                      DTSCS31
01398            MOVE SPACES             TO MAP-COMPROMISE              DTSCS31
01399         END-IF                                                    DTSCS31
01400      END-IF.                                                      DTSCS31
01401                                                                   DTSCS31
01402      MOVE HOLD-EMP-RECENT-SOL TO MAP-RECENT-SOL.                  DTSCS31
01403                                                                   DTSCS31
01404      STRING HOLD-EMP-OPEN-APL-IND DELIMITED BY SIZE               DTSCS31
01405             '/'                   DELIMITED BY SIZE               DTSCS31
01406             HOLD-EMP-OPEN-LIN-IND DELIMITED BY SIZE               DTSCS31
01407             '/'                   DELIMITED BY SIZE               DTSCS31
01408             HOLD-EMP-OPEN-DPC-IND DELIMITED BY SIZE               DTSCS31
01409        INTO MAP-ALD-INDS.                                         DTSCS31
01410                                                                   DTSCS31
01411      MOVE HOLD-EMP-PER-MONTH-INT TO MAP-INT-MONTH-Z.              DTSCS31
01412                                                                   DTSCS31
01413      MOVE HOLD-EMP-FLD-REP-ID TO MAP-FLD-REP-ID.                  DTSCS31
01414                                                                   DTSCS31
01415      MOVE HOLD-EMP-NBR-SPANS TO MAP-SOL-CNT.                      DTSCS31
01416                                                                   DTSCS31
01417      MOVE HOLD-EMP-SUBPOENA-CD   TO MAP-SUBPOENA-CD.              DTSCS31
01418      MOVE HOLD-EMP-SUBPOENA-DATE TO MAP-SUBPOENA-DATE.            DTSCS31
01419                                                                   DTSCS31
01420      MOVE MPRF-PURSUED-RPT-CNT TO MAP-PURSUED-RPT-CNT-Z.          DTSCS31
01421                                                                   DTSCS31
01422      IF MPRF-NOT-WRITTEN-OFF-88                                   DTSCS31
01423          MOVE '    TOLERATED' TO MAP-SUSP-TOL-COL-LIT             DTSCS31
01424      ELSE                                                         DTSCS31
01425          MOVE '  WRITTEN OFF' TO MAP-SUSP-TOL-COL-LIT.            DTSCS31
01426  P6910-EXIT.                                                      DTSCS31
01427      EXIT.                                                        DTSCS31
01428 /*****************************************************************DTSCS31
01429 *                                                               * DTSCS31
01430 ******************************************************************DTSCS31
01431  P6920-CENTER-OF-SCREEN.                                          DTSCS31
01432      INITIALIZE WRK-BUCKETS                                       DTSCS31
01433                 WRK-WAGE-BUCKETS.                                 DTSCS31
01434                                                                   DTSCS31
01435      IF WRK-RANGE-YES                                             DTSCS31
01436          MOVE LOW-VALUES TO MQTR-KEY-AREA                         DTSCS31
01437          MOVE WRK-EMP-NO TO MQTR-EMP-NO                           DTSCS31
01438          SET MQTR-QTR-88 TO TRUE                                  DTSCS31
01439          MOVE WRK-FROM-YRQ TO MQTR-YRQ                            DTSCS31
01440          MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA                      DTSCS31
01441          PERFORM S810-START-BROWSE THRU S810-EXIT                 DTSCS31
01442          PERFORM P6921-SCAN-MQTR THRU P6921-EXIT                  DTSCS31
01443              UNTIL L810-NO-REC-88                                 DTSCS31
01444      ELSE                                                         DTSCS31
01445          PERFORM P6922-PROCESS-MQTR THRU P6922-EXIT.              DTSCS31
01446                                                                   DTSCS31
01447      IF WRK-RANGE-YES                                             DTSCS31
01448          SET WRK-DISPLAY-ZEROS-YES TO TRUE                        DTSCS31
01449      ELSE                                                         DTSCS31
01450          IF MQTR-CURR-NOT-LIABLE-88                               DTSCS31
01451          OR MQTR-CURR-NOT-DUE-88                                  DTSCS31
01452          OR MQTR-CURR-DELINQ-88                                   DTSCS31
01453              SET WRK-DISPLAY-ZEROS-NO TO TRUE                     DTSCS31
01454          ELSE                                                     DTSCS31
01455              SET WRK-DISPLAY-ZEROS-YES TO TRUE.                   DTSCS31
01456                                                                   DTSCS31
01457      PERFORM                                                      DTSCS31
01458        VARYING WRK-ROW FROM 1 BY 1                                DTSCS31
01459        UNTIL WRK-ROW > LIT-TOT-SUB                                DTSCS31
01460          PERFORM                                                  DTSCS31
01461            VARYING WRK-COL FROM 1 BY 1                            DTSCS31
01462            UNTIL WRK-COL > LIT-BALANCE                            DTSCS31
01463              IF (WRK-BUCKET (WRK-ROW WRK-COL) NOT = +0)           DTSCS31
01464                   OR (WRK-DISPLAY-ZEROS-YES)                      DTSCS31
01465                  MOVE WRK-BUCKET (WRK-ROW WRK-COL)                DTSCS31
01466                    TO MAP-AMT-Z (WRK-ROW WRK-COL)                 DTSCS31
01467              END-IF                                               DTSCS31
01468          END-PERFORM                                              DTSCS31
01469      END-PERFORM.                                                 DTSCS31
01470  P6920-EXIT.                                                      DTSCS31
01471      EXIT.                                                        DTSCS31
01472                                                                   DTSCS31
01473                                                                   DTSCS31
01474  P6921-SCAN-MQTR.                                                 DTSCS31
01475      MOVE MSKL-REC TO MQTR-REC.                                   DTSCS31
01476                                                                   DTSCS31
01477      PERFORM P6922-PROCESS-MQTR THRU P6922-EXIT.                  DTSCS31
01478                                                                   DTSCS31
01479      IF MQTR-YRQ NOT < WRK-TO-YRQ                                 DTSCS31
01480          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS31
01481          SET L810-NO-REC-88 TO TRUE                               DTSCS31
01482          GO TO P6921-EXIT.                                        DTSCS31
01483                                                                   DTSCS31
01484      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS31
01485  P6921-EXIT.                                                      DTSCS31
01486      EXIT.                                                        DTSCS31
01487                                                                   DTSCS31
01488                                                                   DTSCS31
01489  P6922-PROCESS-MQTR.                                              DTSCS31
01490      MOVE +0 TO L101-PAID-CHNG.                                   DTSCS31
01491 *               L101-PEN-CHARGED-AMT.                             DTSCS31
01492                                                                   DTSCS31
01493 ************************************************************      DTSCS31
01494 * ONLY UI TAX BALANCE USED TO COMPUTE INTEREST                    DTSCS31
01495 ************************************************************      DTSCS31
01496      PERFORM                                                      DTSCS31
01497        VARYING MQTR-ACCT-IDX FROM 1 BY 1                          DTSCS31
01498        UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT                        DTSCS31
01499          PERFORM P6923-ASSIGN-SUB THRU P6923-EXIT                 DTSCS31
01500          PERFORM P6924-ACCUM THRU P6924-EXIT                      DTSCS31
01501          IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX)                       DTSCS31
01502              ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                 DTSCS31
01503               TO L101-PAID-CHNG                                   DTSCS31
01504          END-IF                                                   DTSCS31
01505          IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) AND                  DTSCS31
01506             MQTR-YRQ >= L109-FIRST-PEN-INT-YRQ                    DTSCS31
01507              ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                 DTSCS31
01508               TO L101-PAID-CHNG                                   DTSCS31
01509          END-IF                                                   DTSCS31
01510 *        IF MQTR-ACCT-PEN-88 (MQTR-ACCT-IDX)                      DTSCS31
01511 *            ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX)                 DTSCS31
01512 *             TO L101-PEN-CHARGED-AMT                             DTSCS31
01513 *        END-IF                                                   DTSCS31
01514      END-PERFORM.                                                 DTSCS31
01515                                                                   DTSCS31
01516      ADD MQTR-TOT-WAGE         TO WRK-TOT-WAGE-BUCKET.            DTSCS31
01517      ADD MQTR-TAX-WAGE         TO WRK-TAX-WAGE-BUCKET.            DTSCS31
01518      ADD MQTR-EXCESS-WAGE      TO WRK-EXCESS-WAGE-BUCKET.         DTSCS31
01519                                                                   DTSCS31
01520      IF L101-PAID-CHNG > +0                                       DTSCS31
01521          NEXT SENTENCE                                            DTSCS31
01522      ELSE                                                         DTSCS31
01523          GO TO P6922-EXIT.                                        DTSCS31
01524                                                                   DTSCS31
01525      IF LCCM-COMP-DATE = ALL-NINES-DATE                           DTSCS31
01526          GO TO P6922-EXIT.                                        DTSCS31
01527                                                                   DTSCS31
01528      MOVE LCCM-COMP-DATE TO L101-RECEIVED-DATE.                   DTSCS31
01529      SET L101-WAIVE-INT-NO-88 TO TRUE.                            DTSCS31
01530      MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE.                 DTSCS31
01531      MOVE MQTR-INT-AREA TO L101-INT-AREA.                         DTSCS31
01532                                                                   DTSCS31
01533      SET L101-PER-MONTH-NO-88 TO TRUE.                            DTSCS31
01534                                                                   DTSCS31
01535      PERFORM S101-PER-MONTH-NO THRU S101-EXIT.                    DTSCS31
01536                                                                   DTSCS31
01537      ADD L101-INT-CHARGE-CHNG                                     DTSCS31
01538       TO WRK-BUCKET (LIT-INT-SUB LIT-CHARGED)                     DTSCS31
01539          WRK-BUCKET (LIT-TOT-SUB LIT-CHARGED)                     DTSCS31
01540          WRK-BUCKET (LIT-INT-SUB LIT-BALANCE)                     DTSCS31
01541          WRK-BUCKET (LIT-TOT-SUB LIT-BALANCE).                    DTSCS31
01542                                                                   DTSCS31
01543      ADD L101-INT-WAIVE-CHNG                                      DTSCS31
01544       TO WRK-BUCKET (LIT-INT-SUB LIT-WAIVED)                      DTSCS31
01545          WRK-BUCKET (LIT-TOT-SUB LIT-WAIVED).                     DTSCS31
01546      SUBTRACT L101-INT-WAIVE-CHNG                                 DTSCS31
01547          FROM WRK-BUCKET (LIT-INT-SUB LIT-BALANCE)                DTSCS31
01548               WRK-BUCKET (LIT-TOT-SUB LIT-BALANCE).               DTSCS31
01549                                                                   DTSCS31
01550 *    ADD L101-PEN-CHARGE-CHNG                                     DTSCS31
01551 *     TO WRK-BUCKET (LIT-PEN-SUB LIT-CHARGED)                     DTSCS31
01552 *        WRK-BUCKET (LIT-TOT-SUB LIT-CHARGED)                     DTSCS31
01553 *        WRK-BUCKET (LIT-PEN-SUB LIT-BALANCE)                     DTSCS31
01554 *        WRK-BUCKET (LIT-TOT-SUB LIT-BALANCE).                    DTSCS31
01555 *                                                                 DTSCS31
01556 *    ADD L101-PEN-ABATE-CHNG                                      DTSCS31
01557 *     TO WRK-BUCKET (LIT-PEN-SUB LIT-ABATED)                      DTSCS31
01558 *        WRK-BUCKET (LIT-TOT-SUB LIT-ABATED).                     DTSCS31
01559 *    SUBTRACT L101-PEN-ABATE-CHNG                                 DTSCS31
01560 *        FROM WRK-BUCKET (LIT-PEN-SUB LIT-BALANCE)                DTSCS31
01561 *             WRK-BUCKET (LIT-TOT-SUB LIT-BALANCE).               DTSCS31
01562  P6922-EXIT.                                                      DTSCS31
01563      EXIT.                                                        DTSCS31
01564                                                                   DTSCS31
01565                                                                   DTSCS31
01566  P6923-ASSIGN-SUB.                                                DTSCS31
01567      IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX)                           DTSCS31
01568          MOVE LIT-UI-SUB TO WRK-ROW                               DTSCS31
01569      ELSE                                                         DTSCS31
01570      IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX)                          DTSCS31
01571          MOVE LIT-SUR-SUB TO WRK-ROW                              DTSCS31
01572      ELSE                                                         DTSCS31
01573      IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX)                          DTSCS31
01574          MOVE LIT-TAX-SUB TO WRK-ROW                              DTSCS31
01575      ELSE                                                         DTSCS31
01576      IF MQTR-ACCT-INT-88 (MQTR-ACCT-IDX)                          DTSCS31
01577          MOVE LIT-INT-SUB TO WRK-ROW                              DTSCS31
01578      ELSE                                                         DTSCS31
01579      IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX)                     DTSCS31
01580          MOVE LIT-LATE-PEN-SUB TO WRK-ROW                         DTSCS31
01581      ELSE                                                         DTSCS31
01582      IF MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX)                      DTSCS31
01583          MOVE LIT-NSF-PEN-SUB TO WRK-ROW                          DTSCS31
01584      ELSE                                                         DTSCS31
01585      IF MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX)                     DTSCS31
01586          MOVE LIT-MISC-PEN-SUB TO WRK-ROW                         DTSCS31
01587      ELSE                                                         DTSCS31
01588          GO TO S899-ABEND.                                        DTSCS31
01589  P6923-EXIT.                                                      DTSCS31
01590      EXIT.                                                        DTSCS31
01591                                                                   DTSCS31
01592                                                                   DTSCS31
01593  P6924-ACCUM.                                                     DTSCS31
01594      ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX)                         DTSCS31
01595       TO WRK-BUCKET (WRK-ROW LIT-CHARGED)                         DTSCS31
01596          WRK-BUCKET (LIT-TOT-SUB LIT-CHARGED).                    DTSCS31
01597                                                                   DTSCS31
01598      ADD MQTR-PAID-AMT (MQTR-ACCT-IDX)                            DTSCS31
01599       TO WRK-BUCKET (WRK-ROW LIT-PAID)                            DTSCS31
01600          WRK-BUCKET (LIT-TOT-SUB LIT-PAID).                       DTSCS31
01601                                                                   DTSCS31
01602      ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX)                          DTSCS31
01603       TO WRK-BUCKET (WRK-ROW LIT-WAIVED)                          DTSCS31
01604          WRK-BUCKET (LIT-TOT-SUB LIT-WAIVED).                     DTSCS31
01605                                                                   DTSCS31
01606      IF MPRF-NOT-WRITTEN-OFF-88                                   DTSCS31
01607          ADD MQTR-TOLER-AMT (MQTR-ACCT-IDX)                       DTSCS31
01608           TO WRK-BUCKET (WRK-ROW LIT-WOFF-TOLER)                  DTSCS31
01609              WRK-BUCKET (LIT-TOT-SUB LIT-WOFF-TOLER)              DTSCS31
01610      ELSE                                                         DTSCS31
01611          ADD MQTR-WRITTEN-OFF-AMT (MQTR-ACCT-IDX)                 DTSCS31
01612           TO WRK-BUCKET (WRK-ROW LIT-WOFF-TOLER)                  DTSCS31
01613              WRK-BUCKET (LIT-TOT-SUB LIT-WOFF-TOLER).             DTSCS31
01614                                                                   DTSCS31
01615      ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                         DTSCS31
01616       TO WRK-BUCKET (WRK-ROW LIT-BALANCE)                         DTSCS31
01617          WRK-BUCKET (LIT-TOT-SUB LIT-BALANCE).                    DTSCS31
01618                                                                   DTSCS31
01619      IF WRK-ROW < LIT-TAX-SUB                                     DTSCS31
01620          ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX)                     DTSCS31
01621           TO WRK-BUCKET (LIT-TAX-SUB LIT-CHARGED)                 DTSCS31
01622          ADD MQTR-PAID-AMT (MQTR-ACCT-IDX)                        DTSCS31
01623           TO WRK-BUCKET (LIT-TAX-SUB LIT-PAID)                    DTSCS31
01624          ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX)                      DTSCS31
01625           TO WRK-BUCKET (LIT-TAX-SUB LIT-WAIVED)                  DTSCS31
01626          IF NOT MPRF-NOT-WRITTEN-OFF-88                           DTSCS31
01627              ADD MQTR-WRITTEN-OFF-AMT (MQTR-ACCT-IDX)             DTSCS31
01628               TO WRK-BUCKET (LIT-TAX-SUB LIT-WOFF-TOLER)          DTSCS31
01629          END-IF                                                   DTSCS31
01630          IF MPRF-NOT-WRITTEN-OFF-88                               DTSCS31
01631              ADD MQTR-TOLER-AMT (MQTR-ACCT-IDX)                   DTSCS31
01632               TO WRK-BUCKET (LIT-TAX-SUB LIT-WOFF-TOLER)          DTSCS31
01633          END-IF                                                   DTSCS31
01634          ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                     DTSCS31
01635           TO WRK-BUCKET (LIT-TAX-SUB LIT-BALANCE).                DTSCS31
01636  P6924-EXIT.                                                      DTSCS31
01637      EXIT.                                                        DTSCS31
01638 /*****************************************************************DTSCS31
01639 * ONLY IF WE ARE DISPLAYING AN INDOIVIDUAL RECORD               * DTSCS31
01640 ******************************************************************DTSCS31
01641  P6930-BOTTOM-OF-SCREEN.                                          DTSCS31
01642      IF (MQTR-RPT-DUE-DATE = +0)                                  DTSCS31
01643              OR                                                   DTSCS31
01644         (MQTR-YRQ = LCCM-PICKUP-YRQ)                              DTSCS31
01645          NEXT SENTENCE                                            DTSCS31
01646      ELSE                                                         DTSCS31
01647          MOVE MQTR-RPT-DUE-DATE TO L001-FED-8-DATE-9              DTSCS31
01648          PERFORM S001-FROM-FED-8 THRU S001-EXIT                   DTSCS31
01649          MOVE L001-SLASH-DATE TO MAP-RPT-DUE-DATE.                DTSCS31
01650                                                                   DTSCS31
01651      IF (MQTR-TAX-DUE-DATE = +0)                                  DTSCS31
01652              OR                                                   DTSCS31
01653         (MQTR-YRQ = LCCM-PICKUP-YRQ)                              DTSCS31
01654          NEXT SENTENCE                                            DTSCS31
01655      ELSE                                                         DTSCS31
01656          MOVE MQTR-TAX-DUE-DATE TO L001-FED-8-DATE-9              DTSCS31
01657          PERFORM S001-FROM-FED-8 THRU S001-EXIT                   DTSCS31
01658          MOVE L001-SLASH-DATE TO MAP-TAX-DUE-DATE.                DTSCS31
01659                                                                   DTSCS31
01660      MOVE MQTR-CURR-RPT-TYPE TO L033-CURR-RPT-TYPE.               DTSCS31
01661      MOVE MQTR-PURSUED-RPT-IND TO L033-PURSUED-RPT-IND.           DTSCS31
01662      PERFORM S033-RPT-PURSUED-DSCR THRU S033-EXIT.                DTSCS31
01663      MOVE L033-SHORT-DSCR TO MAP-CURR-RPT-TYPE-DSCR.              DTSCS31
01664                                                                   DTSCS31
01665      IF MQTR-YRQ = LCCM-PICKUP-YRQ                                DTSCS31
01666          NEXT SENTENCE                                            DTSCS31
01667      ELSE                                                         DTSCS31
01668          MOVE MQTR-MISS-RPT-CUTOFF-CD TO L032-CD                  DTSCS31
01669          PERFORM S032-MISS-RPT-CUTOFF-CD THRU S032-EXIT           DTSCS31
01670          MOVE L032-SHORT-DSCR TO MAP-MISS-RPT-CUTOFF-CD-DSCR.     DTSCS31
01671                                                                   DTSCS31
01672      MOVE MQTR-INT-CHARGE-IND TO MAP-INT-CHARGE-IND.              DTSCS31
01673      MOVE '/' TO MAP-INTPEN-SLASH.                                DTSCS31
01674      MOVE MQTR-PEN-CHARGE-IND TO MAP-PEN-CHARGE-IND.              DTSCS31
01675                                                                   DTSCS31
01676                                                                   DTSCS31
01677      IF MQTR-YRQ = LCCM-PICKUP-YRQ                                DTSCS31
01678          NEXT SENTENCE                                            DTSCS31
01679      ELSE                                                         DTSCS31
01680      IF WRK-RANGE-ANNUAL                                          DTSCS31
01681         IF (WRK-TOT-WAGE-BUCKET NOT = +0                          DTSCS31
01682         OR WRK-DISPLAY-ZEROS-YES)                                 DTSCS31
01683            MOVE WRK-TOT-WAGE-BUCKET TO MAP-TOT-WAGE-Z             DTSCS31
01684         END-IF                                                    DTSCS31
01685      ELSE                                                         DTSCS31
01686      IF (MQTR-TOT-WAGE NOT = +0)                                  DTSCS31
01687            OR (WRK-DISPLAY-ZEROS-YES)                             DTSCS31
01688          MOVE MQTR-TOT-WAGE TO MAP-TOT-WAGE-Z.                    DTSCS31
01689                                                                   DTSCS31
01690      IF MQTR-YRQ = LCCM-PICKUP-YRQ                                DTSCS31
01691          NEXT SENTENCE                                            DTSCS31
01692      ELSE                                                         DTSCS31
01693      IF WRK-RANGE-ANNUAL                                          DTSCS31
01694         IF (WRK-EXCESS-WAGE-BUCKET NOT = +0                       DTSCS31
01695         OR WRK-DISPLAY-ZEROS-YES)                                 DTSCS31
01696            MOVE WRK-EXCESS-WAGE-BUCKET TO MAP-EXCESS-WAGE-Z       DTSCS31
01697         END-IF                                                    DTSCS31
01698      ELSE                                                         DTSCS31
01699      IF (MQTR-EXCESS-WAGE NOT = +0)                               DTSCS31
01700            OR (WRK-DISPLAY-ZEROS-YES)                             DTSCS31
01701          MOVE MQTR-EXCESS-WAGE TO MAP-EXCESS-WAGE-Z.              DTSCS31
01702                                                                   DTSCS31
01703      IF MQTR-YRQ = LCCM-PICKUP-YRQ                                DTSCS31
01704          NEXT SENTENCE                                            DTSCS31
01705      ELSE                                                         DTSCS31
01706      IF WRK-RANGE-ANNUAL                                          DTSCS31
01707         IF (WRK-TAX-WAGE-BUCKET NOT = +0                          DTSCS31
01708         OR WRK-DISPLAY-ZEROS-YES)                                 DTSCS31
01709            MOVE WRK-TAX-WAGE-BUCKET TO MAP-TAX-WAGE-Z             DTSCS31
01710         END-IF                                                    DTSCS31
01711      ELSE                                                         DTSCS31
01712      IF (MQTR-TAX-WAGE NOT = +0)                                  DTSCS31
01713            OR (WRK-DISPLAY-ZEROS-YES)                             DTSCS31
01714          MOVE MQTR-TAX-WAGE TO MAP-TAX-WAGE-Z.                    DTSCS31
01715                                                                   DTSCS31
01716      IF MQTR-YRQ = LCCM-PICKUP-YRQ                                DTSCS31
01717          NEXT SENTENCE                                            DTSCS31
01718      ELSE                                                         DTSCS31
01719      IF MQTR-NO-UI-RATE-88                                        DTSCS31
01720          MOVE +0 TO L056-RATE                                     DTSCS31
01721      ELSE                                                         DTSCS31
01722          MOVE MQTR-UI-RATE TO L056-RATE                           DTSCS31
01723          PERFORM S056-DISP1-RIGHT THRU S056-EXIT                  DTSCS31
01724          MOVE L056-DISP-RATE TO MAP-UI-RATE.                      DTSCS31
01725                                                                   DTSCS31
01726 *****IF MPRF-CLASS-SUB-88                                         DTSCS31
01727 *********MOVE MPRF-EMP-CLASS TO L109-EMP-CLASS                    DTSCS31
01728 *********MOVE MQTR-YRQ TO L109-YRQ                                DTSCS31
01729 *********PERFORM S109-LOOKUP-RATE THRU S109-EXIT                  DTSCS31
01730 *********ADD L109-AFT-RATE TO L056-RATE                           DTSCS31
01731 *********ADD L109-FLA-RATE TO L056-RATE                           DTSCS31
01732 *********ADD L109-SUR-RATE TO L056-RATE                           DTSCS31
01733 *********PERFORM S056-DISP1-LEFT THRU S056-EXIT                   DTSCS31
01734 *********MOVE L056-DISP-RATE TO MAP-TOT-RATE.                     DTSCS31
01735                                                                   DTSCS31
01736      MOVE SPACE TO WRK-QTR-OPEN-APL-IND                           DTSCS31
01737                    WRK-QTR-OPEN-LIN-IND                           DTSCS31
01738                    WRK-QTR-OPEN-DPC-IND.                          DTSCS31
01739      IF HOLD-EMP-OPEN-APL-YES-88                                  DTSCS31
01740          MOVE LOW-VALUES TO MSKL-KEY-AREA                         DTSCS31
01741          MOVE WRK-EMP-NO TO MSKL-EMP-NO                           DTSCS31
01742          SET MSKL-APL-88 TO TRUE                                  DTSCS31
01743          PERFORM S810-START-BROWSE THRU S810-EXIT                 DTSCS31
01744          PERFORM P6931-SCAN-MAPL THRU P6931-EXIT                  DTSCS31
01745              UNTIL L810-NO-REC-88.                                DTSCS31
01746      IF HOLD-EMP-OPEN-LIN-YES-88                                  DTSCS31
01747          MOVE LOW-VALUES TO MSKL-KEY-AREA                         DTSCS31
01748          MOVE WRK-EMP-NO TO MSKL-EMP-NO                           DTSCS31
01749          SET MSKL-LIN-88 TO TRUE                                  DTSCS31
01750          PERFORM S810-START-BROWSE THRU S810-EXIT                 DTSCS31
01751          PERFORM P6932-SCAN-MLIN THRU P6932-EXIT                  DTSCS31
01752              UNTIL L810-NO-REC-88.                                DTSCS31
01753      IF HOLD-EMP-OPEN-DPC-YES-88                                  DTSCS31
01754          MOVE LOW-VALUES TO MSKL-KEY-AREA                         DTSCS31
01755          MOVE WRK-EMP-NO TO MSKL-EMP-NO                           DTSCS31
01756          SET MSKL-DPC-88 TO TRUE                                  DTSCS31
01757          PERFORM S810-START-BROWSE THRU S810-EXIT                 DTSCS31
01758          PERFORM P6933-SCAN-MDPC THRU P6933-EXIT                  DTSCS31
01759              UNTIL L810-NO-REC-88.                                DTSCS31
01760      STRING WRK-QTR-OPEN-APL-IND DELIMITED BY SIZE                DTSCS31
01761             '/'                  DELIMITED BY SIZE                DTSCS31
01762             WRK-QTR-OPEN-LIN-IND DELIMITED BY SIZE                DTSCS31
01763             '/'                  DELIMITED BY SIZE                DTSCS31
01764             WRK-QTR-OPEN-DPC-IND DELIMITED BY SIZE                DTSCS31
01765          INTO MAP-QTR-ALD.                                        DTSCS31
01766                                                                   DTSCS31
01767      IF MQTR-YRQ = LCCM-PICKUP-YRQ                                DTSCS31
01768          NEXT SENTENCE                                            DTSCS31
01769      ELSE                                                         DTSCS31
01770      IF MQTR-WAGE-RPT-IND > SPACES                                DTSCS31
01771          MOVE MQTR-WAGE-RPT-IND TO MAP-WAGE-RPT.                  DTSCS31
01772                                                                   DTSCS31
01773      IF MQTR-WAIVE-PEN-START-DATE NOT = +0                        DTSCS31
01774          MOVE MQTR-WAIVE-PEN-START-DATE TO L001-FED-8-DATE-9      DTSCS31
01775          PERFORM S001-FROM-FED-8 THRU S001-EXIT                   DTSCS31
01776          MOVE L001-SLASH-DATE TO MAP-WAIVE-PEN-START-DATE.        DTSCS31
01777                                                                   DTSCS31
01778      IF MQTR-WAIVE-PEN-END-DATE NOT = +0                          DTSCS31
01779          MOVE MQTR-WAIVE-PEN-END-DATE TO L001-FED-8-DATE-9        DTSCS31
01780          PERFORM S001-FROM-FED-8 THRU S001-EXIT                   DTSCS31
01781          MOVE L001-SLASH-DATE TO MAP-WAIVE-PEN-END-DATE.          DTSCS31
01782                                                                   DTSCS31
01783      IF MQTR-WAIVE-INT-START-DATE NOT = +0                        DTSCS31
01784          MOVE MQTR-WAIVE-INT-START-DATE TO L001-FED-8-DATE-9      DTSCS31
01785          PERFORM S001-FROM-FED-8 THRU S001-EXIT                   DTSCS31
01786          MOVE L001-SLASH-DATE TO MAP-WAIVE-INT-START-DATE.        DTSCS31
01787                                                                   DTSCS31
01788      IF MQTR-WAIVE-INT-END-DATE NOT = +0                          DTSCS31
01789          MOVE MQTR-WAIVE-INT-END-DATE TO L001-FED-8-DATE-9        DTSCS31
01790          PERFORM S001-FROM-FED-8 THRU S001-EXIT                   DTSCS31
01791          MOVE L001-SLASH-DATE TO MAP-WAIVE-INT-END-DATE.          DTSCS31
01792                                                                   DTSCS31
01793      IF MQTR-INT-CNT > +0                                         DTSCS31
01794          MOVE MQTR-INT-START-DATE (1) TO L001-FED-8-DATE-9        DTSCS31
01795          PERFORM S001-FROM-FED-8 THRU S001-EXIT                   DTSCS31
01796          MOVE L001-SLASH-DATE TO MAP-INT-START-DATE-1             DTSCS31
01797          MOVE MQTR-INT-END-DATE (1) TO L001-FED-8-DATE-9          DTSCS31
01798          PERFORM S001-FROM-FED-8 THRU S001-EXIT                   DTSCS31
01799          MOVE L001-SLASH-DATE TO MAP-INT-END-DATE-1               DTSCS31
01800          MOVE MQTR-INT-RATE (1) TO L056-RATE                      DTSCS31
01801          PERFORM S056-DISP1-LEFT THRU S056-EXIT                   DTSCS31
01802          MOVE L056-DISP-RATE TO MAP-INT-RATE-1.                   DTSCS31
01803                                                                   DTSCS31
01804      IF MQTR-INT-CNT > +1                                         DTSCS31
01805          MOVE MQTR-INT-START-DATE (2) TO L001-FED-8-DATE-9        DTSCS31
01806          PERFORM S001-FROM-FED-8 THRU S001-EXIT                   DTSCS31
01807          MOVE L001-SLASH-DATE TO MAP-INT-START-DATE-2             DTSCS31
01808          MOVE MQTR-INT-END-DATE (2) TO L001-FED-8-DATE-9          DTSCS31
01809          PERFORM S001-FROM-FED-8 THRU S001-EXIT                   DTSCS31
01810          MOVE L001-SLASH-DATE TO MAP-INT-END-DATE-2               DTSCS31
01811          MOVE MQTR-INT-RATE (2) TO L056-RATE                      DTSCS31
01812          PERFORM S056-DISP1-LEFT THRU S056-EXIT                   DTSCS31
01813          MOVE L056-DISP-RATE TO MAP-INT-RATE-2.                   DTSCS31
01814  P6930-EXIT.                                                      DTSCS31
01815      EXIT.                                                        DTSCS31
01816                                                                   DTSCS31
01817                                                                   DTSCS31
01818  P6931-SCAN-MAPL.                                                 DTSCS31
01819      MOVE MSKL-REC TO MAPL-REC.                                   DTSCS31
01820                                                                   DTSCS31
01821      IF MAPL-STATUS-OPEN-88                                       DTSCS31
01822          PERFORM                                                  DTSCS31
01823            VARYING MAPL-COV-IDX FROM 1 BY 1                       DTSCS31
01824            UNTIL MAPL-COV-IDX > MAPL-COVERED-CNT                  DTSCS31
01825              IF MQTR-YRQ = MAPL-COVERED-YRQ (MAPL-COV-IDX)        DTSCS31
01826                  SET WRK-QTR-OPEN-APL-YES-88 TO TRUE              DTSCS31
01827              END-IF                                               DTSCS31
01828          END-PERFORM.                                             DTSCS31
01829                                                                   DTSCS31
01830      IF WRK-QTR-OPEN-APL-YES-88                                   DTSCS31
01831          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS31
01832          SET L810-NO-REC-88 TO TRUE                               DTSCS31
01833          GO TO P6931-EXIT.                                        DTSCS31
01834                                                                   DTSCS31
01835      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS31
01836  P6931-EXIT.                                                      DTSCS31
01837      EXIT.                                                        DTSCS31
01838                                                                   DTSCS31
01839                                                                   DTSCS31
01840  P6932-SCAN-MLIN.                                                 DTSCS31
01841      MOVE MSKL-REC TO MLIN-REC.                                   DTSCS31
01842                                                                   DTSCS31
01843      IF MLIN-STATUS-ACTIVE-88                                     DTSCS31
01844          PERFORM                                                  DTSCS31
01845            VARYING MLIN-COV-IDX FROM 1 BY 1                       DTSCS31
01846            UNTIL MLIN-COV-IDX > MLIN-COV-CNT                      DTSCS31
01847              IF MQTR-YRQ = MLIN-COVERED-YRQ (MLIN-COV-IDX)        DTSCS31
01848                  SET WRK-QTR-OPEN-LIN-YES-88 TO TRUE              DTSCS31
01849              END-IF                                               DTSCS31
01850          END-PERFORM.                                             DTSCS31
01851                                                                   DTSCS31
01852      IF WRK-QTR-OPEN-LIN-YES-88                                   DTSCS31
01853          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS31
01854          SET L810-NO-REC-88 TO TRUE                               DTSCS31
01855          GO TO P6932-EXIT.                                        DTSCS31
01856                                                                   DTSCS31
01857      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS31
01858  P6932-EXIT.                                                      DTSCS31
01859      EXIT.                                                        DTSCS31
01860                                                                   DTSCS31
01861                                                                   DTSCS31
01862  P6933-SCAN-MDPC.                                                 DTSCS31
01863      MOVE MSKL-REC TO MDPC-REC.                                   DTSCS31
01864                                                                   DTSCS31
01865      IF MDPC-STATUS-ACTIVE-88                                     DTSCS31
01866          PERFORM                                                  DTSCS31
01867            VARYING MDPC-COV-IDX FROM 1 BY 1                       DTSCS31
01868            UNTIL MDPC-COV-IDX > MDPC-COV-CNT                      DTSCS31
01869              IF MQTR-YRQ = MDPC-COVERED-YRQ (MDPC-COV-IDX)        DTSCS31
01870                  SET WRK-QTR-OPEN-DPC-YES-88 TO TRUE              DTSCS31
01871              END-IF                                               DTSCS31
01872          END-PERFORM.                                             DTSCS31
01873                                                                   DTSCS31
01874      IF WRK-QTR-OPEN-DPC-YES-88                                   DTSCS31
01875          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS31
01876          SET L810-NO-REC-88 TO TRUE                               DTSCS31
01877          GO TO P6933-EXIT.                                        DTSCS31
01878                                                                   DTSCS31
01879      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS31
01880  P6933-EXIT.                                                      DTSCS31
01881      EXIT.                                                        DTSCS31
01882      EJECT                                                        DTSCS31
01883  P6940-SET-RPT-TYPE.                                              DTSCS31
01884      IF WRK-CURR-RPT-TYPE-NULL-88                                 DTSCS31
01885         GO TO P6940-EXIT.                                         DTSCS31
01886                                                                   DTSCS31
01887      MOVE WRK-CURR-RPT-TYPE TO L033-CURR-RPT-TYPE.                DTSCS31
01888      MOVE MQTR-PURSUED-RPT-IND TO L033-PURSUED-RPT-IND.           DTSCS31
01889      PERFORM S033-RPT-PURSUED-DSCR THRU S033-EXIT.                DTSCS31
01890      MOVE L033-SHORT-DSCR TO MAP-CURR-RPT-TYPE-DSCR.              DTSCS31
01891                                                                   DTSCS31
01892  P6940-EXIT.                                                      DTSCS31
01893      EXIT.                                                        DTSCS31
01894      EJECT                                                        DTSCS31
01895  P6990-PAGE-NUMBER.                                               DTSCS31
01896      MOVE WRK-CURR-PAGE TO MAP-CURR-PAGE.                         DTSCS31
01897      MOVE HOLD-EMP-LAST-PAGE TO MAP-LAST-PAGE.                    DTSCS31
01898                                                                   DTSCS31
01899      IF WRK-CURR-PAGE = +1                                        DTSCS31
01900          IF HOLD-EMP-LAST-PAGE = +1                               DTSCS31
01901              MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA                 DTSCS31
01902          ELSE                                                     DTSCS31
01903              MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA                DTSCS31
01904      ELSE                                                         DTSCS31
01905          IF WRK-CURR-PAGE = HOLD-EMP-LAST-PAGE                    DTSCS31
01906              MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA.                DTSCS31
01907  P6990-EXIT.                                                      DTSCS31
01908      EXIT.                                                        DTSCS31
01909 /*****************************************************************DTSCS31
01910 *                                                                 DTSCS31
01911 ******************************************************************DTSCS31
01912  P7000-REFRESH-HOLD-EMP-AREA.                                     DTSCS31
01913      MOVE WRK-EMP-NO TO HOLD-EMP-EMP-NO.                          DTSCS31
01914      MOVE LCCM-COMP-DATE TO HOLD-EMP-COMP-DATE.                   DTSCS31
01915      MOVE LCCM-TASK-START-ABSTIME TO HOLD-EMP-ABSTIME.            DTSCS31
01916                                                                   DTSCS31
01917      MOVE MPRF-EMP-CLASS TO L031-CD.                              DTSCS31
01918      PERFORM S031-MPRF-EMP-CLASS THRU S031-EXIT.                  DTSCS31
01919      MOVE L031-SHORT-DSCR TO HOLD-EMP-CLASS-DSCR.                 DTSCS31
01920                                                                   DTSCS31
01921      MOVE MPRF-EMP-STATUS TO L031-CD.                             DTSCS31
01922      PERFORM S031-MPRF-EMP-STATUS THRU S031-EXIT.                 DTSCS31
01923      MOVE L031-SHORT-DSCR TO HOLD-EMP-STATUS-DSCR.                DTSCS31
01924                                                                   DTSCS31
01925      PERFORM P7100-RECENT-MSOL THRU P7100-EXIT.                   DTSCS31
01926                                                                   DTSCS31
01927      MOVE MPRF-FLD-ZIP TO L061-FLD-ZIP.                           DTSCS31
01928      MOVE MPRF-EMP-NO TO L061-EMP-NO.                             DTSCS31
01929      MOVE MPRF-FLD-ST TO L061-FLD-ST.                             DTSCS31
01930      PERFORM S061-FLD-REP-FROM-ZIP THRU S061-EXIT.                DTSCS31
01931      MOVE L061-FLD-REP-ID TO HOLD-EMP-FLD-REP-ID.                 DTSCS31
01932                                                                   DTSCS31
01933      MOVE SPACES TO HOLD-EMP-OPEN-APL-IND.                        DTSCS31
01934      IF MPRF-MAPL-EXISTS-88                                       DTSCS31
01935          MOVE LOW-VALUES TO MSKL-KEY-AREA                         DTSCS31
01936          MOVE WRK-EMP-NO TO MSKL-EMP-NO                           DTSCS31
01937          SET MSKL-APL-88 TO TRUE                                  DTSCS31
01938          PERFORM S810-START-BROWSE THRU S810-EXIT                 DTSCS31
01939          PERFORM P7210-MAPL-SCAN THRU P7210-EXIT                  DTSCS31
01940              UNTIL L810-NO-REC-88.                                DTSCS31
01941                                                                   DTSCS31
01942      MOVE SPACES TO HOLD-EMP-OPEN-LIN-IND.                        DTSCS31
01943      IF MPRF-MLIN-EXISTS-88                                       DTSCS31
01944          MOVE LOW-VALUES TO MSKL-KEY-AREA                         DTSCS31
01945          MOVE WRK-EMP-NO TO MSKL-EMP-NO                           DTSCS31
01946          SET MSKL-LIN-88 TO TRUE                                  DTSCS31
01947          PERFORM S810-START-BROWSE THRU S810-EXIT                 DTSCS31
01948          PERFORM P7220-MLIN-SCAN THRU P7220-EXIT                  DTSCS31
01949              UNTIL L810-NO-REC-88.                                DTSCS31
01950                                                                   DTSCS31
01951      MOVE SPACES TO HOLD-EMP-OPEN-DPC-IND.                        DTSCS31
01952      IF MPRF-MDPC-EXISTS-88                                       DTSCS31
01953          MOVE LOW-VALUES TO MSKL-KEY-AREA                         DTSCS31
01954          MOVE WRK-EMP-NO TO MSKL-EMP-NO                           DTSCS31
01955          SET MSKL-DPC-88 TO TRUE                                  DTSCS31
01956          PERFORM S810-START-BROWSE THRU S810-EXIT                 DTSCS31
01957          PERFORM P7230-MDPC-SCAN THRU P7230-EXIT                  DTSCS31
01958              UNTIL L810-NO-REC-88.                                DTSCS31
01959                                                                   DTSCS31
01960      MOVE SPACE TO HOLD-EMP-SUBPOENA-CD                           DTSCS31
01961                    HOLD-EMP-SUBPOENA-DATE.                        DTSCS31
01962      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCS31
01963      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCS31
01964      SET MSKL-COL-88 TO TRUE.                                     DTSCS31
01965      PERFORM S810-READ THRU S810-EXIT.                            DTSCS31
01966      IF L810-OK-88                                                DTSCS31
01967          MOVE MSKL-REC TO MCOL-REC                                DTSCS31
01968          MOVE MCOL-SUBPOENA-ACTIVITY-CD TO HOLD-EMP-SUBPOENA-CD   DTSCS31
01969          IF MCOL-SUBPOENA-ACTIVITY-DATE > +0                      DTSCS31
01970              MOVE MCOL-SUBPOENA-ACTIVITY-DATE TO L001-FED-8-DATE-9DTSCS31
01971              PERFORM S001-FROM-FED-8 THRU S001-EXIT               DTSCS31
01972              MOVE L001-SLASH-DATE TO HOLD-EMP-SUBPOENA-DATE.      DTSCS31
01973                                                                   DTSCS31
01974      MOVE +0 TO HOLD-EMP-TOT-DUE-AMT                              DTSCS31
01975                 HOLD-EMP-PER-MONTH-INT.                           DTSCS31
01976                                                                   DTSCS31
01977      MOVE LOW-VALUES TO HOLD-EMP-LAST-KEY-AREA.                   DTSCS31
01978                                                                   DTSCS31
01979      MOVE +0 TO HOLD-EMP-LAST-PAGE.                               DTSCS31
01980                                                                   DTSCS31
01981      MOVE SPACE TO HOLD-EMP-PICKUP-DUE-IND.                       DTSCS31
01982                                                                   DTSCS31
01983      IF MPRF-TOT-BALANCE-AMT > +0                                 DTSCS31
01984          MOVE LOW-VALUES TO MSKL-KEY-AREA                         DTSCS31
01985          MOVE WRK-EMP-NO TO MSKL-EMP-NO                           DTSCS31
01986          SET MSKL-QTR-88 TO TRUE                                  DTSCS31
01987          PERFORM S810-START-BROWSE THRU S810-EXIT                 DTSCS31
01988          PERFORM P7300-MQTR-SCAN THRU P7300-EXIT                  DTSCS31
01989              UNTIL L810-NO-REC-88                                 DTSCS31
01990      ELSE                                                         DTSCS31
01991          PERFORM P7010-EMP-TOT-DUE-AMT THRU P7010-EXIT            DTSCS31
01992          MOVE LOW-VALUES TO MSKL-KEY-AREA                         DTSCS31
01993          MOVE WRK-EMP-NO TO MSKL-EMP-NO                           DTSCS31
01994          SET MSKL-QTR-88 TO TRUE                                  DTSCS31
01995          PERFORM S810-COUNT THRU S810-EXIT                        DTSCS31
01996          IF L810-RECORD-CNT > +0                                  DTSCS31
01997              MOVE L810-RECORD-CNT TO HOLD-EMP-LAST-PAGE           DTSCS31
01998              MOVE MSKL-KEY-AREA TO HOLD-EMP-LAST-KEY-AREA.        DTSCS31
01999  P7000-EXIT.                                                      DTSCS31
02000      EXIT.                                                        DTSCS31
02001      SKIP3                                                        DTSCS31
02002  P7010-EMP-TOT-DUE-AMT.                                           DTSCS31
02003      IF MPRF-TOT-CREDIT-AMT > +0                                  DTSCS31
02004          COMPUTE HOLD-EMP-TOT-DUE-AMT = MPRF-TOT-CREDIT-AMT * -1  DTSCS31
02005      ELSE                                                         DTSCS31
02006          MOVE +0 TO HOLD-EMP-TOT-DUE-AMT.                         DTSCS31
02007  P7010-EXIT.                                                      DTSCS31
02008      EXIT.                                                        DTSCS31
02009      EJECT                                                        DTSCS31
02010  P7100-RECENT-MSOL.                                               DTSCS31
02011      MOVE SPACES TO HOLD-EMP-RECENT-SOL.                          DTSCS31
02012      MOVE ':' TO HOLD-EMP-RECENT-COLON.                           DTSCS31
02013                                                                   DTSCS31
02014      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCS31
02015      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCS31
02016      SET MSKL-SOL-88 TO TRUE.                                     DTSCS31
02017                                                                   DTSCS31
02018      PERFORM S810-COUNT THRU S810-EXIT.                           DTSCS31
02019                                                                   DTSCS31
02020      MOVE L810-RECORD-CNT TO HOLD-EMP-NBR-SPANS.                  DTSCS31
02021                                                                   DTSCS31
02022      IF L810-RECORD-CNT = +0                                      DTSCS31
02023          GO TO P7100-EXIT.                                        DTSCS31
02024                                                                   DTSCS31
02025      PERFORM S810-READ THRU S810-EXIT.                            DTSCS31
02026      MOVE MSKL-REC TO MSOL-REC.                                   DTSCS31
02027                                                                   DTSCS31
02028      IF  MSOL-INACT-WITHDRAWN-88                                  DTSCS31
02029      AND HOLD-EMP-NBR-SPANS > +1                                  DTSCS31
02030          SUBTRACT 1 FROM HOLD-EMP-NBR-SPANS                       DTSCS31
02031          PERFORM P7110-LOCATE-MSOL THRU P7110-EXIT.               DTSCS31
02032                                                                   DTSCS31
02033      PERFORM P7120-FIRST-LIAB-YRQ THRU P7120-EXIT.                DTSCS31
02034      PERFORM P7130-LAST-LIAB-YRQ THRU P7130-EXIT.                 DTSCS31
02035  P7100-EXIT.                                                      DTSCS31
02036      EXIT.                                                        DTSCS31
02037                                                                   DTSCS31
02038                                                                   DTSCS31
02039  P7110-LOCATE-MSOL.                                               DTSCS31
02040      MOVE MSKL-KEY-AREA TO WRK-KEY-AREA.                          DTSCS31
02041                                                                   DTSCS31
02042      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS31
02043      MOVE MSKL-REC TO MSOL-REC.                                   DTSCS31
02044                                                                   DTSCS31
02045      PERFORM UNTIL L810-NO-REC-88                                 DTSCS31
02046              OR    NOT MSOL-INACT-WITHDRAWN-88                    DTSCS31
02047          PERFORM S810-READ-PREV THRU S810-EXIT                    DTSCS31
02048          MOVE MSKL-REC TO MSOL-REC                                DTSCS31
02049      END-PERFORM.                                                 DTSCS31
02050                                                                   DTSCS31
02051      IF L810-OK-88                                                DTSCS31
02052          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS31
02053      ELSE                                                         DTSCS31
02054          MOVE WRK-KEY-AREA TO MSKL-KEY-AREA                       DTSCS31
02055          PERFORM S810-READ THRU S810-EXIT                         DTSCS31
02056          MOVE MSKL-REC TO MSOL-REC.                               DTSCS31
02057  P7110-EXIT. EXIT.                                                DTSCS31
02058                                                                   DTSCS31
02059                                                                   DTSCS31
02060  P7120-FIRST-LIAB-YRQ.                                            DTSCS31
02061      IF MSOL-FIRST-LIAB-YRQ = +0                                  DTSCS31
02062          NEXT SENTENCE                                            DTSCS31
02063      ELSE                                                         DTSCS31
02064          MOVE MSOL-FIRST-LIAB-YRQ TO L004-QTR-5-9                 DTSCS31
02065          PERFORM S004-FROM-5 THRU S004-EXIT                       DTSCS31
02066          MOVE L004-SLASH-QTR TO HOLD-EMP-RECENT-FROM-YRQ.         DTSCS31
02067  P7120-EXIT.                                                      DTSCS31
02068      EXIT.                                                        DTSCS31
02069                                                                   DTSCS31
02070  P7130-LAST-LIAB-YRQ.                                             DTSCS31
02071      IF MSOL-LAST-LIAB-YRQ = +0 OR LIT-9-YRQ                      DTSCS31
02072          NEXT SENTENCE                                            DTSCS31
02073      ELSE                                                         DTSCS31
02074          MOVE MSOL-LAST-LIAB-YRQ TO L004-QTR-5-9                  DTSCS31
02075          PERFORM S004-FROM-5 THRU S004-EXIT                       DTSCS31
02076          MOVE L004-SLASH-QTR TO HOLD-EMP-RECENT-TO-YRQ.           DTSCS31
02077  P7130-EXIT.                                                      DTSCS31
02078      EXIT.                                                        DTSCS31
02079      EJECT                                                        DTSCS31
02080  P7210-MAPL-SCAN.                                                 DTSCS31
02081      MOVE MSKL-REC TO MAPL-REC.                                   DTSCS31
02082                                                                   DTSCS31
02083      IF MAPL-STATUS-OPEN-88                                       DTSCS31
02084          SET HOLD-EMP-OPEN-APL-YES-88 TO TRUE                     DTSCS31
02085          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS31
02086          SET L810-NO-REC-88 TO TRUE                               DTSCS31
02087          GO TO P7210-EXIT.                                        DTSCS31
02088                                                                   DTSCS31
02089      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS31
02090  P7210-EXIT.                                                      DTSCS31
02091      EXIT.                                                        DTSCS31
02092                                                                   DTSCS31
02093                                                                   DTSCS31
02094  P7220-MLIN-SCAN.                                                 DTSCS31
02095      MOVE MSKL-REC TO MLIN-REC.                                   DTSCS31
02096                                                                   DTSCS31
02097      IF MLIN-STATUS-ACTIVE-88                                     DTSCS31
02098          SET HOLD-EMP-OPEN-LIN-YES-88 TO TRUE                     DTSCS31
02099          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS31
02100          SET L810-NO-REC-88 TO TRUE                               DTSCS31
02101          GO TO P7220-EXIT.                                        DTSCS31
02102                                                                   DTSCS31
02103      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS31
02104  P7220-EXIT.                                                      DTSCS31
02105      EXIT.                                                        DTSCS31
02106                                                                   DTSCS31
02107                                                                   DTSCS31
02108  P7230-MDPC-SCAN.                                                 DTSCS31
02109      MOVE MSKL-REC TO MDPC-REC.                                   DTSCS31
02110                                                                   DTSCS31
02111      IF MDPC-STATUS-ACTIVE-88                                     DTSCS31
02112          SET HOLD-EMP-OPEN-DPC-YES-88 TO TRUE                     DTSCS31
02113          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS31
02114          SET L810-NO-REC-88 TO TRUE                               DTSCS31
02115          GO TO P7230-EXIT.                                        DTSCS31
02116                                                                   DTSCS31
02117      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS31
02118  P7230-EXIT.                                                      DTSCS31
02119      EXIT.                                                        DTSCS31
02120      EJECT                                                        DTSCS31
02121  P7300-MQTR-SCAN.                                                 DTSCS31
02122      MOVE MSKL-REC TO MQTR-REC.                                   DTSCS31
02123                                                                   DTSCS31
02124      MOVE MQTR-KEY-AREA TO HOLD-EMP-LAST-KEY-AREA.                DTSCS31
02125                                                                   DTSCS31
02126      ADD +1 TO HOLD-EMP-LAST-PAGE.                                DTSCS31
02127                                                                   DTSCS31
02128      PERFORM P7310-PROCESS-MQTR THRU P7310-EXIT.                  DTSCS31
02129                                                                   DTSCS31
02130      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS31
02131  P7300-EXIT.                                                      DTSCS31
02132      EXIT.                                                        DTSCS31
02133                                                                   DTSCS31
02134                                                                   DTSCS31
02135  P7310-PROCESS-MQTR.                                              DTSCS31
02136      MOVE +0 TO L101-PAID-CHNG                                    DTSCS31
02137 *               L101-PEN-CHARGED-AMT.                             DTSCS31
02138                                                                   DTSCS31
02139      IF MQTR-YRQ = LCCM-PICKUP-YRQ                                DTSCS31
02140          PERFORM                                                  DTSCS31
02141            VARYING MQTR-ACCT-IDX FROM 1 BY 1                      DTSCS31
02142            UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT                    DTSCS31
02143              IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > +0             DTSCS31
02144                  SET HOLD-EMP-PICKUP-DUE-YES-88 TO TRUE           DTSCS31
02145              END-IF                                               DTSCS31
02146          END-PERFORM.                                             DTSCS31
02147                                                                   DTSCS31
02148 ********************************************************          DTSCS31
02149 * ONLY UI TAX BALANCE USED TO COMPUTE INTEREST                    DTSCS31
02150 ********************************************************          DTSCS31
02151      PERFORM                                                      DTSCS31
02152        VARYING MQTR-ACCT-IDX FROM 1 BY 1                          DTSCS31
02153        UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT                        DTSCS31
02154          ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                     DTSCS31
02155           TO HOLD-EMP-TOT-DUE-AMT                                 DTSCS31
02156 *        IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX)                       DTSCS31
02157          IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX)                      DTSCS31
02158              ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                 DTSCS31
02159               TO L101-PAID-CHNG                                   DTSCS31
02160          END-IF                                                   DTSCS31
02161 *********IF MQTR-ACCT-PEN-88 (MQTR-ACCT-IDX)                      DTSCS31
02162 *************ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX)                 DTSCS31
02163 **************TO L101-PEN-CHARGED-AMT                             DTSCS31
02164 *********END-IF                                                   DTSCS31
02165      END-PERFORM.                                                 DTSCS31
02166                                                                   DTSCS31
02167      IF LCCM-COMP-DATE = ALL-NINES-DATE                           DTSCS31
02168          GO TO P7310-EXIT.                                        DTSCS31
02169                                                                   DTSCS31
02170      IF L101-PAID-CHNG > +0                                       DTSCS31
02171          NEXT SENTENCE                                            DTSCS31
02172      ELSE                                                         DTSCS31
02173          GO TO P7310-EXIT.                                        DTSCS31
02174                                                                   DTSCS31
02175      MOVE LCCM-COMP-DATE TO L101-RECEIVED-DATE.                   DTSCS31
02176                                                                   DTSCS31
02177      SET L101-WAIVE-INT-NO-88 TO TRUE.                            DTSCS31
02178 *    SET L101-ABATE-PEN-NO-88 TO TRUE.                            DTSCS31
02179                                                                   DTSCS31
02180      MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE.                 DTSCS31
02181                                                                   DTSCS31
02182      MOVE MQTR-INT-AREA TO L101-INT-AREA.                         DTSCS31
02183                                                                   DTSCS31
02184      PERFORM S101-PER-MONTH-YES THRU S101-EXIT.                   DTSCS31
02185                                                                   DTSCS31
02186      ADD L101-INT-CHARGE-CHNG TO HOLD-EMP-TOT-DUE-AMT.            DTSCS31
02187                                                                   DTSCS31
02188      SUBTRACT L101-INT-WAIVE-CHNG FROM HOLD-EMP-TOT-DUE-AMT.      DTSCS31
02189                                                                   DTSCS31
02190 *    ADD L101-PEN-CHARGE-CHNG TO HOLD-EMP-TOT-DUE-AMT.            DTSCS31
02191                                                                   DTSCS31
02192 *    SUBTRACT L101-PEN-ABATE-CHNG FROM HOLD-EMP-TOT-DUE-AMT.      DTSCS31
02193                                                                   DTSCS31
02194      ADD L101-INT-PER-MONTH TO HOLD-EMP-PER-MONTH-INT.            DTSCS31
02195  P7310-EXIT.                                                      DTSCS31
02196      EXIT.                                                        DTSCS31
02197 /*****************************************************************DTSCS31
02198 * LINKS TO UTILITY MODULES                                        DTSCS31
02199 ******************************************************************DTSCS31
02200                                                                   DTSCS31
02201  S001-FROM-FED-8.                                                 DTSCS31
02202      SET L001-FROM-FED-8 TO TRUE.                                 DTSCS31
02203      GO TO S001-DATE.                                             DTSCS31
02204                                                                   DTSCS31
02205 *S001-FROM-ABS-DATE.                                              DTSCS31
02206 *****SET L001-FROM-ABS-DAY TO TRUE.                               DTSCS31
02207 *****GO TO S001-DATE.                                             DTSCS31
02208                                                                   DTSCS31
02209  S001-DATE.                                                       DTSCS31
02210      EXEC CICS LINK                                               DTSCS31
02211          PROGRAM('DTSCU001')                                      DTSCS31
02212          COMMAREA(L001-COMM-AREA)                                 DTSCS31
02213      END-EXEC.                                                    DTSCS31
02214  S001-EXIT.                                                       DTSCS31
02215      EXIT.                                                        DTSCS31
02216                                                                   DTSCS31
02217  S004-FROM-5.                                                     DTSCS31
02218      SET L004-FROM-5 TO TRUE.                                     DTSCS31
02219      GO TO S004-LINK.                                             DTSCS31
02220                                                                   DTSCS31
02221  S004-FROM-ABS.                                                   DTSCS31
02222      SET L004-FROM-ABS TO TRUE.                                   DTSCS31
02223      GO TO S004-LINK.                                             DTSCS31
02224                                                                   DTSCS31
02225  S004-LINK.                                                       DTSCS31
02226      EXEC CICS LINK                                               DTSCS31
02227          PROGRAM  ('DTSCU004')                                    DTSCS31
02228          COMMAREA (L004-COMM-AREA)                                DTSCS31
02229      END-EXEC.                                                    DTSCS31
02230  S004-EXIT.                                                       DTSCS31
02231      EXIT.                                                        DTSCS31
02232                                                                   DTSCS31
02233  S015-DATE-FROM-SCREEN.                                           DTSCS31
02234      EXEC CICS LINK                                               DTSCS31
02235          PROGRAM('DTSCU015')                                      DTSCS31
02236          COMMAREA(L015-COMM-AREA)                                 DTSCS31
02237      END-EXEC.                                                    DTSCS31
02238  S015-EXIT.                                                       DTSCS31
02239      EXIT.                                                        DTSCS31
02240                                                                   DTSCS31
02241 *S016-YRQ-FROM-SCREEN.                                            DTSCS31
02242 *****EXEC CICS LINK                                               DTSCS31
02243 *********PROGRAM('DTSCU016')                                      DTSCS31
02244 *********COMMAREA(L016-COMM-AREA)                                 DTSCS31
02245 *****END-EXEC.                                                    DTSCS31
02246 *S016-EXIT.                                                       DTSCS31
02247 *****EXIT.                                                        DTSCS31
02248                                                                   DTSCS31
02249                                                                   DTSCS31
02250  S018-EMP-NO-FROM-SCREEN.                                         DTSCS31
02251      EXEC CICS LINK                                               DTSCS31
02252          PROGRAM('DTSCU018')                                      DTSCS31
02253          COMMAREA(L018-COMM-AREA)                                 DTSCS31
02254      END-EXEC.                                                    DTSCS31
02255  S018-EXIT.                                                       DTSCS31
02256      EXIT.                                                        DTSCS31
02257                                                                   DTSCS31
02258                                                                   DTSCS31
02259  S029-YRQ-WITH-PU-FROM-SCREEN.                                    DTSCS31
02260      EXEC CICS LINK                                               DTSCS31
02261          PROGRAM('DTSCU029')                                      DTSCS31
02262          COMMAREA(L029-COMM-AREA)                                 DTSCS31
02263      END-EXEC.                                                    DTSCS31
02264  S029-EXIT.                                                       DTSCS31
02265      EXIT.                                                        DTSCS31
02266                                                                   DTSCS31
02267                                                                   DTSCS31
02268  S031-MPRF-EMP-CLASS.                                             DTSCS31
02269      SET L031-MPRF-EMP-CLASS       TO TRUE.                       DTSCS31
02270      GO TO S031-LINK.                                             DTSCS31
02271                                                                   DTSCS31
02272  S031-MPRF-EMP-STATUS.                                            DTSCS31
02273      SET L031-MPRF-EMP-STATUS      TO TRUE.                       DTSCS31
02274      GO TO S031-LINK.                                             DTSCS31
02275                                                                   DTSCS31
02276  S031-LINK.                                                       DTSCS31
02277      EXEC CICS LINK                                               DTSCS31
02278          PROGRAM  ('DTSCU031')                                    DTSCS31
02279          COMMAREA (L031-COMM-AREA)                                DTSCS31
02280      END-EXEC.                                                    DTSCS31
02281  S031-EXIT.                                                       DTSCS31
02282      EXIT.                                                        DTSCS31
02283                                                                   DTSCS31
02284  S032-MISS-RPT-CUTOFF-CD.                                         DTSCS31
02285      SET L032-MQTR-MISS-RPT-CUOFF-CD TO TRUE.                     DTSCS31
02286      EXEC CICS LINK                                               DTSCS31
02287          PROGRAM  ('DTSCU032')                                    DTSCS31
02288          COMMAREA (L032-COMM-AREA)                                DTSCS31
02289      END-EXEC.                                                    DTSCS31
02290  S032-EXIT.                                                       DTSCS31
02291      EXIT.                                                        DTSCS31
02292                                                                   DTSCS31
02293  S033-RPT-PURSUED-DSCR.                                           DTSCS31
02294      SET L033-MQTR-RPT-PURSUE        TO TRUE.                     DTSCS31
02295      EXEC CICS LINK                                               DTSCS31
02296          PROGRAM  ('DTSCU033')                                    DTSCS31
02297          COMMAREA (L033-COMM-AREA)                                DTSCS31
02298      END-EXEC.                                                    DTSCS31
02299  S033-EXIT.                                                       DTSCS31
02300      EXIT.                                                        DTSCS31
02301                                                                   DTSCS31
02302  S056-DISP1-LEFT.                                                 DTSCS31
02303      SET L056-DISP1-LEFT-88       TO TRUE.                        DTSCS31
02304      GO TO S056-LINK.                                             DTSCS31
02305                                                                   DTSCS31
02306  S056-DISP1-RIGHT.                                                DTSCS31
02307      SET L056-DISP1-RIGHT-88      TO TRUE.                        DTSCS31
02308      GO TO S056-LINK.                                             DTSCS31
02309                                                                   DTSCS31
02310  S056-LINK.                                                       DTSCS31
02311      EXEC CICS LINK                                               DTSCS31
02312          PROGRAM  ('DTSCU056')                                    DTSCS31
02313          COMMAREA (L056-COMM-AREA)                                DTSCS31
02314      END-EXEC.                                                    DTSCS31
02315  S056-EXIT.                                                       DTSCS31
02316      EXIT.                                                        DTSCS31
02317                                                                   DTSCS31
02318  S061-FLD-REP-FROM-ZIP.                                           DTSCS31
02319      EXEC CICS LINK                                               DTSCS31
02320          PROGRAM  ('DTSCU061')                                    DTSCS31
02321          COMMAREA (L061-COMM-AREA)                                DTSCS31
02322      END-EXEC.                                                    DTSCS31
02323                                                                   DTSCS31
02324      IF L061-FILE-CLOSED                                          DTSCS31
02325          MOVE L061-MSG-AREA TO LCCM-MSG-AREA                      DTSCS31
02326          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS31
02327          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS31
02328          GO TO MAINLINE-EXIT.                                     DTSCS31
02329  S061-EXIT.                                                       DTSCS31
02330      EXIT.                                                        DTSCS31
02331                                                                   DTSCS31
02332  S101-PER-MONTH-NO.                                               DTSCS31
02333      SET L101-PER-MONTH-NO-88 TO TRUE.                            DTSCS31
02334      GO TO S101-INT-PEN-COMP.                                     DTSCS31
02335                                                                   DTSCS31
02336  S101-PER-MONTH-YES.                                              DTSCS31
02337      SET L101-PER-MONTH-YES-88 TO TRUE.                           DTSCS31
02338      GO TO S101-INT-PEN-COMP.                                     DTSCS31
02339                                                                   DTSCS31
02340  S101-INT-PEN-COMP.                                               DTSCS31
02341      EXEC CICS LINK                                               DTSCS31
02342          PROGRAM ('DTSCU101')                                     DTSCS31
02343          COMMAREA (L101-COMM-AREA)                                DTSCS31
02344      END-EXEC.                                                    DTSCS31
02345  S101-EXIT.                                                       DTSCS31
02346      EXIT.                                                        DTSCS31
02347                                                                   DTSCS31
02348  S109-SUR-TAX-QTR.                                                DTSCS31
02349        SET L109-CMND-PEN-INT-QTR-88  TO TRUE.                     DTSCS31
02350                                                                   DTSCS31
02351      EXEC CICS LINK                                               DTSCS31
02352          PROGRAM ('DTSCU109')                                     DTSCS31
02353          COMMAREA (L109-COMM-AREA)                                DTSCS31
02354      END-EXEC.                                                    DTSCS31
02355  S109-EXIT.                                                       DTSCS31
02356      EXIT.                                                        DTSCS31
02357                                                                   DTSCS31
02358  S410-FILING-SCHEDULE.                                            DTSCS31
02359      SET L410-MODE-INPUT-YRQ-88   TO TRUE.                        DTSCS31
02360      MOVE MPRF-EMP-NO             TO L410-EMP-NO.                 DTSCS31
02361      MOVE MQTR-YRQ                TO L410-YRQ.                    DTSCS31
02362                                                                   DTSCS31
02363      EXEC CICS LINK                                               DTSCS31
02364          PROGRAM ('DTSCU410')                                     DTSCS31
02365          COMMAREA (L410-COMM-AREA)                                DTSCS31
02366      END-EXEC.                                                    DTSCS31
02367                                                                   DTSCS31
02368  S410-EXIT.                                                       DTSCS31
02369      EXIT.                                                        DTSCS31
02370                                                                   DTSCS31
02371  S803-REQ-SCR-ID-EDIT.                                            DTSCS31
02372      EXEC CICS LINK                                               DTSCS31
02373          PROGRAM ('DTSCU803')                                     DTSCS31
02374          COMMAREA (DFHCOMMAREA)                                   DTSCS31
02375      END-EXEC.                                                    DTSCS31
02376  S803-EXIT.                                                       DTSCS31
02377      EXIT.                                                        DTSCS31
02378                                                                   DTSCS31
02379  S804-INVALID-KEY.                                                DTSCS31
02380      EXEC CICS LINK                                               DTSCS31
02381          PROGRAM ('DTSCU804')                                     DTSCS31
02382          COMMAREA (DFHCOMMAREA)                                   DTSCS31
02383      END-EXEC.                                                    DTSCS31
02384  S804-EXIT.                                                       DTSCS31
02385      EXIT.                                                        DTSCS31
02386                                                                   DTSCS31
02387  S805-MSG-AREA.                                                   DTSCS31
02388      MOVE LCCM-MSG-AREA TO L805-MSG-AREA                          DTSCS31
02389                                                                   DTSCS31
02390      EXEC CICS LINK                                               DTSCS31
02391          PROGRAM ('DTSCU805')                                     DTSCS31
02392          COMMAREA (L805-COMM-AREA)                                DTSCS31
02393      END-EXEC.                                                    DTSCS31
02394                                                                   DTSCS31
02395      MOVE L805-S-MSG-AREA TO MAP-MSG-AREA.                        DTSCS31
02396  S805-EXIT.                                                       DTSCS31
02397      EXIT.                                                        DTSCS31
02398      EJECT                                                        DTSCS31
02399                                                                   DTSCS31
02400  S810-COUNT.                                                      DTSCS31
02401      SET L810-COUNT-88 TO TRUE.                                   DTSCS31
02402      GO TO S810-IO.                                               DTSCS31
02403                                                                   DTSCS31
02404  S810-READ.                                                       DTSCS31
02405      SET L810-READ-88 TO TRUE.                                    DTSCS31
02406      GO TO S810-IO.                                               DTSCS31
02407                                                                   DTSCS31
02408  S810-START-BROWSE.                                               DTSCS31
02409      SET L810-START-BROWSE-88 TO TRUE.                            DTSCS31
02410      GO TO S810-IO.                                               DTSCS31
02411                                                                   DTSCS31
02412  S810-READ-NEXT.                                                  DTSCS31
02413      SET L810-READ-NEXT-88 TO TRUE.                               DTSCS31
02414      GO TO S810-IO.                                               DTSCS31
02415                                                                   DTSCS31
02416  S810-READ-PREV.                                                  DTSCS31
02417      SET L810-READ-PREV-88 TO TRUE.                               DTSCS31
02418      GO TO S810-IO.                                               DTSCS31
02419                                                                   DTSCS31
02420  S810-END-BROWSE.                                                 DTSCS31
02421      SET L810-END-BROWSE-88 TO TRUE.                              DTSCS31
02422      GO TO S810-IO.                                               DTSCS31
02423                                                                   DTSCS31
02424  S810-IO.                                                         DTSCS31
02425                                                                   DTSCS31
02426      EXEC CICS LINK                                               DTSCS31
02427          PROGRAM ('DTSCU810')                                     DTSCS31
02428          COMMAREA (L810-COMM-AREA)                                DTSCS31
02429      END-EXEC.                                                    DTSCS31
02430                                                                   DTSCS31
02431      IF L810-FILE-CLOSED-88                                       DTSCS31
02432          MOVE L810-MSG-AREA TO LCCM-MSG-AREA                      DTSCS31
02433          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS31
02434          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS31
02435          GO TO MAINLINE-EXIT.                                     DTSCS31
02436  S810-EXIT.                                                       DTSCS31
02437      EXIT.                                                        DTSCS31
02438      EJECT                                                        DTSCS31
02439  S851-SCREEN-PROCESSING.                                          DTSCS31
02440      EXEC CICS LINK                                               DTSCS31
02441          PROGRAM ('DTSCU851')                                     DTSCS31
02442          COMMAREA (L851-COMM-AREA)                                DTSCS31
02443      END-EXEC.                                                    DTSCS31
02444  S851-EXIT.                                                       DTSCS31
02445      EXIT.                                                        DTSCS31
02446                                                                   DTSCS31
02447  S899-ABEND.                                                      DTSCS31
02448      EXEC CICS ABEND                                              DTSCS31
02449          ABCODE(WRK-ABEND-CD)                                     DTSCS31
02450      END-EXEC.                                                    DTSCS31
02451  S899-EXIT.                                                       DTSCS31
02452      EXIT.                                                        DTSCS31
02453 /*****************************************************************DTSCS31
02454 *    EDIT THE INFORMATION ON THE SCREEN.                         *DTSCS31
02455 ******************************************************************DTSCS31
02456  S1100-EDIT-KEY.                                                  DTSCS31
02457      PERFORM S1101-EMP-NO              THRU S1101-EXIT.           DTSCS31
02458  S1100-EXIT. EXIT.                                                DTSCS31
02459 /*****************************************************************DTSCS31
02460 *                                                                 DTSCS31
02461 ******************************************************************DTSCS31
02462  S1101-EMP-NO.                                                    DTSCS31
02463      MOVE MAP-EMP-NO-AREA            TO L018-S-EMP-NO-AREA.       DTSCS31
02464      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS31
02465                                                                   DTSCS31
02466      IF L018-NO-ENTRY                                             DTSCS31
02467         MOVE EMSG-FIELD-REQUIRED     TO WRK-MSG-AREA              DTSCS31
02468         PERFORM S1199-ERROR          THRU S1199-EXIT              DTSCS31
02469         GO TO S1101-EXIT.                                         DTSCS31
02470                                                                   DTSCS31
02471      IF L018-NOT-VALID                                            DTSCS31
02472         MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA              DTSCS31
02473         PERFORM S1199-ERROR          THRU S1199-EXIT              DTSCS31
02474         GO TO S1101-EXIT.                                         DTSCS31
02475                                                                   DTSCS31
02476      MOVE L018-EMP-NO                TO WRK-EMP-NO.               DTSCS31
02477      PERFORM S1110-READ-MPRF THRU S1110-EXIT.                     DTSCS31
02478  S1101-EXIT. EXIT.                                                DTSCS31
02479                                                                   DTSCS31
02480  S1110-READ-MPRF.                                                 DTSCS31
02481      MOVE LOW-VALUES     TO MPRF-KEY-AREA.                        DTSCS31
02482      MOVE WRK-EMP-NO     TO MPRF-EMP-NO.                          DTSCS31
02483      SET MPRF-PRF-88     TO TRUE.                                 DTSCS31
02484      MOVE MPRF-KEY-AREA  TO MSKL-KEY-AREA.                        DTSCS31
02485      PERFORM S810-READ   THRU S810-EXIT.                          DTSCS31
02486      IF L810-NO-REC-88                                            DTSCS31
02487          MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA                    DTSCS31
02488          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS31
02489      ELSE                                                         DTSCS31
02490          MOVE MSKL-REC TO MPRF-REC                                DTSCS31
02491          SET WRK-MPRF-YES-88 TO TRUE.                             DTSCS31
02492  S1110-EXIT.                                                      DTSCS31
02493      EXIT.                                                        DTSCS31
02494                                                                   DTSCS31
02495  S1199-ERROR.                                                     DTSCS31
02496      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A            DTSCS31
02497                                         MAP-EMP-NO-2-A.           DTSCS31
02498      IF LCCM-NO-MSG                                               DTSCS31
02499         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS31
02500         MOVE CATB-CURSOR             TO MAP-EMP-NO-1-L            DTSCS31
02501         SET CURSOR-SET-YES TO TRUE.                               DTSCS31
02502  S1199-EXIT. EXIT.                                                DTSCS31
02503                                                                   DTSCS31
02504 /*****************************************************************DTSCS31
02505 *                                                                *DTSCS31
02506 ******************************************************************DTSCS31
02507  S1200-FROM-TO-YRQ.                                               DTSCS31
02508      SET WRK-SUPPRESS-ANN-RANGE-NO   TO TRUE.                     DTSCS31
02509      SET WRK-RANGE-NO                TO TRUE.                     DTSCS31
02510      SET WRK-FROM-NO-ENTRY           TO TRUE.                     DTSCS31
02511      SET WRK-TO-NO-ENTRY             TO TRUE.                     DTSCS31
02512                                                                   DTSCS31
02513      MOVE MAP-FROM-YRQ-AREA          TO L029-S-YRQ-AREA.          DTSCS31
02514      PERFORM S029-YRQ-WITH-PU-FROM-SCREEN THRU S029-EXIT.         DTSCS31
02515      IF L029-NOT-VALID                                            DTSCS31
02516         IF  MAP-FROM-YRQ-YR   = '00'                              DTSCS31
02517         AND MAP-FROM-YRQ-Q    = '0'                               DTSCS31
02518             SET WRK-RANGE-YES        TO TRUE                      DTSCS31
02519             MOVE LIT-ZERO-YRQ        TO WRK-FROM-YRQ              DTSCS31
02520         ELSE                                                      DTSCS31
02521            MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA           DTSCS31
02522            PERFORM S1201-ERROR          THRU S1201-EXIT           DTSCS31
02523      ELSE                                                         DTSCS31
02524      IF L029-NO-ENTRY                                             DTSCS31
02525         SET WRK-FROM-NO-ENTRY TO TRUE                             DTSCS31
02526      ELSE                                                         DTSCS31
02527         MOVE L029-YRQ                TO WRK-FROM-YRQ.             DTSCS31
02528                                                                   DTSCS31
02529      MOVE MAP-TO-YRQ-AREA            TO L029-S-YRQ-AREA.          DTSCS31
02530      PERFORM S029-YRQ-WITH-PU-FROM-SCREEN THRU S029-EXIT.         DTSCS31
02531      IF L029-NOT-VALID                                            DTSCS31
02532         IF  MAP-TO-YRQ-YR     = '99'                              DTSCS31
02533         AND MAP-TO-YRQ-Q      = '9'                               DTSCS31
02534             SET WRK-RANGE-YES        TO TRUE                      DTSCS31
02535             MOVE LIT-9-YRQ           TO WRK-TO-YRQ                DTSCS31
02536         ELSE                                                      DTSCS31
02537            MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA           DTSCS31
02538            PERFORM S1202-ERROR          THRU S1202-EXIT           DTSCS31
02539      ELSE                                                         DTSCS31
02540      IF L029-NO-ENTRY                                             DTSCS31
02541         SET WRK-TO-NO-ENTRY TO TRUE                               DTSCS31
02542      ELSE                                                         DTSCS31
02543         MOVE L029-YRQ                TO WRK-TO-YRQ.               DTSCS31
02544                                                                   DTSCS31
02545      IF LCCM-MSG                                                  DTSCS31
02546         GO TO S1200-EXIT.                                         DTSCS31
02547                                                                   DTSCS31
02548      IF WRK-FROM-NO-ENTRY                                         DTSCS31
02549      AND WRK-TO-NO-ENTRY                                          DTSCS31
02550         GO TO S1200-EXIT.                                         DTSCS31
02551                                                                   DTSCS31
02552      IF WRK-FROM-NO-ENTRY                                         DTSCS31
02553         MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                  DTSCS31
02554         PERFORM S1201-ERROR THRU S1201-EXIT                       DTSCS31
02555         GO TO S1200-EXIT.                                         DTSCS31
02556                                                                   DTSCS31
02557      IF WRK-TO-NO-ENTRY                                           DTSCS31
02558         GO TO S1200-EXIT.                                         DTSCS31
02559                                                                   DTSCS31
02560      IF WRK-TO-YRQ < WRK-FROM-YRQ                                 DTSCS31
02561         MOVE EMSG-CROSS-EDIT         TO WRK-MSG-AREA              DTSCS31
02562         PERFORM S1201-ERROR          THRU S1201-EXIT              DTSCS31
02563         PERFORM S1202-ERROR          THRU S1202-EXIT              DTSCS31
02564         GO TO S1200-EXIT.                                         DTSCS31
02565                                                                   DTSCS31
02566      IF WRK-TO-YRQ > WRK-FROM-YRQ                                 DTSCS31
02567         SET WRK-RANGE-YES        TO TRUE.                         DTSCS31
02568                                                                   DTSCS31
02569      IF WRK-TO-YRQ = WRK-FROM-YRQ                                 DTSCS31
02570         SET WRK-SUPPRESS-ANN-RANGE-YES TO TRUE.                   DTSCS31
02571                                                                   DTSCS31
02572  S1200-EXIT.                                                      DTSCS31
02573      EXIT.                                                        DTSCS31
02574                                                                   DTSCS31
02575  S1201-ERROR.                                                     DTSCS31
02576      MOVE CATB-UNPROT-NORM-AN-MDTON                               DTSCS31
02577        TO MAP-FROM-YRQ-YR-A                                       DTSCS31
02578           MAP-FROM-YRQ-Q-A.                                       DTSCS31
02579                                                                   DTSCS31
02580      IF LCCM-NO-MSG                                               DTSCS31
02581         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS31
02582         MOVE CATB-CURSOR             TO MAP-FROM-YRQ-YR-L         DTSCS31
02583         SET CURSOR-SET-YES TO TRUE.                               DTSCS31
02584  S1201-EXIT. EXIT.                                                DTSCS31
02585                                                                   DTSCS31
02586  S1202-ERROR.                                                     DTSCS31
02587      MOVE CATB-UNPROT-NORM-AN-MDTON                               DTSCS31
02588        TO MAP-TO-YRQ-YR-A                                         DTSCS31
02589           MAP-TO-YRQ-Q-A.                                         DTSCS31
02590                                                                   DTSCS31
02591      IF LCCM-NO-MSG                                               DTSCS31
02592         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS31
02593         MOVE CATB-CURSOR             TO MAP-TO-YRQ-YR-L           DTSCS31
02594         SET CURSOR-SET-YES TO TRUE.                               DTSCS31
02595  S1202-EXIT. EXIT.                                                DTSCS31
02596                                                                   DTSCS31
02597 /*****************************************************************DTSCS31
02598 *                                                                *DTSCS31
02599 ******************************************************************DTSCS31
02600  S1300-COMP-DATE.                                                 DTSCS31
02601      MOVE MAP-COMP-DATE-AREA TO L015-S-DATE-AREA.                 DTSCS31
02602      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS31
02603                                                                   DTSCS31
02604      IF MAP-COMP-MO = '99'                                        DTSCS31
02605      AND MAP-COMP-DA = '99'                                       DTSCS31
02606      AND MAP-COMP-YR = '99'                                       DTSCS31
02607          MOVE ALL-NINES-DATE TO LCCM-COMP-DATE                    DTSCS31
02608          GO TO S1300-EXIT.                                        DTSCS31
02609                                                                   DTSCS31
02610      IF L015-NO-ENTRY                                             DTSCS31
02611            MOVE LCCM-COMP-DATE TO WRK-DISPLAY                     DTSCS31
02612            MOVE WRK-DISPLAY-MO TO MAP-COMP-MO                     DTSCS31
02613            MOVE WRK-DISPLAY-DA TO MAP-COMP-DA                     DTSCS31
02614            MOVE WRK-DISPLAY-YR TO MAP-COMP-YR                     DTSCS31
02615      ELSE                                                         DTSCS31
02616      IF L015-NOT-VALID                                            DTSCS31
02617          MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA             DTSCS31
02618          PERFORM S1301-ERROR          THRU S1301-EXIT             DTSCS31
02619      ELSE                                                         DTSCS31
02620         MOVE L015-DATE TO LCCM-COMP-DATE.                         DTSCS31
02621  S1300-EXIT.                                                      DTSCS31
02622      EXIT.                                                        DTSCS31
02623  S1301-ERROR.                                                     DTSCS31
02624      MOVE CATB-UNPROT-NORM-NUM-MDTON                              DTSCS31
02625        TO MAP-COMP-MO-A                                           DTSCS31
02626           MAP-COMP-DA-A                                           DTSCS31
02627           MAP-COMP-YR-A.                                          DTSCS31
02628      IF LCCM-NO-MSG                                               DTSCS31
02629         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS31
02630         MOVE CATB-CURSOR             TO MAP-COMP-MO-L             DTSCS31
02631         SET CURSOR-SET-YES TO TRUE.                               DTSCS31
02632  S1301-EXIT. EXIT.                                                DTSCS31
02633                                                                   DTSCS31
02634 ******************************************************************DTSCS31
02635 *  SET ATTRIBUTE BYTES FOR INQUIRY STATUS                        *DTSCS31
02636 ******************************************************************DTSCS31
02637  S5300-SET-INQ-ATTRB.                                             DTSCS31
02638      MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN                     DTSCS31
02639                                    WRK-ATB-NUM.                   DTSCS31
02640                                                                   DTSCS31
02641      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS31
02642  S5300-EXIT.                                                      DTSCS31
02643      EXIT.                                                        DTSCS31
02644                                                                   DTSCS31
02645  S5900-SET-ATTRB.                                                 DTSCS31
02646      MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A             DTSCS31
02647                                        MAP-EMP-NO-2-A.            DTSCS31
02648                                                                   DTSCS31
02649      MOVE CATB-ASKIP-BRT-MDTOFF TO                                DTSCS31
02650              MAP-PRIMARY-NAME-A                                   DTSCS31
02651              MAP-CURR-PAGE-A                                      DTSCS31
02652              MAP-LAST-PAGE-A                                      DTSCS31
02653              MAP-WAIVE-INT-END-DATE-A                             DTSCS31
02654              MAP-WAIVE-INT-START-DATE-A                           DTSCS31
02655              MAP-WAIVE-PEN-END-DATE-A                             DTSCS31
02656              MAP-WAIVE-PEN-START-DATE-A                           DTSCS31
02657              MAP-ALD-INDS-A                                       DTSCS31
02658              MAP-BANKRUPTCY-OPEN-IND-A                            DTSCS31
02659              MAP-PICKUP-DUE-IND-A                                 DTSCS31
02660              MAP-CURR-RPT-TYPE-DSCR-A                             DTSCS31
02661              MAP-EMP-CLASS-DSCR-A                                 DTSCS31
02662              MAP-EMP-STATUS-DSCR-A                                DTSCS31
02663              MAP-EXCESS-WAGE-A                                    DTSCS31
02664              MAP-FLD-REP-ID-A                                     DTSCS31
02665              MAP-INT-END-DATE-1-A                                 DTSCS31
02666              MAP-INT-END-DATE-2-A                                 DTSCS31
02667              MAP-INT-RATE-1-A                                     DTSCS31
02668              MAP-INT-RATE-2-A                                     DTSCS31
02669              MAP-INT-START-DATE-1-A                               DTSCS31
02670              MAP-INT-START-DATE-2-A                               DTSCS31
02671              MAP-INTPEN-INDS-A                                    DTSCS31
02672              MAP-MISS-RPT-CUTOFF-CD-DSCR-A                        DTSCS31
02673              MAP-INT-MONTH-A                                      DTSCS31
02674              MAP-PURSUED-RPT-CNT-A                                DTSCS31
02675              MAP-QTR-ALD-A                                        DTSCS31
02676              MAP-SUBPOENA-CD-A                                    DTSCS31
02677              MAP-SUBPOENA-DATE-A                                  DTSCS31
02678              MAP-RECENT-SOL-A                                     DTSCS31
02679              MAP-RPT-DUE-DATE-A                                   DTSCS31
02680              MAP-SOL-CNT-A                                        DTSCS31
02681              MAP-WRITEOFF-DATE-A                                  DTSCS31
02682              MAP-TAX-DUE-DATE-A                                   DTSCS31
02683              MAP-TAX-WAGE-A                                       DTSCS31
02684              MAP-TOT-DUE-AMT-A                                    DTSCS31
02685              MAP-TOT-WAGE-A                                       DTSCS31
02686              MAP-UI-RATE-A                                        DTSCS31
02687              MAP-WAGE-RPT-A.                                      DTSCS31
02688                                                                   DTSCS31
02689      MOVE CATB-ASKIP-NORM-MDTOFF TO MAP-SUSP-TOL-COL-LIT-A.       DTSCS31
02690                                                                   DTSCS31
02691      MOVE CATB-UNPROT-BRT-AN-MDTON TO                             DTSCS31
02692              MAP-FROM-YRQ-YR-A                                    DTSCS31
02693              MAP-FROM-YRQ-Q-A                                     DTSCS31
02694              MAP-TO-YRQ-YR-A                                      DTSCS31
02695              MAP-TO-YRQ-Q-A.                                      DTSCS31
02696                                                                   DTSCS31
02697      MOVE CATB-UNPROT-BRT-NUM-MDTON TO                            DTSCS31
02698              MAP-COMP-DA-A                                        DTSCS31
02699              MAP-COMP-MO-A                                        DTSCS31
02700              MAP-COMP-YR-A.                                       DTSCS31
02701                                                                   DTSCS31
02702      PERFORM VARYING WRK-ROW FROM 1 BY 1                          DTSCS31
02703        UNTIL WRK-ROW > LIT-TOT-SUB                                DTSCS31
02704           MOVE SPACE TO MAP-LINE (WRK-ROW)                        DTSCS31
02705           MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-LINE-A (WRK-ROW)      DTSCS31
02706      END-PERFORM.                                                 DTSCS31
02707                                                                   DTSCS31
02708      MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A.                 DTSCS31
02709  S5900-EXIT.                                                      DTSCS31
02710      EXIT.                                                        DTSCS31
02711      EJECT                                                        DTSCS31
02712 /*****************************************************************DTSCS31
02713 * MAP ROUTINES                                                   *DTSCS31
02714 ******************************************************************DTSCS31
02715  S9100-RECEIVE.                                                   DTSCS31
02716      SET L851-RECEIVE-88 TO TRUE.                                 DTSCS31
02717                                                                   DTSCS31
02718      MOVE WRK-SCR-ID TO L851-SCR-ID.                              DTSCS31
02719                                                                   DTSCS31
02720      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS31
02721                                                                   DTSCS31
02722      MOVE L851-AID TO LCCM-AID.                                   DTSCS31
02723      MOVE L851-CURSOR TO LCCM-CURSOR.                             DTSCS31
02724  S9100-EXIT.                                                      DTSCS31
02725      EXIT.                                                        DTSCS31
02726                                                                   DTSCS31
02727  S9200-SEND-DATAONLY.                                             DTSCS31
02728      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS31
02729                                                                   DTSCS31
02730      IF LCCM-NO-MSG                                               DTSCS31
02731          NEXT SENTENCE                                            DTSCS31
02732      ELSE                                                         DTSCS31
02733          PERFORM S805-MSG-AREA THRU S805-EXIT.                    DTSCS31
02734                                                                   DTSCS31
02735      IF CURSOR-SET-GOTO                                           DTSCS31
02736          MOVE CATB-CURSOR TO MAP-GOTO-L                           DTSCS31
02737      ELSE                                                         DTSCS31
02738          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCS31
02739                                                                   DTSCS31
02740      SET L851-SEND-DATAONLY-88 TO TRUE.                           DTSCS31
02741                                                                   DTSCS31
02742      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS31
02743                                                                   DTSCS31
02744      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS31
02745  S9200-EXIT.                                                      DTSCS31
02746      EXIT.                                                        DTSCS31
02747                                                                   DTSCS31
02748  S9300-SEND-MAP.                                                  DTSCS31
02749      MOVE  LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE.             DTSCS31
02750      MOVE  LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME.             DTSCS31
02751      MOVE  LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME.         DTSCS31
02752                                                                   DTSCS31
02753      IF SCR-ACCESS-UPDATE                                         DTSCS31
02754          PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT               DTSCS31
02755      ELSE                                                         DTSCS31
02756          PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.             DTSCS31
02757                                                                   DTSCS31
02758      PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT.                   DTSCS31
02759                                                                   DTSCS31
02760      PERFORM S805-MSG-AREA THRU S805-EXIT.                        DTSCS31
02761                                                                   DTSCS31
02762      IF CURSOR-SET-NO                                             DTSCS31
02763          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCS31
02764                                                                   DTSCS31
02765      SET L851-SEND-88 TO TRUE.                                    DTSCS31
02766                                                                   DTSCS31
02767      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS31
02768                                                                   DTSCS31
02769      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS31
02770  S9300-EXIT.                                                      DTSCS31
02771      EXIT.                                                        DTSCS31
02772                                                                   DTSCS31
02773  S9310-UPDATE-FKEYS.                                              DTSCS31
02774      PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.                 DTSCS31
02775                                                                   DTSCS31
02776  S9310-EXIT.                                                      DTSCS31
02777      EXIT.                                                        DTSCS31
02778                                                                   DTSCS31
02779  S9320-INQUIRY-FKEYS.                                             DTSCS31
02780      MOVE 'F5=FRST'      TO MAP-KEY-FIRST.                        DTSCS31
02781      MOVE CFKD-LAST      TO MAP-KEY-LAST.                         DTSCS31
02782      MOVE CFKD-BACKWARD  TO MAP-KEY-BACK.                         DTSCS31
02783      MOVE CFKD-FORWARD   TO MAP-KEY-FWRD.                         DTSCS31
02784                                                                   DTSCS31
02785 *    PERFORM S9321-JUMP-KEYS THRU S9321-EXIT.                     DTSCS31
02786  S9320-EXIT.                                                      DTSCS31
02787      EXIT.                                                        DTSCS31
02788                                                                   DTSCS31
02789  S9321-JUMP-KEYS.                                                 DTSCS31
02790 *    MOVE 'F9=NOTE'     TO MAP-KEY-NOTE                           DTSCS31
02791 *    MOVE 'F10=RPT'     TO MAP-KEY-RPT-INQ                        DTSCS31
02792 *    MOVE 'F11=PAY'     TO MAP-KEY-PAY                            DTSCS31
02793 *    MOVE 'F12=ADJ'     TO MAP-KEY-ADJ                            DTSCS31
02794 *    MOVE CFKD-REG-INQ  TO MAP-KEY-REG-INQ                        DTSCS31
02795 *    MOVE CFKD-COLL-INQ TO MAP-KEY-COLL-INQ.                      DTSCS31
02796  S9321-EXIT.                                                      DTSCS31
02797      EXIT.                                                        DTSCS31
02798 *                                                                 DTSCS31
02799  S9330-DSCR-FIELDS.                                               DTSCS31
02800      IF WRK-MPRF-YES-88                                           DTSCS31
02801          MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME               DTSCS31
02802      ELSE                                                         DTSCS31
02803          MOVE LOW-VALUES TO MAP-PRIMARY-NAME.                     DTSCS31
02804                                                                   DTSCS31
02805      MOVE ' UI' TO MAP-LBL(LIT-UI-SUB).                           DTSCS31
02806      MOVE 'SUR' TO MAP-LBL(LIT-SUR-SUB).                          DTSCS31
02807      MOVE 'TAX' TO MAP-LBL(LIT-TAX-SUB).                          DTSCS31
02808      MOVE 'INT' TO MAP-LBL(LIT-INT-SUB).                          DTSCS31
02809      MOVE 'LPN' TO MAP-LBL(LIT-LATE-PEN-SUB).                     DTSCS31
02810      MOVE 'NPN' TO MAP-LBL(LIT-NSF-PEN-SUB).                      DTSCS31
02811      MOVE 'MPN' TO MAP-LBL(LIT-MISC-PEN-SUB).                     DTSCS31
02812      MOVE 'TOT' TO MAP-LBL(LIT-TOT-SUB).                          DTSCS31
02813                                                                   DTSCS31
02814  S9330-EXIT. EXIT.                                                DTSCS31
02815                                                                   DTSCS31
02816  S9900-PREPARE-SEND.                                              DTSCS31
02817      MOVE WRK-SCR-ID TO L851-SCR-ID                               DTSCS31
02818                         LCCM-SCR-ID.                              DTSCS31
02819      MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND.                    DTSCS31
02820      MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE.                         DTSCS31
02821  S9900-EXIT.                                                      DTSCS31
02822      EXIT.                                                        DTSCS31
