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