Files
DUTAS/Batch/DTSBE770.cob
2025-07-21 11:20:11 -04:00

3941 lines
312 KiB
COBOL

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