00001 IDENTIFICATION DIVISION. 03/31/11 00002 PROGRAM-ID. DTSBX774. DTSBX774 00003 AUTHOR. TRW. LV003 00004 DATE-WRITTEN. NOVEMBER 2002. DTSBX774 00005 DATE-COMPILED. DTSBX774 00006 SKIP3 DTSBX774 00007 ***** DTSBX774 00008 * DTSBX774 00009 * DTSBX774 00010 * FUNCTION: BUILD ETA581 RECONSTRUCTION FILE RECORDS FOR DTSBX774 00011 * ACCOUNTS RECEIVABLE POPULATION. DTSBX774 00012 * DTSBX774 00013 * DTSBX774 00014 * MODIFICATION LOG: DTSBX774 00015 * DTSBX774 00016 * 11/28/2002 INITIAL DEVELOPMENT. DTSBX774 00017 * REFERENCE: DATA VALIDATION PROGRAMMER: GD DTSBX774 00018 * DTSBX774 00019 * 10/02/2003 P5100, P5200: MOVED CODE THAT INCREMENTS DTSBX774 00020 * OBS NUMBER TO EXECUTE IMMEDIATELY BEFORE WRITE. DTSBX774 00021 * SOME NUMBERS WERE BEING SKIPPED BECAUSE THE DTSBX774 00022 * NUMBER WAS INCREMENTED FOR RECORDS EVENTUALLY DTSBX774 00023 * BYPASSED. DTSBX774 00024 * REFERENCE: PROGRAMMER: GD DTSBX774 00025 * DTSBX774 00026 * 10/02/2003 MODIFIED OUTPUT RECORD: END OF QTR BALANCE FIELD DTSBX774 00027 * ONLY INCLUDED IN BALANCE RECORDS. DTSBX774 00028 * REFERENCE: PROGRAMMER: GD DTSBX774 00029 * DTSBX774 00030 * 10/27/2010 MODIFIED LIQUIDATION OUTPUT RECORD: ESTABLISHED DTSBX774 00031 * Q DATE IS NOW REQUIRED. DTSBX774 00032 * REFERENCE: PROGRAMMER: GD DTSBX774 00033 * DTSBX774 00034 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX774 00035 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX774 00036 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBX774 00037 * DTSBX774 00038 * DTSBX774 00039 * DESCRIPTION: DTSBX774 00040 * DTSBX774 00041 * DTSBX774 00042 * INITIATION: DTSBX774 00043 * DTSBX774 00044 * OPEN DTSX774 DTSBX774 00045 * DTSBX774 00046 * DTSBX774 00047 * DTSBX774 00048 * PROCESSING: DTSBX774 00049 * DTSBX774 00050 * BUILD X774 OUTPUT RECORDS FROM DTSIY774 INPUT. DTSBX774 00051 * DTSBX774 00052 * DTSBX774 00053 * TERMINATION: DTSBX774 00054 * DTSBX774 00055 * CLOSE DTSX774 DTSBX774 00056 * DTSBX774 00057 * RECORDS READ: DTSBX774 00058 * DTSBX774 00059 * MASTER: DTSBX774 00060 * DTSBX774 00061 * NONE DTSBX774 00062 * DTSBX774 00063 * ALTERNATE INDEX: DTSBX774 00064 * DTSBX774 00065 * NONE. DTSBX774 00066 * DTSBX774 00067 * DTSBX774 00068 * REFERENCE: DTSBX774 00069 * DTSBX774 00070 * DTSBX774 00071 * DTSBX774 00072 * RECORDS UPDATED: DTSBX774 00073 * DTSBX774 00074 * NONE DTSBX774 00075 * DTSBX774 00076 * DTSBX774 00077 * OUTPUT RECORDS WRITTEN: DTSBX774 00078 * DTSBX774 00079 * DTSIX774 POPULATION 4 DOWNLOAD DTSBX774 00080 * DTSBX774 00081 * DTSBX774 00082 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBX774 00083 * DTSBX774 00084 * NONE. DTSBX774 00085 * DTSBX774 00086 * DTSBX774 00087 * MODULES CALLED: DTSBX774 00088 * DTSBX774 00089 * DTSBU001 DATE EDIT/CONVERSION. DTSBX774 00090 * DTSBU004 QUARTER EDIT/CONVERSION. DTSBX774 00091 * DTSBX774 00092 * DTSBX774 00093 * DTSBX774 00094 ***** DTSBX774 00095 SKIP3 DTSBX774 00096 ENVIRONMENT DIVISION. DTSBX774 00097 INPUT-OUTPUT SECTION. DTSBX774 00098 FILE-CONTROL. DTSBX774 00099 SELECT ACCTS-RECEIVABLE ASSIGN TO DTSX774 DTSBX774 00100 FILE STATUS IS X774-STATUS. DTSBX774 00101 EJECT DTSBX774 00102 DATA DIVISION. DTSBX774 00103 FILE SECTION. DTSBX774 00104 FD ACCTS-RECEIVABLE DTSBX774 00105 RECORDING MODE IS F DTSBX774 00106 LABEL RECORDS ARE STANDARD DTSBX774 00107 BLOCK CONTAINS 0 RECORDS. DTSBX774 00108 01 ACCTS-RECEIVABLE-REC PIC X(155). DTSBX774 00109 SKIP3 DTSBX774 00110 WORKING-STORAGE SECTION. DTSBX774 001105 77 PAN-VALET PICTURE X(24) VALUE '003DTSBX774 03/31/11'. DTSBX774 00111 SKIP3 DTSBX774 00112 01 WRK-AREA. DTSBX774 00113 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +774.DTSBX774 00114 DTSBX774 00115 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX774'.DTSBX774 00116 DTSBX774 00117 05 ABEND-MSG PIC X(60). DTSBX774 00118 DTSBX774 00119 05 X774-STATUS PIC X(02) VALUE SPACES. DTSBX774 00120 88 X774-STATUS-OK-88 VALUE ZEROS. DTSBX774 00121 DTSBX774 00122 05 WRK-LEN PIC S9(04) COMP DTSBX774 00123 VALUE +155. DTSBX774 00124 DTSBX774 00125 05 WRK-REC-AREA PIC X(155). DTSBX774 00126 DTSBX774 00127 05 WRK-ESTB-FILLER PIC X(11) VALUE SPACES. DTSBX774 00128 05 WRK-LIQD-FILLER PIC X(20) VALUE SPACES. DTSBX774 00129 05 WRK-REM-BAL-FILLER PIC X(20) VALUE SPACES. DTSBX774 00130 DTSBX774 00131 ******************************************************************DTSBX774 00132 * THE RECEIVABLE TABLE CONTAINS ONE ENTRY FOR EACH RECEIVABLE DTSBX774 00133 * FOR A GIVEN EMPLOYER/QUARTER. THE PROCESSED DATE, RECEIVED DTSBX774 00134 * DATE AND AMOUNT COME FROM THE DTSIY774 RECORD. THE OTHER DTSBX774 00135 * FIELDS ARE CALCULATED. THE START BALANCE IS THE RECEIVABLE DTSBX774 00136 * BALANCE DUE BEFORE APPLYING ANY REPORT QUARTER LIQUIDATIONS. DTSBX774 00137 * THE END BALANCE IS THE RECEIVABLE BALANCE DUE AFTER APPLYING DTSBX774 00138 * ANY REPORT QUARTER LIQUIDATIONS. DTSBX774 00139 ******************************************************************DTSBX774 00140 05 RT-SUB PIC S9(04) COMP VALUE +0. DTSBX774 00141 05 RT-LAST PIC S9(04) COMP VALUE +0. DTSBX774 00142 05 RT-MAX PIC S9(04) COMP VALUE +200. DTSBX774 00143 05 RECEIVABLE-TABLE OCCURS 200 TIMES. DTSBX774 00144 10 RT-PROCESSED-DATE PIC S9(09) COMP-3. DTSBX774 00145 10 RT-RECEIVED-DATE PIC S9(09) COMP-3. DTSBX774 00146 10 RT-AMT PIC S9(09)V99 COMP-3. DTSBX774 00147 10 RT-START-BALANCE PIC S9(09)V99 COMP-3. DTSBX774 00148 10 RT-END-BALANCE PIC S9(09)V99 COMP-3. DTSBX774 00149 10 RT-581-TYPE PIC X(01). DTSBX774 00150 88 RT-581-TYPE-ESTABLISHED-88 VALUE '0'. DTSBX774 00151 88 RT-581-TYPE-BALANCE-88 VALUE '1'. DTSBX774 00152 88 RT-581-TYPE-REMOVED-NOW-88 VALUE '2'. DTSBX774 00153 88 RT-581-TYPE-REMOVED-PRIOR-88 VALUE '3'. DTSBX774 00154 88 RT-581-TYPE-REMOVED-88 VALUE '2' '3'. DTSBX774 00155 DTSBX774 00156 ******************************************************************DTSBX774 00157 * THE LIQUIDATION TABLE CONTAINS ONE ENTRY FOR EACH LIQUIDATION DTSBX774 00158 * PROCESSED DURING THE REPORT QUARTER FOR A GIVEN EMPLOYER/QUARTERDTSBX774 00159 * THE PROCESSED DATE AND THE AMOUNT COME FROM THE DTSIY774 RECORD.DTSBX774 00160 * THE AMOUNT APPLIED IS THE PORTION OF LT-AMOUNT APPLIED TO DTSBX774 00161 * RECEIVABLES THAT HAVE NOT BEEN REMOVED (EITHER DURING THE REPORTDTSBX774 00162 * QUARTER OR PREVIOUSLY). THE TIMELY INDICATOR MARKS LIQUIDATIONS DTSBX774 00163 * APPLIED TO RECEIVABLES ESTABLISHED DURING THE REPORT QUARTER DTSBX774 00164 * WHERE THE RECEIVABLE IS COMPLETELY LIQUIDATED PRIOR TO THE DTSBX774 00165 * TAX DUE DATE. SINCE THERE WAS NEVER A PAST DUE BALANCE, THESE DTSBX774 00166 * ARE NOT ACTUAL RECEIVABLES AND ARE NOT REPORTED ON THE 581. DTSBX774 00167 ******************************************************************DTSBX774 00168 05 LT-SUB PIC S9(04) COMP VALUE +0. DTSBX774 00169 05 LT-LAST PIC S9(04) COMP VALUE +0. DTSBX774 00170 05 LT-MAX PIC S9(04) COMP VALUE +200. DTSBX774 00171 05 LIQUIDATION-TABLE OCCURS 200 TIMES. DTSBX774 00172 10 LT-PROCESSED-DATE PIC S9(09) COMP-3. DTSBX774 00173 10 LT-RCVD-DATE PIC S9(09) COMP-3. DTSBX774 00174 10 LT-AMT PIC S9(09)V99 COMP-3. DTSBX774 00175 DTSBX774 00176 ******************************************************************DTSBX774 00177 * THE LIQUIDATION APPLIED TABLE RELATES LIQUIDATIONS TO THE DTSBX774 00178 * RECEIVABLES TO WHICH THEY ARE APPLIED. LA-LIQD-IDX IS DTSBX774 00179 * THE SUBSCRIPT OF THE LIQUIDATION. LA-RCVBL-IDX IS THE DTSBX774 00180 * SUBSCRIPT OF THE RELATED RECEIVABLE. DTSBX774 00181 ******************************************************************DTSBX774 00182 05 LA-SUB PIC S9(04) COMP VALUE +0. DTSBX774 00183 05 LA-LAST PIC S9(04) COMP VALUE +0. DTSBX774 00184 05 LA-MAX PIC S9(04) COMP VALUE +200. DTSBX774 00185 05 LIQUIDATION-APPLIED-TABLE OCCURS 200 TIMES. DTSBX774 00186 10 LA-LIQD-IDX PIC S9(04) COMP. DTSBX774 00187 10 LA-RCVBL-IDX PIC S9(04) COMP. DTSBX774 00188 10 LA-AMT PIC S9(09)V99 COMP-3. DTSBX774 00189 DTSBX774 00190 05 WRK-EMP-NO PIC S9(07) COMP-3 VALUE +0. DTSBX774 00191 05 WRK-EMP-CLASS PIC X(01). DTSBX774 00192 88 WRK-EMP-CLASS-CONTRIB-88 VALUE 'R'. DTSBX774 00193 88 WRK-EMP-CLASS-REIMB-88 VALUE 'S'. DTSBX774 00194 05 WRK-YRQ PIC S9(05) COMP-3 VALUE +0. DTSBX774 00195 05 WRK-DUE-DATE PIC S9(09) COMP-3 VALUE +0. DTSBX774 00196 05 WRK-LIQD-AMT PIC S9(11)V99 COMP-3. DTSBX774 00197 05 WRK-LIQD-REMAINING PIC S9(11)V99 COMP-3. DTSBX774 00198 05 WRK-AMT-APPLIED PIC S9(11)V99 COMP-3. DTSBX774 00199 05 WRK-P5200-AMT PIC S9(11)V99 COMP-3. DTSBX774 00200 05 WRK-RQ-END-ABS PIC S9(08) COMP. DTSBX774 00201 05 WRK-ERQ-END-ABS PIC S9(08) COMP. DTSBX774 00202 05 WRK-AGE PIC S9(05) COMP-3. DTSBX774 00203 DTSBX774 00204 05 X774-DATA. DTSBX774 00205 10 X774-OBS-NBR PIC 9(07). DTSBX774 00206 10 X774-EMP-NO PIC 9(07). DTSBX774 00207 10 X774-EMP-TYPE PIC X(24). DTSBX774 00208 10 X774-TRANS-DATE PIC X(10). DTSBX774 00209 10 X774-ESTB-Q-DATE PIC X(10). DTSBX774 00210 10 X774-EMP-RPT-QTR PIC 9(06). DTSBX774 00211 10 X774-DUE-DATE PIC X(10). DTSBX774 00212 10 X774-TRANS-TYPE PIC X(01). DTSBX774 00213 88 X774-TRANS-ESTB-RQ-88 VALUE 'E'. DTSBX774 00214 88 X774-TRANS-LIQUIDATE-88 VALUE 'L'. DTSBX774 00215 88 X774-TRANS-UNCOLLECT-88 VALUE 'U'. DTSBX774 00216 88 X774-TRANS-REMOVED-88 VALUE 'R'. DTSBX774 00217 88 X774-TRANS-BALANCE-88 VALUE 'B'. DTSBX774 00218 10 X774-AMT-ESTB-IN-RQ PIC --------9.99. DTSBX774 00219 10 X774-LIQUIDATED PIC --------9.99. DTSBX774 00220 10 X774-UNCOLLECT PIC --------9.99. DTSBX774 00221 10 X774-REMOVED PIC --------9.99. DTSBX774 00222 10 X774-BALANCE PIC --------9.99. DTSBX774 00223 10 X774-AGE PIC 9(05). DTSBX774 00224 DTSBX774 00225 05 WRK-REMOVED-CON PIC S9(11)V99 COMP-3. DTSBX774 00226 05 WRK-REMOVED-RMB PIC S9(11)V99 COMP-3. DTSBX774 00227 05 WRK-UNTIMELY-IND PIC X(01). DTSBX774 00228 88 WRK-UNTIMELY-YES-88 VALUE 'Y'. DTSBX774 00229 88 WRK-UNTIMELY-NO-88 VALUE 'N'. DTSBX774 00230 DTSBX774 00231 05 WRK-COUNT-EMP-IND PIC X(01) VALUE 'N'. DTSBX774 00232 88 WRK-COUNT-EMP-YES-88 VALUE 'Y'. DTSBX774 00233 88 WRK-COUNT-EMP-NO-88 VALUE 'N'. DTSBX774 00234 DTSBX774 00235 05 WRK-6-MONTHS-AMT PIC S9(11)V99 COMP-3 VALUE +0. DTSBX774 00236 05 WRK-9-MONTHS-QTR PIC S9(05) COMP-3 VALUE +0. DTSBX774 00237 05 WRK-9-MONTHS-AMT PIC S9(11)V99 COMP-3 VALUE +0. DTSBX774 00238 05 WRK-12-MONTHS-QTR PIC S9(05) COMP-3 VALUE +0. DTSBX774 00239 05 WRK-12-MONTHS-AMT PIC S9(11)V99 COMP-3 VALUE +0. DTSBX774 00240 05 WRK-15-MONTHS-QTR PIC S9(05) COMP-3 VALUE +0. DTSBX774 00241 05 WRK-15-MONTHS-AMT PIC S9(11)V99 COMP-3 VALUE +0. DTSBX774 00242 05 WRK-OVER-15-MONTHS-AMT PIC S9(11)V99 COMP-3 VALUE +0. DTSBX774 00243 DTSBX774 00244 05 WRK-OBS-NBR PIC S9(07) COMP-3 VALUE +0. DTSBX774 00245 DTSBX774 00246 05 WRK-EMP-CLASS-AREA. DTSBX774 00247 10 WRK-DV-EMP-CLASS PIC X(01). DTSBX774 00248 88 WRK-DV-EMP-CLASS-CONTRIB-88 VALUE 'C'. DTSBX774 00249 88 WRK-DV-EMP-CLASS-REIMB-88 VALUE 'R'. DTSBX774 00250 10 FILLER PIC X(01) VALUE '-'. DTSBX774 00251 10 WRK-MPRF-EMP-CLASS PIC X(01). DTSBX774 00252 10 FILLER PIC X(21) VALUE SPACES. DTSBX774 00253 05 WRK-EMP-CLASS-DISP REDEFINES WRK-EMP-CLASS-AREA DTSBX774 00254 PIC X(24). DTSBX774 00255 DTSBX774 00256 05 WRK-RPT-QTR-AREA. DTSBX774 00257 10 WRK-RPT-QTR-YR PIC X(04). DTSBX774 00258 10 WRK-RPT-QTR-SLASH PIC X(01). DTSBX774 00259 10 WRK-RPT-QTR-Q PIC X(01). DTSBX774 00260 05 WRK-RPT-QTR-9 REDEFINES WRK-RPT-QTR-AREA PIC 9(06). DTSBX774 00261 DTSBX774 00262 05 WRK-ETA581-DATA-AREA. DTSBX774 00263 10 WRK-CON-RECVBL-BEG-PERIOD DTSBX774 00264 PIC S9(11)V9(02) COMP-3. DTSBX774 00265 10 WRK-CON-RECVBL-DETERM DTSBX774 00266 PIC S9(11)V9(02) COMP-3. DTSBX774 00267 10 WRK-CON-RECVBL-LIQUID DTSBX774 00268 PIC S9(11)V9(02) COMP-3. DTSBX774 00269 10 WRK-CON-RECVBL-UNCOLLECT DTSBX774 00270 PIC S9(11)V9(02) COMP-3. DTSBX774 00271 10 WRK-CON-RECVBL-REMOVED DTSBX774 00272 PIC S9(11)V9(02) COMP-3. DTSBX774 00273 10 WRK-CON-RECVBL-END-PERIOD DTSBX774 00274 PIC S9(11)V9(02) COMP-3. DTSBX774 00275 10 WRK-CON-RECVBL-EMP-CNT DTSBX774 00276 PIC S9(07) COMP-3. DTSBX774 00277 10 WRK-CON-RECVBL-6-MOS DTSBX774 00278 PIC S9(11)V9(02) COMP-3. DTSBX774 00279 10 WRK-CON-RECVBL-9-MOS DTSBX774 00280 PIC S9(11)V9(02) COMP-3. DTSBX774 00281 10 WRK-CON-RECVBL-12-MOS DTSBX774 00282 PIC S9(11)V9(02) COMP-3. DTSBX774 00283 10 WRK-CON-RECVBL-15-MOS DTSBX774 00284 PIC S9(11)V9(02) COMP-3. DTSBX774 00285 10 WRK-CON-RECVBL-OVER15-MOS DTSBX774 00286 PIC S9(11)V9(02) COMP-3. DTSBX774 00287 DTSBX774 00288 10 WRK-REIMB-RECVBL-BEG-PERIOD DTSBX774 00289 PIC S9(11)V9(02) COMP-3. DTSBX774 00290 10 WRK-REIMB-RECVBL-DETERM DTSBX774 00291 PIC S9(11)V9(02) COMP-3. DTSBX774 00292 10 WRK-REIMB-RECVBL-LIQUID DTSBX774 00293 PIC S9(11)V9(02) COMP-3. DTSBX774 00294 10 WRK-REIMB-RECVBL-UNCOLLECT DTSBX774 00295 PIC S9(11)V9(02) COMP-3. DTSBX774 00296 10 WRK-REIMB-RECVBL-REMOVED DTSBX774 00297 PIC S9(11)V9(02) COMP-3. DTSBX774 00298 10 WRK-REIMB-RECVBL-END-PERIOD DTSBX774 00299 PIC S9(11)V9(02) COMP-3. DTSBX774 00300 10 WRK-REIMB-RECVBL-EMP-CNT DTSBX774 00301 PIC S9(07) COMP-3. DTSBX774 00302 10 WRK-REIMB-RECVBL-6-MOS DTSBX774 00303 PIC S9(11)V9(02) COMP-3. DTSBX774 00304 10 WRK-REIMB-RECVBL-9-MOS DTSBX774 00305 PIC S9(11)V9(02) COMP-3. DTSBX774 00306 10 WRK-REIMB-RECVBL-12-MOS DTSBX774 00307 PIC S9(11)V9(02) COMP-3. DTSBX774 00308 10 WRK-REIMB-RECVBL-15-MOS DTSBX774 00309 PIC S9(11)V9(02) COMP-3. DTSBX774 00310 10 WRK-REIMB-RECVBL-OVER15-MOS DTSBX774 00311 PIC S9(11)V9(02) COMP-3. DTSBX774 00312 DTSBX774 00313 05 WRK-RECS-WRITTEN-CNT PIC S9(07) COMP-3 DTSBX774 00314 VALUE +0. DTSBX774 00315 DTSBX774 00316 05 WRK-DISP-EMP PIC S9(07) COMP-3 DTSBX774 00317 VALUE +010169. DTSBX774 00318 DTSBX774 00319 05 DISPLAY-CNT PIC Z(06)9. DTSBX774 00320 05 DISPLAY-AMT-X PIC X(15). DTSBX774 00321 05 DISPLAY-AMT REDEFINES DISPLAY-AMT-X DTSBX774 00322 PIC ZZZ,ZZZ,ZZ9.99-. DTSBX774 00323 EJECT DTSBX774 00324 01 L001-LINK-AREA. DTSBX774 00325 ++INCLUDE DTSIL001 DTSBX774 00326 EJECT DTSBX774 00327 01 L004-LINK-AREA. DTSBX774 00328 ++INCLUDE DTSIL004 DTSBX774 00329 EJECT DTSBX774 00330 SKIP3 DTSBX774 00331 01 Y774-REC. DTSBX774 00332 ++INCLUDE DTSIY774 DTSBX774 00333 EJECT DTSBX774 00334 LINKAGE SECTION. DTSBX774 00335 SKIP3 DTSBX774 00336 01 XL774-LINK-AREA. DTSBX774 00337 ++INCLUDE DTSXL774 DTSBX774 00338 DTSBX774 00339 01 X770-PARM-REC. DTSBX774 00340 ++INCLUDE DTSIX770 DTSBX774 00341 DTSBX774 00342 01 RSKL-REC. DTSBX774 00343 ++INCLUDE DTSIRSK1 DTSBX774 00344 EJECT DTSBX774 00345 PROCEDURE DIVISION USING XL774-LINK-AREA DTSBX774 00346 X770-PARM-REC DTSBX774 00347 RSKL-REC. DTSBX774 00348 DTSBX774 00349 IF XL774-CMD-PROCESS-88 DTSBX774 00350 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX774 00351 ELSE DTSBX774 00352 IF XL774-CMD-INIT-88 DTSBX774 00353 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBX774 00354 ELSE DTSBX774 00355 IF XL774-CMD-TERMINATE-88 DTSBX774 00356 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBX774 00357 ELSE DTSBX774 00358 MOVE 'INVALID L770-CALL-TYPE-IND ENCOUNTERED' DTSBX774 00359 TO ABEND-MSG DTSBX774 00360 PERFORM S999-ABEND THRU S999-EXIT. DTSBX774 00361 SKIP2 DTSBX774 00362 GOBACK. DTSBX774 00363 EJECT DTSBX774 00364 I0000-INITIALIZE. DTSBX774 00365 MOVE +0 TO RT-SUB DTSBX774 00366 LT-SUB. DTSBX774 00367 DTSBX774 00368 MOVE +0 TO WRK-REMOVED-CON DTSBX774 00369 WRK-REMOVED-RMB. DTSBX774 00370 OPEN OUTPUT ACCTS-RECEIVABLE DTSBX774 00371 IF NOT X774-STATUS-OK-88 DTSBX774 00372 DISPLAY 'FILE STATUS IS : ' X774-STATUS DTSBX774 00373 MOVE 'CANNOT OPEN OUTPUT FILE ' TO ABEND-MSG DTSBX774 00374 PERFORM S999-ABEND THRU S999-EXIT. DTSBX774 00375 DTSBX774 00376 PERFORM I1000-INIT-581-COUNTS THRU I1000-EXIT. DTSBX774 00377 DTSBX774 00378 PERFORM I2000-AGING-QTRS THRU I2000-EXIT. DTSBX774 00379 DTSBX774 00380 I0000-EXIT. DTSBX774 00381 EXIT. DTSBX774 00382 DTSBX774 00383 I1000-INIT-581-COUNTS. DTSBX774 00384 MOVE +0 TO WRK-CON-RECVBL-BEG-PERIOD DTSBX774 00385 WRK-CON-RECVBL-DETERM DTSBX774 00386 WRK-CON-RECVBL-LIQUID DTSBX774 00387 WRK-CON-RECVBL-UNCOLLECT DTSBX774 00388 WRK-CON-RECVBL-REMOVED DTSBX774 00389 WRK-CON-RECVBL-END-PERIOD DTSBX774 00390 WRK-CON-RECVBL-EMP-CNT DTSBX774 00391 WRK-CON-RECVBL-6-MOS DTSBX774 00392 WRK-CON-RECVBL-9-MOS DTSBX774 00393 WRK-CON-RECVBL-12-MOS DTSBX774 00394 WRK-CON-RECVBL-15-MOS DTSBX774 00395 WRK-CON-RECVBL-OVER15-MOS DTSBX774 00396 WRK-REIMB-RECVBL-BEG-PERIOD DTSBX774 00397 WRK-REIMB-RECVBL-DETERM DTSBX774 00398 WRK-REIMB-RECVBL-LIQUID DTSBX774 00399 WRK-REIMB-RECVBL-UNCOLLECT DTSBX774 00400 WRK-REIMB-RECVBL-REMOVED DTSBX774 00401 WRK-REIMB-RECVBL-END-PERIOD DTSBX774 00402 WRK-REIMB-RECVBL-EMP-CNT DTSBX774 00403 WRK-REIMB-RECVBL-6-MOS DTSBX774 00404 WRK-REIMB-RECVBL-9-MOS DTSBX774 00405 WRK-REIMB-RECVBL-12-MOS DTSBX774 00406 WRK-REIMB-RECVBL-15-MOS DTSBX774 00407 WRK-REIMB-RECVBL-OVER15-MOS. DTSBX774 00408 DTSBX774 00409 DTSBX774 00410 I1000-EXIT. DTSBX774 00411 EXIT. DTSBX774 00412 DTSBX774 00413 I2000-AGING-QTRS. DTSBX774 00414 MOVE X770-SUBJECT-QTR TO L004-QTR-5-9. DTSBX774 00415 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX774 00416 SUBTRACT 3 FROM L004-ABS-QTR. DTSBX774 00417 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBX774 00418 MOVE L004-QTR-5-9 TO WRK-9-MONTHS-QTR. DTSBX774 00419 DTSBX774 00420 SUBTRACT 1 FROM L004-ABS-QTR. DTSBX774 00421 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBX774 00422 MOVE L004-QTR-5-9 TO WRK-12-MONTHS-QTR. DTSBX774 00423 DTSBX774 00424 SUBTRACT 1 FROM L004-ABS-QTR. DTSBX774 00425 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBX774 00426 MOVE L004-QTR-5-9 TO WRK-15-MONTHS-QTR. DTSBX774 00427 DTSBX774 00428 I2000-EXIT. DTSBX774 00429 EXIT. DTSBX774 00430 DTSBX774 00431 P0000-PROCESS. DTSBX774 00432 MOVE RSKL-REC TO Y774-REC. DTSBX774 00433 DTSBX774 00434 IF WRK-EMP-NO = ZERO DTSBX774 00435 PERFORM P1300-INIT-TABLES THRU P1300-EXIT DTSBX774 00436 PERFORM P1000-BUILD-TABLES THRU P1000-EXIT DTSBX774 00437 ELSE DTSBX774 00438 IF Y774-EMP-NO = WRK-EMP-NO DTSBX774 00439 AND Y774-YRQ = WRK-YRQ DTSBX774 00440 PERFORM P1000-BUILD-TABLES THRU P1000-EXIT DTSBX774 00441 ELSE DTSBX774 00442 PERFORM P2000-STARTING-BALANCE THRU P2000-EXIT DTSBX774 00443 PERFORM P3000-SET-581-TYPE THRU P3000-EXIT DTSBX774 00444 PERFORM P4000-RPT-QTR-LIQUIDATIONS THRU P4000-EXIT DTSBX774 00445 PERFORM P5000-WRITE-OUTPUT THRU P5000-EXIT DTSBX774 00446 PERFORM P1300-INIT-TABLES THRU P1300-EXIT DTSBX774 00447 PERFORM P1000-BUILD-TABLES THRU P1000-EXIT. DTSBX774 00448 DTSBX774 00449 P0000-EXIT. DTSBX774 00450 EXIT. DTSBX774 00451 DTSBX774 00452 DTSBX774 00453 P1000-BUILD-TABLES. DTSBX774 00454 IF Y774-TYPE-RECEIVABLE-88 DTSBX774 00455 PERFORM P1100-BUILD-RCVBL-TABLE THRU P1100-EXIT DTSBX774 00456 ELSE DTSBX774 00457 IF Y774-TYPE-LIQUIDATION-88 DTSBX774 00458 PERFORM P1200-BUILD-LIQD-TABLE THRU P1200-EXIT. DTSBX774 00459 DTSBX774 00460 P1000-EXIT. DTSBX774 00461 EXIT. DTSBX774 00462 DTSBX774 00463 P1100-BUILD-RCVBL-TABLE. DTSBX774 00464 IF RT-SUB < RT-MAX DTSBX774 00465 ADD +1 TO RT-SUB DTSBX774 00466 RT-LAST DTSBX774 00467 ELSE DTSBX774 00468 MOVE 'RECEIVABLE TABLE LENGTH EXCEEDED' DTSBX774 00469 TO ABEND-MSG DTSBX774 00470 PERFORM S999-ABEND THRU S999-EXIT. DTSBX774 00471 DTSBX774 00472 MOVE Y774-ESTB-DATE TO RT-PROCESSED-DATE (RT-SUB). DTSBX774 00473 MOVE Y774-RCVD-DATE TO RT-RECEIVED-DATE (RT-SUB). DTSBX774 00474 MOVE Y774-AMT TO RT-AMT (RT-SUB) DTSBX774 00475 RT-START-BALANCE (RT-SUB) DTSBX774 00476 RT-END-BALANCE (RT-SUB). DTSBX774 00477 P1100-EXIT. DTSBX774 00478 EXIT. DTSBX774 00479 DTSBX774 00480 P1200-BUILD-LIQD-TABLE. DTSBX774 00481 DTSBX774 00482 IF Y774-ESTB-DATE < X770-SUBJECT-QTR-START DTSBX774 00483 ADD Y774-AMT TO WRK-LIQD-AMT DTSBX774 00484 ELSE DTSBX774 00485 IF LT-SUB < LT-MAX DTSBX774 00486 ADD +1 TO LT-SUB DTSBX774 00487 LT-LAST DTSBX774 00488 MOVE Y774-ESTB-DATE TO LT-PROCESSED-DATE (LT-SUB) DTSBX774 00489 MOVE Y774-RCVD-DATE TO LT-RCVD-DATE (LT-SUB) DTSBX774 00490 MOVE Y774-AMT TO LT-AMT (LT-SUB) DTSBX774 00491 ELSE DTSBX774 00492 MOVE 'LIQUIDATION TABLE LENGTH EXCEEDED' DTSBX774 00493 TO ABEND-MSG DTSBX774 00494 PERFORM S999-ABEND THRU S999-EXIT. DTSBX774 00495 DTSBX774 00496 P1200-EXIT. DTSBX774 00497 EXIT. DTSBX774 00498 DTSBX774 00499 P1300-INIT-TABLES. DTSBX774 00500 IF Y774-EMP-NO NOT = WRK-EMP-NO DTSBX774 00501 IF WRK-COUNT-EMP-YES-88 DTSBX774 00502 SET WRK-COUNT-EMP-NO-88 TO TRUE DTSBX774 00503 IF WRK-EMP-CLASS-CONTRIB-88 DTSBX774 00504 ADD +1 TO WRK-CON-RECVBL-EMP-CNT DTSBX774 00505 ELSE DTSBX774 00506 ADD +1 TO WRK-REIMB-RECVBL-EMP-CNT DTSBX774 00507 END-IF DTSBX774 00508 END-IF DTSBX774 00509 END-IF. DTSBX774 00510 DTSBX774 00511 MOVE Y774-EMP-NO TO WRK-EMP-NO. DTSBX774 00512 MOVE Y774-EMP-CLASS TO WRK-EMP-CLASS. DTSBX774 00513 MOVE Y774-YRQ TO WRK-YRQ. DTSBX774 00514 MOVE Y774-DUE-DATE TO WRK-DUE-DATE. DTSBX774 00515 DTSBX774 00516 PERFORM DTSBX774 00517 VARYING RT-SUB FROM +1 BY +1 DTSBX774 00518 UNTIL RT-SUB > RT-MAX DTSBX774 00519 MOVE +0 TO RT-PROCESSED-DATE (RT-SUB) DTSBX774 00520 RT-RECEIVED-DATE (RT-SUB) DTSBX774 00521 RT-AMT (RT-SUB) DTSBX774 00522 RT-START-BALANCE (RT-SUB) DTSBX774 00523 RT-END-BALANCE (RT-SUB) DTSBX774 00524 MOVE SPACES TO RT-581-TYPE (RT-SUB) DTSBX774 00525 END-PERFORM. DTSBX774 00526 DTSBX774 00527 PERFORM DTSBX774 00528 VARYING LT-SUB FROM +1 BY +1 DTSBX774 00529 UNTIL LT-SUB > LT-MAX DTSBX774 00530 MOVE +0 TO LT-PROCESSED-DATE (LT-SUB) DTSBX774 00531 LT-RCVD-DATE (LT-SUB) DTSBX774 00532 LT-AMT (LT-SUB) DTSBX774 00533 END-PERFORM. DTSBX774 00534 DTSBX774 00535 PERFORM DTSBX774 00536 VARYING LA-SUB FROM +1 BY +1 DTSBX774 00537 UNTIL LA-SUB > LA-MAX DTSBX774 00538 MOVE +0 TO LA-RCVBL-IDX (LA-SUB) DTSBX774 00539 LA-LIQD-IDX (LA-SUB) DTSBX774 00540 LA-AMT (LA-SUB) DTSBX774 00541 END-PERFORM. DTSBX774 00542 DTSBX774 00543 MOVE +0 TO RT-SUB DTSBX774 00544 RT-LAST DTSBX774 00545 LT-SUB DTSBX774 00546 LT-LAST DTSBX774 00547 LA-SUB DTSBX774 00548 LA-LAST DTSBX774 00549 WRK-LIQD-AMT DTSBX774 00550 WRK-LIQD-REMAINING. DTSBX774 00551 DTSBX774 00552 P1300-EXIT. DTSBX774 00553 EXIT. DTSBX774 00554 DTSBX774 00555 DTSBX774 00556 P2000-STARTING-BALANCE. DTSBX774 00557 COMPUTE WRK-LIQD-REMAINING = (WRK-LIQD-AMT * -1). DTSBX774 00558 DTSBX774 00559 PERFORM DTSBX774 00560 VARYING RT-SUB FROM +1 BY +1 DTSBX774 00561 UNTIL RT-SUB > RT-LAST DTSBX774 00562 OR WRK-LIQD-REMAINING NOT > ZERO DTSBX774 00563 IF RT-START-BALANCE (RT-SUB) > ZERO DTSBX774 00564 IF WRK-LIQD-REMAINING >= RT-START-BALANCE (RT-SUB) DTSBX774 00565 SUBTRACT RT-START-BALANCE (RT-SUB) FROM DTSBX774 00566 WRK-LIQD-REMAINING DTSBX774 00567 MOVE ZERO TO RT-START-BALANCE (RT-SUB) DTSBX774 00568 ELSE DTSBX774 00569 SUBTRACT WRK-LIQD-REMAINING FROM DTSBX774 00570 RT-START-BALANCE (RT-SUB) DTSBX774 00571 MOVE ZERO TO WRK-LIQD-REMAINING DTSBX774 00572 END-IF DTSBX774 00573 END-IF DTSBX774 00574 END-PERFORM. DTSBX774 00575 DTSBX774 00576 P2000-EXIT. DTSBX774 00577 EXIT. DTSBX774 00578 DTSBX774 00579 P3000-SET-581-TYPE. DTSBX774 00580 PERFORM P3100-SCAN-TABLE THRU P3100-EXIT DTSBX774 00581 VARYING RT-SUB FROM +1 BY +1 DTSBX774 00582 UNTIL RT-SUB > RT-LAST. DTSBX774 00583 DTSBX774 00584 P3000-EXIT. DTSBX774 00585 EXIT. DTSBX774 00586 DTSBX774 00587 P3100-SCAN-TABLE. DTSBX774 00588 MOVE RT-START-BALANCE (RT-SUB) TO DTSBX774 00589 RT-END-BALANCE (RT-SUB). DTSBX774 00590 DTSBX774 00591 IF RT-PROCESSED-DATE (RT-SUB) >= DTSBX774 00592 X770-SUBJECT-QTR-START DTSBX774 00593 AND RT-PROCESSED-DATE (RT-SUB) <= DTSBX774 00594 X770-SUBJECT-QTR-END DTSBX774 00595 SET RT-581-TYPE-ESTABLISHED-88 (RT-SUB) TO TRUE DTSBX774 00596 ELSE DTSBX774 00597 IF RT-START-BALANCE (RT-SUB) > ZERO DTSBX774 00598 PERFORM P3110-PRIOR-QTRS THRU P3110-EXIT. DTSBX774 00599 DTSBX774 00600 P3100-EXIT. DTSBX774 00601 EXIT. DTSBX774 00602 DTSBX774 00603 P3110-PRIOR-QTRS. DTSBX774 00604 EVALUATE TRUE DTSBX774 00605 WHEN WRK-YRQ > X770-QTR8 DTSBX774 00606 SET RT-581-TYPE-BALANCE-88 (RT-SUB) TO TRUE DTSBX774 00607 DTSBX774 00608 WHEN WRK-YRQ = X770-QTR8 DTSBX774 00609 IF RT-PROCESSED-DATE (RT-SUB) < X770-QTR1-START DTSBX774 00610 SET RT-581-TYPE-REMOVED-NOW-88 (RT-SUB) TO TRUE DTSBX774 00611 ELSE DTSBX774 00612 SET RT-581-TYPE-BALANCE-88 (RT-SUB) TO TRUE DTSBX774 00613 END-IF DTSBX774 00614 DTSBX774 00615 WHEN WRK-YRQ < X770-QTR8 DTSBX774 00616 IF RT-PROCESSED-DATE (RT-SUB) < X770-QTR2-START DTSBX774 00617 SET RT-581-TYPE-REMOVED-PRIOR-88 (RT-SUB) TO TRUE DTSBX774 00618 ELSE DTSBX774 00619 IF RT-PROCESSED-DATE (RT-SUB) < X770-QTR1-START DTSBX774 00620 SET RT-581-TYPE-REMOVED-NOW-88 (RT-SUB) TO TRUE DTSBX774 00621 ELSE DTSBX774 00622 SET RT-581-TYPE-BALANCE-88 (RT-SUB) TO TRUE DTSBX774 00623 END-IF DTSBX774 00624 END-IF DTSBX774 00625 DTSBX774 00626 END-EVALUATE. DTSBX774 00627 DTSBX774 00628 P3110-EXIT. DTSBX774 00629 EXIT. DTSBX774 00630 DTSBX774 00631 P4000-RPT-QTR-LIQUIDATIONS. DTSBX774 00632 PERFORM DTSBX774 00633 VARYING LT-SUB FROM +1 BY +1 DTSBX774 00634 UNTIL LT-SUB > LT-LAST DTSBX774 00635 COMPUTE WRK-LIQD-REMAINING = (LT-AMT (LT-SUB) * -1) DTSBX774 00636 PERFORM P4100-APPLY-LIQD THRU P4100-EXIT DTSBX774 00637 END-PERFORM. DTSBX774 00638 DTSBX774 00639 P4000-EXIT. DTSBX774 00640 EXIT. DTSBX774 00641 DTSBX774 00642 P4100-APPLY-LIQD. DTSBX774 00643 PERFORM DTSBX774 00644 VARYING RT-SUB FROM +1 BY +1 DTSBX774 00645 UNTIL RT-SUB > RT-LAST DTSBX774 00646 OR WRK-LIQD-REMAINING NOT > ZERO DTSBX774 00647 PERFORM P4110-APPLY THRU P4110-EXIT DTSBX774 00648 END-PERFORM. DTSBX774 00649 DTSBX774 00650 P4100-EXIT. DTSBX774 00651 EXIT. DTSBX774 00652 DTSBX774 00653 P4110-APPLY. DTSBX774 00654 IF RT-END-BALANCE (RT-SUB) > ZERO DTSBX774 00655 IF WRK-LIQD-REMAINING >= RT-END-BALANCE (RT-SUB) DTSBX774 00656 SUBTRACT RT-END-BALANCE (RT-SUB) FROM DTSBX774 00657 WRK-LIQD-REMAINING DTSBX774 00658 MOVE RT-END-BALANCE (RT-SUB) TO WRK-AMT-APPLIED DTSBX774 00659 MOVE ZERO TO RT-END-BALANCE (RT-SUB) DTSBX774 00660 PERFORM P4111-BUILD-LA-TABLE THRU P4111-EXIT DTSBX774 00661 ELSE DTSBX774 00662 SUBTRACT WRK-LIQD-REMAINING FROM DTSBX774 00663 RT-END-BALANCE (RT-SUB) DTSBX774 00664 MOVE WRK-LIQD-REMAINING TO WRK-AMT-APPLIED DTSBX774 00665 MOVE ZERO TO WRK-LIQD-REMAINING DTSBX774 00666 PERFORM P4111-BUILD-LA-TABLE THRU P4111-EXIT DTSBX774 00667 END-IF DTSBX774 00668 END-IF. DTSBX774 00669 DTSBX774 00670 P4110-EXIT. DTSBX774 00671 EXIT. DTSBX774 00672 DTSBX774 00673 P4111-BUILD-LA-TABLE. DTSBX774 00674 IF RT-581-TYPE-REMOVED-88 (RT-SUB) DTSBX774 00675 GO TO P4111-EXIT. DTSBX774 00676 DTSBX774 00677 IF LA-SUB < LA-MAX DTSBX774 00678 ADD +1 TO LA-SUB DTSBX774 00679 LA-LAST DTSBX774 00680 MOVE RT-SUB TO LA-RCVBL-IDX (LA-SUB) DTSBX774 00681 MOVE LT-SUB TO LA-LIQD-IDX (LA-SUB) DTSBX774 00682 MOVE WRK-AMT-APPLIED TO LA-AMT (LA-SUB) DTSBX774 00683 ELSE DTSBX774 00684 MOVE 'RECEIVABLE TABLE LENGTH EXCEEDED' DTSBX774 00685 TO ABEND-MSG DTSBX774 00686 PERFORM S999-ABEND THRU S999-EXIT. DTSBX774 00687 DTSBX774 00688 DTSBX774 00689 P4111-EXIT. DTSBX774 00690 EXIT. DTSBX774 00691 DTSBX774 00692 P5000-WRITE-OUTPUT. DTSBX774 00693 PERFORM DTSBX774 00694 VARYING RT-SUB FROM +1 BY +1 DTSBX774 00695 UNTIL RT-SUB > RT-LAST DTSBX774 00696 DTSBX774 00697 IF RT-581-TYPE-ESTABLISHED-88 (RT-SUB) DTSBX774 00698 IF RT-END-BALANCE (RT-SUB) > ZERO DTSBX774 00699 PERFORM P5100-BUILD-RCVB-X774 THRU P5100-EXIT DTSBX774 00700 PERFORM P5200-BUILD-LIQD-X774 THRU P5200-EXIT DTSBX774 00701 ELSE DTSBX774 00702 PERFORM P5010-CHECK-UNTIMELY THRU P5010-EXIT DTSBX774 00703 IF WRK-UNTIMELY-YES-88 DTSBX774 00704 PERFORM P5100-BUILD-RCVB-X774 THRU P5100-EXIT DTSBX774 00705 PERFORM P5200-BUILD-LIQD-X774 THRU P5200-EXIT DTSBX774 00706 END-IF DTSBX774 00707 END-IF DTSBX774 00708 END-IF DTSBX774 00709 DTSBX774 00710 IF RT-581-TYPE-BALANCE-88 (RT-SUB) DTSBX774 00711 OR RT-581-TYPE-REMOVED-NOW-88 (RT-SUB) DTSBX774 00712 PERFORM P5100-BUILD-RCVB-X774 THRU P5100-EXIT DTSBX774 00713 PERFORM P5200-BUILD-LIQD-X774 THRU P5200-EXIT DTSBX774 00714 END-IF DTSBX774 00715 DTSBX774 00716 IF RT-581-TYPE-REMOVED-PRIOR-88 (RT-SUB) DTSBX774 00717 IF WRK-EMP-CLASS-CONTRIB-88 DTSBX774 00718 ADD RT-END-BALANCE (RT-SUB) TO WRK-REMOVED-CON DTSBX774 00719 ELSE DTSBX774 00720 ADD RT-END-BALANCE (RT-SUB) TO WRK-REMOVED-RMB DTSBX774 00721 END-IF DTSBX774 00722 END-IF DTSBX774 00723 END-PERFORM. DTSBX774 00724 DTSBX774 00725 P5000-EXIT. DTSBX774 00726 EXIT. DTSBX774 00727 DTSBX774 00728 P5010-CHECK-UNTIMELY. DTSBX774 00729 SET WRK-UNTIMELY-NO-88 TO TRUE. DTSBX774 00730 DTSBX774 00731 PERFORM DTSBX774 00732 VARYING LA-SUB FROM +1 BY +1 DTSBX774 00733 UNTIL LA-SUB > LA-LAST DTSBX774 00734 MOVE LA-LIQD-IDX (LA-SUB) TO LT-SUB DTSBX774 00735 IF LT-RCVD-DATE (LT-SUB) > WRK-DUE-DATE DTSBX774 00736 SET WRK-UNTIMELY-YES-88 TO TRUE DTSBX774 00737 END-IF DTSBX774 00738 END-PERFORM. DTSBX774 00739 DTSBX774 00740 P5010-EXIT. DTSBX774 00741 EXIT. DTSBX774 00742 DTSBX774 00743 P5100-BUILD-RCVB-X774. DTSBX774 00744 ADD +1 TO WRK-OBS-NBR. DTSBX774 00745 ADD +1 TO WRK-RECS-WRITTEN-CNT. DTSBX774 00746 DTSBX774 00747 MOVE WRK-EMP-NO TO X774-EMP-NO. DTSBX774 00748 MOVE WRK-OBS-NBR TO X774-OBS-NBR. DTSBX774 00749 DTSBX774 00750 IF RT-581-TYPE-ESTABLISHED-88 (RT-SUB) DTSBX774 00751 OR RT-581-TYPE-BALANCE-88 (RT-SUB) DTSBX774 00752 SET WRK-COUNT-EMP-YES-88 TO TRUE. DTSBX774 00753 DTSBX774 00754 IF WRK-EMP-CLASS-CONTRIB-88 DTSBX774 00755 SET WRK-DV-EMP-CLASS-CONTRIB-88 TO TRUE DTSBX774 00756 *& DTSBX774 00757 * GO TO P5100-EXIT DTSBX774 00758 *& DTSBX774 00759 ELSE DTSBX774 00760 IF WRK-EMP-CLASS-REIMB-88 DTSBX774 00761 SET WRK-DV-EMP-CLASS-REIMB-88 TO TRUE DTSBX774 00762 ELSE DTSBX774 00763 DISPLAY 'INVALID EMPLOYER CLASS ' WRK-EMP-NO DTSBX774 00764 ' CLASS: ' Y774-EMP-CLASS DTSBX774 00765 GO TO P5100-EXIT. DTSBX774 00766 DTSBX774 00767 MOVE WRK-EMP-CLASS TO WRK-MPRF-EMP-CLASS. DTSBX774 00768 MOVE WRK-EMP-CLASS-DISP TO X774-EMP-TYPE. DTSBX774 00769 DTSBX774 00770 MOVE RT-PROCESSED-DATE (RT-SUB) TO L001-FED-8-DATE-9. DTSBX774 00771 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX774 00772 IF RT-581-TYPE-ESTABLISHED-88 (RT-SUB) DTSBX774 00773 MOVE L001-SLASH-8-DATE TO X774-TRANS-DATE DTSBX774 00774 ELSE DTSBX774 00775 MOVE SPACES TO X774-TRANS-DATE. DTSBX774 00776 DTSBX774 00777 MOVE L001-SLASH-8-DATE TO X774-ESTB-Q-DATE DTSBX774 00778 DTSBX774 00779 MOVE WRK-YRQ TO L004-QTR-5-9. DTSBX774 00780 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX774 00781 MOVE L004-SLASH-5-QTR TO WRK-RPT-QTR-AREA. DTSBX774 00782 MOVE '0' TO WRK-RPT-QTR-SLASH. DTSBX774 00783 MOVE WRK-RPT-QTR-9 TO X774-EMP-RPT-QTR. DTSBX774 00784 DTSBX774 00785 MOVE L004-QTR-END-DATE TO L001-FED-8-DATE-9. DTSBX774 00786 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX774 00787 MOVE L001-JUL-ABS-DAY TO WRK-ERQ-END-ABS. DTSBX774 00788 DTSBX774 00789 MOVE X770-SUBJECT-QTR-END TO L001-FED-8-DATE-9. DTSBX774 00790 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX774 00791 MOVE L001-JUL-ABS-DAY TO WRK-RQ-END-ABS. DTSBX774 00792 DTSBX774 00793 MOVE ZERO TO X774-AGE. DTSBX774 00794 DTSBX774 00795 COMPUTE WRK-AGE = WRK-RQ-END-ABS - DTSBX774 00796 WRK-ERQ-END-ABS. DTSBX774 00797 DTSBX774 00798 MOVE WRK-DUE-DATE TO L001-FED-8-DATE-9. DTSBX774 00799 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX774 00800 MOVE L001-SLASH-8-DATE TO X774-DUE-DATE. DTSBX774 00801 DTSBX774 00802 MOVE ZEROS TO X774-AMT-ESTB-IN-RQ DTSBX774 00803 X774-LIQUIDATED DTSBX774 00804 X774-UNCOLLECT DTSBX774 00805 X774-REMOVED DTSBX774 00806 X774-BALANCE. DTSBX774 00807 DTSBX774 00808 EVALUATE TRUE DTSBX774 00809 WHEN RT-581-TYPE-ESTABLISHED-88 (RT-SUB) DTSBX774 00810 SET X774-TRANS-ESTB-RQ-88 TO TRUE DTSBX774 00811 MOVE RT-START-BALANCE (RT-SUB) TO DTSBX774 00812 X774-AMT-ESTB-IN-RQ DTSBX774 00813 PERFORM P5110-ESTB THRU P5110-EXIT DTSBX774 00814 PERFORM P6010-581-ESTB THRU P6010-EXIT DTSBX774 00815 DTSBX774 00816 WHEN RT-581-TYPE-REMOVED-NOW-88 (RT-SUB) DTSBX774 00817 *& SET X774-TRANS-BALANCE-88 TO TRUE DTSBX774 00818 SET X774-TRANS-REMOVED-88 TO TRUE DTSBX774 00819 MOVE RT-START-BALANCE (RT-SUB) TO X774-REMOVED DTSBX774 00820 PERFORM P5120-REM-BAL THRU P5120-EXIT DTSBX774 00821 PERFORM P6020-581-REMOVE THRU P6020-EXIT DTSBX774 00822 DTSBX774 00823 WHEN RT-581-TYPE-BALANCE-88 (RT-SUB) DTSBX774 00824 SET X774-TRANS-BALANCE-88 TO TRUE DTSBX774 00825 MOVE RT-END-BALANCE (RT-SUB) TO X774-BALANCE DTSBX774 00826 MOVE WRK-AGE TO X774-AGE DTSBX774 00827 PERFORM P5120-REM-BAL THRU P5120-EXIT DTSBX774 00828 PERFORM P6030-581-BALANCE THRU P6030-EXIT DTSBX774 00829 DTSBX774 00830 END-EVALUATE. DTSBX774 00831 DTSBX774 00832 IF RT-581-TYPE-BALANCE-88 (RT-SUB) DTSBX774 00833 IF RT-END-BALANCE (RT-SUB) = ZERO DTSBX774 00834 GO TO P5100-EXIT. DTSBX774 00835 DTSBX774 00836 WRITE ACCTS-RECEIVABLE-REC. DTSBX774 00837 DTSBX774 00838 IF NOT X774-STATUS-OK-88 DTSBX774 00839 DISPLAY 'FILE STATUS IS : ' X774-STATUS DTSBX774 00840 MOVE 'WRITE OUTPUT RECORD ERROR ' TO ABEND-MSG DTSBX774 00841 PERFORM S999-ABEND THRU S999-EXIT. DTSBX774 00842 DTSBX774 00843 ************************************************************** DTSBX774 00844 * WRITE BALANCE RECORD FOR RECEIVABLES ESTABLISHED IN RQ. DTSBX774 00845 ************************************************************** DTSBX774 00846 IF RT-581-TYPE-ESTABLISHED-88 (RT-SUB) DTSBX774 00847 IF RT-END-BALANCE (RT-SUB) NOT = ZERO DTSBX774 00848 PERFORM P5130-ESTB-BAL-REC THRU P5130-EXIT. DTSBX774 00849 DTSBX774 00850 P5100-EXIT. DTSBX774 00851 EXIT. DTSBX774 00852 DTSBX774 00853 P5110-ESTB. DTSBX774 00854 *********************************************************** DTSBX774 00855 * INCLUDE ALL RECONSTRUCTION RECORD FIELDS FOR DTSBX774 00856 * THE RECEIVABLES ESTABLISHED SUB-POPULATION. DTSBX774 00857 *********************************************************** DTSBX774 00858 MOVE SPACES TO WRK-REC-AREA. DTSBX774 00859 DTSBX774 00860 STRING DTSBX774 00861 X774-OBS-NBR ',' DTSBX774 00862 X774-EMP-NO ',' DTSBX774 00863 X774-EMP-TYPE ',' DTSBX774 00864 X774-TRANS-DATE ',' DTSBX774 00865 X774-ESTB-Q-DATE ',' DTSBX774 00866 X774-EMP-RPT-QTR ',' DTSBX774 00867 X774-DUE-DATE ',' DTSBX774 00868 X774-TRANS-TYPE ',' DTSBX774 00869 X774-AMT-ESTB-IN-RQ ',' DTSBX774 00870 X774-LIQUIDATED ',' DTSBX774 00871 X774-UNCOLLECT ',' DTSBX774 00872 X774-REMOVED ',' ',' DTSBX774 00873 ***** X774-BALANCE ',' DTSBX774 00874 X774-AGE ',' DTSBX774 00875 WRK-ESTB-FILLER DTSBX774 00876 DELIMITED BY SIZE DTSBX774 00877 INTO WRK-REC-AREA DTSBX774 00878 END-STRING. DTSBX774 00879 DTSBX774 00880 MOVE WRK-REC-AREA (1:WRK-LEN) TO DTSBX774 00881 ACCTS-RECEIVABLE-REC (1:WRK-LEN). DTSBX774 00882 DTSBX774 00883 P5110-EXIT. DTSBX774 00884 EXIT. DTSBX774 00885 DTSBX774 00886 P5120-REM-BAL. DTSBX774 00887 *********************************************************** DTSBX774 00888 * EXCLUDE THE TRANSACTION DATE AND DUE DATE FOR DTSBX774 00889 * THE RECEIVABLES REMOVED AND BALANCE AT END OF REPORT DTSBX774 00890 * QUARTER SUB-POPULATIONS. DTSBX774 00891 * TWO COMMAS IN A ROW IN THE OUTPUT CSV FILE REPRESENT DTSBX774 00892 * A ZERO-LENGTH STRING. DTSBX774 00893 *********************************************************** DTSBX774 00894 IF WRK-EMP-CLASS-CONTRIB-88 DTSBX774 00895 PERFORM P5121-REM-BAL-CON THRU P5121-EXIT DTSBX774 00896 ELSE DTSBX774 00897 PERFORM P5122-REM-BAL-REIMB THRU P5122-EXIT. DTSBX774 00898 DTSBX774 00899 P5120-EXIT. DTSBX774 00900 EXIT. DTSBX774 00901 DTSBX774 00902 P5121-REM-BAL-CON. DTSBX774 00903 MOVE SPACES TO WRK-REC-AREA. DTSBX774 00904 DTSBX774 00905 STRING DTSBX774 00906 X774-OBS-NBR ',' DTSBX774 00907 X774-EMP-NO ',' DTSBX774 00908 X774-EMP-TYPE ',' ',' DTSBX774 00909 X774-ESTB-Q-DATE ',' DTSBX774 00910 X774-EMP-RPT-QTR ',' ',' DTSBX774 00911 X774-TRANS-TYPE ',' DTSBX774 00912 X774-AMT-ESTB-IN-RQ ',' DTSBX774 00913 X774-LIQUIDATED ',' DTSBX774 00914 X774-UNCOLLECT ',' DTSBX774 00915 X774-REMOVED ',' DTSBX774 00916 X774-BALANCE ',' DTSBX774 00917 X774-AGE ',' DTSBX774 00918 WRK-REM-BAL-FILLER DTSBX774 00919 DELIMITED BY SIZE DTSBX774 00920 INTO WRK-REC-AREA DTSBX774 00921 END-STRING. DTSBX774 00922 DTSBX774 00923 MOVE WRK-REC-AREA (1:WRK-LEN) TO DTSBX774 00924 ACCTS-RECEIVABLE-REC (1:WRK-LEN). DTSBX774 00925 DTSBX774 00926 P5121-EXIT. DTSBX774 00927 EXIT. DTSBX774 00928 DTSBX774 00929 P5122-REM-BAL-REIMB. DTSBX774 00930 MOVE SPACES TO WRK-REC-AREA. DTSBX774 00931 DTSBX774 00932 STRING DTSBX774 00933 X774-OBS-NBR ',' DTSBX774 00934 X774-EMP-NO ',' DTSBX774 00935 X774-EMP-TYPE ',' ',' DTSBX774 00936 X774-ESTB-Q-DATE ',' ',' DTSBX774 00937 X774-DUE-DATE ',' DTSBX774 00938 X774-TRANS-TYPE ',' DTSBX774 00939 X774-AMT-ESTB-IN-RQ ',' DTSBX774 00940 X774-LIQUIDATED ',' DTSBX774 00941 X774-UNCOLLECT ',' DTSBX774 00942 X774-REMOVED ',' DTSBX774 00943 X774-BALANCE ',' DTSBX774 00944 X774-AGE ',' DTSBX774 00945 WRK-REM-BAL-FILLER DTSBX774 00946 DELIMITED BY SIZE DTSBX774 00947 INTO WRK-REC-AREA DTSBX774 00948 END-STRING. DTSBX774 00949 DTSBX774 00950 MOVE WRK-REC-AREA (1:WRK-LEN) TO DTSBX774 00951 ACCTS-RECEIVABLE-REC (1:WRK-LEN). DTSBX774 00952 DTSBX774 00953 P5122-EXIT. DTSBX774 00954 EXIT. DTSBX774 00955 DTSBX774 00956 P5130-ESTB-BAL-REC. DTSBX774 00957 ADD +1 TO WRK-OBS-NBR. DTSBX774 00958 ADD +1 TO WRK-RECS-WRITTEN-CNT. DTSBX774 00959 DTSBX774 00960 MOVE WRK-OBS-NBR TO X774-OBS-NBR. DTSBX774 00961 DTSBX774 00962 SET X774-TRANS-BALANCE-88 TO TRUE. DTSBX774 00963 MOVE ZERO TO X774-AMT-ESTB-IN-RQ. DTSBX774 00964 MOVE RT-END-BALANCE (RT-SUB) TO X774-BALANCE. DTSBX774 00965 PERFORM P5120-REM-BAL THRU P5120-EXIT. DTSBX774 00966 DTSBX774 00967 WRITE ACCTS-RECEIVABLE-REC. DTSBX774 00968 DTSBX774 00969 IF NOT X774-STATUS-OK-88 DTSBX774 00970 DISPLAY 'FILE STATUS IS : ' X774-STATUS DTSBX774 00971 MOVE 'WRITE OUTPUT RECORD ERROR ' TO ABEND-MSG DTSBX774 00972 PERFORM S999-ABEND THRU S999-EXIT. DTSBX774 00973 DTSBX774 00974 P5130-EXIT. DTSBX774 00975 EXIT. DTSBX774 00976 DTSBX774 00977 P5200-BUILD-LIQD-X774. DTSBX774 00978 PERFORM DTSBX774 00979 VARYING LA-SUB FROM +1 BY +1 DTSBX774 00980 UNTIL LA-SUB > LA-LAST DTSBX774 00981 IF LA-RCVBL-IDX (LA-SUB) = RT-SUB DTSBX774 00982 MOVE LA-LIQD-IDX (LA-SUB) TO LT-SUB DTSBX774 00983 MOVE LA-AMT (LA-SUB) TO WRK-P5200-AMT DTSBX774 00984 PERFORM P5210-BUILD-LIQD THRU P5210-EXIT DTSBX774 00985 END-IF DTSBX774 00986 END-PERFORM. DTSBX774 00987 DTSBX774 00988 P5200-EXIT. DTSBX774 00989 EXIT. DTSBX774 00990 DTSBX774 00991 P5210-BUILD-LIQD. DTSBX774 00992 ADD +1 TO WRK-OBS-NBR. DTSBX774 00993 ADD +1 TO WRK-RECS-WRITTEN-CNT. DTSBX774 00994 DTSBX774 00995 MOVE WRK-EMP-NO TO X774-EMP-NO. DTSBX774 00996 MOVE WRK-OBS-NBR TO X774-OBS-NBR. DTSBX774 00997 DTSBX774 00998 IF WRK-EMP-CLASS-CONTRIB-88 DTSBX774 00999 SET WRK-DV-EMP-CLASS-CONTRIB-88 TO TRUE DTSBX774 01000 *& DTSBX774 01001 * GO TO P5210-EXIT DTSBX774 01002 *& DTSBX774 01003 ELSE DTSBX774 01004 IF WRK-EMP-CLASS-REIMB-88 DTSBX774 01005 SET WRK-DV-EMP-CLASS-REIMB-88 TO TRUE DTSBX774 01006 ELSE DTSBX774 01007 DISPLAY 'INVALID EMPLOYER CLASS ' WRK-EMP-NO DTSBX774 01008 ' CLASS: ' Y774-EMP-CLASS DTSBX774 01009 GO TO P5210-EXIT. DTSBX774 01010 DTSBX774 01011 MOVE WRK-EMP-CLASS TO WRK-MPRF-EMP-CLASS. DTSBX774 01012 MOVE WRK-EMP-CLASS-DISP TO X774-EMP-TYPE. DTSBX774 01013 DTSBX774 01014 MOVE LT-PROCESSED-DATE (LT-SUB) TO L001-FED-8-DATE-9. DTSBX774 01015 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX774 01016 MOVE L001-SLASH-8-DATE TO X774-TRANS-DATE. DTSBX774 01017 DTSBX774 01018 MOVE L001-SLASH-8-DATE TO X774-ESTB-Q-DATE DTSBX774 01019 *** MOVE SPACES TO X774-ESTB-Q-DATE. DTSBX774 01020 DTSBX774 01021 MOVE WRK-YRQ TO L004-QTR-5-9. DTSBX774 01022 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX774 01023 MOVE L004-SLASH-5-QTR TO WRK-RPT-QTR-AREA. DTSBX774 01024 MOVE '0' TO WRK-RPT-QTR-SLASH. DTSBX774 01025 MOVE WRK-RPT-QTR-9 TO X774-EMP-RPT-QTR. DTSBX774 01026 DTSBX774 01027 MOVE WRK-DUE-DATE TO L001-FED-8-DATE-9 DTSBX774 01028 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX774 01029 MOVE L001-SLASH-8-DATE TO X774-DUE-DATE DTSBX774 01030 DTSBX774 01031 SET X774-TRANS-LIQUIDATE-88 TO TRUE. DTSBX774 01032 DTSBX774 01033 MOVE ZEROS TO X774-AMT-ESTB-IN-RQ DTSBX774 01034 X774-UNCOLLECT DTSBX774 01035 X774-REMOVED DTSBX774 01036 X774-BALANCE. DTSBX774 01037 DTSBX774 01038 MOVE WRK-P5200-AMT TO X774-LIQUIDATED. DTSBX774 01039 PERFORM P6040-581-LIQUIDATE THRU P6040-EXIT DTSBX774 01040 DTSBX774 01041 MOVE ZERO TO X774-AGE. DTSBX774 01042 DTSBX774 01043 PERFORM P5211-LIQD THRU P5211-EXIT. DTSBX774 01044 DTSBX774 01045 WRITE ACCTS-RECEIVABLE-REC. DTSBX774 01046 DTSBX774 01047 IF NOT X774-STATUS-OK-88 DTSBX774 01048 DISPLAY 'FILE STATUS IS : ' X774-STATUS DTSBX774 01049 MOVE 'WRITE OUTPUT RECORD ERROR ' TO ABEND-MSG DTSBX774 01050 PERFORM S999-ABEND THRU S999-EXIT. DTSBX774 01051 DTSBX774 01052 P5210-EXIT. DTSBX774 01053 EXIT. DTSBX774 01054 DTSBX774 01055 P5211-LIQD. DTSBX774 01056 *********************************************************** DTSBX774 01057 * EXCLUDE THE TRANSACTION DATE FOR THE RECEIVABLES DTSBX774 01058 * LIQUIDATED SUB-POPULATIONS. DTSBX774 01059 * TWO COMMAS IN A ROW IN THE OUTPUT CSV FILE REPRESENT DTSBX774 01060 * A ZERO-LENGTH STRING. DTSBX774 01061 *********************************************************** DTSBX774 01062 MOVE SPACES TO WRK-REC-AREA. DTSBX774 01063 DTSBX774 01064 STRING DTSBX774 01065 X774-OBS-NBR ',' DTSBX774 01066 X774-EMP-NO ',' DTSBX774 01067 X774-EMP-TYPE ',' DTSBX774 01068 X774-TRANS-DATE ',' DTSBX774 01069 X774-ESTB-Q-DATE ',' DTSBX774 01070 X774-EMP-RPT-QTR ',' DTSBX774 01071 X774-DUE-DATE ',' DTSBX774 01072 X774-TRANS-TYPE ',' DTSBX774 01073 X774-AMT-ESTB-IN-RQ ',' DTSBX774 01074 X774-LIQUIDATED ',' DTSBX774 01075 X774-UNCOLLECT ',' DTSBX774 01076 X774-REMOVED ',' ',' DTSBX774 01077 ***** X774-BALANCE ',' DTSBX774 01078 X774-AGE ',' DTSBX774 01079 WRK-LIQD-FILLER DTSBX774 01080 DELIMITED BY SIZE DTSBX774 01081 INTO WRK-REC-AREA DTSBX774 01082 END-STRING. DTSBX774 01083 DTSBX774 01084 MOVE WRK-REC-AREA (1:WRK-LEN) TO DTSBX774 01085 ACCTS-RECEIVABLE-REC (1:WRK-LEN). DTSBX774 01086 DTSBX774 01087 P5211-EXIT. DTSBX774 01088 EXIT. DTSBX774 01089 DTSBX774 01090 P6010-581-ESTB. DTSBX774 01091 IF WRK-EMP-CLASS-CONTRIB-88 DTSBX774 01092 ADD RT-START-BALANCE (RT-SUB) TO WRK-CON-RECVBL-DETERM DTSBX774 01093 PERFORM P6031-CONTRIB-AGING THRU P6031-EXIT DTSBX774 01094 ELSE DTSBX774 01095 ADD RT-START-BALANCE (RT-SUB) TO WRK-REIMB-RECVBL-DETERM DTSBX774 01096 PERFORM P6032-REIMB-AGING THRU P6032-EXIT DTSBX774 01097 END-IF. DTSBX774 01098 DTSBX774 01099 P6010-EXIT. DTSBX774 01100 EXIT. DTSBX774 01101 DTSBX774 01102 P6020-581-REMOVE. DTSBX774 01103 IF WRK-EMP-CLASS-CONTRIB-88 DTSBX774 01104 ADD RT-START-BALANCE (RT-SUB) TO DTSBX774 01105 WRK-CON-RECVBL-REMOVED DTSBX774 01106 WRK-CON-RECVBL-BEG-PERIOD DTSBX774 01107 ELSE DTSBX774 01108 ADD RT-START-BALANCE (RT-SUB) TO DTSBX774 01109 WRK-REIMB-RECVBL-REMOVED DTSBX774 01110 WRK-REIMB-RECVBL-BEG-PERIOD DTSBX774 01111 END-IF. DTSBX774 01112 DTSBX774 01113 P6020-EXIT. DTSBX774 01114 EXIT. DTSBX774 01115 DTSBX774 01116 P6030-581-BALANCE. DTSBX774 01117 IF WRK-EMP-CLASS-CONTRIB-88 DTSBX774 01118 ADD RT-START-BALANCE (RT-SUB) TO DTSBX774 01119 WRK-CON-RECVBL-BEG-PERIOD DTSBX774 01120 PERFORM P6031-CONTRIB-AGING THRU P6031-EXIT DTSBX774 01121 ELSE DTSBX774 01122 ADD RT-START-BALANCE (RT-SUB) TO DTSBX774 01123 WRK-REIMB-RECVBL-BEG-PERIOD DTSBX774 01124 PERFORM P6032-REIMB-AGING THRU P6032-EXIT DTSBX774 01125 END-IF. DTSBX774 01126 DTSBX774 01127 P6030-EXIT. DTSBX774 01128 EXIT. DTSBX774 01129 DTSBX774 01130 P6031-CONTRIB-AGING. DTSBX774 01131 DTSBX774 01132 EVALUATE TRUE DTSBX774 01133 WHEN WRK-YRQ > WRK-9-MONTHS-QTR DTSBX774 01134 ADD RT-END-BALANCE (RT-SUB) TO WRK-CON-RECVBL-6-MOS DTSBX774 01135 DTSBX774 01136 WHEN WRK-YRQ = WRK-9-MONTHS-QTR DTSBX774 01137 ADD RT-END-BALANCE (RT-SUB) TO WRK-CON-RECVBL-9-MOS DTSBX774 01138 DTSBX774 01139 WHEN WRK-YRQ = WRK-12-MONTHS-QTR DTSBX774 01140 ADD RT-END-BALANCE (RT-SUB) TO WRK-CON-RECVBL-12-MOS DTSBX774 01141 DTSBX774 01142 WHEN WRK-YRQ = WRK-15-MONTHS-QTR DTSBX774 01143 ADD RT-END-BALANCE (RT-SUB) TO WRK-CON-RECVBL-15-MOS DTSBX774 01144 DTSBX774 01145 WHEN OTHER DTSBX774 01146 ADD RT-END-BALANCE (RT-SUB) DTSBX774 01147 TO WRK-CON-RECVBL-OVER15-MOS DTSBX774 01148 DTSBX774 01149 END-EVALUATE. DTSBX774 01150 DTSBX774 01151 P6031-EXIT. DTSBX774 01152 EXIT. DTSBX774 01153 DTSBX774 01154 P6032-REIMB-AGING. DTSBX774 01155 DTSBX774 01156 EVALUATE TRUE DTSBX774 01157 WHEN WRK-YRQ > WRK-9-MONTHS-QTR DTSBX774 01158 ADD RT-END-BALANCE (RT-SUB) TO WRK-REIMB-RECVBL-6-MOS DTSBX774 01159 DTSBX774 01160 WHEN WRK-YRQ = WRK-9-MONTHS-QTR DTSBX774 01161 ADD RT-END-BALANCE (RT-SUB) TO WRK-REIMB-RECVBL-9-MOS DTSBX774 01162 DTSBX774 01163 WHEN WRK-YRQ = WRK-12-MONTHS-QTR DTSBX774 01164 ADD RT-END-BALANCE (RT-SUB) TO WRK-REIMB-RECVBL-12-MOS DTSBX774 01165 DTSBX774 01166 WHEN WRK-YRQ = WRK-15-MONTHS-QTR DTSBX774 01167 ADD RT-END-BALANCE (RT-SUB) DTSBX774 01168 TO WRK-REIMB-RECVBL-15-MOS DTSBX774 01169 DTSBX774 01170 WHEN OTHER DTSBX774 01171 ADD RT-END-BALANCE (RT-SUB) DTSBX774 01172 TO WRK-REIMB-RECVBL-OVER15-MOS DTSBX774 01173 DTSBX774 01174 END-EVALUATE. DTSBX774 01175 DTSBX774 01176 P6032-EXIT. DTSBX774 01177 EXIT. DTSBX774 01178 DTSBX774 01179 P6040-581-LIQUIDATE. DTSBX774 01180 IF WRK-EMP-CLASS-CONTRIB-88 DTSBX774 01181 ADD WRK-P5200-AMT TO WRK-CON-RECVBL-LIQUID DTSBX774 01182 ELSE DTSBX774 01183 ADD WRK-P5200-AMT TO WRK-REIMB-RECVBL-LIQUID DTSBX774 01184 END-IF. DTSBX774 01185 DTSBX774 01186 P6040-EXIT. DTSBX774 01187 EXIT. DTSBX774 01188 DTSBX774 01189 T0000-TERMINATE. DTSBX774 01190 PERFORM T1000-FINAL-QTR THRU T1000-EXIT. DTSBX774 01191 DTSBX774 01192 COMPUTE WRK-CON-RECVBL-END-PERIOD = DTSBX774 01193 WRK-CON-RECVBL-BEG-PERIOD + DTSBX774 01194 WRK-CON-RECVBL-DETERM - DTSBX774 01195 WRK-CON-RECVBL-LIQUID - DTSBX774 01196 WRK-CON-RECVBL-REMOVED. DTSBX774 01197 DTSBX774 01198 COMPUTE WRK-REIMB-RECVBL-END-PERIOD = DTSBX774 01199 WRK-REIMB-RECVBL-BEG-PERIOD + DTSBX774 01200 WRK-REIMB-RECVBL-DETERM - DTSBX774 01201 WRK-REIMB-RECVBL-LIQUID - DTSBX774 01202 WRK-REIMB-RECVBL-REMOVED. DTSBX774 01203 DTSBX774 01204 MOVE WRK-ETA581-DATA-AREA TO XL774-DATA-AREA. DTSBX774 01205 DTSBX774 01206 DISPLAY ' '. DTSBX774 01207 DTSBX774 01208 DISPLAY '*** DTSBX774 TERMINATION STATISTICS ***'. DTSBX774 01209 DTSBX774 01210 DISPLAY ' '. DTSBX774 01211 DISPLAY 'SUBJECT QUARTER : ' DTSBX774 01212 X770-SUBJECT-QTR. DTSBX774 01213 DTSBX774 01214 DISPLAY ' '. DTSBX774 01215 MOVE WRK-RECS-WRITTEN-CNT TO DISPLAY-CNT. DTSBX774 01216 DISPLAY 'X774 RECORDS WRITTEN : ' DTSBX774 01217 DISPLAY-CNT. DTSBX774 01218 DTSBX774 01219 DISPLAY ' '. DTSBX774 01220 DISPLAY ' ** CONTRIBUTORY TOTALS ' X770-SUBJECT-QTR ' **'. DTSBX774 01221 MOVE WRK-CON-RECVBL-BEG-PERIOD TO DISPLAY-AMT. DTSBX774 01222 DISPLAY 'RCVBLS AT BEGINNING OF PERIOD (21) : ' DTSBX774 01223 DISPLAY-AMT. DTSBX774 01224 MOVE WRK-CON-RECVBL-DETERM TO DISPLAY-AMT. DTSBX774 01225 DISPLAY 'DETERMINED RECEIVABLE DURING PERIOD (22) : ' DTSBX774 01226 DISPLAY-AMT. DTSBX774 01227 MOVE WRK-CON-RECVBL-LIQUID TO DISPLAY-AMT. DTSBX774 01228 DISPLAY 'DETERMINED LIQUIDATED DURING PERIOD (23) : ' DTSBX774 01229 DISPLAY-AMT. DTSBX774 01230 MOVE WRK-CON-RECVBL-REMOVED TO DISPLAY-AMT. DTSBX774 01231 DISPLAY 'DETERMINED REMOVED DURING PERIOD (25) : ' DTSBX774 01232 DISPLAY-AMT. DTSBX774 01233 MOVE WRK-CON-RECVBL-END-PERIOD TO DISPLAY-AMT. DTSBX774 01234 DISPLAY 'ENDING BALANCE (26) : ' DTSBX774 01235 DISPLAY-AMT. DTSBX774 01236 MOVE WRK-REMOVED-CON TO DISPLAY-AMT. DTSBX774 01237 DISPLAY 'REMOVED PRIOR : ' DTSBX774 01238 DISPLAY-AMT. DTSBX774 01239 MOVE WRK-CON-RECVBL-EMP-CNT TO DISPLAY-CNT. DTSBX774 01240 DISPLAY 'EMPLOYER COUNT (27) : ' DTSBX774 01241 DISPLAY-CNT. DTSBX774 01242 DTSBX774 01243 DISPLAY ' '. DTSBX774 01244 DISPLAY ' ** CONTRIBUTORY AGING **'. DTSBX774 01245 MOVE WRK-CON-RECVBL-6-MOS TO DISPLAY-AMT. DTSBX774 01246 DISPLAY '6 MONTHS OR LESS (28) : ' DTSBX774 01247 DISPLAY-AMT. DTSBX774 01248 MOVE WRK-CON-RECVBL-9-MOS TO DISPLAY-AMT. DTSBX774 01249 DISPLAY '9 MONTHS (29) : ' DTSBX774 01250 DISPLAY-AMT. DTSBX774 01251 MOVE WRK-CON-RECVBL-12-MOS TO DISPLAY-AMT. DTSBX774 01252 DISPLAY '12 MONTHS (30) : ' DTSBX774 01253 DISPLAY-AMT. DTSBX774 01254 MOVE WRK-CON-RECVBL-15-MOS TO DISPLAY-AMT. DTSBX774 01255 DISPLAY '15 MONTHS (31) : ' DTSBX774 01256 DISPLAY-AMT. DTSBX774 01257 MOVE WRK-CON-RECVBL-OVER15-MOS TO DISPLAY-AMT. DTSBX774 01258 DISPLAY 'OVER 15 MONTHS (32) : ' DTSBX774 01259 DISPLAY-AMT. DTSBX774 01260 DTSBX774 01261 DISPLAY ' '. DTSBX774 01262 DISPLAY ' ** REIMBURSABLE TOTALS ' X770-SUBJECT-QTR ' ** 'DTSBX774 01263 MOVE WRK-REIMB-RECVBL-BEG-PERIOD TO DISPLAY-AMT. DTSBX774 01264 DISPLAY 'RCVBLS AT BEGINNING OF PERIOD (33) : ' DTSBX774 01265 DISPLAY-AMT. DTSBX774 01266 MOVE WRK-REIMB-RECVBL-DETERM TO DISPLAY-AMT. DTSBX774 01267 DISPLAY 'DETERMINED RECEIVABLE DURING PERIOD (34) : ' DTSBX774 01268 DISPLAY-AMT. DTSBX774 01269 MOVE WRK-REIMB-RECVBL-LIQUID TO DISPLAY-AMT. DTSBX774 01270 DISPLAY 'DETERMINED LIQUIDATED DURING PERIOD (35) : ' DTSBX774 01271 DISPLAY-AMT. DTSBX774 01272 MOVE WRK-REIMB-RECVBL-REMOVED TO DISPLAY-AMT. DTSBX774 01273 DISPLAY 'DETERMINED REMOVED DURING PERIOD (37) : ' DTSBX774 01274 DISPLAY-AMT. DTSBX774 01275 MOVE WRK-REIMB-RECVBL-END-PERIOD TO DISPLAY-AMT. DTSBX774 01276 DISPLAY 'ENDING BALANCE (38) : ' DTSBX774 01277 DISPLAY-AMT. DTSBX774 01278 MOVE WRK-REMOVED-RMB TO DISPLAY-AMT. DTSBX774 01279 DISPLAY 'REMOVED PRIOR : ' DTSBX774 01280 DISPLAY-AMT. DTSBX774 01281 MOVE WRK-REIMB-RECVBL-EMP-CNT TO DISPLAY-CNT. DTSBX774 01282 DISPLAY 'EMPLOYER COUNT (39) : ' DTSBX774 01283 DISPLAY-CNT. DTSBX774 01284 DISPLAY ' '. DTSBX774 01285 DISPLAY ' ** REIMBURSABLE AGING **'. DTSBX774 01286 MOVE WRK-REIMB-RECVBL-6-MOS TO DISPLAY-AMT. DTSBX774 01287 DISPLAY '6 MONTHS OR LESS (40) : ' DTSBX774 01288 DISPLAY-AMT. DTSBX774 01289 MOVE WRK-REIMB-RECVBL-9-MOS TO DISPLAY-AMT. DTSBX774 01290 DISPLAY '9 MONTHS (41) : ' DTSBX774 01291 DISPLAY-AMT. DTSBX774 01292 MOVE WRK-REIMB-RECVBL-12-MOS TO DISPLAY-AMT. DTSBX774 01293 DISPLAY '12 MONTHS (42) : ' DTSBX774 01294 DISPLAY-AMT. DTSBX774 01295 MOVE WRK-REIMB-RECVBL-15-MOS TO DISPLAY-AMT. DTSBX774 01296 DISPLAY '15 MONTHS (43) : ' DTSBX774 01297 DISPLAY-AMT. DTSBX774 01298 MOVE WRK-REIMB-RECVBL-OVER15-MOS TO DISPLAY-AMT. DTSBX774 01299 DISPLAY 'OVER 15 MONTHS (44) : ' DTSBX774 01300 DISPLAY-AMT. DTSBX774 01301 DTSBX774 01302 T0000-EXIT. DTSBX774 01303 EXIT. DTSBX774 01304 DTSBX774 01305 T1000-FINAL-QTR. DTSBX774 01306 PERFORM P2000-STARTING-BALANCE THRU P2000-EXIT. DTSBX774 01307 PERFORM P3000-SET-581-TYPE THRU P3000-EXIT. DTSBX774 01308 PERFORM P4000-RPT-QTR-LIQUIDATIONS THRU P4000-EXIT. DTSBX774 01309 PERFORM P5000-WRITE-OUTPUT THRU P5000-EXIT. DTSBX774 01310 DTSBX774 01311 IF WRK-COUNT-EMP-YES-88 DTSBX774 01312 IF WRK-EMP-CLASS-CONTRIB-88 DTSBX774 01313 ADD +1 TO WRK-CON-RECVBL-EMP-CNT DTSBX774 01314 ELSE DTSBX774 01315 ADD +1 TO WRK-REIMB-RECVBL-EMP-CNT DTSBX774 01316 END-IF DTSBX774 01317 END-IF. DTSBX774 01318 DTSBX774 01319 T1000-EXIT. DTSBX774 01320 EXIT. DTSBX774 01321 DTSBX774 01322 S001-FROM-FED-8. DTSBX774 01323 SET L001-FROM-FED-8 TO TRUE. DTSBX774 01324 GO TO S001-DATE. DTSBX774 01325 DTSBX774 01326 S001-FROM-ABS-DAY. DTSBX774 01327 SET L001-FROM-ABS-DAY TO TRUE. DTSBX774 01328 GO TO S001-DATE. DTSBX774 01329 DTSBX774 01330 S001-FROM-CAL-6. DTSBX774 01331 SET L001-FROM-CAL-6 TO TRUE. DTSBX774 01332 GO TO S001-DATE. DTSBX774 01333 DTSBX774 01334 S001-DATE. DTSBX774 01335 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX774 01336 S001-EXIT. DTSBX774 01337 EXIT. DTSBX774 01338 SKIP3 DTSBX774 01339 S004-FROM-5. DTSBX774 01340 SET L004-FROM-5 TO TRUE. DTSBX774 01341 GO TO S004-QTR. DTSBX774 01342 DTSBX774 01343 S004-FROM-ABS. DTSBX774 01344 SET L004-FROM-ABS TO TRUE. DTSBX774 01345 GO TO S004-QTR. DTSBX774 01346 DTSBX774 01347 S004-FROM-3. DTSBX774 01348 SET L004-FROM-3 TO TRUE. DTSBX774 01349 GO TO S004-QTR. DTSBX774 01350 DTSBX774 01351 S004-FROM-DATE. DTSBX774 01352 SET L004-FROM-DATE TO TRUE. DTSBX774 01353 GO TO S004-QTR. DTSBX774 01354 DTSBX774 01355 S004-QTR. DTSBX774 01356 DTSBX774 01357 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX774 01358 DTSBX774 01359 S004-EXIT. DTSBX774 01360 EXIT. DTSBX774 01361 SKIP3 DTSBX774 01362 DTSBX774 01363 S999-ABEND. DTSBX774 01364 DISPLAY '*** DTSBE774 ABENDING. ' DTSBX774 01365 ABEND-MSG. DTSBX774 01366 DTSBX774 01367 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX774 01368 S999-EXIT. DTSBX774 01369 EXIT. DTSBX774