00001 IDENTIFICATION DIVISION. 06/10/13 00002 PROGRAM-ID. DTSBR602. DTSBR602 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV030 00004 DATE-WRITTEN. JANUARY 1995. DTSBR602 00005 DATE-COMPILED. DTSBR602 00006 DTSBR602 00007 ***** DTSBR602 00008 * DTSBR602 00009 * FUNCTION: AUDIT CANDIDATE LIST. DTSBR602 00010 * DTSBR602 00011 * DTSBR602 00012 * MODIFICATION HISTORY: DTSBR602 00013 * DTSBR602 00014 * 01-17-95 INITIAL DEVELOPMENT DTSBR602 00015 * REFERENCE RFP #RAP AUTHOR OF CHANGE - RHC DTSBR602 00016 * DTSBR602 00017 * 05-25-95 ADD START AND END ZIP CODES TO SELECTION CRITERIA. DTSBR602 00018 * REFERENCE RFP #CR089 AUTHOR OF CHANGE - RHC DTSBR602 00019 * DTSBR602 00020 * 11-19-98 MODIFIED TO MEET DUTAS PROGRAMMING SPECIFICATIONS. DTSBR602 00021 * REFERENCE RFP #**** AUTHOR OF CHANGE - DVS DTSBR602 00022 * DTSBR602 00023 * 01-25-08 MODIFIED REPORT RPT602R2 TO ADD ASSIGN-NO AND TO DTSBR602 00024 * DELETE THE SIC-CD AND NAICS-CD ON THE REPORT. DTSBR602 00025 * REFERENCE RFP #**** AUTHOR OF CHANGE - RW1 DTSBR602 00026 * DTSBR602 00027 * 11-11-08 ADDED R3 REPORT TO PRODUCE NEW AUDIT FORM. DTSBR602 00028 * REFERENCE RFP #**** AUTHOR OF CHANGE - ZL1 DTSBR602 00029 * DTSBR602 00030 * 09-16-09 REMOVE PRINTING THE AUDIT NOTICES FROM THIS PGM DTSBR602 00031 * REFERENCE RFP #**** AUTHOR OF CHANGE - ZL1 DTSBR602 00032 * DTSBR602 00033 * 01-29-10 SET AUDIT STATUS TO ACTIVE INSTEAD OF HELD. DTSBR602 00034 * REFERENCE RFP #**** AUTHOR OF CHANGE - GD DTSBR602 00035 * DTSBR602 00036 * DTSBR602 00037 * 01-27-12 MODIFIED TO INCLUDE NEW CODE FOR TARGETED AUDITS DTSBR602 00038 * REFERENCE RFP #**** AUTHOR OF CHANGE - ZL1 DTSBR602 00039 * DTSBR602 00040 * DTSBR602 00041 * 06-10-13 MODIFIED TO SET AUDIT INDICATOR TO 'T' FOR TARGETED DTSBR602 00042 * AUDITS AUTHOR OF CHANGE - ZL1 DTSBR602 00043 * DTSBR602 00044 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR602 00045 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR602 00046 * REFERENCE RFP #**** AUTHOR OF CHANGE - XXX DTSBR602 00047 * DTSBR602 00048 * DTSBR602 00049 * DESCRIPTION: DTSBR602 00050 * DTSBR602 00051 * THIS MODULE PRODUCES THE AUDIT CANDIDATE LIST. DTSBR602 00052 * DTSBR602 00053 * THERE IS A BIT OF UNIQUE LOGIC IN THIS MODULE, DESIGNED DTSBR602 00054 * TO SIMULATE "RANDOM" SELECTION OF AUDIT CANDIDATES FROM DTSBR602 00055 * A UNIVERSE OF POTENTIAL AUDIT CANDIDATES. DTSBR602 00056 * DTSBR602 00057 * DTSBR602 00058 * RECORDS READ: DTSBR602 00059 * DTSBR602 00060 * FSEL. DTSBR602 00061 * DTSBR602 00062 * DTSBR602 00063 * PRINTED OUTPUTS: DTSBR602 00064 * DTSBR602 00065 * 602R1 AUDIT CANDIDATE LIST. DTSBR602 00066 * DTSBR602 00067 * DTSBR602 00068 * RECORDS WRITTEN: DTSBR602 00069 * DTSBR602 00070 * NONE. DTSBR602 00071 * DTSBR602 00072 * DTSBR602 00073 * MODULES CALLED: DTSBR602 00074 * DTSBR602 00075 * DTSBU001 DATE CONVERT. DTSBR602 00076 * DTSBU004 QUARTER CONVERT. DTSBR602 00077 * DTSBU005 ABSOLUTE TIME EDIT/CONVERSION. DTSBR602 00078 * DTSBU036 FIELD SUPPORT CODES EDIT/DESCRIPTION. DTSBR602 00079 * DTSBU056 RATE DISPLAY. DTSBR602 00080 * DTSBU062 FIELD REP ID EDIT/DESCRIPTION. DTSBR602 00081 * DTSBU931 REFERENCE FILE I/O. DTSBR602 00082 * DTSBR602 00083 * DTSBR602 00084 ***** DTSBR602 00085 EJECT DTSBR602 00086 ENVIRONMENT DIVISION. DTSBR602 00087 DTSBR602 00088 CONFIGURATION SECTION. DTSBR602 00089 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBR602 00090 DTSBR602 00091 INPUT-OUTPUT SECTION. DTSBR602 00092 DTSBR602 00093 FILE-CONTROL. DTSBR602 00094 SELECT PRT-FILE-1 ASSIGN TO RPT602R1. DTSBR602 00095 SELECT PRT-FILE-2 ASSIGN TO RPT602R2. DTSBR602 00096 SELECT FAS-FILE-3 ASSIGN TO RPT602F3. DTSBR602 00097 DTSBR602 00098 DATA DIVISION. DTSBR602 00099 DTSBR602 00100 FILE SECTION. DTSBR602 00101 DTSBR602 00102 FD PRT-FILE-1 DTSBR602 00103 RECORDING MODE IS F. DTSBR602 00104 01 REPORT-LISTING1 PIC X(133). DTSBR602 00105 DTSBR602 00106 FD PRT-FILE-2 DTSBR602 00107 RECORDING MODE IS F. DTSBR602 00108 01 REPORT-LISTING2 PIC X(133). DTSBR602 00109 DTSBR602 00110 FD FAS-FILE-3 DTSBR602 00111 RECORDING MODE IS F. DTSBR602 00112 01 FAS-REC PIC X(1064). DTSBR602 00113 DTSBR602 00114 EJECT DTSBR602 00115 WORKING-STORAGE SECTION. DTSBR602 001155 77 PAN-VALET PICTURE X(24) VALUE '030DTSBR602 06/10/13'. DTSBR602 00116 77 PAN-VALET PICTURE X(24) VALUE '002DTSBR602 06/10/13'. DTSBR602 00117 DTSBR602 00118 01 WRK-AREA. DTSBR602 00119 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +602.DTSBR602 00120 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR602 00121 05 ABEND-MSG PIC X(60). DTSBR602 00122 05 WRK-CTR PIC S9(04) COMP. DTSBR602 00123 DTSBR602 00124 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. DTSBR602 00125 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. DTSBR602 00126 05 WS-LINE-CNT3 PIC S9(02) COMP-3 VALUE 60. DTSBR602 00127 05 WS-LINE-CNT4 PIC S9(02) COMP-3 VALUE +0. DTSBR602 00128 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. DTSBR602 00129 05 WS-PAGE-CNT2 PIC S9(03) COMP-3 VALUE +0. DTSBR602 00130 05 WS-FOOT-NUMBER-ONE PIC S9(05) COMP-3 VALUE +0. DTSBR602 00131 05 WS-FOOT-NUMBER-TWO PIC S9(05) COMP-3 VALUE +0. DTSBR602 00132 05 WS-FORM-CNT PIC S9(03) COMP-3 VALUE +0. DTSBR602 00133 DTSBR602 00134 05 WRK-ASSIGN-NO PIC S9(09) COMP-3. DTSBR602 00135 05 WRK-AUDIT-DATE PIC X(10) VALUE ZEROS. DTSBR602 00136 05 WRK-AUDIT-DATE9 REDEFINES WRK-AUDIT-DATE. DTSBR602 00137 10 WRK-AUDIT-MM PIC 9(02). DTSBR602 00138 10 FILLER PIC X. DTSBR602 00139 10 WRK-AUDIT-DD PIC 9(02). DTSBR602 00140 10 FILLER PIC X. DTSBR602 00141 10 WRK-AUDIT-YEAR PIC 9(04). DTSBR602 00142 DTSBR602 00143 05 WRK-AUDIT-RPT-DATE. DTSBR602 00144 10 WRK-AUDIT-RPT-YR PIC 9(04). DTSBR602 00145 10 WRK-AUDIT-RPT-MM PIC 9(02). DTSBR602 00146 10 WRK-AUDIT-RPT-DD PIC 9(02). DTSBR602 00147 DTSBR602 00148 05 WRK-AUDIT-RPT-DATE9 REDEFINES DTSBR602 00149 WRK-AUDIT-RPT-DATE PIC 9(8). DTSBR602 00150 05 WRK-GROUP. DTSBR602 00151 10 WRK-EMP-SIZE-IND PIC X(01). DTSBR602 00152 DTSBR602 00153 05 WRK-REC-SUB-TYPE PIC X(01). DTSBR602 00154 DTSBR602 00155 05 WRK-MAX-SEL-CNT PIC S9(05) COMP-3. DTSBR602 00156 DTSBR602 00157 05 WRK-MAX-SEL-CNT-MINUS-1 PIC S9(05) COMP-3. DTSBR602 00158 DTSBR602 00159 05 WRK-SEL-CNT PIC S9(05) COMP-3. DTSBR602 00160 DTSBR602 00161 05 WRK-MFAS-WRITTEN-CNT PIC S9(07) COMP-3 DTSBR602 00162 VALUE +0. DTSBR602 00163 DTSBR602 00164 05 WRK-UNIVERSE-CNT PIC S9(05) COMP-3. DTSBR602 00165 DTSBR602 00166 05 WRK-RUNNING-CNT PIC S9(05) COMP-3. DTSBR602 00167 DTSBR602 00168 05 WRK-ABSTIME PIC S9(15) COMP-3. DTSBR602 00169 DTSBR602 00170 DTSBR602 00171 05 CNTRL-RANDOM-999 PIC S9(03) COMP-3. DTSBR602 00172 05 CNTRL-RANDOM-V999 REDEFINES CNTRL-RANDOM-999 DTSBR602 00173 PIC SV9(03) COMP-3. DTSBR602 00174 DTSBR602 00175 05 SKIP-INTERVAL PIC S9(08)V9(03) COMP-3. DTSBR602 00176 DTSBR602 00177 05 INITIAL-CASE PIC S9(05) COMP-3. DTSBR602 00178 DTSBR602 00179 05 CURRENT-CASE PIC S9(08)V9(03) COMP-3. DTSBR602 00180 DTSBR602 00181 05 CURRENT-CASE-ROUNDED PIC S9(08) COMP-3. DTSBR602 00182 DTSBR602 00183 01 WRK-AUDIT-SELECTION-CRITERIA. DTSBR602 00184 DTSBR602 00185 05 WRK-FSEL-FLD-REP-ID OCCURS 10 TIMES DTSBR602 00186 PIC X(02). DTSBR602 00187 DTSBR602 00188 05 WRK-REGULAR-EMP-IND PIC X(01). DTSBR602 00189 05 WRK-GOVT-EMP-IND PIC X(01). DTSBR602 00190 DTSBR602 00191 01 SELECTION-TABLE. DTSBR602 00192 05 SELECTION-IND OCCURS 99999 TIMES DTSBR602 00193 PIC X(01). DTSBR602 00194 ++INCLUDE DTSXL602 DTSBR602 00195 05 ADDR-FMT-AREA PIC X(200). DTSBR602 00196 05 ADDR-FMT-AREA-X REDEFINES ADDR-FMT-AREA. DTSBR602 00197 10 ADDR-FMT-LINE OCCURS 5 TIMES PIC X(40). DTSBR602 00198 05 WS-REC PIC X(132) VALUE SPACES. DTSBR602 00199 01 VSCA-LINE. DTSBR602 00200 05 VSCA-DATA PIC X(133) VALUE SPACES. DTSBR602 00201 EJECT DTSBR602 00202 01 L001-LINK-AREA. DTSBR602 00203 ++INCLUDE DTSIL001 DTSBR602 00204 EJECT DTSBR602 00205 01 L002-LINK-AREA. DTSBR602 00206 ++INCLUDE DTSIL002 DTSBR602 00207 EJECT DTSBR602 00208 01 L004-LINK-AREA. DTSBR602 00209 ++INCLUDE DTSIL004 DTSBR602 00210 EJECT DTSBR602 00211 01 L005-LINK-AREA. DTSBR602 00212 ++INCLUDE DTSIL005 DTSBR602 00213 EJECT DTSBR602 00214 01 L036-LINK-AREA. DTSBR602 00215 ++INCLUDE DTSIL036 DTSBR602 00216 EJECT DTSBR602 00217 01 L056-LINK-AREA. DTSBR602 00218 ++INCLUDE DTSIL056 DTSBR602 00219 EJECT DTSBR602 00220 01 L062-LINK-AREA. DTSBR602 00221 ++INCLUDE DTSIL062 DTSBR602 00222 EJECT DTSBR602 00223 01 L071-LINK-AREA. DTSBR602 00224 ++INCLUDE DTSIL071 DTSBR602 00225 EJECT DTSBR602 00226 01 L910-LINK-AREA. DTSBR602 00227 ++INCLUDE DTSIL910 DTSBR602 00228 SKIP3 DTSBR602 00229 01 MSKL-REC. DTSBR602 00230 ++INCLUDE DTSIMSKL DTSBR602 00231 SKIP3 DTSBR602 00232 01 MHDR-REC. DTSBR602 00233 ++INCLUDE DTSIMHDR DTSBR602 00234 DTSBR602 00235 01 L931-LINK-AREA. DTSBR602 00236 ++INCLUDE DTSIL931 DTSBR602 00237 EJECT DTSBR602 00238 01 FSKL-REC. DTSBR602 00239 ++INCLUDE DTSIFSKL DTSBR602 00240 EJECT DTSBR602 00241 01 FSEL-REC. DTSBR602 00242 ++INCLUDE DTSIFSEL DTSBR602 00243 EJECT DTSBR602 00244 01 FMAX-LITERALS. DTSBR602 00245 ++INCLUDE DTSIFMAX DTSBR602 00246 DTSBR602 00247 01 MFAS-REC. DTSBR602 00248 ++INCLUDE DTSIMFAS DTSBR602 00249 DTSBR602 00250 01 AUDIT-SELECTION-PAGE-HEADING. DTSBR602 00251 05 HDR1-LINE-1. DTSBR602 00252 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00253 10 FILLER PIC X(05) DTSBR602 00254 VALUE '602R1'. DTSBR602 00255 10 FILLER PIC X(19) VALUE SPACES. DTSBR602 00256 10 HDR1-AGY-NAME-LINE1 PIC X(50). DTSBR602 00257 10 FILLER PIC X(14) VALUE SPACES. DTSBR602 00258 10 FILLER PIC X(05) DTSBR602 00259 VALUE 'DATE:'. DTSBR602 00260 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00261 10 HDR1-SYS-DATE PIC X(08). DTSBR602 00262 DTSBR602 00263 05 HDR1-LINE-2. DTSBR602 00264 10 FILLER PIC X(24) VALUE SPACES. DTSBR602 00265 10 HDR1-AGY-NAME-LINE2 PIC X(50). DTSBR602 00266 10 FILLER PIC X(15) VALUE SPACES. DTSBR602 00267 10 FILLER PIC X(05) DTSBR602 00268 VALUE 'TIME:'. DTSBR602 00269 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00270 10 HDR1-SYS-TIME PIC X(08). DTSBR602 00271 DTSBR602 00272 05 HDR1-LINE-3. DTSBR602 00273 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00274 10 FILLER PIC X(10) DTSBR602 00275 VALUE 'ROUTE TO: '. DTSBR602 00276 10 FILLER PIC X(16) DTSBR602 00277 VALUE 'ENFORCEMENT UNIT'. DTSBR602 00278 10 FILLER PIC X(62) VALUE SPACES. DTSBR602 00279 10 FILLER PIC X(05) DTSBR602 00280 VALUE 'PAGE:'. DTSBR602 00281 10 FILLER PIC X(03) VALUE SPACES. DTSBR602 00282 10 HDR1-PAGE-CNT PIC ZZ,ZZ9. DTSBR602 00283 DTSBR602 00284 05 HDR1-LINE-4. DTSBR602 00285 10 FILLER PIC X(38) VALUE SPACES. DTSBR602 00286 10 FILLER PIC X(18) DTSBR602 00287 VALUE 'SELECTION CRITERIA'. DTSBR602 00288 DTSBR602 00289 01 AUDIT-SELECTION-DETAIL. DTSBR602 00290 05 DTL1-LINE-7. DTSBR602 00291 10 FILLER PIC X(04) VALUE SPACES. DTSBR602 00292 10 FILLER PIC X(16) DTSBR602 00293 VALUE 'AUDIT START QTR:'. DTSBR602 00294 10 FILLER PIC X(02) VALUE SPACES. DTSBR602 00295 10 WRK-AUDIT-START-QTR PIC X(04). DTSBR602 00296 DTSBR602 00297 05 DTL1-LINE-9. DTSBR602 00298 10 FILLER PIC X(06) VALUE SPACES. DTSBR602 00299 10 FILLER PIC X(14) DTSBR602 00300 VALUE 'AUDIT END-QTR:'. DTSBR602 00301 10 FILLER PIC X(02) VALUE SPACES. DTSBR602 00302 10 WRK-AUDIT-END-QTR PIC X(04). DTSBR602 00303 DTSBR602 00304 05 DTL1-LINE-11. DTSBR602 00305 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00306 10 FILLER PIC X(19) DTSBR602 00307 VALUE '# SMALL CANDIDATES:'. DTSBR602 00308 10 FILLER PIC X(02) VALUE SPACES. DTSBR602 00309 10 DTL1-SMALL-EMP-LIST-CNT PIC ZZ9. DTSBR602 00310 10 FILLER PIC X(05) VALUE SPACES. DTSBR602 00311 10 FILLER PIC X(19) DTSBR602 00312 VALUE '# LARGE CANDIDATES:'. DTSBR602 00313 10 FILLER PIC X(02) VALUE SPACES. DTSBR602 00314 10 DTL1-LARGE-EMP-LIST-CNT PIC ZZ9. DTSBR602 00315 10 FILLER PIC X(05) VALUE SPACES. DTSBR602 00316 10 FILLER PIC X(17) DTSBR602 00317 VALUE 'LARGE DEFINITION:'. DTSBR602 00318 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00319 10 DTL1-LARGE-EMP-DEF-IND PIC X(01). DTSBR602 00320 DTSBR602 00321 05 DTL1-LINE-14. DTSBR602 00322 10 FILLER PIC X(18) VALUE SPACES. DTSBR602 00323 10 FILLER PIC X(07) DTSBR602 00324 VALUE 'RANDOM:'. DTSBR602 00325 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00326 10 DTL1-RANDOM-IND PIC X(01). DTSBR602 00327 10 FILLER PIC X(07) VALUE SPACES. DTSBR602 00328 10 FILLER PIC X(07) DTSBR602 00329 VALUE 'TARGET:'. DTSBR602 00330 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00331 10 DTL1-TARGET-IND PIC X(01). DTSBR602 00332 DTSBR602 00333 05 DTL1-LINE-16. DTSBR602 00334 10 FILLER PIC X(07) VALUE SPACES. DTSBR602 00335 10 FILLER PIC X(18) DTSBR602 00336 VALUE 'AUDITED START QTR:'. DTSBR602 00337 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00338 10 WRK-AUDITED-START-QTR PIC X(04). DTSBR602 00339 DTSBR602 00340 05 DTL1-LINE-18. DTSBR602 00341 10 FILLER PIC X(05) VALUE SPACES. DTSBR602 00342 10 FILLER PIC X(20) DTSBR602 00343 VALUE 'ACTIVE AUDIT PERIOD:'. DTSBR602 00344 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00345 10 WRK-ACTIVE-AUDIT-PERIOD-IND PIC X(01). DTSBR602 00346 DTSBR602 00347 05 DTL1-LINE-20. DTSBR602 00348 10 FILLER PIC X(10) VALUE SPACES. DTSBR602 00349 10 FILLER PIC X(15) DTSBR602 00350 VALUE 'ACTIVE CURRENT:'. DTSBR602 00351 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00352 10 WRK-ACTIVE-CURRENT-IND PIC X(01). DTSBR602 00353 DTSBR602 00354 05 DTL1-LINE-22. DTSBR602 00355 10 FILLER PIC X(15) VALUE SPACES. DTSBR602 00356 10 FILLER PIC X(10) DTSBR602 00357 VALUE 'START SIC:'. DTSBR602 00358 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00359 10 WRK-START-SIC-CD PIC X(07). DTSBR602 00360 10 FILLER PIC X(05) VALUE SPACES. DTSBR602 00361 10 FILLER PIC X(08) DTSBR602 00362 VALUE 'END SIC:'. DTSBR602 00363 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00364 10 WRK-END-SIC-CD PIC X(07). DTSBR602 00365 DTSBR602 00366 05 DTL1-LINE-24. DTSBR602 00367 10 FILLER PIC X(14) VALUE SPACES. DTSBR602 00368 10 FILLER PIC X(11) DTSBR602 00369 VALUE 'START NAIC:'. DTSBR602 00370 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00371 10 WRK-START-NAICS-CD PIC X(06). DTSBR602 00372 10 FILLER PIC X(06) VALUE SPACES. DTSBR602 00373 10 FILLER PIC X(09) DTSBR602 00374 VALUE 'END NAIC:'. DTSBR602 00375 10 WRK-END-NAICS-CD PIC X(07). DTSBR602 00376 DTSBR602 00377 05 DTL1-LINE-26. DTSBR602 00378 10 FILLER PIC X(08) VALUE SPACES. DTSBR602 00379 10 FILLER PIC X(17) DTSBR602 00380 VALUE 'MUST BE DISTRICT:'. DTSBR602 00381 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00382 10 WRK-FLD-ZIP-TERRITORY-IND PIC X(01). DTSBR602 00383 10 FILLER PIC X(05) VALUE SPACES. DTSBR602 00384 10 FILLER PIC X(10) DTSBR602 00385 VALUE 'START ZIP:'. DTSBR602 00386 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00387 10 WRK-FLD-ZIP-START PIC X(05). DTSBR602 00388 10 FILLER PIC X(04) VALUE SPACES. DTSBR602 00389 10 FILLER PIC X(08) DTSBR602 00390 VALUE 'END ZIP:'. DTSBR602 00391 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00392 10 WRK-FLD-ZIP-END PIC X(05). DTSBR602 00393 DTSBR602 00394 05 DTL1-LINE-28. DTSBR602 00395 10 FILLER PIC X(09) VALUE SPACES. DTSBR602 00396 10 FILLER PIC X(16) DTSBR602 00397 VALUE 'LIABILITY START:'. DTSBR602 00398 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00399 10 WRK-INIT-LIAB-START-DATE PIC X(08). DTSBR602 00400 10 FILLER PIC X(05) VALUE SPACES. DTSBR602 00401 10 FILLER PIC X(14) DTSBR602 00402 VALUE 'LIABILITY END:'. DTSBR602 00403 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00404 10 WRK-INIT-LIAB-END-DATE PIC X(08). DTSBR602 00405 DTSBR602 00406 05 DTL1-LINE-30. DTSBR602 00407 10 FILLER PIC X(08) VALUE SPACES. DTSBR602 00408 10 FILLER PIC X(17) DTSBR602 00409 VALUE 'TOT WAGE AMT MIN:'. DTSBR602 00410 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00411 10 WRK-TOT-WAGE-START-AMT PIC ZZZ,ZZZ,ZZ9.99. DTSBR602 00412 10 FILLER PIC X(05) VALUE SPACES. DTSBR602 00413 10 FILLER PIC X(04) DTSBR602 00414 VALUE 'MAX:'. DTSBR602 00415 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00416 10 WRK-TOT-WAGE-END-AMT PIC ZZZ,ZZZ,ZZ9.99. DTSBR602 00417 DTSBR602 00418 05 DTL1-LINE-32. DTSBR602 00419 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00420 10 FILLER PIC X(24) DTSBR602 00421 VALUE 'TOT WAGE DECR START QTR:'. DTSBR602 00422 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00423 10 WRK-TOT-WAGE-DECR-START-QTR PIC X(04). DTSBR602 00424 10 FILLER PIC X(05) VALUE SPACES. DTSBR602 00425 10 FILLER PIC X(08) VALUE 'END QTR:'. DTSBR602 00426 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00427 10 WRK-TOT-WAGE-DECR-END-QTR PIC X(04). DTSBR602 00428 10 FILLER PIC X(05) VALUE SPACES. DTSBR602 00429 10 FILLER PIC X(06) VALUE 'LOW %:'. DTSBR602 00430 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00431 10 WRK-TOT-WAGE-START-RATIO PIC X(07). DTSBR602 00432 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00433 10 FILLER PIC X(07) VALUE 'HIGH %:'. DTSBR602 00434 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00435 10 WRK-TOT-WAGE-END-RATIO PIC X(07). DTSBR602 00436 DTSBR602 00437 05 DTL1-LINE-34. DTSBR602 00438 10 FILLER PIC X(05) VALUE SPACES. DTSBR602 00439 10 FILLER PIC X(20) DTSBR602 00440 VALUE 'WAGE CHNG START QTR:'. DTSBR602 00441 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00442 10 WRK-TOT-WAGE-CHNG-START-QTR PIC X(04). DTSBR602 00443 10 FILLER PIC X(05) VALUE SPACES. DTSBR602 00444 10 FILLER PIC X(08) VALUE 'END QTR:'. DTSBR602 00445 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00446 10 WRK-TOT-WAGE-CHNG-END-QTR PIC X(04). DTSBR602 00447 10 FILLER PIC X(06) VALUE SPACES. DTSBR602 00448 10 FILLER PIC X(21) DTSBR602 00449 VALUE 'MIN # WAGE CHNG RPTS:'. DTSBR602 00450 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00451 10 WRK-TOT-WAGE-CHNG-TRIG-CNT PIC ZZ9. DTSBR602 00452 DTSBR602 00453 05 DTL1-LINE-36. DTSBR602 00454 10 FILLER PIC X(16) VALUE SPACES. DTSBR602 00455 10 FILLER PIC X(09) VALUE 'MIN RATE:'.DTSBR602 00456 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00457 10 WRK-UI-RATE-MIN PIC X(07). DTSBR602 00458 DTSBR602 00459 01 AUDIT-CANDIDATE-PAGE-HEADING. DTSBR602 00460 05 HDR2-LINE-1. DTSBR602 00461 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00462 10 FILLER PIC X(05) DTSBR602 00463 VALUE '602R2'. DTSBR602 00464 10 FILLER PIC X(19) VALUE SPACES.DTSBR602 00465 10 HDR2-AGY-NAME-LINE1 PIC X(50). DTSBR602 00466 10 FILLER PIC X(14) VALUE SPACES.DTSBR602 00467 10 FILLER PIC X(05) DTSBR602 00468 VALUE 'DATE:'. DTSBR602 00469 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00470 10 HDR2-SYS-DATE PIC X(08). DTSBR602 00471 DTSBR602 00472 05 HDR2-LINE-2. DTSBR602 00473 10 FILLER PIC X(24) VALUE SPACES.DTSBR602 00474 10 HDR2-AGY-NAME-LINE2 PIC X(50). DTSBR602 00475 10 FILLER PIC X(15) VALUE SPACES.DTSBR602 00476 10 FILLER PIC X(05) DTSBR602 00477 VALUE 'TIME:'. DTSBR602 00478 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00479 10 HDR2-SYS-TIME PIC X(08). DTSBR602 00480 DTSBR602 00481 05 HDR2-LINE-3. DTSBR602 00482 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00483 10 FILLER PIC X(10) DTSBR602 00484 VALUE 'ROUTE TO: '. DTSBR602 00485 10 FILLER PIC X(22) DTSBR602 00486 VALUE 'REGISTRATION AND RATES'. DTSBR602 00487 10 FILLER PIC X(56) VALUE SPACES.DTSBR602 00488 10 FILLER PIC X(05) DTSBR602 00489 VALUE 'PAGE:'. DTSBR602 00490 10 FILLER PIC X(03) VALUE SPACES.DTSBR602 00491 10 HDR2-PAGE-CNT PIC ZZ,ZZ9. DTSBR602 00492 DTSBR602 00493 05 HDR2-LINE-4. DTSBR602 00494 10 FILLER PIC X(40) VALUE SPACES.DTSBR602 00495 10 FILLER PIC X(20) DTSBR602 00496 VALUE 'AUDIT CANDIDATE LIST'. DTSBR602 00497 DTSBR602 00498 05 HDR2-LINE-5. DTSBR602 00499 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00500 10 FILLER PIC X(17) DTSBR602 00501 VALUE 'ASSIGNMENT TYPE: '. DTSBR602 00502 10 HDR2-ASSIGN-TYPE PIC X(22) VALUE SPACES.DTSBR602 00503 DTSBR602 00504 05 HDR2-LINE-6 PIC X(133) VALUE SPACES.DTSBR602 00505 05 HDR2-LINE-7. DTSBR602 00506 10 FILLER PIC X(05) VALUE SPACES.DTSBR602 00507 10 FILLER PIC X(10) DTSBR602 00508 VALUE 'FIELD REP:'. DTSBR602 00509 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00510 10 WRK-FLD-REP-ID PIC X(02). DTSBR602 00511 10 FILLER PIC X(03) VALUE SPACES.DTSBR602 00512 10 WRK-FLD-REP-NAME PIC X(32). DTSBR602 00513 DTSBR602 00514 05 HDR2-LINE-8. DTSBR602 00515 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00516 10 FILLER PIC X(14) DTSBR602 00517 VALUE 'EMPLOYER TYPE:'. DTSBR602 00518 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00519 10 WRK-EMP-SIZE-DSCR PIC X(05). DTSBR602 00520 DTSBR602 00521 05 HDR2-LINE-9 PIC X(133) VALUE SPACES.DTSBR602 00522 05 HDR2-LINE-10. DTSBR602 00523 10 FILLER PIC X(83) VALUE SPACES.DTSBR602 00524 10 FILLER PIC X(11) DTSBR602 00525 VALUE 'PREVIOUS YR'. DTSBR602 00526 DTSBR602 00527 05 HDR2-LINE-11. DTSBR602 00528 10 FILLER PIC X(02) VALUE SPACE. DTSBR602 00529 10 FILLER PIC X(09) DTSBR602 00530 VALUE 'ASSIGN NO'. DTSBR602 00531 10 FILLER PIC X(04) VALUE SPACES.DTSBR602 00532 10 FILLER PIC X(08) DTSBR602 00533 VALUE 'ZIP CODE'. DTSBR602 00534 10 FILLER PIC X(05) VALUE SPACES.DTSBR602 00535 10 FILLER PIC X(06) DTSBR602 00536 VALUE 'EMP NO'. DTSBR602 00537 10 FILLER PIC X(07) VALUE SPACES.DTSBR602 00538 10 FILLER PIC X(13) DTSBR602 00539 VALUE 'PRIMARY NAME'. DTSBR602 00540 10 FILLER PIC X(18) VALUE SPACES.DTSBR602 00541 * 10 FILLER PIC X(06) DTSBR602 00542 * VALUE 'SIC CD'. DTSBR602 00543 * 10 FILLER PIC X(04) VALUE SPACES.DTSBR602 00544 * 10 FILLER PIC X(08) DTSBR602 00545 * VALUE 'NAICS CD'. DTSBR602 00546 10 FILLER PIC X(11) VALUE SPACES.DTSBR602 00547 10 FILLER PIC X(09) DTSBR602 00548 VALUE 'TOT WAGES'. DTSBR602 00549 DTSBR602 00550 01 AUDIT-CANDIDATE-DETAIL-1. DTSBR602 00551 05 DTL2-LINE-2. DTSBR602 00552 10 FILLER PIC X(03) VALUE SPACES.DTSBR602 00553 10 DTL2-ASSIGN-NO PIC 99B99999. DTSBR602 00554 10 FILLER PIC X(06) VALUE SPACES.DTSBR602 00555 10 DTL2-FLD-ZIP PIC X(05). DTSBR602 00556 10 FILLER PIC X(06) VALUE SPACES.DTSBR602 00557 10 DTL2-EMP-NO PIC 999B999. DTSBR602 00558 10 FILLER PIC X(05) VALUE SPACES.DTSBR602 00559 10 DTL2-PRIMARY-NAME PIC X(40). DTSBR602 00560 * 10 FILLER PIC X(05) VALUE SPACES.DTSBR602 00561 * 10 DTL2-SIC-CD PIC X(04). DTSBR602 00562 * 10 FILLER PIC X(06) VALUE SPACES.DTSBR602 00563 * 10 DTL2-NAICS-CD PIC ZZZZZZ. DTSBR602 00564 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00565 10 DTL2-PRIOR-YR-WAGES PIC ZZZ,ZZZ,ZZ9.99. DTSBR602 00566 DTSBR602 00567 01 AUDIT-CANDIDATE-DETAIL-2. DTSBR602 00568 05 CTF2-LINE-3. DTSBR602 00569 10 FILLER PIC X(07) VALUE SPACES.DTSBR602 00570 10 CTF2-SEL-CNT PIC ZZ,ZZ9. DTSBR602 00571 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00572 10 FILLER PIC X(44) DTSBR602 00573 VALUE 'AUDIT CANDIDATES SELECTED FROM A UNIVERSE OF'. DTSBR602 00574 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00575 10 CTF2-UNIVERSE-CNT PIC ZZ,ZZ9. DTSBR602 00576 10 FILLER PIC X(01) VALUE SPACE. DTSBR602 00577 10 FILLER PIC X(26) DTSBR602 00578 VALUE 'POTENTIAL AUDIT CANDIDATES'. DTSBR602 00579 DTSBR602 00580 01 AUDIT-CANDIDATE-GROUP-2. DTSBR602 00581 05 CFF-LINE-3. DTSBR602 00582 10 FILLER PIC X(07) VALUE SPACES.DTSBR602 00583 10 FILLER PIC X(17) DTSBR602 00584 VALUE '*** END OF REPORT'. DTSBR602 00585 EJECT DTSBR602 00586 LINKAGE SECTION. DTSBR602 00587 DTSBR602 00588 01 LRCM-LINK-AREA. DTSBR602 00589 ++INCLUDE DTSILRCM DTSBR602 00590 EJECT DTSBR602 00591 01 R602-REC. DTSBR602 00592 ++INCLUDE DTSIR602 DTSBR602 00593 EJECT DTSBR602 00594 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR602 00595 R602-REC. DTSBR602 00596 IF FIRST-TIME-IND = 'Y' DTSBR602 00597 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR602 00598 MOVE 'N' TO FIRST-TIME-IND. DTSBR602 00599 DTSBR602 00600 IF LRCM-EOR-88 DTSBR602 00601 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR602 00602 ELSE DTSBR602 00603 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR602 00604 SKIP3 DTSBR602 00605 GOBACK. DTSBR602 00606 EJECT DTSBR602 00607 I1000-INITIATE. DTSBR602 00608 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSBR602 00609 SET MHDR-HDR-88 TO TRUE. DTSBR602 00610 MOVE +0 TO MHDR-EMP-NO. DTSBR602 00611 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSBR602 00612 DTSBR602 00613 PERFORM S910-READ THRU S910-EXIT. DTSBR602 00614 DTSBR602 00615 IF L910-NO-REC-88 DTSBR602 00616 DISPLAY 'MASTER HEADER RECORD NOT FOUND' DTSBR602 00617 PERFORM S999-ABEND THRU S999-EXIT DTSBR602 00618 ELSE DTSBR602 00619 MOVE MSKL-REC TO MHDR-REC DTSBR602 00620 MOVE MHDR-LAST-USED-ASSIGN-NO TO WRK-ASSIGN-NO DTSBR602 00621 END-IF. DTSBR602 00622 DTSBR602 00623 DISPLAY 'LAST USED ASSIGNMENT NBR: ' WRK-ASSIGN-NO. DTSBR602 00624 DTSBR602 00625 MOVE LOW-VALUES TO FSKL-KEY-AREA. DTSBR602 00626 SET FSKL-SEL-88 TO TRUE. DTSBR602 00627 PERFORM S931-READ THRU S931-EXIT. DTSBR602 00628 IF L931-NO-REC-88 DTSBR602 00629 MOVE 'FSEL RECORD NOT FOUND' TO ABEND-MSG DTSBR602 00630 PERFORM S999-ABEND THRU S999-EXIT. DTSBR602 00631 DTSBR602 00632 MOVE FSKL-REC TO FSEL-REC. DTSBR602 00633 DTSBR602 00634 MOVE SPACES TO WRK-AUDIT-SELECTION-CRITERIA. DTSBR602 00635 DTSBR602 00636 MOVE FSEL-AUDIT-START-YRQ TO L004-QTR-5-9. DTSBR602 00637 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBR602 00638 MOVE L004-SLASH-QTR TO WRK-AUDIT-START-QTR. DTSBR602 00639 DTSBR602 00640 MOVE FSEL-AUDIT-END-YRQ TO L004-QTR-5-9. DTSBR602 00641 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBR602 00642 MOVE L004-SLASH-QTR TO WRK-AUDIT-END-QTR. DTSBR602 00643 DTSBR602 00644 IF FSEL-USE-CRITERIA-88 DTSBR602 00645 PERFORM I1100-AUDIT-SELECTION-CRITERIA THRU I1100-EXIT. DTSBR602 00646 DTSBR602 00647 OPEN OUTPUT PRT-FILE-1. DTSBR602 00648 DTSBR602 00649 MOVE LRCM-SYS-DATE TO HDR1-SYS-DATE. DTSBR602 00650 MOVE LRCM-SYS-DATE TO HDR2-SYS-DATE. DTSBR602 00651 MOVE LRCM-SYS-TIME TO HDR1-SYS-TIME. DTSBR602 00652 MOVE LRCM-SYS-TIME TO HDR2-SYS-TIME. DTSBR602 00653 MOVE LRCM-AGY-NAME-LINE1 TO HDR1-AGY-NAME-LINE1. DTSBR602 00654 MOVE LRCM-AGY-NAME-LINE1 TO HDR2-AGY-NAME-LINE1. DTSBR602 00655 MOVE LRCM-AGY-NAME-LINE2 TO HDR1-AGY-NAME-LINE2. DTSBR602 00656 MOVE LRCM-AGY-NAME-LINE2 TO HDR2-AGY-NAME-LINE2. DTSBR602 00657 MOVE SPACES TO REPORT-LISTING1 REPORT-LISTING2. DTSBR602 00658 DTSBR602 00659 MOVE FSEL-SMALL-EMP-LIST-CNT TO DTL1-SMALL-EMP-LIST-CNT.DTSBR602 00660 MOVE FSEL-LARGE-EMP-LIST-CNT TO DTL1-LARGE-EMP-LIST-CNT.DTSBR602 00661 MOVE FSEL-LARGE-EMP-DEFINITION-IND TO DTL1-LARGE-EMP-DEF-IND.DTSBR602 00662 MOVE FSEL-RANDOM-IND TO DTL1-RANDOM-IND. DTSBR602 00663 MOVE FSEL-TARGET-IND TO DTL1-TARGET-IND. DTSBR602 00664 PERFORM P2000-PRINT-HEADER THRU P2000-EXIT. DTSBR602 00665 PERFORM P4000-PRINT-DETAIL THRU P4000-EXIT. DTSBR602 00666 DTSBR602 00667 CLOSE PRT-FILE-1. DTSBR602 00668 DTSBR602 00669 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBR602 00670 DTSBR602 00671 COMPUTE L005-ABSTIME = L005-ABSTIME / 1000. DTSBR602 00672 DTSBR602 00673 DIVIDE L005-ABSTIME BY 1000 DTSBR602 00674 GIVING WRK-ABSTIME DTSBR602 00675 REMAINDER CNTRL-RANDOM-999. DTSBR602 00676 DTSBR602 00677 PERFORM P1100-INIT-GROUP THRU P1100-EXIT. DTSBR602 00678 DTSBR602 00679 OPEN OUTPUT PRT-FILE-2. DTSBR602 00680 OPEN OUTPUT FAS-FILE-3. DTSBR602 00681 I1000-EXIT. DTSBR602 00682 EXIT. DTSBR602 00683 SKIP3 DTSBR602 00684 I1100-AUDIT-SELECTION-CRITERIA. DTSBR602 00685 DTSBR602 00686 IF FSEL-AUDITED-START-YRQ > +0 DTSBR602 00687 MOVE FSEL-AUDITED-START-YRQ TO L004-QTR-5-9 DTSBR602 00688 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR602 00689 MOVE L004-SLASH-QTR TO WRK-AUDITED-START-QTR. DTSBR602 00690 DTSBR602 00691 MOVE FSEL-ACTIVE-AUDIT-PERIOD-IND DTSBR602 00692 TO WRK-ACTIVE-AUDIT-PERIOD-IND. DTSBR602 00693 DTSBR602 00694 MOVE FSEL-ACTIVE-CURRENT-IND DTSBR602 00695 TO WRK-ACTIVE-CURRENT-IND. DTSBR602 00696 DTSBR602 00697 IF FSEL-END-SIC-CD NOT = SPACES DTSBR602 00698 MOVE FSEL-START-SIC-CD TO WRK-START-SIC-CD DTSBR602 00699 MOVE FSEL-END-SIC-CD TO WRK-END-SIC-CD. DTSBR602 00700 DTSBR602 00701 IF FSEL-END-NAICS-CD NOT = SPACES DTSBR602 00702 MOVE FSEL-START-NAICS-CD TO WRK-START-NAICS-CD DTSBR602 00703 MOVE FSEL-END-NAICS-CD TO WRK-END-NAICS-CD. DTSBR602 00704 DTSBR602 00705 MOVE FSEL-FLD-ZIP-TERRITORY-IND TO WRK-FLD-ZIP-TERRITORY-IND.DTSBR602 00706 DTSBR602 00707 IF FSEL-FLD-ZIP-END NOT = SPACES DTSBR602 00708 MOVE FSEL-FLD-ZIP-START TO WRK-FLD-ZIP-START DTSBR602 00709 MOVE FSEL-FLD-ZIP-END TO WRK-FLD-ZIP-END. DTSBR602 00710 DTSBR602 00711 IF FSEL-INIT-LIAB-END-DATE > +0 DTSBR602 00712 MOVE FSEL-INIT-LIAB-START-DATE TO L001-FED-8-DATE-9 DTSBR602 00713 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBR602 00714 MOVE L001-SLASH-DATE TO WRK-INIT-LIAB-START-DATE DTSBR602 00715 MOVE FSEL-INIT-LIAB-END-DATE TO L001-FED-8-DATE-9 DTSBR602 00716 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBR602 00717 MOVE L001-SLASH-DATE TO WRK-INIT-LIAB-END-DATE. DTSBR602 00718 DTSBR602 00719 IF FSEL-TOT-WAGE-END-AMT > -1 DTSBR602 00720 MOVE FSEL-TOT-WAGE-START-AMT TO WRK-TOT-WAGE-START-AMT DTSBR602 00721 MOVE FSEL-TOT-WAGE-END-AMT TO WRK-TOT-WAGE-END-AMT. DTSBR602 00722 DTSBR602 00723 IF FSEL-TOT-WAGE-DECR-END-YRQ > +0 DTSBR602 00724 MOVE FSEL-TOT-WAGE-DECR-START-YRQ TO L004-QTR-5-9 DTSBR602 00725 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR602 00726 MOVE L004-SLASH-QTR TO WRK-TOT-WAGE-DECR-START-QTR DTSBR602 00727 MOVE FSEL-TOT-WAGE-DECR-END-YRQ TO L004-QTR-5-9 DTSBR602 00728 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR602 00729 MOVE L004-SLASH-QTR TO WRK-TOT-WAGE-DECR-END-QTR DTSBR602 00730 MOVE FSEL-TOT-WAGE-START-RATIO TO L056-RATE DTSBR602 00731 PERFORM S056-DISP1-LEFT THRU S056-EXIT DTSBR602 00732 MOVE L056-DISP-RATE TO WRK-TOT-WAGE-START-RATIO DTSBR602 00733 MOVE FSEL-TOT-WAGE-END-RATIO TO L056-RATE DTSBR602 00734 PERFORM S056-DISP1-LEFT THRU S056-EXIT DTSBR602 00735 MOVE L056-DISP-RATE TO WRK-TOT-WAGE-END-RATIO. DTSBR602 00736 DTSBR602 00737 IF FSEL-TOT-WAGE-CHNG-END-YRQ > +0 DTSBR602 00738 MOVE FSEL-TOT-WAGE-CHNG-START-YRQ TO L004-QTR-5-9 DTSBR602 00739 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR602 00740 MOVE L004-SLASH-QTR TO WRK-TOT-WAGE-CHNG-START-QTR DTSBR602 00741 MOVE FSEL-TOT-WAGE-CHNG-END-YRQ TO L004-QTR-5-9 DTSBR602 00742 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR602 00743 MOVE L004-SLASH-QTR TO WRK-TOT-WAGE-CHNG-END-QTR DTSBR602 00744 MOVE FSEL-TOT-WAGE-CHNG-TRIGGER-CNT DTSBR602 00745 TO WRK-TOT-WAGE-CHNG-TRIG-CNT. DTSBR602 00746 DTSBR602 00747 IF FSEL-UI-RATE-MIN > +0 DTSBR602 00748 MOVE FSEL-UI-RATE-MIN TO L056-RATE DTSBR602 00749 PERFORM S056-DISP1-LEFT THRU S056-EXIT DTSBR602 00750 MOVE L056-DISP-RATE TO WRK-UI-RATE-MIN. DTSBR602 00751 I1100-EXIT. DTSBR602 00752 EXIT. DTSBR602 00753 EJECT DTSBR602 00754 P1000-PROCESS. DTSBR602 00755 IF (R602-FIELD-REP-ID = WRK-FLD-REP-ID) DTSBR602 00756 AND DTSBR602 00757 (R602-EMP-SIZE-IND = WRK-EMP-SIZE-IND) DTSBR602 00758 NEXT SENTENCE DTSBR602 00759 ELSE DTSBR602 00760 PERFORM P1200-BREAK-GROUP THRU P1200-EXIT DTSBR602 00761 PERFORM P1100-INIT-GROUP THRU P1100-EXIT. DTSBR602 00762 DTSBR602 00763 IF R602-REC-SUB-TYPE = WRK-REC-SUB-TYPE DTSBR602 00764 NEXT SENTENCE DTSBR602 00765 ELSE DTSBR602 00766 PERFORM P1300-COMPUTE-UNIVERSE THRU P1300-EXIT DTSBR602 00767 MOVE R602-REC-SUB-TYPE TO WRK-REC-SUB-TYPE. DTSBR602 00768 DTSBR602 00769 IF R602-UNIVERSE-CNT-88 DTSBR602 00770 ADD +1 TO WRK-UNIVERSE-CNT DTSBR602 00771 GO TO P1000-EXIT. DTSBR602 00772 DTSBR602 00773 ADD +1 TO WRK-RUNNING-CNT. DTSBR602 00774 DTSBR602 00775 IF WRK-RUNNING-CNT > WRK-UNIVERSE-CNT DTSBR602 00776 MOVE 'LOGIC ERROR P1000-1' TO ABEND-MSG DTSBR602 00777 PERFORM S999-ABEND THRU S999-EXIT. DTSBR602 00778 DTSBR602 00779 IF SELECTION-IND (WRK-RUNNING-CNT) = 'Y' DTSBR602 00780 ADD +1 TO WRK-SEL-CNT DTSBR602 00781 DTSBR602 00782 MOVE R602-FLD-ZIP TO DTL2-FLD-ZIP DTSBR602 00783 MOVE R602-EMP-NO TO DTL2-EMP-NO DTSBR602 00784 MOVE R602-PRIMARY-NAME TO DTL2-PRIMARY-NAME DTSBR602 00785 * MOVE R602-SIC-CD TO DTL2-SIC-CD DTSBR602 00786 * MOVE R602-NAICS-CD TO DTL2-NAICS-CD DTSBR602 00787 ADD +1 TO WRK-ASSIGN-NO DTSBR602 00788 MOVE WRK-ASSIGN-NO TO R602-ASSIGN-NO DTSBR602 00789 DTL2-ASSIGN-NO DTSBR602 00790 MOVE R602-PRIOR-YR-WAGES TO DTL2-PRIOR-YR-WAGES DTSBR602 00791 PERFORM P3000-PRINT-HEADER THRU P3000-EXIT DTSBR602 00792 WRITE REPORT-LISTING2 FROM DTL2-LINE-2 AFTER 2 DTSBR602 00793 ADD +2 TO WS-LINE-CNT4 DTSBR602 00794 PERFORM P1400-WRITE-MFAS THRU P1400-EXIT DTSBR602 00795 END-IF. DTSBR602 00796 DTSBR602 00797 P1000-EXIT. DTSBR602 00798 EXIT. DTSBR602 00799 DTSBR602 00800 P1100-INIT-GROUP. DTSBR602 00801 MOVE R602-FIELD-REP-ID TO WRK-FLD-REP-ID DTSBR602 00802 L062-FLD-REP-ID. DTSBR602 00803 PERFORM S062-FLD-REP-LOOKUP THRU S062-EXIT. DTSBR602 00804 MOVE L062-NAME TO WRK-FLD-REP-NAME. DTSBR602 00805 DTSBR602 00806 MOVE R602-EMP-SIZE-IND TO WRK-EMP-SIZE-IND DTSBR602 00807 L036-CD. DTSBR602 00808 PERFORM S036-EMP-SIZE-IND THRU S036-EXIT. DTSBR602 00809 MOVE L036-SHORT-DSCR TO WRK-EMP-SIZE-DSCR. DTSBR602 00810 DTSBR602 00811 MOVE R602-REC-SUB-TYPE TO WRK-REC-SUB-TYPE. DTSBR602 00812 DTSBR602 00813 IF R602-EMP-SIZE-LARGE DTSBR602 00814 MOVE FSEL-LARGE-EMP-LIST-CNT TO WRK-MAX-SEL-CNT DTSBR602 00815 ELSE DTSBR602 00816 MOVE FSEL-SMALL-EMP-LIST-CNT TO WRK-MAX-SEL-CNT. DTSBR602 00817 DTSBR602 00818 MOVE +0 TO WRK-SEL-CNT DTSBR602 00819 WRK-UNIVERSE-CNT DTSBR602 00820 WRK-RUNNING-CNT. DTSBR602 00821 P1100-EXIT. DTSBR602 00822 EXIT. DTSBR602 00823 DTSBR602 00824 P1200-BREAK-GROUP. DTSBR602 00825 DTSBR602 00826 MOVE WRK-SEL-CNT TO CTF2-SEL-CNT. DTSBR602 00827 MOVE WRK-UNIVERSE-CNT TO CTF2-UNIVERSE-CNT. DTSBR602 00828 WRITE REPORT-LISTING2 FROM CTF2-LINE-3 AFTER 3. DTSBR602 00829 MOVE +60 TO WS-LINE-CNT4. DTSBR602 00830 DTSBR602 00831 P1200-EXIT. DTSBR602 00832 EXIT. DTSBR602 00833 DTSBR602 00834 P1300-COMPUTE-UNIVERSE. DTSBR602 00835 IF (WRK-UNIVERSE-CNT < +1) DTSBR602 00836 OR DTSBR602 00837 (WRK-UNIVERSE-CNT > 99999) DTSBR602 00838 MOVE 'LOGIC ERROR P1300-1' TO ABEND-MSG DTSBR602 00839 PERFORM S999-ABEND THRU S999-EXIT. DTSBR602 00840 DTSBR602 00841 MOVE ALL 'N' TO SELECTION-TABLE. DTSBR602 00842 DTSBR602 00843 IF WRK-MAX-SEL-CNT < +1 DTSBR602 00844 GO TO P1300-EXIT. DTSBR602 00845 DTSBR602 00846 IF WRK-MAX-SEL-CNT < WRK-UNIVERSE-CNT DTSBR602 00847 NEXT SENTENCE DTSBR602 00848 ELSE DTSBR602 00849 MOVE ALL 'Y' DTSBR602 00850 TO SELECTION-TABLE (1:WRK-UNIVERSE-CNT) DTSBR602 00851 GO TO P1300-EXIT. DTSBR602 00852 DTSBR602 00853 DIVIDE WRK-UNIVERSE-CNT BY WRK-MAX-SEL-CNT DTSBR602 00854 GIVING SKIP-INTERVAL. DTSBR602 00855 DTSBR602 00856 COMPUTE INITIAL-CASE DTSBR602 00857 = (SKIP-INTERVAL * CNTRL-RANDOM-V999) + 0.5. DTSBR602 00858 DTSBR602 00859 IF INITIAL-CASE = +0 DTSBR602 00860 MOVE SKIP-INTERVAL TO INITIAL-CASE. DTSBR602 00861 DTSBR602 00862 PERFORM P1320-CHECK-MAX THRU P1320-EXIT. DTSBR602 00863 DTSBR602 00864 MOVE INITIAL-CASE TO CURRENT-CASE. DTSBR602 00865 DTSBR602 00866 PERFORM P1310-SELECTION-TABLE THRU P1310-EXIT. DTSBR602 00867 DTSBR602 00868 COMPUTE WRK-MAX-SEL-CNT-MINUS-1 DTSBR602 00869 = WRK-MAX-SEL-CNT - 1. DTSBR602 00870 DTSBR602 00871 IF WRK-MAX-SEL-CNT-MINUS-1 > +0 DTSBR602 00872 PERFORM DTSBR602 00873 WRK-MAX-SEL-CNT-MINUS-1 TIMES DTSBR602 00874 ADD SKIP-INTERVAL TO CURRENT-CASE DTSBR602 00875 PERFORM P1310-SELECTION-TABLE THRU P1310-EXIT DTSBR602 00876 END-PERFORM. DTSBR602 00877 P1300-EXIT. DTSBR602 00878 EXIT. DTSBR602 00879 DTSBR602 00880 P1310-SELECTION-TABLE. DTSBR602 00881 COMPUTE CURRENT-CASE-ROUNDED DTSBR602 00882 = CURRENT-CASE + 0.500. DTSBR602 00883 DTSBR602 00884 IF (CURRENT-CASE-ROUNDED < +1) DTSBR602 00885 OR DTSBR602 00886 (CURRENT-CASE-ROUNDED > WRK-UNIVERSE-CNT) DTSBR602 00887 NEXT SENTENCE DTSBR602 00888 ELSE DTSBR602 00889 MOVE 'Y' DTSBR602 00890 TO SELECTION-IND (CURRENT-CASE-ROUNDED). DTSBR602 00891 P1310-EXIT. DTSBR602 00892 EXIT. DTSBR602 00893 DTSBR602 00894 P1320-CHECK-MAX. DTSBR602 00895 MOVE INITIAL-CASE TO CURRENT-CASE. DTSBR602 00896 DTSBR602 00897 COMPUTE WRK-MAX-SEL-CNT-MINUS-1 DTSBR602 00898 = WRK-MAX-SEL-CNT - 1. DTSBR602 00899 DTSBR602 00900 IF WRK-MAX-SEL-CNT-MINUS-1 > +0 DTSBR602 00901 PERFORM DTSBR602 00902 WRK-MAX-SEL-CNT-MINUS-1 TIMES DTSBR602 00903 ADD SKIP-INTERVAL TO CURRENT-CASE DTSBR602 00904 END-PERFORM. DTSBR602 00905 DTSBR602 00906 COMPUTE CURRENT-CASE-ROUNDED = CURRENT-CASE + 0.500. DTSBR602 00907 DTSBR602 00908 IF CURRENT-CASE-ROUNDED > WRK-UNIVERSE-CNT DTSBR602 00909 IF INITIAL-CASE > +1 DTSBR602 00910 SUBTRACT 1 FROM INITIAL-CASE. DTSBR602 00911 P1320-EXIT. DTSBR602 00912 EXIT. DTSBR602 00913 DTSBR602 00914 P1400-WRITE-MFAS. DTSBR602 00915 MOVE LOW-VALUES TO MFAS-REC. DTSBR602 00916 MOVE R602-EMP-NO TO MFAS-EMP-NO. DTSBR602 00917 SET MFAS-FAS-88 TO TRUE. DTSBR602 00918 MOVE R602-ASSIGN-NO TO MFAS-ASSIGN-NO. DTSBR602 00919 MOVE +0 TO MFAS-PURGE-DATE. DTSBR602 00920 SET MFAS-STATUS-ACTIVE-88 TO TRUE. DTSBR602 00921 ** SET MFAS-STATUS-HELD-88 TO TRUE. DTSBR602 00922 MOVE R602-FIELD-REP-ID TO MFAS-FLD-REP-ID. DTSBR602 00923 DTSBR602 00924 IF R602-TARGET-IND = 'Y' DTSBR602 00925 MOVE '15' TO MFAS-ASSIGN-TYPE DTSBR602 00926 SET MFAS-TARGET-AUDIT-88 TO TRUE DTSBR602 00927 ELSE DTSBR602 00928 SET MFAS-VERIF-AUDIT-88 TO TRUE DTSBR602 00929 MOVE '05' TO MFAS-ASSIGN-TYPE. DTSBR602 00930 DTSBR602 00931 SET MFAS-ATTACHMENTS-NO-88 TO TRUE. DTSBR602 00932 MOVE +0 TO MFAS-START-DATE DTSBR602 00933 MFAS-DUE-DATE DTSBR602 00934 MFAS-COMPLETED-DATE DTSBR602 00935 MFAS-PROCESSED-DATE DTSBR602 00936 MFAS-TAX-DOWNLOAD-DATE DTSBR602 00937 MFAS-WAGE-DOWNLOAD-DATE. DTSBR602 00938 MOVE 'SYSTEM' TO MFAS-SOURCE-OP-ID. DTSBR602 00939 MOVE ZEROS TO MFAS-CLAIMANT-SSN. DTSBR602 00940 MOVE SPACES TO MFAS-CLAIMANT-NAME. DTSBR602 00941 MOVE +0 TO MFAS-RELATED-EMP-NO DTSBR602 00942 MOVE FSEL-AUDIT-START-YRQ TO MFAS-START-YRQ. DTSBR602 00943 MOVE FSEL-AUDIT-END-YRQ TO MFAS-END-YRQ. DTSBR602 00944 MOVE R602-SIC-CD TO MFAS-SIC-CD. DTSBR602 00945 MOVE R602-NAICS-CD TO MFAS-NAICS-CD. DTSBR602 00946 MOVE R602-OWN-CD TO MFAS-OWN-CD. DTSBR602 00947 MOVE R602-EMP-SIZE-IND TO MFAS-EMP-SIZE-IND. DTSBR602 00948 MOVE +0 TO MFAS-SEL-CNT. DTSBR602 00949 SET MFAS-NOT-CONVERTED-88 TO TRUE. DTSBR602 00950 MOVE +0 TO MFAS-ESTB-DATE DTSBR602 00951 MFAS-CHNG-DATE. DTSBR602 00952 MOVE +1 TO MFAS-TEXT-CNT. DTSBR602 00953 MOVE 'ASSIGNMENT GENERATED BY AUDIT CANDIDATE SELECTION' DTSBR602 00954 TO MFAS-TEXT (1). DTSBR602 00955 ADD +1 TO MFAS-TEXT-CNT. DTSBR602 00956 MOVE 'PROCESS (REPORT 602).' DTSBR602 00957 TO MFAS-TEXT (2). DTSBR602 00958 DTSBR602 00959 ADD +1 TO WRK-MFAS-WRITTEN-CNT. DTSBR602 00960 DTSBR602 00961 WRITE FAS-REC FROM MFAS-REC. DTSBR602 00962 ** MOVE MFAS-REC TO MSKL-REC. DTSBR602 00963 ** PERFORM S910-WRITE THRU S910-EXIT. DTSBR602 00964 ** SET MPRF-MFAS-EXISTS-88 TO TRUE. DTSBR602 00965 DTSBR602 00966 DTSBR602 00967 P1400-EXIT. DTSBR602 00968 EXIT. DTSBR602 00969 DTSBR602 00970 P2000-PRINT-HEADER. DTSBR602 00971 DTSBR602 00972 IF WS-LINE-CNT GREATER 58 OR DTSBR602 00973 WS-LINE-CNT2 GREATER 58 DTSBR602 00974 MOVE +0 TO WS-LINE-CNT DTSBR602 00975 MOVE +0 TO WS-LINE-CNT2 DTSBR602 00976 ADD +1 TO WS-PAGE-CNT DTSBR602 00977 MOVE WS-PAGE-CNT TO HDR1-PAGE-CNT DTSBR602 00978 WRITE REPORT-LISTING1 FROM HDR1-LINE-1 DTSBR602 00979 AFTER TOP-OF-PAGE DTSBR602 00980 WRITE REPORT-LISTING1 FROM HDR1-LINE-2 AFTER 1 DTSBR602 00981 WRITE REPORT-LISTING1 FROM HDR1-LINE-3 AFTER 1 DTSBR602 00982 WRITE REPORT-LISTING1 FROM HDR1-LINE-4 AFTER 1 DTSBR602 00983 ADD +4 TO WS-LINE-CNT2. DTSBR602 00984 DTSBR602 00985 P2000-EXIT. DTSBR602 00986 EXIT. DTSBR602 00987 DTSBR602 00988 P3000-PRINT-HEADER. DTSBR602 00989 IF R602-TARGET-IND = 'Y' DTSBR602 00990 MOVE 'TARGETED' TO HDR2-ASSIGN-TYPE DTSBR602 00991 ELSE DTSBR602 00992 MOVE 'REGULAR ' TO HDR2-ASSIGN-TYPE. DTSBR602 00993 IF WS-LINE-CNT3 GREATER 58 OR DTSBR602 00994 WS-LINE-CNT4 GREATER 58 DTSBR602 00995 MOVE +0 TO WS-LINE-CNT3 DTSBR602 00996 MOVE +0 TO WS-LINE-CNT4 DTSBR602 00997 ADD +1 TO WS-PAGE-CNT2 DTSBR602 00998 MOVE WS-PAGE-CNT2 TO HDR2-PAGE-CNT DTSBR602 00999 WRITE REPORT-LISTING2 FROM HDR2-LINE-1 DTSBR602 01000 AFTER TOP-OF-PAGE DTSBR602 01001 WRITE REPORT-LISTING2 FROM HDR2-LINE-2 AFTER 1 DTSBR602 01002 WRITE REPORT-LISTING2 FROM HDR2-LINE-3 AFTER 1 DTSBR602 01003 WRITE REPORT-LISTING2 FROM HDR2-LINE-4 AFTER 1 DTSBR602 01004 WRITE REPORT-LISTING2 FROM HDR2-LINE-5 AFTER 1 DTSBR602 01005 WRITE REPORT-LISTING2 FROM HDR2-LINE-6 AFTER 2 DTSBR602 01006 WRITE REPORT-LISTING2 FROM HDR2-LINE-7 AFTER 1 DTSBR602 01007 WRITE REPORT-LISTING2 FROM HDR2-LINE-8 AFTER 1 DTSBR602 01008 WRITE REPORT-LISTING2 FROM HDR2-LINE-9 AFTER 1 DTSBR602 01009 WRITE REPORT-LISTING2 FROM HDR2-LINE-10 AFTER 1 DTSBR602 01010 WRITE REPORT-LISTING2 FROM HDR2-LINE-11 AFTER 1 DTSBR602 01011 ADD +11 TO WS-LINE-CNT4. DTSBR602 01012 DTSBR602 01013 P3000-EXIT. DTSBR602 01014 EXIT. DTSBR602 01015 DTSBR602 01016 P4000-PRINT-DETAIL. DTSBR602 01017 DTSBR602 01018 WRITE REPORT-LISTING1 FROM DTL1-LINE-7 AFTER 2. DTSBR602 01019 WRITE REPORT-LISTING1 FROM DTL1-LINE-9 AFTER 2. DTSBR602 01020 WRITE REPORT-LISTING1 FROM DTL1-LINE-11 AFTER 2. DTSBR602 01021 WRITE REPORT-LISTING1 FROM DTL1-LINE-14 AFTER 3. DTSBR602 01022 WRITE REPORT-LISTING1 FROM DTL1-LINE-16 AFTER 2. DTSBR602 01023 WRITE REPORT-LISTING1 FROM DTL1-LINE-18 AFTER 2. DTSBR602 01024 WRITE REPORT-LISTING1 FROM DTL1-LINE-20 AFTER 2. DTSBR602 01025 WRITE REPORT-LISTING1 FROM DTL1-LINE-22 AFTER 2. DTSBR602 01026 WRITE REPORT-LISTING1 FROM DTL1-LINE-24 AFTER 2. DTSBR602 01027 WRITE REPORT-LISTING1 FROM DTL1-LINE-26 AFTER 2. DTSBR602 01028 WRITE REPORT-LISTING1 FROM DTL1-LINE-28 AFTER 2. DTSBR602 01029 WRITE REPORT-LISTING1 FROM DTL1-LINE-30 AFTER 2. DTSBR602 01030 WRITE REPORT-LISTING1 FROM DTL1-LINE-32 AFTER 2. DTSBR602 01031 WRITE REPORT-LISTING1 FROM DTL1-LINE-34 AFTER 2. DTSBR602 01032 WRITE REPORT-LISTING1 FROM DTL1-LINE-36 AFTER 2. DTSBR602 01033 ADD +31 TO WS-LINE-CNT4. DTSBR602 01034 DTSBR602 01035 P4000-EXIT. DTSBR602 01036 EXIT. DTSBR602 01037 DTSBR602 01038 T1000-TERMINATE. DTSBR602 01039 DTSBR602 01040 PERFORM P1200-BREAK-GROUP THRU P1200-EXIT. DTSBR602 01041 WRITE REPORT-LISTING2 FROM CFF-LINE-3 AFTER 3. DTSBR602 01042 DTSBR602 01043 DISPLAY 'LAST ASSIGNMENT NBR FOR THIS RUN: ' DTSBR602 01044 WRK-ASSIGN-NO. DTSBR602 01045 DTSBR602 01046 CLOSE PRT-FILE-2. DTSBR602 01047 CLOSE FAS-FILE-3. DTSBR602 01048 DTSBR602 01049 T1000-EXIT. DTSBR602 01050 EXIT. DTSBR602 01051 EJECT DTSBR602 01052 S001-FROM-FED-8. DTSBR602 01053 DTSBR602 01054 SET L001-FROM-FED-8 TO TRUE. DTSBR602 01055 DTSBR602 01056 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR602 01057 DTSBR602 01058 S001-EXIT. DTSBR602 01059 EXIT. DTSBR602 01060 DTSBR602 01061 S002-MIXED-CASE. DTSBR602 01062 SET L002-UPPER-CASE TO TRUE. DTSBR602 01063 CALL 'DTSBU002' USING L002-LINK-AREA. DTSBR602 01064 S002-EXIT. DTSBR602 01065 EXIT. DTSBR602 01066 SKIP3 DTSBR602 01067 DTSBR602 01068 S004-FROM-5. DTSBR602 01069 SET L004-FROM-5 TO TRUE. DTSBR602 01070 DTSBR602 01071 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBR602 01072 DTSBR602 01073 S004-EXIT. DTSBR602 01074 EXIT. DTSBR602 01075 DTSBR602 01076 S005-FROM-SYS. DTSBR602 01077 DTSBR602 01078 SET L005-FROM-SYS TO TRUE. DTSBR602 01079 DTSBR602 01080 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBR602 01081 DTSBR602 01082 S005-EXIT. DTSBR602 01083 EXIT. DTSBR602 01084 DTSBR602 01085 S036-EMP-SIZE-IND. DTSBR602 01086 DTSBR602 01087 SET L036-MFAS-EMP-SIZE-IND TO TRUE. DTSBR602 01088 DTSBR602 01089 CALL 'DTSBU036' USING L036-LINK-AREA. DTSBR602 01090 DTSBR602 01091 S036-EXIT. DTSBR602 01092 EXIT. DTSBR602 01093 DTSBR602 01094 S056-DISP1-LEFT. DTSBR602 01095 DTSBR602 01096 SET L056-DISP1-LEFT-88 TO TRUE. DTSBR602 01097 DTSBR602 01098 CALL 'DTSBU056' USING L056-LINK-AREA. DTSBR602 01099 DTSBR602 01100 S056-EXIT. DTSBR602 01101 EXIT. DTSBR602 01102 DTSBR602 01103 S062-FLD-REP-LOOKUP. DTSBR602 01104 DTSBR602 01105 CALL 'DTSBU062' USING L062-LINK-AREA. DTSBR602 01106 DTSBR602 01107 S062-EXIT. DTSBR602 01108 EXIT. DTSBR602 01109 DTSBR602 01110 S071-DESLASH-NAME. DTSBR602 01111 CALL 'DTSBU071' USING L071-LINK-AREA. DTSBR602 01112 S071-EXIT. DTSBR602 01113 EXIT. DTSBR602 01114 SKIP3 DTSBR602 01115 DTSBR602 01116 S910-READ. DTSBR602 01117 SET L910-READ-88 TO TRUE. DTSBR602 01118 CALL 'DTSBU910' USING L910-LINK-AREA DTSBR602 01119 MSKL-REC. DTSBR602 01120 DTSBR602 01121 S910-EXIT. DTSBR602 01122 EXIT. DTSBR602 01123 DTSBR602 01124 S931-READ. DTSBR602 01125 SET L931-READ-88 TO TRUE. DTSBR602 01126 GO TO S931-INPUT. DTSBR602 01127 DTSBR602 01128 S931-INPUT. DTSBR602 01129 CALL 'DTSBU931' USING L931-LINK-AREA DTSBR602 01130 FSKL-REC. DTSBR602 01131 S931-EXIT. DTSBR602 01132 EXIT. DTSBR602 01133 DTSBR602 01134 S999-ABEND. DTSBR602 01135 DTSBR602 01136 DISPLAY ABEND-MSG. DTSBR602 01137 DTSBR602 01138 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR602 01139 DTSBR602 01140 S999-EXIT. DTSBR602 01141 EXIT. DTSBR602 01142 DTSBR602