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

361 lines
28 KiB
COBOL

00001 IDENTIFICATION DIVISION. 06/28/19
00002 PROGRAM-ID. DTSBR119. DTSBR119
00003 AUTHOR. MT DEPT OF LABOR/UI PROGRAMMING SECTION. LV013
00004 UPDATED BY TRW/BDM SEPT 1998. DTSBR119
00005 DATE-WRITTEN. AUGUST 1994. DTSBR119
00006 DATE-COMPILED. DTSBR119
00007 SKIP3 DTSBR119
00008 ***** DTSBR119
00009 * DTSBR119
00010 * CALLING SEQUENCE: DTSBD400 CALLS DTSBR119
00011 * DTSBE119 WHICH UPDATES DTRIR119 DTSBR119
00012 * DTSBR119 READ DTSIR119 RECORD TO DTSBR119
00013 * PRODUCE THE 8 QTRS OF NONE REPORTS DTSBR119
00014 * LIST. DTSBR119
00015 * DTSBR119
00016 * FUNCTION: EIGHT QTRS OF NONE REPORTS LIST. DTSBR119
00017 * DTSBR119
00018 ******** DTSBR119
00019 * MODIFICATION HISTORY: DTSBR119
00020 * DTSBR119
00021 * 08-21-94 INITIAL DEVELOPMENT DTSBR119
00022 * REFERENCE RFP #RAP AUTHOR OF CHANGE - SFW DTSBR119
00023 * DTSBR119
00024 * 03-14-95 DROP ADDRESS FROM REPORT. DTSBR119
00025 * REFERENCE RFP #CR051 AUTHOR OF CHANGE - RHC DTSBR119
00026 * DTSBR119
00027 * 02-15-96 ADDED CODE TO COUNT THE ACCOUNTS WHERE THE LAST QTR DTSBR119
00028 * IS DELINQUENT. DTSBR119
00029 * REFERENCE RFP #PROD RECOVERY PROGRAMMER: MJA DTSBR119
00030 * DTSBR119
00031 * 05-22-00 CLEANED UP REMNANTS OF NON-RPT119R1 REPORTS DTSBR119
00032 * REFERENCE: SYSTEMS TEST FOR DOES PROGRAMMER: JHP DTSBR119
00033 * DTSBR119
00034 * CL*13
00035 * 06-28-19 MODIFIED PROGRAM TO INDICATE ACCOUNTS INACTIVATED CL*13
00036 * BUT EMPLOYER FILE A WAGE REPORT IN THE 9TH QTR. CL*13
00037 * REFERENCE: IPT MEET 6/27/19 PROGRAMMER: ZL1 CL*13
00038 * CL*13
00039 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR119
00040 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR119
00041 * REFERENCE RFP #**** PROGRAMMER: XXX DTSBR119
00042 * DTSBR119
00043 * DTSBR119
00044 * DESCRIPTION: DTSBR119
00045 * DTSBR119
00046 * THIS MODULE LISTS ALL EMPLOYERS WHO HAVE ZERO WAGES DTSBR119
00047 * REPORTED FOR CONSECUTIVE QUARTERS INCLUDED IN A TIME DTSBR119
00048 * SPAN DEFINED BY PARAMETER LOWER AND UPPER BOUND QUARTERS DTSBR119
00049 * (NORMALLY THERE WOULD BE 8 QUARTERS CONSIDERED). DTSBR119
00050 * DTSBR119
00051 * DTSBR119
00052 * RECORDS READ: DTSBR119
00053 * DTSBR119
00054 * NONE. DTSBR119
00055 * DTSBR119
00056 * DTSBR119
00057 * PRINTED OUTPUTS: DTSBR119
00058 * DTSBR119
00059 * 119R1 EIGHT CONSECUTIVE NONES LIST DTSBR119
00060 * DTSBR119
00061 * DTSBR119
00062 * RECORDS WRITTEN: DTSBR119
00063 * DTSBR119
00064 * NONE DTSBR119
00065 * DTSBR119
00066 * DTSBR119
00067 * MODULES CALLED: DTSBR119
00068 * DTSBR119
00069 * NONE DTSBR119
00070 * DTSBR119
00071 * DTSBR119
00072 ***** DTSBR119
00073 EJECT DTSBR119
00074 ENVIRONMENT DIVISION. DTSBR119
00075 SKIP2 DTSBR119
00076 CONFIGURATION SECTION. DTSBR119
00077 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBR119
00078 INPUT-OUTPUT SECTION. DTSBR119
00079 SKIP1 DTSBR119
00080 FILE-CONTROL. DTSBR119
00081 SELECT PRT-FILE ASSIGN TO RPT119R1. DTSBR119
00082 SKIP3 DTSBR119
00083 DATA DIVISION. DTSBR119
00084 SKIP3 DTSBR119
00085 FILE SECTION. DTSBR119
00086 SKIP2 DTSBR119
00087 DTSBR119
00088 FD PRT-FILE DTSBR119
00089 RECORDING MODE IS F. DTSBR119
00090 01 PRT-RECORD PIC X(133). DTSBR119
00091 EJECT DTSBR119
00092 WORKING-STORAGE SECTION. DTSBR119
000925 77 PAN-VALET PICTURE X(24) VALUE '013DTSBR119 06/28/19'. DTSBR119
00093 77 PAN-VALET PICTURE X(24) VALUE '023DTSBR119 08/30/12'. DTSBR119
00094 SKIP3 DTSBR119
00095 01 WRK-AREA. DTSBR119
00096 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +119.DTSBR119
00097 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR119
00098 05 WS-FIRST-QTR PIC 9(05) VALUE 0. DTSBR119
00099 05 WS-FIRST-QTR9 REDEFINES WS-FIRST-QTR. DTSBR119
00100 10 WS-FIRST-CEN PIC 9(02). DTSBR119
00101 10 WS-FIRST-YEAR PIC 9(02). DTSBR119
00102 10 WS-FIRST-QUARTER PIC 9(01). DTSBR119
00103 05 WS-LAST-QTR PIC 9(05) VALUE 0. DTSBR119
00104 05 WS-LAST-QTR9 REDEFINES WS-LAST-QTR. DTSBR119
00105 10 WS-LAST-CEN PIC 9(02). DTSBR119
00106 10 WS-LAST-YEAR PIC 9(02). DTSBR119
00107 10 WS-LAST-QUARTER PIC 9(01). DTSBR119
00108 DTSBR119
00109 05 WS-NBR-REC-CNT PIC 9(05) VALUE ZERO. DTSBR119
00110 05 WS-NBR-LIA-CNT PIC 9(05) VALUE ZERO. CL**9
00111 05 WS-NBR-EST-CNT PIC 9(05) VALUE ZERO. CL**9
00112 05 WS-NBR-INA-CNT PIC 9(05) VALUE ZERO. CL**9
00113 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE +65. DTSBR119
00114 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. DTSBR119
00115 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. DTSBR119
00116 DTSBR119
00117 05 WS-END-QTR-DELQ-ACCT-CNT PIC S9(05) COMP VALUE +0. DTSBR119
00118 05 WS-ADDR-FMT-AREA PIC X(200) VALUE SPACES. DTSBR119
00119 05 WS-ADDR-FMT-AREA-X REDEFINES WS-ADDR-FMT-AREA. DTSBR119
00120 10 ADDR-FMT-LINE OCCURS 5 TIMES PIC X(40). DTSBR119
00121 DTSBR119
00122 EJECT DTSBR119
00123 DTSBR119
00124 01 HEADER-1 PIC X(133) VALUE SPACES. DTSBR119
00125 01 HEADER-2 PIC X(133) VALUE SPACES. DTSBR119
00126 01 HEADER-3. DTSBR119
00127 05 FILLER PIC X(01) VALUE SPACES. DTSBR119
00128 05 FILLER PIC X(49) VALUE '119R1'. DTSBR119
00129 05 FILLER PIC X(60) VALUE DTSBR119
00130 'DISTRICT OF COLUMBIA'. DTSBR119
00131 05 FILLER PIC X(05) VALUE SPACES. DTSBR119
00132 05 FILLER PIC X(06) VALUE 'DATE:'. DTSBR119
00133 05 HDR1-LRCM-SYS-DATE PIC X(08). DTSBR119
00134 DTSBR119
00135 01 HEADER-4. DTSBR119
00136 05 FILLER PIC X(54) VALUE SPACES. DTSBR119
00137 05 FILLER PIC X(56) VALUE DTSBR119
00138 'TAX DIVISION'. DTSBR119
00139 05 FILLER PIC X(05) VALUE SPACES. DTSBR119
00140 05 FILLER PIC X(06) VALUE 'TIME:'. DTSBR119
00141 05 HDR2-LRCM-SYS-TIME PIC X(08). DTSBR119
00142 DTSBR119
00143 01 HEADER-5. DTSBR119
00144 05 FILLER PIC X(01) VALUE SPACES. DTSBR119
00145 05 FILLER PIC X(40) DTSBR119
00146 VALUE 'ROUTE TO: REGISTRATION AND RATES '. DTSBR119
00147 05 FILLER PIC X(16) DTSBR119
00148 VALUE 'EIGHT QUARTERS ('. DTSBR119
00149 05 WS-HDR5-FIRST-YEAR PIC 99. DTSBR119
00150 05 FILLER PIC X(01) VALUE '/'. DTSBR119
00151 05 WS-HDR5-FIRST-QUARTER PIC 9. DTSBR119
00152 05 FILLER PIC X(01) VALUE SPACE. DTSBR119
00153 05 FILLER PIC X(01) DTSBR119
00154 VALUE '-'. DTSBR119
00155 05 FILLER PIC X(01) VALUE SPACE. DTSBR119
00156 05 WS-HDR5-LAST-YEAR PIC 99. DTSBR119
00157 05 FILLER PIC X(01) VALUE '/'. DTSBR119
00158 05 WS-HDR5-LAST-QUARTER PIC 9. DTSBR119
00159 05 FILLER PIC X(17) DTSBR119
00160 VALUE ') OF NONE REPORTS'. DTSBR119
00161 05 FILLER PIC X(05) VALUE SPACES. DTSBR119
00162 05 WS-HDR5-PRELIM-YN PIC X(13) VALUE SPACES. DTSBR119
00163 05 FILLER PIC X(12) VALUE SPACES. DTSBR119
00164 05 FILLER PIC X(05) DTSBR119
00165 VALUE 'PAGE:'. DTSBR119
00166 05 FILLER PIC X(03) VALUE SPACES. DTSBR119
00167 05 HDR5-PAGE-CNT PIC ZZ,ZZ9. DTSBR119
00168 DTSBR119
00169 01 HEADER-6 PIC X(133) VALUE SPACES. DTSBR119
00170 01 HEADER-7 PIC X(133) VALUE SPACES. DTSBR119
00171 01 HEADER-8. DTSBR119
00172 05 FILLER PIC X(02) VALUE SPACES. CL**4
00173 05 FILLER PIC X(26) DTSBR119
00174 VALUE 'EMP NO PRIMARY NAME '. CL**5
00175 05 FILLER PIC X(10) VALUE SPACES. CL**4
00176 05 FILLER PIC X(14) DTSBR119
00177 VALUE ' CLASS '. CL**5
00178 05 FILLER PIC X(06) CL**7
00179 VALUE ' REP '. CL**7
00180 05 FILLER PIC X(07) DTSBR119
00181 VALUE 'DELQ '. CL**6
00182 05 FILLER PIC X(26) CL*10
00183 VALUE 'REASON-NOT INACTIVATED '. CL*11
00184 01 HEADER-9. DTSBR119
00185 05 FILLER PIC X(98) VALUE SPACES. DTSBR119
00186 05 FILLER PIC X(04) DTSBR119
00187 VALUE ' '. CL**6
00188 05 FILLER PIC X(09) VALUE SPACES. DTSBR119
00189 05 FILLER PIC X(05) DTSBR119
00190 VALUE ' '. CL**6
00191 DTSBR119
00192 01 DETAIL-LINE-2. DTSBR119
00193 05 FILLER PIC X(02) VALUE SPACES. CL**3
00194 05 WS-EMP-NO PIC 999B999. DTSBR119
00195 05 FILLER PIC X(02) VALUE SPACES. CL**3
00196 05 WS-PRIMARY-NAME PIC X(30) VALUE SPACES. CL**3
00197 05 FILLER PIC X(05) VALUE SPACES. DTSBR119
00198 05 WS-EMP-CLASS-NAME PIC X(04) VALUE SPACES. CL**5
00199 05 FILLER PIC X(04) VALUE SPACES. CL**5
00200 05 WS-FLD-REP-ID PIC X(02) VALUE SPACES. DTSBR119
00201 05 FILLER PIC X(04) VALUE SPACES. CL**5
00202 05 WS-LAST-YRQ-DELQ-IND PIC X(01) VALUE SPACE. DTSBR119
00203 05 FILLER PIC X(04) VALUE SPACES. CL**5
00204 05 WS-MESG-IND PIC X(30) VALUE SPACE. CL**3
00205 05 WS-MESG-IND2 PIC X(10) VALUE SPACE. CL**7
00206 DTSBR119
00207 01 FOOTING-LINE-4. DTSBR119
00208 05 FILLER PIC X(59) VALUE SPACES. DTSBR119
00209 05 WS-FOOTING-REC-CNT PIC ZZ,ZZ9. DTSBR119
00210 05 FILLER PIC X(01) VALUE SPACES. DTSBR119
00211 05 FILLER PIC X(40) CL**9
00212 VALUE '# OF ACCOUNTS SELECTED FOR INACTIVATION'. CL**9
00213 01 FOOTING-LINE-5. CL**9
00214 05 FILLER PIC X(59) VALUE SPACES. CL**9
00215 05 WS-FOOTING-LIA-CNT PIC ZZ,ZZ9. CL**9
00216 05 FILLER PIC X(01) VALUE SPACES. CL**9
00217 05 FILLER PIC X(40) CL**9
00218 VALUE '# OF ACCOUNTS HAD NEW LIABILITY '. CL**9
00219 01 FOOTING-LINE-51. CL**9
00220 05 FILLER PIC X(59) VALUE SPACES. CL**9
00221 05 WS-FOOTING-EST-CNT PIC ZZ,ZZ9. CL**9
00222 05 FILLER PIC X(01) VALUE SPACES. CL**9
00223 05 FILLER PIC X(40) CL**9
00224 VALUE '# OF ACCOUNTS HAD ESTIMATED REPORT(S) '. CL**9
00225 01 FOOTING-LINE-52. CL**9
00226 05 FILLER PIC X(59) VALUE SPACES. CL**9
00227 05 WS-FOOTING-INA-CNT PIC ZZ,ZZ9. CL**9
00228 05 FILLER PIC X(01) VALUE SPACES. CL**9
00229 05 FILLER PIC X(30) CL**9
00230 VALUE '# OF ACCOUNTS INACTIVATED '. CL**9
00231 01 FOOTING-LINE-6. DTSBR119
00232 05 FILLER PIC X(59) VALUE SPACES. DTSBR119
00233 05 WS-FOOTING-ACCT-CNT PIC ZZ,ZZ9. DTSBR119
00234 05 FILLER PIC X(01) VALUE SPACES. DTSBR119
00235 05 FILLER PIC X(34) DTSBR119
00236 VALUE 'END QTR DELINQUENT ACCOUNTS LISTED'. DTSBR119
00237 EJECT DTSBR119
00238 LINKAGE SECTION. DTSBR119
00239 SKIP3 DTSBR119
00240 01 LRCM-LINK-AREA. DTSBR119
00241 ++INCLUDE DTSILRCM DTSBR119
00242 EJECT DTSBR119
00243 01 R119-REC. DTSBR119
00244 ++INCLUDE DTSIR119 DTSBR119
00245 EJECT DTSBR119
00246 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR119
00247 R119-REC. DTSBR119
00248 SKIP2 DTSBR119
00249 IF FIRST-TIME-IND = 'Y' DTSBR119
00250 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR119
00251 MOVE 'N' TO FIRST-TIME-IND. DTSBR119
00252 SKIP1 DTSBR119
00253 IF LRCM-EOR-88 DTSBR119
00254 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR119
00255 ELSE DTSBR119
00256 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR119
00257 SKIP2 DTSBR119
00258 GOBACK. DTSBR119
00259 DTSBR119
00260 I1000-INITIATE. DTSBR119
00261 DTSBR119
00262 OPEN OUTPUT PRT-FILE. DTSBR119
00263 MOVE R119-FIRST-QTR TO WS-FIRST-QTR. DTSBR119
00264 MOVE R119-LAST-QTR TO WS-LAST-QTR. DTSBR119
00265 MOVE WS-FIRST-YEAR TO WS-HDR5-FIRST-YEAR. DTSBR119
00266 MOVE WS-FIRST-QUARTER TO WS-HDR5-FIRST-QUARTER. DTSBR119
00267 MOVE WS-LAST-YEAR TO WS-HDR5-LAST-YEAR. DTSBR119
00268 MOVE WS-LAST-QUARTER TO WS-HDR5-LAST-QUARTER. DTSBR119
00269 IF R119-AUTOMATIC-INACT-NO-88 DTSBR119
00270 MOVE '(PRELIMINARY)' TO WS-HDR5-PRELIM-YN. DTSBR119
00271 MOVE LRCM-SYS-DATE TO HDR1-LRCM-SYS-DATE. DTSBR119
00272 MOVE LRCM-SYS-TIME TO HDR2-LRCM-SYS-TIME. DTSBR119
00273 MOVE SPACES TO PRT-RECORD. DTSBR119
00274 PERFORM P2000-PRINT-HEADER THRU P2000-EXIT. CL*11
00275 DTSBR119
00276 I1000-EXIT. DTSBR119
00277 EXIT. DTSBR119
00278 EJECT DTSBR119
00279 P1000-PROCESS. DTSBR119
00280 DTSBR119
00281 MOVE R119-EMP-CLASS TO WS-EMP-CLASS-NAME CL**4
00282 DTSBR119
00283 IF R119-LAST-YRQ-DELQ-IND = 'Y' DTSBR119
00284 ADD +1 TO WS-END-QTR-DELQ-ACCT-CNT. DTSBR119
00285 DTSBR119
00286 MOVE R119-EMP-NO TO WS-EMP-NO. DTSBR119
00287 MOVE R119-PRIMARY-NAME TO WS-PRIMARY-NAME. DTSBR119
00288 MOVE R119-FLD-REP-ID TO WS-FLD-REP-ID. DTSBR119
00289 MOVE R119-LAST-YRQ-DELQ-IND TO WS-LAST-YRQ-DELQ-IND. DTSBR119
00290 MOVE SPACES TO WS-MESG-IND2. CL**8
00291 IF R119-AUTO-INACT-NO-LIAB-88 CL**2
00292 MOVE 'NEW LIABILITY DATE ' TO WS-MESG-IND CL**8
00293 ADD +1 TO WS-NBR-LIA-CNT CL**9
00294 ELSE CL**2
00295 IF R119-AUTO-INACT-NO-ESTM-88 CL**2
00296 MOVE 'ESTIMATED REPORT(S) ' TO WS-MESG-IND CL**8
00297 ADD +1 TO WS-NBR-EST-CNT CL**9
00298 ELSE CL**2
00299 ADD +1 TO WS-NBR-INA-CNT CL**9
00300 MOVE ' ' TO WS-MESG-IND CL**8
00301 MOVE 'INACTIVATED ' TO WS-MESG-IND2. CL**8
00302 CL*13
00303 IF R119-9THQTR-RPTWGE-YES-88 CL*13
00304 MOVE '*** 9TH QTR WAGE REP FILED ' TO WS-MESG-IND. CL*13
00305 CL*13
00306 WRITE PRT-RECORD FROM DETAIL-LINE-2 AFTER 2. DTSBR119
00307 ADD +2 TO WS-LINE-CNT2. DTSBR119
00308 ADD +1 TO WS-NBR-REC-CNT. DTSBR119
00309 DTSBR119
00310 P1000-EXIT. DTSBR119
00311 EXIT. DTSBR119
00312 DTSBR119
00313 P2000-PRINT-HEADER. DTSBR119
00314 IF WS-LINE-CNT GREATER +58 OR DTSBR119
00315 WS-LINE-CNT2 GREATER +58 DTSBR119
00316 MOVE +0 TO WS-LINE-CNT DTSBR119
00317 MOVE +0 TO WS-LINE-CNT2 DTSBR119
00318 ADD +1 TO WS-PAGE-CNT DTSBR119
00319 MOVE WS-PAGE-CNT TO HDR5-PAGE-CNT DTSBR119
00320 WRITE PRT-RECORD FROM HEADER-1 AFTER TOP-OF-PAGE DTSBR119
00321 WRITE PRT-RECORD FROM HEADER-2 AFTER 1 DTSBR119
00322 WRITE PRT-RECORD FROM HEADER-3 AFTER 1 DTSBR119
00323 WRITE PRT-RECORD FROM HEADER-4 AFTER 1 DTSBR119
00324 WRITE PRT-RECORD FROM HEADER-5 AFTER 1 DTSBR119
00325 WRITE PRT-RECORD FROM HEADER-6 AFTER 1 DTSBR119
00326 WRITE PRT-RECORD FROM HEADER-7 AFTER 1 DTSBR119
00327 WRITE PRT-RECORD FROM HEADER-8 AFTER 1 DTSBR119
00328 WRITE PRT-RECORD FROM HEADER-9 AFTER 1 DTSBR119
00329 ADD +9 TO WS-LINE-CNT2. DTSBR119
00330 P2000-EXIT. DTSBR119
00331 EXIT. DTSBR119
00332 DTSBR119
00333 T1000-TERMINATE. DTSBR119
00334 DTSBR119
00335 * IF WS-LINE-CNT2 > +54 CL*11
00336 * PERFORM P2000-PRINT-HEADER THRU P2000-EXIT CL*11
00337 * END-IF. CL*11
00338 MOVE WS-NBR-REC-CNT TO WS-FOOTING-REC-CNT. DTSBR119
00339 MOVE WS-NBR-LIA-CNT TO WS-FOOTING-LIA-CNT. CL**9
00340 MOVE WS-NBR-EST-CNT TO WS-FOOTING-EST-CNT. CL**9
00341 MOVE WS-NBR-INA-CNT TO WS-FOOTING-INA-CNT. CL**9
00342 MOVE WS-END-QTR-DELQ-ACCT-CNT TO WS-FOOTING-ACCT-CNT. DTSBR119
00343 WRITE PRT-RECORD FROM FOOTING-LINE-4 AFTER 4. DTSBR119
00344 WRITE PRT-RECORD FROM FOOTING-LINE-5 AFTER 1. CL**9
00345 WRITE PRT-RECORD FROM FOOTING-LINE-51 AFTER 1. CL**9
00346 WRITE PRT-RECORD FROM FOOTING-LINE-52 AFTER 1. CL**9
00347 WRITE PRT-RECORD FROM FOOTING-LINE-6 AFTER 2. DTSBR119
00348 CLOSE PRT-FILE. DTSBR119
00349 DTSBR119
00350 T1000-EXIT. DTSBR119
00351 EXIT. DTSBR119
00352 DTSBR119
00353 *S999-ABEND. DTSBR119
00354 * SKIP1 DTSBR119
00355 * CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR119
00356 * SKIP2 DTSBR119
00357 *S999-EXIT. DTSBR119
00358 * EXIT. DTSBR119
00359 DTSBR119