00001 IDENTIFICATION DIVISION. 04/21/20 00002 PROGRAM-ID. DTSBE120. DTSBE120 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV092 00004 MODIFIED BY TRW/BDM OCT. 1998. DTSBE120 00005 DATE-WRITTEN. AUGUST 1994. DTSBE120 00006 DATE-COMPILED. DTSBE120 00007 SKIP3 DTSBE120 00008 ***** DTSBE120 00009 * DTSBE120 00010 * CALLING SEQUENCE: DTSBD400 CALLS DTSBE120 00011 * DTSBE120 WHICH UPDATES DTSIR120 DTSBE120 00012 * DTSBR120 READS DTSIR120 RECORDS. DTSBE120 00013 * DTSBE120 00014 * FUNCTION: POTENTIALLY FICTITIOUS EMPLOYER LIST EXTRACT. DTSBE120 00015 * DTSBE120 00016 * NOTE: THE BENEFIT-CHARGE-FILE SHOULD BE SORTED IN DTSBE120 00017 * EMPLOYER NUMBER SEQUENCE PRIOR TO EXECUTING DTSBE120 00018 * THIS PROGRAM. DTSBE120 00019 * DTSBE120 00020 * MODIFICATION LOG: DTSBE120 00021 * DTSBE120 00022 * 03/10/99 MODIFIED TO MEET DUTAS PROGRAMMING SPECIFICATIONS. DTSBE120 00023 * WORK ORDER: PROGRAMMER: DVS DTSBE120 00024 * DTSBE120 00025 * 03/31/00 MODIFIED TO REFLECT NEW ESP930 REC LENGTH DTSBE120 00026 * WORK ORDER: FDB PROGRAMMER: JHP DTSBE120 00027 * DTSBE120 00028 * 10/19/99 MODIFIED TO REFLECT ACTUAL ESP930 REC LENGTH DTSBE120 00029 * WORK ORDER: FDB PROGRAMMER: JHP DTSBE120 00030 * DTSBE120 00031 * 07/30/02 MODIFIED TO READ BENEFIT CHARGE DATA FROM DTSBE120 00032 * VSAM TO CREATE A NEW DISK FILE FOR INPUT DTSBE120 00033 * RATHER THAN FROM CARTRIDGES. DTSBE120 00034 * WORK ORDER: PROGRAMMER: RW1 DTSBE120 00035 * DTSBE120 00036 * 05/14/10 RECOMPILE FOR NEW VERSION OF CHGIM004 DTSBE120 00037 * WORK ORDER: PROGRAMMER: ZL1 DTSBE120 00038 * DTSBE120 00039 * 04/18/20 RECOMPILE FOR NEW VERSION OF CHGIM004 CL*92 00040 * WORK ORDER: PUA FPUC FRUR PROGRAMMER: ZL1 CL*92 00041 * CL*92 00042 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE120 00043 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE120 00044 * WORK ORDER: PROGRAMMER: XXX DTSBE120 00045 * DTSBE120 00046 * DTSBE120 00047 * DESCRIPTION: DTSBE120 00048 * DTSBE120 00049 * DTSBE120 00050 * INITIATION: DTSBE120 00051 * DTSBE120 00052 * SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE120 00053 * SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE120 00054 * DTSBE120 00055 * EDIT AND DEFAULT PARAMETERS. SEE PRINTED OUTPUTS DTSBE120 00056 * DESCRIPTIONS AND LAYOUTS (120R1). DTSBE120 00057 * DTSBE120 00058 * OPEN THE BENEFIT CHARGE FILE FOR READ ONLY ACCESS. DTSBE120 00059 * DTSBE120 00060 * DTSBE120 00061 * DTSBE120 00062 * PROCESSING: DTSBE120 00063 * DTSBE120 00064 * SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (120R1). DTSBE120 00065 * DTSBE120 00066 * DTSBE120 00067 * TERMINATION: DTSBE120 00068 * DTSBE120 00069 * CLOSE THE BENEFIT CHARGE FILE. DTSBE120 00070 * DTSBE120 00071 * DTSBE120 00072 * RECORDS READ: DTSBE120 00073 * DTSBE120 00074 * MASTER: DTSBE120 00075 * DTSBE120 00076 * MSOL DTSBE120 00077 * MREL DTSBE120 00078 * MQTR DTSBE120 00079 * DTSBE120 00080 * DTSBE120 00081 * ALTERNATE INDEX: DTSBE120 00082 * DTSBE120 00083 * IPES. DTSBE120 00084 * DTSBE120 00085 * DTSBE120 00086 * REFERENCE: DTSBE120 00087 * DTSBE120 00088 * NONE. DTSBE120 00089 * DTSBE120 00090 * DTSBE120 00091 * RECORDS UPDATED: DTSBE120 00092 * DTSBE120 00093 * NONE. DTSBE120 00094 * DTSBE120 00095 * DTSBE120 00096 * REPORT RECORDS WRITTEN: DTSBE120 00097 * DTSBE120 00098 * R120 POTENTIALLY FICTITIOUS EMPLOYER LIST. DTSBE120 00099 * DTSBE120 00100 * DTSBE120 00101 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE120 00102 * DTSBE120 00103 * NONE. DTSBE120 00104 * DTSBE120 00105 * DTSBE120 00106 * MODULES CALLED: DTSBE120 00107 * DTSBE120 00108 * DTSBU001 DATE CONVERSION/EDIT. DTSBE120 00109 * DTSBU910 MASTER FILE I/O. DTSBE120 00110 * DTSBU921 ALTERNATE INDEX FILE I/O. DTSBE120 00111 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. DTSBE120 00112 * DTSBE120 00113 * DTSBE120 00114 * VERMONT REFERENCE: DTSBE120 00115 * DTSBE120 00116 * TXBE307 DTSBE120 00117 * DTSBE120 00118 ***** DTSBE120 00119 SKIP3 DTSBE120 00120 ENVIRONMENT DIVISION. DTSBE120 00121 SKIP3 DTSBE120 00122 INPUT-OUTPUT SECTION. DTSBE120 00123 SKIP2 DTSBE120 00124 FILE-CONTROL. DTSBE120 00125 SELECT BENEFIT-CHARGE-FILE ASSIGN TO CHGFILE DTSBE120 00126 ** ACCESS IS SEQUENTIAL DTSBE120 00127 FILE STATUS IS FILE-STATUS. DTSBE120 00128 DTSBE120 00129 DATA DIVISION. DTSBE120 00130 SKIP3 DTSBE120 00131 FILE SECTION. DTSBE120 00132 SKIP3 DTSBE120 00133 FD BENEFIT-CHARGE-FILE DTSBE120 00134 * RECORDING MODE IS V DTSBE120 00135 * BLOCK CONTAINS 0 RECORDS. DTSBE120 00136 * SKIP1 DTSBE120 00137 RECORDING MODE IS F DTSBE120 00138 LABEL RECORDS ARE STANDARD DTSBE120 00139 BLOCK CONTAINS 0 CHARACTERS. DTSBE120 00140 SKIP1 DTSBE120 00141 01 CHARGE-IN-REC PIC X(388). DTSBE120 00142 DTSBE120 00143 WORKING-STORAGE SECTION. DTSBE120 001435 77 PAN-VALET PICTURE X(24) VALUE '092DTSBE120 04/21/20'. DTSBE120 00144 SKIP3 DTSBE120 00145 01 WRK-AREA. DTSBE120 00146 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +120.DTSBE120 00147 SKIP1 DTSBE120 00148 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE120'.DTSBE120 00149 SKIP3 DTSBE120 00150 05 FILE-STATUS PIC X(02). DTSBE120 00151 88 FILE-OK-88 VALUE '00'. DTSBE120 00152 88 FILE-NO-REC-88 VALUE '10' '23'. DTSBE120 00153 88 FILE-VERIFY-88 VALUE '97'. DTSBE120 00154 SKIP3 DTSBE120 00155 05 ABEND-MSG PIC X(60). DTSBE120 00156 SKIP3 DTSBE120 00157 05 WRK-PARM-START-LIAB-DATE PIC S9(09) COMP-3. DTSBE120 00158 SKIP1 DTSBE120 00159 05 WRK-PARM-END-LIAB-DATE PIC S9(09) COMP-3. DTSBE120 00160 SKIP1 DTSBE120 00161 05 BENEFIT-CHARGE-FILE-OPEN-IND PIC X(01). DTSBE120 00162 SKIP3 DTSBE120 00163 05 WRK-BYPASS-IND PIC X(01). DTSBE120 00164 88 WRK-BYPASS-YES-88 VALUE 'Y'. DTSBE120 00165 88 WRK-BYPASS-NO-88 VALUE 'N'. DTSBE120 00166 DTSBE120 00167 05 WRK-SAME-EMP-IND PIC X(1). DTSBE120 00168 88 WRK-SAME-EMP-88 VALUE 'Y'. DTSBE120 00169 88 WRK-NOT-SAME-EMP-88 VALUE 'N'. DTSBE120 00170 SKIP1 DTSBE120 00171 05 WRK-DELINQUENT-QTR-CNT PIC S9(03) COMP-3. DTSBE120 00172 DTSBE120 00173 05 WRK-PARM-EMPL-MAX PIC S9(03) COMP-3. DTSBE120 00174 DTSBE120 00175 05 WRK-MAX-EMPLOYEES PIC S9(03) COMP-3. DTSBE120 00176 SKIP3 DTSBE120 00177 SKIP1 DTSBE120 00178 05 WRK-TAX-PAID-AMT PIC S9(09)V9(02) COMP-3.DTSBE120 00179 SKIP1 DTSBE120 00180 05 WRK-BEN-CHARGE-AMT PIC S9(09)V9(02) COMP-3.DTSBE120 00181 SKIP1 DTSBE120 00182 05 WRK-QTR-TOT-BALANCE-AMT PIC S9(09)V9(02) COMP-3.DTSBE120 00183 SKIP1 DTSBE120 00184 05 WRK-EMP-FIRST-LIAB-DATE PIC S9(09) COMP-3 VALUE 0. DTSBE120 00185 SKIP1 DTSBE120 00186 EJECT DTSBE120 00187 01 L001-LINK-AREA. DTSBE120 00188 ++INCLUDE DTSIL001 DTSBE120 00189 EJECT DTSBE120 00190 01 L910-LINK-AREA. DTSBE120 00191 ++INCLUDE DTSIL910 DTSBE120 00192 SKIP3 DTSBE120 00193 01 MSKL-REC. DTSBE120 00194 ++INCLUDE DTSIMSKL DTSBE120 00195 SKIP3 DTSBE120 00196 01 MSOL-REC. DTSBE120 00197 ++INCLUDE DTSIMSOL DTSBE120 00198 EJECT DTSBE120 00199 01 MREL-REC. DTSBE120 00200 ++INCLUDE DTSIMREL DTSBE120 00201 EJECT DTSBE120 00202 01 MQTR-REC. DTSBE120 00203 ++INCLUDE DTSIMQTR DTSBE120 00204 EJECT DTSBE120 00205 01 L921-LINK-AREA. DTSBE120 00206 ++INCLUDE DTSIL921 DTSBE120 00207 SKIP3 DTSBE120 00208 01 ISKL-REC. DTSBE120 00209 ++INCLUDE DTSIISKL DTSBE120 00210 SKIP3 DTSBE120 00211 01 IPES-REC. DTSBE120 00212 ++INCLUDE DTSIIPES DTSBE120 00213 EJECT DTSBE120 00214 01 R120-REC. DTSBE120 00215 ++INCLUDE DTSIR120 DTSBE120 00216 EJECT DTSBE120 00217 *****************++INCLUDE ESPRPT04 DTSBE120 00218 *01 FILLER REDEFINES CHARGE-REC. DTSBE120 00219 * 05 FILLER PIC X(04). DTSBE120 00220 *01 CHARGE-REC-W. DTSBE120 00221 **** 03/31/00 JHP/CHGED TO REFLECT NEW REC LNGTH DTSBE120 00222 **** 10/19/99 JHP/CHGED TO REFLECT REAL REC LNGTH DTSBE120 00223 * 05 WRK-CHARGE-REC. DTSBE120 00224 * 10 WRK-REC-TYPE PIC 9(2). DTSBE120 00225 * 10 WRK-EMPL-ACCT PIC 9(6). DTSBE120 00226 * DTSBE120 00227 * 10 WRK-KEY. DTSBE120 00228 * 15 WRK-SSN PIC 9(9). DTSBE120 00229 * 15 WRK-SSN-SEQ PIC 9(1). DTSBE120 00230 * 10 WRK-CODE PIC 9(1). DTSBE120 00231 * 10 WRK-DATE PIC 9(8). DTSBE120 00232 * 10 WRK-SHAREABLE-IND PIC 9(1). DTSBE120 00233 * 10 WRK-PROG-NAME PIC X(6). DTSBE120 00234 * 10 WRK-PAY-TYPE-BEN PIC X(2). DTSBE120 00235 * 05 WRK-BWE-DATE PIC 9(8). DTSBE120 00236 * DTSBE120 00237 * 05 WRK-TRAN-ID PIC X(2). DTSBE120 00238 * DTSBE120 00239 * 05 WRK-OPER-ID PIC X(8). DTSBE120 00240 * DTSBE120 00241 * 05 WRK-TOT-AMT PIC S9(8)V99. DTSBE120 00242 * DTSBE120 00243 * 05 WRK-CURR-AMT PIC S9(8)V99. DTSBE120 00244 * DTSBE120 00245 * 05 WRK-BYE-DATE PIC 9(8). DTSBE120 00246 * DTSBE120 00247 * 05 WRK-SUPP-CODE PIC X(1). DTSBE120 00248 * 05 WRK-PAY-TYPE PIC X(1). DTSBE120 00249 * DTSBE120 00250 * 05 WRK-NAME PIC X(32). DTSBE120 00251 * DTSBE120 00252 * 05 WRK-EMPLOYER-TYPE PIC 9(2). DTSBE120 00253 * DTSBE120 00254 * 05 WRK-REG-ADJ-CHECK PIC 9(02). DTSBE120 00255 * DTSBE120 00256 * 05 WRK-FILLER-ONE PIC X(16). DTSBE120 00257 DTSBE120 00258 01 CHARGE-REC-IN. DTSBE120 00259 ++INCLUDE CHGIM004 DTSBE120 00260 DTSBE120 00261 EJECT DTSBE120 00262 LINKAGE SECTION. DTSBE120 00263 SKIP3 DTSBE120 00264 01 LECM-LINK-AREA. DTSBE120 00265 ++INCLUDE DTSILECM DTSBE120 00266 SKIP3 DTSBE120 00267 10 LECM-PARM-AREA REDEFINES LECM-EXTRACT-PARMS. DTSBE120 00268 15 LECM-PARM-START-LIAB-DATE PIC X(06). DTSBE120 00269 15 FILLER PIC X(01). DTSBE120 00270 15 LECM-PARM-END-LIAB-DATE PIC X(06). DTSBE120 00271 15 FILLER PIC X(01). DTSBE120 00272 15 LECM-PARM-EMPL-MAX PIC X(03). DTSBE120 00273 15 LECM-PARM-EMPL-MAX-N REDEFINES DTSBE120 00274 LECM-PARM-EMPL-MAX PIC 9(03). DTSBE120 00275 15 FILLER PIC X(51). DTSBE120 00276 EJECT DTSBE120 00277 01 MPRF-LINK-REC. DTSBE120 00278 ++INCLUDE DTSIMPRF DTSBE120 00279 EJECT DTSBE120 00280 ************************************************************** DTSBE120 00281 * CONTROL PARAGRAPH FOR DTSBE120 - REPORT EXTRACT FOR DTSBE120 00282 * POTENTIALLY FICTITIOUS EMPLOYER LIST. DTSBE120 00283 ************************************************************** DTSBE120 00284 DTSBE120 00285 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE120 00286 MPRF-LINK-REC. DTSBE120 00287 SKIP2 DTSBE120 00288 IF LECM-PROCESS-88 DTSBE120 00289 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE120 00290 ELSE DTSBE120 00291 IF LECM-INITIALIZE-88 DTSBE120 00292 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE120 00293 ELSE DTSBE120 00294 IF LECM-TERMINATE-88 DTSBE120 00295 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE120 00296 ELSE DTSBE120 00297 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE120 00298 TO ABEND-MSG DTSBE120 00299 PERFORM S999-ABEND THRU S999-EXIT. DTSBE120 00300 SKIP2 DTSBE120 00301 GOBACK. DTSBE120 00302 EJECT DTSBE120 00303 ************************************************************** DTSBE120 00304 * THIS PARAGRAPH CONTROLS THE INITIATION PROCESS. DTSBE120 00305 ************************************************************** DTSBE120 00306 DTSBE120 00307 I0000-INITIALIZE. DTSBE120 00308 SKIP2 DTSBE120 00309 MOVE LENGTH OF R120-REC TO R120-LENGTH. DTSBE120 00310 MOVE '120' TO R120-REC-TYPE. DTSBE120 00311 MOVE LECM-TRACE-IND TO L910-TRACE-IND DTSBE120 00312 L921-TRACE-IND. DTSBE120 00313 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBE120 00314 L921-MOD-NAME. DTSBE120 00315 DTSBE120 00316 PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT. DTSBE120 00317 SKIP1 DTSBE120 00318 SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE120 00319 SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE120 00320 SKIP1 DTSBE120 00321 MOVE 'N' TO BENEFIT-CHARGE-FILE-OPEN-IND. DTSBE120 00322 * DTSBE120 00323 INITIALIZE CHARGE-REC-IN. DTSBE120 00324 * DTSBE120 00325 SKIP2 DTSBE120 00326 I0000-EXIT. DTSBE120 00327 EXIT. DTSBE120 00328 SKIP3 DTSBE120 00329 ************************************************************** DTSBE120 00330 * THIS PARAGRAPH CONTROLS THE EDIT OF THE INPUT PARMS. DTSBE120 00331 ************************************************************** DTSBE120 00332 DTSBE120 00333 I1000-EDIT-AND-DEFAULT-PARMS. DTSBE120 00334 DTSBE120 00335 PERFORM I1100-START-LIAB-DATE THRU I1100-EXIT. DTSBE120 00336 DTSBE120 00337 PERFORM I1200-END-LIAB-DATE THRU I1200-EXIT. DTSBE120 00338 DTSBE120 00339 PERFORM I1300-EMPL-CNT-MAX THRU I1300-EXIT. DTSBE120 00340 I1000-EXIT. DTSBE120 00341 EXIT. DTSBE120 00342 EJECT DTSBE120 00343 *************************************************************** DTSBE120 00344 * THIS PARAGRAPH EDITS THE BEGINNING LIABILITY DATE PARM. DTSBE120 00345 * IF PARM IS NOT ENTERED DEFAULT IS 540 DAYS PRIOR TO DTSBE120 00346 * PRIOR RUN DATE. DTSBE120 00347 *************************************************************** DTSBE120 00348 DTSBE120 00349 I1100-START-LIAB-DATE. DTSBE120 00350 DTSBE120 00351 IF LECM-PARM-START-LIAB-DATE = SPACES DTSBE120 00352 MOVE LECM-PRIOR-RUN-DATE TO L001-FED-8-DATE-9 DTSBE120 00353 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBE120 00354 SUBTRACT 540 FROM L001-JUL-ABS-DAY DTSBE120 00355 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT DTSBE120 00356 MOVE L001-FED-8-DATE-9 TO WRK-PARM-START-LIAB-DATE DTSBE120 00357 ELSE DTSBE120 00358 MOVE LECM-PARM-START-LIAB-DATE TO L001-CAL-6-DATE-X DTSBE120 00359 PERFORM S001-FROM-CAL-6 THRU S001-EXIT DTSBE120 00360 IF L001-VALID-DATE DTSBE120 00361 MOVE L001-FED-8-DATE-9 TO WRK-PARM-START-LIAB-DATE DTSBE120 00362 ELSE DTSBE120 00363 MOVE 'START-LIAB-DATE NOT VALID' DTSBE120 00364 TO ABEND-MSG DTSBE120 00365 PERFORM S999-ABEND THRU S999-EXIT. DTSBE120 00366 I1100-EXIT. DTSBE120 00367 EXIT. DTSBE120 00368 EJECT DTSBE120 00369 *************************************************************** DTSBE120 00370 * THIS PARAGRAPH EDITS THE ENDING LIABILITY DATE PARM. DTSBE120 00371 * IF PARM IS NOT ENTERED DEFAULT IS 180 DAYS PRIOR TO DTSBE120 00372 * PRIOR RUN DATE. DTSBE120 00373 *************************************************************** DTSBE120 00374 DTSBE120 00375 I1200-END-LIAB-DATE. DTSBE120 00376 DTSBE120 00377 IF LECM-PARM-END-LIAB-DATE = SPACES DTSBE120 00378 MOVE LECM-PRIOR-RUN-DATE TO L001-FED-8-DATE-9 DTSBE120 00379 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBE120 00380 SUBTRACT 180 FROM L001-JUL-ABS-DAY DTSBE120 00381 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT DTSBE120 00382 MOVE L001-FED-8-DATE-9 TO WRK-PARM-END-LIAB-DATE DTSBE120 00383 ELSE DTSBE120 00384 MOVE LECM-PARM-END-LIAB-DATE TO L001-CAL-6-DATE-X DTSBE120 00385 PERFORM S001-FROM-CAL-6 THRU S001-EXIT DTSBE120 00386 IF L001-VALID-DATE DTSBE120 00387 MOVE L001-FED-8-DATE-9 TO WRK-PARM-END-LIAB-DATE DTSBE120 00388 ELSE DTSBE120 00389 MOVE 'END-LIAB-DATE NOT VALID' DTSBE120 00390 TO ABEND-MSG DTSBE120 00391 PERFORM S999-ABEND THRU S999-EXIT. DTSBE120 00392 DTSBE120 00393 IF WRK-PARM-START-LIAB-DATE > WRK-PARM-END-LIAB-DATE DTSBE120 00394 MOVE 'START-LIAB-DATE GREATER THAN END-LIAB-DATE' DTSBE120 00395 TO ABEND-MSG DTSBE120 00396 PERFORM S999-ABEND THRU S999-EXIT. DTSBE120 00397 I1200-EXIT. DTSBE120 00398 EXIT. DTSBE120 00399 EJECT DTSBE120 00400 *************************************************************** DTSBE120 00401 * THIS PARAGRAPH EDITS THE MAXIMUM NUMBER OF EMPLOYEES PARM. DTSBE120 00402 * IF PARM IS NOT ENTERED, DEFAULT IS 10. DTSBE120 00403 *************************************************************** DTSBE120 00404 DTSBE120 00405 I1300-EMPL-CNT-MAX. DTSBE120 00406 DTSBE120 00407 IF LECM-PARM-EMPL-MAX = SPACES DTSBE120 00408 MOVE +10 TO WRK-PARM-EMPL-MAX DTSBE120 00409 ELSE DTSBE120 00410 IF (LECM-PARM-EMPL-MAX NUMERIC) DTSBE120 00411 AND DTSBE120 00412 (LECM-PARM-EMPL-MAX-N > +0) DTSBE120 00413 MOVE LECM-PARM-EMPL-MAX-N TO WRK-PARM-EMPL-MAX DTSBE120 00414 ELSE DTSBE120 00415 MOVE 'EMPL-MAX NOT VALID' TO ABEND-MSG DTSBE120 00416 PERFORM S999-ABEND THRU S999-EXIT. DTSBE120 00417 I1300-EXIT. DTSBE120 00418 EXIT. DTSBE120 00419 EJECT DTSBE120 00420 *************************************************************** DTSBE120 00421 * THIS IS THE PROCESS PARAGRAPH FOR THE POTENTIALLY DTSBE120 00422 * FICTITIOUS EMPLOYER LIST. DTSBE120 00423 *************************************************************** DTSBE120 00424 DTSBE120 00425 P0000-PROCESS. DTSBE120 00426 DTSBE120 00427 IF BENEFIT-CHARGE-FILE-OPEN-IND = 'N' DTSBE120 00428 OPEN INPUT BENEFIT-CHARGE-FILE DTSBE120 00429 DISPLAY 'CHRG-FILE STATUS = ', FILE-STATUS DTSBE120 00430 IF FILE-OK-88 DTSBE120 00431 MOVE 'Y' TO BENEFIT-CHARGE-FILE-OPEN-INDDTSBE120 00432 ELSE DTSBE120 00433 MOVE 'BENEFIT CHARGE FILE OPEN FAILED' DTSBE120 00434 TO ABEND-MSG DTSBE120 00435 PERFORM S999-ABEND THRU S999-EXIT. DTSBE120 00436 DTSBE120 00437 IF MPRF-CLASS-RATED-88 DTSBE120 00438 SET WRK-BYPASS-NO-88 TO TRUE DTSBE120 00439 ELSE DTSBE120 00440 GO TO P0000-EXIT. DTSBE120 00441 DTSBE120 00442 PERFORM P1000-CHECK-IF-SUCC-EMPLR THRU P1000-EXIT. DTSBE120 00443 DTSBE120 00444 IF WRK-BYPASS-YES-88 DTSBE120 00445 GO TO P0000-EXIT. DTSBE120 00446 DTSBE120 00447 DTSBE120 00448 PERFORM P2000-CHECK-IF-PRED-EMPLR THRU P2000-EXIT. DTSBE120 00449 DTSBE120 00450 IF WRK-BYPASS-YES-88 DTSBE120 00451 GO TO P0000-EXIT. DTSBE120 00452 DTSBE120 00453 DTSBE120 00454 MOVE LOW-VALUES TO MSOL-KEY-AREA. DTSBE120 00455 SET MSOL-SOL-88 TO TRUE. DTSBE120 00456 MOVE MPRF-EMP-NO TO MSOL-EMP-NO. DTSBE120 00457 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. DTSBE120 00458 DTSBE120 00459 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE120 00460 DTSBE120 00461 IF L910-OK-88 DTSBE120 00462 PERFORM P3000-CHECK-MSOL THRU P3000-EXIT DTSBE120 00463 ELSE DTSBE120 00464 SET WRK-BYPASS-YES-88 TO TRUE. DTSBE120 00465 DTSBE120 00466 IF WRK-BYPASS-YES-88 DTSBE120 00467 GO TO P0000-EXIT. DTSBE120 00468 DTSBE120 00469 MOVE ZERO TO WRK-MAX-EMPLOYEES DTSBE120 00470 WRK-DELINQUENT-QTR-CNT DTSBE120 00471 WRK-TAX-PAID-AMT DTSBE120 00472 WRK-BEN-CHARGE-AMT. DTSBE120 00473 DTSBE120 00474 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE120 00475 SET MQTR-QTR-88 TO TRUE. DTSBE120 00476 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE120 00477 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE120 00478 DTSBE120 00479 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE120 00480 DTSBE120 00481 PERFORM P4000-SCAN-MQTR THRU P4000-EXIT DTSBE120 00482 UNTIL L910-NO-REC-88 OR DTSBE120 00483 WRK-BYPASS-YES-88. DTSBE120 00484 SKIP3 DTSBE120 00485 IF WRK-BYPASS-YES-88 DTSBE120 00486 GO TO P0000-EXIT. DTSBE120 00487 DTSBE120 00488 IF FILE-NO-REC-88 DTSBE120 00489 GO TO P0000-EXIT. DTSBE120 00490 DTSBE120 00491 PERFORM P5000-START-BENEFIT-FILE THRU P5000-EXIT. DTSBE120 00492 DTSBE120 00493 PERFORM P6000-ACCUM-BENEFIT-CHGS THRU P6000-EXIT DTSBE120 00494 UNTIL WRK-NOT-SAME-EMP-88. DTSBE120 00495 DTSBE120 00496 IF WRK-BEN-CHARGE-AMT GREATER THAN WRK-TAX-PAID-AMT DTSBE120 00497 PERFORM P7000-SETUP-R120 THRU P7000-EXIT DTSBE120 00498 PERFORM S946-WRITE-R120 THRU S946-EXIT. DTSBE120 00499 DTSBE120 00500 P0000-EXIT. DTSBE120 00501 EXIT. DTSBE120 00502 EJECT DTSBE120 00503 ************************************************************** DTSBE120 00504 * THIS PARAGRAPH CHECKS TO SEE IF THE EMPLOYER IS A DTSBE120 00505 * SUCCESSOR EMPLOYER. DTSBE120 00506 ************************************************************** DTSBE120 00507 DTSBE120 00508 P1000-CHECK-IF-SUCC-EMPLR. DTSBE120 00509 DTSBE120 00510 MOVE LOW-VALUES TO MREL-KEY-AREA. DTSBE120 00511 MOVE MPRF-EMP-NO TO MREL-EMP-NO. DTSBE120 00512 SET MREL-REL-88 TO TRUE. DTSBE120 00513 MOVE MREL-KEY-AREA TO MSKL-KEY-AREA. DTSBE120 00514 DTSBE120 00515 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE120 00516 DTSBE120 00517 IF L910-NO-REC-88 DTSBE120 00518 NEXT SENTENCE DTSBE120 00519 ELSE DTSBE120 00520 SET WRK-BYPASS-YES-88 TO TRUE. DTSBE120 00521 DTSBE120 00522 P1000-EXIT. DTSBE120 00523 EXIT. DTSBE120 00524 SKIP3 DTSBE120 00525 ************************************************************** DTSBE120 00526 * THIS PARAGRAPH CHECKS TO SEE IF THE EMPLOYER IS A DTSBE120 00527 * PREDECESSOR EMPLOYER. DTSBE120 00528 ************************************************************** DTSBE120 00529 DTSBE120 00530 P2000-CHECK-IF-PRED-EMPLR. DTSBE120 00531 DTSBE120 00532 MOVE LOW-VALUES TO IPES-KEY-AREA. DTSBE120 00533 MOVE MPRF-EMP-NO TO IPES-PRED-EMP-NO. DTSBE120 00534 SET IPES-PES-88 TO TRUE. DTSBE120 00535 MOVE IPES-KEY-AREA TO ISKL-KEY-AREA. DTSBE120 00536 DTSBE120 00537 PERFORM S921-START-BROWSE THRU S921-EXIT. DTSBE120 00538 DTSBE120 00539 IF L921-NO-REC-88 DTSBE120 00540 GO TO P2000-EXIT. DTSBE120 00541 DTSBE120 00542 MOVE ISKL-REC TO IPES-REC. DTSBE120 00543 DTSBE120 00544 IF IPES-PRED-EMP-NO EQUAL MPRF-EMP-NO DTSBE120 00545 SET WRK-BYPASS-YES-88 TO TRUE. DTSBE120 00546 DTSBE120 00547 P2000-EXIT. DTSBE120 00548 EXIT. DTSBE120 00549 EJECT DTSBE120 00550 ************************************************************** DTSBE120 00551 * THIS PARAGRAPH CHECKS THE FIRST OCCURRENCE OF THE MSOL DTSBE120 00552 * RECORD TO DETERMINE IF INITIAL LIABILITY DATE WAS WITHIN DTSBE120 00553 * THE PARM DATES. DTSBE120 00554 ************************************************************** DTSBE120 00555 DTSBE120 00556 P3000-CHECK-MSOL. DTSBE120 00557 DTSBE120 00558 MOVE MSKL-REC TO MSOL-REC. DTSBE120 00559 DTSBE120 00560 IF MSOL-LIAB-DATE LESS THAN WRK-PARM-START-LIAB-DATE OR DTSBE120 00561 MSOL-LIAB-DATE GREATER THAN WRK-PARM-END-LIAB-DATE DTSBE120 00562 SET WRK-BYPASS-YES-88 TO TRUE DTSBE120 00563 ELSE DTSBE120 00564 MOVE MSOL-LIAB-DATE TO WRK-EMP-FIRST-LIAB-DATE. DTSBE120 00565 DTSBE120 00566 P3000-EXIT. DTSBE120 00567 EXIT. DTSBE120 00568 EJECT DTSBE120 00569 ************************************************************** DTSBE120 00570 * THIS PARAGRAPH PROCESSES THE MQTR RECORDS. DTSBE120 00571 ************************************************************** DTSBE120 00572 DTSBE120 00573 P4000-SCAN-MQTR. DTSBE120 00574 DTSBE120 00575 MOVE MSKL-REC TO MQTR-REC. DTSBE120 00576 DTSBE120 00577 PERFORM P4100-PROCESS-MQTR THRU P4100-EXIT. DTSBE120 00578 DTSBE120 00579 IF WRK-BYPASS-YES-88 DTSBE120 00580 GO TO P4000-EXIT. DTSBE120 00581 DTSBE120 00582 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE120 00583 DTSBE120 00584 P4000-EXIT. DTSBE120 00585 EXIT. DTSBE120 00586 EJECT DTSBE120 00587 ************************************************************** DTSBE120 00588 * THIS PARAGRAPH ACCUMULATES THE TOTAL TAXES PAID AND DTSBE120 00589 * DETERMINES THE MAXIMUM NUMBER OF EMPLOYEES, AND DTSBE120 00590 * WHETHER AMOUNTS ARE DUE IN MORE THAN ONE QUARTER. DTSBE120 00591 ************************************************************** DTSBE120 00592 DTSBE120 00593 P4100-PROCESS-MQTR. DTSBE120 00594 DTSBE120 00595 MOVE ZERO TO WRK-QTR-TOT-BALANCE-AMT. DTSBE120 00596 DTSBE120 00597 PERFORM DTSBE120 00598 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBE120 00599 UNTIL MQTR-ACCT-IDX GREATER THAN MQTR-ACCT-CNT DTSBE120 00600 DTSBE120 00601 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE120 00602 TO WRK-QTR-TOT-BALANCE-AMT DTSBE120 00603 DTSBE120 00604 IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX) DTSBE120 00605 COMPUTE WRK-TAX-PAID-AMT = DTSBE120 00606 WRK-TAX-PAID-AMT + DTSBE120 00607 MQTR-PAID-AMT (MQTR-ACCT-IDX) DTSBE120 00608 END-IF DTSBE120 00609 END-PERFORM. DTSBE120 00610 DTSBE120 00611 IF (WRK-QTR-TOT-BALANCE-AMT GREATER THAN ZERO) OR DTSBE120 00612 (MQTR-CURR-MISSING-88) DTSBE120 00613 ADD +1 TO WRK-DELINQUENT-QTR-CNT. DTSBE120 00614 DTSBE120 00615 IF WRK-DELINQUENT-QTR-CNT GREATER THAN +1 DTSBE120 00616 SET WRK-BYPASS-YES-88 TO TRUE DTSBE120 00617 GO TO P4100-EXIT. DTSBE120 00618 DTSBE120 00619 IF MQTR-1ST-MTH-NO-ENTRY-88 DTSBE120 00620 NEXT SENTENCE DTSBE120 00621 ELSE DTSBE120 00622 IF MQTR-1ST-MTH-EMPL-CNT GREATER THAN DTSBE120 00623 WRK-MAX-EMPLOYEES DTSBE120 00624 MOVE MQTR-1ST-MTH-EMPL-CNT DTSBE120 00625 TO WRK-MAX-EMPLOYEES. DTSBE120 00626 DTSBE120 00627 IF MQTR-2ND-MTH-NO-ENTRY-88 DTSBE120 00628 NEXT SENTENCE DTSBE120 00629 ELSE DTSBE120 00630 IF MQTR-2ND-MTH-EMPL-CNT GREATER THAN DTSBE120 00631 WRK-MAX-EMPLOYEES DTSBE120 00632 MOVE MQTR-2ND-MTH-EMPL-CNT DTSBE120 00633 TO WRK-MAX-EMPLOYEES. DTSBE120 00634 DTSBE120 00635 IF MQTR-3RD-MTH-NO-ENTRY-88 DTSBE120 00636 NEXT SENTENCE DTSBE120 00637 ELSE DTSBE120 00638 IF MQTR-3RD-MTH-EMPL-CNT GREATER THAN DTSBE120 00639 WRK-MAX-EMPLOYEES DTSBE120 00640 MOVE MQTR-3RD-MTH-EMPL-CNT DTSBE120 00641 TO WRK-MAX-EMPLOYEES. DTSBE120 00642 DTSBE120 00643 IF WRK-MAX-EMPLOYEES GREATER THAN WRK-PARM-EMPL-MAX DTSBE120 00644 SET WRK-BYPASS-YES-88 TO TRUE DTSBE120 00645 GO TO P4100-EXIT. DTSBE120 00646 DTSBE120 00647 P4100-EXIT. DTSBE120 00648 EXIT. DTSBE120 00649 EJECT DTSBE120 00650 ************************************************************** DTSBE120 00651 * THIS PARAGRAPH STARTS READING THE BENEFIT FILE. DTSBE120 00652 ************************************************************** DTSBE120 00653 DTSBE120 00654 P5000-START-BENEFIT-FILE. DTSBE120 00655 DTSBE120 00656 PERFORM P6200-READ-NEXT-BENEFIT THRU P6200-EXIT DTSBE120 00657 UNTIL CHG4-EMP-NO GREATER MPRF-EMP-NO OR DTSBE120 00658 CHG4-EMP-NO EQUAL MPRF-EMP-NO. DTSBE120 00659 DTSBE120 00660 ** IF WRK-EMPL-ACCT EQUAL MPRF-EMP-NO DTSBE120 00661 IF CHG4-EMP-NO EQUAL MPRF-EMP-NO DTSBE120 00662 SET WRK-SAME-EMP-88 TO TRUE DTSBE120 00663 ELSE DTSBE120 00664 SET WRK-NOT-SAME-EMP-88 TO TRUE. DTSBE120 00665 * DTSBE120 00666 P5000-EXIT. DTSBE120 00667 EXIT. DTSBE120 00668 SKIP3 DTSBE120 00669 ************************************************************** DTSBE120 00670 * THIS PARAGRAPH PROCESSES THE BENEFIT CHARGES FOR THE DTSBE120 00671 * EMPLOYER. DTSBE120 00672 ************************************************************** DTSBE120 00673 DTSBE120 00674 P6000-ACCUM-BENEFIT-CHGS. DTSBE120 00675 DTSBE120 00676 PERFORM P6100-ACCUM-CHGS THRU P6100-EXIT. DTSBE120 00677 DTSBE120 00678 PERFORM P6200-READ-NEXT-BENEFIT THRU P6200-EXIT. DTSBE120 00679 DTSBE120 00680 P6000-EXIT. DTSBE120 00681 EXIT. DTSBE120 00682 EJECT DTSBE120 00683 ************************************************************** DTSBE120 00684 * THIS PARAGRAPH ACCUMULATES THE BENEFIT CHARGES FOR THE DTSBE120 00685 * EMPLOYER. DTSBE120 00686 ************************************************************** DTSBE120 00687 DTSBE120 00688 P6100-ACCUM-CHGS. DTSBE120 00689 DTSBE120 00690 COMPUTE WRK-BEN-CHARGE-AMT = DTSBE120 00691 WRK-BEN-CHARGE-AMT + DTSBE120 00692 (CHG4-CURR-BEN-AMT + CHG4-CURR-ADJ-AMT). DTSBE120 00693 ** WRK-CURR-AMT. DTSBE120 00694 DTSBE120 00695 P6100-EXIT. DTSBE120 00696 EXIT. DTSBE120 00697 SKIP3 DTSBE120 00698 ************************************************************** DTSBE120 00699 * THIS PARAGRAPH READS THE NEXT BENEFIT. DTSBE120 00700 ************************************************************** DTSBE120 00701 DTSBE120 00702 P6200-READ-NEXT-BENEFIT. DTSBE120 00703 DTSBE120 00704 READ BENEFIT-CHARGE-FILE INTO CHARGE-REC-IN AT END DTSBE120 00705 SET FILE-NO-REC-88 TO TRUE. DTSBE120 00706 DTSBE120 00707 IF FILE-OK-88 DTSBE120 00708 ** IF WRK-EMPL-ACCT EQUAL MPRF-EMP-NO DTSBE120 00709 IF CHG4-EMP-NO EQUAL MPRF-EMP-NO DTSBE120 00710 SET WRK-SAME-EMP-88 TO TRUE DTSBE120 00711 ELSE DTSBE120 00712 SET WRK-NOT-SAME-EMP-88 TO TRUE DTSBE120 00713 ELSE DTSBE120 00714 IF FILE-NO-REC-88 DTSBE120 00715 SET WRK-NOT-SAME-EMP-88 TO TRUE DTSBE120 00716 ELSE DTSBE120 00717 DISPLAY 'CHARGE FILE READ ERROR: ' FILE-STATUS DTSBE120 00718 SET WRK-NOT-SAME-EMP-88 TO TRUE DTSBE120 00719 SET FILE-NO-REC-88 TO TRUE. DTSBE120 00720 DTSBE120 00721 P6200-EXIT. DTSBE120 00722 EXIT. DTSBE120 00723 EJECT DTSBE120 00724 ************************************************************** DTSBE120 00725 * THIS PARAGRAPH SETS UP THE R120 REPORT EXTRACT RECORD. DTSBE120 00726 ************************************************************** DTSBE120 00727 DTSBE120 00728 P7000-SETUP-R120. DTSBE120 00729 MOVE MPRF-EMP-NO TO R120-EMP-NO. DTSBE120 00730 MOVE WRK-PARM-START-LIAB-DATE TO R120-BEGIN-LIAB-DATE. DTSBE120 00731 MOVE WRK-PARM-END-LIAB-DATE TO R120-END-LIAB-DATE. DTSBE120 00732 MOVE WRK-PARM-EMPL-MAX TO R120-MAX-EMPLOYEES. DTSBE120 00733 MOVE MPRF-PRIMARY-NAME TO R120-PRIMARY-NAME. DTSBE120 00734 MOVE WRK-EMP-FIRST-LIAB-DATE TO R120-OLDEST-LIAB-DATE. DTSBE120 00735 MOVE WRK-BEN-CHARGE-AMT TO R120-BENEFIT-CHARGES. DTSBE120 00736 MOVE WRK-TAX-PAID-AMT TO R120-PAID-AMT. DTSBE120 00737 DTSBE120 00738 P7000-EXIT. DTSBE120 00739 EXIT. DTSBE120 00740 EJECT DTSBE120 00741 T0000-TERMINATE. DTSBE120 00742 SKIP2 DTSBE120 00743 IF BENEFIT-CHARGE-FILE-OPEN-IND = 'Y' DTSBE120 00744 CLOSE BENEFIT-CHARGE-FILE DTSBE120 00745 IF FILE-OK-88 DTSBE120 00746 NEXT SENTENCE DTSBE120 00747 ELSE DTSBE120 00748 MOVE 'BENEFIT CHARGE FILE CLOSE FAILED' DTSBE120 00749 TO ABEND-MSG DTSBE120 00750 PERFORM S999-ABEND THRU S999-EXIT. DTSBE120 00751 SKIP2 DTSBE120 00752 T0000-EXIT. DTSBE120 00753 EXIT. DTSBE120 00754 EJECT DTSBE120 00755 S001-FROM-FED-8. DTSBE120 00756 SET L001-FROM-FED-8 TO TRUE. DTSBE120 00757 GO TO S001-DATE. DTSBE120 00758 SKIP1 DTSBE120 00759 S001-FROM-CAL-6. DTSBE120 00760 SET L001-FROM-CAL-6 TO TRUE. DTSBE120 00761 GO TO S001-DATE. DTSBE120 00762 SKIP1 DTSBE120 00763 S001-FROM-ABS-DAY. DTSBE120 00764 SET L001-FROM-ABS-DAY TO TRUE. DTSBE120 00765 GO TO S001-DATE. DTSBE120 00766 SKIP1 DTSBE120 00767 S001-DATE. DTSBE120 00768 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBE120 00769 S001-EXIT. DTSBE120 00770 EXIT. DTSBE120 00771 SKIP3 DTSBE120 00772 S910-READ. DTSBE120 00773 SET L910-READ-88 TO TRUE. DTSBE120 00774 GO TO S910-MSTR-IO. DTSBE120 00775 SKIP1 DTSBE120 00776 S910-START-BROWSE. DTSBE120 00777 SET L910-START-BROWSE-88 TO TRUE. DTSBE120 00778 GO TO S910-MSTR-IO. DTSBE120 00779 SKIP1 DTSBE120 00780 S910-READ-NEXT. DTSBE120 00781 SET L910-READ-NEXT-88 TO TRUE. DTSBE120 00782 GO TO S910-MSTR-IO. DTSBE120 00783 SKIP1 DTSBE120 00784 S910-COUNT. DTSBE120 00785 SET L910-COUNT-88 TO TRUE. DTSBE120 00786 GO TO S910-MSTR-IO. DTSBE120 00787 SKIP1 DTSBE120 00788 S910-MSTR-IO. DTSBE120 00789 CALL 'DTSBU910' USING L910-LINK-AREA DTSBE120 00790 MSKL-REC. DTSBE120 00791 S910-EXIT. DTSBE120 00792 EXIT. DTSBE120 00793 SKIP3 DTSBE120 00794 S921-READ. DTSBE120 00795 SET L921-READ-88 TO TRUE. DTSBE120 00796 GO TO S921-AIX-IO. DTSBE120 00797 SKIP1 DTSBE120 00798 S921-START-BROWSE. DTSBE120 00799 SET L921-START-BROWSE-88 TO TRUE. DTSBE120 00800 GO TO S921-AIX-IO. DTSBE120 00801 SKIP1 DTSBE120 00802 S921-READ-NEXT. DTSBE120 00803 SET L921-READ-NEXT-88 TO TRUE. DTSBE120 00804 GO TO S921-AIX-IO. DTSBE120 00805 SKIP1 DTSBE120 00806 S921-AIX-IO. DTSBE120 00807 CALL 'DTSBU921' USING L921-LINK-AREA DTSBE120 00808 ISKL-REC. DTSBE120 00809 S921-EXIT. DTSBE120 00810 EXIT. DTSBE120 00811 SKIP3 DTSBE120 00812 S946-WRITE-R120. DTSBE120 00813 CALL 'DTSBU946' USING R120-REC. DTSBE120 00814 GO TO S946-EXIT. DTSBE120 00815 SKIP1 DTSBE120 00816 S946-EXIT. DTSBE120 00817 EXIT. DTSBE120 00818 SKIP3 DTSBE120 00819 S999-ABEND. DTSBE120 00820 DISPLAY '*** DTSBE120 ABENDING. ' DTSBE120 00821 ABEND-MSG. DTSBE120 00822 SKIP1 DTSBE120 00823 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBE120 00824 S999-EXIT. DTSBE120 00825 EXIT. DTSBE120