00001 IDENTIFICATION DIVISION. 02/07/12 00002 PROGRAM-ID. DTSBE602. DTSBE602 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV020 00004 DATE-WRITTEN. AUGUST 1994. DTSBE602 00005 DATE-COMPILED. DTSBE602 00006 SKIP3 DTSBE602 00007 ***** DTSBE602 00008 * DTSBE602 00009 * FUNCTION: AUDIT CANDIDATE LIST EXTRACT. DTSBE602 00010 * DTSBE602 00011 * DTSBE602 00012 * MODIFICATION LOG: DTSBE602 00013 * DTSBE602 00014 * 09/22/94 INITIAL DEVELOPMENT. DTSBE602 00015 * WORK ORDER: PROGRAMMER: RHC DTSBE602 00016 * DTSBE602 00017 * 05/15/95 HAVING AN OPEN BANKRUPTCY NO LONGER EXCLUDES THE DTSBE602 00018 * EMPLOYER. DTSBE602 00019 * WORK ORDER: CR086 PROGRAMMER: RHC DTSBE602 00020 * DTSBE602 00021 * 05/25/95 ZIP CODE RANGE ADDED TO SELECTION CRITERIA. DTSBE602 00022 * WORK ORDER: CR089 PROGRAMMER: RHC DTSBE602 00023 * DTSBE602 00024 * 01/22/08 MODIFY FOR AUTOMATIC AUDIT ASSIGNMENT. DTSBE602 00025 * USE NEW VERSION OF DTSIR602. DTSBE602 00026 * EXCLUDE IF BAD ADDRESS OR WAGES MISSING. DTSBE602 00027 * WORK ORDER: PROGRAMMER: GD DTSBE602 00028 * DTSBE602 00029 * 07/14/08 EXCLUDE HOUSEHOLD ACCOUNTS FROM SELECTION. DTSBE602 00030 * WORK ORDER: PROGRAMMER: GD DTSBE602 00031 * DTSBE602 00032 * 11/12/08 MODIFIED TO INCLUDE EMP MAILING ADDRESS WHEN DTSBE602 00033 * BUILDING 602 IR REPORT RECORDS. DTSBE602 00034 * WORK ORDER: PROGRAMMER: ZL1 DTSBE602 00035 * DTSBE602 00036 * 01/29/10 BYPASS CANDIDATES IF NO FIELD REP ASSIGNED TO DTSBE602 00037 * TERRITORY. DTSBE602 00038 * WORK ORDER: PROGRAMMER: GD DTSBE602 00039 * DTSBE602 00040 * DTSBE602 00041 * 01/27/12 MODIFIED TO PASS NEW FIELD FOR TARGETED AUDITS DTSBE602 00042 * TERRITORY. DTSBE602 00043 * WORK ORDER: PROGRAMMER: ZL1 DTSBE602 00044 * DTSBE602 00045 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE602 00046 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE602 00047 * WORK ORDER: PROGRAMMER: XXX DTSBE602 00048 * DTSBE602 00049 * DTSBE602 00050 * DESCRIPTION: DTSBE602 00051 * DTSBE602 00052 * DTSBE602 00053 * INITIATION: DTSBE602 00054 * DTSBE602 00055 * SET LECM-MST-OPEN-UPDATE-88 TO TRUE. DTSBE602 00056 * SET LECM-REF-OPEN-UPDATE-88 TO TRUE. DTSBE602 00057 * DTSBE602 00058 * NO PARAMETERS ARE INPUT. DTSBE602 00059 * DTSBE602 00060 * READ THE FSEL RECORD (WHERE THE SELECTION CRITERIA DTSBE602 00061 * IS STORED). IF NO FSEL RECORD EXISTS, THEN ABEND. DTSBE602 00062 * DTSBE602 00063 * DTSBE602 00064 * PROCESSING: DTSBE602 00065 * DTSBE602 00066 * SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (602R1). DTSBE602 00067 * DTSBE602 00068 * FOR EACH EMPLOYER MEETING THE SELECTION CRITERIA, WRITE DTSBE602 00069 * TWO DTSIR602 RECORDS. SEE THE COMMENT IN DTSIR602. DTSBE602 00070 * DTSBE602 00071 * DTSBE602 00072 * TERMINATION: DTSBE602 00073 * DTSBE602 00074 * NONE. DTSBE602 00075 * DTSBE602 00076 * DTSBE602 00077 * RECORDS READ: DTSBE602 00078 * DTSBE602 00079 * MASTER: DTSBE602 00080 * DTSBE602 00081 * MFAS DTSBE602 00082 * MAUR DTSBE602 00083 * MSOL DTSBE602 00084 * MQTR DTSBE602 00085 * MRPT DTSBE602 00086 * DTSBE602 00087 * DTSBE602 00088 * ALTERNATE INDEX: DTSBE602 00089 * DTSBE602 00090 * NONE. DTSBE602 00091 * DTSBE602 00092 * DTSBE602 00093 * REFERENCE: DTSBE602 00094 * DTSBE602 00095 * FSEL. DTSBE602 00096 * DTSBE602 00097 * DTSBE602 00098 * RECORDS UPDATED: DTSBE602 00099 * DTSBE602 00100 * NONE. DTSBE602 00101 * DTSBE602 00102 * DTSBE602 00103 * REPORT RECORDS WRITTEN: DTSBE602 00104 * DTSBE602 00105 * R602 AUDIT CANDIDATE LIST. DTSBE602 00106 * DTSBE602 00107 * DTSBE602 00108 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE602 00109 * DTSBE602 00110 * NONE. DTSBE602 00111 * DTSBE602 00112 * DTSBE602 00113 * MODULES CALLED: DTSBE602 00114 * DTSBE602 00115 * DTSBU004 QUARTER EDIT/CONVERSION. DTSBE602 00116 * DTSBU061 FIELD ZIP / FIELD REP ID. DTSBE602 00117 * DTSBU910 MASTER FILE I/O. DTSBE602 00118 * DTSBU931 REFERENCE FILE I/O. DTSBE602 00119 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. DTSBE602 00120 * DTSBE602 00121 * DTSBE602 00122 * VERMONT REFERENCE: DTSBE602 00123 * DTSBE602 00124 * TXBE365. DTSBE602 00125 * DTSBE602 00126 ***** DTSBE602 00127 SKIP3 DTSBE602 00128 ENVIRONMENT DIVISION. DTSBE602 00129 SKIP3 DTSBE602 00130 DATA DIVISION. DTSBE602 00131 EJECT DTSBE602 00132 WORKING-STORAGE SECTION. DTSBE602 001325 77 PAN-VALET PICTURE X(24) VALUE '020DTSBE602 02/07/12'. DTSBE602 00133 SKIP1 DTSBE602 00134 01 WRK-JOB-SETTINGS. DTSBE602 00135 SKIP1 DTSBE602 00136 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +602.DTSBE602 00137 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE602'.DTSBE602 00138 05 ABEND-MSG PIC X(60). DTSBE602 00139 SKIP3 DTSBE602 00140 05 WRK-AUDIT-START-ABS-QTR PIC S9(04) COMP. DTSBE602 00141 05 WRK-AUDIT-END-ABS-QTR PIC S9(04) COMP. DTSBE602 00142 SKIP3 DTSBE602 00143 05 WRK-START-PRECED-CAL-YRQ PIC 9(05). DTSBE602 00144 05 FILLER REDEFINES WRK-START-PRECED-CAL-YRQ. DTSBE602 00145 10 WRK-START-PRECED-CAL-YR PIC 9(04). DTSBE602 00146 10 WRK-START-PRECED-CAL-Q PIC 9(01). DTSBE602 00147 SKIP3 DTSBE602 00148 05 WRK-END-PRECED-CAL-YRQ PIC 9(05). DTSBE602 00149 05 FILLER REDEFINES WRK-END-PRECED-CAL-YRQ. DTSBE602 00150 10 WRK-END-PRECED-CAL-YR PIC 9(04). DTSBE602 00151 10 WRK-END-PRECED-CAL-Q PIC 9(01). DTSBE602 00152 SKIP3 DTSBE602 00153 05 WRK-END-CURR-CAL-YRQ PIC 9(05). DTSBE602 00154 05 FILLER REDEFINES WRK-END-CURR-CAL-YRQ. DTSBE602 00155 10 WRK-END-CURR-CAL-YR PIC 9(04). DTSBE602 00156 10 WRK-END-CURR-CAL-Q PIC 9(01). DTSBE602 00157 SKIP3 DTSBE602 00158 01 WRK-MISC. DTSBE602 00159 SKIP1 DTSBE602 00160 05 WRK-CNT PIC S9(04) COMP. DTSBE602 00161 05 WRK-START-BROWSE-YRQ PIC S9(05). DTSBE602 00162 SKIP3 DTSBE602 00163 05 REJECT-IND PIC X(01). DTSBE602 00164 88 REJECT-NO VALUE 'N'. DTSBE602 00165 88 REJECT-YES VALUE 'Y'. DTSBE602 00166 SKIP1 DTSBE602 00167 05 RECORDS-WRITTEN-IND PIC X(01). DTSBE602 00168 88 RECORDS-WRITTEN-NO VALUE 'N'. DTSBE602 00169 88 RECORDS-WRITTEN-YES VALUE 'Y'. DTSBE602 00170 SKIP3 DTSBE602 00171 05 WRK-START-ABS-QTR PIC S9(04) COMP. DTSBE602 00172 05 WRK-END-ABS-QTR PIC S9(04) COMP. DTSBE602 00173 SKIP1 DTSBE602 00174 05 WRK-PREV-START-YRQ PIC S9(05) COMP-3. DTSBE602 00175 05 WRK-PREV-END-YRQ PIC S9(05) COMP-3. DTSBE602 00176 SKIP1 DTSBE602 00177 05 WRK-ACTIVE-QTR-TBL. DTSBE602 00178 10 WRK-ACTIVE-QTR OCCURS 400 PIC X. DTSBE602 00179 SKIP3 DTSBE602 00180 05 WRK-PRIOR-YR-TAX-WAGES PIC S9(11)V9(02) COMP-3. DTSBE602 00181 SKIP1 DTSBE602 00182 05 WRK-TOT-WAGE PIC S9(11)V9(02) COMP-3. DTSBE602 00183 05 WRK-PREV-TOT-WAGE PIC S9(11)V9(02) COMP-3. DTSBE602 00184 05 WRK-WGH-TOT-WAGE PIC S9(11)V9(02) COMP-3. DTSBE602 00185 05 WRK-MQTR-TOT-WAGE PIC S9(11)V9(02) COMP-3. DTSBE602 00186 SKIP1 DTSBE602 00187 05 WRK-RATIO PIC S9(01)V9(04) COMP-3. DTSBE602 00188 SKIP1 DTSBE602 00189 05 WRK-ASSIGN-DUE-DATE PIC 9(08) VALUE ZEROS. DTSBE602 00190 DTSBE602 00191 05 WRK-DISP-AMT1 PIC ---------9.99. DTSBE602 00192 05 WRK-DISP-AMT2 PIC ---------9.99. DTSBE602 00193 01 MSG-AREA. DTSBE602 00194 SKIP1 DTSBE602 00195 05 MSG1-TEXT. DTSBE602 00196 10 FILLER PIC X(40) DTSBE602 00197 VALUE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED '. DTSBE602 00198 10 FILLER PIC X(40) DTSBE602 00199 VALUE ' '. DTSBE602 00200 SKIP1 DTSBE602 00201 05 MSG2-TEXT. DTSBE602 00202 10 FILLER PIC X(40) DTSBE602 00203 VALUE 'REFERENCE FILE AUDIT SELECTION CRITERIA '. DTSBE602 00204 10 FILLER PIC X(40) DTSBE602 00205 VALUE 'RECORD MISSING '. DTSBE602 00206 SKIP1 DTSBE602 00207 05 MSG3-TEXT. DTSBE602 00208 10 FILLER PIC X(40) DTSBE602 00209 VALUE 'NO EMPLOYERS SELECTED '. DTSBE602 00210 10 FILLER PIC X(40) DTSBE602 00211 VALUE ' '. DTSBE602 00212 SKIP1 DTSBE602 00213 05 MSG4-TEXT. DTSBE602 00214 10 FILLER PIC X(40) DTSBE602 00215 VALUE 'MFAS RECORD DELETED DURING PROCESSING '. DTSBE602 00216 10 FILLER PIC X(40) DTSBE602 00217 VALUE ' '. DTSBE602 00218 EJECT DTSBE602 00219 01 L001-LINK-AREA. DTSBE602 00220 ++INCLUDE DTSIL001 DTSBE602 00221 EJECT DTSBE602 00222 01 L004-LINK-AREA. DTSBE602 00223 ++INCLUDE DTSIL004 DTSBE602 00224 EJECT DTSBE602 00225 01 L111-LINK-AREA. DTSBE602 00226 ++INCLUDE DTSIL111 DTSBE602 00227 EJECT DTSBE602 00228 01 L112-LINK-AREA. DTSBE602 00229 ++INCLUDE DTSIL112 DTSBE602 00230 EJECT DTSBE602 00231 01 L061-LINK-AREA. DTSBE602 00232 ++INCLUDE DTSIL061 DTSBE602 00233 EJECT DTSBE602 00234 01 L910-LINK-AREA. DTSBE602 00235 ++INCLUDE DTSIL910 DTSBE602 00236 SKIP3 DTSBE602 00237 01 MSKL-REC. DTSBE602 00238 ++INCLUDE DTSIMSKL DTSBE602 00239 SKIP3 DTSBE602 00240 01 MTAD-REC. DTSBE602 00241 ++INCLUDE DTSIMTAD DTSBE602 00242 SKIP3 DTSBE602 00243 01 MHDR-REC. DTSBE602 00244 ++INCLUDE DTSIMHDR DTSBE602 00245 SKIP3 DTSBE602 00246 01 MFAS-REC. DTSBE602 00247 ++INCLUDE DTSIMFAS DTSBE602 00248 SKIP3 DTSBE602 00249 01 MAUR-REC. DTSBE602 00250 ++INCLUDE DTSIMAUR DTSBE602 00251 SKIP3 DTSBE602 00252 01 MSOL-REC. DTSBE602 00253 ++INCLUDE DTSIMSOL DTSBE602 00254 SKIP3 DTSBE602 00255 01 MQTR-REC. DTSBE602 00256 ++INCLUDE DTSIMQTR DTSBE602 00257 SKIP3 DTSBE602 00258 01 MRPT-REC. DTSBE602 00259 ++INCLUDE DTSIMRPT DTSBE602 00260 EJECT DTSBE602 00261 01 L931-LINK-AREA. DTSBE602 00262 ++INCLUDE DTSIL931 DTSBE602 00263 SKIP3 DTSBE602 00264 01 FSKL-REC. DTSBE602 00265 ++INCLUDE DTSIFSKL DTSBE602 00266 SKIP3 DTSBE602 00267 01 FSEL-REC. DTSBE602 00268 ++INCLUDE DTSIFSEL DTSBE602 00269 EJECT DTSBE602 00270 01 L981-LINK-AREA. DTSBE602 00271 ++INCLUDE DTSIL981 DTSBE602 00272 SKIP3 DTSBE602 00273 01 WWGH-REC. DTSBE602 00274 ++INCLUDE DTSIWWGH DTSBE602 00275 DTSBE602 00276 01 FMAX-CONSTANT-AREA. DTSBE602 00277 ++INCLUDE DTSIFMAX DTSBE602 00278 EJECT DTSBE602 00279 01 R602-REC. DTSBE602 00280 ++INCLUDE DTSIR602 DTSBE602 00281 EJECT DTSBE602 00282 LINKAGE SECTION. DTSBE602 00283 SKIP3 DTSBE602 00284 01 LECM-LINK-AREA. DTSBE602 00285 ++INCLUDE DTSILECM DTSBE602 00286 EJECT DTSBE602 00287 01 MPRF-LINK-REC. DTSBE602 00288 ++INCLUDE DTSIMPRF DTSBE602 00289 EJECT DTSBE602 00290 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE602 00291 MPRF-LINK-REC. DTSBE602 00292 SKIP1 DTSBE602 00293 IF LECM-PROCESS-88 DTSBE602 00294 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE602 00295 ELSE DTSBE602 00296 IF LECM-INITIALIZE-88 DTSBE602 00297 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE602 00298 ELSE DTSBE602 00299 IF LECM-TERMINATE-88 DTSBE602 00300 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE602 00301 ELSE DTSBE602 00302 MOVE MSG1-TEXT TO ABEND-MSG DTSBE602 00303 PERFORM S999-ABEND THRU S999-EXIT. DTSBE602 00304 SKIP3 DTSBE602 00305 GOBACK. DTSBE602 00306 EJECT DTSBE602 00307 I0000-INITIALIZE. DTSBE602 00308 DTSBE602 00309 MOVE LENGTH OF R602-REC TO R602-LENGTH. DTSBE602 00310 MOVE '602' TO R602-REC-TYPE. DTSBE602 00311 SET RECORDS-WRITTEN-NO TO TRUE. DTSBE602 00312 DTSBE602 00313 SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE602 00314 SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE602 00315 DTSBE602 00316 MOVE LECM-TRACE-IND TO L910-TRACE-IND DTSBE602 00317 L931-TRACE-IND. DTSBE602 00318 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBE602 00319 L931-MOD-NAME DTSBE602 00320 L981-MOD-NAME. DTSBE602 00321 DTSBE602 00322 PERFORM S981A-OPEN-READ THRU S981A-EXIT. DTSBE602 00323 DTSBE602 00324 MOVE LOW-VALUES TO FSKL-KEY-AREA. DTSBE602 00325 SET FSKL-SEL-88 TO TRUE. DTSBE602 00326 DTSBE602 00327 PERFORM S931-READ THRU S931-EXIT. DTSBE602 00328 IF L931-NO-REC-88 DTSBE602 00329 MOVE MSG2-TEXT TO ABEND-MSG DTSBE602 00330 PERFORM S999-ABEND THRU S999-EXIT. DTSBE602 00331 MOVE FSKL-REC TO FSEL-REC. DTSBE602 00332 DTSBE602 00333 IF FSEL-ACTIVE-IN-PERIOD-88 DTSBE602 00334 MOVE FSEL-AUDIT-START-YRQ TO L004-QTR-5-9 DTSBE602 00335 PERFORM S004-FROM-5 THRU S004-EXIT DTSBE602 00336 MOVE L004-ABS-QTR TO WRK-AUDIT-START-ABS-QTR DTSBE602 00337 MOVE FSEL-AUDIT-END-YRQ TO L004-QTR-5-9 DTSBE602 00338 PERFORM S004-FROM-5 THRU S004-EXIT DTSBE602 00339 MOVE L004-ABS-QTR TO WRK-AUDIT-END-ABS-QTR. DTSBE602 00340 DTSBE602 00341 MOVE FSEL-AUDIT-START-YRQ TO WRK-START-PRECED-CAL-YRQ DTSBE602 00342 WRK-END-PRECED-CAL-YRQ DTSBE602 00343 WRK-END-CURR-CAL-YRQ. DTSBE602 00344 DTSBE602 00345 SUBTRACT 1 FROM WRK-START-PRECED-CAL-YR. DTSBE602 00346 SUBTRACT 1 FROM WRK-END-PRECED-CAL-YR. DTSBE602 00347 DTSBE602 00348 MOVE 1 TO WRK-START-PRECED-CAL-Q. DTSBE602 00349 MOVE 4 TO WRK-END-PRECED-CAL-Q DTSBE602 00350 WRK-END-CURR-CAL-Q. DTSBE602 00351 DTSBE602 00352 MOVE LECM-CURR-MAIL-DATE TO L001-FED-8-DATE-9. DTSBE602 00353 ADD 1 TO L001-FED-8-YR. DTSBE602 00354 MOVE L001-FED-8-DATE-9 TO WRK-ASSIGN-DUE-DATE. DTSBE602 00355 DTSBE602 00356 I0000-EXIT. DTSBE602 00357 EXIT. DTSBE602 00358 DTSBE602 00359 DTSBE602 00360 P0000-PROCESS. DTSBE602 00361 DTSBE602 00362 IF MPRF-CLASS-CHG-ONLY-88 DTSBE602 00363 OR MPRF-CLASS-SELF-INS-88 DTSBE602 00364 OR MPRF-RETURN-MAIL-YES-88 DTSBE602 00365 OR MPRF-ORG-HSEHLD-DMSTIC-88 DTSBE602 00366 GO TO P0000-EXIT. DTSBE602 00367 DTSBE602 00368 *****IF MPRF-BANKRP-OPEN-88 DTSBE602 00369 ***** GO TO P0000-EXIT. DTSBE602 00370 DTSBE602 00371 PERFORM S061-DETERMINE-FLD-REP THRU S061-EXIT. DTSBE602 00372 IF L061-FLD-REP-ID = '??' DTSBE602 00373 GO TO P0000-EXIT DTSBE602 00374 END-IF. DTSBE602 00375 DTSBE602 00376 IF FSEL-USE-CRITERIA-88 DTSBE602 00377 SET REJECT-NO TO TRUE DTSBE602 00378 PERFORM P1000-NON-RANDOM-NON-IO THRU P1000-EXIT DTSBE602 00379 IF REJECT-YES DTSBE602 00380 GO TO P0000-EXIT. DTSBE602 00381 DTSBE602 00382 MOVE +0 TO R602-PRIOR-YR-WAGES. DTSBE602 00383 MOVE +0 TO WRK-PRIOR-YR-TAX-WAGES. DTSBE602 00384 MOVE WRK-START-PRECED-CAL-YRQ TO WRK-START-BROWSE-YRQ. DTSBE602 00385 PERFORM S1000-START-BROWSE-MQTR THRU S1000-EXIT. DTSBE602 00386 PERFORM UNTIL MQTR-YRQ > WRK-END-PRECED-CAL-YRQ DTSBE602 00387 OR L910-NO-REC-88 DTSBE602 00388 IF NOT MQTR-CURR-ESTIM-88 DTSBE602 00389 ADD MQTR-TOT-WAGE TO R602-PRIOR-YR-WAGES DTSBE602 00390 ADD MQTR-TAX-WAGE TO WRK-PRIOR-YR-TAX-WAGES DTSBE602 00391 END-IF DTSBE602 00392 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE602 00393 MOVE MSKL-REC TO MQTR-REC DTSBE602 00394 END-PERFORM. DTSBE602 00395 DTSBE602 00396 IF FSEL-TAXABLE-WAGE-88 DTSBE602 00397 IF WRK-PRIOR-YR-TAX-WAGES < 1000000 DTSBE602 00398 SET R602-EMP-SIZE-SMALL TO TRUE DTSBE602 00399 ELSE DTSBE602 00400 SET R602-EMP-SIZE-LARGE TO TRUE DTSBE602 00401 ELSE DTSBE602 00402 SET R602-EMP-SIZE-SMALL TO TRUE DTSBE602 00403 MOVE WRK-START-PRECED-CAL-YRQ TO WRK-START-BROWSE-YRQ DTSBE602 00404 PERFORM S1000-START-BROWSE-MQTR THRU S1000-EXIT DTSBE602 00405 PERFORM P2000-SCAN-EMP-SIZE THRU P2000-EXIT DTSBE602 00406 UNTIL R602-EMP-SIZE-LARGE DTSBE602 00407 OR MQTR-YRQ > WRK-END-CURR-CAL-YRQ DTSBE602 00408 OR L910-NO-REC-88. DTSBE602 00409 DTSBE602 00410 MOVE FSEL-TARGET-IND TO R602-TARGET-IND. DTSBE602 00411 DTSBE602 00412 IF R602-EMP-SIZE-SMALL DTSBE602 00413 AND FSEL-SMALL-EMP-LIST-CNT = 0 DTSBE602 00414 GO TO P0000-EXIT. DTSBE602 00415 DTSBE602 00416 IF R602-EMP-SIZE-LARGE DTSBE602 00417 AND FSEL-LARGE-EMP-LIST-CNT = 0 DTSBE602 00418 GO TO P0000-EXIT. DTSBE602 00419 DTSBE602 00420 IF FSEL-RANDOM-88 DTSBE602 00421 PERFORM P3000-WRITE-R602S THRU P3000-EXIT DTSBE602 00422 GO TO P0000-EXIT. DTSBE602 00423 DTSBE602 00424 *---------- NON-RANDOM CRITERIA REQUIRING I/O ---------- DTSBE602 00425 * DTSBE602 00426 *---------- NON-RANDOM CRITERIA REQUIRING I/O ---------- DTSBE602 00427 DTSBE602 00428 IF FSEL-AUDITED-START-YRQ > 0 DTSBE602 00429 IF MPRF-ARCHIVED-AUDIT-YRQ < FSEL-AUDITED-START-YRQ DTSBE602 00430 NEXT SENTENCE DTSBE602 00431 ELSE DTSBE602 00432 GO TO P0000-EXIT. DTSBE602 00433 IF FSEL-AUDITED-START-YRQ > 0 DTSBE602 00434 SET REJECT-NO TO TRUE DTSBE602 00435 PERFORM S2000-START-BROWSE-MSKL-FAS THRU S2000-EXIT DTSBE602 00436 PERFORM P7000-CHECK-FOR-AUDITED THRU P7000-EXIT DTSBE602 00437 UNTIL L910-NO-REC-88 DTSBE602 00438 IF REJECT-YES DTSBE602 00439 GO TO P0000-EXIT. DTSBE602 00440 DTSBE602 00441 IF FSEL-ACTIVE-IN-PERIOD-88 DTSBE602 00442 MOVE LOW-VALUE TO WRK-ACTIVE-QTR-TBL DTSBE602 00443 PERFORM S3000-START-BROWSE-MSKL-SOL THRU S3000-EXIT DTSBE602 00444 PERFORM P4000-FILL-TABLE THRU P4000-EXIT DTSBE602 00445 UNTIL L910-NO-REC-88 DTSBE602 00446 SET REJECT-NO TO TRUE DTSBE602 00447 PERFORM VARYING WRK-CNT FROM WRK-AUDIT-START-ABS-QTR BY 1 DTSBE602 00448 UNTIL WRK-CNT > WRK-AUDIT-END-ABS-QTR DTSBE602 00449 IF WRK-ACTIVE-QTR (WRK-CNT) = LOW-VALUE DTSBE602 00450 SET REJECT-YES TO TRUE DTSBE602 00451 END-IF DTSBE602 00452 END-PERFORM DTSBE602 00453 IF REJECT-YES DTSBE602 00454 GO TO P0000-EXIT. DTSBE602 00455 *-- DTSBE602 00456 IF FSEL-INIT-LIAB-END-DATE > 0 DTSBE602 00457 PERFORM S3000-START-BROWSE-MSKL-SOL THRU S3000-EXIT DTSBE602 00458 IF L910-NO-REC-88 DTSBE602 00459 GO TO P0000-EXIT DTSBE602 00460 ELSE DTSBE602 00461 IF MSOL-LIAB-DATE < FSEL-INIT-LIAB-START-DATE DTSBE602 00462 OR MSOL-LIAB-DATE > FSEL-INIT-LIAB-END-DATE DTSBE602 00463 GO TO P0000-EXIT. DTSBE602 00464 SKIP1 DTSBE602 00465 *-- DTSBE602 00466 SKIP1 DTSBE602 00467 IF FSEL-TOT-WAGE-END-AMT > -1 DTSBE602 00468 MOVE +0 TO WRK-TOT-WAGE DTSBE602 00469 MOVE FSEL-AUDIT-START-YRQ TO WRK-START-BROWSE-YRQ DTSBE602 00470 PERFORM S1000-START-BROWSE-MQTR THRU S1000-EXIT DTSBE602 00471 PERFORM UNTIL MQTR-YRQ > FSEL-AUDIT-END-YRQ DTSBE602 00472 OR L910-NO-REC-88 DTSBE602 00473 IF NOT MQTR-CURR-ESTIM-88 DTSBE602 00474 ADD MQTR-TOT-WAGE TO WRK-TOT-WAGE DTSBE602 00475 END-IF DTSBE602 00476 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE602 00477 MOVE MSKL-REC TO MQTR-REC DTSBE602 00478 END-PERFORM DTSBE602 00479 IF WRK-TOT-WAGE < FSEL-TOT-WAGE-START-AMT DTSBE602 00480 OR WRK-TOT-WAGE > FSEL-TOT-WAGE-END-AMT DTSBE602 00481 GO TO P0000-EXIT. DTSBE602 00482 DTSBE602 00483 IF FSEL-TOT-WAGE-DECR-END-YRQ > 0 DTSBE602 00484 MOVE +0 TO WRK-PREV-TOT-WAGE DTSBE602 00485 WRK-TOT-WAGE DTSBE602 00486 WRK-CNT DTSBE602 00487 PERFORM P5100-GET-DECR-WAGE THRU P5100-EXIT DTSBE602 00488 IF WRK-CNT NOT > WRK-END-ABS-QTR - WRK-START-ABS-QTR DTSBE602 00489 GO TO P0000-EXIT DTSBE602 00490 ELSE DTSBE602 00491 PERFORM P5200-GET-PREV-DECR-WAGE THRU P5200-EXIT DTSBE602 00492 COMPUTE WRK-RATIO ROUNDED DTSBE602 00493 = WRK-TOT-WAGE / WRK-PREV-TOT-WAGE DTSBE602 00494 ON SIZE ERROR DTSBE602 00495 GO TO P0000-EXIT. DTSBE602 00496 IF FSEL-TOT-WAGE-DECR-END-YRQ > 0 DTSBE602 00497 IF WRK-RATIO < FSEL-TOT-WAGE-START-RATIO DTSBE602 00498 OR WRK-RATIO > FSEL-TOT-WAGE-END-RATIO DTSBE602 00499 GO TO P0000-EXIT. DTSBE602 00500 DTSBE602 00501 IF FSEL-TOT-WAGE-CHNG-END-YRQ > 0 DTSBE602 00502 MOVE +0 TO WRK-CNT DTSBE602 00503 MOVE FSEL-TOT-WAGE-CHNG-START-YRQ TO WRK-START-BROWSE-YRQDTSBE602 00504 PERFORM S4000-START-BROWSE-MRPT THRU S4000-EXIT DTSBE602 00505 PERFORM P6000-CHECK-SUPPLEM THRU P6000-EXIT DTSBE602 00506 UNTIL MRPT-YRQ > FSEL-TOT-WAGE-CHNG-END-YRQ DTSBE602 00507 OR L910-NO-REC-88 DTSBE602 00508 IF WRK-CNT < FSEL-TOT-WAGE-CHNG-TRIGGER-CNT DTSBE602 00509 GO TO P0000-EXIT. DTSBE602 00510 DTSBE602 00511 IF FSEL-UI-RATE-MIN > 0 DTSBE602 00512 SET REJECT-YES TO TRUE DTSBE602 00513 MOVE FSEL-AUDIT-START-YRQ TO WRK-START-BROWSE-YRQ DTSBE602 00514 PERFORM S1000-START-BROWSE-MQTR THRU S1000-EXIT DTSBE602 00515 PERFORM P8000-CHECK-UI-RATE THRU P8000-EXIT DTSBE602 00516 UNTIL MQTR-YRQ > FSEL-AUDIT-END-YRQ DTSBE602 00517 OR L910-NO-REC-88 DTSBE602 00518 IF REJECT-YES DTSBE602 00519 GO TO P0000-EXIT. DTSBE602 00520 DTSBE602 00521 PERFORM P9000-CHECK-WAGES THRU P9000-EXIT. DTSBE602 00522 IF REJECT-YES DTSBE602 00523 GO TO P0000-EXIT. DTSBE602 00524 DTSBE602 00525 PERFORM P3000-WRITE-R602S THRU P3000-EXIT. DTSBE602 00526 DTSBE602 00527 P0000-EXIT. DTSBE602 00528 EXIT. DTSBE602 00529 EJECT DTSBE602 00530 DTSBE602 00531 P1000-NON-RANDOM-NON-IO. DTSBE602 00532 DTSBE602 00533 *** IF MPRF-CLASS-RATED-88 DTSBE602 00534 * IF FSEL-REGULAR-EXCLUDE-88 DTSBE602 00535 *** SET REJECT-YES TO TRUE DTSBE602 00536 *** GO TO P1000-EXIT DTSBE602 00537 * END-IF DTSBE602 00538 * ELSE DTSBE602 00539 * IF FSEL-GOVT-EXCLUDE-88 DTSBE602 00540 * SET REJECT-YES TO TRUE DTSBE602 00541 * GO TO P1000-EXIT. DTSBE602 00542 SKIP1 DTSBE602 00543 *-- DTSBE602 00544 SKIP1 DTSBE602 00545 IF FSEL-ACTIVE-CURRENTLY-88 DTSBE602 00546 IF MPRF-STATUS-ACT-88 DTSBE602 00547 NEXT SENTENCE DTSBE602 00548 ELSE DTSBE602 00549 SET REJECT-YES TO TRUE DTSBE602 00550 GO TO P1000-EXIT. DTSBE602 00551 SKIP3 DTSBE602 00552 IF FSEL-END-NAICS-CD NOT = SPACES DTSBE602 00553 IF MPRF-NAICS-CD < FSEL-START-NAICS-CD DTSBE602 00554 OR MPRF-NAICS-CD > FSEL-END-NAICS-CD DTSBE602 00555 SET REJECT-YES TO TRUE DTSBE602 00556 GO TO P1000-EXIT. DTSBE602 00557 SKIP3 DTSBE602 00558 IF FSEL-END-SIC-CD NOT = SPACES DTSBE602 00559 IF MPRF-SIC-CD < FSEL-START-SIC-CD DTSBE602 00560 OR MPRF-SIC-CD > FSEL-END-SIC-CD DTSBE602 00561 SET REJECT-YES TO TRUE DTSBE602 00562 GO TO P1000-EXIT. DTSBE602 00563 SKIP3 DTSBE602 00564 IF FSEL-MUST-BE-ASSIGNED-88 DTSBE602 00565 IF MPRF-FLD-ZIP (1:2) NOT = '20' DTSBE602 00566 SET REJECT-YES TO TRUE DTSBE602 00567 GO TO P1000-EXIT. DTSBE602 00568 SKIP3 DTSBE602 00569 IF FSEL-FLD-ZIP-END NOT = SPACE DTSBE602 00570 IF MPRF-FLD-ZIP (1:5) < FSEL-FLD-ZIP-START DTSBE602 00571 OR MPRF-FLD-ZIP (1:5) > FSEL-FLD-ZIP-END DTSBE602 00572 SET REJECT-YES TO TRUE DTSBE602 00573 GO TO P1000-EXIT. DTSBE602 00574 SKIP1 DTSBE602 00575 *-- DTSBE602 00576 SKIP1 DTSBE602 00577 IF FSEL-FLD-REP-ID (1) NOT = SPACE DTSBE602 00578 SET REJECT-YES TO TRUE DTSBE602 00579 PERFORM P1100-SCAN-FLD-REP THRU P1100-EXIT DTSBE602 00580 VARYING FSEL-FLD-REP-IDX FROM 1 BY 1 DTSBE602 00581 UNTIL REJECT-NO DTSBE602 00582 OR FSEL-FLD-REP-IDX GREATER THAN DTSBE602 00583 FMAX-SEL-FLD-REP-ID-MAX DTSBE602 00584 IF REJECT-YES DTSBE602 00585 GO TO P1000-EXIT. DTSBE602 00586 SKIP1 DTSBE602 00587 P1000-EXIT. EXIT. DTSBE602 00588 EJECT DTSBE602 00589 P1100-SCAN-FLD-REP. DTSBE602 00590 SKIP1 DTSBE602 00591 IF FSEL-FLD-REP-ID (FSEL-FLD-REP-IDX) = L061-FLD-REP-ID DTSBE602 00592 SET REJECT-NO TO TRUE. DTSBE602 00593 SKIP1 DTSBE602 00594 P1100-EXIT. EXIT. DTSBE602 00595 EJECT DTSBE602 00596 P2000-SCAN-EMP-SIZE. DTSBE602 00597 SKIP1 DTSBE602 00598 IF MQTR-1ST-MTH-NO-ENTRY-88 DTSBE602 00599 NEXT SENTENCE DTSBE602 00600 ELSE DTSBE602 00601 IF MQTR-1ST-MTH-EMPL-CNT < 100 DTSBE602 00602 NEXT SENTENCE DTSBE602 00603 ELSE DTSBE602 00604 SET R602-EMP-SIZE-LARGE TO TRUE DTSBE602 00605 GO TO P2000-EXIT. DTSBE602 00606 SKIP1 DTSBE602 00607 IF MQTR-2ND-MTH-NO-ENTRY-88 DTSBE602 00608 NEXT SENTENCE DTSBE602 00609 ELSE DTSBE602 00610 IF MQTR-2ND-MTH-EMPL-CNT < 100 DTSBE602 00611 NEXT SENTENCE DTSBE602 00612 ELSE DTSBE602 00613 SET R602-EMP-SIZE-LARGE TO TRUE DTSBE602 00614 GO TO P2000-EXIT. DTSBE602 00615 SKIP1 DTSBE602 00616 IF MQTR-3RD-MTH-NO-ENTRY-88 DTSBE602 00617 NEXT SENTENCE DTSBE602 00618 ELSE DTSBE602 00619 IF MQTR-3RD-MTH-EMPL-CNT < 100 DTSBE602 00620 NEXT SENTENCE DTSBE602 00621 ELSE DTSBE602 00622 SET R602-EMP-SIZE-LARGE TO TRUE DTSBE602 00623 GO TO P2000-EXIT. DTSBE602 00624 SKIP1 DTSBE602 00625 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE602 00626 MOVE MSKL-REC TO MQTR-REC. DTSBE602 00627 SKIP1 DTSBE602 00628 P2000-EXIT. EXIT. DTSBE602 00629 EJECT DTSBE602 00630 P3000-WRITE-R602S. DTSBE602 00631 PERFORM P3900-PROCESS-MTAD THRU P3900-EXIT. DTSBE602 00632 MOVE L061-FLD-REP-ID TO R602-FIELD-REP-ID. DTSBE602 00633 MOVE MPRF-FLD-ZIP TO R602-FLD-ZIP. DTSBE602 00634 MOVE SPACES TO R602-FLD-ZIP (6:5). DTSBE602 00635 MOVE MPRF-EMP-NO TO R602-EMP-NO. DTSBE602 00636 MOVE MPRF-PRIMARY-NAME TO R602-PRIMARY-NAME. DTSBE602 00637 MOVE MPRF-SIC-CD TO R602-SIC-CD. DTSBE602 00638 MOVE MPRF-OWN-CD TO R602-OWN-CD. DTSBE602 00639 MOVE MPRF-NAICS-CD TO R602-NAICS-CD. DTSBE602 00640 MOVE ZERO TO R602-ASSIGN-NO. DTSBE602 00641 SKIP1 DTSBE602 00642 SET R602-UNIVERSE-CNT-88 TO TRUE. DTSBE602 00643 PERFORM S946-WRITE-R602 THRU S946-EXIT. DTSBE602 00644 SET R602-SELECTION-88 TO TRUE. DTSBE602 00645 PERFORM S946-WRITE-R602 THRU S946-EXIT. DTSBE602 00646 SKIP1 DTSBE602 00647 SET RECORDS-WRITTEN-YES TO TRUE. DTSBE602 00648 DTSBE602 00649 P3000-EXIT. DTSBE602 00650 EXIT. DTSBE602 00651 EJECT DTSBE602 00652 DTSBE602 00653 P3900-PROCESS-MTAD. DTSBE602 00654 IF MPRF-EMP-NO = 022647 DTSBE602 00655 DISPLAY 'P4 ' MPRF-EMP-NO DTSBE602 00656 END-IF. DTSBE602 00657 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSBE602 00658 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSBE602 00659 SET MTAD-TAD-88 TO TRUE. DTSBE602 00660 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBE602 00661 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE602 00662 PERFORM P4100-SCAN-MTAD THRU P4100-EXIT DTSBE602 00663 UNTIL L910-NO-REC-88. DTSBE602 00664 P3900-EXIT. DTSBE602 00665 EXIT. DTSBE602 00666 EJECT DTSBE602 00667 ************************************************************* DTSBE602 00668 ** DTSBE602 00669 **THIS PARAGRAPH SCANS THE MTAD RECORDS. DTSBE602 00670 ************************************************************* DTSBE602 00671 ** DTSBE602 00672 P4100-SCAN-MTAD. DTSBE602 00673 MOVE MSKL-REC TO MTAD-REC. DTSBE602 00674 PERFORM P4110-WRITE-MTAD-REC THRU P4110-EXIT. DTSBE602 00675 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE602 00676 P4100-EXIT. DTSBE602 00677 EXIT. DTSBE602 00678 EJECT DTSBE602 00679 ************************************************************* DTSBE602 00680 * DTSBE602 00681 P4110-WRITE-MTAD-REC. DTSBE602 00682 IF MTAD-UC223-NO-88 DTSBE602 00683 GO TO P4110-EXIT. DTSBE602 00684 MOVE LOW-VALUES TO L111-RETURN-AREA. DTSBE602 00685 MOVE MPRF-EMP-NO TO L111-EMP-NO. DTSBE602 00686 SET L111-LOOKUP-TAD-88 TO TRUE. DTSBE602 00687 MOVE MTAD-ID-NO TO L111-ID-NO. DTSBE602 00688 PERFORM S111-LOOKUP-ADDR THRU S111-EXIT. DTSBE602 00689 IF L111-ADDR-FOUND-88 DTSBE602 00690 SET L112-TAD-ADDR-88 TO TRUE DTSBE602 00691 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA DTSBE602 00692 PERFORM P4111-FORMAT-ADDR THRU P4111-EXIT DTSBE602 00693 ELSE DTSBE602 00694 MOVE ALL '?' TO R602-FMT-ADDR DTSBE602 00695 R602-ZIP DTSBE602 00696 R602-ADVANCED-BARCODE. DTSBE602 00697 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBE602 00698 PERFORM S910-READ THRU S910-EXIT. DTSBE602 00699 IF L910-NO-REC-88 DTSBE602 00700 PERFORM S999-ABEND THRU S999-EXIT. DTSBE602 00701 P4110-EXIT. DTSBE602 00702 EXIT. DTSBE602 00703 EJECT DTSBE602 00704 P4111-FORMAT-ADDR. DTSBE602 00705 SET L112-ANCHOR-FIRST-88 TO TRUE. DTSBE602 00706 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME. DTSBE602 00707 PERFORM S112-FORMAT-ADDR THRU S112-EXIT. DTSBE602 00708 MOVE L112-MAILING-ADDRESS TO R602-FMT-ADDR. DTSBE602 00709 MOVE L112-ZIP TO R602-ZIP. DTSBE602 00710 MOVE L112-ADVANCED-BARCODE TO R602-ADVANCED-BARCODE. DTSBE602 00711 P4111-EXIT. DTSBE602 00712 EXIT. DTSBE602 00713 EJECT DTSBE602 00714 P4000-FILL-TABLE. DTSBE602 00715 SKIP1 DTSBE602 00716 MOVE MSOL-FIRST-LIAB-YRQ TO L004-QTR-5-9. DTSBE602 00717 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE602 00718 IF L004-VALID-QTR DTSBE602 00719 MOVE L004-ABS-QTR TO WRK-START-ABS-QTR DTSBE602 00720 ELSE DTSBE602 00721 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE602 00722 MOVE MSKL-REC TO MSOL-REC DTSBE602 00723 GO TO P4000-EXIT. DTSBE602 00724 SKIP3 DTSBE602 00725 MOVE MSOL-LAST-LIAB-YRQ TO L004-QTR-5-9. DTSBE602 00726 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE602 00727 IF L004-VALID-QTR DTSBE602 00728 MOVE L004-ABS-QTR TO WRK-END-ABS-QTR DTSBE602 00729 ELSE DTSBE602 00730 MOVE +400 TO WRK-END-ABS-QTR. DTSBE602 00731 SKIP3 DTSBE602 00732 MOVE ALL 'X' TO WRK-ACTIVE-QTR-TBL (WRK-START-ABS-QTR DTSBE602 00733 : WRK-END-ABS-QTR - WRK-START-ABS-QTR + 1).DTSBE602 00734 SKIP3 DTSBE602 00735 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE602 00736 MOVE MSKL-REC TO MSOL-REC. DTSBE602 00737 SKIP1 DTSBE602 00738 P4000-EXIT. EXIT. DTSBE602 00739 EJECT DTSBE602 00740 P5100-GET-DECR-WAGE. DTSBE602 00741 SKIP1 DTSBE602 00742 MOVE FSEL-TOT-WAGE-DECR-START-YRQ TO WRK-START-BROWSE-YRQ. DTSBE602 00743 PERFORM S1000-START-BROWSE-MQTR THRU S1000-EXIT. DTSBE602 00744 PERFORM UNTIL MQTR-YRQ > FSEL-TOT-WAGE-DECR-END-YRQ DTSBE602 00745 OR L910-NO-REC-88 DTSBE602 00746 IF MQTR-CURR-ESTIM-88 DTSBE602 00747 OR MQTR-CURR-NOT-LIABLE-88 DTSBE602 00748 CONTINUE DTSBE602 00749 ELSE DTSBE602 00750 ADD MQTR-TOT-WAGE TO WRK-TOT-WAGE DTSBE602 00751 ADD +1 TO WRK-CNT DTSBE602 00752 END-IF DTSBE602 00753 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE602 00754 MOVE MSKL-REC TO MQTR-REC DTSBE602 00755 END-PERFORM. DTSBE602 00756 SKIP3 DTSBE602 00757 MOVE FSEL-TOT-WAGE-DECR-START-YRQ TO L004-QTR-5-9. DTSBE602 00758 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE602 00759 MOVE L004-ABS-QTR TO WRK-START-ABS-QTR. DTSBE602 00760 SKIP1 DTSBE602 00761 MOVE FSEL-TOT-WAGE-DECR-END-YRQ TO L004-QTR-5-9. DTSBE602 00762 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE602 00763 MOVE L004-ABS-QTR TO WRK-END-ABS-QTR. DTSBE602 00764 SKIP1 DTSBE602 00765 P5100-EXIT. EXIT. DTSBE602 00766 SKIP3 DTSBE602 00767 P5200-GET-PREV-DECR-WAGE. DTSBE602 00768 SKIP1 DTSBE602 00769 SUBTRACT 1 FROM WRK-START-ABS-QTR GIVING L004-ABS-QTR. DTSBE602 00770 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBE602 00771 MOVE L004-QTR-5-9 TO WRK-PREV-END-YRQ. DTSBE602 00772 SKIP1 DTSBE602 00773 COMPUTE L004-ABS-QTR = L004-ABS-QTR - DTSBE602 00774 ( WRK-END-ABS-QTR - WRK-START-ABS-QTR ). DTSBE602 00775 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBE602 00776 MOVE L004-QTR-5-9 TO WRK-PREV-START-YRQ. DTSBE602 00777 SKIP3 DTSBE602 00778 MOVE WRK-PREV-START-YRQ TO WRK-START-BROWSE-YRQ. DTSBE602 00779 PERFORM S1000-START-BROWSE-MQTR THRU S1000-EXIT. DTSBE602 00780 PERFORM UNTIL MQTR-YRQ > WRK-PREV-END-YRQ DTSBE602 00781 OR L910-NO-REC-88 DTSBE602 00782 IF NOT MQTR-CURR-ESTIM-88 DTSBE602 00783 ADD MQTR-TOT-WAGE TO WRK-PREV-TOT-WAGE DTSBE602 00784 END-IF DTSBE602 00785 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE602 00786 MOVE MSKL-REC TO MQTR-REC DTSBE602 00787 END-PERFORM. DTSBE602 00788 SKIP1 DTSBE602 00789 P5200-EXIT. EXIT. DTSBE602 00790 EJECT DTSBE602 00791 P6000-CHECK-SUPPLEM. DTSBE602 00792 SKIP1 DTSBE602 00793 IF MRPT-TOT-WAGE = 0 DTSBE602 00794 AND MRPT-TAX-WAGE = 0 DTSBE602 00795 NEXT SENTENCE DTSBE602 00796 ELSE DTSBE602 00797 IF MRPT-SUPPLEM-88 DTSBE602 00798 ADD +1 TO WRK-CNT. DTSBE602 00799 SKIP1 DTSBE602 00800 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE602 00801 MOVE MSKL-REC TO MRPT-REC. DTSBE602 00802 SKIP1 DTSBE602 00803 P6000-EXIT. EXIT. DTSBE602 00804 EJECT DTSBE602 00805 P7000-CHECK-FOR-AUDITED. DTSBE602 00806 SKIP1 DTSBE602 00807 IF MFAS-AUDIT-88 DTSBE602 00808 IF ( MFAS-STATUS-ACTIVE-88 DTSBE602 00809 OR MFAS-STATUS-COMPLETE-88 DTSBE602 00810 OR MFAS-STATUS-HELD-88 ) DTSBE602 00811 IF MFAS-END-YRQ < FSEL-AUDITED-START-YRQ DTSBE602 00812 NEXT SENTENCE DTSBE602 00813 ELSE DTSBE602 00814 SET REJECT-YES TO TRUE DTSBE602 00815 SET L910-NO-REC-88 TO TRUE DTSBE602 00816 GO TO P7000-EXIT DTSBE602 00817 ELSE DTSBE602 00818 IF MFAS-STATUS-PROCESSED-88 DTSBE602 00819 MOVE LOW-VALUE TO MAUR-KEY-AREA DTSBE602 00820 MOVE MFAS-EMP-NO TO MAUR-EMP-NO DTSBE602 00821 SET MAUR-AUR-88 TO TRUE DTSBE602 00822 MOVE MFAS-ASSIGN-NO TO MAUR-ASSIGN-NO DTSBE602 00823 MOVE MAUR-KEY-AREA TO MSKL-KEY-AREA DTSBE602 00824 PERFORM S910-READ THRU S910-EXIT DTSBE602 00825 IF L910-NO-REC-88 DTSBE602 00826 PERFORM P7100-REREAD-MFAS-KEY THRU P7100-EXIT DTSBE602 00827 ELSE DTSBE602 00828 MOVE MSKL-REC TO MAUR-REC DTSBE602 00829 IF MAUR-LAST-YRQ < FSEL-AUDITED-START-YRQ DTSBE602 00830 PERFORM P7100-REREAD-MFAS-KEY THRU P7100-EXITDTSBE602 00831 ELSE DTSBE602 00832 SET REJECT-YES TO TRUE DTSBE602 00833 SET L910-NO-REC-88 TO TRUE DTSBE602 00834 GO TO P7000-EXIT. DTSBE602 00835 SKIP1 DTSBE602 00836 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE602 00837 MOVE MSKL-REC TO MFAS-REC. DTSBE602 00838 SKIP1 DTSBE602 00839 P7000-EXIT. EXIT. DTSBE602 00840 EJECT DTSBE602 00841 P7100-REREAD-MFAS-KEY. DTSBE602 00842 SKIP1 DTSBE602 00843 MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA. DTSBE602 00844 PERFORM S910-READ THRU S910-EXIT. DTSBE602 00845 IF L910-NO-REC-88 DTSBE602 00846 MOVE MSG4-TEXT TO ABEND-MSG DTSBE602 00847 PERFORM S999-ABEND THRU S999-EXIT. DTSBE602 00848 SKIP1 DTSBE602 00849 P7100-EXIT. EXIT. DTSBE602 00850 EJECT DTSBE602 00851 P8000-CHECK-UI-RATE. DTSBE602 00852 SKIP1 DTSBE602 00853 IF MQTR-UI-RATE < FSEL-UI-RATE-MIN DTSBE602 00854 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE602 00855 MOVE MSKL-REC TO MQTR-REC DTSBE602 00856 ELSE DTSBE602 00857 SET REJECT-NO TO TRUE DTSBE602 00858 SET L910-NO-REC-88 TO TRUE. DTSBE602 00859 SKIP1 DTSBE602 00860 P8000-EXIT. EXIT. DTSBE602 00861 EJECT DTSBE602 00862 P9000-CHECK-WAGES. DTSBE602 00863 MOVE ZERO TO WRK-WGH-TOT-WAGE DTSBE602 00864 WRK-MQTR-TOT-WAGE. DTSBE602 00865 DTSBE602 00866 MOVE LOW-VALUES TO WWGH-KEY-AREA. DTSBE602 00867 MOVE MPRF-EMP-NO TO WWGH-EMP-NO. DTSBE602 00868 MOVE FSEL-AUDIT-START-YRQ TO WWGH-YRQ. DTSBE602 00869 DTSBE602 00870 PERFORM S981D-START-BROWSE THRU S981D-EXIT. DTSBE602 00871 PERFORM UNTIL L981-NO-REC-88 DTSBE602 00872 IF WWGH-EMP-NO = MPRF-EMP-NO DTSBE602 00873 AND WWGH-YRQ <= FSEL-AUDIT-END-YRQ DTSBE602 00874 ADD WWGH-EARNINGS TO WRK-WGH-TOT-WAGE DTSBE602 00875 PERFORM S981E-READ-NEXT THRU S981E-EXIT DTSBE602 00876 ELSE DTSBE602 00877 SET L981-NO-REC-88 TO TRUE DTSBE602 00878 END-IF DTSBE602 00879 END-PERFORM. DTSBE602 00880 DTSBE602 00881 MOVE FSEL-AUDIT-START-YRQ TO WRK-START-BROWSE-YRQ. DTSBE602 00882 PERFORM S1000-START-BROWSE-MQTR THRU S1000-EXIT. DTSBE602 00883 PERFORM UNTIL L910-NO-REC-88 DTSBE602 00884 IF MQTR-YRQ > FSEL-AUDIT-END-YRQ DTSBE602 00885 SET L910-NO-REC-88 TO TRUE DTSBE602 00886 ELSE DTSBE602 00887 IF NOT MQTR-CURR-ESTIM-88 DTSBE602 00888 ADD MQTR-TOT-WAGE TO WRK-MQTR-TOT-WAGE DTSBE602 00889 END-IF DTSBE602 00890 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE602 00891 MOVE MSKL-REC TO MQTR-REC DTSBE602 00892 END-IF DTSBE602 00893 END-PERFORM. DTSBE602 00894 DTSBE602 00895 IF WRK-MQTR-TOT-WAGE > ZERO DTSBE602 00896 AND WRK-WGH-TOT-WAGE = ZERO DTSBE602 00897 MOVE WRK-MQTR-TOT-WAGE TO WRK-DISP-AMT1 DTSBE602 00898 MOVE WRK-WGH-TOT-WAGE TO WRK-DISP-AMT2 DTSBE602 00899 DISPLAY 'NO WAGES ' MPRF-EMP-NO DTSBE602 00900 ' MQTR ' WRK-DISP-AMT1 DTSBE602 00901 ' WGH ' WRK-DISP-AMT2 DTSBE602 00902 SET REJECT-YES TO TRUE DTSBE602 00903 END-IF. DTSBE602 00904 DTSBE602 00905 P9000-EXIT. EXIT. DTSBE602 00906 EJECT DTSBE602 00907 S004-FROM-5. DTSBE602 00908 SET L004-FROM-5 TO TRUE. DTSBE602 00909 GO TO S004-QTR. DTSBE602 00910 SKIP1 DTSBE602 00911 S004-FROM-ABS. DTSBE602 00912 SET L004-FROM-ABS TO TRUE. DTSBE602 00913 GO TO S004-QTR. DTSBE602 00914 SKIP1 DTSBE602 00915 S004-QTR. DTSBE602 00916 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBE602 00917 S004-EXIT. EXIT. DTSBE602 00918 SKIP3 DTSBE602 00919 S061-DETERMINE-FLD-REP. DTSBE602 00920 MOVE MPRF-FLD-ZIP TO L061-FLD-ZIP. DTSBE602 00921 MOVE MPRF-FLD-ST TO L061-FLD-ST. DTSBE602 00922 MOVE MPRF-EMP-NO TO L061-EMP-NO. DTSBE602 00923 CALL 'DTSBU061' USING L061-LINK-AREA. DTSBE602 00924 S061-EXIT. EXIT. DTSBE602 00925 SKIP3 DTSBE602 00926 S111-LOOKUP-ADDR. DTSBE602 00927 CALL 'DTSBU111' USING L111-LINK-AREA. DTSBE602 00928 S111-EXIT. DTSBE602 00929 EXIT. DTSBE602 00930 SKIP3 DTSBE602 00931 S112-FORMAT-ADDR. DTSBE602 00932 CALL 'DTSBU112' USING L112-LINK-AREA. DTSBE602 00933 S112-EXIT. DTSBE602 00934 EXIT. DTSBE602 00935 SKIP3 DTSBE602 00936 S910-READ. DTSBE602 00937 SET L910-READ-88 TO TRUE. DTSBE602 00938 GO TO S910-MSTR-IO. DTSBE602 00939 SKIP1 DTSBE602 00940 S910-START-BROWSE. DTSBE602 00941 SET L910-START-BROWSE-88 TO TRUE. DTSBE602 00942 GO TO S910-MSTR-IO. DTSBE602 00943 SKIP1 DTSBE602 00944 S910-READ-NEXT. DTSBE602 00945 SET L910-READ-NEXT-88 TO TRUE. DTSBE602 00946 GO TO S910-MSTR-IO. DTSBE602 00947 SKIP1 DTSBE602 00948 *S910-COUNT. DTSBE602 00949 * SET L910-COUNT-88 TO TRUE. DTSBE602 00950 * GO TO S910-MSTR-IO. DTSBE602 00951 DTSBE602 00952 S910-REWRITE. DTSBE602 00953 SET L910-REWRITE-88 TO TRUE. DTSBE602 00954 GO TO S910-MSTR-IO. DTSBE602 00955 DTSBE602 00956 S910-WRITE. DTSBE602 00957 SET L910-WRITE-88 TO TRUE. DTSBE602 00958 GO TO S910-MSTR-IO. DTSBE602 00959 DTSBE602 00960 S910-MSTR-IO. DTSBE602 00961 CALL 'DTSBU910' USING L910-LINK-AREA DTSBE602 00962 MSKL-REC. DTSBE602 00963 S910-EXIT. EXIT. DTSBE602 00964 EJECT DTSBE602 00965 S931-READ. DTSBE602 00966 SET L931-READ-88 TO TRUE. DTSBE602 00967 GO TO S931-REF-I. DTSBE602 00968 SKIP1 DTSBE602 00969 *S931-START-BROWSE. DTSBE602 00970 * SET L931-START-BROWSE-88 TO TRUE. DTSBE602 00971 * GO TO S931-REF-I. DTSBE602 00972 * SKIP1 DTSBE602 00973 *S931-READ-NEXT. DTSBE602 00974 * SET L931-READ-NEXT-88 TO TRUE. DTSBE602 00975 * GO TO S931-REF-I. DTSBE602 00976 SKIP1 DTSBE602 00977 S931-REF-I. DTSBE602 00978 CALL 'DTSBU931' USING L931-LINK-AREA DTSBE602 00979 FSKL-REC. DTSBE602 00980 S931-EXIT. EXIT. DTSBE602 00981 SKIP3 DTSBE602 00982 S946-WRITE-R602. DTSBE602 00983 CALL 'DTSBU946' USING R602-REC. DTSBE602 00984 S946-EXIT. EXIT. DTSBE602 00985 SKIP3 DTSBE602 00986 S981A-OPEN-READ. DTSBE602 00987 SET L981-OPEN-READ-88 TO TRUE. DTSBE602 00988 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBE602 00989 DTSBE602 00990 S981A-EXIT. DTSBE602 00991 EXIT. DTSBE602 00992 DTSBE602 00993 S981C-CLOSE. DTSBE602 00994 SET L981-CLOSE-88 TO TRUE. DTSBE602 00995 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBE602 00996 DTSBE602 00997 S981C-EXIT. DTSBE602 00998 EXIT. DTSBE602 00999 DTSBE602 01000 S981D-START-BROWSE. DTSBE602 01001 SET L981-START-BROWSE-88 TO TRUE. DTSBE602 01002 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBE602 01003 DTSBE602 01004 S981D-EXIT. DTSBE602 01005 EXIT. DTSBE602 01006 DTSBE602 01007 S981E-READ-NEXT. DTSBE602 01008 SET L981-READ-NEXT-88 TO TRUE. DTSBE602 01009 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBE602 01010 DTSBE602 01011 S981E-EXIT. DTSBE602 01012 EXIT. DTSBE602 01013 DTSBE602 01014 S981Z-WAGE-I. DTSBE602 01015 CALL 'DTSBU981' USING L981-LINK-AREA DTSBE602 01016 WWGH-REC. DTSBE602 01017 S981Z-EXIT. DTSBE602 01018 EXIT. DTSBE602 01019 DTSBE602 01020 S999-ABEND. DTSBE602 01021 DISPLAY '*** DTSBE602 ABENDING - ' ABEND-MSG. DTSBE602 01022 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBE602 01023 S999-EXIT. EXIT. DTSBE602 01024 EJECT DTSBE602 01025 S1000-START-BROWSE-MQTR. DTSBE602 01026 SKIP1 DTSBE602 01027 MOVE LOW-VALUE TO MQTR-KEY-AREA. DTSBE602 01028 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE602 01029 SET MQTR-QTR-88 TO TRUE. DTSBE602 01030 MOVE WRK-START-BROWSE-YRQ TO MQTR-YRQ. DTSBE602 01031 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE602 01032 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE602 01033 IF L910-OK-88 DTSBE602 01034 MOVE MSKL-REC TO MQTR-REC. DTSBE602 01035 SKIP1 DTSBE602 01036 S1000-EXIT. EXIT. DTSBE602 01037 SKIP3 DTSBE602 01038 S2000-START-BROWSE-MSKL-FAS. DTSBE602 01039 SKIP1 DTSBE602 01040 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBE602 01041 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBE602 01042 SET MSKL-FAS-88 TO TRUE. DTSBE602 01043 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE602 01044 IF L910-OK-88 DTSBE602 01045 MOVE MSKL-REC TO MFAS-REC. DTSBE602 01046 SKIP1 DTSBE602 01047 S2000-EXIT. EXIT. DTSBE602 01048 SKIP3 DTSBE602 01049 S3000-START-BROWSE-MSKL-SOL. DTSBE602 01050 SKIP1 DTSBE602 01051 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBE602 01052 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBE602 01053 SET MSKL-SOL-88 TO TRUE. DTSBE602 01054 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE602 01055 IF L910-OK-88 DTSBE602 01056 MOVE MSKL-REC TO MSOL-REC. DTSBE602 01057 SKIP1 DTSBE602 01058 S3000-EXIT. EXIT. DTSBE602 01059 SKIP3 DTSBE602 01060 S4000-START-BROWSE-MRPT. DTSBE602 01061 SKIP1 DTSBE602 01062 MOVE LOW-VALUE TO MRPT-KEY-AREA. DTSBE602 01063 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. DTSBE602 01064 SET MRPT-RPT-88 TO TRUE. DTSBE602 01065 MOVE WRK-START-BROWSE-YRQ TO MRPT-YRQ. DTSBE602 01066 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSBE602 01067 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE602 01068 IF L910-OK-88 DTSBE602 01069 MOVE MSKL-REC TO MRPT-REC. DTSBE602 01070 DTSBE602 01071 S4000-EXIT. DTSBE602 01072 EXIT. DTSBE602 01073 DTSBE602 01074 T0000-TERMINATE. DTSBE602 01075 PERFORM S981C-CLOSE THRU S981C-EXIT. DTSBE602 01076 DTSBE602 01077 *****IF RECORDS-WRITTEN-NO DTSBE602 01078 ***** MOVE MSG3-TEXT TO ABEND-MSG DTSBE602 01079 ***** PERFORM S999-ABEND THRU S999-EXIT. DTSBE602 01080 DTSBE602 01081 DTSBE602 01082 T0000-EXIT. DTSBE602 01083 EXIT. DTSBE602