1144 lines
90 KiB
COBOL
1144 lines
90 KiB
COBOL
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
|