00001 IDENTIFICATION DIVISION. 08/06/02 00002 PROGRAM-ID. DTSBR120. DTSBR120 00003 AUTHOR. MT DEPT OF LABOR/UI PROGRAMMING SECTION LV015 00004 MODIFIED BY TRW/BDM OCT. 1998. DTSBR120 00005 DATE-WRITTEN. SEPTEMBER 1994. DTSBR120 00006 DATE-COMPILED. DTSBR120 00007 DTSBR120 00008 ***** DTSBR120 00009 * DTSBR120 00010 * CALLING SEQUENCE: DTSBD400 CALLS DTSBR120 00011 * DTSBE120 WHICH UPDATES DTSIR120 DTSBR120 00012 * DTSBR120 READS DTSIR120 RECORDS. DTSBR120 00013 * DTSBR120 00014 * FUNCTION: POTENTIALLY FICTITIOUS EMPLOYERS LIST. DTSBR120 00015 * DTSBR120 00016 * DTSBR120 00017 * MODIFICATION HISTORY: DTSBR120 00018 * DTSBR120 00019 * 09-25-94 INITIAL DEVELOPMENT DTSBR120 00020 * REFERENCE RFP #RAP AUTHOR OF CHANGE - SFW DTSBR120 00021 * DTSBR120 00022 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR120 00023 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR120 00024 * REFERENCE RFP #**** AUTHOR OF CHANGE - XXX DTSBR120 00025 * DTSBR120 00026 * DTSBR120 00027 * DESCRIPTION: DTSBR120 00028 * DTSBR120 00029 * THIS MODULE ATTEMPTS TO IDENTIFY FICTITIOUS EMPLOYERS DTSBR120 00030 * ESTABLISHED FOR THE PURPOSES OF FRAUDULENT BENEFIT DTSBR120 00031 * CLAIMS. DTSBR120 00032 * DTSBR120 00033 * DTSBR120 00034 * RECORDS READ: DTSBR120 00035 * DTSBR120 00036 * NONE. DTSBR120 00037 * DTSBR120 00038 * DTSBR120 00039 * PRINTED OUTPUTS: DTSBR120 00040 * DTSBR120 00041 * 120R1 POTENTIALLY FICTITIOUS EMPLOYERS LIST DTSBR120 00042 * DTSBR120 00043 * DTSBR120 00044 * RECORDS WRITTEN: DTSBR120 00045 * DTSBR120 00046 * NONE. DTSBR120 00047 * DTSBR120 00048 * DTSBR120 00049 * MODULES CALLED: DTSBR120 00050 * DTSBR120 00051 * DTSBU001 DATE EDIT/CONVERSION MODULE DTSBR120 00052 * DTSBR120 00053 * DTSBR120 00054 ***** DTSBR120 00055 EJECT DTSBR120 00056 ENVIRONMENT DIVISION. DTSBR120 00057 DTSBR120 00058 CONFIGURATION SECTION. DTSBR120 00059 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBR120 00060 DTSBR120 00061 INPUT-OUTPUT SECTION. DTSBR120 00062 DTSBR120 00063 FILE-CONTROL. DTSBR120 00064 SELECT PRT-FILE ASSIGN TO RPT120R1. DTSBR120 00065 DTSBR120 00066 SELECT CHG-PARM-FILE ASSIGN TO CHGPARM DTSBR120 00067 FILE STATUS IS CHG-PARM-STATUS. DTSBR120 00068 DTSBR120 00069 DATA DIVISION. DTSBR120 00070 DTSBR120 00071 FILE SECTION. DTSBR120 00072 DTSBR120 00073 FD PRT-FILE DTSBR120 00074 RECORDING MODE IS F. DTSBR120 00075 01 PRT-RECORD PIC X(133). DTSBR120 00076 DTSBR120 00077 FD CHG-PARM-FILE DTSBR120 00078 RECORDING MODE IS F DTSBR120 00079 BLOCK CONTAINS 0 CHARACTERS. DTSBR120 00080 SKIP1 DTSBR120 00081 01 CHG-PARM-REC. DTSBR120 00082 ++INCLUDE CHGIM003 DTSBR120 00083 DTSBR120 00084 EJECT DTSBR120 00085 WORKING-STORAGE SECTION. DTSBR120 000855 77 PAN-VALET PICTURE X(24) VALUE '015DTSBR120 08/06/02'. DTSBR120 00086 DTSBR120 00087 01 WRK-AREA. DTSBR120 00088 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +120.DTSBR120 00089 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR120 00090 05 WS-NUMBER-ONE PIC S9(03) COMP-3 VALUE +0. DTSBR120 00091 DTSBR120 00092 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 56. DTSBR120 00093 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. DTSBR120 00094 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. DTSBR120 00095 DTSBR120 00096 05 CHG-PARM-STATUS PIC X(02) VALUE SPACES. DTSBR120 00097 88 CHG-PARM-FILE-OK-88 VALUE ZERO. DTSBR120 00098 88 CHG-PARM-FILE-EOF-88 VALUE '10'. DTSBR120 00099 DTSBR120 00100 EJECT DTSBR120 00101 01 L001-LINK-AREA. DTSBR120 00102 ++INCLUDE DTSIL001 DTSBR120 00103 EJECT DTSBR120 00104 DTSBR120 00105 01 HEADER-1. DTSBR120 00106 05 FILLER PIC X(01) VALUE SPACES. DTSBR120 00107 05 FILLER PIC X(49) VALUE '120R1'. DTSBR120 00108 05 FILLER PIC X(60) VALUE DTSBR120 00109 'DISTRICT OF COLUMBIA'. DTSBR120 00110 05 FILLER PIC X(06) VALUE 'DATE:'. DTSBR120 00111 05 HDR1-LRCM-SYS-DATE PIC X(08). DTSBR120 00112 DTSBR120 00113 01 HEADER-2. DTSBR120 00114 05 FILLER PIC X(54) VALUE SPACES. DTSBR120 00115 05 FILLER PIC X(56) VALUE DTSBR120 00116 'TAX DIVISION'. DTSBR120 00117 05 FILLER PIC X(06) VALUE 'TIME:'. DTSBR120 00118 05 HDR2-LRCM-SYS-TIME PIC X(08). DTSBR120 00119 DTSBR120 00120 01 HEADER-3. DTSBR120 00121 05 FILLER PIC X(01) VALUE SPACES. DTSBR120 00122 05 FILLER PIC X(41) VALUE DTSBR120 00123 'ROUTE TO: TAX CHIEF'. DTSBR120 00124 05 HDR3-LITERAL PIC X(60) VALUE DTSBR120 00125 'POTENTIALLY FICTITIOUS EMPLOYERS LIST'. DTSBR120 00126 05 FILLER PIC X(08) VALUE SPACES. DTSBR120 00127 05 FILLER PIC X(06) VALUE 'PAGE:'. DTSBR120 00128 05 HDR3-PAGE PIC ZZ,ZZ9. DTSBR120 00129 DTSBR120 00130 01 HEADER-4. DTSBR120 00131 05 FILLER PIC X(01) VALUE SPACES. DTSBR120 00132 05 FILLER PIC X(132) VALUE SPACES. DTSBR120 00133 DTSBR120 00134 01 HEADER-5. DTSBR120 00135 05 FILLER PIC X(01) VALUE SPACES. DTSBR120 00136 05 FILLER PIC X(16) VALUE DTSBR120 00137 'LIABILITY DATES:'. DTSBR120 00138 05 FILLER PIC X(13) VALUE SPACES. DTSBR120 00139 05 FILLER PIC X(21) VALUE DTSBR120 00140 'BENEFIT CHARGE DATES:'. DTSBR120 00141 DTSBR120 00142 01 HEADER-6. DTSBR120 00143 05 FILLER PIC X(01) VALUE SPACES. DTSBR120 00144 05 FILLER PIC X(132) VALUE SPACES. DTSBR120 00145 DTSBR120 00146 01 HEADER-7. DTSBR120 00147 05 FILLER PIC X(01) VALUE SPACES. DTSBR120 00148 05 WS-BEGIN-LIAB-DATE PIC X(08). DTSBR120 00149 05 FILLER PIC X(01) VALUE SPACES. DTSBR120 00150 05 FILLER PIC X(01) VALUE '-'. DTSBR120 00151 05 FILLER PIC X(01) VALUE SPACES. DTSBR120 00152 05 WS-END-LIAB-DATE PIC X(08). DTSBR120 00153 05 FILLER PIC X(10) VALUE SPACES. DTSBR120 00154 05 WS-BEGIN-CHRG-DATE PIC X(08). DTSBR120 00155 05 FILLER PIC X(01) VALUE SPACES. DTSBR120 00156 05 FILLER PIC X(01) VALUE '-'. DTSBR120 00157 05 FILLER PIC X(01) VALUE SPACES. DTSBR120 00158 05 WS-END-CHRG-DATE PIC X(08). DTSBR120 00159 DTSBR120 00160 01 HEADER-8. DTSBR120 00161 05 FILLER PIC X(01) VALUE SPACES. DTSBR120 00162 05 FILLER PIC X(132) VALUE SPACES. DTSBR120 00163 DTSBR120 00164 01 HEADER-9. DTSBR120 00165 05 FILLER PIC X(01) VALUE SPACES. DTSBR120 00166 05 FILLER PIC X(19) VALUE DTSBR120 00167 'MAXIMUM # EMPLOYEES'. DTSBR120 00168 DTSBR120 00169 01 HEADER-10. DTSBR120 00170 05 FILLER PIC X(01) VALUE SPACES. DTSBR120 00171 05 FILLER PIC X(02) VALUE SPACES. DTSBR120 00172 05 WS-MAX-EMPLOYEES PIC ZZ9. DTSBR120 00173 DTSBR120 00174 01 HEADER-11. DTSBR120 00175 05 FILLER PIC X(01) VALUE SPACES. DTSBR120 00176 05 FILLER PIC X(132) VALUE SPACES. DTSBR120 00177 DTSBR120 00178 01 HEADER-12. DTSBR120 00179 05 FILLER PIC X(01) VALUE SPACES. DTSBR120 00180 05 FILLER PIC X(58) VALUE SPACES. DTSBR120 00181 05 FILLER PIC X(09) VALUE DTSBR120 00182 'LIABILITY'. DTSBR120 00183 05 FILLER PIC X(07) VALUE SPACES. DTSBR120 00184 05 FILLER PIC X(08) VALUE DTSBR120 00185 'BENEFITS'. DTSBR120 00186 DTSBR120 00187 01 HEADER-13. DTSBR120 00188 05 FILLER PIC X(01) VALUE SPACES. DTSBR120 00189 05 FILLER PIC X(04) VALUE SPACES. DTSBR120 00190 05 FILLER PIC X(06) VALUE DTSBR120 00191 'EMP NO'. DTSBR120 00192 05 FILLER PIC X(05) VALUE SPACES. DTSBR120 00193 05 FILLER PIC X(13) VALUE DTSBR120 00194 'PRIMARY NAME'. DTSBR120 00195 05 FILLER PIC X(32) VALUE SPACES. DTSBR120 00196 05 FILLER PIC X(04) VALUE DTSBR120 00197 'DATE'. DTSBR120 00198 05 FILLER PIC X(10) VALUE SPACES. DTSBR120 00199 05 FILLER PIC X(07) VALUE DTSBR120 00200 'CHARGED'. DTSBR120 00201 05 FILLER PIC X(09) VALUE SPACES. DTSBR120 00202 05 FILLER PIC X(10) VALUE DTSBR120 00203 'TAXES PAID'. DTSBR120 00204 DTSBR120 00205 01 HEADER-14. DTSBR120 00206 05 FILLER PIC X(01) VALUE SPACES. DTSBR120 00207 05 FILLER PIC X(132) VALUE SPACES. DTSBR120 00208 DTSBR120 00209 01 DETAIL-LINE-15. DTSBR120 00210 05 FILLER PIC X(05) VALUE SPACES. DTSBR120 00211 05 WS-EMP-NO PIC 999B999. DTSBR120 00212 05 FILLER PIC X(02) VALUE SPACES. DTSBR120 00213 05 WS-PRIMARY-NAME PIC X(40). DTSBR120 00214 05 FILLER PIC X(05) VALUE SPACES. DTSBR120 00215 05 WS-OLDEST-LIAB-DATE PIC X(08). DTSBR120 00216 05 FILLER PIC X(04) VALUE SPACES. DTSBR120 00217 05 WS-BENEFIT-CHARGES PIC ZZZ,ZZZ,ZZ9.99. DTSBR120 00218 05 FILLER PIC X(04) VALUE SPACES. DTSBR120 00219 05 WS-PAID-AMT PIC ZZZ,ZZZ,ZZ9.99. DTSBR120 00220 DTSBR120 00221 01 FOOTING-LINE-1 PIC X(133) VALUE SPACES. DTSBR120 00222 01 FOOTING-LINE-2 PIC X(133) VALUE SPACES. DTSBR120 00223 DTSBR120 00224 01 FOOTING-LINE-3. DTSBR120 00225 05 FILLER PIC X(69) VALUE SPACES. DTSBR120 00226 05 WS-FOOTING-CNT PIC ZZ,ZZ9. DTSBR120 00227 05 FILLER PIC X(02) VALUE SPACES. DTSBR120 00228 05 FILLER PIC X(24) VALUE DTSBR120 00229 'EMPLOYER ACCOUNTS LISTED'. DTSBR120 00230 01 FOOTING-LINE-4 PIC X(133) VALUE SPACES. DTSBR120 00231 01 FOOTING-LINE-5. DTSBR120 00232 05 FILLER PIC X(25) VALUE SPACES. DTSBR120 00233 05 FILLER PIC X(17) VALUE DTSBR120 00234 '*** END OF REPORT'. DTSBR120 00235 EJECT DTSBR120 00236 LINKAGE SECTION. DTSBR120 00237 DTSBR120 00238 01 LRCM-LINK-AREA. DTSBR120 00239 ++INCLUDE DTSILRCM DTSBR120 00240 EJECT DTSBR120 00241 01 R120-REC. DTSBR120 00242 ++INCLUDE DTSIR120 DTSBR120 00243 EJECT DTSBR120 00244 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR120 00245 R120-REC. DTSBR120 00246 DTSBR120 00247 IF FIRST-TIME-IND = 'Y' DTSBR120 00248 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR120 00249 MOVE 'N' TO FIRST-TIME-IND. DTSBR120 00250 DTSBR120 00251 IF LRCM-EOR-88 DTSBR120 00252 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR120 00253 ELSE DTSBR120 00254 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR120 00255 DTSBR120 00256 GOBACK. DTSBR120 00257 EJECT DTSBR120 00258 I1000-INITIATE. DTSBR120 00259 DTSBR120 00260 MOVE R120-MAX-EMPLOYEES TO WS-MAX-EMPLOYEES. DTSBR120 00261 DTSBR120 00262 MOVE R120-BEGIN-LIAB-DATE TO L001-FED-8-DATE-9. DTSBR120 00263 SET L001-FROM-FED-8 TO TRUE. DTSBR120 00264 PERFORM S001-DATE THRU S001-EXIT. DTSBR120 00265 MOVE L001-SLASH-DATE TO WS-BEGIN-LIAB-DATE. DTSBR120 00266 DTSBR120 00267 MOVE R120-END-LIAB-DATE TO L001-FED-8-DATE-9. DTSBR120 00268 SET L001-FROM-FED-8 TO TRUE. DTSBR120 00269 PERFORM S001-DATE THRU S001-EXIT. DTSBR120 00270 MOVE L001-SLASH-DATE TO WS-END-LIAB-DATE. DTSBR120 00271 DTSBR120 00272 OPEN OUTPUT PRT-FILE. DTSBR120 00273 MOVE LRCM-SYS-DATE TO HDR1-LRCM-SYS-DATE. DTSBR120 00274 MOVE LRCM-SYS-TIME TO HDR2-LRCM-SYS-TIME. DTSBR120 00275 MOVE SPACES TO PRT-RECORD. DTSBR120 00276 DTSBR120 00277 OPEN INPUT CHG-PARM-FILE. DTSBR120 00278 IF NOT CHG-PARM-FILE-OK-88 DTSBR120 00279 DISPLAY 'PARM5 FILE OPEN ERROR: ' CHG-PARM-STATUS DTSBR120 00280 PERFORM S999-ABEND THRU S999-EXIT. DTSBR120 00281 DTSBR120 00282 READ CHG-PARM-FILE. DTSBR120 00283 IF NOT CHG-PARM-FILE-OK-88 DTSBR120 00284 DISPLAY 'PARM FILE READ ERROR: ' CHG-PARM-STATUS DTSBR120 00285 PERFORM S999-ABEND THRU S999-EXIT. DTSBR120 00286 DTSBR120 00287 MOVE CHG3-BEGIN-DATE TO L001-FED-8-DATE-9. DTSBR120 00288 SET L001-FROM-FED-8 TO TRUE. DTSBR120 00289 PERFORM S001-DATE THRU S001-EXIT. DTSBR120 00290 MOVE L001-SLASH-DATE TO WS-BEGIN-CHRG-DATE. DTSBR120 00291 DTSBR120 00292 MOVE CHG3-END-DATE TO L001-FED-8-DATE-9. DTSBR120 00293 SET L001-FROM-FED-8 TO TRUE. DTSBR120 00294 PERFORM S001-DATE THRU S001-EXIT. DTSBR120 00295 MOVE L001-SLASH-DATE TO WS-END-CHRG-DATE. DTSBR120 00296 DTSBR120 00297 CLOSE CHG-PARM-FILE. DTSBR120 00298 DTSBR120 00299 I1000-EXIT. DTSBR120 00300 EXIT. DTSBR120 00301 EJECT DTSBR120 00302 P1000-PROCESS. DTSBR120 00303 DTSBR120 00304 MOVE R120-OLDEST-LIAB-DATE TO L001-FED-8-DATE-9. DTSBR120 00305 SET L001-FROM-FED-8 TO TRUE. DTSBR120 00306 PERFORM S001-DATE THRU S001-EXIT. DTSBR120 00307 MOVE L001-SLASH-DATE TO WS-OLDEST-LIAB-DATE. DTSBR120 00308 MOVE R120-EMP-NO TO WS-EMP-NO. DTSBR120 00309 MOVE R120-PRIMARY-NAME TO WS-PRIMARY-NAME. DTSBR120 00310 MOVE R120-BENEFIT-CHARGES TO WS-BENEFIT-CHARGES. DTSBR120 00311 MOVE R120-PAID-AMT TO WS-PAID-AMT. DTSBR120 00312 DTSBR120 00313 PERFORM P2000-PRINT-HEADER THRU P2000-EXIT. DTSBR120 00314 WRITE PRT-RECORD FROM DETAIL-LINE-15 AFTER 1. DTSBR120 00315 ADD 1 TO WS-LINE-CNT2. DTSBR120 00316 ADD +1 TO WS-NUMBER-ONE. DTSBR120 00317 DTSBR120 00318 P1000-EXIT. DTSBR120 00319 EXIT. DTSBR120 00320 EJECT DTSBR120 00321 DTSBR120 00322 P2000-PRINT-HEADER. DTSBR120 00323 IF WS-LINE-CNT GREATER 55 OR DTSBR120 00324 WS-LINE-CNT2 GREATER 55 DTSBR120 00325 MOVE +0 TO WS-LINE-CNT DTSBR120 00326 MOVE +0 TO WS-LINE-CNT2 DTSBR120 00327 ADD +1 TO WS-PAGE-CNT DTSBR120 00328 MOVE WS-PAGE-CNT TO HDR3-PAGE DTSBR120 00329 WRITE PRT-RECORD FROM HEADER-1 AFTER TOP-OF-PAGE DTSBR120 00330 WRITE PRT-RECORD FROM HEADER-2 AFTER 1 DTSBR120 00331 WRITE PRT-RECORD FROM HEADER-3 AFTER 1 DTSBR120 00332 WRITE PRT-RECORD FROM HEADER-4 AFTER 1 DTSBR120 00333 WRITE PRT-RECORD FROM HEADER-5 AFTER 1 DTSBR120 00334 WRITE PRT-RECORD FROM HEADER-6 AFTER 1 DTSBR120 00335 WRITE PRT-RECORD FROM HEADER-7 AFTER 1 DTSBR120 00336 WRITE PRT-RECORD FROM HEADER-8 AFTER 1 DTSBR120 00337 WRITE PRT-RECORD FROM HEADER-9 AFTER 1 DTSBR120 00338 WRITE PRT-RECORD FROM HEADER-10 AFTER 1 DTSBR120 00339 WRITE PRT-RECORD FROM HEADER-11 AFTER 1 DTSBR120 00340 WRITE PRT-RECORD FROM HEADER-12 AFTER 1 DTSBR120 00341 WRITE PRT-RECORD FROM HEADER-13 AFTER 1 DTSBR120 00342 WRITE PRT-RECORD FROM HEADER-14 AFTER 1 DTSBR120 00343 ADD +14 TO WS-LINE-CNT2. DTSBR120 00344 P2000-EXIT. DTSBR120 00345 EXIT. DTSBR120 00346 T1000-TERMINATE. DTSBR120 00347 DTSBR120 00348 IF WS-LINE-CNT2 > 52 DTSBR120 00349 PERFORM P2000-PRINT-HEADER THRU P2000-EXIT DTSBR120 00350 END-IF. DTSBR120 00351 MOVE WS-NUMBER-ONE TO WS-FOOTING-CNT. DTSBR120 00352 WRITE PRT-RECORD FROM FOOTING-LINE-1 AFTER 1. DTSBR120 00353 WRITE PRT-RECORD FROM FOOTING-LINE-2 AFTER 1. DTSBR120 00354 WRITE PRT-RECORD FROM FOOTING-LINE-3 AFTER 1. DTSBR120 00355 WRITE PRT-RECORD FROM FOOTING-LINE-4 AFTER 1. DTSBR120 00356 WRITE PRT-RECORD FROM FOOTING-LINE-5 AFTER 1. DTSBR120 00357 CLOSE PRT-FILE. DTSBR120 00358 DTSBR120 00359 T1000-EXIT. DTSBR120 00360 EXIT. DTSBR120 00361 EJECT DTSBR120 00362 S001-DATE. DTSBR120 00363 DTSBR120 00364 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR120 00365 DTSBR120 00366 S001-EXIT. DTSBR120 00367 EXIT. DTSBR120 00368 DTSBR120 00369 S999-ABEND. DTSBR120 00370 DTSBR120 00371 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR120 00372 DTSBR120 00373 S999-EXIT. DTSBR120 00374 EXIT. DTSBR120