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
