00001 IDENTIFICATION DIVISION. 05/01/09 00002 PROGRAM-ID. DTSBX773. DTSBX773 00003 AUTHOR. TRW. LV003 00004 DATE-WRITTEN. NOVEMBER 2002. DTSBX773 00005 DATE-COMPILED. DTSBX773 00006 SKIP3 DTSBX773 00007 ***** DTSBX773 00008 * DTSBX773 00009 * DTSBX773 00010 * FUNCTION: EXTRACT RECONSTRUCTION FILE DATA FOR THE STATUS DTSBX773 00011 * DETERMINATIONS FOR THE ETA581 REPORT. DTSBX773 00012 * DTSBX773 00013 * DTSBX773 00014 * MODIFICATION LOG: DTSBX773 00015 * DTSBX773 00016 * 10/25/2002 INITIAL DEVELOPMENT. DTSBX773 00017 * REFERENCE: DATA VALIDATION PROGRAMMER: RW1 DTSBX773 00018 * DTSBX773 00019 * 04/30/2009 MODIFIED P1100-TIME-LAPSE: CALCULATION WAS DTSBX773 00020 * INCORRECT. IT SHOULD BE THE DIFFERENCE DTSBX773 00021 * BETWEEN THE DETERMINATION ENTRY DATE AND THE DTSBX773 00022 * END DATE OF THE LIABLE QUARTER, BUT IT WAS DTSBX773 00023 * USING THE LIABILITY DATE INSTEAD OF THE DTSBX773 00024 * QUARTER END DATE. DTSBX773 00025 * REFERENCE: DATA VALIDATION PROGRAMMER: GD DTSBX773 00026 * DTSBX773 00027 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX773 00028 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX773 00029 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBX773 00030 * DTSBX773 00031 * DTSBX773 00032 * DESCRIPTION: DTSBX773 00033 * DTSBX773 00034 * DTSBX773 00035 * INITIATION: DTSBX773 00036 * DTSBX773 00037 * DTSBX773 00038 * EDIT AND DEFAULT PARAMETERS. DTSBX773 00039 * DTSBX773 00040 * DTSBX773 00041 * PROCESSING: DTSBX773 00042 * DTSBX773 00043 * SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (DTSIX773) DTSBX773 00044 * DTSBX773 00045 * DTSBX773 00046 * TERMINATION: DTSBX773 00047 * DTSBX773 00048 * DTSBX773 00049 * DTSBX773 00050 * RECORDS READ: DTSBX773 00051 * DTSBX773 00052 * MASTER: DTSBX773 00053 * DTSBX773 00054 * NONE DTSBX773 00055 * DTSBX773 00056 * DTSBX773 00057 * ALTERNATE INDEX: DTSBX773 00058 * DTSBX773 00059 * NONE. DTSBX773 00060 * DTSBX773 00061 * DTSBX773 00062 * REFERENCE: DTSBX773 00063 * DTSBX773 00064 * DTSBX773 00065 * DTSBX773 00066 * RECORDS UPDATED: DTSBX773 00067 * DTSBX773 00068 * NONE DTSBX773 00069 * DTSBX773 00070 * DTSBX773 00071 * OUTPUT RECORDS WRITTEN: DTSBX773 00072 * DTSBX773 00073 * DTSIX773 POPULATION 3 STATUS DETERMINATIONS. DTSBX773 00074 * DTSBX773 00075 * DTSBX773 00076 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBX773 00077 * DTSBX773 00078 * NONE. DTSBX773 00079 * DTSBX773 00080 * DTSBX773 00081 * MODULES CALLED: DTSBX773 00082 * DTSBX773 00083 * DTSBU001 DATE EDIT/CONVERSION. DTSBX773 00084 * DTSBU004 QUARTER EDIT/CONVERSION. DTSBX773 00085 * DTSBU005 ABSOLUTE TIMES CONVERSION. DTSBX773 00086 * DTSBX773 00087 ***** DTSBX773 00088 SKIP3 DTSBX773 00089 ENVIRONMENT DIVISION. DTSBX773 00090 DTSBX773 00091 INPUT-OUTPUT SECTION. DTSBX773 00092 SKIP3 DTSBX773 00093 FILE-CONTROL. DTSBX773 00094 SELECT STATUS-DETERM ASSIGN TO DTSX773 DTSBX773 00095 FILE STATUS IS X773-STATUS. DTSBX773 00096 EJECT DTSBX773 00097 DATA DIVISION. DTSBX773 00098 DTSBX773 00099 FILE SECTION. DTSBX773 00100 SKIP2 DTSBX773 00101 FD STATUS-DETERM DTSBX773 00102 RECORDING MODE IS F DTSBX773 00103 LABEL RECORDS ARE STANDARD DTSBX773 00104 BLOCK CONTAINS 0 CHARACTERS. DTSBX773 00105 DTSBX773 00106 01 DETERM-REC PIC X(163). DTSBX773 00107 DTSBX773 00108 WORKING-STORAGE SECTION. DTSBX773 001085 77 PAN-VALET PICTURE X(24) VALUE '003DTSBX773 05/01/09'. DTSBX773 00109 DTSBX773 00110 01 WRK-AREA. DTSBX773 00111 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +773.DTSBX773 00112 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX773'.DTSBX773 00113 05 ABEND-MSG PIC X(60). DTSBX773 00114 DTSBX773 00115 05 X773-STATUS PIC X(02) VALUE SPACES. DTSBX773 00116 88 X773-STATUS-OK-88 VALUE ZERO. DTSBX773 00117 DTSBX773 00118 05 WRK-VALID-CLASS-IND PIC X(01). DTSBX773 00119 88 WRK-VALID-CLASS-YES-88 VALUE 'Y'. DTSBX773 00120 88 WRK-VALID-CLASS-NO-88 VALUE 'N'. DTSBX773 00121 DTSBX773 00122 05 WRK-OBS-NBR PIC S9(07) COMP-3 VALUE +0. DTSBX773 00123 DTSBX773 00124 05 WRK-EMP-CLASS-AREA. DTSBX773 00125 10 WRK-DV-EMP-CLASS PIC X(01). DTSBX773 00126 88 WRK-DV-EMP-CLASS-CONTRIB-88 VALUE 'C'. DTSBX773 00127 88 WRK-DV-EMP-CLASS-REIMB-88 VALUE 'R'. DTSBX773 00128 10 FILLER PIC X(01) VALUE '-'. DTSBX773 00129 10 WRK-MPRF-EMP-CLASS PIC X(01). DTSBX773 00130 10 FILLER PIC X(21) VALUE SPACES. DTSBX773 00131 05 WRK-EMP-CLASS REDEFINES WRK-EMP-CLASS-AREA DTSBX773 00132 PIC X(24). DTSBX773 00133 05 WRK-DETERM-AREA. DTSBX773 00134 10 WRK-DV-DETERM-TYPE PIC X(01). DTSBX773 00135 88 WRK-DV-DETERM-NEW-88 VALUE 'N'. DTSBX773 00136 88 WRK-DV-DETERM-SUC-88 VALUE 'S'. DTSBX773 00137 88 WRK-DV-DETERM-INACT-88 VALUE 'I'. DTSBX773 00138 10 FILLER PIC X(01) VALUE '-'. DTSBX773 00139 10 WRK-MERD-DETERM-TYPE PIC X(01). DTSBX773 00140 10 FILLER PIC X(21) VALUE SPACES. DTSBX773 00141 05 WRK-DETERM-TYPE REDEFINES WRK-DETERM-AREA DTSBX773 00142 PIC X(24). DTSBX773 00143 DTSBX773 00144 05 WRK-RECS-WRITTEN-CNT PIC S9(07) COMP-3 DTSBX773 00145 VALUE +0. DTSBX773 00146 05 WRK-NEW-CNT PIC S9(07) COMP-3 DTSBX773 00147 VALUE +0. DTSBX773 00148 05 WRK-NEW-T180-CNT PIC S9(07) COMP-3 DTSBX773 00149 VALUE +0. DTSBX773 00150 05 WRK-NEW-T90-CNT PIC S9(07) COMP-3 DTSBX773 00151 VALUE +0. DTSBX773 00152 05 WRK-SUC-CNT PIC S9(07) COMP-3 DTSBX773 00153 VALUE +0. DTSBX773 00154 05 WRK-SUC-T180-CNT PIC S9(07) COMP-3 DTSBX773 00155 VALUE +0. DTSBX773 00156 05 WRK-SUC-T90-CNT PIC S9(07) COMP-3 DTSBX773 00157 VALUE +0. DTSBX773 00158 05 WRK-INACT-CNT PIC S9(07) COMP-3 DTSBX773 00159 VALUE +0. DTSBX773 00160 DTSBX773 00161 DTSBX773 00162 05 WRK-TIME-LAPSE-DAYS PIC S9(08) COMP. DTSBX773 00163 05 WRK-ENTRY-JUL-ABS-DAY PIC S9(08) COMP. DTSBX773 00164 05 WRK-LIAB-QTR-END-ABS PIC S9(08) COMP. DTSBX773 00165 05 ADD-TO-T180-CNT-IND PIC X(01). DTSBX773 00166 88 ADD-TO-T180-CNT-YES-88 VALUE 'Y'. DTSBX773 00167 88 ADD-TO-T180-CNT-NO-88 VALUE 'N'. DTSBX773 00168 05 ADD-TO-T90-CNT-IND PIC X(01). DTSBX773 00169 88 ADD-TO-T90-CNT-YES-88 VALUE 'Y'. DTSBX773 00170 88 ADD-TO-T90-CNT-NO-88 VALUE 'N'. DTSBX773 00171 DTSBX773 00172 05 WRK-LEN PIC S9(04) COMP VALUE +163. DTSBX773 00173 05 WRK-REC-AREA PIC X(163). DTSBX773 00174 DTSBX773 00175 05 WRK-X773-FILLER1 PIC X(51) VALUE SPACES. DTSBX773 00176 05 WRK-X773-FILLER2 PIC X(29) VALUE SPACES. DTSBX773 00177 05 WRK-X773-FILLER3 PIC X(33) VALUE SPACES. DTSBX773 00178 05 WRK-X773-FILLER4 PIC X(11) VALUE SPACES. DTSBX773 00179 05 WRK-X773-FILLER5 PIC X(51) VALUE SPACES. DTSBX773 00180 DTSBX773 00181 05 DISPLAY-AMT-X PIC X(15). DTSBX773 00182 05 DISPLAY-AMT REDEFINES DISPLAY-AMT-X DTSBX773 00183 PIC ZZZ,ZZZ,ZZ9.99-. DTSBX773 00184 EJECT DTSBX773 00185 01 L001-LINK-AREA. DTSBX773 00186 ++INCLUDE DTSIL001 DTSBX773 00187 EJECT DTSBX773 00188 01 L004-LINK-AREA. DTSBX773 00189 ++INCLUDE DTSIL004 DTSBX773 00190 EJECT DTSBX773 00191 01 L005-LINK-AREA. DTSBX773 00192 ++INCLUDE DTSIL005 DTSBX773 00193 EJECT DTSBX773 00194 01 Y773-REC. DTSBX773 00195 ++INCLUDE DTSIY773 DTSBX773 00196 DTSBX773 00197 01 X773-REC. DTSBX773 00198 ++INCLUDE DTSIX773 DTSBX773 00199 EJECT DTSBX773 00200 LINKAGE SECTION. DTSBX773 00201 SKIP3 DTSBX773 00202 01 XL773-LINK-AREA. DTSBX773 00203 ++INCLUDE DTSXL773 DTSBX773 00204 SKIP3 DTSBX773 00205 01 X770-PARM-REC. DTSBX773 00206 ++INCLUDE DTSIX770 DTSBX773 00207 SKIP3 DTSBX773 00208 01 RSKL-REC. DTSBX773 00209 ++INCLUDE DTSIRSK1 DTSBX773 00210 EJECT DTSBX773 00211 PROCEDURE DIVISION USING XL773-LINK-AREA DTSBX773 00212 X770-PARM-REC DTSBX773 00213 RSKL-REC. DTSBX773 00214 DTSBX773 00215 IF XL773-CMD-PROCESS-88 DTSBX773 00216 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX773 00217 ELSE DTSBX773 00218 IF XL773-CMD-INIT-88 DTSBX773 00219 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBX773 00220 ELSE DTSBX773 00221 IF XL773-CMD-TERMINATE-88 DTSBX773 00222 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBX773 00223 ELSE DTSBX773 00224 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBX773 00225 TO ABEND-MSG DTSBX773 00226 PERFORM S999-ABEND THRU S999-EXIT. DTSBX773 00227 SKIP2 DTSBX773 00228 GOBACK. DTSBX773 00229 EJECT DTSBX773 00230 I0000-INITIALIZE. DTSBX773 00231 OPEN OUTPUT STATUS-DETERM. DTSBX773 00232 IF NOT X773-STATUS-OK-88 DTSBX773 00233 DISPLAY 'FILE STATUS IS : ' X773-STATUS DTSBX773 00234 MOVE 'CANNOT OPEN OUTPUT FILE ' TO ABEND-MSG DTSBX773 00235 PERFORM S999-ABEND THRU S999-EXIT. DTSBX773 00236 DTSBX773 00237 MOVE ZERO TO XL773-NEW-DETERM-CNT DTSBX773 00238 XL773-NEW-DETERM-T180-CNT DTSBX773 00239 XL773-NEW-DETERM-T90-CNT DTSBX773 00240 XL773-SUC-DETERM-CNT DTSBX773 00241 XL773-SUC-DETERM-T180-CNT DTSBX773 00242 XL773-SUC-DETERM-T90-CNT DTSBX773 00243 XL773-TERMINATION-CNT. DTSBX773 00244 I0000-EXIT. DTSBX773 00245 EXIT. DTSBX773 00246 EJECT DTSBX773 00247 P0000-PROCESS. DTSBX773 00248 MOVE RSKL-REC TO Y773-REC. DTSBX773 00249 DTSBX773 00250 PERFORM P1000-WRITE-OUTPUT THRU P1000-EXIT. DTSBX773 00251 DTSBX773 00252 P0000-EXIT. DTSBX773 00253 EXIT. DTSBX773 00254 DTSBX773 00255 P1000-WRITE-OUTPUT. DTSBX773 00256 *& DISPLAY 'DTSBE773 ' Y773-EMP-NO. DTSBX773 00257 INITIALIZE X773-REC. DTSBX773 00258 DTSBX773 00259 ADD +1 TO WRK-OBS-NBR. DTSBX773 00260 ADD +1 TO WRK-RECS-WRITTEN-CNT. DTSBX773 00261 DTSBX773 00262 MOVE Y773-EMP-NO TO X773-EMP-NO. DTSBX773 00263 MOVE WRK-OBS-NBR TO X773-OBS-NBR. DTSBX773 00264 DTSBX773 00265 SET WRK-VALID-CLASS-YES-88 TO TRUE. DTSBX773 00266 EVALUATE TRUE DTSBX773 00267 WHEN Y773-CLASS-RATED-88 DTSBX773 00268 SET WRK-DV-EMP-CLASS-CONTRIB-88 TO TRUE DTSBX773 00269 DTSBX773 00270 WHEN Y773-CLASS-SELF-INS-88 DTSBX773 00271 SET WRK-DV-EMP-CLASS-REIMB-88 TO TRUE DTSBX773 00272 DTSBX773 00273 WHEN OTHER DTSBX773 00274 DISPLAY 'INVALID EMPLOYER CLASS ' Y773-EMP-NO DTSBX773 00275 ' CLASS: ' Y773-EMP-CLASS DTSBX773 00276 SET WRK-VALID-CLASS-NO-88 TO TRUE DTSBX773 00277 DTSBX773 00278 END-EVALUATE. DTSBX773 00279 DTSBX773 00280 IF WRK-VALID-CLASS-NO-88 DTSBX773 00281 GO TO P1000-EXIT. DTSBX773 00282 DTSBX773 00283 MOVE Y773-EMP-CLASS TO WRK-MPRF-EMP-CLASS. DTSBX773 00284 MOVE WRK-EMP-CLASS-AREA TO X773-EMP-TYPE. DTSBX773 00285 DTSBX773 00286 IF Y773-LIAB-DATE > ZERO DTSBX773 00287 MOVE Y773-LIAB-DATE TO L001-FED-8-DATE-9 DTSBX773 00288 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX773 00289 MOVE L001-SLASH-8-DATE TO X773-LIAB-DATE DTSBX773 00290 MOVE L001-FED-8-DATE-9 TO L004-DATE DTSBX773 00291 PERFORM S004-FROM-DATE THRU S004-EXIT DTSBX773 00292 MOVE L004-QTR-END-DATE TO L001-FED-8-DATE-9 DTSBX773 00293 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX773 00294 MOVE L001-SLASH-8-DATE TO X773-LIAB-QTR-END DTSBX773 00295 MOVE L001-JUL-ABS-DAY TO WRK-LIAB-QTR-END-ABS DTSBX773 00296 ELSE DTSBX773 00297 MOVE SPACES TO X773-LIAB-QTR-END DTSBX773 00298 MOVE ZEROS TO WRK-LIAB-QTR-END-ABS DTSBX773 00299 END-IF. DTSBX773 00300 DTSBX773 00301 IF Y773-STATUS-DETERM-DATE > ZERO DTSBX773 00302 MOVE Y773-STATUS-DETERM-DATE DTSBX773 00303 TO L001-FED-8-DATE-9 DTSBX773 00304 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX773 00305 MOVE L001-SLASH-8-DATE TO X773-STATUS-DETERM-DATE DTSBX773 00306 ELSE DTSBX773 00307 MOVE SPACES TO X773-STATUS-DETERM-DATE. DTSBX773 00308 DTSBX773 00309 EVALUATE TRUE DTSBX773 00310 WHEN Y773-DETERM-NEW-88 DTSBX773 00311 SET WRK-DV-DETERM-NEW-88 TO TRUE DTSBX773 00312 ADD +1 TO WRK-NEW-CNT DTSBX773 00313 PERFORM P1100-TIME-LAPSE THRU P1100-EXIT DTSBX773 00314 IF ADD-TO-T180-CNT-YES-88 DTSBX773 00315 ADD +1 TO WRK-NEW-T180-CNT DTSBX773 00316 END-IF DTSBX773 00317 IF ADD-TO-T90-CNT-YES-88 DTSBX773 00318 ADD +1 TO WRK-NEW-T90-CNT DTSBX773 00319 END-IF DTSBX773 00320 DTSBX773 00321 WHEN Y773-DETERM-SUC-88 DTSBX773 00322 SET WRK-DV-DETERM-SUC-88 TO TRUE DTSBX773 00323 ADD +1 TO WRK-SUC-CNT DTSBX773 00324 PERFORM P1100-TIME-LAPSE THRU P1100-EXIT DTSBX773 00325 IF ADD-TO-T180-CNT-YES-88 DTSBX773 00326 ADD +1 TO WRK-SUC-T180-CNT DTSBX773 00327 END-IF DTSBX773 00328 IF ADD-TO-T90-CNT-YES-88 DTSBX773 00329 ADD +1 TO WRK-SUC-T90-CNT DTSBX773 00330 END-IF DTSBX773 00331 DTSBX773 00332 WHEN Y773-DETERM-INACT-88 DTSBX773 00333 SET WRK-DV-DETERM-INACT-88 TO TRUE DTSBX773 00334 ADD +1 TO WRK-INACT-CNT DTSBX773 00335 DTSBX773 00336 END-EVALUATE. DTSBX773 00337 DTSBX773 00338 MOVE Y773-DETERM-TYPE TO WRK-MERD-DETERM-TYPE. DTSBX773 00339 MOVE WRK-DETERM-AREA TO X773-DETERM-TYPE. DTSBX773 00340 DTSBX773 00341 IF Y773-ACTIVATION-DATE > ZERO DTSBX773 00342 MOVE Y773-ACTIVATION-DATE TO L001-FED-8-DATE-9 DTSBX773 00343 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX773 00344 MOVE L001-SLASH-8-DATE TO X773-ACTIVE-PROCESS-DATE DTSBX773 00345 ELSE DTSBX773 00346 MOVE SPACES TO X773-ACTIVE-PROCESS-DATE. DTSBX773 00347 DTSBX773 00348 IF Y773-SUCC-DATE > ZERO DTSBX773 00349 MOVE Y773-SUCC-DATE TO L001-FED-8-DATE-9 DTSBX773 00350 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX773 00351 MOVE L001-SLASH-8-DATE TO X773-SUCC-PROCESS-DATE DTSBX773 00352 ELSE DTSBX773 00353 MOVE SPACES TO X773-SUCC-PROCESS-DATE. DTSBX773 00354 DTSBX773 00355 IF Y773-REACT-DATE > ZERO DTSBX773 00356 MOVE Y773-REACT-DATE TO L001-FED-8-DATE-9 DTSBX773 00357 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX773 00358 MOVE L001-SLASH-8-DATE TO X773-REACT-PROCESS-DATE DTSBX773 00359 ELSE DTSBX773 00360 MOVE SPACES TO X773-REACT-PROCESS-DATE. DTSBX773 00361 DTSBX773 00362 IF Y773-INACT-DATE > ZERO DTSBX773 00363 MOVE Y773-INACT-DATE TO L001-FED-8-DATE-9 DTSBX773 00364 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX773 00365 MOVE L001-SLASH-8-DATE TO X773-INACT-PROCESS-DATE DTSBX773 00366 ELSE DTSBX773 00367 MOVE SPACES TO X773-INACT-PROCESS-DATE. DTSBX773 00368 DTSBX773 00369 MOVE Y773-PRED-EMP-NO TO X773-PRED-EMP-NO. DTSBX773 00370 DTSBX773 00371 MOVE SPACES TO X773-TERM-PROCESS-DATE. DTSBX773 00372 DTSBX773 00373 EVALUATE TRUE DTSBX773 00374 WHEN Y773-DETERM-ORIG-88 DTSBX773 00375 PERFORM P2100-WRITE-NEW THRU P2100-EXIT DTSBX773 00376 DTSBX773 00377 WHEN Y773-DETERM-REACT-88 DTSBX773 00378 PERFORM P2200-WRITE-REACT THRU P2200-EXIT DTSBX773 00379 DTSBX773 00380 WHEN Y773-DETERM-SUC-88 DTSBX773 00381 AND Y773-REACT-DATE = ZERO DTSBX773 00382 PERFORM P2300-WRITE-SUC-ORIG THRU P2300-EXIT DTSBX773 00383 DTSBX773 00384 WHEN Y773-DETERM-SUC-88 DTSBX773 00385 AND Y773-REACT-DATE > ZERO DTSBX773 00386 PERFORM P2400-WRITE-SUC-REACT THRU P2400-EXIT DTSBX773 00387 DTSBX773 00388 WHEN Y773-DETERM-INACT-88 DTSBX773 00389 PERFORM P2500-WRITE-INACT THRU P2500-EXIT DTSBX773 00390 DTSBX773 00391 END-EVALUATE. DTSBX773 00392 DTSBX773 00393 DTSBX773 00394 P1000-EXIT. DTSBX773 00395 EXIT. DTSBX773 00396 DTSBX773 00397 P1100-TIME-LAPSE. DTSBX773 00398 MOVE Y773-STATUS-DETERM-DATE TO L001-FED-8-DATE-9. DTSBX773 00399 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX773 00400 MOVE L001-JUL-ABS-DAY TO WRK-ENTRY-JUL-ABS-DAY. DTSBX773 00401 DTSBX773 00402 ** INCORRECT - SHOULD BE LIAB QTR END DATE. ** DTSBX773 00403 ** MOVE Y773-LIAB-DATE TO L004-DATE. DTSBX773 00404 * PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBX773 00405 * MOVE L004-QTR-END-DATE TO L001-FED-8-DATE-9. DTSBX773 00406 ** PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX773 00407 DTSBX773 00408 COMPUTE WRK-TIME-LAPSE-DAYS DTSBX773 00409 = WRK-ENTRY-JUL-ABS-DAY - WRK-LIAB-QTR-END-ABS. DTSBX773 00410 DTSBX773 00411 SET ADD-TO-T180-CNT-NO-88 TO TRUE. DTSBX773 00412 SET ADD-TO-T90-CNT-NO-88 TO TRUE. DTSBX773 00413 DTSBX773 00414 IF WRK-TIME-LAPSE-DAYS > +180 DTSBX773 00415 NEXT SENTENCE DTSBX773 00416 ELSE DTSBX773 00417 SET ADD-TO-T180-CNT-YES-88 TO TRUE DTSBX773 00418 IF WRK-TIME-LAPSE-DAYS > +90 DTSBX773 00419 NEXT SENTENCE DTSBX773 00420 ELSE DTSBX773 00421 SET ADD-TO-T90-CNT-YES-88 TO TRUE. DTSBX773 00422 DTSBX773 00423 P1100-EXIT. DTSBX773 00424 EXIT. DTSBX773 00425 DTSBX773 00426 P2100-WRITE-NEW. DTSBX773 00427 MOVE SPACES TO WRK-REC-AREA. DTSBX773 00428 DTSBX773 00429 STRING DTSBX773 00430 X773-OBS-NBR ',' DTSBX773 00431 X773-EMP-NO ',' DTSBX773 00432 X773-EMP-TYPE ',' DTSBX773 00433 X773-DETERM-TYPE ',' DTSBX773 00434 X773-TIME-LAPSE ',' DTSBX773 00435 X773-STATUS-DETERM-DATE ',' DTSBX773 00436 X773-LIAB-DATE ',' DTSBX773 00437 X773-LIAB-QTR-END ',' DTSBX773 00438 X773-ACTIVE-PROCESS-DATE ',' ',' ',' ',' ',' ',' DTSBX773 00439 WRK-X773-FILLER1 DTSBX773 00440 DELIMITED BY SIZE DTSBX773 00441 INTO WRK-REC-AREA DTSBX773 00442 END-STRING. DTSBX773 00443 DTSBX773 00444 MOVE WRK-REC-AREA (1:WRK-LEN) TO DTSBX773 00445 DETERM-REC (1:WRK-LEN). DTSBX773 00446 DTSBX773 00447 WRITE DETERM-REC. DTSBX773 00448 DTSBX773 00449 IF NOT X773-STATUS-OK-88 DTSBX773 00450 DISPLAY 'FILE STATUS IS : ' X773-STATUS DTSBX773 00451 MOVE 'WRITE OUTPUT RECORD ERROR ' TO ABEND-MSG DTSBX773 00452 PERFORM S999-ABEND THRU S999-EXIT. DTSBX773 00453 DTSBX773 00454 P2100-EXIT. DTSBX773 00455 EXIT. DTSBX773 00456 DTSBX773 00457 P2200-WRITE-REACT. DTSBX773 00458 MOVE SPACES TO WRK-REC-AREA. DTSBX773 00459 DTSBX773 00460 STRING DTSBX773 00461 X773-OBS-NBR ',' DTSBX773 00462 X773-EMP-NO ',' DTSBX773 00463 X773-EMP-TYPE ',' DTSBX773 00464 X773-DETERM-TYPE ',' DTSBX773 00465 X773-TIME-LAPSE ',' DTSBX773 00466 X773-STATUS-DETERM-DATE ',' DTSBX773 00467 X773-LIAB-DATE ',' DTSBX773 00468 X773-LIAB-QTR-END ',' DTSBX773 00469 X773-ACTIVE-PROCESS-DATE ',' DTSBX773 00470 X773-REACT-PROCESS-DATE ',' ',' ',' ',' ',' DTSBX773 00471 WRK-X773-FILLER2 DTSBX773 00472 DELIMITED BY SIZE DTSBX773 00473 INTO WRK-REC-AREA DTSBX773 00474 END-STRING. DTSBX773 00475 DTSBX773 00476 MOVE WRK-REC-AREA (1:WRK-LEN) TO DTSBX773 00477 DETERM-REC (1:WRK-LEN). DTSBX773 00478 DTSBX773 00479 WRITE DETERM-REC. DTSBX773 00480 DTSBX773 00481 IF NOT X773-STATUS-OK-88 DTSBX773 00482 DISPLAY 'FILE STATUS IS : ' X773-STATUS DTSBX773 00483 MOVE 'WRITE OUTPUT RECORD ERROR ' TO ABEND-MSG DTSBX773 00484 PERFORM S999-ABEND THRU S999-EXIT. DTSBX773 00485 DTSBX773 00486 P2200-EXIT. DTSBX773 00487 EXIT. DTSBX773 00488 DTSBX773 00489 P2300-WRITE-SUC-ORIG. DTSBX773 00490 MOVE SPACES TO WRK-REC-AREA. DTSBX773 00491 DTSBX773 00492 STRING DTSBX773 00493 X773-OBS-NBR ',' DTSBX773 00494 X773-EMP-NO ',' DTSBX773 00495 X773-EMP-TYPE ',' DTSBX773 00496 X773-DETERM-TYPE ',' DTSBX773 00497 X773-TIME-LAPSE ',' DTSBX773 00498 X773-STATUS-DETERM-DATE ',' DTSBX773 00499 X773-LIAB-DATE ',' DTSBX773 00500 X773-LIAB-QTR-END ',' DTSBX773 00501 X773-ACTIVE-PROCESS-DATE ',' ',' DTSBX773 00502 X773-SUCC-PROCESS-DATE ',' DTSBX773 00503 X773-PRED-EMP-NO ',' ',' ',' DTSBX773 00504 WRK-X773-FILLER3 DTSBX773 00505 DELIMITED BY SIZE DTSBX773 00506 INTO WRK-REC-AREA DTSBX773 00507 END-STRING. DTSBX773 00508 DTSBX773 00509 MOVE WRK-REC-AREA (1:WRK-LEN) TO DTSBX773 00510 DETERM-REC (1:WRK-LEN). DTSBX773 00511 DTSBX773 00512 WRITE DETERM-REC. DTSBX773 00513 DTSBX773 00514 IF NOT X773-STATUS-OK-88 DTSBX773 00515 DISPLAY 'FILE STATUS IS : ' X773-STATUS DTSBX773 00516 MOVE 'WRITE OUTPUT RECORD ERROR ' TO ABEND-MSG DTSBX773 00517 PERFORM S999-ABEND THRU S999-EXIT. DTSBX773 00518 DTSBX773 00519 P2300-EXIT. DTSBX773 00520 EXIT. DTSBX773 00521 DTSBX773 00522 P2400-WRITE-SUC-REACT. DTSBX773 00523 MOVE SPACES TO WRK-REC-AREA. DTSBX773 00524 DTSBX773 00525 STRING DTSBX773 00526 X773-OBS-NBR ',' DTSBX773 00527 X773-EMP-NO ',' DTSBX773 00528 X773-EMP-TYPE ',' DTSBX773 00529 X773-DETERM-TYPE ',' DTSBX773 00530 X773-TIME-LAPSE ',' DTSBX773 00531 X773-STATUS-DETERM-DATE ',' DTSBX773 00532 X773-LIAB-DATE ',' DTSBX773 00533 X773-LIAB-QTR-END ',' DTSBX773 00534 X773-ACTIVE-PROCESS-DATE ',' DTSBX773 00535 X773-REACT-PROCESS-DATE ',' DTSBX773 00536 X773-SUCC-PROCESS-DATE ',' DTSBX773 00537 X773-PRED-EMP-NO ',' DTSBX773 00538 X773-INACT-PROCESS-DATE ',' ',' DTSBX773 00539 WRK-X773-FILLER4 DTSBX773 00540 DELIMITED BY SIZE DTSBX773 00541 INTO WRK-REC-AREA DTSBX773 00542 END-STRING. DTSBX773 00543 DTSBX773 00544 MOVE WRK-REC-AREA (1:WRK-LEN) TO DTSBX773 00545 DETERM-REC (1:WRK-LEN). DTSBX773 00546 DTSBX773 00547 WRITE DETERM-REC. DTSBX773 00548 DTSBX773 00549 IF NOT X773-STATUS-OK-88 DTSBX773 00550 DISPLAY 'FILE STATUS IS : ' X773-STATUS DTSBX773 00551 MOVE 'WRITE OUTPUT RECORD ERROR ' TO ABEND-MSG DTSBX773 00552 PERFORM S999-ABEND THRU S999-EXIT. DTSBX773 00553 DTSBX773 00554 P2400-EXIT. DTSBX773 00555 EXIT. DTSBX773 00556 DTSBX773 00557 P2500-WRITE-INACT. DTSBX773 00558 MOVE SPACES TO WRK-REC-AREA. DTSBX773 00559 DTSBX773 00560 STRING DTSBX773 00561 X773-OBS-NBR ',' DTSBX773 00562 X773-EMP-NO ',' DTSBX773 00563 X773-EMP-TYPE ',' DTSBX773 00564 X773-DETERM-TYPE ',' DTSBX773 00565 X773-TIME-LAPSE ',' DTSBX773 00566 X773-STATUS-DETERM-DATE ',' DTSBX773 00567 X773-LIAB-DATE ',' DTSBX773 00568 X773-LIAB-QTR-END ',' ',' ',' ',' ',' DTSBX773 00569 X773-INACT-PROCESS-DATE ',' ',' DTSBX773 00570 WRK-X773-FILLER5 DTSBX773 00571 DELIMITED BY SIZE DTSBX773 00572 INTO WRK-REC-AREA DTSBX773 00573 END-STRING. DTSBX773 00574 DTSBX773 00575 MOVE WRK-REC-AREA (1:WRK-LEN) TO DTSBX773 00576 DETERM-REC (1:WRK-LEN). DTSBX773 00577 DTSBX773 00578 WRITE DETERM-REC. DTSBX773 00579 DTSBX773 00580 IF NOT X773-STATUS-OK-88 DTSBX773 00581 DISPLAY 'FILE STATUS IS : ' X773-STATUS DTSBX773 00582 MOVE 'WRITE OUTPUT RECORD ERROR ' TO ABEND-MSG DTSBX773 00583 PERFORM S999-ABEND THRU S999-EXIT. DTSBX773 00584 DTSBX773 00585 P2500-EXIT. DTSBX773 00586 EXIT. DTSBX773 00587 DTSBX773 00588 T0000-TERMINATE. DTSBX773 00589 PERFORM T1000-UPDATE-LINK THRU T1000-EXIT. DTSBX773 00590 DTSBX773 00591 DISPLAY ' '. DTSBX773 00592 DTSBX773 00593 DISPLAY '*** DTSBX773 TERMINATION STATISTICS ***'. DTSBX773 00594 DTSBX773 00595 DISPLAY ' '. DTSBX773 00596 DISPLAY 'STATUS-DETERMINATIONS RECORDS WRITTEN : ' DTSBX773 00597 WRK-RECS-WRITTEN-CNT. DTSBX773 00598 DISPLAY 'NEW DETERMINATIONS : ' DTSBX773 00599 WRK-NEW-CNT. DTSBX773 00600 DISPLAY 'NEW T90 : ' DTSBX773 00601 WRK-NEW-T90-CNT. DTSBX773 00602 DISPLAY 'NEW T180 : ' DTSBX773 00603 WRK-NEW-T180-CNT. DTSBX773 00604 DISPLAY 'SUCCESSOR DETERMINATIONS : ' DTSBX773 00605 WRK-SUC-CNT. DTSBX773 00606 DISPLAY 'SUC T90 : ' DTSBX773 00607 WRK-SUC-T90-CNT. DTSBX773 00608 DISPLAY 'SUC T180 : ' DTSBX773 00609 WRK-SUC-T180-CNT. DTSBX773 00610 DISPLAY 'INACTIVE DETERMINATIONS : ' DTSBX773 00611 WRK-INACT-CNT. DTSBX773 00612 DTSBX773 00613 DISPLAY ' '. DTSBX773 00614 DTSBX773 00615 CLOSE STATUS-DETERM. DTSBX773 00616 DTSBX773 00617 T0000-EXIT. DTSBX773 00618 EXIT. DTSBX773 00619 DTSBX773 00620 T1000-UPDATE-LINK. DTSBX773 00621 MOVE WRK-NEW-CNT TO XL773-NEW-DETERM-CNT. DTSBX773 00622 MOVE WRK-NEW-T180-CNT TO XL773-NEW-DETERM-T180-CNT. DTSBX773 00623 MOVE WRK-NEW-T90-CNT TO XL773-NEW-DETERM-T90-CNT. DTSBX773 00624 MOVE WRK-SUC-CNT TO XL773-SUC-DETERM-CNT. DTSBX773 00625 MOVE WRK-SUC-T180-CNT TO XL773-SUC-DETERM-T180-CNT. DTSBX773 00626 MOVE WRK-SUC-T90-CNT TO XL773-SUC-DETERM-T90-CNT. DTSBX773 00627 MOVE WRK-INACT-CNT TO XL773-TERMINATION-CNT. DTSBX773 00628 DTSBX773 00629 T1000-EXIT. DTSBX773 00630 EXIT. DTSBX773 00631 DTSBX773 00632 S001-FROM-FED-8. DTSBX773 00633 SET L001-FROM-FED-8 TO TRUE. DTSBX773 00634 GO TO S001-DATE. DTSBX773 00635 DTSBX773 00636 S001-FROM-ABS-DAY. DTSBX773 00637 SET L001-FROM-ABS-DAY TO TRUE. DTSBX773 00638 GO TO S001-DATE. DTSBX773 00639 DTSBX773 00640 S001-FROM-CAL-6. DTSBX773 00641 SET L001-FROM-CAL-6 TO TRUE. DTSBX773 00642 GO TO S001-DATE. DTSBX773 00643 DTSBX773 00644 S001-DATE. DTSBX773 00645 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX773 00646 S001-EXIT. DTSBX773 00647 EXIT. DTSBX773 00648 SKIP3 DTSBX773 00649 S004-FROM-5. DTSBX773 00650 SET L004-FROM-5 TO TRUE. DTSBX773 00651 GO TO S004-QTR. DTSBX773 00652 DTSBX773 00653 S004-FROM-ABS. DTSBX773 00654 SET L004-FROM-ABS TO TRUE. DTSBX773 00655 GO TO S004-QTR. DTSBX773 00656 DTSBX773 00657 S004-FROM-3. DTSBX773 00658 SET L004-FROM-3 TO TRUE. DTSBX773 00659 GO TO S004-QTR. DTSBX773 00660 DTSBX773 00661 S004-FROM-DATE. DTSBX773 00662 SET L004-FROM-DATE TO TRUE. DTSBX773 00663 GO TO S004-QTR. DTSBX773 00664 DTSBX773 00665 S004-QTR. DTSBX773 00666 DTSBX773 00667 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX773 00668 DTSBX773 00669 S004-EXIT. DTSBX773 00670 EXIT. DTSBX773 00671 SKIP3 DTSBX773 00672 S005-FROM-ABSTIME. DTSBX773 00673 SET L005-FROM-ABSTIME TO TRUE. DTSBX773 00674 GO TO S005-ABSTIME. DTSBX773 00675 DTSBX773 00676 S005-FROM-DATE-TIME. DTSBX773 00677 SET L005-FROM-DATE-TIME TO TRUE. DTSBX773 00678 GO TO S005-ABSTIME. DTSBX773 00679 DTSBX773 00680 S005-ABSTIME. DTSBX773 00681 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX773 00682 S005-EXIT. DTSBX773 00683 EXIT. DTSBX773 00684 SKIP3 DTSBX773 00685 S999-ABEND. DTSBX773 00686 DISPLAY '*** DTSBE773 ABENDING. ' DTSBX773 00687 ABEND-MSG. DTSBX773 00688 DTSBX773 00689 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX773 00690 S999-EXIT. DTSBX773 00691 EXIT. DTSBX773