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