giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
ca3572c5dfa2d2f7aa129881cbdfdb422c1fc30f
DUTAS/Batch/DTSBE602.cob
Neeraj Kumar ca3572c5df DUTAS re-platformed to Raincode - Initial Source Code
2025-07-21 11:20:11 -04:00

1085 lines
86 KiB
COBOL
Raw Blame History

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
Reference in New Issue View Git Blame Copy Permalink