693 lines
55 KiB
COBOL
693 lines
55 KiB
COBOL
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
|