713 lines
56 KiB
COBOL
713 lines
56 KiB
COBOL
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
|