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