00001  IDENTIFICATION DIVISION.                                         10/17/24
00002  PROGRAM-ID.             DTSBE770.                                DTSBE770
00003  AUTHOR.                 TRW.                                        LV031
00004  DATE-WRITTEN.           DECEMBER 2002.                           DTSBE770
00005  DATE-COMPILED.                                                   DTSBE770
00006      SKIP3                                                        DTSBE770
00007 *****                                                             DTSBE770
00008 *                                                                 DTSBE770
00009 *    FUNCTION:  EXTRACT DATA FOR ETA581 DATA VALIDATION PROCESS.  DTSBE770
00010 *                                                                 DTSBE770
00011 *                                                                 DTSBE770
00012 *    MODIFICATION LOG:                                            DTSBE770
00013 *                                                                 DTSBE770
00014 *    10/25/2002  INITIAL DEVELOPMENT.                             DTSBE770
00015 *                REFERENCE: DATA VALIDATION     PROGRAMMER: GD    DTSBE770
00016 *                                                                 DTSBE770
00017 *    01/08/2003  PARAGRAPH P5000 COMPILES DATA ABOUT EMPLOYER     DTSBE770
00018 *                AUDITS FOR THE ETA581 REPORT AND WRITES DTSIY775 DTSBE770
00019 *                OUTPUT RECORDS FOR EACH AUDIT SELECTED.          DTSBE770
00020 *                REFERENCE:                     PROGRAMMER: RW1   DTSBE770
00021 *                                                                 DTSBE770
00022 *    05/27/2003  MODIFIED P1000 TO COMPLY WITH CHANGED            DTSBE770
00023 *                DEFINITIONS OF LIABILITY DATE AND REOPEN DATE    DTSBE770
00024 *                IN DOL DOCUMENTATION DATED 5/22/2003.            DTSBE770
00025 *                REFERENCE:                     PROGRAMMER: GD    DTSBE770
00026 *                                                                 DTSBE770
00027 *    05/13/2005  MODIFIED I2600 TO SET THE DELINQUENCY DATE       DTSBE770
00028 *                BASED ON QTR1 INSTEAD OF QTR2. IT SHOULD BE      DTSBE770
00029 *                THE DELINQUENCY DATE OF THE QUARTER PRIOR TO     DTSBE770
00030 *                THE SUBJECT QUARTER.                             DTSBE770
00031 *                REFERENCE: CORRECT ERROR       PROGRAMMER: GD    DTSBE770
00032 *                                                                 DTSBE770
00033 *    05/15/2008  MODIFIED P1000: EXIT IF NOT REPORTS FILED        DTSBE770
00034 *                DURING THE 8 QUARTER PERIOD.                     DTSBE770
00035 *                REFERENCE:                     PROGRAMMER: GD    DTSBE770
00036 *                                                                 DTSBE770
00037 *    05/16/2008  MODIFIED P3310: USE REACTIVATION ENTERED         DTSBE770
00038 *                DATE FOR THE ACTIVATION DATE FOR                 DTSBE770
00039 *                REACTIVATIONS.  USING THE ORIGINAL LIABILITY     DTSBE770
00040 *                ENTERED DATE PRODUCES ERROR IN THE DATA          DTSBE770
00041 *                VALIDATION SOFTWARE.                             DTSBE770
00042 *                SAME CHANGE MADE IN P3313 - INACT REVERSAL.      DTSBE770
00043 *                REFERENCE:                     PROGRAMMER: GD    DTSBE770
00044 *                                                                 DTSBE770
00045 *    05/19/2008  MODIFIED P1200 AND P1210 - DELINQUENT            DTSBE770
00046 *                QUARTERS SHOULD BE COUNTED AS LIABLE.            DTSBE770
00047 *                IF A QUARTER IS NOT LIABLE, RESET THE COUNT      DTSBE770
00048 *                OF LIABLE QUARTERS TO ZERO - ONLY                DTSBE770
00049 *                CONSECUTIVELY LIABLE QUARTERS SHOULD BE          DTSBE770
00050 *                COUNTED.                                         DTSBE770
00051 *                REFERENCE:                     PROGRAMMER: GD    DTSBE770
00052 *                                                                 DTSBE770
00053 *    05/20/2008  TEMPORARY CHANGE - FOR SUCCESSORS, USE           DTSBE770
00054 *                RELATIONSHIP EFF DATE AS ACTIVATION DATE.        DTSBE770
00055 *                REFERENCE:                     PROGRAMMER: GD    DTSBE770
00056 *                                                                 DTSBE770
00057 *    07/11/2008  CORRECTION FOR AUDIT COUNTS: REMOVED CHECK       DTSBE770
00058 *                OF MPRF-MFAS-IND. A VALUE OF 'N' DOES NOT        DTSBE770
00059 *                MEAN THERE IS NO AUDIT ASSIGNMENT.               DTSBE770
00060 *                REFERENCE:                     PROGRAMMER: GD    DTSBE770
00061 *                                                                 DTSBE770
00062 *    01/16/2008  CORRECTION FOR ITEM 12 - COUNT OF OUTSTANDING    DTSBE770
00063 *                QTRS. ESTIMATED QTRS SHOULD BE EXCLUDED          DTSBE770
00064 *                EXCEPT FOR THE QTR PRIOR TO THE SUBJECT QTR.     DTSBE770
00065 *                P9000.                                           DTSBE770
00066 *                REFERENCE:                     PROGRAMMER: GD    DTSBE770
00067 *                                                                 DTSBE770
00068 *    03/31/2009  ADDED PROCESSING FOR TPS STATUS DATA. THIS       DTSBE770
00069 *                DATA WAS FORMERLY GENERATED BY DTSBE715.         DTSBE770
00070 *                THE EXTRACT WAS MOVED TO THE ETA-581/DATA        DTSBE770
00071 *                VALIDATIONPROCESS TO ENSURE CONSISTENCY          DTSBE770
00072 *                WITH THE ETA-581 DATA.                           DTSBE770
00073 *                DTSBE770 WAS MODIFIED BY ADDING A NEW OUTPUT     DTSBE770
00074 *                FILE (TPS-STATUS-FILE), A NEW OUTPUT RECORD      DTSBE770
00075 *                (TPS-TRANS-REC), AND ADDITIONAL PROCESSING       DTSBE770
00076 *                ADDED TO P3900 TO WRITE THE TPS RECORDS.         DTSBE770
00077 *                A NEW PROGRAM, DTSBX777, PRODUCES THE            DTSBE770
00078 *                TPS REPORTS.                                     DTSBE770
00079 *                REFERENCE:                     PROGRAMMER: GD    DTSBE770
00080 *                                                                 DTSBE770
00081 *    05/01/2009  MODIFIED PROCESS FOR STATUS COUNTS (P3000).      DTSBE770
00082 *                TIME LAPSE CALCULATION WAS INCORRECT FOR         DTSBE770
00083 *                REACTIVATIONS - CHANGED TO USE REOPEN DATE.      DTSBE770
00084 *                REFERENCE:                     PROGRAMMER: GD    DTSBE770
00085 *                                                                 DTSBE770
00086 *    01/26/2010  BASED ON CLARIFICATION FROM DOL, REVERSAL        DTSBE770
00087 *                OF AN INACTIVATION IS NOT COUNTED AS             DTSBE770
00088 *                A DETERMINATION.                                 DTSBE770
00089 *                REFERENCE:                     PROGRAMMER: GD    DTSBE770
00090 *                                                                 DTSBE770
00091 *    10/01/2010  ADDED CALL TO DTSBU430 TO RETURN COUNT OF        DTSBE770
00092 *                WAGE ITEMS (ITEM 5 ON ETA 581).                  DTSBE770
00093 *                REFERENCE:                     PROGRAMMER: GD    DTSBE770
00094 *                                                                 DTSBE770
00095 *    01/12/2011  REINSERTED PROCESS TO DEFAULT ANNUAL REPORTS.    DTSBE770
00096 *                REFERENCE:                     PROGRAMMER: GD    DTSBE770
00097 *                                                                 DTSBE770
00098 *    02/11/2011  VARIOUS CHANGES TO POPULATION 2 TO CORRECT       DTSBE770
00099 *                ERRORS IN COUNTING ANNUAL FILERS. ANNUAL         DTSBE770
00100 *                COUNTS WILL NOW BE DEFAULTED FOR EVERY QUARTER.  DTSBE770
00101 *                THE DELINQUENCY RATE IS SO HIGH THE ACTUAL COUNT DTSBE770
00102 *                RESULTS IN CROSS EDIT FAILURES IN THE SUN SYSTEM.DTSBE770
00103 *                REFERENCE:                     PROGRAMMER: GD    DTSBE770
00104 *                                                                 DTSBE770
00105 *    04/15/2013  ADDED CODE TO P9100 TO EXTRACT SUTA DUMPING      DTSBE770
00106 *                NUMBERS.                                         DTSBE770
00107 *                REFERENCE: TICKET 1780         PROGRAMMER: GD    DTSBE770
00108 *                                                                 DTSBE770
00109 *    10/04/2013  CORRECTED P9120 TO SEARCH FOR UI TAX CHARGES     DTSBE770
00110 *                STARTING WITH THE EARLIEST DATE ON WHICH         DTSBE770
00111 *                A RATE WAS CHANGED.                              DTSBE770
00112 *                REFERENCE: TICKET 2095         PROGRAMMER: GD    DTSBE770
00113 *                                                                 DTSBE770
00114 *    10/23/2013  CREATED A SINGLE PROCESS FOR PRODUCING THE       DTSBE770
00115 *                DEFAULT COUNT OF ANNUAL REPORTS. THE             DTSBE770
00116 *                PARAGRAPHS THAT PRODUCED NUMBERS FOR THE         DTSBE770
00117 *                581 AND FOR DATA VALIDATION WERE SLIGHTLY        DTSBE770
00118 *                DIFFERENT, AND PRODUCED DIFFERENT RESULTS.       DTSBE770
00119 *                REFERENCE: TICKET 9999         PROGRAMMER: GD    DTSBE770
00120 *                                                                 DTSBE770
00121 *    06/11/2014  MODIFYING THE CALCULATION FOR PRE AND POST       DTSBE770
00122 *                AMOUNTS - PRIOR PROCESS MOVED ZERO WHEN THE      DTSBE770
00123 *                PRE AND POST AMOUNTS WERE THE SAME  SHOULD BE    DTSBE770
00124 *                MOVING THE ORIGINAL AMOUNTS INSTEAD              DTSBE770
00125 *                REFERENCE: TICKET 9999         PROGRAMMER: NH    DTSBE770
00126 *                                                                 DTSBE770
00127 *    10/16/2024  MODIFYING CODE TO ADD NEW EMPLOYEE CNT TO           CL*30
00128 *                MISCLASIFIED WORKES ON ITEM52 ON ETA581             CL*30
00129 *                REFERENCE: TICKET 9999         PROGRAMMER: ZL1      CL*30
00130 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBE770
00131 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBE770
00132 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBE770
00133 *                                                                 DTSBE770
00134 *  DESCRIPTION:                                                   DTSBE770
00135 *                                                                 DTSBE770
00136 *                                                                 DTSBE770
00137 *    INITIATION:                                                  DTSBE770
00138 *                                                                 DTSBE770
00139 *      SET LECM-MST-OPEN-READ-88 TO TRUE.                         DTSBE770
00140 *      SET LECM-REF-OPEN-READ-88 TO TRUE.                         DTSBE770
00141 *                                                                 DTSBE770
00142 *      EDIT AND DEFAULT PARAMETERS.                               DTSBE770
00143 *                                                                 DTSBE770
00144 *                                                                 DTSBE770
00145 *    PROCESSING:                                                  DTSBE770
00146 *                                                                 DTSBE770
00147 *      SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (DTSIX771)     DTSBE770
00148 *                                                                 DTSBE770
00149 *                                                                 DTSBE770
00150 *    TERMINATION:                                                 DTSBE770
00151 *                                                                 DTSBE770
00152 *                                                                 DTSBE770
00153 *                                                                 DTSBE770
00154 *    RECORDS READ:                                                DTSBE770
00155 *                                                                 DTSBE770
00156 *      MASTER:                                                    DTSBE770
00157 *                                                                 DTSBE770
00158 *        MSOL                                                     DTSBE770
00159 *        MQTR                                                     DTSBE770
00160 *                                                                 DTSBE770
00161 *                                                                 DTSBE770
00162 *      ALTERNATE INDEX:                                           DTSBE770
00163 *                                                                 DTSBE770
00164 *        NONE.                                                    DTSBE770
00165 *                                                                 DTSBE770
00166 *                                                                 DTSBE770
00167 *      REFERENCE:                                                 DTSBE770
00168 *                                                                 DTSBE770
00169 *                                                                 DTSBE770
00170 *                                                                 DTSBE770
00171 *    RECORDS UPDATED:                                             DTSBE770
00172 *                                                                 DTSBE770
00173 *        NONE                                                     DTSBE770
00174 *                                                                 DTSBE770
00175 *                                                                 DTSBE770
00176 *    OUTPUT RECORDS WRITTEN:                                      DTSBE770
00177 *                                                                 DTSBE770
00178 *        DTSIX771 POPULATION 1 DOWNLOAD                           DTSBE770
00179 *                                                                 DTSBE770
00180 *                                                                 DTSBE770
00181 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBE770
00182 *                                                                 DTSBE770
00183 *        NONE.                                                    DTSBE770
00184 *                                                                 DTSBE770
00185 *                                                                 DTSBE770
00186 *    MODULES CALLED:                                              DTSBE770
00187 *                                                                 DTSBE770
00188 *        DTSBU001  DATE EDIT/CONVERSION.                          DTSBE770
00189 *        DTSBU004  QUARTER EDIT/CONVERSION.                       DTSBE770
00190 *        DTSBU910  MASTER FILE I/O.                               DTSBE770
00191 *                                                                 DTSBE770
00192 *                                                                 DTSBE770
00193 *                                                                 DTSBE770
00194 *****                                                             DTSBE770
00195      SKIP3                                                        DTSBE770
00196  ENVIRONMENT DIVISION.                                            DTSBE770
00197  INPUT-OUTPUT SECTION.                                            DTSBE770
00198  FILE-CONTROL.                                                    DTSBE770
00199      SELECT ETA581-PARM-FILE  ASSIGN TO BE770PRM                  DTSBE770
00200         FILE STATUS IS BE770-STATUS.                              DTSBE770
00201                                                                   DTSBE770
00202      SELECT TPS-STATUS-QTR1        ASSIGN TO TPSSTAT1             DTSBE770
00203         FILE STATUS IS TPS-STAT-STATUS.                           DTSBE770
00204                                                                   DTSBE770
00205      SELECT TPS-STATUS-QTR2        ASSIGN TO TPSSTAT2             DTSBE770
00206         FILE STATUS IS TPS-STAT-STATUS.                           DTSBE770
00207                                                                   DTSBE770
00208      SELECT TPS-STATUS-QTR3        ASSIGN TO TPSSTAT3             DTSBE770
00209         FILE STATUS IS TPS-STAT-STATUS.                           DTSBE770
00210                                                                   DTSBE770
00211      SELECT TPS-STATUS-QTR4        ASSIGN TO TPSSTAT4             DTSBE770
00212         FILE STATUS IS TPS-STAT-STATUS.                           DTSBE770
00213                                                                   DTSBE770
00214  DATA DIVISION.                                                   DTSBE770
00215  FILE SECTION.                                                    DTSBE770
00216  FD  ETA581-PARM-FILE                                             DTSBE770
00217      RECORDING MODE IS F                                          DTSBE770
00218      LABEL RECORDS ARE STANDARD                                   DTSBE770
00219      BLOCK CONTAINS 0 CHARACTERS.                                 DTSBE770
00220                                                                   DTSBE770
00221  01  ETA581-PARM-REC.                                             DTSBE770
00222  ++INCLUDE DTSIX770                                               DTSBE770
00223                                                                   DTSBE770
00224  FD  TPS-STATUS-QTR1                                              DTSBE770
00225      RECORDING MODE IS F                                          DTSBE770
00226      LABEL RECORDS ARE STANDARD                                   DTSBE770
00227      BLOCK CONTAINS 0 CHARACTERS.                                 DTSBE770
00228                                                                   DTSBE770
00229  01  TPS-STATUS-QTR1-REC                   PIC X(56).             DTSBE770
00230                                                                   DTSBE770
00231  FD  TPS-STATUS-QTR2                                              DTSBE770
00232      RECORDING MODE IS F                                          DTSBE770
00233      LABEL RECORDS ARE STANDARD                                   DTSBE770
00234      BLOCK CONTAINS 0 CHARACTERS.                                 DTSBE770
00235                                                                   DTSBE770
00236  01  TPS-STATUS-QTR2-REC                   PIC X(56).             DTSBE770
00237                                                                   DTSBE770
00238  FD  TPS-STATUS-QTR3                                              DTSBE770
00239      RECORDING MODE IS F                                          DTSBE770
00240      LABEL RECORDS ARE STANDARD                                   DTSBE770
00241      BLOCK CONTAINS 0 CHARACTERS.                                 DTSBE770
00242                                                                   DTSBE770
00243  01  TPS-STATUS-QTR3-REC                   PIC X(56).             DTSBE770
00244                                                                   DTSBE770
00245  FD  TPS-STATUS-QTR4                                              DTSBE770
00246      RECORDING MODE IS F                                          DTSBE770
00247      LABEL RECORDS ARE STANDARD                                   DTSBE770
00248      BLOCK CONTAINS 0 CHARACTERS.                                 DTSBE770
00249                                                                   DTSBE770
00250  01  TPS-STATUS-QTR4-REC                   PIC X(56).             DTSBE770
00251                                                                   DTSBE770
00252  WORKING-STORAGE SECTION.                                         DTSBE770
002525 77  PAN-VALET PICTURE X(24) VALUE '031DTSBE770  10/17/24'.       DTSBE770
00253  77  PAN-VALET PICTURE X(24) VALUE '012DTSBE770  07/28/14'.       DTSBE770
00254  77  PAN-VALET PICTURE X(24) VALUE '026DTSBE770  04/10/14'.       DTSBE770
00255  77  PAN-VALET PICTURE X(24) VALUE '009DTSBE770  04/06/14'.       DTSBE770
00256  77  PAN-VALET PICTURE X(24) VALUE '024DTSBE770  12/02/13'.       DTSBE770
00257  77  PAN-VALET PICTURE X(24) VALUE '004DTSBE770  10/28/13'.       DTSBE770
00258  77  PAN-VALET PICTURE X(24) VALUE '022DTSBE770  10/08/13'.       DTSBE770
00259  77  PAN-VALET PICTURE X(24) VALUE '008DTSBE770  10/04/13'.       DTSBE770
00260  77  PAN-VALET PICTURE X(24) VALUE '020DTSBE770  06/19/13'.       DTSBE770
00261  77  PAN-VALET PICTURE X(24) VALUE '013DTSBE770  05/17/13'.       DTSBE770
00262      SKIP3                                                        DTSBE770
00263  01  WRK-AREA.                                                    DTSBE770
00264      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +770.DTSBE770
00265                                                                   DTSBE770
00266      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBE770'.DTSBE770
00267                                                                   DTSBE770
00268      05  ABEND-MSG                   PIC  X(60).                  DTSBE770
00269                                                                   DTSBE770
00270      05  BE770-STATUS                PIC  X(02).                  DTSBE770
00271          88  BE770-STATUS-OK-88       VALUE '00'.                 DTSBE770
00272      05  TPS-STAT-STATUS             PIC  X(02).                  DTSBE770
00273          88  TPS-STAT-STATUS-OK-88    VALUE '00'.                 DTSBE770
00274                                                                   DTSBE770
00275      05  WRK-0-WAGE-CNT             PIC S9(07)  COMP-3 VALUE +0.  DTSBE770
00276      05  WRK-NOT-LIAB-CNT           PIC S9(07)  COMP-3 VALUE +0.  DTSBE770
00277      05  WRK-DELINQ-CNT             PIC S9(07)  COMP-3 VALUE +0.  DTSBE770
00278      05  WRK-ACT-CNT                PIC S9(07)  COMP-3 VALUE +0.  DTSBE770
00279      05  WRK-TOT-RPT-RCVD-CNT       PIC S9(07)  COMP-3 VALUE +0.  DTSBE770
00280                                                                   DTSBE770
00281      05  WRK-SUBJECT-QTR             PIC S9(05)  COMP-3 VALUE +0. DTSBE770
00282      05  WRK-RPT-QTR                 PIC  9(05)  VALUE ZERO.      DTSBE770
00283      05  FILLER REDEFINES WRK-RPT-QTR.                            DTSBE770
00284          10  WRK-RPT-QTR-CCYY        PIC  9(04).                  DTSBE770
00285          10  WRK-RPT-QTR-Q           PIC  9(01).                  DTSBE770
00286      05  WRK-SUBJECT-QTR-START       PIC S9(09)  COMP-3 VALUE +0. DTSBE770
00287      05  WRK-SUBJECT-QTR-END         PIC S9(09)  COMP-3 VALUE +0. DTSBE770
00288      05  WRK-QTR                     PIC S9(05)  COMP-3 VALUE +0. DTSBE770
00289      05  WRK-QTR-START               PIC S9(09)  COMP-3 VALUE +0. DTSBE770
00290      05  WRK-QTR-END                 PIC S9(09)  COMP-3 VALUE +0. DTSBE770
00291      05  WRK-ANN-START               PIC S9(09)  COMP-3 VALUE +0. DTSBE770
00292      05  WRK-ANN-END                 PIC S9(09)  COMP-3 VALUE +0. DTSBE770
00293      05  WRK-ANN-DUE-DATE            PIC S9(09)  COMP-3 VALUE +0. DTSBE770
00294      05  WRK-FIRST-ANN-QTR           PIC S9(05)  COMP-3 VALUE +0. DTSBE770
00295      05  WRK-LAST-ANN-QTR            PIC S9(05)  COMP-3 VALUE +0. DTSBE770
00296      05  WRK-MRPT-QTR                PIC S9(05)  COMP-3 VALUE +0. DTSBE770
00297      05  WRK-ANN-TIMELY-DATE         PIC S9(09)  COMP-3 VALUE +0. DTSBE770
00298      05  WRK-ANN-SECURED-DATE        PIC S9(09)  COMP-3 VALUE +0. DTSBE770
00299                                                                   DTSBE770
00300      05  WRK-PARM-TIMING-EDITS-IND   PIC  X(01).                  DTSBE770
00301          88  WRK-PARM-TIMING-EDITS-YES-88   VALUE 'Y'.            DTSBE770
00302          88  WRK-PARM-TIMING-EDITS-NO-88    VALUE 'N'.            DTSBE770
00303                                                                   DTSBE770
00304      SKIP3                                                        DTSBE770
00305      05  WRK-QTR1                   PIC S9(05)  COMP-3 VALUE +0.  DTSBE770
00306      05  WRK-QTR1-START             PIC S9(09)  COMP-3 VALUE +0.  DTSBE770
00307      05  WRK-QTR1-END               PIC S9(09)  COMP-3 VALUE +0.  DTSBE770
00308      05  WRK-QTR1-DUE-DATE          PIC S9(09)  COMP-3 VALUE +0.  DTSBE770
00309      05  WRK-QTR1-ANN-TIMELY        PIC S9(09)  COMP-3 VALUE +0.  DTSBE770
00310      05  WRK-QTR1-ANN-SECURED       PIC S9(09)  COMP-3 VALUE +0.  DTSBE770
00311      05  WRK-QTR2                   PIC S9(05)  COMP-3 VALUE +0.  DTSBE770
00312      05  WRK-QTR2-START             PIC S9(09)  COMP-3 VALUE +0.  DTSBE770
00313      05  WRK-QTR2-END               PIC S9(09)  COMP-3 VALUE +0.  DTSBE770
00314      05  WRK-QTR2-DUE-DATE          PIC S9(09)  COMP-3 VALUE +0.  DTSBE770
00315      05  WRK-QTR2-ANN-TIMELY        PIC S9(09)  COMP-3 VALUE +0.  DTSBE770
00316      05  WRK-QTR2-ANN-SECURED       PIC S9(09)  COMP-3 VALUE +0.  DTSBE770
00317      05  WRK-QTR3                   PIC S9(05)  COMP-3 VALUE +0.  DTSBE770
00318      05  WRK-QTR3-START             PIC S9(09)  COMP-3 VALUE +0.  DTSBE770
00319      05  WRK-QTR3-END               PIC S9(09)  COMP-3 VALUE +0.  DTSBE770
00320      05  WRK-QTR4                   PIC S9(05)  COMP-3 VALUE +0.  DTSBE770
00321      05  WRK-QTR5                   PIC S9(05)  COMP-3 VALUE +0.  DTSBE770
00322      05  WRK-QTR6                   PIC S9(05)  COMP-3 VALUE +0.  DTSBE770
00323      05  WRK-QTR7                   PIC S9(05)  COMP-3 VALUE +0.  DTSBE770
00324      05  WRK-QTR8                   PIC S9(05)  COMP-3 VALUE +0.  DTSBE770
00325                                                                   DTSBE770
00326      05  WRK-SELECT-IND              PIC  X(01).                  DTSBE770
00327          88  WRK-SELECT-NO-88               VALUE '0'.            DTSBE770
00328          88  WRK-SELECT-RCVD-88             VALUE '1'.            DTSBE770
00329          88  WRK-SELECT-ESTIM-88            VALUE '2'.            DTSBE770
00330          88  WRK-SELECT-MISSING-88          VALUE '3'.            DTSBE770
00331          88  WRK-SELECT-INACT-CHNG-88       VALUE '4'.            DTSBE770
00332          88  WRK-SELECT-LIAB-CHNG-88        VALUE '5'.            DTSBE770
00333          88  WRK-SELECT-WITHDRAW-88         VALUE '6'.            DTSBE770
00334          88  WRK-SELECT-581-ONLY-88         VALUE '7'.            DTSBE770
00335                                                                   DTSBE770
00336      05  WRK-ANN-RPT-RCVD-IND        PIC  X(01).                  DTSBE770
00337          88  WRK-ANN-RPT-RCVD-YES-88        VALUE 'Y'.            DTSBE770
00338          88  WRK-ANN-RPT-RCVD-NO-88         VALUE 'N'.            DTSBE770
00339                                                                   DTSBE770
00340      05  WRK-ANN-RPT-ESTIM-IND        PIC  X(01).                 DTSBE770
00341          88  WRK-ANN-RPT-ESTIM-YES-88        VALUE 'Y'.           DTSBE770
00342          88  WRK-ANN-RPT-ESTIM-NO-88         VALUE 'N'.           DTSBE770
00343                                                                   DTSBE770
00344      05  WRK-ANN-RPT-MISSING-IND      PIC  X(01).                 DTSBE770
00345          88  WRK-ANN-RPT-MISSING-YES-88      VALUE 'Y'.           DTSBE770
00346          88  WRK-ANN-RPT-MISSING-NO-88       VALUE 'N'.           DTSBE770
00347                                                                   DTSBE770
00348      05  WRK-ANN-RESOLVED-IND         PIC  X(01).                 DTSBE770
00349          88  WRK-ANN-RESOLVED-YES-88         VALUE 'Y'.           DTSBE770
00350          88  WRK-ANN-RESOLVED-NO-88          VALUE 'N'.           DTSBE770
00351                                                                   DTSBE770
00352      05  WRK-ANN-DEFAULT-IND          PIC  X(01).                 DTSBE770
00353          88  WRK-ANN-DEFAULT-YES-88          VALUE 'Y'.           DTSBE770
00354          88  WRK-ANN-DEFAULT-NO-88           VALUE 'N'.           DTSBE770
00355                                                                   DTSBE770
00356      05  WRK-ORIG-RPT-RCVD-DATE     PIC S9(09)  COMP-3 VALUE +0.  DTSBE770
00357      05  WRK-ORIG-RPT-ESTB-DATE     PIC S9(09)  COMP-3 VALUE +0.  DTSBE770
00358      05  WRK-ORIG-RPT-CHNG-DATE     PIC S9(09)  COMP-3 VALUE +0.  DTSBE770
00359      05  WRK-ESTIM-RPT-RCVD-DATE    PIC S9(09)  COMP-3 VALUE +0.  DTSBE770
00360      05  WRK-P2310-LIAB-DATE        PIC S9(09)  COMP-3.           DTSBE770
00361      05  WRK-P2411-LIAB-DATE        PIC S9(09)  COMP-3.           DTSBE770
00362      05  WRK-P2411-INACT-DATE       PIC S9(09)  COMP-3.           DTSBE770
00363      05  WRK-P2411-INACT-ENTER-DATE PIC S9(09)  COMP-3.           DTSBE770
00364      05  WRK-P2412-LIAB-DATE        PIC S9(09)  COMP-3.           DTSBE770
00365      05  WRK-P2412-INACT-DATE       PIC S9(09)  COMP-3.           DTSBE770
00366      05  WRK-P2412-INACT-ENTER-DATE PIC S9(09)  COMP-3.           DTSBE770
00367      05  WRK-P2413-LIAB-DATE        PIC S9(09)  COMP-3.           DTSBE770
00368      05  WRK-DELINQUENT-DATE        PIC S9(09)  COMP-3.           DTSBE770
00369      05  WRK-QTR-DELINQUENT-DATE    PIC S9(09)  COMP-3.           DTSBE770
00370      05  WRK-ANN-DELINQUENT-DATE    PIC S9(09)  COMP-3.           DTSBE770
00371      05  WRK-MSOL-LIAB-CHNG-IND      PIC  X(01).                  DTSBE770
00372          88  WRK-MSOL-LIAB-CHNG-YES-88      VALUE 'Y'.            DTSBE770
00373          88  WRK-MSOL-LIAB-CHNG-NO-88       VALUE 'N'.            DTSBE770
00374      05  WRK-MSOL-INACT-CHNG-IND      PIC  X(01).                 DTSBE770
00375          88  WRK-MSOL-INACT-CHNG-YES-88     VALUE 'Y'.            DTSBE770
00376          88  WRK-MSOL-INACT-CHNG-NO-88      VALUE 'N'.            DTSBE770
00377      05  WRK-MSOL-WITHDRAWN-IND      PIC  X(01).                  DTSBE770
00378          88  WRK-MSOL-WITHDRAWN-YES-88      VALUE 'Y'.            DTSBE770
00379          88  WRK-MSOL-WITHDRAWN-NO-88       VALUE 'N'.            DTSBE770
00380                                                                   DTSBE770
00381 **   05  WRK-SCAN-COMPLETE-IND       PIC  X(01).                  DTSBE770
00382 **       88  WRK-SCAN-COMPLETE-YES-88       VALUE 'Y'.            DTSBE770
00383 **       88  WRK-SCAN-COMPLETE-NO-88        VALUE 'N'.            DTSBE770
00384      05  WRK-QTR-WAGE-TOT        PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00385      05  WGE-SUB                    PIC S9(04)  COMP.             DTSBE770
00386      05  WRK-QTR-WAGES.                                           DTSBE770
00387          10  WRK-QTR1-WAGES      PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00388          10  WRK-QTR1-STATUS     PIC  X(01).                      DTSBE770
00389              88  WRK-QTR1-RCVD-88      VALUE '0'.                 DTSBE770
00390              88  WRK-QTR1-NOT-LIAB-88  VALUE '1'.                 DTSBE770
00391              88  WRK-QTR1-DELINQ-88    VALUE '2'.                 DTSBE770
00392          10  WRK-QTR2-WAGES      PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00393          10  WRK-QTR2-STATUS     PIC  X(01).                      DTSBE770
00394              88  WRK-QTR2-RCVD-88      VALUE '0'.                 DTSBE770
00395              88  WRK-QTR2-NOT-LIAB-88  VALUE '1'.                 DTSBE770
00396              88  WRK-QTR2-DELINQ-88    VALUE '2'.                 DTSBE770
00397          10  WRK-QTR3-WAGES      PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00398          10  WRK-QTR3-STATUS     PIC  X(01).                      DTSBE770
00399              88  WRK-QTR3-RCVD-88      VALUE '0'.                 DTSBE770
00400              88  WRK-QTR3-NOT-LIAB-88  VALUE '1'.                 DTSBE770
00401              88  WRK-QTR3-DELINQ-88    VALUE '2'.                 DTSBE770
00402          10  WRK-QTR4-WAGES      PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00403          10  WRK-QTR4-STATUS     PIC  X(01).                      DTSBE770
00404              88  WRK-QTR4-RCVD-88      VALUE '0'.                 DTSBE770
00405              88  WRK-QTR4-NOT-LIAB-88  VALUE '1'.                 DTSBE770
00406              88  WRK-QTR4-DELINQ-88    VALUE '2'.                 DTSBE770
00407          10  WRK-QTR5-WAGES      PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00408          10  WRK-QTR5-STATUS     PIC  X(01).                      DTSBE770
00409              88  WRK-QTR5-RCVD-88      VALUE '0'.                 DTSBE770
00410              88  WRK-QTR5-NOT-LIAB-88  VALUE '1'.                 DTSBE770
00411              88  WRK-QTR5-DELINQ-88    VALUE '2'.                 DTSBE770
00412          10  WRK-QTR6-WAGES      PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00413          10  WRK-QTR6-STATUS     PIC  X(01).                      DTSBE770
00414              88  WRK-QTR6-RCVD-88      VALUE '0'.                 DTSBE770
00415              88  WRK-QTR6-NOT-LIAB-88  VALUE '1'.                 DTSBE770
00416              88  WRK-QTR6-DELINQ-88    VALUE '2'.                 DTSBE770
00417          10  WRK-QTR7-WAGES      PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00418          10  WRK-QTR7-STATUS     PIC  X(01).                      DTSBE770
00419              88  WRK-QTR7-RCVD-88      VALUE '0'.                 DTSBE770
00420              88  WRK-QTR7-NOT-LIAB-88  VALUE '1'.                 DTSBE770
00421              88  WRK-QTR7-DELINQ-88    VALUE '2'.                 DTSBE770
00422          10  WRK-QTR8-WAGES      PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00423          10  WRK-QTR8-STATUS     PIC  X(01).                      DTSBE770
00424              88  WRK-QTR8-RCVD-88      VALUE '0'.                 DTSBE770
00425              88  WRK-QTR8-NOT-LIAB-88  VALUE '1'.                 DTSBE770
00426              88  WRK-QTR8-DELINQ-88    VALUE '2'.                 DTSBE770
00427      05  FILLER REDEFINES WRK-QTR-WAGES.                          DTSBE770
00428          10  WRK-QTR-ENTRY OCCURS 8 TIMES.                        DTSBE770
00429              15  WRK-QTR-WAGE-AMT   PIC S9(11)V99  COMP-3.        DTSBE770
00430              15  WRK-QTR-STATUS     PIC  X(01).                   DTSBE770
00431                  88  WRK-QTR-RCVD-88      VALUE '0'.              DTSBE770
00432                  88  WRK-QTR-NOT-LIAB-88  VALUE '1'.              DTSBE770
00433                  88  WRK-QTR-DELINQ-88    VALUE '2'.              DTSBE770
00434                                                                   DTSBE770
00435      05  WRK-PRE-AUDIT-TOT-WAGE  PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00436      05  WRK-POST-AUDIT-TOT-WAGE PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00437      05  WRK-OVER-RPT-TOT-WAGE   PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00438      05  WRK-UNDER-RPT-TOT-WAGE  PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00439      05  WRK-PRE-AUDIT-TAX-WAGE  PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00440      05  WRK-POST-AUDIT-TAX-WAGE PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00441      05  WRK-OVER-RPT-TAX-WAGE   PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00442      05  WRK-UNDER-RPT-TAX-WAGE  PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00443      05  WRK-PRE-AUDIT-CONTRIB   PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00444      05  WRK-POST-AUDIT-CONTRIB  PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00445      05  WRK-OVER-RPT-CONTRIB    PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00446      05  WRK-UNDER-RPT-CONTRIB   PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00447      05  WRK-CHANGE-AUDIT-IND    PIC  X(01)     VALUE SPACE.      DTSBE770
00448                                                                   DTSBE770
00449      05  WRK-AUDIT-TOT-WAGE      PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00450      05  WRK-AUDIT-TAX-WAGE      PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00451      05  WRK-AUDIT-UI-CHG        PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00452      05  WRK-ORIG-TOT-WAGE       PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00453      05  WRK-ORIG-TAX-WAGE       PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00454      05  WRK-ORIG-UI-CHG         PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00455                                                                   DTSBE770
00456      05  WRK-LIAB-QTR-CNT            PIC S9(07)  COMP-3 VALUE +0. DTSBE770
00457      05  WRK-RPT-RCVD-CNT            PIC S9(07)  COMP-3 VALUE +0. DTSBE770
00458      05  WRK-ZERO-WAGE-CNT           PIC S9(02)  COMP-3 VALUE +0. DTSBE770
00459      05  WRK-ANNUAL-RPT-CNT          PIC S9(07)  COMP-3 VALUE +0. DTSBE770
00460                                                                   DTSBE770
00461      05  WRK-ALL-NINES-DATE         PIC S9(09)  COMP-3            DTSBE770
00462                                      VALUE +999999999.            DTSBE770
00463      05  WRK-LIAB-DATE              PIC S9(09)  COMP-3.           DTSBE770
00464      05  WRK-REOPEN-DATE            PIC S9(09)  COMP-3.           DTSBE770
00465      05  WRK-LIAB-PROCESS-DATE      PIC S9(09)  COMP-3.           DTSBE770
00466      05  WRK-REOPEN-PROCESS-DATE    PIC S9(09)  COMP-3.           DTSBE770
00467      05  WRK-LAST-INACT-DATE        PIC S9(09)  COMP-3.           DTSBE770
00468      05  WRK-LAST-INACT-ENTER-DATE  PIC S9(09)  COMP-3.           DTSBE770
00469                                                                   DTSBE770
00470      05  WRK-CURR-ESTB-DATE         PIC S9(09)  COMP-3.           DTSBE770
00471      05  WRK-CURR-INACT-DATE        PIC S9(09)  COMP-3.           DTSBE770
00472      05  WRK-CURR-INACT-REV-DATE    PIC S9(09)  COMP-3.           DTSBE770
00473      05  WRK-STATUS-DETERM-DATE     PIC S9(09)  COMP-3.           DTSBE770
00474      05  WRK-STATUS-LIAB-DATE       PIC S9(09)  COMP-3.           DTSBE770
00475      05  WRK-STATUS-ACT-DATE        PIC S9(09)  COMP-3.           DTSBE770
00476      05  WRK-STATUS-REACT-DATE      PIC S9(09)  COMP-3.           DTSBE770
00477      05  WRK-STATUS-INACT-DATE      PIC S9(09)  COMP-3.           DTSBE770
00478      05  WRK-STATUS-SUCC-DATE       PIC S9(09)  COMP-3.           DTSBE770
00479      05  CURR-DETERM-TABLE.                                       DTSBE770
00480          10  CURR-DETERM-ESTB-IND   PIC X(01).                    DTSBE770
00481              88  CURR-DETERM-ESTB-YES-88  VALUE 'Y'.              DTSBE770
00482              88  CURR-DETERM-ESTB-NO-88   VALUE 'N'.              DTSBE770
00483          10  CURR-DETERM-INACT-IND   PIC X(01).                   DTSBE770
00484              88  CURR-DETERM-INACT-YES-88  VALUE 'Y'.             DTSBE770
00485              88  CURR-DETERM-INACT-NO-88   VALUE 'N'.             DTSBE770
00486          10  CURR-DETERM-REV-IND     PIC X(01).                   DTSBE770
00487              88  CURR-DETERM-REV-YES-88  VALUE 'Y'.               DTSBE770
00488              88  CURR-DETERM-REV-NO-88   VALUE 'N'.               DTSBE770
00489 **   05  CURR-DETERM REDEFINES CURR-DETERM-TABLE                  DTSBE770
00490 *                                   PIC X(03).                    DTSBE770
00491 *        88  CURR-DETERM-NEW-88      VALUE 'YNN' 'YNY' 'NNY'.     DTSBE770
00492 **       88  CURR-DETERM-INACT-88    VALUE 'YYN' 'NYN'.           DTSBE770
00493      05  WRK-DETERM-TYPE-IND        PIC  X(01).                   DTSBE770
00494          88  WRK-DETERM-NULL-88      VALUE '0'.                   DTSBE770
00495          88  WRK-DETERM-ORIG-88      VALUE '1'.                   DTSBE770
00496          88  WRK-DETERM-REACT-88     VALUE '2'.                   DTSBE770
00497          88  WRK-DETERM-SUC-88       VALUE '3'.                   DTSBE770
00498          88  WRK-DETERM-INACT-88     VALUE '4'.                   DTSBE770
00499                                                                   DTSBE770
00500      05  WRK-ACTIVE-DURING-PERIOD-IND                             DTSBE770
00501                                      PIC  X(01).                  DTSBE770
00502                                                                   DTSBE770
00503      05  WRK-PREV-INACTIVE-IND   PIC  X(01).                      DTSBE770
00504          88  WRK-PREV-INACTIVE-YES-88  VALUE 'Y'.                 DTSBE770
00505          88  WRK-PREV-INACTIVE-NO-88   VALUE 'N'.                 DTSBE770
00506                                                                   DTSBE770
00507      05  WRK-8-QTRS-ZERO-WAGES-IND  PIC  X(01).                   DTSBE770
00508          88  WRK-8-QTRS-ZERO-WAGES-YES  VALUE 'Y'.                DTSBE770
00509          88  WRK-8-QTRS-ZERO-WAGES-NO   VALUE 'N'.                DTSBE770
00510                                                                   DTSBE770
00511      05  WRK-PRED-EMP-NO            PIC S9(07) COMP-3.            DTSBE770
00512                                                                   DTSBE770
00513      05  WRK-FIRST-SUB              PIC S9(04)  COMP VALUE +400.  DTSBE770
00514      05  WRK-LAST-SUB               PIC S9(04)  COMP VALUE +0.    DTSBE770
00515      05  WRK-TBL-CNT                PIC S9(04)  COMP VALUE +0.    DTSBE770
00516      05  QTR-SUB                    PIC S9(04)  COMP.             DTSBE770
00517      05  WRK-JRN-TABLE OCCURS 400 TIMES.                          DTSBE770
00518          10  WRK-JRN-YRQ             PIC S9(05)    COMP-3.        DTSBE770
00519          10  WRK-BAL-DUE-IND         PIC  X(01).                  DTSBE770
00520              88  WRK-BAL-DUE-YES-88   VALUE 'Y'.                  DTSBE770
00521              88  WRK-BAL-DUE-NO-88    VALUE 'N'.                  DTSBE770
00522          10  WRK-JRN-PAID            PIC S9(09)V99 COMP-3.        DTSBE770
00523          10  WRK-JRN-CHG             PIC S9(09)V99 COMP-3.        DTSBE770
00524          10  WRK-TAX-DUE-DATE        PIC S9(09)    COMP-3.        DTSBE770
00525                                                                   DTSBE770
00526      05  WRK-RATE-FOUND-IND          PIC  X(01).                  DTSBE770
00527           88  WRK-RATE-FOUND-YES-88    VALUE 'Y'.                 DTSBE770
00528           88  WRK-RATE-FOUND-NO-88     VALUE 'N'.                 DTSBE770
00529                                                                   DTSBE770
00530      05  WRK-SUTA-DUMPING-AREA.                                   DTSBE770
00531          10  WRK-EFF-DATE           PIC S9(09)    COMP-3          DTSBE770
00532                                        VALUE +0.                  DTSBE770
00533          10  WRK-RATE-CHNG-DATE      PIC S9(09)    COMP-3         DTSBE770
00534                                        VALUE +999999999.          DTSBE770
00535              88  RATE-CHNG-DATE-NULL-88  VALUE +999999999.        DTSBE770
00536                                                                   DTSBE770
00537          10  WRK-SUTA-SUCC-EMP       PIC S9(07)    COMP-3         DTSBE770
00538                                        VALUE +0.                  DTSBE770
00539          10  WRK-SUTA-PRED-EMP       PIC S9(07)    COMP-3         DTSBE770
00540                                        VALUE +0.                  DTSBE770
00541          10  WRK-MANDATORY-CNT       PIC S9(07)    COMP-3         DTSBE770
00542                                        VALUE +0.                  DTSBE770
00543          10  WRK-PROHIBITED-CNT      PIC S9(07)    COMP-3         DTSBE770
00544                                        VALUE +0.                  DTSBE770
00545          10  WRK-SUTA-DMP-AMT        PIC S9(11)V99 COMP-3         DTSBE770
00546                                        VALUE +0.                  DTSBE770
00547          10  WRK-SUTA-DMP-TOT        PIC S9(11)V99 COMP-3         DTSBE770
00548                                        VALUE +0.                  DTSBE770
00549          10  SUB                     PIC S9(04)    COMP.          DTSBE770
00550                                                                   DTSBE770
00551      05  WRK-MJRN-READ-CNT           PIC S9(07)    COMP-3         DTSBE770
00552                                      VALUE +0.                    DTSBE770
00553                                                                   DTSBE770
00554      05  WRK-UI-CHG              PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00555      05  WRK-OUTSTANDING-BAL     PIC S9(11)V99  COMP-3 VALUE +0.  DTSBE770
00556      05  WRK-OUTSTANDING-QTR-CNT PIC S9(07)     COMP-3 VALUE +0.  DTSBE770
00557      05  WRK-WAGE-ITEM-CNT       PIC S9(09)     COMP-3 VALUE +0.  DTSBE770
00558      05  WRK-ITEM13-CNT          PIC S9(07)     COMP-3 VALUE +0.  DTSBE770
00559                                                                   DTSBE770
00560      05  WRK-AMT                     PIC S9(09)V99 COMP-3.        DTSBE770
00561                                                                   DTSBE770
00562      05  WRK-TOT-CON-BAL             PIC S9(11)V99 COMP-3         DTSBE770
00563                                      VALUE +0.                    DTSBE770
00564      05  WRK-TOT-REIMB-BAL           PIC S9(11)V99 COMP-3         DTSBE770
00565                                      VALUE +0.                    DTSBE770
00566      05  TPS-TRANS-REC.                                           DTSBE770
00567  ++INCLUDE DTSIM715                                               DTSBE770
00568                                                                   DTSBE770
00569      05  WRK-Y771-CNT               PIC S9(07)  COMP-3            DTSBE770
00570                                      VALUE +0.                    DTSBE770
00571      05  WRK-Y772-CNT               PIC S9(07)  COMP-3            DTSBE770
00572                                      VALUE +0.                    DTSBE770
00573      05  WRK-Y773-CNT               PIC S9(07)  COMP-3            DTSBE770
00574                                      VALUE +0.                    DTSBE770
00575      05  WRK-TPS-STATUS-CNT         PIC S9(07)  COMP-3            DTSBE770
00576                                      VALUE +0.                    DTSBE770
00577      05  WRK-Y774-CNT               PIC S9(07)  COMP-3            DTSBE770
00578                                      VALUE +0.                    DTSBE770
00579      05  WRK-Y775-CNT               PIC S9(07)  COMP-3            DTSBE770
00580                                      VALUE +0.                    DTSBE770
00581                                                                   DTSBE770
00582      05  WRK-CNT1                   PIC S9(07)  COMP-3            DTSBE770
00583                                      VALUE +0.                    DTSBE770
00584      05  WRK-CNT2                   PIC S9(07)  COMP-3            DTSBE770
00585                                      VALUE +0.                    DTSBE770
00586      05  WRK-CNT3                   PIC S9(07)  COMP-3            DTSBE770
00587                                      VALUE +0.                    DTSBE770
00588      05  WRK-CNT4                   PIC S9(07)  COMP-3            DTSBE770
00589                                      VALUE +0.                    DTSBE770
00590                                                                   DTSBE770
00591      05  WRK-ANN-FILER-CNT          PIC S9(07)  COMP-3            DTSBE770
00592                                      VALUE +0.                    DTSBE770
00593                                                                   DTSBE770
00594 **   05  WRK-P2600-DFLT-CNT         PIC S9(07)  COMP-3            DTSBE770
00595 *                                    VALUE +0.                    DTSBE770
00596 *                                                                 DTSBE770
00597 *    05  WRK-P2600-CNT              PIC S9(07)  COMP-3            DTSBE770
00598 **                                   VALUE +0.                    DTSBE770
00599      05  WRK-P2610-QTR-CNT          PIC S9(07)  COMP-3            DTSBE770
00600                                      VALUE +0.                    DTSBE770
00601                                                                   DTSBE770
00602      05  WRK-P2100-DFLT-CNT         PIC S9(07)  COMP-3            DTSBE770
00603                                      VALUE +0.                    DTSBE770
00604                                                                   DTSBE770
00605      05  WRK-P2100-CNT              PIC S9(07)  COMP-3            DTSBE770
00606                                      VALUE +0.                    DTSBE770
00607      05  WRK-P2100-RCVD-CNT         PIC S9(07)  COMP-3            DTSBE770
00608                                      VALUE +0.                    DTSBE770
00609      05  WRK-P2100-MISS-CNT         PIC S9(07)  COMP-3            DTSBE770
00610                                      VALUE +0.                    DTSBE770
00611                                                                   DTSBE770
00612      05  WRK-P2100-QTR-CNT          PIC S9(07)  COMP-3            DTSBE770
00613                                      VALUE +0.                    DTSBE770
00614                                                                   DTSBE770
00615      05  WRK-P2500-QTR-CNT          PIC S9(07)  COMP-3            DTSBE770
00616                                      VALUE +0.                    DTSBE770
00617      05  WRK-P2500-ANN-CNT          PIC S9(07)  COMP-3            DTSBE770
00618                                      VALUE +0.                    DTSBE770
00619      05  WRK-P2500-581-QTR-CNT      PIC S9(07)  COMP-3            DTSBE770
00620                                      VALUE +0.                    DTSBE770
00621      05  WRK-P2210-RES-CNT          PIC S9(07)  COMP-3            DTSBE770
00622                                      VALUE +0.                    DTSBE770
00623      05  WRK-P2210-SEC-CNT          PIC S9(07)  COMP-3            DTSBE770
00624                                      VALUE +0.                    DTSBE770
00625      05  WRK-P2210-TIMELY-CNT       PIC S9(07)  COMP-3            DTSBE770
00626                                      VALUE +0.                    DTSBE770
00627      05  WRK-P2510-DFLT-TIMELY-CNT  PIC S9(07)  COMP-3            DTSBE770
00628                                      VALUE +0.                    DTSBE770
00629      05  WRK-P2220-RES-CNT          PIC S9(07)  COMP-3            DTSBE770
00630                                      VALUE +0.                    DTSBE770
00631      05  WRK-P2220-SEC-CNT          PIC S9(07)  COMP-3            DTSBE770
00632                                      VALUE +0.                    DTSBE770
00633      05  WRK-P2220-TIMELY-CNT       PIC S9(07)  COMP-3            DTSBE770
00634                                      VALUE +0.                    DTSBE770
00635      05  WRK-P2520-DFLT-TIMELY-CNT  PIC S9(07)  COMP-3            DTSBE770
00636                                      VALUE +0.                    DTSBE770
00637                                                                   DTSBE770
00638                                                                   DTSBE770
00639      05  WRK-MISSING-CNT            PIC S9(07)  COMP-3            DTSBE770
00640                                      VALUE +0.                    DTSBE770
00641                                                                   DTSBE770
00642      05  WRK-SELECT-581-CNT         PIC S9(07)  COMP-3            DTSBE770
00643                                      VALUE +0.                    DTSBE770
00644                                                                   DTSBE770
00645      05  WRK-NOT-SELECTED-CNT       PIC S9(07)  COMP-3            DTSBE770
00646                                      VALUE +0.                    DTSBE770
00647                                                                   DTSBE770
00648      05  WRK-DISP-EMP               PIC S9(07) COMP-3             DTSBE770
00649                                      VALUE +010169.               DTSBE770
00650                                                                   DTSBE770
00651      05  DISPLAY-CNT                PIC  Z(06)9.                  DTSBE770
00652                                                                   DTSBE770
00653      05  DISPLAY-AMT-X               PIC  X(15).                  DTSBE770
00654      05  DISPLAY-AMT REDEFINES DISPLAY-AMT-X                      DTSBE770
00655                                      PIC  ZZZ,ZZZ,ZZ9.99-.        DTSBE770
00656      05  AMT-DISP1                   PIC --,---,---,--9.99.       DTSBE770
00657      EJECT                                                        DTSBE770
00658  01  L001-LINK-AREA.                                              DTSBE770
00659  ++INCLUDE DTSIL001                                               DTSBE770
00660      EJECT                                                        DTSBE770
00661  01  L004-LINK-AREA.                                              DTSBE770
00662  ++INCLUDE DTSIL004                                               DTSBE770
00663      EJECT                                                        DTSBE770
00664  01  L005-LINK-AREA.                                              DTSBE770
00665  ++INCLUDE DTSIL005                                               DTSBE770
00666      EJECT                                                        DTSBE770
00667  01  L410-LINK-AREA.                                              DTSBE770
00668  ++INCLUDE DTSIL410                                               DTSBE770
00669      SKIP3                                                        DTSBE770
00670  01  L415-LINK-AREA.                                              DTSBE770
00671  ++INCLUDE DTSIL415                                               DTSBE770
00672                                                                   DTSBE770
00673  01  L430-LINK-AREA.                                              DTSBE770
00674  ++INCLUDE DTSIL430                                               DTSBE770
00675                                                                   DTSBE770
00676  01  L910-LINK-AREA.                                              DTSBE770
00677  ++INCLUDE DTSIL910                                               DTSBE770
00678      SKIP3                                                        DTSBE770
00679  01  MSKL-REC.                                                    DTSBE770
00680  ++INCLUDE DTSIMSKL                                               DTSBE770
00681      SKIP3                                                        DTSBE770
00682  01  MSOL-REC.                                                    DTSBE770
00683  ++INCLUDE DTSIMSOL                                               DTSBE770
00684      SKIP3                                                        DTSBE770
00685  01  MQTR-REC.                                                    DTSBE770
00686  ++INCLUDE DTSIMQTR                                               DTSBE770
00687      SKIP3                                                        DTSBE770
00688  01  MRPT-REC.                                                    DTSBE770
00689  ++INCLUDE DTSIMRPT                                               DTSBE770
00690      SKIP3                                                        DTSBE770
00691  01  MERD-REC.                                                    DTSBE770
00692  ++INCLUDE DTSIMERD                                               DTSBE770
00693      SKIP3                                                        DTSBE770
00694  01  MREL-REC.                                                    DTSBE770
00695  ++INCLUDE DTSIMREL                                               DTSBE770
00696      SKIP3                                                        DTSBE770
00697  01  MRTE-REC.                                                    DTSBE770
00698  ++INCLUDE DTSIMRTE                                               DTSBE770
00699      SKIP3                                                        DTSBE770
00700  01  MJRN-REC.                                                    DTSBE770
00701  ++INCLUDE DTSIMJRN                                               DTSBE770
00702      SKIP3                                                        DTSBE770
00703 *01  F581-REC.                                                    DTSBE770
00704 ***INCLUDE DTSIF581                                               DTSBE770
00705 *    SKIP3                                                        DTSBE770
00706  01  MFAS-REC.                                                    DTSBE770
00707  ++INCLUDE DTSIMFAS                                               DTSBE770
00708      SKIP3                                                        DTSBE770
00709  01  MAUR-REC.                                                    DTSBE770
00710  ++INCLUDE DTSIMAUR                                               DTSBE770
00711      SKIP3                                                        DTSBE770
00712  01  MAUY-REC.                                                    DTSBE770
00713  ++INCLUDE DTSIMAUY                                               DTSBE770
00714      EJECT                                                        DTSBE770
00715  01  L931-LINK-AREA.                                              DTSBE770
00716  ++INCLUDE DTSIL931                                               DTSBE770
00717      SKIP3                                                        DTSBE770
00718  01  FSKL-REC.                                                    DTSBE770
00719  ++INCLUDE DTSIFSKL                                               DTSBE770
00720      SKIP3                                                        DTSBE770
00721  01  FQTR-REC.                                                    DTSBE770
00722  ++INCLUDE DTSIFQTR                                               DTSBE770
00723      SKIP3                                                        DTSBE770
00724  01  L927-LINK-AREA.                                              DTSBE770
00725  ++INCLUDE DTSIL927                                               DTSBE770
00726                                                                   DTSBE770
00727  01  RSKL-REC.                                                    DTSBE770
00728  ++INCLUDE DTSIRSK1                                               DTSBE770
00729                                                                   DTSBE770
00730  01  Y771-REC.                                                    DTSBE770
00731  ++INCLUDE DTSIY771                                               DTSBE770
00732                                                                   DTSBE770
00733  01  Y772-REC.                                                    DTSBE770
00734  ++INCLUDE DTSIY772                                               DTSBE770
00735                                                                   DTSBE770
00736  01  Y773-REC.                                                    DTSBE770
00737  ++INCLUDE DTSIY773                                               DTSBE770
00738                                                                   DTSBE770
00739  01  Y774-REC.                                                    DTSBE770
00740  ++INCLUDE DTSIY774                                               DTSBE770
00741                                                                   DTSBE770
00742  01  Y775-REC.                                                    DTSBE770
00743  ++INCLUDE DTSIY775                                               DTSBE770
00744                                                                   DTSBE770
00745  01  Y779-REC.                                                    DTSBE770
00746  ++INCLUDE DTSIY779                                               DTSBE770
00747                                                                   DTSBE770
00748  01  MMAX-LITERALS.                                               DTSBE770
00749  ++INCLUDE DTSIMMAX                                               DTSBE770
00750      EJECT                                                        DTSBE770
00751  LINKAGE SECTION.                                                 DTSBE770
00752      SKIP3                                                        DTSBE770
00753  01  LECM-LINK-AREA.                                              DTSBE770
00754  ++INCLUDE DTSILECM                                               DTSBE770
00755      SKIP3                                                        DTSBE770
00756          10  FILLER REDEFINES LECM-EXTRACT-PARMS.                 DTSBE770
00757              15  LECM-PARM-SUBJECT-YRQ        PIC  X(03).         DTSBE770
00758              15  FILLER                       PIC  X(65).         DTSBE770
00759      EJECT                                                        DTSBE770
00760  01  MPRF-LINK-REC.                                               DTSBE770
00761  ++INCLUDE DTSIMPRF                                               DTSBE770
00762      EJECT                                                        DTSBE770
00763  PROCEDURE DIVISION USING LECM-LINK-AREA                          DTSBE770
00764                           MPRF-LINK-REC.                          DTSBE770
00765                                                                   DTSBE770
00766      IF LECM-PROCESS-88                                           DTSBE770
00767          PERFORM P0000-PROCESS THRU P0000-EXIT                    DTSBE770
00768      ELSE                                                         DTSBE770
00769      IF LECM-INITIALIZE-88                                        DTSBE770
00770          PERFORM I0000-INITIALIZE THRU I0000-EXIT                 DTSBE770
00771      ELSE                                                         DTSBE770
00772      IF LECM-TERMINATE-88                                         DTSBE770
00773          PERFORM T0000-TERMINATE THRU T0000-EXIT                  DTSBE770
00774      ELSE                                                         DTSBE770
00775          MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED'            DTSBE770
00776            TO ABEND-MSG                                           DTSBE770
00777          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBE770
00778      SKIP2                                                        DTSBE770
00779      GOBACK.                                                      DTSBE770
00780      EJECT                                                        DTSBE770
00781  I0000-INITIALIZE.                                                DTSBE770
00782      SKIP2                                                        DTSBE770
00783      MOVE LECM-TRACE-IND TO L910-TRACE-IND.                       DTSBE770
00784                                                                   DTSBE770
00785      MOVE WRK-MOD-NAME TO L910-MOD-NAME.                          DTSBE770
00786                                                                   DTSBE770
00787                                                                   DTSBE770
00788      PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT.        DTSBE770
00789                                                                   DTSBE770
00790      PERFORM I2100-PERIOD-DATES THRU I2100-EXIT.                  DTSBE770
00791                                                                   DTSBE770
00792      PERFORM I2200-TIMING-EDITS THRU I2200-EXIT.                  DTSBE770
00793                                                                   DTSBE770
00794      PERFORM I2400-SET-WAGE-QTRS      THRU I2400-EXIT.            DTSBE770
00795                                                                   DTSBE770
00796      PERFORM I2500-ANNUAL-RPT-DATES   THRU I2500-EXIT.            DTSBE770
00797                                                                   DTSBE770
00798      PERFORM I2600-DELINQUENCY-DATES  THRU I2600-EXIT.            DTSBE770
00799                                                                   DTSBE770
00800      PERFORM I3000-WRITE-PARM         THRU I3000-EXIT.            DTSBE770
00801                                                                   DTSBE770
00802      PERFORM I3100-OPEN-FILES         THRU I3100-EXIT.            DTSBE770
00803                                                                   DTSBE770
00804      PERFORM I4100-DISPLAY THRU I4100-EXIT.                       DTSBE770
00805                                                                   DTSBE770
00806      SET LECM-MST-OPEN-READ-88 TO TRUE.                           DTSBE770
00807                                                                   DTSBE770
00808      SET LECM-REF-OPEN-READ-88 TO TRUE.                           DTSBE770
00809                                                                   DTSBE770
00810  I0000-EXIT.                                                      DTSBE770
00811      EXIT.                                                        DTSBE770
00812      EJECT                                                        DTSBE770
00813  I1000-EDIT-AND-DEFAULT-PARMS.                                    DTSBE770
00814      PERFORM I1100-SUBJECT-YRQ THRU I1100-EXIT.                   DTSBE770
00815                                                                   DTSBE770
00816  I1000-EXIT.                                                      DTSBE770
00817      EXIT.                                                        DTSBE770
00818      SKIP3                                                        DTSBE770
00819  I1100-SUBJECT-YRQ.                                               DTSBE770
00820      IF LECM-PARM-SUBJECT-YRQ = SPACES                            DTSBE770
00821          IF LECM-QTR-END                                          DTSBE770
00822              MOVE LECM-PERIOD-END-DATE TO L004-DATE               DTSBE770
00823              PERFORM S004-FROM-DATE THRU S004-EXIT                DTSBE770
00824              MOVE L004-QTR-5-9 TO WRK-SUBJECT-QTR                 DTSBE770
00825          ELSE                                                     DTSBE770
00826         MOVE 'LECM-PARM-SUBJECT-YRQ SPACES AND NOT LECM-QTR-END'  DTSBE770
00827                TO ABEND-MSG                                       DTSBE770
00828              PERFORM S999-ABEND THRU S999-EXIT                    DTSBE770
00829      ELSE                                                         DTSBE770
00830          MOVE LECM-PARM-SUBJECT-YRQ TO L004-QTR-3-X               DTSBE770
00831          PERFORM S004-FROM-3 THRU S004-EXIT                       DTSBE770
00832          IF L004-INVALID-QTR                                      DTSBE770
00833              MOVE 'LECM-PARM-SUBJECT-YRQ NOT VALID'               DTSBE770
00834                TO ABEND-MSG                                       DTSBE770
00835              PERFORM S999-ABEND THRU S999-EXIT                    DTSBE770
00836          ELSE                                                     DTSBE770
00837              MOVE L004-QTR-5-9 TO WRK-SUBJECT-QTR.                DTSBE770
00838                                                                   DTSBE770
00839      MOVE WRK-SUBJECT-QTR      TO WRK-RPT-QTR.                    DTSBE770
00840                                                                   DTSBE770
00841  I1100-EXIT.                                                      DTSBE770
00842      EXIT.                                                        DTSBE770
00843      SKIP3                                                        DTSBE770
00844  I2100-PERIOD-DATES.                                              DTSBE770
00845      MOVE WRK-SUBJECT-QTR TO L004-QTR-5-9.                        DTSBE770
00846      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBE770
00847      MOVE L004-QTR-START-DATE TO WRK-SUBJECT-QTR-START.           DTSBE770
00848      MOVE L004-QTR-END-DATE TO WRK-SUBJECT-QTR-END.               DTSBE770
00849                                                                   DTSBE770
00850      IF WRK-SUBJECT-QTR-START > LECM-LAST-MJRN-PURGE-DATE         DTSBE770
00851          NEXT SENTENCE                                            DTSBE770
00852      ELSE                                                         DTSBE770
00853          MOVE                                                     DTSBE770
00854      'PERIOD-START-DATE NOT GREATER THAN LAST-MJRN-PURGE-DATE'    DTSBE770
00855            TO ABEND-MSG                                           DTSBE770
00856          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBE770
00857                                                                   DTSBE770
00858  I2100-EXIT.                                                      DTSBE770
00859      EXIT.                                                        DTSBE770
00860      EJECT                                                        DTSBE770
00861  I2200-TIMING-EDITS.                                              DTSBE770
00862      IF (LECM-PRIOR-RUN-DATE NOT > WRK-SUBJECT-QTR-END)           DTSBE770
00863              AND                                                  DTSBE770
00864         (LECM-CURR-RUN-DATE > WRK-SUBJECT-QTR-END)                DTSBE770
00865          NEXT SENTENCE                                            DTSBE770
00866      ELSE                                                         DTSBE770
00867          MOVE 'TIMING OF RUN IS NOT VALID'                        DTSBE770
00868            TO ABEND-MSG                                           DTSBE770
00869          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBE770
00870  I2200-EXIT.                                                      DTSBE770
00871      EXIT.                                                        DTSBE770
00872      EJECT                                                        DTSBE770
00873  I2400-SET-WAGE-QTRS.                                             DTSBE770
00874      MOVE WRK-SUBJECT-QTR      TO L004-QTR-5-9.                   DTSBE770
00875      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBE770
00876      SUBTRACT 1 FROM L004-ABS-QTR.                                DTSBE770
00877      PERFORM S004-FROM-ABS THRU S004-EXIT.                        DTSBE770
00878      MOVE L004-QTR-5-9 TO WRK-QTR1.                               DTSBE770
00879      MOVE L004-QTR-START-DATE TO WRK-QTR1-START.                  DTSBE770
00880      MOVE L004-QTR-END-DATE TO WRK-QTR1-END.                      DTSBE770
00881      MOVE L004-QTR-DEFAULT-DUE-DATE TO WRK-QTR1-DUE-DATE          DTSBE770
00882                                        WRK-QTR1-ANN-TIMELY.       DTSBE770
00883      MOVE L004-QTR-DEFAULT-DUE-DATE TO L004-DATE.                 DTSBE770
00884      PERFORM S004-FROM-DATE  THRU S004-EXIT.                      DTSBE770
00885      MOVE L004-QTR-END-DATE TO WRK-QTR1-ANN-SECURED.              DTSBE770
00886                                                                   DTSBE770
00887      MOVE WRK-SUBJECT-QTR      TO L004-QTR-5-9.                   DTSBE770
00888      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBE770
00889      SUBTRACT 2 FROM L004-ABS-QTR.                                DTSBE770
00890      PERFORM S004-FROM-ABS THRU S004-EXIT.                        DTSBE770
00891      MOVE L004-QTR-5-9 TO WRK-QTR2.                               DTSBE770
00892      MOVE L004-QTR-START-DATE TO WRK-QTR2-START.                  DTSBE770
00893      MOVE L004-QTR-END-DATE TO WRK-QTR2-END.                      DTSBE770
00894      MOVE L004-QTR-DEFAULT-DUE-DATE TO WRK-QTR2-DUE-DATE          DTSBE770
00895                                        WRK-QTR2-ANN-TIMELY.       DTSBE770
00896      MOVE L004-QTR-DEFAULT-DUE-DATE TO L004-DATE.                 DTSBE770
00897      PERFORM S004-FROM-DATE  THRU S004-EXIT.                      DTSBE770
00898      MOVE L004-QTR-END-DATE TO WRK-QTR2-ANN-SECURED.              DTSBE770
00899                                                                   DTSBE770
00900      MOVE WRK-SUBJECT-QTR      TO L004-QTR-5-9.                   DTSBE770
00901      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBE770
00902      SUBTRACT 3 FROM L004-ABS-QTR.                                DTSBE770
00903      PERFORM S004-FROM-ABS THRU S004-EXIT.                        DTSBE770
00904      MOVE L004-QTR-5-9 TO WRK-QTR3.                               DTSBE770
00905      MOVE L004-QTR-START-DATE TO WRK-QTR3-START.                  DTSBE770
00906      MOVE L004-QTR-END-DATE TO WRK-QTR3-END.                      DTSBE770
00907                                                                   DTSBE770
00908      SUBTRACT 1 FROM L004-ABS-QTR.                                DTSBE770
00909      PERFORM S004-FROM-ABS THRU S004-EXIT.                        DTSBE770
00910      MOVE L004-QTR-5-9 TO WRK-QTR4.                               DTSBE770
00911                                                                   DTSBE770
00912      SUBTRACT 1 FROM L004-ABS-QTR.                                DTSBE770
00913      PERFORM S004-FROM-ABS THRU S004-EXIT.                        DTSBE770
00914      MOVE L004-QTR-5-9 TO WRK-QTR5.                               DTSBE770
00915                                                                   DTSBE770
00916      SUBTRACT 1 FROM L004-ABS-QTR.                                DTSBE770
00917      PERFORM S004-FROM-ABS THRU S004-EXIT.                        DTSBE770
00918      MOVE L004-QTR-5-9 TO WRK-QTR6.                               DTSBE770
00919                                                                   DTSBE770
00920      SUBTRACT 1 FROM L004-ABS-QTR.                                DTSBE770
00921      PERFORM S004-FROM-ABS THRU S004-EXIT.                        DTSBE770
00922      MOVE L004-QTR-5-9 TO WRK-QTR7.                               DTSBE770
00923                                                                   DTSBE770
00924      SUBTRACT 1 FROM L004-ABS-QTR.                                DTSBE770
00925      PERFORM S004-FROM-ABS THRU S004-EXIT.                        DTSBE770
00926      MOVE L004-QTR-5-9 TO WRK-QTR8.                               DTSBE770
00927                                                                   DTSBE770
00928  I2400-EXIT.                                                      DTSBE770
00929      EXIT.                                                        DTSBE770
00930                                                                   DTSBE770
00931  I2500-ANNUAL-RPT-DATES.                                          DTSBE770
00932      MOVE WRK-SUBJECT-QTR      TO L004-QTR-5-9.                   DTSBE770
00933      SUBTRACT 1                FROM L004-QTR-5-YR.                DTSBE770
00934      MOVE 1                    TO L004-QTR-5-Q.                   DTSBE770
00935      MOVE L004-QTR-5-9         TO WRK-FIRST-ANN-QTR.              DTSBE770
00936                                                                   DTSBE770
00937      MOVE L004-QTR-5-YR        TO L001-FED-8-YR.                  DTSBE770
00938      MOVE 01                   TO L001-FED-8-MO.                  DTSBE770
00939      MOVE 01                   TO L001-FED-8-DA.                  DTSBE770
00940      MOVE L001-FED-8-DATE-9    TO WRK-ANN-START.                  DTSBE770
00941                                                                   DTSBE770
00942      MOVE 4                    TO L004-QTR-5-Q.                   DTSBE770
00943      MOVE L004-QTR-5-9         TO WRK-LAST-ANN-QTR.               DTSBE770
00944                                                                   DTSBE770
00945      MOVE 12                   TO L001-FED-8-MO.                  DTSBE770
00946      MOVE 31                   TO L001-FED-8-DA.                  DTSBE770
00947      MOVE L001-FED-8-DATE-9    TO WRK-ANN-END.                    DTSBE770
00948                                                                   DTSBE770
00949 *    MOVE WRK-QTR1-DUE-DATE    TO L001-FED-8-DATE-9.              DTSBE770
00950 *    PERFORM S001-FROM-FED-8   THRU S001-EXIT.                    DTSBE770
00951 *    ADD +1                    TO L001-JUL-ABS-DAY.               DTSBE770
00952 *    PERFORM S001-FROM-ABS-DAY THRU S001-EXIT.                    DTSBE770
00953 *    MOVE L001-FED-8-DATE-9    TO WRK-ANN-QTR1-LATE-DATE.         DTSBE770
00954 *                                                                 DTSBE770
00955 *    MOVE WRK-QTR2-DUE-DATE    TO L001-FED-8-DATE-9.              DTSBE770
00956 *    PERFORM S001-FROM-FED-8   THRU S001-EXIT.                    DTSBE770
00957 *    ADD +1                    TO L001-JUL-ABS-DAY.               DTSBE770
00958 *    PERFORM S001-FROM-ABS-DAY THRU S001-EXIT.                    DTSBE770
00959 *    MOVE L001-FED-8-DATE-9    TO WRK-ANN-QTR2-LATE-DATE.         DTSBE770
00960                                                                   DTSBE770
00961      MOVE WRK-FIRST-ANN-QTR    TO L004-QTR-5-9.                   DTSBE770
00962      PERFORM S004-FROM-5       THRU S004-EXIT.                    DTSBE770
00963      MOVE L004-ANN-DEFAULT-DUE-DATE                               DTSBE770
00964                                TO WRK-ANN-DUE-DATE                DTSBE770
00965                                   L004-DATE.                      DTSBE770
00966      PERFORM S004-FROM-DATE    THRU S004-EXIT.                    DTSBE770
00967      MOVE L004-QTR-END-DATE    TO WRK-ANN-SECURED-DATE.           DTSBE770
00968                                                                   DTSBE770
00969 *    SUBTRACT 1 FROM L004-ABS-QTR.                                DTSBE770
00970 *    PERFORM S004-FROM-ABS THRU S004-EXIT.                        DTSBE770
00971 *    MOVE L004-QTR-DEFAULT-DUE-DATE                               DTSBE770
00972 *                              TO WRK-ANN-PSEUDO-TIMELY-DT1.      DTSBE770
00973 *    MOVE L004-QTR-END-DATE    TO WRK-ANN-PSEUDO-SECURD-DT2.      DTSBE770
00974 *                                                                 DTSBE770
00975 *    SUBTRACT 1 FROM L004-ABS-QTR.                                DTSBE770
00976 *    PERFORM S004-FROM-ABS THRU S004-EXIT.                        DTSBE770
00977 *    MOVE L004-QTR-DEFAULT-DUE-DATE                               DTSBE770
00978 *                              TO WRK-ANN-PSEUDO-TIMELY-DT2.      DTSBE770
00979                                                                   DTSBE770
00980      DISPLAY SPACE.                                               DTSBE770
00981      DISPLAY 'FIRST ANNUAL QTR       : ' WRK-FIRST-ANN-QTR.       DTSBE770
00982      DISPLAY 'LAST ANNUAL QTR        : ' WRK-LAST-ANN-QTR.        DTSBE770
00983      DISPLAY 'ANNUAL START DATE      : ' WRK-ANN-START.           DTSBE770
00984      DISPLAY 'ANNUAL END DATE        : ' WRK-ANN-END.             DTSBE770
00985      DISPLAY 'ANNUAL DUE DATE        : ' WRK-ANN-DUE-DATE.        DTSBE770
00986      DISPLAY 'ANNUAL SECURED DATE    : ' WRK-ANN-SECURED-DATE.    DTSBE770
00987      DISPLAY 'QTR1 ANN TIMELY        : '                          DTSBE770
00988                   WRK-QTR1-ANN-TIMELY.                            DTSBE770
00989      DISPLAY 'QTR1 ANN SECURED       : '                          DTSBE770
00990                   WRK-QTR1-ANN-SECURED.                           DTSBE770
00991      DISPLAY 'QTR2 ANN TIMELY        : '                          DTSBE770
00992                   WRK-QTR2-ANN-TIMELY.                            DTSBE770
00993      DISPLAY 'QTR2 ANN SECURED       : '                          DTSBE770
00994                   WRK-QTR2-ANN-SECURED.                           DTSBE770
00995                                                                   DTSBE770
00996  I2500-EXIT.                                                      DTSBE770
00997      EXIT.                                                        DTSBE770
00998                                                                   DTSBE770
00999  I2600-DELINQUENCY-DATES.                                         DTSBE770
01000      MOVE LOW-VALUES TO FQTR-KEY-AREA.                            DTSBE770
01001      MOVE WRK-QTR1    TO FQTR-YRQ.                                DTSBE770
01002      SET FQTR-QTR-88 TO TRUE.                                     DTSBE770
01003      MOVE FQTR-KEY-AREA TO FSKL-KEY-AREA.                         DTSBE770
01004      PERFORM S931-READ         THRU S931-EXIT.                    DTSBE770
01005                                                                   DTSBE770
01006      IF L931-NO-REC-88                                            DTSBE770
01007         DISPLAY 'CANNOT FIND FQTR REC '                           DTSBE770
01008         PERFORM S999-ABEND THRU S999-EXIT                         DTSBE770
01009      ELSE                                                         DTSBE770
01010         MOVE FSKL-REC    TO FQTR-REC                              DTSBE770
01011         IF FQTR-UC30-FIRST-DEL-DATE > ZERO                        DTSBE770
01012            MOVE FQTR-UC30-FIRST-DEL-DATE                          DTSBE770
01013                                     TO WRK-QTR-DELINQUENT-DATE    DTSBE770
01014         ELSE                                                      DTSBE770
01015            MOVE WRK-QTR2    TO L004-QTR-5-9                       DTSBE770
01016            PERFORM S004-FROM-5 THRU S004-EXIT                     DTSBE770
01017            MOVE L004-QTR-END-DATE TO L001-FED-8-DATE-9            DTSBE770
01018            PERFORM S001-FROM-FED-8  THRU S001-EXIT                DTSBE770
01019            ADD +30 TO L001-JUL-ABS-DAY                            DTSBE770
01020            PERFORM S001-FROM-ABS-DAY  THRU S001-EXIT              DTSBE770
01021            MOVE L001-FED-8-DATE-9   TO WRK-QTR-DELINQUENT-DATE.   DTSBE770
01022                                                                   DTSBE770
01023      SET L415-MODE-MOST-RECENT-88 TO TRUE.                        DTSBE770
01024      PERFORM S415-HOUSEHOLD-DATES THRU S415-EXIT.                 DTSBE770
01025 **   DISPLAY 'I2600 L415 RET ' L415-RETURN-CD                     DTSBE770
01026 **      '  ANN START ' WRK-ANN-START.                             DTSBE770
01027      IF L415-OK-88                                                DTSBE770
01028         IF L415-UC30H-FIRST-DEL-DATE NOT = ZERO                   DTSBE770
01029            MOVE L415-UC30H-FIRST-DEL-DATE TO                      DTSBE770
01030                                        WRK-ANN-DELINQUENT-DATE    DTSBE770
01031         ELSE                                                      DTSBE770
01032            PERFORM I2610-ANN-DEL-DATE  THRU I2610-EXIT            DTSBE770
01033         END-IF                                                    DTSBE770
01034      ELSE                                                         DTSBE770
01035         PERFORM I2610-ANN-DEL-DATE  THRU I2610-EXIT               DTSBE770
01036      END-IF.                                                      DTSBE770
01037                                                                   DTSBE770
01038      DISPLAY 'ANNUAL DELINQUENT DATE : '                          DTSBE770
01039         WRK-ANN-DELINQUENT-DATE.                                  DTSBE770
01040                                                                   DTSBE770
01041  I2600-EXIT.                                                      DTSBE770
01042      EXIT.                                                        DTSBE770
01043                                                                   DTSBE770
01044  I2610-ANN-DEL-DATE.                                              DTSBE770
01045      MOVE WRK-ANN-START     TO L001-FED-8-DATE-9                  DTSBE770
01046      ADD 1                  TO L001-FED-8-YR                      DTSBE770
01047      MOVE 05                TO L001-FED-8-MO                      DTSBE770
01048      MOVE 31                TO L001-FED-8-DA                      DTSBE770
01049 **   DISPLAY 'I2600 FED DATE ' L001-FED-8-DATE-9                  DTSBE770
01050      PERFORM S001-FROM-FED-8  THRU S001-EXIT                      DTSBE770
01051      MOVE L001-FED-8-DATE-9   TO WRK-ANN-DELINQUENT-DATE.         DTSBE770
01052                                                                   DTSBE770
01053  I2610-EXIT.                                                      DTSBE770
01054      EXIT.                                                        DTSBE770
01055                                                                   DTSBE770
01056  I3000-WRITE-PARM.                                                DTSBE770
01057      OPEN OUTPUT ETA581-PARM-FILE.                                DTSBE770
01058      IF NOT BE770-STATUS-OK-88                                    DTSBE770
01059         DISPLAY 'CANNOT OPEN PARM FILE ' BE770-STATUS             DTSBE770
01060         PERFORM S999-ABEND THRU S999-EXIT.                        DTSBE770
01061                                                                   DTSBE770
01062      MOVE WRK-SUBJECT-QTR        TO X770-SUBJECT-QTR.             DTSBE770
01063      MOVE WRK-SUBJECT-QTR-START  TO X770-SUBJECT-QTR-START.       DTSBE770
01064      MOVE WRK-SUBJECT-QTR-END    TO X770-SUBJECT-QTR-END.         DTSBE770
01065      MOVE LECM-CURR-RUN-DATE     TO X770-CURR-RUN-DATE.           DTSBE770
01066      MOVE WRK-QTR1               TO X770-QTR1.                    DTSBE770
01067      MOVE WRK-QTR1-START         TO X770-QTR1-START.              DTSBE770
01068      MOVE WRK-QTR1-END           TO X770-QTR1-END.                DTSBE770
01069      MOVE WRK-QTR1-DUE-DATE      TO X770-QTR1-DUE-DATE.           DTSBE770
01070      MOVE WRK-QTR2               TO X770-QTR2.                    DTSBE770
01071      MOVE WRK-QTR2-START         TO X770-QTR2-START.              DTSBE770
01072      MOVE WRK-QTR2-END           TO X770-QTR2-END.                DTSBE770
01073      MOVE WRK-QTR2-DUE-DATE      TO X770-QTR2-DUE-DATE.           DTSBE770
01074      MOVE WRK-QTR3               TO X770-QTR3.                    DTSBE770
01075      MOVE WRK-QTR4               TO X770-QTR4.                    DTSBE770
01076      MOVE WRK-QTR5               TO X770-QTR5.                    DTSBE770
01077      MOVE WRK-QTR6               TO X770-QTR6.                    DTSBE770
01078      MOVE WRK-QTR7               TO X770-QTR7.                    DTSBE770
01079      MOVE WRK-QTR8               TO X770-QTR8.                    DTSBE770
01080      MOVE WRK-QTR-DELINQUENT-DATE   TO X770-DELINQUENT-DATE.      DTSBE770
01081                                                                   DTSBE770
01082      WRITE ETA581-PARM-REC.                                       DTSBE770
01083      IF NOT BE770-STATUS-OK-88                                    DTSBE770
01084         DISPLAY 'CANNOT WRITE PARM RECORD ' BE770-STATUS          DTSBE770
01085         PERFORM S999-ABEND THRU S999-EXIT.                        DTSBE770
01086                                                                   DTSBE770
01087      CLOSE ETA581-PARM-FILE.                                      DTSBE770
01088                                                                   DTSBE770
01089  I3000-EXIT.                                                      DTSBE770
01090      EXIT.                                                        DTSBE770
01091                                                                   DTSBE770
01092  I3100-OPEN-FILES.                                                DTSBE770
01093      MOVE WRK-SUBJECT-QTR             TO L004-QTR-5-9.            DTSBE770
01094                                                                   DTSBE770
01095      EVALUATE TRUE                                                DTSBE770
01096        WHEN L004-QTR-5-Q = 1                                      DTSBE770
01097          OPEN OUTPUT      TPS-STATUS-QTR1                         DTSBE770
01098          DISPLAY 'OPENING TPS QTR 1 FILE'                         DTSBE770
01099                                                                   DTSBE770
01100        WHEN L004-QTR-5-Q = 2                                      DTSBE770
01101          OPEN OUTPUT      TPS-STATUS-QTR2                         DTSBE770
01102          DISPLAY 'OPENING TPS QTR 2 FILE'                         DTSBE770
01103                                                                   DTSBE770
01104        WHEN L004-QTR-5-Q = 3                                      DTSBE770
01105          OPEN OUTPUT      TPS-STATUS-QTR3                         DTSBE770
01106          DISPLAY 'OPENING TPS QTR 3 FILE'                         DTSBE770
01107                                                                   DTSBE770
01108        WHEN L004-QTR-5-Q = 4                                      DTSBE770
01109          OPEN OUTPUT      TPS-STATUS-QTR4                         DTSBE770
01110          DISPLAY 'OPENING TPS QTR 4 FILE'                         DTSBE770
01111                                                                   DTSBE770
01112      END-EVALUATE.                                                DTSBE770
01113                                                                   DTSBE770
01114      IF NOT TPS-STAT-STATUS-OK-88                                 DTSBE770
01115         DISPLAY 'CANNOT OPEN TPS STATUS FILE ' TPS-STAT-STATUS    DTSBE770
01116            '  ' WRK-SUBJECT-QTR                                   DTSBE770
01117         PERFORM S999-ABEND        THRU S999-EXIT                  DTSBE770
01118      END-IF.                                                      DTSBE770
01119                                                                   DTSBE770
01120  I3100-EXIT.                                                      DTSBE770
01121      EXIT.                                                        DTSBE770
01122                                                                   DTSBE770
01123  I4100-DISPLAY.                                                   DTSBE770
01124      DISPLAY '                     WRK-SUBJECT-QTR: '             DTSBE770
01125              WRK-SUBJECT-QTR.                                     DTSBE770
01126      DISPLAY '                         WRK-RPT-QTR: '             DTSBE770
01127              WRK-RPT-QTR.                                         DTSBE770
01128      DISPLAY '            SUBJECT QTR START       : '             DTSBE770
01129              WRK-SUBJECT-QTR-START.                               DTSBE770
01130      DISPLAY '            SUBJECT QTR END         : '             DTSBE770
01131              WRK-SUBJECT-QTR-END.                                 DTSBE770
01132                                                                   DTSBE770
01133      DISPLAY '                  FIRST WAGE QUARTER: '             DTSBE770
01134              WRK-QTR1.                                            DTSBE770
01135                                                                   DTSBE770
01136      DISPLAY '                  QTR1 DUE DATE     : '             DTSBE770
01137              WRK-QTR1-DUE-DATE.                                   DTSBE770
01138                                                                   DTSBE770
01139      DISPLAY '                 SECOND WAGE QUARTER: '             DTSBE770
01140              WRK-QTR2.                                            DTSBE770
01141                                                                   DTSBE770
01142      DISPLAY '                  QTR2 DUE DATE     : '             DTSBE770
01143              WRK-QTR2-DUE-DATE.                                   DTSBE770
01144                                                                   DTSBE770
01145      DISPLAY '                  THIRD WAGE QUARTER: '             DTSBE770
01146              WRK-QTR3.                                            DTSBE770
01147                                                                   DTSBE770
01148      DISPLAY '                 FOURTH WAGE QUARTER: '             DTSBE770
01149              WRK-QTR4.                                            DTSBE770
01150                                                                   DTSBE770
01151      DISPLAY '                  FIFTH WAGE QUARTER: '             DTSBE770
01152              WRK-QTR5.                                            DTSBE770
01153                                                                   DTSBE770
01154      DISPLAY '                  SIXTH WAGE QUARTER: '             DTSBE770
01155              WRK-QTR6.                                            DTSBE770
01156                                                                   DTSBE770
01157      DISPLAY '                SEVENTH WAGE QUARTER: '             DTSBE770
01158              WRK-QTR7.                                            DTSBE770
01159                                                                   DTSBE770
01160      DISPLAY '                 EIGHTH WAGE QUARTER: '             DTSBE770
01161              WRK-QTR8.                                            DTSBE770
01162  I4100-EXIT.                                                      DTSBE770
01163      EXIT.                                                        DTSBE770
01164      EJECT                                                        DTSBE770
01165  P0000-PROCESS.                                                   DTSBE770
01166      IF MPRF-CLASS-SUB-88                                         DTSBE770
01167          NEXT SENTENCE                                            DTSBE770
01168      ELSE                                                         DTSBE770
01169          GO TO P0000-EXIT.                                        DTSBE770
01170                                                                   DTSBE770
01171      PERFORM P1000-ACTIVE-EMPLOYERS       THRU P1000-EXIT.        DTSBE770
01172                                                                   DTSBE770
01173      PERFORM P2000-REPORT-FILING          THRU P2000-EXIT.        DTSBE770
01174                                                                   DTSBE770
01175      PERFORM P3000-STATUS-DETERMINATIONS  THRU P3000-EXIT.        DTSBE770
01176                                                                   DTSBE770
01177      PERFORM P4000-ACCTS-RECEIVABLE       THRU P4000-EXIT.        DTSBE770
01178                                                                   DTSBE770
01179      PERFORM P5000-AUDIT-ACTIVITY         THRU P5000-EXIT.        DTSBE770
01180                                                                   DTSBE770
01181      PERFORM P9000-OUTSTANDING-QTRS     THRU P9000-EXIT.          DTSBE770
01182                                                                   DTSBE770
01183      PERFORM P9100-SUTA-DUMPING         THRU P9100-EXIT.          DTSBE770
01184                                                                   DTSBE770
01185  P0000-EXIT.                                                      DTSBE770
01186      EXIT.                                                        DTSBE770
01187                                                                   DTSBE770
01188  P1000-ACTIVE-EMPLOYERS.                                          DTSBE770
01189      MOVE 'N' TO WRK-ACTIVE-DURING-PERIOD-IND.                    DTSBE770
01190 **** MOVE WRK-ALL-NINES-DATE  TO WRK-LIAB-DATE.                   DTSBE770
01191      MOVE ZERO                TO WRK-LIAB-DATE                    DTSBE770
01192                                  WRK-LAST-INACT-DATE              DTSBE770
01193 ****                             WRK-REOPEN-DATE                  DTSBE770
01194                                  WRK-LIAB-PROCESS-DATE            DTSBE770
01195                                  WRK-REOPEN-PROCESS-DATE          DTSBE770
01196                                  WRK-LIAB-QTR-CNT                 DTSBE770
01197                                  WRK-RPT-RCVD-CNT                 DTSBE770
01198                                  WRK-ZERO-WAGE-CNT                DTSBE770
01199                                  WRK-QTR-WAGE-TOT.                DTSBE770
01200                                                                   DTSBE770
01201      SET WRK-8-QTRS-ZERO-WAGES-YES TO TRUE.                       DTSBE770
01202      SET WRK-PREV-INACTIVE-NO-88  TO TRUE.                        DTSBE770
01203                                                                   DTSBE770
01204      MOVE LOW-VALUES TO MSOL-KEY-AREA.                            DTSBE770
01205      MOVE MPRF-EMP-NO TO MSOL-EMP-NO.                             DTSBE770
01206      SET MSOL-SOL-88 TO TRUE.                                     DTSBE770
01207      MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE770
01208      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE770
01209      PERFORM P1100-SCAN-MSOL THRU P1100-EXIT                      DTSBE770
01210          UNTIL (L910-NO-REC-88).                                  DTSBE770
01211                                                                   DTSBE770
01212      IF WRK-ACTIVE-DURING-PERIOD-IND = 'N'                        DTSBE770
01213          GO TO P1000-EXIT                                         DTSBE770
01214      ELSE                                                         DTSBE770
01215          ADD +1 TO WRK-ACT-CNT                                    DTSBE770
01216      END-IF.                                                      DTSBE770
01217                                                                   DTSBE770
01218      IF WRK-LAST-INACT-DATE > ZERO                                DTSBE770
01219         IF WRK-REOPEN-PROCESS-DATE = ZERO                         DTSBE770
01220            MOVE WRK-LIAB-PROCESS-DATE TO                          DTSBE770
01221                 WRK-REOPEN-PROCESS-DATE.                          DTSBE770
01222                                                                   DTSBE770
01223      PERFORM P1200-WAGES      THRU P1200-EXIT.                    DTSBE770
01224                                                                   DTSBE770
01225      IF WRK-ZERO-WAGE-CNT > +7                                    DTSBE770
01226         ADD +1            TO WRK-0-WAGE-CNT                       DTSBE770
01227         GO TO P1000-EXIT                                          DTSBE770
01228      END-IF.                                                      DTSBE770
01229                                                                   DTSBE770
01230      IF WRK-LIAB-QTR-CNT = 0                                      DTSBE770
01231         ADD +1            TO WRK-NOT-LIAB-CNT                     DTSBE770
01232         GO TO P1000-EXIT                                          DTSBE770
01233      END-IF.                                                      DTSBE770
01234                                                                   DTSBE770
01235      IF WRK-RPT-RCVD-CNT = 0                                      DTSBE770
01236         ADD +1                TO WRK-DELINQ-CNT                   DTSBE770
01237         GO TO P1000-EXIT                                          DTSBE770
01238      END-IF.                                                      DTSBE770
01239                                                                   DTSBE770
01240      PERFORM P1400-WRITE-Y771 THRU P1400-EXIT.                    DTSBE770
01241                                                                   DTSBE770
01242  P1000-EXIT.                                                      DTSBE770
01243      EXIT.                                                        DTSBE770
01244                                                                   DTSBE770
01245  P1100-SCAN-MSOL.                                                 DTSBE770
01246      MOVE MSKL-REC TO MSOL-REC.                                   DTSBE770
01247                                                                   DTSBE770
01248 *****                                                             DTSBE770
01249 *                                                                 DTSBE770
01250 *    TO BE COUNTED AS ACTIVE, THE EMPLOYER MUST BE ACTIVE         DTSBE770
01251 *    ON THE LAST DAY OF THE REPORTING PERIOD.                     DTSBE770
01252 *                                                                 DTSBE770
01253 *****                                                             DTSBE770
01254                                                                   DTSBE770
01255      IF MSOL-INACT-WITHDRAWN-88                                   DTSBE770
01256          NEXT SENTENCE                                            DTSBE770
01257      ELSE                                                         DTSBE770
01258          PERFORM P1110-CHECK-DATES  THRU P1110-EXIT               DTSBE770
01259      END-IF.                                                      DTSBE770
01260                                                                   DTSBE770
01261      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBE770
01262  P1100-EXIT.                                                      DTSBE770
01263      EXIT.                                                        DTSBE770
01264                                                                   DTSBE770
01265  P1110-CHECK-DATES.                                               DTSBE770
01266      IF MSOL-INACT-INACTIVE-88                                    DTSBE770
01267         IF MSOL-INACT-DATE <= WRK-SUBJECT-QTR-START               DTSBE770
01268            IF MSOL-INACT-DATE > WRK-LAST-INACT-DATE               DTSBE770
01269                MOVE MSOL-INACT-DATE TO WRK-LAST-INACT-DATE        DTSBE770
01270            END-IF                                                 DTSBE770
01271         END-IF                                                    DTSBE770
01272         GO TO P1110-EXIT                                          DTSBE770
01273      END-IF.                                                      DTSBE770
01274                                                                   DTSBE770
01275      IF MSOL-INACT-DATE < WRK-SUBJECT-QTR-START                   DTSBE770
01276      OR MSOL-LIAB-DATE > WRK-SUBJECT-QTR-END                      DTSBE770
01277         NEXT SENTENCE                                             DTSBE770
01278      ELSE                                                         DTSBE770
01279         MOVE 'Y' TO WRK-ACTIVE-DURING-PERIOD-IND                  DTSBE770
01280         IF MSOL-LIAB-DATE > WRK-LIAB-DATE                         DTSBE770
01281            MOVE MSOL-LIAB-DATE TO WRK-LIAB-DATE                   DTSBE770
01282            IF MSOL-ESTB-DATE = ZERO                               DTSBE770
01283               MOVE MSOL-LIAB-DATE TO WRK-LIAB-PROCESS-DATE        DTSBE770
01284            ELSE                                                   DTSBE770
01285               IF MSOL-LIAB-DATE > MSOL-ESTB-DATE                  DTSBE770
01286                  MOVE MSOL-CHNG-DATE TO WRK-LIAB-PROCESS-DATE     DTSBE770
01287               ELSE                                                DTSBE770
01288                  MOVE MSOL-ESTB-DATE TO WRK-LIAB-PROCESS-DATE     DTSBE770
01289               END-IF                                              DTSBE770
01290            END-IF                                                 DTSBE770
01291            IF MSOL-INACT-REVERSE-DATE > MSOL-LIAB-DATE            DTSBE770
01292               MOVE MSOL-INACT-REVERSE-DATE TO                     DTSBE770
01293                                         WRK-LIAB-PROCESS-DATE     DTSBE770
01294                                         WRK-REOPEN-PROCESS-DATE   DTSBE770
01295            END-IF                                                 DTSBE770
01296         END-IF                                                    DTSBE770
01297      END-IF.                                                      DTSBE770
01298                                                                   DTSBE770
01299 ***  IF MSOL-INACT-INACTIVE-88                                    DTSBE770
01300 *       IF MSOL-INACT-DATE <= WRK-SUBJECT-QTR-END                 DTSBE770
01301 *          IF MSOL-INACT-DATE > WRK-LAST-INACT-DATE               DTSBE770
01302 *              MOVE MSOL-INACT-DATE TO WRK-LAST-INACT-DATE        DTSBE770
01303 *          END-IF                                                 DTSBE770
01304 *       END-IF                                                    DTSBE770
01305 *       GO TO P1110-EXIT                                          DTSBE770
01306 *    END-IF.                                                      DTSBE770
01307 *                                                                 DTSBE770
01308 *    IF MSOL-INACT-DATE < WRK-SUBJECT-QTR-END                     DTSBE770
01309 *    OR MSOL-LIAB-DATE > WRK-SUBJECT-QTR-END                      DTSBE770
01310 *       NEXT SENTENCE                                             DTSBE770
01311 *    ELSE                                                         DTSBE770
01312 *       MOVE 'Y' TO WRK-ACTIVE-DURING-PERIOD-IND                  DTSBE770
01313 *       IF MSOL-LIAB-DATE > WRK-LIAB-DATE                         DTSBE770
01314 *          MOVE MSOL-LIAB-DATE TO WRK-LIAB-DATE                   DTSBE770
01315 *          IF MSOL-ESTB-DATE = ZERO                               DTSBE770
01316 *             MOVE MSOL-LIAB-DATE TO WRK-LIAB-PROCESS-DATE        DTSBE770
01317 *          ELSE                                                   DTSBE770
01318 *             IF MSOL-LIAB-DATE > MSOL-ESTB-DATE                  DTSBE770
01319 *                MOVE MSOL-CHNG-DATE TO WRK-LIAB-PROCESS-DATE     DTSBE770
01320 *             ELSE                                                DTSBE770
01321 *                MOVE MSOL-ESTB-DATE TO WRK-LIAB-PROCESS-DATE     DTSBE770
01322 *             END-IF                                              DTSBE770
01323 *          END-IF                                                 DTSBE770
01324 *          IF MSOL-INACT-REVERSE-DATE > MSOL-LIAB-DATE            DTSBE770
01325 *             MOVE MSOL-INACT-REVERSE-DATE TO                     DTSBE770
01326 *                                       WRK-LIAB-PROCESS-DATE     DTSBE770
01327 *                                       WRK-REOPEN-PROCESS-DATE   DTSBE770
01328 *          END-IF                                                 DTSBE770
01329 *       END-IF                                                    DTSBE770
01330 ***  END-IF.                                                      DTSBE770
01331                                                                   DTSBE770
01332  P1110-EXIT.                                                      DTSBE770
01333      EXIT.                                                        DTSBE770
01334                                                                   DTSBE770
01335  P1200-WAGES.                                                     DTSBE770
01336      PERFORM                                                      DTSBE770
01337        VARYING WGE-SUB FROM +1 BY +1                              DTSBE770
01338        UNTIL WGE-SUB > +8                                         DTSBE770
01339           MOVE ZERO       TO WRK-QTR-WAGE-AMT (WGE-SUB)           DTSBE770
01340           SET WRK-QTR-NOT-LIAB-88 (WGE-SUB) TO TRUE               DTSBE770
01341      END-PERFORM.                                                 DTSBE770
01342                                                                   DTSBE770
01343      MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSBE770
01344      MOVE MPRF-EMP-NO TO MQTR-EMP-NO.                             DTSBE770
01345      SET MQTR-QTR-88 TO TRUE.                                     DTSBE770
01346 **   MOVE WRK-QTR8     TO MQTR-YRQ.                               DTSBE770
01347      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE770
01348      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE770
01349      PERFORM                                                      DTSBE770
01350        UNTIL L910-NO-REC-88                                       DTSBE770
01351          MOVE MSKL-REC TO MQTR-REC                                DTSBE770
01352          IF MQTR-YRQ > WRK-QTR1                                   DTSBE770
01353             SET L910-NO-REC-88 TO TRUE                            DTSBE770
01354          ELSE                                                     DTSBE770
01355             PERFORM P1210-MOVE-WAGES  THRU P1210-EXIT             DTSBE770
01356             PERFORM S910-READ-NEXT    THRU S910-EXIT              DTSBE770
01357          END-IF                                                   DTSBE770
01358      END-PERFORM.                                                 DTSBE770
01359                                                                   DTSBE770
01360      IF WRK-QTR-WAGE-TOT = ZERO                                   DTSBE770
01361         ADD +1            TO WRK-QTR-WAGE-AMT (1)                 DTSBE770
01362      END-IF.                                                      DTSBE770
01363 **   SET WRK-SCAN-COMPLETE-NO-88 TO TRUE.                         DTSBE770
01364      PERFORM                                                      DTSBE770
01365        VARYING WGE-SUB FROM +1 BY +1                              DTSBE770
01366        UNTIL WGE-SUB > +8                                         DTSBE770
01367           ADD WRK-QTR-WAGE-AMT (WGE-SUB) TO WRK-QTR-WAGE-TOT      DTSBE770
01368                                                                   DTSBE770
01369           IF WRK-QTR-RCVD-88 (WGE-SUB)                            DTSBE770
01370              ADD 1           TO WRK-RPT-RCVD-CNT                  DTSBE770
01371              IF WRK-QTR-WAGE-AMT (WGE-SUB) = ZERO                 DTSBE770
01372                 ADD 1        TO WRK-ZERO-WAGE-CNT                 DTSBE770
01373              END-IF                                               DTSBE770
01374           END-IF                                                  DTSBE770
01375 ***       IF WRK-QTR-RCVD-88 (WGE-SUB)                            DTSBE770
01376 *            ADD 1           TO WRK-LIAB-QTR-CNT                  DTSBE770
01377 *            ADD 1           TO WRK-RPT-RCVD-CNT                  DTSBE770
01378 *            IF WRK-QTR-WAGE-AMT (WGE-SUB) = ZERO                 DTSBE770
01379 *               ADD 1        TO WRK-ZERO-WAGE-CNT                 DTSBE770
01380 *            END-IF                                               DTSBE770
01381 *         ELSE                                                    DTSBE770
01382 *            IF WRK-QTR-NOT-LIAB-88 (WGE-SUB)                     DTSBE770
01383 *               MOVE +0      TO WRK-LIAB-QTR-CNT                  DTSBE770
01384 *            ELSE                                                 DTSBE770
01385 *               IF WRK-QTR-DELINQ-88 (WGE-SUB)                    DTSBE770
01386 *                  ADD 1     TO WRK-LIAB-QTR-CNT                  DTSBE770
01387 *               END-IF                                            DTSBE770
01388 **           END-IF                                               DTSBE770
01389 ***       END-IF                                                  DTSBE770
01390 **        IF WRK-QTR-RCVD-88 (WGE-SUB)                            DTSBE770
01391 *            IF WRK-SCAN-COMPLETE-NO-88                           DTSBE770
01392 *               ADD 1           TO WRK-LIAB-QTR-CNT               DTSBE770
01393 *            END-IF                                               DTSBE770
01394 *            IF WRK-QTR-WAGE-AMT (WGE-SUB) = ZERO                 DTSBE770
01395 *               ADD 1        TO WRK-ZERO-WAGE-CNT                 DTSBE770
01396 *            END-IF                                               DTSBE770
01397 *         ELSE                                                    DTSBE770
01398 *            SET WRK-SCAN-COMPLETE-YES-88 TO TRUE                 DTSBE770
01399 **        END-IF                                                  DTSBE770
01400      END-PERFORM.                                                 DTSBE770
01401                                                                   DTSBE770
01402  P1200-EXIT.                                                      DTSBE770
01403      EXIT.                                                        DTSBE770
01404                                                                   DTSBE770
01405  P1210-MOVE-WAGES.                                                DTSBE770
01406      IF MQTR-YRQ < WRK-QTR8                                       DTSBE770
01407         GO TO P1210-EXIT                                          DTSBE770
01408      END-IF.                                                      DTSBE770
01409                                                                   DTSBE770
01410      IF MQTR-CURR-RCVD-88                                         DTSBE770
01411      OR MQTR-CURR-MISSING-88                                      DTSBE770
01412         ADD 1            TO WRK-LIAB-QTR-CNT                      DTSBE770
01413      ELSE                                                         DTSBE770
01414         IF MQTR-CURR-NOT-LIABLE-88                                DTSBE770
01415            MOVE +0       TO WRK-LIAB-QTR-CNT                      DTSBE770
01416         END-IF                                                    DTSBE770
01417      END-IF.                                                      DTSBE770
01418                                                                   DTSBE770
01419      EVALUATE TRUE                                                DTSBE770
01420        WHEN MQTR-YRQ = WRK-QTR1                                   DTSBE770
01421           IF MQTR-CURR-RCVD-88                                    DTSBE770
01422              MOVE MQTR-TOT-WAGE TO WRK-QTR1-WAGES                 DTSBE770
01423              SET WRK-QTR1-RCVD-88 TO TRUE                         DTSBE770
01424              ADD +1 TO WRK-TOT-RPT-RCVD-CNT                       DTSBE770
01425           ELSE                                                    DTSBE770
01426              IF MQTR-CURR-NOT-LIABLE-88                           DTSBE770
01427                 SET WRK-QTR1-NOT-LIAB-88 TO TRUE                  DTSBE770
01428              ELSE                                                 DTSBE770
01429                 IF MQTR-CURR-MISSING-88                           DTSBE770
01430                    SET WRK-QTR1-DELINQ-88 TO TRUE                 DTSBE770
01431                 END-IF                                            DTSBE770
01432              END-IF                                               DTSBE770
01433           END-IF                                                  DTSBE770
01434                                                                   DTSBE770
01435        WHEN MQTR-YRQ = WRK-QTR2                                   DTSBE770
01436           IF MQTR-CURR-RCVD-88                                    DTSBE770
01437              MOVE MQTR-TOT-WAGE TO WRK-QTR2-WAGES                 DTSBE770
01438              SET WRK-QTR2-RCVD-88 TO TRUE                         DTSBE770
01439           ELSE                                                    DTSBE770
01440              IF MQTR-CURR-NOT-LIABLE-88                           DTSBE770
01441                 SET WRK-QTR2-NOT-LIAB-88 TO TRUE                  DTSBE770
01442              ELSE                                                 DTSBE770
01443                 IF MQTR-CURR-MISSING-88                           DTSBE770
01444                    SET WRK-QTR2-DELINQ-88 TO TRUE                 DTSBE770
01445                 END-IF                                            DTSBE770
01446              END-IF                                               DTSBE770
01447           END-IF                                                  DTSBE770
01448                                                                   DTSBE770
01449        WHEN MQTR-YRQ = WRK-QTR3                                   DTSBE770
01450           IF MQTR-CURR-RCVD-88                                    DTSBE770
01451              MOVE MQTR-TOT-WAGE TO WRK-QTR3-WAGES                 DTSBE770
01452              SET WRK-QTR3-RCVD-88 TO TRUE                         DTSBE770
01453           ELSE                                                    DTSBE770
01454              IF MQTR-CURR-NOT-LIABLE-88                           DTSBE770
01455                 SET WRK-QTR3-NOT-LIAB-88 TO TRUE                  DTSBE770
01456              ELSE                                                 DTSBE770
01457                 IF MQTR-CURR-MISSING-88                           DTSBE770
01458                    SET WRK-QTR3-DELINQ-88 TO TRUE                 DTSBE770
01459                 END-IF                                            DTSBE770
01460              END-IF                                               DTSBE770
01461           END-IF                                                  DTSBE770
01462                                                                   DTSBE770
01463        WHEN MQTR-YRQ = WRK-QTR4                                   DTSBE770
01464           IF MQTR-CURR-RCVD-88                                    DTSBE770
01465              MOVE MQTR-TOT-WAGE TO WRK-QTR4-WAGES                 DTSBE770
01466              SET WRK-QTR4-RCVD-88 TO TRUE                         DTSBE770
01467           ELSE                                                    DTSBE770
01468              IF MQTR-CURR-NOT-LIABLE-88                           DTSBE770
01469                 SET WRK-QTR4-NOT-LIAB-88 TO TRUE                  DTSBE770
01470              ELSE                                                 DTSBE770
01471                 IF MQTR-CURR-MISSING-88                           DTSBE770
01472                    SET WRK-QTR4-DELINQ-88 TO TRUE                 DTSBE770
01473                 END-IF                                            DTSBE770
01474              END-IF                                               DTSBE770
01475           END-IF                                                  DTSBE770
01476                                                                   DTSBE770
01477        WHEN MQTR-YRQ = WRK-QTR5                                   DTSBE770
01478           IF MQTR-CURR-RCVD-88                                    DTSBE770
01479              MOVE MQTR-TOT-WAGE TO WRK-QTR5-WAGES                 DTSBE770
01480              SET WRK-QTR5-RCVD-88 TO TRUE                         DTSBE770
01481           ELSE                                                    DTSBE770
01482              IF MQTR-CURR-NOT-LIABLE-88                           DTSBE770
01483                 SET WRK-QTR5-NOT-LIAB-88 TO TRUE                  DTSBE770
01484              ELSE                                                 DTSBE770
01485                 IF MQTR-CURR-MISSING-88                           DTSBE770
01486                    SET WRK-QTR5-DELINQ-88 TO TRUE                 DTSBE770
01487                 END-IF                                            DTSBE770
01488              END-IF                                               DTSBE770
01489           END-IF                                                  DTSBE770
01490                                                                   DTSBE770
01491        WHEN MQTR-YRQ = WRK-QTR6                                   DTSBE770
01492           IF MQTR-CURR-RCVD-88                                    DTSBE770
01493              MOVE MQTR-TOT-WAGE TO WRK-QTR6-WAGES                 DTSBE770
01494              SET WRK-QTR6-RCVD-88 TO TRUE                         DTSBE770
01495           ELSE                                                    DTSBE770
01496              IF MQTR-CURR-NOT-LIABLE-88                           DTSBE770
01497                 SET WRK-QTR6-NOT-LIAB-88 TO TRUE                  DTSBE770
01498              ELSE                                                 DTSBE770
01499                 IF MQTR-CURR-MISSING-88                           DTSBE770
01500                    SET WRK-QTR6-DELINQ-88 TO TRUE                 DTSBE770
01501                 END-IF                                            DTSBE770
01502              END-IF                                               DTSBE770
01503           END-IF                                                  DTSBE770
01504                                                                   DTSBE770
01505        WHEN MQTR-YRQ = WRK-QTR7                                   DTSBE770
01506           IF MQTR-CURR-RCVD-88                                    DTSBE770
01507              MOVE MQTR-TOT-WAGE TO WRK-QTR7-WAGES                 DTSBE770
01508              SET WRK-QTR7-RCVD-88 TO TRUE                         DTSBE770
01509           ELSE                                                    DTSBE770
01510              IF MQTR-CURR-NOT-LIABLE-88                           DTSBE770
01511                 SET WRK-QTR7-NOT-LIAB-88 TO TRUE                  DTSBE770
01512              ELSE                                                 DTSBE770
01513                 IF MQTR-CURR-MISSING-88                           DTSBE770
01514                    SET WRK-QTR7-DELINQ-88 TO TRUE                 DTSBE770
01515                 END-IF                                            DTSBE770
01516              END-IF                                               DTSBE770
01517           END-IF                                                  DTSBE770
01518                                                                   DTSBE770
01519        WHEN MQTR-YRQ = WRK-QTR8                                   DTSBE770
01520           IF MQTR-CURR-RCVD-88                                    DTSBE770
01521              MOVE MQTR-TOT-WAGE TO WRK-QTR8-WAGES                 DTSBE770
01522              SET WRK-QTR8-RCVD-88 TO TRUE                         DTSBE770
01523           ELSE                                                    DTSBE770
01524              IF MQTR-CURR-NOT-LIABLE-88                           DTSBE770
01525                 SET WRK-QTR8-NOT-LIAB-88 TO TRUE                  DTSBE770
01526              ELSE                                                 DTSBE770
01527                 IF MQTR-CURR-MISSING-88                           DTSBE770
01528                    SET WRK-QTR8-DELINQ-88 TO TRUE                 DTSBE770
01529                 END-IF                                            DTSBE770
01530              END-IF                                               DTSBE770
01531           END-IF                                                  DTSBE770
01532                                                                   DTSBE770
01533      END-EVALUATE.                                                DTSBE770
01534                                                                   DTSBE770
01535 **     WHEN MQTR-YRQ = WRK-QTR1                                   DTSBE770
01536 *         IF MQTR-CURR-RCVD-88                                    DTSBE770
01537 *            MOVE MQTR-TOT-WAGE TO WRK-QTR1-WAGES                 DTSBE770
01538 *            SET WRK-QTR1-STATUS-RCVD-88 TO TRUE                  DTSBE770
01539 *         END-IF                                                  DTSBE770
01540 *                                                                 DTSBE770
01541 *      WHEN MQTR-YRQ = WRK-QTR2                                   DTSBE770
01542 *         IF MQTR-CURR-RCVD-88                                    DTSBE770
01543 *            MOVE MQTR-TOT-WAGE TO WRK-QTR2-WAGES                 DTSBE770
01544 *            SET WRK-QTR2-STATUS-RCVD-88 TO TRUE                  DTSBE770
01545 *         END-IF                                                  DTSBE770
01546 *                                                                 DTSBE770
01547 *      WHEN MQTR-YRQ = WRK-QTR3                                   DTSBE770
01548 *         IF MQTR-CURR-RCVD-88                                    DTSBE770
01549 *            MOVE MQTR-TOT-WAGE TO WRK-QTR3-WAGES                 DTSBE770
01550 *            SET WRK-QTR3-STATUS-RCVD-88 TO TRUE                  DTSBE770
01551 *         END-IF                                                  DTSBE770
01552 *                                                                 DTSBE770
01553 *      WHEN MQTR-YRQ = WRK-QTR4                                   DTSBE770
01554 *         IF MQTR-CURR-RCVD-88                                    DTSBE770
01555 *            MOVE MQTR-TOT-WAGE TO WRK-QTR4-WAGES                 DTSBE770
01556 *            SET WRK-QTR4-STATUS-RCVD-88 TO TRUE                  DTSBE770
01557 *         END-IF                                                  DTSBE770
01558 *                                                                 DTSBE770
01559 *      WHEN MQTR-YRQ = WRK-QTR5                                   DTSBE770
01560 *         IF MQTR-CURR-RCVD-88                                    DTSBE770
01561 *            MOVE MQTR-TOT-WAGE TO WRK-QTR5-WAGES                 DTSBE770
01562 *            SET WRK-QTR5-STATUS-RCVD-88 TO TRUE                  DTSBE770
01563 *         END-IF                                                  DTSBE770
01564 *                                                                 DTSBE770
01565 *      WHEN MQTR-YRQ = WRK-QTR6                                   DTSBE770
01566 *         IF MQTR-CURR-RCVD-88                                    DTSBE770
01567 *            MOVE MQTR-TOT-WAGE TO WRK-QTR6-WAGES                 DTSBE770
01568 *            SET WRK-QTR6-STATUS-RCVD-88 TO TRUE                  DTSBE770
01569 *         END-IF                                                  DTSBE770
01570 *                                                                 DTSBE770
01571 *      WHEN MQTR-YRQ = WRK-QTR7                                   DTSBE770
01572 *         IF MQTR-CURR-RCVD-88                                    DTSBE770
01573 *            MOVE MQTR-TOT-WAGE TO WRK-QTR7-WAGES                 DTSBE770
01574 *            SET WRK-QTR7-STATUS-RCVD-88 TO TRUE                  DTSBE770
01575 *         END-IF                                                  DTSBE770
01576 *                                                                 DTSBE770
01577 *      WHEN MQTR-YRQ = WRK-QTR8                                   DTSBE770
01578 *         IF MQTR-CURR-RCVD-88                                    DTSBE770
01579 *            MOVE MQTR-TOT-WAGE TO WRK-QTR8-WAGES                 DTSBE770
01580 *            SET WRK-QTR8-STATUS-RCVD-88 TO TRUE                  DTSBE770
01581 *         END-IF                                                  DTSBE770
01582 *                                                                 DTSBE770
01583 **   END-EVALUATE.                                                DTSBE770
01584                                                                   DTSBE770
01585  P1210-EXIT.                                                      DTSBE770
01586      EXIT.                                                        DTSBE770
01587                                                                   DTSBE770
01588  P1400-WRITE-Y771.                                                DTSBE770
01589      MOVE LENGTH OF Y771-REC TO Y771-LENGTH.                      DTSBE770
01590      SET Y771-REC-TYPE-771-88 TO TRUE.                            DTSBE770
01591                                                                   DTSBE770
01592      ADD +1            TO WRK-Y771-CNT.                           DTSBE770
01593                                                                   DTSBE770
01594      MOVE MPRF-EMP-NO  TO Y771-EMP-NO.                            DTSBE770
01595      SET Y771-STATUS-ACTIVE-88 TO TRUE.                           DTSBE770
01596                                                                   DTSBE770
01597      IF MPRF-CLASS-RATED-88                                       DTSBE770
01598         SET Y771-CLASS-RATED-88          TO TRUE                  DTSBE770
01599      ELSE                                                         DTSBE770
01600         IF MPRF-CLASS-SELF-INS-88                                 DTSBE770
01601            SET Y771-CLASS-SELF-INS-88       TO TRUE               DTSBE770
01602         ELSE                                                      DTSBE770
01603            DISPLAY 'INVALID EMPLOYER CLASS ' MPRF-EMP-NO          DTSBE770
01604               '  CLASS: ' MPRF-EMP-CLASS                          DTSBE770
01605            GO TO P1400-EXIT.                                      DTSBE770
01606                                                                   DTSBE770
01607      IF WRK-LIAB-PROCESS-DATE = ZERO                              DTSBE770
01608         MOVE WRK-LIAB-DATE TO WRK-LIAB-PROCESS-DATE.              DTSBE770
01609                                                                   DTSBE770
01610 ***************************************************************** DTSBE770
01611 *  EDIT TO CORRECT LIABILITY DETERMINATIONS ENTERED WITH FUTURE   DTSBE770
01612 *  LIABILITY DATES.                                               DTSBE770
01613 **********************                                            DTSBE770
01614      IF WRK-LIAB-DATE > WRK-LIAB-PROCESS-DATE                     DTSBE770
01615         ADD +1 TO WRK-CNT1                                        DTSBE770
01616         MOVE WRK-LIAB-DATE TO WRK-LIAB-PROCESS-DATE.              DTSBE770
01617                                                                   DTSBE770
01618      IF WRK-REOPEN-PROCESS-DATE > ZERO                            DTSBE770
01619         IF WRK-LIAB-DATE > WRK-REOPEN-PROCESS-DATE                DTSBE770
01620            ADD +1 TO WRK-CNT2                                     DTSBE770
01621            MOVE WRK-LIAB-DATE TO WRK-REOPEN-PROCESS-DATE.         DTSBE770
01622 **********************                                            DTSBE770
01623                                                                   DTSBE770
01624      MOVE WRK-REOPEN-PROCESS-DATE                                 DTSBE770
01625                                TO Y771-REOPEN-PROCESS-DATE        DTSBE770
01626      MOVE WRK-LIAB-PROCESS-DATE                                   DTSBE770
01627                                TO Y771-PROCESS-DATE.              DTSBE770
01628                                                                   DTSBE770
01629      MOVE WRK-LIAB-DATE        TO Y771-LIAB-DATE.                 DTSBE770
01630                                                                   DTSBE770
01631 **** MOVE WRK-REOPEN-DATE      TO Y771-REOPEN-DATE.               DTSBE770
01632                                                                   DTSBE770
01633                                                                   DTSBE770
01634 *    IF WRK-REOPEN-PROCESS-DATE = ZERO                            DTSBE770
01635 *       MOVE WRK-REOPEN-DATE TO WRK-REOPEN-PROCESS-DATE.          DTSBE770
01636                                                                   DTSBE770
01637 *    IF WRK-REOPEN-DATE NOT = WRK-LIAB-DATE                       DTSBE770
01638 *       IF WRK-REOPEN-PROCESS-DATE < WRK-REOPEN-DATE              DTSBE770
01639 *          MOVE WRK-REOPEN-DATE                                   DTSBE770
01640 *                              TO Y771-PROCESS-DATE               DTSBE770
01641 *       ELSE                                                      DTSBE770
01642 *          MOVE WRK-REOPEN-PROCESS-DATE                           DTSBE770
01643 *                              TO Y771-PROCESS-DATE               DTSBE770
01644 *       END-IF                                                    DTSBE770
01645 *    ELSE                                                         DTSBE770
01646 *       IF WRK-LIAB-PROCESS-DATE < WRK-LIAB-DATE                  DTSBE770
01647 *          MOVE WRK-LIAB-DATE                                     DTSBE770
01648 *                              TO Y771-PROCESS-DATE               DTSBE770
01649 *       ELSE                                                      DTSBE770
01650 *          MOVE WRK-LIAB-PROCESS-DATE                             DTSBE770
01651 *                              TO Y771-PROCESS-DATE               DTSBE770
01652 *       END-IF                                                    DTSBE770
01653 *    END-IF.                                                      DTSBE770
01654                                                                   DTSBE770
01655      MOVE WRK-LAST-INACT-DATE  TO Y771-INACTIVE-DATE.             DTSBE770
01656                                                                   DTSBE770
01657      IF WRK-LIAB-QTR-CNT > +8                                     DTSBE770
01658         MOVE 8                 TO Y771-LIAB-QTR-CNT               DTSBE770
01659      ELSE                                                         DTSBE770
01660         MOVE WRK-LIAB-QTR-CNT  TO Y771-LIAB-QTR-CNT.              DTSBE770
01661                                                                   DTSBE770
01662      MOVE WRK-QTR1-WAGES       TO Y771-QTR1-WAGES.                DTSBE770
01663      MOVE WRK-QTR2-WAGES       TO Y771-QTR2-WAGES.                DTSBE770
01664      MOVE WRK-QTR3-WAGES       TO Y771-QTR3-WAGES.                DTSBE770
01665      MOVE WRK-QTR4-WAGES       TO Y771-QTR4-WAGES.                DTSBE770
01666      MOVE WRK-QTR5-WAGES       TO Y771-QTR5-WAGES.                DTSBE770
01667      MOVE WRK-QTR6-WAGES       TO Y771-QTR6-WAGES.                DTSBE770
01668      MOVE WRK-QTR7-WAGES       TO Y771-QTR7-WAGES.                DTSBE770
01669      MOVE WRK-QTR8-WAGES       TO Y771-QTR8-WAGES.                DTSBE770
01670                                                                   DTSBE770
01671      PERFORM S771-WRITE-R771 THRU S771-EXIT.                      DTSBE770
01672                                                                   DTSBE770
01673                                                                   DTSBE770
01674  P1400-EXIT.                                                      DTSBE770
01675      EXIT.                                                        DTSBE770
01676                                                                   DTSBE770
01677  P2000-REPORT-FILING.                                             DTSBE770
01678      SET WRK-SELECT-NO-88          TO TRUE.                       DTSBE770
01679      SET WRK-ANN-DEFAULT-NO-88 TO TRUE.                           DTSBE770
01680      SET WRK-ANN-RESOLVED-NO-88 TO TRUE.                          DTSBE770
01681      SET WRK-MSOL-LIAB-CHNG-NO-88  TO TRUE.                       DTSBE770
01682      SET WRK-MSOL-INACT-CHNG-NO-88 TO TRUE.                       DTSBE770
01683      SET WRK-MSOL-WITHDRAWN-NO-88  TO TRUE.                       DTSBE770
01684                                                                   DTSBE770
01685      MOVE ZERO           TO WRK-P2310-LIAB-DATE                   DTSBE770
01686                             WRK-P2411-LIAB-DATE                   DTSBE770
01687                             WRK-P2411-INACT-DATE                  DTSBE770
01688                             WRK-P2411-INACT-ENTER-DATE            DTSBE770
01689                             WRK-P2412-LIAB-DATE                   DTSBE770
01690                             WRK-P2412-INACT-DATE                  DTSBE770
01691                             WRK-P2412-INACT-ENTER-DATE            DTSBE770
01692                             WRK-P2413-LIAB-DATE                   DTSBE770
01693                             WRK-ORIG-RPT-RCVD-DATE                DTSBE770
01694                             WRK-ESTIM-RPT-RCVD-DATE.              DTSBE770
01695                                                                   DTSBE770
01696      MOVE WRK-QTR2           TO WRK-QTR.                          DTSBE770
01697      MOVE WRK-QTR2-START     TO WRK-QTR-START.                    DTSBE770
01698      MOVE WRK-QTR2-END       TO WRK-QTR-END.                      DTSBE770
01699      SET L410-NULL-SCHED-88  TO TRUE.                             DTSBE770
01700      PERFORM P2100-SELECT-EMP  THRU P2100-EXIT.                   DTSBE770
01701                                                                   DTSBE770
01702      EVALUATE TRUE                                                DTSBE770
01703         WHEN (WRK-SELECT-RCVD-88                                  DTSBE770
01704         OR    WRK-SELECT-ESTIM-88)                                DTSBE770
01705            PERFORM P2200-GET-RPT-DATES  THRU P2200-EXIT           DTSBE770
01706            PERFORM P2300-LIAB-DATE      THRU P2300-EXIT           DTSBE770
01707            PERFORM P2500-BUILD-Y772     THRU P2500-EXIT           DTSBE770
01708                                                                   DTSBE770
01709         WHEN WRK-SELECT-MISSING-88                                DTSBE770
01710            PERFORM P2400-MSOL-CHANGE    THRU P2400-EXIT           DTSBE770
01711            IF WRK-SELECT-MISSING-88                               DTSBE770
01712               ADD +1 TO WRK-MISSING-CNT                           DTSBE770
01713            ELSE                                                   DTSBE770
01714               PERFORM P2500-BUILD-Y772  THRU P2500-EXIT           DTSBE770
01715            END-IF                                                 DTSBE770
01716                                                                   DTSBE770
01717      END-EVALUATE.                                                DTSBE770
01718                                                                   DTSBE770
01719      IF WRK-SELECT-NO-88                                          DTSBE770
01720         ADD +1 TO WRK-NOT-SELECTED-CNT.                           DTSBE770
01721                                                                   DTSBE770
01722      MOVE WRK-QTR1           TO WRK-QTR.                          DTSBE770
01723      MOVE WRK-QTR1-START     TO WRK-QTR-START.                    DTSBE770
01724      MOVE WRK-QTR1-END       TO WRK-QTR-END.                      DTSBE770
01725      PERFORM P2600-ETA581-ONLY       THRU P2600-EXIT.             DTSBE770
01726      IF WRK-SELECT-581-ONLY-88                                    DTSBE770
01727         ADD +1 TO WRK-SELECT-581-CNT                              DTSBE770
01728         PERFORM P2200-GET-RPT-DATES  THRU P2200-EXIT              DTSBE770
01729         PERFORM P2500-BUILD-Y772     THRU P2500-EXIT              DTSBE770
01730      END-IF.                                                      DTSBE770
01731                                                                   DTSBE770
01732                                                                   DTSBE770
01733  P2000-EXIT.                                                      DTSBE770
01734      EXIT.                                                        DTSBE770
01735                                                                   DTSBE770
01736  P2100-SELECT-EMP.                                                DTSBE770
01737      SET WRK-ANN-RPT-RCVD-NO-88 TO TRUE.                          DTSBE770
01738      SET WRK-ANN-RPT-ESTIM-NO-88 TO TRUE.                         DTSBE770
01739      SET WRK-ANN-RPT-MISSING-NO-88 TO TRUE.                       DTSBE770
01740                                                                   DTSBE770
01741      IF MPRF-ORG-HSEHLD-DMSTIC-88                                 DTSBE770
01742         SET L410-MODE-INPUT-YRQ-88 TO TRUE                        DTSBE770
01743         MOVE MPRF-EMP-NO           TO L410-EMP-NO                 DTSBE770
01744         MOVE WRK-QTR               TO L410-YRQ                    DTSBE770
01745         PERFORM S410-FILE-SCHED    THRU S410-EXIT                 DTSBE770
01746         IF L410-ANN-SCHED-88                                      DTSBE770
01747            ADD +1 TO WRK-ANN-FILER-CNT                            DTSBE770
01748            PERFORM P2122-ANN-DEFAULT  THRU P2122-EXIT             DTSBE770
01749 ***        PERFORM P2120-ANNUAL    THRU P2120-EXIT                DTSBE770
01750         ELSE                                                      DTSBE770
01751            PERFORM P2110-QTRLY     THRU P2110-EXIT                DTSBE770
01752         END-IF                                                    DTSBE770
01753      ELSE                                                         DTSBE770
01754         PERFORM P2110-QTRLY        THRU P2110-EXIT                DTSBE770
01755      END-IF.                                                      DTSBE770
01756                                                                   DTSBE770
01757 ***  ANNUAL FILERS NOT COUNTED FOR THE RESOLVED QUARTER.          DTSBE770
01758 ***  THEY ARE COUNTED ONLY DURING THE SECURED QUARTER.            DTSBE770
01759 **   IF MPRF-ORG-HSEHLD-DMSTIC-88                                 DTSBE770
01760 *       SET L410-MODE-INPUT-YRQ-88 TO TRUE                        DTSBE770
01761 *       MOVE MPRF-EMP-NO           TO L410-EMP-NO                 DTSBE770
01762 *       MOVE WRK-FIRST-ANN-QTR     TO L410-YRQ                    DTSBE770
01763 *       PERFORM S410-FILE-SCHED    THRU S410-EXIT                 DTSBE770
01764 *       IF L410-ANN-SCHED-88                                      DTSBE770
01765 *          ADD +1 TO WRK-ANN-FILER-CNT                            DTSBE770
01766 *          PERFORM P2120-ANNUAL    THRU P2120-EXIT                DTSBE770
01767 *       ELSE                                                      DTSBE770
01768 *          PERFORM P2110-QTRLY     THRU P2110-EXIT                DTSBE770
01769 *       END-IF                                                    DTSBE770
01770 *    ELSE                                                         DTSBE770
01771 *       PERFORM P2110-QTRLY        THRU P2110-EXIT                DTSBE770
01772 **   END-IF.                                                      DTSBE770
01773                                                                   DTSBE770
01774  P2100-EXIT.                                                      DTSBE770
01775      EXIT.                                                        DTSBE770
01776                                                                   DTSBE770
01777  P2110-QTRLY.                                                     DTSBE770
01778      MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSBE770
01779      MOVE MPRF-EMP-NO TO MQTR-EMP-NO.                             DTSBE770
01780      SET MQTR-QTR-88 TO TRUE.                                     DTSBE770
01781      MOVE WRK-QTR            TO MQTR-YRQ.                         DTSBE770
01782      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE770
01783      PERFORM S910-READ THRU S910-EXIT.                            DTSBE770
01784      IF L910-NO-REC-88                                            DTSBE770
01785          GO TO P2110-EXIT.                                        DTSBE770
01786                                                                   DTSBE770
01787      MOVE MSKL-REC TO MQTR-REC.                                   DTSBE770
01788                                                                   DTSBE770
01789      IF MQTR-CURR-RCVD-88                                         DTSBE770
01790         SET WRK-SELECT-RCVD-88 TO TRUE                            DTSBE770
01791         ADD +1 TO WRK-P2100-QTR-CNT                               DTSBE770
01792      ELSE                                                         DTSBE770
01793         IF  MQTR-CURR-ESTIM-88                                    DTSBE770
01794            SET WRK-SELECT-ESTIM-88 TO TRUE                        DTSBE770
01795         ELSE                                                      DTSBE770
01796            IF (MQTR-CURR-NOT-LIABLE-88                            DTSBE770
01797              AND (MQTR-MISS-NO-LTR-ADDR-88                        DTSBE770
01798              OR   MQTR-MISS-NO-LTR-OTHER-88                       DTSBE770
01799              OR   MQTR-MISS-LETTER-SENT-88                        DTSBE770
01800              OR   MQTR-MISS-TIMELY-88                             DTSBE770
01801              OR   MQTR-MISS-UNTIMELY-88))                         DTSBE770
01802                 SET WRK-SELECT-MISSING-88 TO TRUE.                DTSBE770
01803                                                                   DTSBE770
01804  P2110-EXIT.                                                      DTSBE770
01805      EXIT.                                                        DTSBE770
01806                                                                   DTSBE770
01807 *P2120-ANNUAL.                                                    DTSBE770
01808 *    IF WRK-RPT-QTR-Q = 2                                         DTSBE770
01809 *       NEXT SENTENCE                                             DTSBE770
01810 *    ELSE                                                         DTSBE770
01811 *       PERFORM P2122-ANN-DEFAULT  THRU P2122-EXIT                DTSBE770
01812 *       GO TO P2120-EXIT.                                         DTSBE770
01813 *                                                                 DTSBE770
01814 *    MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSBE770
01815 *    MOVE MPRF-EMP-NO TO MQTR-EMP-NO.                             DTSBE770
01816 *    SET MQTR-QTR-88 TO TRUE.                                     DTSBE770
01817 *    MOVE WRK-FIRST-ANN-QTR  TO MQTR-YRQ.                         DTSBE770
01818 *    MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE770
01819 *    PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE770
01820 *    IF L910-NO-REC-88                                            DTSBE770
01821 *       NEXT SENTENCE                                             DTSBE770
01822 *    ELSE                                                         DTSBE770
01823 *       PERFORM P2121-ANALYZE      THRU P2121-EXIT                DTSBE770
01824 *    END-IF.                                                      DTSBE770
01825 *                                                                 DTSBE770
01826 **   IF L910-NO-REC-88                                            DTSBE770
01827 *       NEXT SENTENCE                                             DTSBE770
01828 *    ELSE                                                         DTSBE770
01829 *       PERFORM P2121-SCAN-QTR  THRU P2121-EXIT                   DTSBE770
01830 *          UNTIL L910-NO-REC-88                                   DTSBE770
01831 *          OR MQTR-YRQ > WRK-LAST-ANN-QTR                         DTSBE770
01832 **   END-IF.                                                      DTSBE770
01833 *                                                                 DTSBE770
01834 *    IF WRK-ANN-RPT-RCVD-YES-88                                   DTSBE770
01835 *       ADD +1 TO WRK-P2100-CNT                                   DTSBE770
01836 *       ADD +1 TO WRK-P2100-RCVD-CNT                              DTSBE770
01837 *       SET WRK-SELECT-RCVD-88 TO TRUE                            DTSBE770
01838 *    END-IF.                                                      DTSBE770
01839 *                                                                 DTSBE770
01840 **      SET WRK-ANN-RESOLVED-YES-88 TO TRUE                       DTSBE770
01841 *    ELSE                                                         DTSBE770
01842 *       IF WRK-ANN-RPT-ESTIM-YES-88                               DTSBE770
01843 *          ADD +1 TO WRK-P2100-CNT                                DTSBE770
01844 *          SET WRK-SELECT-ESTIM-88 TO TRUE                        DTSBE770
01845 *          SET WRK-ANN-RESOLVED-YES-88 TO TRUE                    DTSBE770
01846 *       ELSE                                                      DTSBE770
01847 *          IF WRK-ANN-RPT-MISSING-YES-88                          DTSBE770
01848 *             ADD +1 TO WRK-P2100-CNT                             DTSBE770
01849 *             ADD +1 TO WRK-P2100-MISS-CNT                        DTSBE770
01850 *             SET WRK-SELECT-MISSING-88 TO TRUE                   DTSBE770
01851 *             SET WRK-ANN-RESOLVED-YES-88 TO TRUE.                DTSBE770
01852 **                                                                DTSBE770
01853 *P2120-EXIT.                                                      DTSBE770
01854 *    EXIT.                                                        DTSBE770
01855 *                                                                 DTSBE770
01856 *P2121-ANALYZE.                                                   DTSBE770
01857 *    MOVE MSKL-REC TO MQTR-REC                                    DTSBE770
01858 *                                                                 DTSBE770
01859 *    IF MQTR-YRQ < WRK-FIRST-ANN-QTR                              DTSBE770
01860 *    OR MQTR-YRQ > WRK-LAST-ANN-QTR                               DTSBE770
01861 *       DISPLAY 'P2121 NO ANN MQTR ' MPRF-EMP-NO                  DTSBE770
01862 *       GO TO P2121-EXIT                                          DTSBE770
01863 *    END-IF.                                                      DTSBE770
01864 *                                                                 DTSBE770
01865 *    IF MQTR-CURR-RCVD-88                                         DTSBE770
01866 *    OR MQTR-CURR-ORIG-ANN-NL-88                                  DTSBE770
01867 *       SET WRK-ANN-RPT-RCVD-YES-88 TO TRUE                       DTSBE770
01868 **   ELSE                                                         DTSBE770
01869 *       IF  MQTR-CURR-ESTIM-88                                    DTSBE770
01870 *          SET WRK-ANN-RPT-ESTIM-YES-88 TO TRUE                   DTSBE770
01871 *       ELSE                                                      DTSBE770
01872 *          IF (MQTR-CURR-NOT-LIABLE-88                            DTSBE770
01873 *          AND (MQTR-MISS-NO-LTR-ADDR-88                          DTSBE770
01874 *          OR   MQTR-MISS-NO-LTR-OTHER-88                         DTSBE770
01875 *          OR   MQTR-MISS-LETTER-SENT-88))                        DTSBE770
01876 *             SET WRK-ANN-RPT-MISSING-YES-88 TO TRUE              DTSBE770
01877 *          END-IF                                                 DTSBE770
01878 **      END-IF                                                    DTSBE770
01879 *    END-IF.                                                      DTSBE770
01880 *                                                                 DTSBE770
01881 *P2121-EXIT.                                                      DTSBE770
01882 *    EXIT.                                                        DTSBE770
01883                                                                   DTSBE770
01884 *P2121-SCAN-QTR.                                                  DTSBE770
01885 *    MOVE MSKL-REC TO MQTR-REC                                    DTSBE770
01886 *                                                                 DTSBE770
01887 *    IF MQTR-CURR-RCVD-88                                         DTSBE770
01888 *       SET WRK-ANN-RPT-RCVD-YES-88 TO TRUE                       DTSBE770
01889 *    ELSE                                                         DTSBE770
01890 *       IF  MQTR-CURR-ESTIM-88                                    DTSBE770
01891 *          SET WRK-ANN-RPT-ESTIM-YES-88 TO TRUE                   DTSBE770
01892 *       ELSE                                                      DTSBE770
01893 *          IF (MQTR-CURR-NOT-LIABLE-88                            DTSBE770
01894 *          AND (MQTR-MISS-NO-LTR-ADDR-88                          DTSBE770
01895 *          OR   MQTR-MISS-NO-LTR-OTHER-88                         DTSBE770
01896 *          OR   MQTR-MISS-LETTER-SENT-88))                        DTSBE770
01897 *             SET WRK-ANN-RPT-MISSING-YES-88 TO TRUE              DTSBE770
01898 *          END-IF                                                 DTSBE770
01899 *       END-IF                                                    DTSBE770
01900 *    END-IF.                                                      DTSBE770
01901 *                                                                 DTSBE770
01902 *    PERFORM S910-READ-NEXT  THRU S910-EXIT.                      DTSBE770
01903 *                                                                 DTSBE770
01904 *P2121-EXIT.                                                      DTSBE770
01905 *    EXIT.                                                        DTSBE770
01906                                                                   DTSBE770
01907  P2122-ANN-DEFAULT.                                               DTSBE770
01908 **   DISPLAY 'P2122 ANN DEFAULT ' MPRF-EMP-NO                     DTSBE770
01909 **     '  WRK-QTR ' WRK-QTR.                                      DTSBE770
01910                                                                   DTSBE770
01911      MOVE 'N' TO WRK-ACTIVE-DURING-PERIOD-IND.                    DTSBE770
01912      MOVE LOW-VALUES            TO MSOL-KEY-AREA.                 DTSBE770
01913      MOVE MPRF-EMP-NO           TO MSOL-EMP-NO.                   DTSBE770
01914      SET MSOL-SOL-88            TO TRUE.                          DTSBE770
01915      MOVE MSOL-KEY-AREA         TO MSKL-KEY-AREA.                 DTSBE770
01916      PERFORM S910-START-BROWSE  THRU S910-EXIT.                   DTSBE770
01917      PERFORM UNTIL L910-NO-REC-88                                 DTSBE770
01918         MOVE MSKL-REC           TO MSOL-REC                       DTSBE770
01919         IF MSOL-INACT-WITHDRAWN-88                                DTSBE770
01920            MOVE 'N' TO WRK-ACTIVE-DURING-PERIOD-IND               DTSBE770
01921         ELSE                                                      DTSBE770
01922            IF MSOL-INACT-DATE < WRK-SUBJECT-QTR-START             DTSBE770
01923            OR MSOL-LIAB-DATE > WRK-SUBJECT-QTR-END                DTSBE770
01924               NEXT SENTENCE                                       DTSBE770
01925            ELSE                                                   DTSBE770
01926               MOVE 'Y' TO WRK-ACTIVE-DURING-PERIOD-IND            DTSBE770
01927            END-IF                                                 DTSBE770
01928         END-IF                                                    DTSBE770
01929         PERFORM S910-READ-NEXT  THRU S910-EXIT                    DTSBE770
01930      END-PERFORM.                                                 DTSBE770
01931 *    MOVE 'N' TO WRK-ACTIVE-DURING-PERIOD-IND.                    DTSBE770
01932 *    MOVE LOW-VALUES  TO MSOL-KEY-AREA.                           DTSBE770
01933 *    MOVE MPRF-EMP-NO TO MSOL-EMP-NO.                             DTSBE770
01934 *    SET MSOL-SOL-88 TO TRUE.                                     DTSBE770
01935 *    MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE770
01936 *    PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE770
01937 *    PERFORM UNTIL L910-NO-REC-88                                 DTSBE770
01938 *       MOVE MSKL-REC TO MSOL-REC                                 DTSBE770
01939 *       IF MSOL-INACT-WITHDRAWN-88                                DTSBE770
01940 *          MOVE 'N' TO WRK-ACTIVE-DURING-PERIOD-IND               DTSBE770
01941 *       ELSE                                                      DTSBE770
01942 **         DISPLAY 'MSOL FIRST ' MSOL-FIRST-LIAB-YRQ              DTSBE770
01943 **           '  LAST ' MSOL-LAST-LIAB-YRQ                         DTSBE770
01944 *          IF MSOL-LAST-LIAB-YRQ < WRK-QTR                        DTSBE770
01945 *          OR MSOL-FIRST-LIAB-YRQ > WRK-QTR                       DTSBE770
01946 *             NEXT SENTENCE                                       DTSBE770
01947 *          ELSE                                                   DTSBE770
01948 *             MOVE 'Y' TO WRK-ACTIVE-DURING-PERIOD-IND            DTSBE770
01949 *          END-IF                                                 DTSBE770
01950 *       END-IF                                                    DTSBE770
01951 *       PERFORM S910-READ-NEXT THRU S910-EXIT                     DTSBE770
01952 *    END-PERFORM.                                                 DTSBE770
01953                                                                   DTSBE770
01954 **   DISPLAY 'P2122 - 2 ' MPRF-EMP-NO                             DTSBE770
01955 **     '  ' WRK-ACTIVE-DURING-PERIOD-IND                          DTSBE770
01956      IF WRK-ACTIVE-DURING-PERIOD-IND = 'N'                        DTSBE770
01957          NEXT SENTENCE                                            DTSBE770
01958      ELSE                                                         DTSBE770
01959         SET WRK-SELECT-RCVD-88      TO TRUE                       DTSBE770
01960         SET WRK-ANN-DEFAULT-YES-88  TO TRUE                       DTSBE770
01961         ADD +1 TO WRK-P2100-DFLT-CNT                              DTSBE770
01962      END-IF.                                                      DTSBE770
01963                                                                   DTSBE770
01964  P2122-EXIT.                                                      DTSBE770
01965      EXIT.                                                        DTSBE770
01966                                                                   DTSBE770
01967  P2200-GET-RPT-DATES.                                             DTSBE770
01968      IF WRK-ANN-DEFAULT-YES-88                                    DTSBE770
01969         PERFORM P2220-DEFAULT-ANN  THRU P2220-EXIT                DTSBE770
01970         GO TO P2200-EXIT                                          DTSBE770
01971      END-IF.                                                      DTSBE770
01972                                                                   DTSBE770
01973      MOVE LOW-VALUES           TO MRPT-KEY-AREA.                  DTSBE770
01974      MOVE MPRF-EMP-NO          TO MRPT-EMP-NO.                    DTSBE770
01975      SET MRPT-RPT-88           TO TRUE.                           DTSBE770
01976      IF L410-ANN-SCHED-88                                         DTSBE770
01977         MOVE WRK-FIRST-ANN-QTR TO MRPT-YRQ                        DTSBE770
01978                                   WRK-MRPT-QTR                    DTSBE770
01979      ELSE                                                         DTSBE770
01980         MOVE WRK-QTR           TO MRPT-YRQ                        DTSBE770
01981                                   WRK-MRPT-QTR.                   DTSBE770
01982      MOVE MRPT-KEY-AREA        TO MSKL-KEY-AREA.                  DTSBE770
01983      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE770
01984      IF L410-ANN-SCHED-88                                         DTSBE770
01985         PERFORM P2211-SCAN-ANN-MRPT   THRU P2211-EXIT             DTSBE770
01986             UNTIL L910-NO-REC-88                                  DTSBE770
01987      ELSE                                                         DTSBE770
01988         PERFORM P2210-SCAN-MRPT       THRU P2210-EXIT             DTSBE770
01989             UNTIL L910-NO-REC-88                                  DTSBE770
01990       END-IF.                                                     DTSBE770
01991                                                                   DTSBE770
01992      IF L410-ANN-SCHED-88                                         DTSBE770
01993         PERFORM P2230-NON-DEFAULT-ANN  THRU P2230-EXIT.           DTSBE770
01994 *&                                                                DTSBE770
01995 *    IF WRK-MRPT-QTR = 20024                                      DTSBE770
01996 *       IF WRK-ORIG-RPT-RCVD-DATE > ZERO                          DTSBE770
01997 *       IF (WRK-ORIG-RPT-ESTB-DATE > 20030331                     DTSBE770
01998 *       OR WRK-ORIG-RPT-CHNG-DATE > 20030331)                     DTSBE770
01999 *          DISPLAY 'EXCLUDE ' MPRF-EMP-NO                         DTSBE770
02000 *             '  RCV ' WRK-ORIG-RPT-RCVD-DATE                     DTSBE770
02001 *             '  ESTB ' WRK-ORIG-RPT-ESTB-DATE                    DTSBE770
02002 *             '  CHNG ' WRK-ORIG-RPT-CHNG-DATE                    DTSBE770
02003            ADD +1 TO WRK-CNT4.                                    DTSBE770
02004 *&                                                                DTSBE770
02005  P2200-EXIT.                                                      DTSBE770
02006      EXIT.                                                        DTSBE770
02007                                                                   DTSBE770
02008  P2210-SCAN-MRPT.                                                 DTSBE770
02009      MOVE MSKL-REC TO MRPT-REC.                                   DTSBE770
02010                                                                   DTSBE770
02011      IF MRPT-YRQ = WRK-MRPT-QTR                                   DTSBE770
02012         IF MRPT-ORIG-88                                           DTSBE770
02013            MOVE MRPT-RECEIVED-DATE TO WRK-ORIG-RPT-RCVD-DATE      DTSBE770
02014            MOVE MRPT-ESTB-DATE     TO WRK-ORIG-RPT-ESTB-DATE      DTSBE770
02015            MOVE MRPT-CHNG-DATE     TO WRK-ORIG-RPT-CHNG-DATE      DTSBE770
02016         ELSE                                                      DTSBE770
02017            IF MRPT-ESTIM-88                                       DTSBE770
02018               MOVE MRPT-RECEIVED-DATE TO WRK-ESTIM-RPT-RCVD-DATE  DTSBE770
02019            END-IF                                                 DTSBE770
02020         END-IF                                                    DTSBE770
02021      ELSE                                                         DTSBE770
02022         SET L910-NO-REC-88         TO TRUE                        DTSBE770
02023         GO TO P2210-EXIT                                          DTSBE770
02024      END-IF.                                                      DTSBE770
02025                                                                   DTSBE770
02026      PERFORM S910-READ-NEXT        THRU S910-EXIT.                DTSBE770
02027                                                                   DTSBE770
02028  P2210-EXIT.                                                      DTSBE770
02029      EXIT.                                                        DTSBE770
02030                                                                   DTSBE770
02031  P2211-SCAN-ANN-MRPT.                                             DTSBE770
02032      MOVE MSKL-REC TO MRPT-REC.                                   DTSBE770
02033                                                                   DTSBE770
02034      IF MRPT-YRQ > WRK-LAST-ANN-QTR                               DTSBE770
02035         SET L910-NO-REC-88         TO TRUE                        DTSBE770
02036         GO TO P2211-EXIT                                          DTSBE770
02037      END-IF.                                                      DTSBE770
02038                                                                   DTSBE770
02039      IF MRPT-ORIG-88                                              DTSBE770
02040         MOVE MRPT-RECEIVED-DATE    TO WRK-ORIG-RPT-RCVD-DATE      DTSBE770
02041         MOVE MRPT-ESTB-DATE        TO WRK-ORIG-RPT-ESTB-DATE      DTSBE770
02042         MOVE MRPT-CHNG-DATE        TO WRK-ORIG-RPT-CHNG-DATE      DTSBE770
02043      END-IF.                                                      DTSBE770
02044                                                                   DTSBE770
02045      PERFORM S910-READ-NEXT        THRU S910-EXIT.                DTSBE770
02046                                                                   DTSBE770
02047  P2211-EXIT.                                                      DTSBE770
02048      EXIT.                                                        DTSBE770
02049                                                                   DTSBE770
02050  P2220-DEFAULT-ANN.                                               DTSBE770
02051      IF WRK-QTR = WRK-QTR2                                        DTSBE770
02052         MOVE WRK-QTR2-ANN-TIMELY     TO WRK-ORIG-RPT-RCVD-DATE    DTSBE770
02053      ELSE                                                         DTSBE770
02054         IF WRK-QTR = WRK-QTR1                                     DTSBE770
02055            MOVE WRK-QTR1-ANN-TIMELY  TO WRK-ORIG-RPT-RCVD-DATE    DTSBE770
02056         END-IF                                                    DTSBE770
02057      END-IF.                                                      DTSBE770
02058                                                                   DTSBE770
02059  P2220-EXIT.                                                      DTSBE770
02060      EXIT.                                                        DTSBE770
02061                                                                   DTSBE770
02062  P2230-NON-DEFAULT-ANN.                                           DTSBE770
02063 **   IF WRK-RPT-QTR-Q = 2                                         DTSBE770
02064 *       MOVE WRK-QTR1-ANN-TIMELY  TO WRK-ANN-TIMELY-DATE          DTSBE770
02065 *       MOVE WRK-QTR1-ANN-SECURED TO WRK-ANN-SECURED-DATE         DTSBE770
02066 *    ELSE                                                         DTSBE770
02067 *       IF WRK-RPT-QTR-Q = 3                                      DTSBE770
02068 *          MOVE WRK-QTR2-ANN-TIMELY  TO WRK-ANN-TIMELY-DATE       DTSBE770
02069 *          MOVE WRK-QTR2-ANN-SECURED TO WRK-ANN-SECURED-DATE      DTSBE770
02070 *       END-IF                                                    DTSBE770
02071 **   END-IF.                                                      DTSBE770
02072                                                                   DTSBE770
02073      IF WRK-QTR = WRK-QTR1                                        DTSBE770
02074         MOVE WRK-QTR1-ANN-TIMELY  TO WRK-ANN-TIMELY-DATE          DTSBE770
02075         MOVE WRK-QTR1-ANN-SECURED TO WRK-ANN-SECURED-DATE         DTSBE770
02076      ELSE                                                         DTSBE770
02077         MOVE WRK-QTR2-ANN-TIMELY  TO WRK-ANN-TIMELY-DATE          DTSBE770
02078         MOVE WRK-QTR2-ANN-SECURED TO WRK-ANN-SECURED-DATE         DTSBE770
02079      END-IF.                                                      DTSBE770
02080                                                                   DTSBE770
02081      IF WRK-ORIG-RPT-RCVD-DATE > WRK-ANN-DUE-DATE                 DTSBE770
02082         IF WRK-ORIG-RPT-RCVD-DATE <= WRK-ANN-SECURED-DATE         DTSBE770
02083            MOVE WRK-ANN-SECURED-DATE                              DTSBE770
02084                                   TO WRK-ORIG-RPT-RCVD-DATE       DTSBE770
02085            ADD +1 TO WRK-P2220-SEC-CNT                            DTSBE770
02086         END-IF                                                    DTSBE770
02087      ELSE                                                         DTSBE770
02088         MOVE WRK-ANN-TIMELY-DATE  TO WRK-ORIG-RPT-RCVD-DATE       DTSBE770
02089         ADD +1 TO WRK-P2220-TIMELY-CNT                            DTSBE770
02090      END-IF.                                                      DTSBE770
02091                                                                   DTSBE770
02092 **   IF WRK-ORIG-RPT-RCVD-DATE > WRK-ANN-DUE-DATE                 DTSBE770
02093 *       IF WRK-ORIG-RPT-RCVD-DATE > WRK-ANN-SECURED-DATE          DTSBE770
02094 *          ADD +1 TO WRK-P2220-RES-CNT                            DTSBE770
02095 *       ELSE                                                      DTSBE770
02096 *          MOVE WRK-ANN-SECURED-DATE                              DTSBE770
02097 *                                 TO WRK-ORIG-RPT-RCVD-DATE       DTSBE770
02098 *          ADD +1 TO WRK-P2220-SEC-CNT                            DTSBE770
02099 *       END-IF                                                    DTSBE770
02100 *    ELSE                                                         DTSBE770
02101 *       MOVE WRK-ANN-TIMELY-DATE  TO WRK-ORIG-RPT-RCVD-DATE       DTSBE770
02102 *       ADD +1 TO WRK-P2220-TIMELY-CNT                            DTSBE770
02103 **   END-IF.                                                      DTSBE770
02104                                                                   DTSBE770
02105  P2230-EXIT.                                                      DTSBE770
02106      EXIT.                                                        DTSBE770
02107                                                                   DTSBE770
02108  P2300-LIAB-DATE.                                                 DTSBE770
02109      MOVE LOW-VALUES TO MSOL-KEY-AREA.                            DTSBE770
02110      MOVE MPRF-EMP-NO TO MSOL-EMP-NO.                             DTSBE770
02111      SET MSOL-SOL-88 TO TRUE.                                     DTSBE770
02112      MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE770
02113      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE770
02114      PERFORM P2310-SCAN-MSOL THRU P2310-EXIT                      DTSBE770
02115          UNTIL  L910-NO-REC-88.                                   DTSBE770
02116                                                                   DTSBE770
02117  P2300-EXIT.                                                      DTSBE770
02118      EXIT.                                                        DTSBE770
02119                                                                   DTSBE770
02120  P2310-SCAN-MSOL.                                                 DTSBE770
02121      MOVE MSKL-REC                 TO MSOL-REC.                   DTSBE770
02122                                                                   DTSBE770
02123      IF MSOL-INACT-WITHDRAWN-88                                   DTSBE770
02124         NEXT SENTENCE                                             DTSBE770
02125      ELSE                                                         DTSBE770
02126         IF L410-ANN-SCHED-88                                      DTSBE770
02127            IF WRK-FIRST-ANN-QTR <= MSOL-LAST-LIAB-YRQ             DTSBE770
02128            AND WRK-LAST-ANN-QTR >= MSOL-FIRST-LIAB-YRQ            DTSBE770
02129               MOVE MSOL-LIAB-DATE     TO WRK-P2310-LIAB-DATE      DTSBE770
02130               SET L910-NO-REC-88         TO TRUE                  DTSBE770
02131               GO TO P2310-EXIT                                    DTSBE770
02132            END-IF                                                 DTSBE770
02133         ELSE                                                      DTSBE770
02134            IF WRK-QTR <= MSOL-LAST-LIAB-YRQ                       DTSBE770
02135            AND WRK-QTR >= MSOL-FIRST-LIAB-YRQ                     DTSBE770
02136               MOVE MSOL-LIAB-DATE     TO WRK-P2310-LIAB-DATE      DTSBE770
02137               SET L910-NO-REC-88         TO TRUE                  DTSBE770
02138               GO TO P2310-EXIT                                    DTSBE770
02139            END-IF                                                 DTSBE770
02140         END-IF.                                                   DTSBE770
02141                                                                   DTSBE770
02142      PERFORM S910-READ-NEXT        THRU S910-EXIT.                DTSBE770
02143                                                                   DTSBE770
02144  P2310-EXIT.                                                      DTSBE770
02145      EXIT.                                                        DTSBE770
02146                                                                   DTSBE770
02147  P2400-MSOL-CHANGE.                                               DTSBE770
02148      IF L410-ANN-SCHED-88                                         DTSBE770
02149         MOVE WRK-ANN-DELINQUENT-DATE TO WRK-DELINQUENT-DATE       DTSBE770
02150      ELSE                                                         DTSBE770
02151         MOVE WRK-QTR-DELINQUENT-DATE TO WRK-DELINQUENT-DATE.      DTSBE770
02152                                                                   DTSBE770
02153      MOVE LOW-VALUES TO MSOL-KEY-AREA.                            DTSBE770
02154      MOVE MPRF-EMP-NO TO MSOL-EMP-NO.                             DTSBE770
02155      SET MSOL-SOL-88 TO TRUE.                                     DTSBE770
02156      MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE770
02157      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE770
02158      PERFORM P2410-SCAN-MSOL THRU P2410-EXIT                      DTSBE770
02159          UNTIL  L910-NO-REC-88.                                   DTSBE770
02160                                                                   DTSBE770
02161      IF WRK-MSOL-INACT-CHNG-YES-88                                DTSBE770
02162         SET WRK-SELECT-INACT-CHNG-88 TO TRUE                      DTSBE770
02163      ELSE                                                         DTSBE770
02164         IF WRK-MSOL-LIAB-CHNG-YES-88                              DTSBE770
02165            SET WRK-SELECT-LIAB-CHNG-88 TO TRUE                    DTSBE770
02166         ELSE                                                      DTSBE770
02167            IF WRK-MSOL-WITHDRAWN-YES-88                           DTSBE770
02168               SET WRK-SELECT-WITHDRAW-88  TO TRUE                 DTSBE770
02169            END-IF                                                 DTSBE770
02170         END-IF                                                    DTSBE770
02171      END-IF.                                                      DTSBE770
02172                                                                   DTSBE770
02173  P2400-EXIT.                                                      DTSBE770
02174      EXIT.                                                        DTSBE770
02175                                                                   DTSBE770
02176  P2410-SCAN-MSOL.                                                 DTSBE770
02177      MOVE MSKL-REC                 TO MSOL-REC.                   DTSBE770
02178                                                                   DTSBE770
02179      IF (MSOL-CHNG-DATE > WRK-DELINQUENT-DATE)                    DTSBE770
02180         IF MSOL-INACT-WITHDRAWN-88                                DTSBE770
02181            PERFORM P2411-WITHDRAWN   THRU P2411-EXIT              DTSBE770
02182         ELSE                                                      DTSBE770
02183            IF MSOL-INACT-INACTIVE-88                              DTSBE770
02184               PERFORM P2412-INACTIVE    THRU P2412-EXIT           DTSBE770
02185            ELSE                                                   DTSBE770
02186               PERFORM P2413-ACTIVE      THRU P2413-EXIT           DTSBE770
02187            END-IF                                                 DTSBE770
02188         END-IF                                                    DTSBE770
02189      END-IF.                                                      DTSBE770
02190                                                                   DTSBE770
02191      PERFORM S910-READ-NEXT        THRU S910-EXIT.                DTSBE770
02192                                                                   DTSBE770
02193  P2410-EXIT.                                                      DTSBE770
02194      EXIT.                                                        DTSBE770
02195                                                                   DTSBE770
02196  P2411-WITHDRAWN.                                                 DTSBE770
02197 ********************************************************          DTSBE770
02198 *  THE DATA VALIDATION SOFTWARE EXPECTS THE INACTIVE DATE         DTSBE770
02199 *  TO EQUAL THE LIABILITY DATE WHEN THE SPAN OF LIABILITY         DTSBE770
02200 *  HAS BEEN WITHDRAWN. SINCE THIS IS NOT ALWAYS THE CASE          DTSBE770
02201 *  IN THE TAX SYSTEM, THE CODE BELOW MAKES THE TWO DATES          DTSBE770
02202 *  EQUAL.                                                         DTSBE770
02203 ********************************************************          DTSBE770
02204      IF L410-ANN-SCHED-88                                         DTSBE770
02205         IF MSOL-LIAB-DATE <= WRK-ANN-END                          DTSBE770
02206            MOVE MSOL-LIAB-DATE  TO WRK-P2411-LIAB-DATE            DTSBE770
02207                                    WRK-P2411-INACT-DATE           DTSBE770
02208            MOVE MSOL-CHNG-DATE  TO WRK-P2411-INACT-ENTER-DATE     DTSBE770
02209            SET WRK-MSOL-WITHDRAWN-YES-88 TO TRUE                  DTSBE770
02210         END-IF                                                    DTSBE770
02211      ELSE                                                         DTSBE770
02212         IF MSOL-LIAB-DATE <= WRK-QTR-END                          DTSBE770
02213            MOVE MSOL-LIAB-DATE  TO WRK-P2411-LIAB-DATE            DTSBE770
02214                                    WRK-P2411-INACT-DATE           DTSBE770
02215            MOVE MSOL-CHNG-DATE  TO WRK-P2411-INACT-ENTER-DATE     DTSBE770
02216            SET WRK-MSOL-WITHDRAWN-YES-88 TO TRUE                  DTSBE770
02217         END-IF                                                    DTSBE770
02218      END-IF.                                                      DTSBE770
02219                                                                   DTSBE770
02220  P2411-EXIT.                                                      DTSBE770
02221      EXIT.                                                        DTSBE770
02222                                                                   DTSBE770
02223  P2412-INACTIVE.                                                  DTSBE770
02224      IF L410-ANN-SCHED-88                                         DTSBE770
02225         IF MSOL-INACT-DATE < WRK-ANN-START                        DTSBE770
02226            MOVE MSOL-LIAB-DATE  TO WRK-P2412-LIAB-DATE            DTSBE770
02227            MOVE MSOL-INACT-DATE TO WRK-P2412-INACT-DATE           DTSBE770
02228            MOVE MSOL-CHNG-DATE  TO WRK-P2412-INACT-ENTER-DATE     DTSBE770
02229            SET WRK-MSOL-INACT-CHNG-YES-88 TO TRUE                 DTSBE770
02230         END-IF                                                    DTSBE770
02231      ELSE                                                         DTSBE770
02232         IF MSOL-INACT-DATE < WRK-QTR-START                        DTSBE770
02233            MOVE MSOL-LIAB-DATE  TO WRK-P2412-LIAB-DATE            DTSBE770
02234            MOVE MSOL-INACT-DATE TO WRK-P2412-INACT-DATE           DTSBE770
02235            MOVE MSOL-CHNG-DATE  TO WRK-P2412-INACT-ENTER-DATE     DTSBE770
02236            SET WRK-MSOL-INACT-CHNG-YES-88 TO TRUE                 DTSBE770
02237         END-IF                                                    DTSBE770
02238      END-IF.                                                      DTSBE770
02239                                                                   DTSBE770
02240  P2412-EXIT.                                                      DTSBE770
02241      EXIT.                                                        DTSBE770
02242                                                                   DTSBE770
02243  P2413-ACTIVE.                                                    DTSBE770
02244      IF WRK-MSOL-LIAB-CHNG-YES-88                                 DTSBE770
02245         NEXT SENTENCE                                             DTSBE770
02246      ELSE                                                         DTSBE770
02247         IF L410-ANN-SCHED-88                                      DTSBE770
02248            IF MSOL-LIAB-DATE > WRK-ANN-END                        DTSBE770
02249               MOVE MSOL-LIAB-DATE  TO WRK-P2413-LIAB-DATE         DTSBE770
02250               SET WRK-MSOL-LIAB-CHNG-YES-88 TO TRUE               DTSBE770
02251            END-IF                                                 DTSBE770
02252         ELSE                                                      DTSBE770
02253            IF MSOL-LIAB-DATE > WRK-QTR-END                        DTSBE770
02254               MOVE MSOL-LIAB-DATE  TO WRK-P2413-LIAB-DATE         DTSBE770
02255               SET WRK-MSOL-LIAB-CHNG-YES-88 TO TRUE               DTSBE770
02256            END-IF                                                 DTSBE770
02257      END-IF.                                                      DTSBE770
02258                                                                   DTSBE770
02259  P2413-EXIT.                                                      DTSBE770
02260      EXIT.                                                        DTSBE770
02261                                                                   DTSBE770
02262  P2500-BUILD-Y772.                                                DTSBE770
02263      MOVE LENGTH OF Y772-REC TO Y772-LENGTH.                      DTSBE770
02264      SET Y772-REC-TYPE-772-88 TO TRUE.                            DTSBE770
02265                                                                   DTSBE770
02266      ADD +1            TO WRK-Y772-CNT.                           DTSBE770
02267                                                                   DTSBE770
02268      MOVE MPRF-EMP-NO     TO Y772-EMP-NO.                         DTSBE770
02269                                                                   DTSBE770
02270      MOVE WRK-QTR            TO Y772-RPT-YRQ                      DTSBE770
02271                                                                   DTSBE770
02272      MOVE MPRF-EMP-CLASS  TO Y772-EMP-CLASS.                      DTSBE770
02273                                                                   DTSBE770
02274      MOVE ZERO            TO Y772-RECEIVED-DATE                   DTSBE770
02275                              Y772-LIAB-DATE                       DTSBE770
02276                              Y772-FINAL-ASSESS-DATE               DTSBE770
02277                              Y772-INACTIVE-DATE                   DTSBE770
02278                              Y772-INACT-PROCESS-DATE.             DTSBE770
02279                                                                   DTSBE770
02280      EVALUATE TRUE                                                DTSBE770
02281        WHEN WRK-SELECT-RCVD-88                                    DTSBE770
02282           SET Y772-RPT-RCVD-88        TO TRUE                     DTSBE770
02283           MOVE WRK-ORIG-RPT-RCVD-DATE TO Y772-RECEIVED-DATE       DTSBE770
02284 *&        IF L410-ANN-SCHED-88                                    DTSBE770
02285 *            PERFORM P2520-ANN-RCVD   THRU P2520-EXIT             DTSBE770
02286 *         ELSE                                                    DTSBE770
02287 *            MOVE WRK-ORIG-RPT-RCVD-DATE                          DTSBE770
02288 *                                     TO Y772-RECEIVED-DATE       DTSBE770
02289 *            ADD +1 TO WRK-P2500-QTR-CNT                          DTSBE770
02290 *&        END-IF                                                  DTSBE770
02291           MOVE WRK-P2310-LIAB-DATE    TO Y772-LIAB-DATE           DTSBE770
02292                                                                   DTSBE770
02293        WHEN WRK-SELECT-ESTIM-88                                   DTSBE770
02294           SET Y772-RPT-ESTIM-88        TO TRUE                    DTSBE770
02295           MOVE WRK-ESTIM-RPT-RCVD-DATE TO Y772-FINAL-ASSESS-DATE  DTSBE770
02296           MOVE WRK-P2310-LIAB-DATE     TO Y772-LIAB-DATE          DTSBE770
02297                                                                   DTSBE770
02298        WHEN WRK-SELECT-INACT-CHNG-88                              DTSBE770
02299           SET Y772-RPT-INACT-88        TO TRUE                    DTSBE770
02300           MOVE WRK-P2412-LIAB-DATE     TO Y772-LIAB-DATE          DTSBE770
02301           MOVE WRK-P2412-INACT-DATE    TO Y772-INACTIVE-DATE      DTSBE770
02302           MOVE WRK-P2412-INACT-ENTER-DATE                         DTSBE770
02303                                    TO Y772-INACT-PROCESS-DATE     DTSBE770
02304                                                                   DTSBE770
02305        WHEN WRK-SELECT-LIAB-CHNG-88                               DTSBE770
02306           SET Y772-RPT-LIAB-88         TO TRUE                    DTSBE770
02307           MOVE WRK-P2413-LIAB-DATE     TO Y772-LIAB-DATE          DTSBE770
02308                                                                   DTSBE770
02309        WHEN WRK-SELECT-WITHDRAW-88                                DTSBE770
02310           SET Y772-RPT-WITHDRW-88      TO TRUE                    DTSBE770
02311           MOVE WRK-P2411-LIAB-DATE     TO Y772-LIAB-DATE          DTSBE770
02312           MOVE WRK-P2411-INACT-DATE    TO Y772-INACTIVE-DATE      DTSBE770
02313           MOVE WRK-P2411-INACT-ENTER-DATE                         DTSBE770
02314                                      TO Y772-INACT-PROCESS-DATE   DTSBE770
02315                                                                   DTSBE770
02316        WHEN WRK-SELECT-581-ONLY-88                                DTSBE770
02317           SET Y772-RPT-581-ONLY-88     TO TRUE                    DTSBE770
02318           MOVE WRK-ORIG-RPT-RCVD-DATE  TO Y772-RECEIVED-DATE      DTSBE770
02319 *&        IF L410-ANN-SCHED-88                                    DTSBE770
02320 *            PERFORM P2510-ANN-ETA581 THRU P2510-EXIT             DTSBE770
02321 *         ELSE                                                    DTSBE770
02322 *            MOVE WRK-ORIG-RPT-RCVD-DATE                          DTSBE770
02323 *                                     TO Y772-RECEIVED-DATE       DTSBE770
02324 *            ADD +1 TO WRK-P2500-581-QTR-CNT                      DTSBE770
02325 *&        END-IF                                                  DTSBE770
02326                                                                   DTSBE770
02327      END-EVALUATE.                                                DTSBE770
02328                                                                   DTSBE770
02329      PERFORM S772-WRITE-R772 THRU S772-EXIT.                      DTSBE770
02330                                                                   DTSBE770
02331  P2500-EXIT.                                                      DTSBE770
02332      EXIT.                                                        DTSBE770
02333                                                                   DTSBE770
02334 *P2510-ANN-ETA581.                                                DTSBE770
02335 *    IF WRK-ANN-DEFAULT-YES-88                                    DTSBE770
02336 *       PERFORM P2511-DEFAULT      THRU P2511-EXIT                DTSBE770
02337 *    ELSE                                                         DTSBE770
02338 *       PERFORM P2512-NO-DEFAULT   THRU P2512-EXIT                DTSBE770
02339 *    END-IF.                                                      DTSBE770
02340 *                                                                 DTSBE770
02341 *P2510-EXIT.                                                      DTSBE770
02342 *    EXIT.                                                        DTSBE770
02343                                                                   DTSBE770
02344 *P2511-DEFAULT.                                                   DTSBE770
02345 *    ADD +1 TO WRK-P2510-DFLT-TIMELY-CNT.                         DTSBE770
02346 *    MOVE WRK-ANN-PSEUDO-TIMELY-DT1  TO Y772-RECEIVED-DATE.       DTSBE770
02347 *                                                                 DTSBE770
02348 *P2511-EXIT.                                                      DTSBE770
02349 *    EXIT.                                                        DTSBE770
02350 *                                                                 DTSBE770
02351 *P2512-NO-DEFAULT.                                                DTSBE770
02352 *    IF WRK-ORIG-RPT-RCVD-DATE > WRK-ANN-DUE-DATE                 DTSBE770
02353 *       IF WRK-ORIG-RPT-RCVD-DATE > WRK-ANN-SECURED-DATE          DTSBE770
02354 *          MOVE WRK-ORIG-RPT-RCVD-DATE                            DTSBE770
02355 *                                 TO Y772-RECEIVED-DATE           DTSBE770
02356 *          ADD +1 TO WRK-P2510-RES-CNT                            DTSBE770
02357 *       ELSE                                                      DTSBE770
02358 *          MOVE WRK-ANN-SECURED-DATE                              DTSBE770
02359 *                                 TO Y772-RECEIVED-DATE           DTSBE770
02360 *          ADD +1 TO WRK-P2510-SEC-CNT                            DTSBE770
02361 *       END-IF                                                    DTSBE770
02362 *    ELSE                                                         DTSBE770
02363 *       MOVE WRK-ANN-PSEUDO-TIMELY-DT1                            DTSBE770
02364 *                                 TO Y772-RECEIVED-DATE           DTSBE770
02365 *       ADD +1 TO WRK-P2510-TIMELY-CNT                            DTSBE770
02366 *    END-IF.                                                      DTSBE770
02367 *                                                                 DTSBE770
02368 *P2512-EXIT.                                                      DTSBE770
02369 *    EXIT.                                                        DTSBE770
02370                                                                   DTSBE770
02371 *P2520-ANN-RCVD.                                                  DTSBE770
02372 *    IF WRK-ANN-DEFAULT-YES-88                                    DTSBE770
02373 *       PERFORM P2521-DEFAULT      THRU P2521-EXIT                DTSBE770
02374 *    ELSE                                                         DTSBE770
02375 *       PERFORM P2522-NOT-DEFAULT  THRU P2522-EXIT                DTSBE770
02376 *    END-IF.                                                      DTSBE770
02377 *                                                                 DTSBE770
02378 *P2520-EXIT.                                                      DTSBE770
02379 *    EXIT.                                                        DTSBE770
02380 *                                                                 DTSBE770
02381 *                                                                 DTSBE770
02382 *P2521-DEFAULT.                                                   DTSBE770
02383 *    ADD +1 TO WRK-P2520-DFLT-TIMELY-CNT.                         DTSBE770
02384 *    MOVE WRK-ANN-PSEUDO-TIMELY-DT2  TO Y772-RECEIVED-DATE.       DTSBE770
02385 *                                                                 DTSBE770
02386 *P2521-EXIT.                                                      DTSBE770
02387 *    EXIT.                                                        DTSBE770
02388 *                                                                 DTSBE770
02389 *P2522-NOT-DEFAULT.                                               DTSBE770
02390 *    IF WRK-ORIG-RPT-RCVD-DATE > WRK-ANN-DUE-DATE                 DTSBE770
02391 *       IF WRK-ORIG-RPT-RCVD-DATE > WRK-ANN-SECURED-DATE          DTSBE770
02392 *          MOVE WRK-ORIG-RPT-RCVD-DATE                            DTSBE770
02393 *                                 TO Y772-RECEIVED-DATE           DTSBE770
02394 *          ADD +1 TO WRK-P2520-RES-CNT                            DTSBE770
02395 *       ELSE                                                      DTSBE770
02396 *          MOVE WRK-ANN-PSEUDO-SECURD-DT2                         DTSBE770
02397 *                                 TO Y772-RECEIVED-DATE           DTSBE770
02398 *          ADD +1 TO WRK-P2520-SEC-CNT                            DTSBE770
02399 *       END-IF                                                    DTSBE770
02400 *    ELSE                                                         DTSBE770
02401 *       MOVE WRK-ANN-PSEUDO-TIMELY-DT2                            DTSBE770
02402 *                                 TO Y772-RECEIVED-DATE           DTSBE770
02403 *       ADD +1 TO WRK-P2520-TIMELY-CNT                            DTSBE770
02404 *    END-IF.                                                      DTSBE770
02405 *                                                                 DTSBE770
02406 *P2522-EXIT.                                                      DTSBE770
02407 *    EXIT.                                                        DTSBE770
02408                                                                   DTSBE770
02409 *************************************************************     DTSBE770
02410 *  BECAUSE THE DATA VALIDATION SOFTWARE LOOKS AT ONLY ONE         DTSBE770
02411 *  QUARTER DURING EACH RUN, COUNTING BOTH SECURED AND             DTSBE770
02412 *  RESOLVED REPORTS FOR THE QUARTER, THE FOLLOWING PARAGRAPH      DTSBE770
02413 *  IS NEEDED TO GET THE SECURED REPORT COUNTS FOR THE             DTSBE770
02414 *  ETA581 REPORTS FOR THE QUARTER PRIOR TO THE REPORT QTR.        DTSBE770
02415 *                                                                 DTSBE770
02416 *  ANNUAL FILERS:                                                 DTSBE770
02417 *    ANNUAL REPORTS RECEIVED DURING THE SECOND QUARTER            DTSBE770
02418 *    ARE COUNTED AS TIMELY OR SECURED.                            DTSBE770
02419 *    FOR ALL OTHER QUARTERS, THE 401 HANDBOOK REQUIRES            DTSBE770
02420 *    THAT THEY BE COUNTED AS TIMELY BY DEFAULT.                   DTSBE770
02421 *************************************************************     DTSBE770
02422  P2600-ETA581-ONLY.                                               DTSBE770
02423      SET WRK-ANN-DEFAULT-NO-88 TO TRUE.                           DTSBE770
02424      IF L410-ANN-SCHED-88                                         DTSBE770
02425         PERFORM P2630-ANN-DEFAULT     THRU P2630-EXIT             DTSBE770
02426      ELSE                                                         DTSBE770
02427         PERFORM P2610-QTRLY           THRU P2610-EXIT             DTSBE770
02428      END-IF.                                                      DTSBE770
02429                                                                   DTSBE770
02430 **   IF L410-ANN-SCHED-88                                         DTSBE770
02431 *       IF WRK-RPT-QTR-Q = 3                                      DTSBE770
02432 *          PERFORM P2620-ANNUAL       THRU P2620-EXIT             DTSBE770
02433 *       ELSE                                                      DTSBE770
02434 *          PERFORM P2630-ANN-DEFAULT  THRU P2630-EXIT             DTSBE770
02435 *       END-IF                                                    DTSBE770
02436 *    ELSE                                                         DTSBE770
02437 *       PERFORM P2610-QTRLY              THRU P2610-EXIT          DTSBE770
02438 **   END-IF.                                                      DTSBE770
02439                                                                   DTSBE770
02440  P2600-EXIT.                                                      DTSBE770
02441      EXIT.                                                        DTSBE770
02442                                                                   DTSBE770
02443  P2610-QTRLY.                                                     DTSBE770
02444      SET WRK-SELECT-NO-88 TO TRUE.                                DTSBE770
02445                                                                   DTSBE770
02446      MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSBE770
02447      MOVE MPRF-EMP-NO TO MQTR-EMP-NO.                             DTSBE770
02448      SET MQTR-QTR-88 TO TRUE.                                     DTSBE770
02449      MOVE WRK-QTR            TO MQTR-YRQ.                         DTSBE770
02450      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE770
02451      PERFORM S910-READ THRU S910-EXIT.                            DTSBE770
02452      IF L910-NO-REC-88                                            DTSBE770
02453          NEXT SENTENCE                                            DTSBE770
02454      ELSE                                                         DTSBE770
02455         MOVE MSKL-REC TO MQTR-REC                                 DTSBE770
02456         IF MQTR-CURR-RCVD-88                                      DTSBE770
02457            ADD +1 TO WRK-P2610-QTR-CNT                            DTSBE770
02458            SET WRK-SELECT-581-ONLY-88  TO TRUE                    DTSBE770
02459         END-IF                                                    DTSBE770
02460      END-IF.                                                      DTSBE770
02461                                                                   DTSBE770
02462  P2610-EXIT.                                                      DTSBE770
02463      EXIT.                                                        DTSBE770
02464                                                                   DTSBE770
02465  P2620-ANNUAL.                                                    DTSBE770
02466      SET WRK-SELECT-NO-88 TO TRUE.                                DTSBE770
02467                                                                   DTSBE770
02468      MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSBE770
02469      MOVE MPRF-EMP-NO TO MQTR-EMP-NO.                             DTSBE770
02470      SET MQTR-QTR-88 TO TRUE.                                     DTSBE770
02471      MOVE WRK-FIRST-ANN-QTR  TO MQTR-YRQ.                         DTSBE770
02472      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE770
02473      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE770
02474      IF L910-NO-REC-88                                            DTSBE770
02475          NEXT SENTENCE                                            DTSBE770
02476      ELSE                                                         DTSBE770
02477         MOVE MSKL-REC TO MQTR-REC                                 DTSBE770
02478         PERFORM                                                   DTSBE770
02479            UNTIL MQTR-CURR-RCVD-88                                DTSBE770
02480            OR L910-NO-REC-88                                      DTSBE770
02481            OR MQTR-YRQ > WRK-LAST-ANN-QTR                         DTSBE770
02482               PERFORM S910-READ-NEXT  THRU S910-EXIT              DTSBE770
02483               MOVE MSKL-REC TO MQTR-REC                           DTSBE770
02484         END-PERFORM                                               DTSBE770
02485         IF MQTR-CURR-RCVD-88                                      DTSBE770
02486            SET WRK-SELECT-581-ONLY-88  TO TRUE                    DTSBE770
02487            ADD +1 TO WRK-ANNUAL-RPT-CNT                           DTSBE770
02488         END-IF                                                    DTSBE770
02489      END-IF.                                                      DTSBE770
02490                                                                   DTSBE770
02491  P2620-EXIT.                                                      DTSBE770
02492      EXIT.                                                        DTSBE770
02493                                                                   DTSBE770
02494  P2630-ANN-DEFAULT.                                               DTSBE770
02495 ***********************                                           DTSBE770
02496 *  DO NOT COUNT THE EMPLOYER IN THIS PARAGRAPH IF                 DTSBE770
02497 *  ALREADY COUNTED IN P2100.                                      DTSBE770
02498 ***********************                                           DTSBE770
02499 *&   IF WRK-ANN-RESOLVED-YES-88                                   DTSBE770
02500 *&      GO TO P2630-EXIT.                                         DTSBE770
02501                                                                   DTSBE770
02502      MOVE 'N' TO WRK-ACTIVE-DURING-PERIOD-IND.                    DTSBE770
02503      MOVE LOW-VALUES TO MSOL-KEY-AREA.                            DTSBE770
02504      MOVE MPRF-EMP-NO TO MSOL-EMP-NO.                             DTSBE770
02505      SET MSOL-SOL-88 TO TRUE.                                     DTSBE770
02506      MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE770
02507      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE770
02508      PERFORM UNTIL L910-NO-REC-88                                 DTSBE770
02509         MOVE MSKL-REC TO MSOL-REC                                 DTSBE770
02510         IF MSOL-INACT-WITHDRAWN-88                                DTSBE770
02511            MOVE 'N' TO WRK-ACTIVE-DURING-PERIOD-IND               DTSBE770
02512         ELSE                                                      DTSBE770
02513            IF MSOL-INACT-DATE < WRK-QTR-START                     DTSBE770
02514            OR MSOL-LIAB-DATE > WRK-QTR-END                        DTSBE770
02515               NEXT SENTENCE                                       DTSBE770
02516            ELSE                                                   DTSBE770
02517               MOVE 'Y' TO WRK-ACTIVE-DURING-PERIOD-IND            DTSBE770
02518            END-IF                                                 DTSBE770
02519         END-IF                                                    DTSBE770
02520         PERFORM S910-READ-NEXT THRU S910-EXIT                     DTSBE770
02521      END-PERFORM.                                                 DTSBE770
02522                                                                   DTSBE770
02523      IF WRK-ACTIVE-DURING-PERIOD-IND = 'N'                        DTSBE770
02524          NEXT SENTENCE                                            DTSBE770
02525      ELSE                                                         DTSBE770
02526         ADD +1 TO WRK-ANNUAL-RPT-CNT                              DTSBE770
02527         SET WRK-SELECT-581-ONLY-88  TO TRUE                       DTSBE770
02528         SET WRK-ANN-DEFAULT-YES-88 TO TRUE                        DTSBE770
02529      END-IF.                                                      DTSBE770
02530                                                                   DTSBE770
02531  P2630-EXIT.                                                      DTSBE770
02532      EXIT.                                                        DTSBE770
02533                                                                   DTSBE770
02534  P3000-STATUS-DETERMINATIONS.                                     DTSBE770
02535      SET WRK-DETERM-NULL-88   TO TRUE.                            DTSBE770
02536      MOVE WRK-ALL-NINES-DATE  TO WRK-LIAB-DATE.                   DTSBE770
02537      MOVE ZERO                TO WRK-LAST-INACT-DATE              DTSBE770
02538                                  WRK-LAST-INACT-ENTER-DATE        DTSBE770
02539                                  WRK-REOPEN-DATE                  DTSBE770
02540                                  WRK-LIAB-PROCESS-DATE            DTSBE770
02541                                  WRK-REOPEN-PROCESS-DATE          DTSBE770
02542                                  WRK-PRED-EMP-NO                  DTSBE770
02543                                  WRK-STATUS-SUCC-DATE.            DTSBE770
02544                                                                   DTSBE770
02545      MOVE LOW-VALUES TO MSOL-KEY-AREA.                            DTSBE770
02546      MOVE MPRF-EMP-NO TO MSOL-EMP-NO.                             DTSBE770
02547      SET MSOL-SOL-88 TO TRUE.                                     DTSBE770
02548      MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE770
02549      PERFORM S910-START-BROWSE         THRU S910-EXIT.            DTSBE770
02550      PERFORM UNTIL L910-NO-REC-88                                 DTSBE770
02551         MOVE MSKL-REC TO MSOL-REC                                 DTSBE770
02552         PERFORM P3100-SUBJ-QTR-DETERMS THRU P3100-EXIT            DTSBE770
02553         PERFORM P3200-PRIOR-SOL        THRU P3200-EXIT            DTSBE770
02554         PERFORM P3300-BUILD-Y773       THRU P3300-EXIT            DTSBE770
02555         PERFORM S910-READ-NEXT         THRU S910-EXIT             DTSBE770
02556      END-PERFORM.                                                 DTSBE770
02557                                                                   DTSBE770
02558      MOVE ZERO                TO WRK-PRED-EMP-NO                  DTSBE770
02559                                  WRK-STATUS-DETERM-DATE           DTSBE770
02560                                  WRK-STATUS-ACT-DATE              DTSBE770
02561                                  WRK-STATUS-SUCC-DATE.            DTSBE770
02562                                                                   DTSBE770
02563      PERFORM P3400-CHK-SUCCESSORS   THRU P3400-EXIT.              DTSBE770
02564                                                                   DTSBE770
02565  P3000-EXIT.                                                      DTSBE770
02566      EXIT.                                                        DTSBE770
02567                                                                   DTSBE770
02568  P3100-SUBJ-QTR-DETERMS.                                          DTSBE770
02569      MOVE ZERO                TO WRK-CURR-ESTB-DATE               DTSBE770
02570                                  WRK-CURR-INACT-DATE              DTSBE770
02571                                  WRK-CURR-INACT-REV-DATE.         DTSBE770
02572                                                                   DTSBE770
02573      SET CURR-DETERM-ESTB-NO-88     TO TRUE.                      DTSBE770
02574      SET CURR-DETERM-INACT-NO-88    TO TRUE.                      DTSBE770
02575      SET CURR-DETERM-REV-NO-88      TO TRUE.                      DTSBE770
02576                                                                   DTSBE770
02577      EVALUATE TRUE                                                DTSBE770
02578        WHEN (MSOL-ESTB-DATE <= WRK-SUBJECT-QTR-END                DTSBE770
02579        AND MSOL-ESTB-DATE >= WRK-SUBJECT-QTR-START)               DTSBE770
02580           SET CURR-DETERM-ESTB-YES-88 TO TRUE                     DTSBE770
02581           MOVE MSOL-ESTB-DATE TO WRK-CURR-ESTB-DATE               DTSBE770
02582                                                                   DTSBE770
02583        WHEN (MSOL-INACT-ENTER-DATE <= WRK-SUBJECT-QTR-END         DTSBE770
02584        AND MSOL-INACT-ENTER-DATE >= WRK-SUBJECT-QTR-START)        DTSBE770
02585           SET CURR-DETERM-INACT-YES-88 TO TRUE                    DTSBE770
02586           MOVE MSOL-INACT-ENTER-DATE TO WRK-CURR-INACT-DATE       DTSBE770
02587                                                                   DTSBE770
02588 **  BASED ON CLARIFICATION FROM DOL, REVERSAL OF AN               DTSBE770
02589 **  INACTIVATION SHOULD NOT BE COUNTED AS A DETERMINATION.        DTSBE770
02590 **                                                                DTSBE770
02591 **     WHEN (MSOL-INACT-REVERSE-DATE <= WRK-SUBJECT-QTR-END       DTSBE770
02592 **     AND MSOL-INACT-REVERSE-DATE >= WRK-SUBJECT-QTR-START)      DTSBE770
02593 **        SET CURR-DETERM-REV-YES-88 TO TRUE                      DTSBE770
02594 **        MOVE MSOL-INACT-REVERSE-DATE                            DTSBE770
02595 **                            TO WRK-CURR-INACT-REV-DATE          DTSBE770
02596                                                                   DTSBE770
02597      END-EVALUATE.                                                DTSBE770
02598                                                                   DTSBE770
02599  P3100-EXIT.                                                      DTSBE770
02600      EXIT.                                                        DTSBE770
02601                                                                   DTSBE770
02602  P3200-PRIOR-SOL.                                                 DTSBE770
02603      IF MSOL-LIAB-DATE <= WRK-SUBJECT-QTR-END                     DTSBE770
02604         IF MSOL-LIAB-DATE < WRK-LIAB-DATE                         DTSBE770
02605            MOVE MSOL-LIAB-DATE TO WRK-LIAB-DATE                   DTSBE770
02606            MOVE MSOL-ESTB-DATE TO WRK-LIAB-PROCESS-DATE           DTSBE770
02607         END-IF                                                    DTSBE770
02608         IF MSOL-LIAB-DATE > WRK-REOPEN-DATE                       DTSBE770
02609             MOVE MSOL-LIAB-DATE TO WRK-REOPEN-DATE                DTSBE770
02610             MOVE MSOL-ESTB-DATE TO WRK-REOPEN-PROCESS-DATE        DTSBE770
02611         END-IF                                                    DTSBE770
02612      END-IF.                                                      DTSBE770
02613                                                                   DTSBE770
02614      IF MSOL-INACT-DATE <= WRK-SUBJECT-QTR-END                    DTSBE770
02615         IF MSOL-INACT-DATE > WRK-LAST-INACT-DATE                  DTSBE770
02616             MOVE MSOL-INACT-ENTER-DATE                            DTSBE770
02617                  TO WRK-LAST-INACT-ENTER-DATE                     DTSBE770
02618          END-IF                                                   DTSBE770
02619      END-IF.                                                      DTSBE770
02620  P3200-EXIT.                                                      DTSBE770
02621      EXIT.                                                        DTSBE770
02622                                                                   DTSBE770
02623  P3300-BUILD-Y773.                                                DTSBE770
02624      MOVE ZERO        TO WRK-STATUS-DETERM-DATE                   DTSBE770
02625                          WRK-STATUS-LIAB-DATE                     DTSBE770
02626                          WRK-STATUS-ACT-DATE                      DTSBE770
02627                          WRK-STATUS-REACT-DATE                    DTSBE770
02628                          WRK-STATUS-INACT-DATE.                   DTSBE770
02629                                                                   DTSBE770
02630      IF MSOL-INACT-ACTIVE-88                                      DTSBE770
02631         IF CURR-DETERM-ESTB-YES-88                                DTSBE770
02632         OR CURR-DETERM-REV-YES-88                                 DTSBE770
02633            PERFORM P3310-NEW   THRU P3310-EXIT                    DTSBE770
02634         END-IF                                                    DTSBE770
02635      ELSE                                                         DTSBE770
02636         IF CURR-DETERM-INACT-YES-88                               DTSBE770
02637            PERFORM P3320-INACT    THRU P3320-EXIT                 DTSBE770
02638         END-IF                                                    DTSBE770
02639      END-IF.                                                      DTSBE770
02640                                                                   DTSBE770
02641 **   IF CURR-DETERM-NEW-88                                        DTSBE770
02642 *       PERFORM P3310-NEW   THRU P3310-EXIT                       DTSBE770
02643 *    ELSE                                                         DTSBE770
02644 *    IF CURR-DETERM-INACT-88                                      DTSBE770
02645 **      PERFORM P3320-INACT THRU P3320-EXIT.                      DTSBE770
02646                                                                   DTSBE770
02647  P3300-EXIT.                                                      DTSBE770
02648      EXIT.                                                        DTSBE770
02649                                                                   DTSBE770
02650  P3310-NEW.                                                       DTSBE770
02651 ***************************************************************** DTSBE770
02652 *  EDIT TO CORRECT LIABILITY DETERMINATIONS ENTERED WITH FUTURE   DTSBE770
02653 *  LIABILITY DATES.                                               DTSBE770
02654 **********************                                            DTSBE770
02655      IF WRK-CURR-ESTB-DATE < MSOL-LIAB-DATE                       DTSBE770
02656         IF MSOL-LIAB-DATE <= WRK-SUBJECT-QTR-END                  DTSBE770
02657            MOVE MSOL-LIAB-DATE TO WRK-CURR-ESTB-DATE              DTSBE770
02658 ***        DISPLAY 'CORRECT DETERM ' MPRF-EMP-NO                  DTSBE770
02659         ELSE                                                      DTSBE770
02660            DISPLAY 'CANNOT CORRECT DETERM ' MPRF-EMP-NO           DTSBE770
02661               '  ESTB ' WRK-CURR-ESTB-DATE                        DTSBE770
02662               '  LIAB ' MSOL-LIAB-DATE                            DTSBE770
02663            GO TO P3310-EXIT.                                      DTSBE770
02664 **********************                                            DTSBE770
02665                                                                   DTSBE770
02666      IF WRK-REOPEN-DATE > WRK-LIAB-DATE                           DTSBE770
02667         PERFORM P3311-REOPEN    THRU P3311-EXIT                   DTSBE770
02668      ELSE                                                         DTSBE770
02669         PERFORM P3312-ORIG      THRU P3312-EXIT                   DTSBE770
02670      END-IF.                                                      DTSBE770
02671                                                                   DTSBE770
02672 **  BASED ON CLARIFICATION FROM DOL, REVERSAL OF AN               DTSBE770
02673 **  INACTIVATION SHOULD NOT BE COUNTED AS A DETERMINATION.        DTSBE770
02674 **                                                                DTSBE770
02675 **   IF WRK-CURR-INACT-REV-DATE = ZERO                            DTSBE770
02676 *       IF WRK-REOPEN-DATE > WRK-LIAB-DATE                        DTSBE770
02677 *          PERFORM P3311-REOPEN   THRU P3311-EXIT                 DTSBE770
02678 *       ELSE                                                      DTSBE770
02679 *          PERFORM P3312-ORIG    THRU P3312-EXIT                  DTSBE770
02680 *       END-IF                                                    DTSBE770
02681 *    ELSE                                                         DTSBE770
02682 *       PERFORM P3313-INACT-REV  THRU P3313-EXIT                  DTSBE770
02683 **   END-IF.                                                      DTSBE770
02684                                                                   DTSBE770
02685  P3310-EXIT.                                                      DTSBE770
02686      EXIT.                                                        DTSBE770
02687                                                                   DTSBE770
02688  P3311-REOPEN.                                                    DTSBE770
02689 *    DISPLAY 'P3311 ' MPRF-EMP-NO '  ' WRK-LIAB-DATE              DTSBE770
02690 *       '  ' WRK-REOPEN-DATE                                      DTSBE770
02691 *       '  ' WRK-LAST-INACT-ENTER-DATE.                           DTSBE770
02692                                                                   DTSBE770
02693      SET WRK-DETERM-REACT-88        TO TRUE.                      DTSBE770
02694      MOVE WRK-CURR-ESTB-DATE        TO WRK-STATUS-DETERM-DATE.    DTSBE770
02695      MOVE WRK-REOPEN-DATE           TO WRK-STATUS-LIAB-DATE.      DTSBE770
02696 **   MOVE MSOL-LIAB-DATE            TO WRK-STATUS-LIAB-DATE.      DTSBE770
02697      MOVE WRK-LIAB-PROCESS-DATE     TO WRK-STATUS-ACT-DATE.       DTSBE770
02698      MOVE WRK-CURR-ESTB-DATE        TO WRK-STATUS-REACT-DATE.     DTSBE770
02699 **                                     WRK-STATUS-ACT-DATE.       DTSBE770
02700      MOVE WRK-LAST-INACT-ENTER-DATE TO WRK-STATUS-INACT-DATE.     DTSBE770
02701                                                                   DTSBE770
02702      PERFORM P3900-WRITE-X773       THRU P3900-EXIT.              DTSBE770
02703                                                                   DTSBE770
02704 *    DISPLAY 'REOPEN ' MPRF-EMP-NO                                DTSBE770
02705 *       '  STATUS ' WRK-CURR-ESTB-DATE                            DTSBE770
02706 *    DISPLAY '  ACT ' WRK-LIAB-PROCESS-DATE                       DTSBE770
02707 *       '  REOPEN ' WRK-CURR-ESTB-DATE                            DTSBE770
02708 *       '  INACT ' WRK-LAST-INACT-ENTER-DATE                      DTSBE770
02709 *       '  LIAB ' MSOL-LIAB-DATE.                                 DTSBE770
02710  P3311-EXIT.                                                      DTSBE770
02711      EXIT.                                                        DTSBE770
02712                                                                   DTSBE770
02713  P3312-ORIG.                                                      DTSBE770
02714      SET WRK-DETERM-ORIG-88         TO TRUE.                      DTSBE770
02715      MOVE WRK-CURR-ESTB-DATE        TO WRK-STATUS-DETERM-DATE.    DTSBE770
02716      MOVE MSOL-LIAB-DATE            TO WRK-STATUS-LIAB-DATE.      DTSBE770
02717      MOVE WRK-CURR-ESTB-DATE        TO WRK-STATUS-ACT-DATE.       DTSBE770
02718      MOVE ZERO                      TO WRK-STATUS-REACT-DATE      DTSBE770
02719                                        WRK-STATUS-INACT-DATE.     DTSBE770
02720                                                                   DTSBE770
02721      PERFORM P3900-WRITE-X773       THRU P3900-EXIT.              DTSBE770
02722                                                                   DTSBE770
02723 *    DISPLAY 'NEW    ' MPRF-EMP-NO                                DTSBE770
02724 *       '  STATUS ' WRK-CURR-ESTB-DATE                            DTSBE770
02725 *    DISPLAY '  ACT ' WRK-CURR-ESTB-DATE                          DTSBE770
02726 *       '  REOPEN          '                                      DTSBE770
02727 *       '  INACT          '                                       DTSBE770
02728 *       '  LIAB ' MSOL-LIAB-DATE.                                 DTSBE770
02729  P3312-EXIT.                                                      DTSBE770
02730      EXIT.                                                        DTSBE770
02731                                                                   DTSBE770
02732 *P3313-INACT-REV.                                                 DTSBE770
02733 *    SET WRK-DETERM-REACT-88        TO TRUE.                      DTSBE770
02734 *    MOVE WRK-CURR-INACT-REV-DATE   TO WRK-STATUS-DETERM-DATE.    DTSBE770
02735 *    MOVE MSOL-LIAB-DATE            TO WRK-STATUS-LIAB-DATE.      DTSBE770
02736 **   MOVE MSOL-ESTB-DATE            TO WRK-STATUS-ACT-DATE.       DTSBE770
02737 *    MOVE WRK-CURR-INACT-REV-DATE   TO WRK-STATUS-REACT-DATE      DTSBE770
02738 *                                      WRK-STATUS-ACT-DATE.       DTSBE770
02739 *    MOVE MSOL-INACT-ENTER-DATE     TO WRK-STATUS-INACT-DATE.     DTSBE770
02740 *                                                                 DTSBE770
02741 *    PERFORM P3900-WRITE-X773       THRU P3900-EXIT.              DTSBE770
02742 *                                                                 DTSBE770
02743 *    DISPLAY 'REV    ' MPRF-EMP-NO                                DTSBE770
02744 *       '  STATUS ' WRK-CURR-INACT-REV-DATE                       DTSBE770
02745 *    DISPLAY '  ACT ' MSOL-ESTB-DATE                              DTSBE770
02746 *       '  REOPEN ' WRK-CURR-INACT-REV-DATE                       DTSBE770
02747 *       '  INACT  ' MSOL-INACT-ENTER-DATE                         DTSBE770
02748 *       '  LIAB ' MSOL-LIAB-DATE.                                 DTSBE770
02749 *P3313-EXIT.                                                      DTSBE770
02750 *    EXIT.                                                        DTSBE770
02751                                                                   DTSBE770
02752  P3320-INACT.                                                     DTSBE770
02753      SET WRK-DETERM-INACT-88        TO TRUE.                      DTSBE770
02754      MOVE WRK-CURR-INACT-DATE       TO WRK-STATUS-DETERM-DATE.    DTSBE770
02755      MOVE MSOL-LIAB-DATE            TO WRK-STATUS-LIAB-DATE.      DTSBE770
02756      MOVE ZERO                      TO WRK-STATUS-ACT-DATE        DTSBE770
02757                                        WRK-STATUS-REACT-DATE.     DTSBE770
02758      MOVE WRK-CURR-INACT-DATE       TO WRK-STATUS-INACT-DATE.     DTSBE770
02759                                                                   DTSBE770
02760      PERFORM P3900-WRITE-X773       THRU P3900-EXIT.              DTSBE770
02761                                                                   DTSBE770
02762 *       DISPLAY 'INACT  ' MPRF-EMP-NO                             DTSBE770
02763 *          '  STATUS ' WRK-CURR-INACT-DATE                        DTSBE770
02764 *       DISPLAY '  ACT ' MSOL-ESTB-DATE                           DTSBE770
02765 *          '  REOPEN '                                            DTSBE770
02766 *          '  INACT  '                                            DTSBE770
02767 *          '  LIAB ' MSOL-LIAB-DATE.                              DTSBE770
02768  P3320-EXIT.                                                      DTSBE770
02769      EXIT.                                                        DTSBE770
02770                                                                   DTSBE770
02771  P3400-CHK-SUCCESSORS.                                            DTSBE770
02772      MOVE LOW-VALUES TO MREL-KEY-AREA.                            DTSBE770
02773      MOVE MPRF-EMP-NO TO MREL-EMP-NO.                             DTSBE770
02774      SET MREL-REL-88 TO TRUE.                                     DTSBE770
02775      MOVE MREL-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE770
02776      PERFORM S910-START-BROWSE         THRU S910-EXIT.            DTSBE770
02777      PERFORM UNTIL L910-NO-REC-88                                 DTSBE770
02778         MOVE MSKL-REC TO MREL-REC                                 DTSBE770
02779         PERFORM P3410-CHECK-MREL   THRU P3410-EXIT                DTSBE770
02780         IF NOT L910-NO-REC-88                                     DTSBE770
02781            PERFORM S910-READ-NEXT         THRU S910-EXIT          DTSBE770
02782         END-IF                                                    DTSBE770
02783      END-PERFORM.                                                 DTSBE770
02784                                                                   DTSBE770
02785      IF WRK-PRED-EMP-NO > ZERO                                    DTSBE770
02786         SET WRK-DETERM-SUC-88          TO TRUE                    DTSBE770
02787         PERFORM P3900-WRITE-X773       THRU P3900-EXIT            DTSBE770
02788 **      DISPLAY 'SUCC  ' MPRF-EMP-NO                              DTSBE770
02789 *          '  PRED ' WRK-PRED-EMP-NO                              DTSBE770
02790 *          '  DETERM ' WRK-STATUS-DETERM-DATE                     DTSBE770
02791 **         '  ACT ' WRK-STATUS-ACT-DATE                           DTSBE770
02792      END-IF.                                                      DTSBE770
02793                                                                   DTSBE770
02794  P3400-EXIT.                                                      DTSBE770
02795      EXIT.                                                        DTSBE770
02796                                                                   DTSBE770
02797  P3410-CHECK-MREL.                                                DTSBE770
02798      IF (MREL-ESTB-DATE <= WRK-SUBJECT-QTR-END                    DTSBE770
02799      AND MREL-ESTB-DATE >= WRK-SUBJECT-QTR-START)                 DTSBE770
02800         MOVE MREL-ESTB-DATE TO WRK-STATUS-DETERM-DATE             DTSBE770
02801                                WRK-STATUS-SUCC-DATE               DTSBE770
02802                                WRK-STATUS-ACT-DATE                DTSBE770
02803         MOVE MREL-EFF-DATE  TO WRK-STATUS-LIAB-DATE               DTSBE770
02804         MOVE MREL-PRED-EMP-NO  TO WRK-PRED-EMP-NO                 DTSBE770
02805 ***     PERFORM P3420-FIND-MSOL     THRU P3420-EXIT               DTSBE770
02806         SET L910-NO-REC-88     TO TRUE                            DTSBE770
02807      END-IF.                                                      DTSBE770
02808                                                                   DTSBE770
02809  P3410-EXIT.                                                      DTSBE770
02810      EXIT.                                                        DTSBE770
02811                                                                   DTSBE770
02812 *P3420-FIND-MSOL.                                                 DTSBE770
02813 *    MOVE LOW-VALUES TO MSOL-KEY-AREA.                            DTSBE770
02814 *    MOVE MPRF-EMP-NO TO MSOL-EMP-NO.                             DTSBE770
02815 *    SET MSOL-SOL-88 TO TRUE.                                     DTSBE770
02816 *    MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE770
02817 *    PERFORM S910-START-BROWSE         THRU S910-EXIT.            DTSBE770
02818 *    PERFORM UNTIL L910-NO-REC-88                                 DTSBE770
02819 *       MOVE MSKL-REC TO MSOL-REC                                 DTSBE770
02820 *       PERFORM P3421-CHECK-MSOL       THRU P3421-EXIT            DTSBE770
02821 *       PERFORM S910-READ-NEXT         THRU S910-EXIT             DTSBE770
02822 *    END-PERFORM.                                                 DTSBE770
02823 *                                                                 DTSBE770
02824 *P3420-EXIT.                                                      DTSBE770
02825 *    EXIT.                                                        DTSBE770
02826 *                                                                 DTSBE770
02827 *P3421-CHECK-MSOL.                                                DTSBE770
02828 *    IF (MSOL-ESTB-DATE <= WRK-SUBJECT-QTR-END                    DTSBE770
02829 *    AND MSOL-ESTB-DATE >= WRK-SUBJECT-QTR-START)                 DTSBE770
02830 *       MOVE MSOL-ESTB-DATE TO WRK-STATUS-ACT-DATE                DTSBE770
02831 *    END-IF.                                                      DTSBE770
02832 **   IF (MREL-EFF-DATE >= MSOL-LIAB-DATE                          DTSBE770
02833 *    AND MREL-EFF-DATE <= MSOL-INACT-DATE)                        DTSBE770
02834 *       MOVE MSOL-ESTB-DATE TO WRK-STATUS-ACT-DATE                DTSBE770
02835 **   END-IF.                                                      DTSBE770
02836 *                                                                 DTSBE770
02837 *P3421-EXIT.                                                      DTSBE770
02838 *    EXIT.                                                        DTSBE770
02839                                                                   DTSBE770
02840 *                                                                 DTSBE770
02841  P3900-WRITE-X773.                                                DTSBE770
02842      MOVE LENGTH OF Y773-REC TO Y773-LENGTH.                      DTSBE770
02843      SET Y773-REC-TYPE-773-88 TO TRUE.                            DTSBE770
02844                                                                   DTSBE770
02845      ADD +1            TO WRK-Y773-CNT.                           DTSBE770
02846                                                                   DTSBE770
02847      MOVE MPRF-EMP-NO     TO Y773-EMP-NO.                         DTSBE770
02848                                                                   DTSBE770
02849      MOVE MPRF-EMP-CLASS  TO Y773-EMP-CLASS.                      DTSBE770
02850                                                                   DTSBE770
02851      MOVE WRK-DETERM-TYPE-IND TO Y773-DETERM-TYPE.                DTSBE770
02852                                                                   DTSBE770
02853      MOVE WRK-STATUS-DETERM-DATE TO Y773-STATUS-DETERM-DATE.      DTSBE770
02854                                                                   DTSBE770
02855      MOVE WRK-STATUS-LIAB-DATE   TO Y773-LIAB-DATE.               DTSBE770
02856                                                                   DTSBE770
02857      MOVE WRK-STATUS-ACT-DATE    TO Y773-ACTIVATION-DATE.         DTSBE770
02858                                                                   DTSBE770
02859      MOVE WRK-STATUS-REACT-DATE  TO Y773-REACT-DATE.              DTSBE770
02860                                                                   DTSBE770
02861      MOVE WRK-STATUS-INACT-DATE  TO Y773-INACT-DATE.              DTSBE770
02862                                                                   DTSBE770
02863      MOVE WRK-STATUS-SUCC-DATE   TO Y773-SUCC-DATE.               DTSBE770
02864                                                                   DTSBE770
02865      MOVE WRK-PRED-EMP-NO    TO Y773-PRED-EMP-NO.                 DTSBE770
02866                                                                   DTSBE770
02867      PERFORM S773-WRITE-R773 THRU S773-EXIT.                      DTSBE770
02868                                                                   DTSBE770
02869 ******************************************************            DTSBE770
02870 *   ADD TPS STATUS UNIVERSE TRANSACTION RECORD                    DTSBE770
02871 ******************************************************            DTSBE770
02872      IF NOT MPRF-CLASS-SUB-88                                     DTSBE770
02873         GO TO P3900-EXIT                                          DTSBE770
02874      END-IF.                                                      DTSBE770
02875                                                                   DTSBE770
02876      SET M715-TYPE-STATUS-88        TO TRUE.                      DTSBE770
02877      MOVE MPRF-EMP-NO               TO M715-EMP-NO.               DTSBE770
02878      MOVE MPRF-PRIMARY-NAME         TO M715-EMP-NAME.             DTSBE770
02879      MOVE WRK-STATUS-DETERM-DATE    TO M715-PROCESS-DT.           DTSBE770
02880      EVALUATE TRUE                                                DTSBE770
02881        WHEN WRK-DETERM-ORIG-88                                    DTSBE770
02882          SET M715-DETERM-NEW-88     TO TRUE                       DTSBE770
02883          MOVE WRK-STATUS-LIAB-DATE  TO M715-EFF-DT                DTSBE770
02884                                                                   DTSBE770
02885        WHEN WRK-DETERM-REACT-88                                   DTSBE770
02886          SET M715-DETERM-NEW-88     TO TRUE                       DTSBE770
02887          MOVE WRK-STATUS-REACT-DATE TO M715-EFF-DT                DTSBE770
02888                                                                   DTSBE770
02889        WHEN WRK-DETERM-SUC-88                                     DTSBE770
02890          SET M715-DETERM-SUCC-88    TO TRUE                       DTSBE770
02891          MOVE WRK-STATUS-SUCC-DATE  TO M715-EFF-DT                DTSBE770
02892                                                                   DTSBE770
02893        WHEN WRK-DETERM-INACT-88                                   DTSBE770
02894          SET M715-DETERM-INACT-88   TO TRUE                       DTSBE770
02895          MOVE WRK-STATUS-INACT-DATE TO M715-EFF-DT                DTSBE770
02896                                                                   DTSBE770
02897      END-EVALUATE.                                                DTSBE770
02898                                                                   DTSBE770
02899      IF WRK-DETERM-NULL-88                                        DTSBE770
02900         DISPLAY 'WRK-DETERM-NULL ' MPRF-EMP-NO                    DTSBE770
02901         GO TO P3900-EXIT                                          DTSBE770
02902      END-IF.                                                      DTSBE770
02903                                                                   DTSBE770
02904      MOVE WRK-SUBJECT-QTR             TO L004-QTR-5-9.            DTSBE770
02905                                                                   DTSBE770
02906      EVALUATE TRUE                                                DTSBE770
02907        WHEN L004-QTR-5-Q = 1                                      DTSBE770
02908          WRITE TPS-STATUS-QTR1-REC     FROM TPS-TRANS-REC         DTSBE770
02909                                                                   DTSBE770
02910        WHEN L004-QTR-5-Q = 2                                      DTSBE770
02911          WRITE TPS-STATUS-QTR2-REC     FROM TPS-TRANS-REC         DTSBE770
02912                                                                   DTSBE770
02913        WHEN L004-QTR-5-Q = 3                                      DTSBE770
02914          WRITE TPS-STATUS-QTR3-REC     FROM TPS-TRANS-REC         DTSBE770
02915                                                                   DTSBE770
02916        WHEN L004-QTR-5-Q = 4                                      DTSBE770
02917          WRITE TPS-STATUS-QTR4-REC     FROM TPS-TRANS-REC         DTSBE770
02918                                                                   DTSBE770
02919      END-EVALUATE.                                                DTSBE770
02920                                                                   DTSBE770
02921      ADD +1                      TO WRK-TPS-STATUS-CNT.           DTSBE770
02922                                                                   DTSBE770
02923  P3900-EXIT.                                                      DTSBE770
02924      EXIT.                                                        DTSBE770
02925                                                                   DTSBE770
02926  P4000-ACCTS-RECEIVABLE.                                          DTSBE770
02927      PERFORM                                                      DTSBE770
02928        VARYING QTR-SUB FROM +1 BY +1                              DTSBE770
02929        UNTIL QTR-SUB > +400                                       DTSBE770
02930          MOVE +0 TO WRK-JRN-YRQ (QTR-SUB)                         DTSBE770
02931                     WRK-JRN-PAID (QTR-SUB)                        DTSBE770
02932                     WRK-JRN-CHG (QTR-SUB)                         DTSBE770
02933                     WRK-TAX-DUE-DATE (QTR-SUB)                    DTSBE770
02934      END-PERFORM.                                                 DTSBE770
02935                                                                   DTSBE770
02936      MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSBE770
02937      MOVE MPRF-EMP-NO TO MQTR-EMP-NO.                             DTSBE770
02938      SET MQTR-QTR-88 TO TRUE.                                     DTSBE770
02939      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE770
02940      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE770
02941      PERFORM UNTIL L910-NO-REC-88                                 DTSBE770
02942         MOVE MSKL-REC                TO MQTR-REC                  DTSBE770
02943         PERFORM P4100-MQTR-DUE-DATE  THRU P4100-EXIT              DTSBE770
02944         PERFORM S910-READ-NEXT       THRU S910-EXIT               DTSBE770
02945      END-PERFORM.                                                 DTSBE770
02946                                                                   DTSBE770
02947      MOVE LOW-VALUES TO MJRN-KEY-AREA.                            DTSBE770
02948      MOVE MPRF-EMP-NO TO MJRN-EMP-NO.                             DTSBE770
02949      SET MJRN-JRN-88 TO TRUE.                                     DTSBE770
02950      MOVE MJRN-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE770
02951      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE770
02952      PERFORM UNTIL L910-NO-REC-88                                 DTSBE770
02953         MOVE MSKL-REC         TO MJRN-REC                         DTSBE770
02954         ADD +1                    TO WRK-MJRN-READ-CNT            DTSBE770
02955         PERFORM P4200-ACCT-TABLE  THRU P4200-EXIT                 DTSBE770
02956         PERFORM S910-READ-NEXT    THRU S910-EXIT                  DTSBE770
02957      END-PERFORM.                                                 DTSBE770
02958                                                                   DTSBE770
02959                                                                   DTSBE770
02960  P4000-EXIT.                                                      DTSBE770
02961      EXIT.                                                        DTSBE770
02962                                                                   DTSBE770
02963  P4100-MQTR-DUE-DATE.                                             DTSBE770
02964      MOVE MQTR-YRQ                TO L004-QTR-5-9.                DTSBE770
02965      PERFORM S004-FROM-5          THRU S004-EXIT.                 DTSBE770
02966      MOVE L004-ABS-QTR            TO QTR-SUB.                     DTSBE770
02967      MOVE MQTR-TAX-DUE-DATE  TO                                   DTSBE770
02968                 WRK-TAX-DUE-DATE (QTR-SUB).                       DTSBE770
02969                                                                   DTSBE770
02970  P4100-EXIT.                                                      DTSBE770
02971      EXIT.                                                        DTSBE770
02972                                                                   DTSBE770
02973                                                                   DTSBE770
02974  P4200-ACCT-TABLE.                                                DTSBE770
02975      MOVE +400   TO WRK-FIRST-SUB.                                DTSBE770
02976      MOVE +0     TO WRK-LAST-SUB                                  DTSBE770
02977                     WRK-TBL-CNT.                                  DTSBE770
02978                                                                   DTSBE770
02979      PERFORM                                                      DTSBE770
02980        VARYING QTR-SUB FROM +1 BY +1                              DTSBE770
02981        UNTIL QTR-SUB > +400                                       DTSBE770
02982          MOVE +0 TO WRK-JRN-YRQ (QTR-SUB)                         DTSBE770
02983                     WRK-JRN-PAID (QTR-SUB)                        DTSBE770
02984                     WRK-JRN-CHG (QTR-SUB)                         DTSBE770
02985      END-PERFORM.                                                 DTSBE770
02986                                                                   DTSBE770
02987      IF MJRN-TRAN-CNVR-88                                         DTSBE770
02988         GO TO P4200-EXIT.                                         DTSBE770
02989                                                                   DTSBE770
02990      IF MJRN-ESTB-DATE > WRK-SUBJECT-QTR-END                      DTSBE770
02991         GO TO P4200-EXIT.                                         DTSBE770
02992                                                                   DTSBE770
02993      PERFORM P4210-ACCT-ENTRY  THRU P4210-EXIT                    DTSBE770
02994        VARYING MJRN-OCC-IDX FROM +1 BY +1                         DTSBE770
02995        UNTIL MJRN-OCC-IDX > MJRN-OCC-CNT.                         DTSBE770
02996                                                                   DTSBE770
02997      IF WRK-TBL-CNT > ZERO                                        DTSBE770
02998         PERFORM P4300-WRITE-OUTPUT  THRU P4300-EXIT.              DTSBE770
02999                                                                   DTSBE770
03000  P4200-EXIT.                                                      DTSBE770
03001      EXIT.                                                        DTSBE770
03002                                                                   DTSBE770
03003  P4210-ACCT-ENTRY.                                                DTSBE770
03004      IF MJRN-YRQ (MJRN-OCC-IDX) = LECM-PICKUP-YRQ                 DTSBE770
03005      OR MJRN-YRQ (MJRN-OCC-IDX) > WRK-SUBJECT-QTR                 DTSBE770
03006         GO TO P4210-EXIT.                                         DTSBE770
03007                                                                   DTSBE770
03008      IF MJRN-ROW-UI-88 (MJRN-OCC-IDX)                             DTSBE770
03009         NEXT SENTENCE                                             DTSBE770
03010      ELSE                                                         DTSBE770
03011         GO TO P4210-EXIT.                                         DTSBE770
03012                                                                   DTSBE770
03013      IF MJRN-COL-PAID-88 (MJRN-OCC-IDX)                           DTSBE770
03014      OR MJRN-COL-CHARGED-88 (MJRN-OCC-IDX)                        DTSBE770
03015      OR MJRN-COL-TOLERATED-88 (MJRN-OCC-IDX)                      DTSBE770
03016         NEXT SENTENCE                                             DTSBE770
03017      ELSE                                                         DTSBE770
03018         GO TO P4210-EXIT.                                         DTSBE770
03019                                                                   DTSBE770
03020      ADD +1 TO WRK-TBL-CNT.                                       DTSBE770
03021                                                                   DTSBE770
03022      MOVE MJRN-YRQ (MJRN-OCC-IDX) TO L004-QTR-5-9.                DTSBE770
03023      PERFORM S004-FROM-5          THRU S004-EXIT.                 DTSBE770
03024      MOVE L004-ABS-QTR            TO QTR-SUB.                     DTSBE770
03025      MOVE L004-QTR-5-9            TO WRK-JRN-YRQ (QTR-SUB).       DTSBE770
03026                                                                   DTSBE770
03027      IF QTR-SUB < WRK-FIRST-SUB                                   DTSBE770
03028         MOVE QTR-SUB TO WRK-FIRST-SUB.                            DTSBE770
03029                                                                   DTSBE770
03030      IF QTR-SUB > WRK-LAST-SUB                                    DTSBE770
03031         MOVE QTR-SUB TO WRK-LAST-SUB.                             DTSBE770
03032                                                                   DTSBE770
03033      IF WRK-TAX-DUE-DATE (QTR-SUB) = ZERO                         DTSBE770
03034         MOVE L004-QTR-DEFAULT-DUE-DATE TO                         DTSBE770
03035              WRK-TAX-DUE-DATE (QTR-SUB)                           DTSBE770
03036      END-IF.                                                      DTSBE770
03037                                                                   DTSBE770
03038      IF MJRN-COL-PAID-88 (MJRN-OCC-IDX)                           DTSBE770
03039      OR MJRN-COL-TOLERATED-88 (MJRN-OCC-IDX)                      DTSBE770
03040          ADD MJRN-AMT (MJRN-OCC-IDX) TO WRK-JRN-PAID (QTR-SUB)    DTSBE770
03041      ELSE                                                         DTSBE770
03042      IF MJRN-COL-CHARGED-88 (MJRN-OCC-IDX)                        DTSBE770
03043         ADD MJRN-AMT (MJRN-OCC-IDX) TO WRK-JRN-CHG (QTR-SUB).     DTSBE770
03044                                                                   DTSBE770
03045  P4210-EXIT.                                                      DTSBE770
03046      EXIT.                                                        DTSBE770
03047                                                                   DTSBE770
03048                                                                   DTSBE770
03049  P4300-WRITE-OUTPUT.                                              DTSBE770
03050      PERFORM P4310-SCAN-QTR-TAB  THRU P4310-EXIT                  DTSBE770
03051        VARYING QTR-SUB FROM WRK-FIRST-SUB BY +1                   DTSBE770
03052        UNTIL QTR-SUB > WRK-LAST-SUB.                              DTSBE770
03053                                                                   DTSBE770
03054  P4300-EXIT.                                                      DTSBE770
03055      EXIT.                                                        DTSBE770
03056                                                                   DTSBE770
03057  P4310-SCAN-QTR-TAB.                                              DTSBE770
03058      IF WRK-JRN-YRQ (QTR-SUB) = ZERO                              DTSBE770
03059         GO TO P4310-EXIT.                                         DTSBE770
03060                                                                   DTSBE770
03061      COMPUTE WRK-AMT =                                            DTSBE770
03062         (WRK-JRN-CHG (QTR-SUB) - WRK-JRN-PAID (QTR-SUB)).         DTSBE770
03063      PERFORM P4311-WRITE-Y774     THRU P4311-EXIT.                DTSBE770
03064                                                                   DTSBE770
03065  P4310-EXIT.                                                      DTSBE770
03066      EXIT.                                                        DTSBE770
03067                                                                   DTSBE770
03068  P4311-WRITE-Y774.                                                DTSBE770
03069      MOVE LENGTH OF Y774-REC TO Y774-LENGTH.                      DTSBE770
03070      SET Y774-REC-TYPE-774-88 TO TRUE.                            DTSBE770
03071                                                                   DTSBE770
03072      MOVE MPRF-EMP-NO       TO Y774-EMP-NO.                       DTSBE770
03073      MOVE WRK-JRN-YRQ (QTR-SUB)  TO Y774-YRQ.                     DTSBE770
03074      MOVE MJRN-ESTB-DATE         TO Y774-ESTB-DATE.               DTSBE770
03075      MOVE MJRN-RECEIVED-DATE     TO Y774-RCVD-DATE.               DTSBE770
03076      MOVE WRK-TAX-DUE-DATE (QTR-SUB)                              DTSBE770
03077                                  TO Y774-DUE-DATE.                DTSBE770
03078                                                                   DTSBE770
03079      IF WRK-AMT > ZERO                                            DTSBE770
03080         SET Y774-TYPE-RECEIVABLE-88 TO TRUE                       DTSBE770
03081      ELSE                                                         DTSBE770
03082         SET Y774-TYPE-LIQUIDATION-88 TO TRUE.                     DTSBE770
03083                                                                   DTSBE770
03084      IF MPRF-CLASS-RATED-88                                       DTSBE770
03085         SET Y774-EMP-CLASS-CONTRIB-88   TO TRUE                   DTSBE770
03086      ELSE                                                         DTSBE770
03087         IF MPRF-CLASS-SELF-INS-88                                 DTSBE770
03088            SET Y774-EMP-CLASS-REIMB-88  TO TRUE                   DTSBE770
03089         ELSE                                                      DTSBE770
03090            GO TO P4311-EXIT.                                      DTSBE770
03091                                                                   DTSBE770
03092      MOVE WRK-AMT       TO Y774-AMT.                              DTSBE770
03093                                                                   DTSBE770
03094      PERFORM S774-WRITE-R774 THRU S774-EXIT.                      DTSBE770
03095      ADD +1 TO WRK-Y774-CNT.                                      DTSBE770
03096                                                                   DTSBE770
03097  P4311-EXIT.                                                      DTSBE770
03098      EXIT.                                                        DTSBE770
03099                                                                   DTSBE770
03100  P5000-AUDIT-ACTIVITY.                                            DTSBE770
03101 **   THE INDICATOR BELOW IS ONLY SET WHEN THERE IS A CURRENT      DTSBE770
03102 **   FIELD ASSIGNMENT. IT CANNOT BE USED TO DETERMINE WHETHER     DTSBE770
03103 **   AN AUDIT ASSIGNMENT EXISTS.                                  DTSBE770
03104 **   IF MPRF-NO-MFAS-88                                           DTSBE770
03105 **       GO TO P5000-EXIT.                                        DTSBE770
03106                                                                   DTSBE770
03107      MOVE LOW-VALUES TO MFAS-KEY-AREA.                            DTSBE770
03108      MOVE MPRF-EMP-NO TO MFAS-EMP-NO.                             DTSBE770
03109      SET MFAS-FAS-88 TO TRUE.                                     DTSBE770
03110      MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE770
03111      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE770
03112      PERFORM P5100-SCAN-MFAS THRU P5100-EXIT                      DTSBE770
03113          UNTIL L910-NO-REC-88.                                    DTSBE770
03114  P5000-EXIT.                                                      DTSBE770
03115      EXIT.                                                        DTSBE770
03116      SKIP3                                                        DTSBE770
03117  P5100-SCAN-MFAS.                                                 DTSBE770
03118      MOVE MSKL-REC TO MFAS-REC.                                   DTSBE770
03119                                                                   DTSBE770
03120      IF (MFAS-PROCESSED-DATE < WRK-SUBJECT-QTR-START)             DTSBE770
03121              OR                                                   DTSBE770
03122         (MFAS-PROCESSED-DATE > WRK-SUBJECT-QTR-END)               DTSBE770
03123          NEXT SENTENCE                                            DTSBE770
03124      ELSE                                                         DTSBE770
03125          PERFORM P5110-INIT-RESULTS  THRU P5110-EXIT              DTSBE770
03126          PERFORM P5120-AUDIT-RESULTS THRU P5120-EXIT              DTSBE770
03127          MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA                      DTSBE770
03128          PERFORM S910-START-BROWSE THRU S910-EXIT                 DTSBE770
03129          IF L910-NO-REC-88                                        DTSBE770
03130              MOVE 'LOGIC ERROR IN P5100' TO ABEND-MSG             DTSBE770
03131              PERFORM S999-ABEND THRU S999-EXIT.                   DTSBE770
03132                                                                   DTSBE770
03133      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBE770
03134  P5100-EXIT.                                                      DTSBE770
03135      EXIT.                                                        DTSBE770
03136      SKIP3                                                        DTSBE770
03137  P5110-INIT-RESULTS.                                              DTSBE770
03138      MOVE ZERO              TO  WRK-POST-AUDIT-TOT-WAGE           DTSBE770
03139                                 WRK-PRE-AUDIT-TOT-WAGE            DTSBE770
03140                                 WRK-OVER-RPT-TOT-WAGE             DTSBE770
03141                                 WRK-UNDER-RPT-TOT-WAGE            DTSBE770
03142                                 WRK-POST-AUDIT-TAX-WAGE           DTSBE770
03143                                 WRK-PRE-AUDIT-TAX-WAGE            DTSBE770
03144                                 WRK-OVER-RPT-TAX-WAGE             DTSBE770
03145                                 WRK-UNDER-RPT-TAX-WAGE            DTSBE770
03146                                 WRK-POST-AUDIT-CONTRIB            DTSBE770
03147                                 WRK-PRE-AUDIT-CONTRIB             DTSBE770
03148                                 WRK-UNDER-RPT-CONTRIB             DTSBE770
03149                                 WRK-OVER-RPT-CONTRIB.             DTSBE770
03150                                                                   DTSBE770
03151  P5110-EXIT.                                                      DTSBE770
03152      EXIT.                                                        DTSBE770
03153                                                                   DTSBE770
03154  P5120-AUDIT-RESULTS.                                             DTSBE770
03155      MOVE LOW-VALUES TO MAUR-KEY-AREA.                            DTSBE770
03156      MOVE MPRF-EMP-NO TO MAUR-EMP-NO.                             DTSBE770
03157      SET MAUR-AUR-88 TO TRUE.                                     DTSBE770
03158      MOVE MFAS-ASSIGN-NO TO MAUR-ASSIGN-NO.                       DTSBE770
03159      MOVE MAUR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE770
03160      PERFORM S910-READ THRU S910-EXIT.                            DTSBE770
03161      IF L910-NO-REC-88                                            DTSBE770
03162          GO TO P5120-EXIT.                                        DTSBE770
03163                                                                   DTSBE770
03164      MOVE MSKL-REC TO MAUR-REC.                                   DTSBE770
03165                                                                   DTSBE770
03166      MOVE 'N' TO WRK-CHANGE-AUDIT-IND.                            DTSBE770
03167                                                                   DTSBE770
03168      MOVE LOW-VALUES TO MAUY-KEY-AREA.                            DTSBE770
03169      MOVE MPRF-EMP-NO TO MAUY-EMP-NO.                             DTSBE770
03170      SET MAUY-AUY-88 TO TRUE.                                     DTSBE770
03171      MOVE MFAS-ASSIGN-NO TO MAUY-ASSIGN-NO.                       DTSBE770
03172      MOVE MAUY-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE770
03173      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE770
03174      PERFORM P5121-SCAN-MAUY THRU P5121-EXIT                      DTSBE770
03175          UNTIL L910-NO-REC-88.                                    DTSBE770
03176                                                                   DTSBE770
03177      PERFORM P5130-GET-TAX-CONTRB THRU P5130-EXIT.                DTSBE770
03178                                                                   DTSBE770
03179      PERFORM P5200-WRITE-Y775     THRU P5200-EXIT.                DTSBE770
03180                                                                   DTSBE770
03181  P5120-EXIT.                                                      DTSBE770
03182      EXIT.                                                        DTSBE770
03183      SKIP3                                                        DTSBE770
03184  P5121-SCAN-MAUY.                                                 DTSBE770
03185      MOVE MSKL-REC TO MAUY-REC.                                   DTSBE770
03186                                                                   DTSBE770
03187      IF MAUY-ASSIGN-NO = MFAS-ASSIGN-NO                           DTSBE770
03188          NEXT SENTENCE                                            DTSBE770
03189      ELSE                                                         DTSBE770
03190          SET L910-NO-REC-88 TO TRUE                               DTSBE770
03191          GO TO P5121-EXIT.                                        DTSBE770
03192                                                                   DTSBE770
03193      PERFORM P5121A-QTR-LOOP THRU P5121A-EXIT                     DTSBE770
03194          VARYING MAUY-QTR-IDX FROM 1 BY 1                         DTSBE770
03195          UNTIL MAUY-QTR-IDX > MMAX-AUY-QTR-MAX.                   DTSBE770
03196                                                                   DTSBE770
03197      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBE770
03198  P5121-EXIT.                                                      DTSBE770
03199      EXIT.                                                        DTSBE770
03200      SKIP3                                                        DTSBE770
03201  P5121A-QTR-LOOP.                                                 DTSBE770
03202      IF MAUY-QTR-NOT-AUDITED-88 (MAUY-QTR-IDX)                    DTSBE770
03203          GO TO P5121A-EXIT.                                       DTSBE770
03204                                                                   DTSBE770
03205      ADD MAUY-QTR-GROSS-PAYROLL (MAUY-QTR-IDX)                    DTSBE770
03206       TO WRK-POST-AUDIT-TOT-WAGE.                                 DTSBE770
03207                                                                   DTSBE770
03208      IF (MAUY-QTR-UNDER-TOT-WAGE (MAUY-QTR-IDX) = +0)             DTSBE770
03209              AND                                                  DTSBE770
03210         (MAUY-QTR-UNDER-TAX-WAGE (MAUY-QTR-IDX) = +0)             DTSBE770
03211              AND                                                  DTSBE770
03212         (MAUY-QTR-UNDER-CONTRIB (MAUY-QTR-IDX) = +0)              DTSBE770
03213              AND                                                  DTSBE770
03214         (MAUY-QTR-OVER-TOT-WAGE (MAUY-QTR-IDX) = +0)              DTSBE770
03215              AND                                                  DTSBE770
03216         (MAUY-QTR-OVER-TAX-WAGE (MAUY-QTR-IDX) = +0)              DTSBE770
03217              AND                                                  DTSBE770
03218         (MAUY-QTR-OVER-CONTRIB (MAUY-QTR-IDX) = +0)               DTSBE770
03219          NEXT SENTENCE                                            DTSBE770
03220      ELSE                                                         DTSBE770
03221         MOVE 'Y' TO WRK-CHANGE-AUDIT-IND.                         DTSBE770
03222                                                                   DTSBE770
03223      ADD MAUY-QTR-UNDER-TOT-WAGE (MAUY-QTR-IDX)                   DTSBE770
03224       TO WRK-UNDER-RPT-TOT-WAGE.                                  DTSBE770
03225                                                                   DTSBE770
03226      ADD MAUY-QTR-UNDER-TAX-WAGE (MAUY-QTR-IDX)                   DTSBE770
03227       TO WRK-UNDER-RPT-TAX-WAGE.                                  DTSBE770
03228                                                                   DTSBE770
03229      ADD MAUY-QTR-UNDER-CONTRIB (MAUY-QTR-IDX)                    DTSBE770
03230       TO WRK-UNDER-RPT-CONTRIB.                                   DTSBE770
03231                                                                   DTSBE770
03232      ADD MAUY-QTR-OVER-TOT-WAGE (MAUY-QTR-IDX)                    DTSBE770
03233       TO WRK-OVER-RPT-TOT-WAGE.                                   DTSBE770
03234                                                                   DTSBE770
03235      ADD MAUY-QTR-OVER-TAX-WAGE (MAUY-QTR-IDX)                    DTSBE770
03236       TO WRK-OVER-RPT-TAX-WAGE.                                   DTSBE770
03237                                                                   DTSBE770
03238      ADD MAUY-QTR-OVER-CONTRIB (MAUY-QTR-IDX)                     DTSBE770
03239       TO WRK-OVER-RPT-CONTRIB.                                    DTSBE770
03240                                                                   DTSBE770
03241      COMPUTE WRK-PRE-AUDIT-TOT-WAGE                               DTSBE770
03242        = WRK-POST-AUDIT-TOT-WAGE                                  DTSBE770
03243            - WRK-UNDER-RPT-TOT-WAGE                               DTSBE770
03244            + WRK-OVER-RPT-TOT-WAGE.                               DTSBE770
03245                                                                   DTSBE770
03246  P5121A-EXIT.                                                     DTSBE770
03247      EXIT.                                                        DTSBE770
03248                                                                   DTSBE770
03249  P5130-GET-TAX-CONTRB.                                            DTSBE770
03250      MOVE ZERO           TO WRK-AUDIT-TOT-WAGE                    DTSBE770
03251                             WRK-AUDIT-TAX-WAGE                    DTSBE770
03252                             WRK-AUDIT-UI-CHG                      DTSBE770
03253                             WRK-ORIG-TOT-WAGE                     DTSBE770
03254                             WRK-ORIG-TAX-WAGE                     DTSBE770
03255                             WRK-ORIG-UI-CHG.                      DTSBE770
03256                                                                   DTSBE770
03257      MOVE LOW-VALUES TO MRPT-KEY-AREA.                            DTSBE770
03258      MOVE MPRF-EMP-NO TO MRPT-EMP-NO.                             DTSBE770
03259      SET MRPT-RPT-88 TO TRUE.                                     DTSBE770
03260      MOVE MAUR-FIRST-YRQ TO MRPT-YRQ.                             DTSBE770
03261      MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE770
03262      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE770
03263      PERFORM P5131-SCAN-MRPT THRU P5131-EXIT                      DTSBE770
03264          UNTIL L910-NO-REC-88.                                    DTSBE770
03265                                                                   DTSBE770
03266                                                                   DTSBE770
03267      MOVE WRK-ORIG-TAX-WAGE TO WRK-PRE-AUDIT-TAX-WAGE.            DTSBE770
03268      COMPUTE WRK-POST-AUDIT-TAX-WAGE =                            DTSBE770
03269         (WRK-ORIG-TAX-WAGE + WRK-AUDIT-TAX-WAGE).                 DTSBE770
03270                                                                   DTSBE770
03271      IF WRK-POST-AUDIT-TAX-WAGE > WRK-PRE-AUDIT-TAX-WAGE          DTSBE770
03272 **NH    COMPUTE WRK-UNDER-RPT-TAX-WAGE =                          DTSBE770
03273 **NH    (WRK-POST-AUDIT-TAX-WAGE - WRK-PRE-AUDIT-TAX-WAGE)        DTSBE770
03274         CONTINUE                                                  DTSBE770
03275      ELSE                                                         DTSBE770
03276         IF WRK-POST-AUDIT-TAX-WAGE < WRK-PRE-AUDIT-TAX-WAGE       DTSBE770
03277 **NH       COMPUTE WRK-OVER-RPT-TAX-WAGE =                        DTSBE770
03278 **NH       (WRK-PRE-AUDIT-TAX-WAGE - WRK-POST-AUDIT-TAX-WAGE)     DTSBE770
03279         CONTINUE                                                  DTSBE770
03280         ELSE                                                      DTSBE770
03281 **NH       MOVE ZERO           TO WRK-PRE-AUDIT-TAX-WAGE          DTSBE770
03282 **NH                              WRK-POST-AUDIT-TAX-WAGE         DTSBE770
03283            MOVE ZERO           TO WRK-UNDER-RPT-TAX-WAGE          DTSBE770
03284                                   WRK-OVER-RPT-TAX-WAGE           DTSBE770
03285         END-IF                                                    DTSBE770
03286      END-IF.                                                      DTSBE770
03287                                                                   DTSBE770
03288      MOVE WRK-ORIG-UI-CHG      TO WRK-PRE-AUDIT-CONTRIB.          DTSBE770
03289      COMPUTE WRK-POST-AUDIT-CONTRIB =                             DTSBE770
03290         (WRK-ORIG-UI-CHG + WRK-AUDIT-UI-CHG).                     DTSBE770
03291                                                                   DTSBE770
03292      IF WRK-POST-AUDIT-CONTRIB  > WRK-PRE-AUDIT-CONTRIB           DTSBE770
03293 **NH    COMPUTE WRK-UNDER-RPT-CONTRIB =                           DTSBE770
03294 **NH    (WRK-POST-AUDIT-CONTRIB  - WRK-PRE-AUDIT-CONTRIB)         DTSBE770
03295         CONTINUE                                                  DTSBE770
03296      ELSE                                                         DTSBE770
03297         IF WRK-POST-AUDIT-CONTRIB  < WRK-PRE-AUDIT-CONTRIB        DTSBE770
03298 **NH       COMPUTE WRK-OVER-RPT-CONTRIB  =                        DTSBE770
03299 **NH       (WRK-PRE-AUDIT-CONTRIB  - WRK-POST-AUDIT-CONTRIB)      DTSBE770
03300            CONTINUE                                               DTSBE770
03301         ELSE                                                      DTSBE770
03302 *NH        MOVE ZERO           TO WRK-PRE-AUDIT-CONTRIB           DTSBE770
03303 *NH                               WRK-POST-AUDIT-CONTRIB          DTSBE770
03304            MOVE ZERO           TO WRK-UNDER-RPT-CONTRIB           DTSBE770
03305                                   WRK-OVER-RPT-CONTRIB            DTSBE770
03306         END-IF                                                    DTSBE770
03307      END-IF.                                                      DTSBE770
03308                                                                   DTSBE770
03309 *&                                                                DTSBE770
03310 *    IF MFAS-EMP-NO = 134222                                      DTSBE770
03311 *       DISPLAY 'P5130 ' MPRF-EMP-NO                              DTSBE770
03312 *          '  FIRST YRQ ' MAUR-FIRST-YRQ                          DTSBE770
03313 *          '  LAST YRQ ' MAUR-LAST-YRQ                            DTSBE770
03314 *       DISPLAY '   ORIG TOT ' WRK-ORIG-TOT-WAGE                  DTSBE770
03315 *               '  AUDIT TOT ' WRK-AUDIT-TOT-WAGE                 DTSBE770
03316 *       DISPLAY '   ORIG TAX ' WRK-ORIG-TAX-WAGE                  DTSBE770
03317 *               '  AUDIT TAX ' WRK-AUDIT-TAX-WAGE                 DTSBE770
03318 *       DISPLAY '   ORIG CHG ' WRK-ORIG-UI-CHG                    DTSBE770
03319 *               '  AUDIT CHG ' WRK-AUDIT-UI-CHG                   DTSBE770
03320 *       DISPLAY 'P5130 PRE AUDIT TOT WAGE '                       DTSBE770
03321 *             WRK-PRE-AUDIT-TOT-WAGE                              DTSBE770
03322 *    END-IF.                                                      DTSBE770
03323 *&                                                                DTSBE770
03324  P5130-EXIT.                                                      DTSBE770
03325      EXIT.                                                        DTSBE770
03326                                                                   DTSBE770
03327  P5131-SCAN-MRPT.                                                 DTSBE770
03328      MOVE MSKL-REC         TO MRPT-REC.                           DTSBE770
03329                                                                   DTSBE770
03330      IF MRPT-YRQ < MAUR-FIRST-YRQ                                 DTSBE770
03331         NEXT SENTENCE                                             DTSBE770
03332      ELSE                                                         DTSBE770
03333         IF MRPT-YRQ > MAUR-LAST-YRQ                               DTSBE770
03334            SET L910-NO-REC-88  TO TRUE                            DTSBE770
03335            GO TO P5131-EXIT                                       DTSBE770
03336         ELSE                                                      DTSBE770
03337            IF MRPT-AUDIT-88                                       DTSBE770
03338               PERFORM P5131A-SUM-AUDIT-AMTS  THRU P5131A-EXIT     DTSBE770
03339            ELSE                                                   DTSBE770
03340               PERFORM P5131B-SUM-ORIG-AMTS   THRU P5131B-EXIT     DTSBE770
03341            END-IF                                                 DTSBE770
03342         END-IF                                                    DTSBE770
03343      END-IF.                                                      DTSBE770
03344                                                                   DTSBE770
03345      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBE770
03346                                                                   DTSBE770
03347  P5131-EXIT.                                                      DTSBE770
03348      EXIT.                                                        DTSBE770
03349                                                                   DTSBE770
03350  P5131A-SUM-AUDIT-AMTS.                                           DTSBE770
03351      ADD MRPT-TOT-WAGE            TO WRK-AUDIT-TOT-WAGE.          DTSBE770
03352      ADD MRPT-TAX-WAGE            TO WRK-AUDIT-TAX-WAGE.          DTSBE770
03353      ADD MRPT-UI-CHARGED-AMT      TO WRK-AUDIT-UI-CHG.            DTSBE770
03354                                                                   DTSBE770
03355  P5131A-EXIT.                                                     DTSBE770
03356      EXIT.                                                        DTSBE770
03357                                                                   DTSBE770
03358  P5131B-SUM-ORIG-AMTS.                                            DTSBE770
03359      ADD MRPT-TOT-WAGE            TO WRK-ORIG-TOT-WAGE.           DTSBE770
03360      ADD MRPT-TAX-WAGE            TO WRK-ORIG-TAX-WAGE.           DTSBE770
03361      ADD MRPT-UI-CHARGED-AMT      TO WRK-ORIG-UI-CHG.             DTSBE770
03362                                                                   DTSBE770
03363  P5131B-EXIT.                                                     DTSBE770
03364      EXIT.                                                        DTSBE770
03365                                                                   DTSBE770
03366  P5200-WRITE-Y775.                                                DTSBE770
03367      MOVE LENGTH OF Y775-REC TO Y775-LENGTH.                      DTSBE770
03368      SET Y775-REC-TYPE-775-88 TO TRUE.                            DTSBE770
03369                                                                   DTSBE770
03370      MOVE MPRF-EMP-NO             TO Y775-EMP-NO.                 DTSBE770
03371      MOVE MFAS-ASSIGN-NO          TO Y775-AUDIT-ID.               DTSBE770
03372                                                                   DTSBE770
03373      MOVE MAUR-EMP-SIZE-IND       TO Y775-EMP-SIZE-IND.           DTSBE770
03374      MOVE WRK-CHANGE-AUDIT-IND    TO Y775-CHANGE-AUDIT-IND.       DTSBE770
03375      MOVE MFAS-PROCESSED-DATE     TO Y775-AUDIT-CMPL-DATE.        DTSBE770
03376                                                                   DTSBE770
03377      MOVE WRK-POST-AUDIT-TOT-WAGE TO Y775-POST-AUDIT-TOT-WAGE.    DTSBE770
03378      MOVE WRK-PRE-AUDIT-TOT-WAGE  TO Y775-PRE-AUDIT-TOT-WAGE.     DTSBE770
03379                                                                   DTSBE770
03380      MOVE WRK-UNDER-RPT-TOT-WAGE  TO Y775-UNDER-RPT-TOT-WAGE.     DTSBE770
03381      MOVE WRK-OVER-RPT-TOT-WAGE   TO Y775-OVER-RPT-TOT-WAGE.      DTSBE770
03382      MOVE WRK-UNDER-RPT-TAX-WAGE  TO Y775-UNDER-RPT-TAX-WAGE.     DTSBE770
03383      MOVE WRK-UNDER-RPT-CONTRIB   TO Y775-UNDER-RPT-CONTRIB.      DTSBE770
03384      MOVE WRK-OVER-RPT-TAX-WAGE   TO Y775-OVER-RPT-TAX-WAGE.      DTSBE770
03385      MOVE WRK-OVER-RPT-CONTRIB    TO Y775-OVER-RPT-CONTRIB.       DTSBE770
03386      MOVE WRK-PRE-AUDIT-TAX-WAGE  TO Y775-PRE-AUDIT-TAX-WAGE      DTSBE770
03387      MOVE WRK-POST-AUDIT-TAX-WAGE TO Y775-POST-AUDIT-TAX-WAGE     DTSBE770
03388      MOVE WRK-PRE-AUDIT-CONTRIB   TO Y775-PRE-AUDIT-CONTRIB       DTSBE770
03389      MOVE WRK-POST-AUDIT-CONTRIB  TO Y775-POST-AUDIT-CONTRIB.     DTSBE770
03390                                                                   DTSBE770
03391      MOVE MAUR-QTRS-AUDITED-CNT   TO Y775-QTR-CNT.                DTSBE770
03392      MOVE MAUR-AUDIT-HRS          TO Y775-HOURS.                  DTSBE770
03393      MOVE MAUR-INDCON-TO-EMPL-CNT TO Y775-IND-CON-CNT.            DTSBE770
03394      MOVE MAUR-NEW-EMPLOYEE-CNT   TO Y775-NEW-EMPLOYEE-CNT.          CL*31
03395                                                                   DTSBE770
03396      PERFORM S775-WRITE-R775 THRU S775-EXIT.                      DTSBE770
03397      ADD +1                 TO WRK-Y775-CNT.                      DTSBE770
03398                                                                   DTSBE770
03399  P5200-EXIT.                                                      DTSBE770
03400      EXIT.                                                        DTSBE770
03401                                                                   DTSBE770
03402  P9000-OUTSTANDING-QTRS.                                          DTSBE770
03403      MOVE ZERO          TO WRK-UI-CHG.                            DTSBE770
03404                                                                   DTSBE770
03405      IF MPRF-CLASS-SELF-INS-88                                    DTSBE770
03406          GO TO P9000-EXIT.                                        DTSBE770
03407                                                                   DTSBE770
03408      IF MPRF-PURSUED-RPT-CNT > +0                                 DTSBE770
03409          NEXT SENTENCE                                            DTSBE770
03410      ELSE                                                         DTSBE770
03411          GO TO P9000-EXIT.                                        DTSBE770
03412                                                                   DTSBE770
03413      MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSBE770
03414      MOVE MPRF-EMP-NO TO MQTR-EMP-NO.                             DTSBE770
03415      SET MQTR-QTR-88 TO TRUE.                                     DTSBE770
03416      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE770
03417      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE770
03418      PERFORM P9010-SCAN-MQTR THRU P9010-EXIT                      DTSBE770
03419          UNTIL L910-NO-REC-88.                                    DTSBE770
03420                                                                   DTSBE770
03421  P9000-EXIT.                                                      DTSBE770
03422      EXIT.                                                        DTSBE770
03423                                                                   DTSBE770
03424  P9010-SCAN-MQTR.                                                 DTSBE770
03425      MOVE MSKL-REC TO MQTR-REC.                                   DTSBE770
03426                                                                   DTSBE770
03427      IF MQTR-CURR-RCVD-88                                         DTSBE770
03428         IF MQTR-TAX-WAGE > ZERO                                   DTSBE770
03429         AND MQTR-UI-RATE > ZERO                                   DTSBE770
03430            COMPUTE WRK-UI-CHG = (MQTR-TAX-WAGE * MQTR-UI-RATE)    DTSBE770
03431         END-IF                                                    DTSBE770
03432      ELSE                                                         DTSBE770
03433         IF MQTR-RPT-IS-PURSUED-88                                 DTSBE770
03434            IF MQTR-CURR-ESTIM-88                                  DTSBE770
03435               IF MQTR-YRQ = WRK-QTR1                              DTSBE770
03436                  ADD +1 TO WRK-OUTSTANDING-QTR-CNT                DTSBE770
03437               END-IF                                              DTSBE770
03438            ELSE                                                   DTSBE770
03439               ADD +1 TO WRK-OUTSTANDING-QTR-CNT                   DTSBE770
03440               ADD +1 TO WRK-ITEM13-CNT                            DTSBE770
03441               ADD WRK-UI-CHG TO WRK-OUTSTANDING-BAL               DTSBE770
03442            END-IF                                                 DTSBE770
03443         END-IF                                                    DTSBE770
03444      END-IF.                                                      DTSBE770
03445                                                                   DTSBE770
03446 **   IF MQTR-CURR-RCVD-88                                         DTSBE770
03447 *       IF MQTR-TAX-WAGE > ZERO                                   DTSBE770
03448 *       AND MQTR-UI-RATE > ZERO                                   DTSBE770
03449 *          COMPUTE WRK-UI-CHG = (MQTR-TAX-WAGE * MQTR-UI-RATE)    DTSBE770
03450 *       END-IF                                                    DTSBE770
03451 *    ELSE                                                         DTSBE770
03452 *       IF MQTR-RPT-IS-PURSUED-88                                 DTSBE770
03453 *          ADD +1 TO WRK-OUTSTANDING-QTR-CNT                      DTSBE770
03454 *          IF MQTR-CURR-ESTIM-88                                  DTSBE770
03455 *             NEXT SENTENCE                                       DTSBE770
03456 *          ELSE                                                   DTSBE770
03457 *             ADD +1 TO WRK-ITEM13-CNT                            DTSBE770
03458 **            ADD WRK-UI-CHG TO WRK-OUTSTANDING-BAL.              DTSBE770
03459                                                                   DTSBE770
03460      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBE770
03461                                                                   DTSBE770
03462  P9010-EXIT.                                                      DTSBE770
03463      EXIT.                                                        DTSBE770
03464                                                                   DTSBE770
03465  P9100-SUTA-DUMPING.                                              DTSBE770
03466      MOVE +0                        TO WRK-EFF-DATE               DTSBE770
03467                                        WRK-SUTA-PRED-EMP.         DTSBE770
03468      SET RATE-CHNG-DATE-NULL-88     TO TRUE.                      DTSBE770
03469      SET WRK-RATE-FOUND-NO-88       TO TRUE.                      DTSBE770
03470                                                                   DTSBE770
03471      MOVE LOW-VALUES                TO MREL-KEY-AREA.             DTSBE770
03472      MOVE MPRF-EMP-NO               TO MREL-EMP-NO.               DTSBE770
03473      SET MREL-REL-88                TO TRUE.                      DTSBE770
03474      MOVE MREL-KEY-AREA             TO MSKL-KEY-AREA.             DTSBE770
03475                                                                   DTSBE770
03476      PERFORM S910-START-BROWSE      THRU S910-EXIT.               DTSBE770
03477      PERFORM UNTIL L910-NO-REC-88 OR                              DTSBE770
03478          WRK-RATE-FOUND-YES-88                                    DTSBE770
03479         MOVE MSKL-REC                     TO MREL-REC             DTSBE770
03480         IF (MREL-ESTB-DATE >= WRK-SUBJECT-QTR-START               DTSBE770
03481         AND MREL-ESTB-DATE <= WRK-SUBJECT-QTR-END)                DTSBE770
03482         OR (MREL-CHNG-DATE >= WRK-SUBJECT-QTR-START               DTSBE770
03483         AND MREL-CHNG-DATE <= WRK-SUBJECT-QTR-END)                DTSBE770
03484            IF (MREL-XFER-MANDATORY-88                             DTSBE770
03485            OR MREL-XFER-PROHIBITED-88)                            DTSBE770
03486               MOVE MREL-EMP-NO            TO WRK-SUTA-SUCC-EMP    DTSBE770
03487               MOVE MREL-PRED-EMP-NO       TO WRK-SUTA-PRED-EMP    DTSBE770
03488               MOVE MREL-EFF-DATE          TO WRK-EFF-DATE         DTSBE770
03489               DISPLAY MREL-EMP-NO ' MREL-EMP-NO'                  DTSBE770
03490               DISPLAY MREL-PRED-EMP-NO ' MREL-PRED-EMP-NO'        DTSBE770
03491               DISPLAY MREL-EFF-DATE ' MREL-EFF-DATE'              DTSBE770
03492               PERFORM P9110-FIND-MRTE     THRU P9110-EXIT         DTSBE770
03493               IF NOT RATE-CHNG-DATE-NULL-88                       DTSBE770
03494                  PERFORM P9120-FIND-AMT   THRU P9120-EXIT         DTSBE770
03495               END-IF                                              DTSBE770
03496            END-IF                                                 DTSBE770
03497         END-IF                                                    DTSBE770
03498         MOVE MREL-REC                     TO MSKL-REC             DTSBE770
03499         PERFORM S910-READ-NEXT            THRU S910-EXIT          DTSBE770
03500      END-PERFORM.                                                 DTSBE770
03501                                                                   DTSBE770
03502                                                                   DTSBE770
03503  P9100-EXIT.                                                      DTSBE770
03504      EXIT.                                                        DTSBE770
03505                                                                   DTSBE770
03506  P9110-FIND-MRTE.                                                 DTSBE770
03507      IF MREL-XFER-MANDATORY-88                                    DTSBE770
03508         ADD +1                         TO WRK-MANDATORY-CNT       DTSBE770
03509      ELSE                                                         DTSBE770
03510         ADD +1                         TO WRK-PROHIBITED-CNT      DTSBE770
03511      END-IF.                                                      DTSBE770
03512                                                                   DTSBE770
03513 ***  PERFORM P9111-CHK-PREDECESSOR     THRU P9111-EXIT            DTSBE770
03514      MOVE LOW-VALUES                   TO MRTE-KEY-AREA.          DTSBE770
03515      MOVE MPRF-EMP-NO                  TO MRTE-EMP-NO.            DTSBE770
03516      SET MRTE-RTE-88                   TO TRUE.                   DTSBE770
03517      MOVE MRTE-KEY-AREA                TO MSKL-KEY-AREA.          DTSBE770
03518                                                                   DTSBE770
03519      PERFORM S910-START-BROWSE         THRU S910-EXIT.            DTSBE770
03520                                                                   DTSBE770
03521      PERFORM UNTIL L910-NO-REC-88                                 DTSBE770
03522         MOVE MSKL-REC                  TO MRTE-REC                DTSBE770
03523            IF MRTE-MREL-PRED-NO NOT NUMERIC                       DTSBE770
03524               MOVE +0                  TO MRTE-MREL-PRED-NO       DTSBE770
03525            END-IF                                                 DTSBE770
03526            IF MRTE-MREL-EFF-DATE NOT NUMERIC                      DTSBE770
03527               MOVE +0                  TO MRTE-MREL-EFF-DATE      DTSBE770
03528            END-IF                                                 DTSBE770
03529            DISPLAY MRTE-MREL-PRED-NO 'MRTE-MREL-PRED-NO'          DTSBE770
03530            DISPLAY MRTE-MREL-EFF-DATE  'MRTE-MREL-EFF-DATE'       DTSBE770
03531            DISPLAY MRTE-CHNG-DATE  'MRTE-CHNG-DATE'               DTSBE770
03532            IF MRTE-MREL-PRED-NO = WRK-SUTA-PRED-EMP               DTSBE770
03533            AND MRTE-MREL-EFF-DATE = WRK-EFF-DATE                  DTSBE770
03534               SET WRK-RATE-FOUND-YES-88  TO TRUE                  DTSBE770
03535               IF MRTE-CHNG-DATE < WRK-RATE-CHNG-DATE              DTSBE770
03536                  MOVE MRTE-CHNG-DATE   TO WRK-RATE-CHNG-DATE      DTSBE770
03537               END-IF                                              DTSBE770
03538            END-IF                                                 DTSBE770
03539            MOVE MRTE-REC               TO MSKL-REC                DTSBE770
03540            PERFORM S910-READ-NEXT      THRU S910-EXIT             DTSBE770
03541         IF L910-NO-REC-88 AND MPRF-EMP-NO = 156023                DTSBE770
03542            MOVE 20140331 TO WRK-RATE-CHNG-DATE                    DTSBE770
03543            SET WRK-RATE-FOUND-YES-88 TO TRUE                      DTSBE770
03544         END-IF                                                    DTSBE770
03545         IF L910-NO-REC-88 AND MPRF-EMP-NO = 202263                DTSBE770
03546            MOVE 20140130 TO WRK-RATE-CHNG-DATE                    DTSBE770
03547            SET WRK-RATE-FOUND-YES-88 TO TRUE                      DTSBE770
03548         END-IF                                                    DTSBE770
03549      END-PERFORM.                                                 DTSBE770
03550                                                                   DTSBE770
03551  P9110-EXIT.                                                      DTSBE770
03552      EXIT.                                                        DTSBE770
03553                                                                   DTSBE770
03554 *P9111-CHK-PREDECESSOR.                                           DTSBE770
03555 *P9111-EXIT.                                                      DTSBE770
03556 *    EXIT.                                                        DTSBE770
03557                                                                   DTSBE770
03558 *P9112-CHK-SUCCESSOR.                                             DTSBE770
03559 *P9112-EXIT.                                                      DTSBE770
03560 *    EXIT.                                                        DTSBE770
03561                                                                   DTSBE770
03562  P9120-FIND-AMT.                                                  DTSBE770
03563      MOVE +0                         TO WRK-SUTA-DMP-AMT.         DTSBE770
03564      IF MPRF-EMP-NO = 156023                                      DTSBE770
03565         MOVE 20140331                 TO L005-DATE                DTSBE770
03566      ELSE                                                         DTSBE770
03567      MOVE WRK-RATE-CHNG-DATE         TO L005-DATE.                DTSBE770
03568                                                                   DTSBE770
03569      MOVE +0                         TO L005-TIME.                DTSBE770
03570      PERFORM S005-FROM-DATE-TIME     THRU S005-EXIT.              DTSBE770
03571                                                                   DTSBE770
03572      MOVE LOW-VALUES                 TO MJRN-KEY-AREA.            DTSBE770
03573      MOVE MPRF-EMP-NO                TO MJRN-EMP-NO.              DTSBE770
03574      SET MJRN-JRN-88                 TO TRUE.                     DTSBE770
03575      MOVE L005-ABSTIME               TO MJRN-ESTB-ABSTIME.        DTSBE770
03576      MOVE MJRN-KEY-AREA              TO MSKL-KEY-AREA.            DTSBE770
03577                                                                   DTSBE770
03578      PERFORM S910-START-BROWSE       THRU S910-EXIT.              DTSBE770
03579                                                                   DTSBE770
03580      PERFORM UNTIL L910-NO-REC-88                                 DTSBE770
03581         MOVE MSKL-REC                TO MJRN-REC                  DTSBE770
03582         IF MJRN-ESTB-DATE <= WRK-SUBJECT-QTR-END                  DTSBE770
03583 ***     IF MJRN-ESTB-DATE = WRK-RATE-CHNG-DATE                    DTSBE770
03584         AND MJRN-ADMN-CORR-RPT-88                                 DTSBE770
03585         DISPLAY MJRN-ESTB-DATE  ' MJRN-ESTB-DATE'                 DTSBE770
03586            PERFORM P9121-UI-CHG      THRU P9121-EXIT              DTSBE770
03587         END-IF                                                    DTSBE770
03588         PERFORM S910-READ-NEXT       THRU S910-EXIT               DTSBE770
03589      END-PERFORM.                                                 DTSBE770
03590                                                                   DTSBE770
03591  P9120-EXIT.                                                      DTSBE770
03592      EXIT.                                                        DTSBE770
03593                                                                   DTSBE770
03594  P9121-UI-CHG.                                                    DTSBE770
03595      PERFORM                                                      DTSBE770
03596        VARYING SUB FROM +1 BY +1                                  DTSBE770
03597        UNTIL SUB > MJRN-OCC-CNT                                   DTSBE770
03598          IF MJRN-ROW-UI-88 (SUB)                                  DTSBE770
03599          AND MJRN-COL-CHARGED-88 (SUB)                            DTSBE770
03600             ADD MJRN-AMT (SUB)    TO WRK-SUTA-DMP-AMT             DTSBE770
03601                                      WRK-SUTA-DMP-TOT             DTSBE770
03602          END-IF                                                   DTSBE770
03603      END-PERFORM.                                                 DTSBE770
03604                                                                   DTSBE770
03605      MOVE WRK-SUTA-DMP-AMT        TO AMT-DISP1.                   DTSBE770
03606      DISPLAY 'P9121 ' MPRF-EMP-NO '  ' AMT-DISP1                  DTSBE770
03607         '  ' WRK-RATE-CHNG-DATE.                                  DTSBE770
03608  P9121-EXIT.                                                      DTSBE770
03609      EXIT.                                                        DTSBE770
03610                                                                   DTSBE770
03611  T0000-TERMINATE.                                                 DTSBE770
03612      PERFORM T1000-WAGE-ITEM-CNT   THRU T1000-EXIT.               DTSBE770
03613      PERFORM T2000-WRITE-Y779-REC  THRU T2000-EXIT.               DTSBE770
03614                                                                   DTSBE770
03615      DISPLAY '*********************************************'.     DTSBE770
03616      DISPLAY '**   DTSBE770 TERMINATION STATISTICS       **'.     DTSBE770
03617      DISPLAY '**                                         **'.     DTSBE770
03618      DISPLAY '  ZERO WAGE  ' WRK-0-WAGE-CNT.                      DTSBE770
03619      DISPLAY '  NOT LIABLE ' WRK-NOT-LIAB-CNT.                    DTSBE770
03620      DISPLAY '  DELINQUENT ' WRK-DELINQ-CNT.                      DTSBE770
03621      DISPLAY '  ACT CNT    ' WRK-ACT-CNT.                         DTSBE770
03622      DISPLAY '  RPT RCVD   ' WRK-TOT-RPT-RCVD-CNT.                DTSBE770
03623      DISPLAY SPACE.                                               DTSBE770
03624                                                                   DTSBE770
03625      DISPLAY 'MANDATORY CNT  ' WRK-MANDATORY-CNT.                 DTSBE770
03626      DISPLAY 'PROHIBITED CNT ' WRK-PROHIBITED-CNT.                DTSBE770
03627      MOVE WRK-SUTA-DMP-TOT     TO AMT-DISP1.                      DTSBE770
03628      DISPLAY 'SUTA CONTRIB   ' AMT-DISP1.                         DTSBE770
03629                                                                   DTSBE770
03630      MOVE WRK-Y771-CNT TO DISPLAY-CNT.                            DTSBE770
03631      DISPLAY '**  Y771 COUNT    ' DISPLAY-CNT                     DTSBE770
03632                                       '                  **'.     DTSBE770
03633      MOVE WRK-Y772-CNT TO DISPLAY-CNT.                            DTSBE770
03634      DISPLAY '**  Y772 COUNT    ' DISPLAY-CNT                     DTSBE770
03635                                       '                  **'.     DTSBE770
03636      MOVE WRK-Y773-CNT TO DISPLAY-CNT.                            DTSBE770
03637      DISPLAY '**  Y773 COUNT    ' DISPLAY-CNT                     DTSBE770
03638                                       '                  **'.     DTSBE770
03639      DISPLAY '**  TPS STATUS    ' WRK-TPS-STATUS-CNT.             DTSBE770
03640      MOVE WRK-Y774-CNT TO DISPLAY-CNT.                            DTSBE770
03641      DISPLAY '**  Y774 COUNT    ' DISPLAY-CNT                     DTSBE770
03642                                       '                  **'.     DTSBE770
03643      MOVE WRK-Y775-CNT TO DISPLAY-CNT.                            DTSBE770
03644      DISPLAY '**  Y775 COUNT    ' DISPLAY-CNT                     DTSBE770
03645                                       '                  **'.     DTSBE770
03646      MOVE WRK-MISSING-CNT TO DISPLAY-CNT.                         DTSBE770
03647      DISPLAY '**  MISSING       ' DISPLAY-CNT                     DTSBE770
03648                                       '                  **'.     DTSBE770
03649      MOVE WRK-NOT-SELECTED-CNT TO DISPLAY-CNT.                    DTSBE770
03650      DISPLAY '**  NOT SELECTED  ' DISPLAY-CNT                     DTSBE770
03651                                       '                  **'.     DTSBE770
03652      MOVE WRK-SELECT-581-CNT   TO DISPLAY-CNT.                    DTSBE770
03653      DISPLAY '**  581 ONLY CNT  ' DISPLAY-CNT                     DTSBE770
03654                                       '                  **'.     DTSBE770
03655      MOVE WRK-OUTSTANDING-QTR-CNT TO DISPLAY-CNT.                 DTSBE770
03656      DISPLAY '**  OUTSTANDING QTR ' DISPLAY-CNT                   DTSBE770
03657                                       '                **'.       DTSBE770
03658      MOVE WRK-ITEM13-CNT          TO DISPLAY-CNT.                 DTSBE770
03659      DISPLAY '**  ITEM 13 CNT     ' DISPLAY-CNT                   DTSBE770
03660                                       '                **'.       DTSBE770
03661      DISPLAY '**  ANN RPT CNT     ' WRK-ANNUAL-RPT-CNT            DTSBE770
03662                                       '                **'.       DTSBE770
03663      MOVE WRK-OUTSTANDING-BAL     TO DISPLAY-AMT.                 DTSBE770
03664      DISPLAY '**  OUTSTANDING BAL ' DISPLAY-AMT                   DTSBE770
03665                                       '                **'.       DTSBE770
03666 *    DISPLAY '**  CORRECT LIAB DATE    ' WRK-CNT1                 DTSBE770
03667 *                                     '                **'.       DTSBE770
03668 *    DISPLAY '**  CORRECT REOPEN DATE  ' WRK-CNT2                 DTSBE770
03669 *                                     '                **'.       DTSBE770
03670      DISPLAY '**  P2600 QTR            ' WRK-P2610-QTR-CNT        DTSBE770
03671                                       '                **'.       DTSBE770
03672      DISPLAY '**  ANNNUAL FILERS       ' WRK-ANN-FILER-CNT        DTSBE770
03673                                       '                **'.       DTSBE770
03674 **   DISPLAY '**  ANN: SCRD P2600      ' WRK-P2600-CNT            DTSBE770
03675 *                                     '                **'.       DTSBE770
03676 *    DISPLAY '**  ANN: SCRD DFLT P26   ' WRK-P2600-DFLT-CNT       DTSBE770
03677 **                                    '                **'.       DTSBE770
03678      DISPLAY '**  ANN: RESOLVED P21    ' WRK-P2100-CNT            DTSBE770
03679                                       '                **'.       DTSBE770
03680      DISPLAY '**  ANN: P2100 RCVD      ' WRK-P2100-RCVD-CNT       DTSBE770
03681                                       '                **'.       DTSBE770
03682      DISPLAY '**  ANN: P2100 MISS      ' WRK-P2100-MISS-CNT       DTSBE770
03683                                       '                **'.       DTSBE770
03684      DISPLAY '**  ANN: P2120 DEFAULT   ' WRK-P2100-DFLT-CNT       DTSBE770
03685 *                                     '                **'.       DTSBE770
03686      DISPLAY '**  QTR: RECEIVED  P21   ' WRK-P2100-QTR-CNT        DTSBE770
03687                                       '                **'.       DTSBE770
03688 *    DISPLAY '**  ENTERED IN QTR1      ' WRK-CNT4                 DTSBE770
03689 *                                     '                **'.       DTSBE770
03690      DISPLAY '**  ANN: RES P2220       ' WRK-P2220-RES-CNT        DTSBE770
03691                                       '                **'.       DTSBE770
03692      DISPLAY '**  ANN: SEC P2220       ' WRK-P2220-SEC-CNT        DTSBE770
03693                                       '                **'.       DTSBE770
03694      DISPLAY '**  ANN: TIMELY P2220    ' WRK-P2220-TIMELY-CNT     DTSBE770
03695                                       '                **'.       DTSBE770
03696      DISPLAY '**  P2510 DFLT TIMELY    '                          DTSBE770
03697        WRK-P2510-DFLT-TIMELY-CNT      '                **'.       DTSBE770
03698 *    DISPLAY '**  ANN: RES P2520       ' WRK-P2520-RES-CNT        DTSBE770
03699 *                                     '                **'.       DTSBE770
03700 *    DISPLAY '**  ANN: SEC P2520       ' WRK-P2520-SEC-CNT        DTSBE770
03701 *                                     '                **'.       DTSBE770
03702 *    DISPLAY '**  ANN: TIMELY P2520    ' WRK-P2520-TIMELY-CNT     DTSBE770
03703 *                                     '                **'.       DTSBE770
03704      DISPLAY '**  P2520 DFLT TIMELY    '                          DTSBE770
03705        WRK-P2520-DFLT-TIMELY-CNT      '                **'.       DTSBE770
03706 *    DISPLAY '**  P2500 QTR CNT        ' WRK-P2500-QTR-CNT        DTSBE770
03707 *                                     '                **'.       DTSBE770
03708 *    DISPLAY '**  P2500 ANN CNT        ' WRK-P2500-ANN-CNT        DTSBE770
03709 *                                     '                **'.       DTSBE770
03710 *    DISPLAY '**  P2500 581 QTR CNT    ' WRK-P2500-581-QTR-CNT    DTSBE770
03711 *                                     '                **'.       DTSBE770
03712      DISPLAY '**                                         **'.     DTSBE770
03713      DISPLAY '*********************************************'.     DTSBE770
03714                                                                   DTSBE770
03715      MOVE WRK-SUBJECT-QTR             TO L004-QTR-5-9.            DTSBE770
03716                                                                   DTSBE770
03717      EVALUATE TRUE                                                DTSBE770
03718        WHEN L004-QTR-5-Q = 1                                      DTSBE770
03719          CLOSE   TPS-STATUS-QTR1                                  DTSBE770
03720                                                                   DTSBE770
03721        WHEN L004-QTR-5-Q = 2                                      DTSBE770
03722          CLOSE   TPS-STATUS-QTR2                                  DTSBE770
03723                                                                   DTSBE770
03724        WHEN L004-QTR-5-Q = 3                                      DTSBE770
03725          CLOSE   TPS-STATUS-QTR3                                  DTSBE770
03726                                                                   DTSBE770
03727        WHEN L004-QTR-5-Q = 4                                      DTSBE770
03728          CLOSE   TPS-STATUS-QTR4                                  DTSBE770
03729                                                                   DTSBE770
03730      END-EVALUATE.                                                DTSBE770
03731                                                                   DTSBE770
03732  T0000-EXIT.                                                      DTSBE770
03733      EXIT.                                                        DTSBE770
03734                                                                   DTSBE770
03735  T1000-WAGE-ITEM-CNT.                                             DTSBE770
03736      INITIALIZE                      L430-LINK-AREA.              DTSBE770
03737      MOVE WRK-SUBJECT-QTR            TO L430-SUBJECT-YRQ.         DTSBE770
03738                                                                   DTSBE770
03739      SET L430-CMND-INITIALIZE-88     TO TRUE.                     DTSBE770
03740      CALL 'DTSBU431' USING L430-LINK-AREA.                           CL*29
03741                                                                   DTSBE770
03742      SET L430-CMND-PROCESS-88        TO TRUE.                     DTSBE770
03743      CALL 'DTSBU431' USING L430-LINK-AREA.                           CL*29
03744      MOVE L430-WAGE-ITEM-CNT          TO WRK-WAGE-ITEM-CNT.       DTSBE770
03745                                                                   DTSBE770
03746      SET L430-CMND-TERMINATE-88      TO TRUE.                     DTSBE770
03747      CALL 'DTSBU431' USING L430-LINK-AREA.                           CL*29
03748                                                                   DTSBE770
03749  T1000-EXIT.                                                      DTSBE770
03750      EXIT.                                                        DTSBE770
03751                                                                   DTSBE770
03752  T2000-WRITE-Y779-REC.                                            DTSBE770
03753      MOVE LENGTH OF Y779-REC TO Y779-LENGTH.                      DTSBE770
03754      SET Y779-REC-TYPE-779-88 TO TRUE.                            DTSBE770
03755                                                                   DTSBE770
03756      MOVE WRK-OUTSTANDING-QTR-CNT TO Y779-OUTSTANDING-QTR-CNT.    DTSBE770
03757      MOVE WRK-OUTSTANDING-BAL     TO Y779-OUTSTANDING-BAL.        DTSBE770
03758      MOVE WRK-WAGE-ITEM-CNT       TO Y779-WAGE-ITEM-CNT.          DTSBE770
03759      MOVE WRK-SUTA-DMP-TOT        TO Y779-SUTA-CONTRIB-DUE.       DTSBE770
03760      MOVE WRK-MANDATORY-CNT       TO Y779-MANDATORY-XFER-CNT.     DTSBE770
03761      MOVE WRK-PROHIBITED-CNT      TO Y779-PROHIBITED-XFER-CNT.    DTSBE770
03762                                                                   DTSBE770
03763      PERFORM S779-WRITE-R779 THRU S779-EXIT.                      DTSBE770
03764                                                                   DTSBE770
03765  T2000-EXIT.                                                      DTSBE770
03766      EXIT.                                                        DTSBE770
03767                                                                   DTSBE770
03768  S001-FROM-FED-8.                                                 DTSBE770
03769      SET L001-FROM-FED-8 TO TRUE.                                 DTSBE770
03770      GO TO S001-DATE.                                             DTSBE770
03771                                                                   DTSBE770
03772  S001-FROM-ABS-DAY.                                               DTSBE770
03773      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBE770
03774      GO TO S001-DATE.                                             DTSBE770
03775                                                                   DTSBE770
03776  S001-FROM-CAL-6.                                                 DTSBE770
03777      SET L001-FROM-CAL-6 TO TRUE.                                 DTSBE770
03778      GO TO S001-DATE.                                             DTSBE770
03779                                                                   DTSBE770
03780  S001-DATE.                                                       DTSBE770
03781      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBE770
03782  S001-EXIT.                                                       DTSBE770
03783      EXIT.                                                        DTSBE770
03784      SKIP3                                                        DTSBE770
03785  S004-FROM-5.                                                     DTSBE770
03786      SET L004-FROM-5 TO TRUE.                                     DTSBE770
03787      GO TO S004-QTR.                                              DTSBE770
03788                                                                   DTSBE770
03789  S004-FROM-ABS.                                                   DTSBE770
03790      SET L004-FROM-ABS TO TRUE.                                   DTSBE770
03791      GO TO S004-QTR.                                              DTSBE770
03792                                                                   DTSBE770
03793  S004-FROM-3.                                                     DTSBE770
03794      SET L004-FROM-3 TO TRUE.                                     DTSBE770
03795      GO TO S004-QTR.                                              DTSBE770
03796                                                                   DTSBE770
03797  S004-FROM-DATE.                                                  DTSBE770
03798      SET L004-FROM-DATE TO TRUE.                                  DTSBE770
03799      GO TO S004-QTR.                                              DTSBE770
03800                                                                   DTSBE770
03801  S004-QTR.                                                        DTSBE770
03802                                                                   DTSBE770
03803      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBE770
03804                                                                   DTSBE770
03805  S004-EXIT.                                                       DTSBE770
03806      EXIT.                                                        DTSBE770
03807      SKIP3                                                        DTSBE770
03808  S005-FROM-DATE-TIME.                                             DTSBE770
03809      SET L005-FROM-DATE-TIME   TO TRUE                            DTSBE770
03810      CALL 'DTSBU005' USING L005-LINK-AREA.                        DTSBE770
03811                                                                   DTSBE770
03812  S005-EXIT.                                                       DTSBE770
03813      EXIT.                                                        DTSBE770
03814                                                                   DTSBE770
03815  S410-FILE-SCHED.                                                 DTSBE770
03816      CALL 'DTSBU410' USING L410-LINK-AREA.                        DTSBE770
03817  S410-EXIT.                                                       DTSBE770
03818      EXIT.                                                        DTSBE770
03819                                                                   DTSBE770
03820  S415-HOUSEHOLD-DATES.                                            DTSBE770
03821      CALL 'DTSBU415' USING L415-LINK-AREA.                        DTSBE770
03822  S415-EXIT.                                                       DTSBE770
03823      EXIT.                                                        DTSBE770
03824                                                                   DTSBE770
03825  S910-READ.                                                       DTSBE770
03826      SET L910-READ-88 TO TRUE.                                    DTSBE770
03827      GO TO S910-MSTR-IO.                                          DTSBE770
03828                                                                   DTSBE770
03829  S910-START-BROWSE.                                               DTSBE770
03830      SET L910-START-BROWSE-88 TO TRUE.                            DTSBE770
03831      GO TO S910-MSTR-IO.                                          DTSBE770
03832                                                                   DTSBE770
03833  S910-READ-NEXT.                                                  DTSBE770
03834      SET L910-READ-NEXT-88 TO TRUE.                               DTSBE770
03835      GO TO S910-MSTR-IO.                                          DTSBE770
03836                                                                   DTSBE770
03837 *S910-COUNT.                                                      DTSBE770
03838 *****SET L910-COUNT-88 TO TRUE.                                   DTSBE770
03839 *****GO TO S910-MSTR-IO.                                          DTSBE770
03840                                                                   DTSBE770
03841  S910-REWRITE.                                                    DTSBE770
03842      SET L910-REWRITE-88 TO TRUE.                                 DTSBE770
03843      SET LECM-EMP-UPDATED-YES-88 TO TRUE.                         DTSBE770
03844      GO TO S910-MSTR-IO.                                          DTSBE770
03845                                                                   DTSBE770
03846  S910-MSTR-IO.                                                    DTSBE770
03847      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBE770
03848                            MSKL-REC.                              DTSBE770
03849  S910-EXIT.                                                       DTSBE770
03850      EXIT.                                                        DTSBE770
03851      SKIP3                                                        DTSBE770
03852                                                                   DTSBE770
03853  S931-READ.                                                       DTSBE770
03854      SET L931-READ-88 TO TRUE.                                    DTSBE770
03855      GO TO S931-REF-IO.                                           DTSBE770
03856                                                                   DTSBE770
03857  S931-REF-IO.                                                     DTSBE770
03858      CALL 'DTSBU931' USING L931-LINK-AREA                         DTSBE770
03859                            FSKL-REC.                              DTSBE770
03860  S931-EXIT.                                                       DTSBE770
03861      EXIT.                                                        DTSBE770
03862                                                                   DTSBE770
03863  S771-WRITE-R771.                                                 DTSBE770
03864      MOVE Y771-REC         TO RSKL-REC.                           DTSBE770
03865      PERFORM S927B-WRITE   THRU S927B-EXIT.                       DTSBE770
03866                                                                   DTSBE770
03867  S771-EXIT.                                                       DTSBE770
03868      EXIT.                                                        DTSBE770
03869                                                                   DTSBE770
03870  S772-WRITE-R772.                                                 DTSBE770
03871      MOVE Y772-REC         TO RSKL-REC.                           DTSBE770
03872      PERFORM S927B-WRITE   THRU S927B-EXIT.                       DTSBE770
03873                                                                   DTSBE770
03874  S772-EXIT.                                                       DTSBE770
03875      EXIT.                                                        DTSBE770
03876                                                                   DTSBE770
03877  S773-WRITE-R773.                                                 DTSBE770
03878      MOVE Y773-REC         TO RSKL-REC.                           DTSBE770
03879      PERFORM S927B-WRITE   THRU S927B-EXIT.                       DTSBE770
03880                                                                   DTSBE770
03881  S773-EXIT.                                                       DTSBE770
03882      EXIT.                                                        DTSBE770
03883                                                                   DTSBE770
03884  S774-WRITE-R774.                                                 DTSBE770
03885      MOVE Y774-REC         TO RSKL-REC.                           DTSBE770
03886      PERFORM S927B-WRITE   THRU S927B-EXIT.                       DTSBE770
03887                                                                   DTSBE770
03888  S774-EXIT.                                                       DTSBE770
03889      EXIT.                                                        DTSBE770
03890                                                                   DTSBE770
03891  S775-WRITE-R775.                                                 DTSBE770
03892      MOVE Y775-REC         TO RSKL-REC.                           DTSBE770
03893      PERFORM S927B-WRITE   THRU S927B-EXIT.                       DTSBE770
03894                                                                   DTSBE770
03895  S775-EXIT.                                                       DTSBE770
03896      EXIT.                                                        DTSBE770
03897                                                                   DTSBE770
03898  S779-WRITE-R779.                                                 DTSBE770
03899      MOVE Y779-REC         TO RSKL-REC.                           DTSBE770
03900      PERFORM S927B-WRITE   THRU S927B-EXIT.                       DTSBE770
03901                                                                   DTSBE770
03902  S779-EXIT.                                                       DTSBE770
03903      EXIT.                                                        DTSBE770
03904                                                                   DTSBE770
03905  S927A-OPEN-UPDATE.                                               DTSBE770
03906      SET L927-OPEN-UPDATE-88  TO TRUE.                            DTSBE770
03907      PERFORM S927X-BTC-IO   THRU S927X-EXIT.                      DTSBE770
03908                                                                   DTSBE770
03909  S927A-EXIT.                                                      DTSBE770
03910      EXIT.                                                        DTSBE770
03911                                                                   DTSBE770
03912  S927B-WRITE.                                                     DTSBE770
03913      SET L927-WRITE-88  TO TRUE.                                  DTSBE770
03914      PERFORM S927X-BTC-IO   THRU S927X-EXIT.                      DTSBE770
03915                                                                   DTSBE770
03916  S927B-EXIT.                                                      DTSBE770
03917      EXIT.                                                        DTSBE770
03918                                                                   DTSBE770
03919  S927C-CLOSE.                                                     DTSBE770
03920      SET L927-CLOSE-88  TO TRUE.                                  DTSBE770
03921      PERFORM S927X-BTC-IO   THRU S927X-EXIT.                      DTSBE770
03922                                                                   DTSBE770
03923  S927C-EXIT.                                                      DTSBE770
03924      EXIT.                                                        DTSBE770
03925                                                                   DTSBE770
03926  S927X-BTC-IO.                                                    DTSBE770
03927      CALL 'DTSBU927' USING L927-LINK-AREA                         DTSBE770
03928                            RSKL-REC.                              DTSBE770
03929                                                                   DTSBE770
03930  S927X-EXIT.                                                      DTSBE770
03931      EXIT.                                                        DTSBE770
03932      SKIP3                                                        DTSBE770
03933  S999-ABEND.                                                      DTSBE770
03934      DISPLAY '*** DTSBE770 ABENDING.  '                           DTSBE770
03935              ABEND-MSG.                                           DTSBE770
03936                                                                   DTSBE770
03937      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBE770
03938  S999-EXIT.                                                       DTSBE770
03939      EXIT.                                                        DTSBE770
