00001  IDENTIFICATION DIVISION.                                         08/31/05
00002  PROGRAM-ID.             DTSBX332.                                DTSBX332
00003  AUTHOR.                 TRW.                                        LV001
00004  DATE-WRITTEN.           NOVEMBER 2002.                           DTSBX332
00005  DATE-COMPILED.                                                   DTSBX332
00006      SKIP3                                                        DTSBX332
00007 *****                                                             DTSBX332
00008 *                                                                 DTSBX332
00009 *                                                                 DTSBX332
00010 *    FUNCTION:  BUILD REPORT RECORDS FOR COLLECTIONS REPORT:      DTSBX332
00011 *               RECEIVABLES OVER 120 DAYS OLD.                    DTSBX332
00012 *                                                                 DTSBX332
00013 *                                                                 DTSBX332
00014 *    MODIFICATION LOG:                                            DTSBX332
00015 *                                                                 DTSBX332
00016 *    11/28/2002  INITIAL DEVELOPMENT.                             DTSBX332
00017 *                REFERENCE:                     PROGRAMMER: GD    DTSBX332
00018 *                                                                 DTSBX332
00019 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBX332
00020 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBX332
00021 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBX332
00022 *                                                                 DTSBX332
00023 *                                                                 DTSBX332
00024 *  DESCRIPTION:                                                   DTSBX332
00025 *                                                                 DTSBX332
00026 *                                                                 DTSBX332
00027 *    INITIATION:                                                  DTSBX332
00028 *                                                                 DTSBX332
00029 *      OPEN DTSX774                                               DTSBX332
00030 *                                                                 DTSBX332
00031 *                                                                 DTSBX332
00032 *                                                                 DTSBX332
00033 *    PROCESSING:                                                  DTSBX332
00034 *                                                                 DTSBX332
00035 *      BUILD R332 REPORT RECORDS FROM DTSIX332 INPUT.             DTSBX332
00036 *                                                                 DTSBX332
00037 *                                                                 DTSBX332
00038 *    TERMINATION:                                                 DTSBX332
00039 *                                                                 DTSBX332
00040 *                                                                 DTSBX332
00041 *                                                                 DTSBX332
00042 *    RECORDS READ:                                                DTSBX332
00043 *                                                                 DTSBX332
00044 *      MASTER:                                                    DTSBX332
00045 *                                                                 DTSBX332
00046 *        NONE                                                     DTSBX332
00047 *                                                                 DTSBX332
00048 *      ALTERNATE INDEX:                                           DTSBX332
00049 *                                                                 DTSBX332
00050 *        NONE.                                                    DTSBX332
00051 *                                                                 DTSBX332
00052 *                                                                 DTSBX332
00053 *      REFERENCE:                                                 DTSBX332
00054 *                                                                 DTSBX332
00055 *                                                                 DTSBX332
00056 *                                                                 DTSBX332
00057 *    RECORDS UPDATED:                                             DTSBX332
00058 *                                                                 DTSBX332
00059 *        NONE                                                     DTSBX332
00060 *                                                                 DTSBX332
00061 *                                                                 DTSBX332
00062 *    OUTPUT RECORDS WRITTEN:                                      DTSBX332
00063 *                                                                 DTSBX332
00064 *                                                                 DTSBX332
00065 *                                                                 DTSBX332
00066 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBX332
00067 *                                                                 DTSBX332
00068 *        NONE.                                                    DTSBX332
00069 *                                                                 DTSBX332
00070 *                                                                 DTSBX332
00071 *    MODULES CALLED:                                              DTSBX332
00072 *                                                                 DTSBX332
00073 *        DTSBU001  DATE EDIT/CONVERSION.                          DTSBX332
00074 *        DTSBU004  QUARTER EDIT/CONVERSION.                       DTSBX332
00075 *                                                                 DTSBX332
00076 *                                                                 DTSBX332
00077 *                                                                 DTSBX332
00078 *****                                                             DTSBX332
00079      SKIP3                                                        DTSBX332
00080  ENVIRONMENT DIVISION.                                            DTSBX332
00081  INPUT-OUTPUT SECTION.                                            DTSBX332
00082  FILE-CONTROL.                                                    DTSBX332
00083      SELECT X332-FILE         ASSIGN TO DTSX332                   DTSBX332
00084             FILE STATUS IS X332-STATUS.                           DTSBX332
00085                                                                   DTSBX332
00086      SELECT BE332-PARM-FILE   ASSIGN TO BE332PRM                  DTSBX332
00087             FILE STATUS IS PARM-STATUS.                           DTSBX332
00088                                                                   DTSBX332
00089 ***  SELECT X332-OUT-FILE     ASSIGN TO X332OUT                   DTSBX332
00090 ***         FILE STATUS IS X332-OUT-STATUS.                       DTSBX332
00091      EJECT                                                        DTSBX332
00092  DATA DIVISION.                                                   DTSBX332
00093  FILE SECTION.                                                    DTSBX332
00094  FD  X332-FILE                                                    DTSBX332
00095      RECORDING MODE IS F                                          DTSBX332
00096      LABEL RECORDS ARE STANDARD                                   DTSBX332
00097      BLOCK CONTAINS 0 RECORDS.                                    DTSBX332
00098  01  X332-REC.                                                    DTSBX332
00099  ++INCLUDE DTSIX332                                               DTSBX332
00100                                                                   DTSBX332
00101  FD  BE332-PARM-FILE                                              DTSBX332
00102      RECORDING MODE IS F                                          DTSBX332
00103      LABEL RECORDS ARE STANDARD                                   DTSBX332
00104      BLOCK CONTAINS 0 CHARACTERS.                                 DTSBX332
00105                                                                   DTSBX332
00106  01  BE332-PARM-REC.                                              DTSBX332
00107      05  BE332-PARM-START-DATE      PIC S9(09) COMP-3.            DTSBX332
00108      05  BE332-PARM-END-DATE        PIC S9(09) COMP-3.            DTSBX332
00109      05  BE332-PARM-UPDATE-IND      PIC  X(01).                   DTSBX332
00110          88  BE332-PARM-UPDATE-YES-88  VALUE 'Y'.                 DTSBX332
00111          88  BE332-PARM-UPDATE-NO-88   VALUE 'N'.                 DTSBX332
00112                                                                   DTSBX332
00113 *FD  X332-OUT-FILE                                                DTSBX332
00114 *    RECORDING MODE IS F                                          DTSBX332
00115 *    LABEL RECORDS ARE STANDARD                                   DTSBX332
00116 *    BLOCK CONTAINS 0 CHARACTERS.                                 DTSBX332
00117 *                                                                 DTSBX332
00118 *01  X332-OUT-REC                   PIC  X(26).                   DTSBX332
00119                                                                   DTSBX332
00120  WORKING-STORAGE SECTION.                                         DTSBX332
001205 77  PAN-VALET PICTURE X(24) VALUE '001DTSBX332  08/31/05'.       DTSBX332
00121      SKIP3                                                        DTSBX332
00122  01  WRK-AREA.                                                    DTSBX332
00123      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +332.DTSBX332
00124                                                                   DTSBX332
00125      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBX332'.DTSBX332
00126                                                                   DTSBX332
00127      05  WRK-TRACE-IND               PIC  X(01)  VALUE SPACE.     DTSBX332
00128                                                                   DTSBX332
00129      05  ABEND-MSG                   PIC  X(60).                  DTSBX332
00130                                                                   DTSBX332
00131      05  X332-STATUS                 PIC X(02) VALUE SPACES.      DTSBX332
00132          88 X332-STATUS-OK-88     VALUE ZEROS.                    DTSBX332
00133          88 X332-STATUS-EOF-88    VALUE '10'.                     DTSBX332
00134                                                                   DTSBX332
00135      05  PARM-STATUS                 PIC X(02) VALUE SPACES.      DTSBX332
00136          88 PARM-STATUS-OK-88     VALUE ZEROS.                    DTSBX332
00137          88 PARM-STATUS-EOF-88    VALUE '10'.                     DTSBX332
00138                                                                   DTSBX332
00139      05  WRK-PARM-UPDATE-IND      PIC  X(01).                     DTSBX332
00140          88  WRK-PARM-UPDATE-YES-88  VALUE 'Y'.                   DTSBX332
00141          88  WRK-PARM-UPDATE-NO-88   VALUE 'N'.                   DTSBX332
00142                                                                   DTSBX332
00143      05  WRK-MFAS-FOUND-IND          PIC X(01) VALUE SPACES.      DTSBX332
00144          88 WRK-MFAS-FOUND-YES-88 VALUE 'Y'.                      DTSBX332
00145          88 WRK-MFAS-FOUND-NO-88  VALUE 'N'.                      DTSBX332
00146                                                                   DTSBX332
00147      05  WRK-MFAS-EMP-NO             PIC S9(07) COMP-3            DTSBX332
00148                                       VALUE +0.                   DTSBX332
00149                                                                   DTSBX332
00150      05  WRK-MFAS-ESTB-DATE          PIC S9(09) COMP-3            DTSBX332
00151                                       VALUE +0.                   DTSBX332
00152                                                                   DTSBX332
00153 **   05  X332-OUT-STATUS             PIC X(02) VALUE SPACES.      DTSBX332
00154 **       88 X332-OUT-STATUS-OK-88  VALUE ZEROS.                   DTSBX332
00155                                                                   DTSBX332
00156      05  WRK-X332-REC.                                            DTSBX332
00157          10  WRK-X332-EMP-NO         PIC  9(06).                  DTSBX332
00158          10  FILLER                  PIC  X(01) VALUE ','.        DTSBX332
00159          10  WRK-X332-YRQ            PIC  X(06).                  DTSBX332
00160          10  FILLER                  PIC  X(01) VALUE ','.        DTSBX332
00161 *        10  WRK-X332-BATCH          PIC  9(05).                  DTSBX332
00162 *        10  FILLER                  PIC  X(01) VALUE ','.        DTSBX332
00163 *        10  WRK-X332-ITEM           PIC  9(03).                  DTSBX332
00164 *        10  FILLER                  PIC  X(01) VALUE ','.        DTSBX332
00165 *        10  WRK-X332-ESTB           PIC  X(10).                  DTSBX332
00166 *        10  FILLER                  PIC  X(01) VALUE ','.        DTSBX332
00167 *        10  WRK-X332-TRAN           PIC  X(02).                  DTSBX332
00168 *        10  FILLER                  PIC  X(01) VALUE ','.        DTSBX332
00169          10  WRK-X332-AMT            PIC  --------9.99.           DTSBX332
00170                                                                   DTSBX332
00171      05  ALL-NINES-DATE              PIC S9(09) COMP-3            DTSBX332
00172                                       VALUE +99999999.            DTSBX332
00173      05  WRK-ALL-NINES-BAL           PIC S9(09)V99 COMP-3         DTSBX332
00174                                       VALUE +99999999.99.         DTSBX332
00175      05  WRK-END-DATE                PIC S9(09) COMP-3            DTSBX332
00176                                       VALUE +0.                   DTSBX332
00177      05  WRK-START-DATE              PIC S9(09) COMP-3            DTSBX332
00178                                       VALUE +0.                   DTSBX332
00179      05  WRK-ABSTIME                 PIC S9(15) COMP-3.           DTSBX332
00180      05  WRK-EMP-NO                  PIC S9(07) COMP-3            DTSBX332
00181                                       VALUE +0.                   DTSBX332
00182      05  WRK-ASSIGN-NO               PIC S9(09) COMP-3            DTSBX332
00183                                       VALUE +0.                   DTSBX332
00184      05  WRK-PRIMARY-NAME            PIC  X(40).                  DTSBX332
00185      05  WRK-FLD-REP-ID              PIC  X(02).                  DTSBX332
00186                                                                   DTSBX332
00187      05  WRK-YRQ                     PIC S9(05) COMP-3            DTSBX332
00188                                       VALUE +0.                   DTSBX332
00189      05  WRK-TRAN-TYPE               PIC  X(02).                  DTSBX332
00190                                                                   DTSBX332
00191      05  WRK-QTR-BAL                 PIC S9(11)V99  COMP-3        DTSBX332
00192                                       VALUE +0.                   DTSBX332
00193      05  PREV-QTR-BAL                PIC S9(11)V99  COMP-3        DTSBX332
00194                                       VALUE +0.                   DTSBX332
00195                                                                   DTSBX332
00196      05  WRK-REC-AREA                PIC  X(155).                 DTSBX332
00197                                                                   DTSBX332
00198 ******************************************************************DTSBX332
00199 * THE RECEIVABLE TABLE CONTAINS ONE ENTRY FOR EACH RECEIVABLE     DTSBX332
00200 * FOR A GIVEN EMPLOYER/QUARTER. THE PROCESSED DATE, RECEIVED      DTSBX332
00201 * DATE AND AMOUNT COME FROM THE DTSIY774 RECORD. THE OTHER        DTSBX332
00202 * FIELDS ARE CALCULATED.  THE START BALANCE IS THE RECEIVABLE     DTSBX332
00203 * BALANCE DUE BEFORE APPLYING ANY REPORT QUARTER LIQUIDATIONS.    DTSBX332
00204 * THE END BALANCE IS THE RECEIVABLE BALANCE DUE AFTER APPLYING    DTSBX332
00205 * ANY REPORT QUARTER LIQUIDATIONS.                                DTSBX332
00206 ******************************************************************DTSBX332
00207      05  QTR-SUB                     PIC S9(04)  COMP VALUE +0.   DTSBX332
00208      05  QTR-LAST                    PIC S9(04)  COMP VALUE +0.   DTSBX332
00209      05  QTR-MAX                     PIC S9(04)  COMP VALUE +200. DTSBX332
00210      05  QTR-TABLE               OCCURS 200 TIMES.                DTSBX332
00211          10  QTR-ESTB-DATE           PIC S9(09)    COMP-3.        DTSBX332
00212          10  QTR-BATCH-NO            PIC S9(05)    COMP-3.        DTSBX332
00213          10  QTR-ITEM-NO             PIC S9(03)    COMP-3.        DTSBX332
00214          10  QTR-TRAN-TYPE           PIC  X(02).                  DTSBX332
00215          10  QTR-AMT                 PIC S9(09)V99 COMP-3.        DTSBX332
00216          10  QTR-FIRST-RCVBL         PIC  X(01).                  DTSBX332
00217              88  QTR-FIRST-RCVBL-YES-88  VALUE 'Y'.               DTSBX332
00218              88  QTR-FIRST-RCVBL-NO-88   VALUE 'N'.               DTSBX332
00219                                                                   DTSBX332
00220      05  WRK-RCVBL-FOUND-IND         PIC X(01) VALUE SPACES.      DTSBX332
00221          88 WRK-RCVBL-FOUND-YES-88    VALUE 'Y'.                  DTSBX332
00222          88 WRK-RCVBL-FOUND-NO-88     VALUE 'N'.                  DTSBX332
00223                                                                   DTSBX332
00224      05  WRK-ESTB-DATE           PIC S9(09)    COMP-3.            DTSBX332
00225      05  WRK-BATCH-NO            PIC S9(05)    COMP-3.            DTSBX332
00226      05  WRK-ITEM-NO             PIC S9(03)    COMP-3.            DTSBX332
00227                                                                   DTSBX332
00228      05  WRK-EVENT-TXT           PIC  X(50) VALUE                 DTSBX332
00229          'FLD ASSIGN CREATED: RCVBL OVER 120 DAYS OLD'.           DTSBX332
00230                                                                   DTSBX332
00231      05  WRK-R332-CNT               PIC S9(07)  COMP-3            DTSBX332
00232                                      VALUE +0.                    DTSBX332
00233      05  WRK-X332-CNT               PIC S9(07)  COMP-3            DTSBX332
00234                                      VALUE +0.                    DTSBX332
00235                                                                   DTSBX332
00236      05  WRK-DISP-EMP                PIC S9(07) COMP-3            DTSBX332
00237                                      VALUE +010169.               DTSBX332
00238                                                                   DTSBX332
00239      05  DISPLAY-CNT                 PIC  Z(06)9.                 DTSBX332
00240      05  DISPLAY-AMT-X               PIC  X(15).                  DTSBX332
00241      05  DISPLAY-AMT REDEFINES DISPLAY-AMT-X                      DTSBX332
00242                                      PIC  ZZZ,ZZZ,ZZ9.99-.        DTSBX332
00243      05  DISPLAY-AMT1-X               PIC  X(15).                 DTSBX332
00244      05  DISPLAY-AMT1 REDEFINES DISPLAY-AMT1-X                    DTSBX332
00245                                      PIC  ZZZ,ZZZ,ZZ9.99-.        DTSBX332
00246      EJECT                                                        DTSBX332
00247  01  L001-LINK-AREA.                                              DTSBX332
00248  ++INCLUDE DTSIL001                                               DTSBX332
00249                                                                   DTSBX332
00250  01  L004-LINK-AREA.                                              DTSBX332
00251  ++INCLUDE DTSIL004                                               DTSBX332
00252                                                                   DTSBX332
00253  01  L005-LINK-AREA.                                              DTSBX332
00254  ++INCLUDE DTSIL005                                               DTSBX332
00255                                                                   DTSBX332
00256  01  L910-LINK-AREA.                                              DTSBX332
00257  ++INCLUDE DTSIL910                                               DTSBX332
00258      SKIP3                                                        DTSBX332
00259  01  MSKL-REC.                                                    DTSBX332
00260  ++INCLUDE DTSIMSKL                                               DTSBX332
00261                                                                   DTSBX332
00262  01  MHDR-REC.                                                    DTSBX332
00263  ++INCLUDE DTSIMHDR                                               DTSBX332
00264                                                                   DTSBX332
00265  01  MPRF-REC.                                                    DTSBX332
00266  ++INCLUDE DTSIMPRF                                               DTSBX332
00267                                                                   DTSBX332
00268  01  MFAS-REC.                                                    DTSBX332
00269  ++INCLUDE DTSIMFAS                                               DTSBX332
00270                                                                   DTSBX332
00271  01  MEVL-REC.                                                    DTSBX332
00272  ++INCLUDE DTSIMEVL                                               DTSBX332
00273                                                                   DTSBX332
00274  01  L921-LINK-AREA.                                              DTSBX332
00275  ++INCLUDE DTSIL921                                               DTSBX332
00276                                                                   DTSBX332
00277  01  ISKL-REC.                                                    DTSBX332
00278  ++INCLUDE DTSIISKL                                               DTSBX332
00279                                                                   DTSBX332
00280  01  R332-REC.                                                    DTSBX332
00281  ++INCLUDE DTSIR332                                               DTSBX332
00282                                                                   DTSBX332
00283      SKIP3                                                        DTSBX332
00284  PROCEDURE DIVISION.                                              DTSBX332
00285                                                                   DTSBX332
00286      PERFORM I0000-INITIALIZE THRU I0000-EXIT.                    DTSBX332
00287                                                                   DTSBX332
00288      PERFORM P0000-PROCESS THRU P0000-EXIT                        DTSBX332
00289         UNTIL X332-STATUS-EOF-88.                                 DTSBX332
00290                                                                   DTSBX332
00291      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DTSBX332
00292      SKIP2                                                        DTSBX332
00293      GOBACK.                                                      DTSBX332
00294      EJECT                                                        DTSBX332
00295  I0000-INITIALIZE.                                                DTSBX332
00296      MOVE +0         TO QTR-SUB                                   DTSBX332
00297                         WRK-MFAS-EMP-NO.                          DTSBX332
00298                                                                   DTSBX332
00299      MOVE LENGTH OF R332-REC    TO R332-LENGTH.                   DTSBX332
00300      MOVE '332'                 TO R332-REC-TYPE.                 DTSBX332
00301                                                                   DTSBX332
00302      SET L005-FROM-SYS          TO TRUE.                          DTSBX332
00303      PERFORM S005-CONVERT-TIME  THRU S005-EXIT.                   DTSBX332
00304      MOVE L005-ABSTIME          TO WRK-ABSTIME.                   DTSBX332
00305                                                                   DTSBX332
00306      PERFORM I2000-OPEN-FILES   THRU I2000-EXIT.                  DTSBX332
00307                                                                   DTSBX332
00308      PERFORM I3000-ASSIGN-NBR   THRU I3000-EXIT.                  DTSBX332
00309                                                                   DTSBX332
00310  I0000-EXIT.                                                      DTSBX332
00311      EXIT.                                                        DTSBX332
00312                                                                   DTSBX332
00313  I2000-OPEN-FILES.                                                DTSBX332
00314      MOVE WRK-TRACE-IND TO L910-TRACE-IND                         DTSBX332
00315                            L921-TRACE-IND.                        DTSBX332
00316                                                                   DTSBX332
00317      MOVE WRK-MOD-NAME TO L910-MOD-NAME                           DTSBX332
00318                           L921-MOD-NAME.                          DTSBX332
00319                                                                   DTSBX332
00320      OPEN INPUT  X332-FILE                                        DTSBX332
00321      IF NOT X332-STATUS-OK-88                                     DTSBX332
00322         DISPLAY 'X332 FILE STATUS IS : ' X332-STATUS              DTSBX332
00323         MOVE 'CANNOT OPEN OUTPUT FILE '  TO ABEND-MSG             DTSBX332
00324         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX332
00325      END-IF.                                                      DTSBX332
00326                                                                   DTSBX332
00327      OPEN INPUT  BE332-PARM-FILE                                  DTSBX332
00328      IF NOT PARM-STATUS-OK-88                                     DTSBX332
00329         DISPLAY 'PARM FILE STATUS IS : ' PARM-STATUS              DTSBX332
00330         MOVE 'CANNOT OPEN PARM FILE '  TO ABEND-MSG               DTSBX332
00331         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX332
00332      END-IF.                                                      DTSBX332
00333                                                                   DTSBX332
00334      READ  BE332-PARM-FILE                                        DTSBX332
00335      IF PARM-STATUS-OK-88                                         DTSBX332
00336         MOVE BE332-PARM-START-DATE  TO WRK-START-DATE             DTSBX332
00337         MOVE BE332-PARM-END-DATE    TO WRK-END-DATE               DTSBX332
00338         MOVE BE332-PARM-UPDATE-IND  TO WRK-PARM-UPDATE-IND        DTSBX332
00339         DISPLAY 'START DATE ' WRK-START-DATE                      DTSBX332
00340         DISPLAY 'END DATE ' WRK-END-DATE                          DTSBX332
00341         DISPLAY 'UPDATE   ' WRK-PARM-UPDATE-IND                   DTSBX332
00342      ELSE                                                         DTSBX332
00343         DISPLAY 'PARM FILE STATUS IS : ' PARM-STATUS              DTSBX332
00344         MOVE 'CANNOT READ PARM FILE '  TO ABEND-MSG               DTSBX332
00345         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX332
00346      END-IF.                                                      DTSBX332
00347                                                                   DTSBX332
00348      CLOSE BE332-PARM-FILE.                                       DTSBX332
00349                                                                   DTSBX332
00350      IF WRK-PARM-UPDATE-YES-88                                    DTSBX332
00351         PERFORM S910-OPEN-UPDATE             THRU S910-EXIT       DTSBX332
00352         PERFORM S921-OPEN-UPDATE             THRU S921-EXIT       DTSBX332
00353      ELSE                                                         DTSBX332
00354         PERFORM S910-OPEN-READ               THRU S910-EXIT       DTSBX332
00355         PERFORM S921-OPEN-READ               THRU S921-EXIT       DTSBX332
00356      END-IF.                                                      DTSBX332
00357                                                                   DTSBX332
00358 *    OPEN OUTPUT  X332-OUT-FILE.                                  DTSBX332
00359 *    IF NOT X332-OUT-STATUS-OK-88                                 DTSBX332
00360 *       DISPLAY 'X332 OUT FILE STATUS IS : ' X332-OUT-STATUS      DTSBX332
00361 *       MOVE 'CANNOT OPEN OUTPUT FILE '  TO ABEND-MSG             DTSBX332
00362 *       PERFORM S999-ABEND THRU S999-EXIT                         DTSBX332
00363 *    END-IF.                                                      DTSBX332
00364                                                                   DTSBX332
00365                                                                   DTSBX332
00366  I2000-EXIT.                                                      DTSBX332
00367      EXIT.                                                        DTSBX332
00368                                                                   DTSBX332
00369  I3000-ASSIGN-NBR.                                                DTSBX332
00370      MOVE LOW-VALUES TO MHDR-KEY-AREA.                            DTSBX332
00371      MOVE +0 TO MHDR-EMP-NO.                                      DTSBX332
00372      SET MHDR-HDR-88 TO TRUE.                                     DTSBX332
00373      MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBX332
00374                                                                   DTSBX332
00375      PERFORM S910-READ THRU S910-EXIT.                            DTSBX332
00376                                                                   DTSBX332
00377      IF L910-NO-REC-88                                            DTSBX332
00378          MOVE 'MHDR RECORD NOT FOUND (I0000)'                     DTSBX332
00379            TO ABEND-MSG                                           DTSBX332
00380          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBX332
00381                                                                   DTSBX332
00382      MOVE MSKL-REC TO MHDR-REC.                                   DTSBX332
00383                                                                   DTSBX332
00384      MOVE MHDR-LAST-USED-ASSIGN-NO  TO WRK-ASSIGN-NO.             DTSBX332
00385                                                                   DTSBX332
00386  I3000-EXIT.                                                      DTSBX332
00387      EXIT.                                                        DTSBX332
00388                                                                   DTSBX332
00389  P0000-PROCESS.                                                   DTSBX332
00390      READ X332-FILE.                                              DTSBX332
00391      IF X332-STATUS-EOF-88                                        DTSBX332
00392         GO TO P0000-EXIT                                          DTSBX332
00393      ELSE                                                         DTSBX332
00394         IF NOT X332-STATUS-OK-88                                  DTSBX332
00395            DISPLAY 'BAD READ: ' X332-STATUS                       DTSBX332
00396            SET X332-STATUS-EOF-88 TO TRUE                         DTSBX332
00397            GO TO P0000-EXIT                                       DTSBX332
00398         END-IF                                                    DTSBX332
00399      END-IF.                                                      DTSBX332
00400                                                                   DTSBX332
00401      IF WRK-EMP-NO = ZERO                                         DTSBX332
00402         PERFORM P1300-INIT-TABLES              THRU P1300-EXIT    DTSBX332
00403         PERFORM P1000-BUILD-QTR-TABLE          THRU P1000-EXIT    DTSBX332
00404      ELSE                                                         DTSBX332
00405         IF X332-EMP-NO = WRK-EMP-NO                               DTSBX332
00406         AND X332-YRQ = WRK-YRQ                                    DTSBX332
00407            PERFORM P1000-BUILD-QTR-TABLE       THRU P1000-EXIT    DTSBX332
00408         ELSE                                                      DTSBX332
00409            PERFORM P5000-WRITE-OUTPUT          THRU P5000-EXIT    DTSBX332
00410            PERFORM P1300-INIT-TABLES           THRU P1300-EXIT    DTSBX332
00411            PERFORM P1000-BUILD-QTR-TABLE       THRU P1000-EXIT    DTSBX332
00412         END-IF                                                    DTSBX332
00413      END-IF.                                                      DTSBX332
00414                                                                   DTSBX332
00415  P0000-EXIT.                                                      DTSBX332
00416      EXIT.                                                        DTSBX332
00417                                                                   DTSBX332
00418                                                                   DTSBX332
00419  P1000-BUILD-QTR-TABLE.                                           DTSBX332
00420      IF QTR-SUB < QTR-MAX                                         DTSBX332
00421         ADD +1 TO QTR-SUB                                         DTSBX332
00422                   QTR-LAST                                        DTSBX332
00423      ELSE                                                         DTSBX332
00424          MOVE 'RECEIVABLE TABLE LENGTH EXCEEDED'                  DTSBX332
00425            TO ABEND-MSG                                           DTSBX332
00426          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBX332
00427                                                                   DTSBX332
00428      MOVE X332-ESTB-DATE       TO QTR-ESTB-DATE (QTR-SUB).        DTSBX332
00429      MOVE X332-BATCH-NO        TO QTR-BATCH-NO (QTR-SUB).         DTSBX332
00430      MOVE X332-ITEM-NO         TO QTR-ITEM-NO (QTR-SUB).          DTSBX332
00431      MOVE X332-TRAN-TYPE       TO QTR-TRAN-TYPE (QTR-SUB).        DTSBX332
00432      MOVE X332-AMT             TO QTR-AMT (QTR-SUB).              DTSBX332
00433                                                                   DTSBX332
00434  P1000-EXIT.                                                      DTSBX332
00435      EXIT.                                                        DTSBX332
00436                                                                   DTSBX332
00437  P1300-INIT-TABLES.                                               DTSBX332
00438      MOVE X332-EMP-NO                       TO WRK-EMP-NO.        DTSBX332
00439      MOVE X332-PRIMARY-NAME                 TO WRK-PRIMARY-NAME.  DTSBX332
00440      MOVE X332-FLD-REP-ID                   TO WRK-FLD-REP-ID.    DTSBX332
00441      MOVE X332-YRQ                          TO WRK-YRQ.           DTSBX332
00442                                                                   DTSBX332
00443      PERFORM                                                      DTSBX332
00444        VARYING QTR-SUB FROM +1 BY +1                              DTSBX332
00445        UNTIL QTR-SUB > QTR-MAX                                    DTSBX332
00446          MOVE +0               TO QTR-BATCH-NO (QTR-SUB)          DTSBX332
00447                                   QTR-ITEM-NO (QTR-SUB)           DTSBX332
00448                                   QTR-ESTB-DATE (QTR-SUB)         DTSBX332
00449                                   QTR-AMT (QTR-SUB)               DTSBX332
00450          MOVE SPACES            TO QTR-TRAN-TYPE (QTR-SUB)        DTSBX332
00451          SET QTR-FIRST-RCVBL-NO-88 (QTR-SUB)  TO TRUE             DTSBX332
00452      END-PERFORM.                                                 DTSBX332
00453                                                                   DTSBX332
00454      MOVE +0                   TO QTR-SUB                         DTSBX332
00455                                   QTR-LAST.                       DTSBX332
00456                                                                   DTSBX332
00457  P1300-EXIT.                                                      DTSBX332
00458      EXIT.                                                        DTSBX332
00459                                                                   DTSBX332
00460                                                                   DTSBX332
00461  P5000-WRITE-OUTPUT.                                              DTSBX332
00462 ***************************                                       DTSBX332
00463 *  FOR EACH QUARTER, FIND THE EARLIEST TRANSACTION BETWEEN        DTSBX332
00464 *  THE START AND END DATES THAT ESTABLISHED A RECEIVABLE.         DTSBX332
00465 *  RECORD THE QUARTER FOR THE REPORT                              DTSBX332
00466 ***************************                                       DTSBX332
00467      SET WRK-RCVBL-FOUND-NO-88    TO TRUE.                        DTSBX332
00468                                                                   DTSBX332
00469      MOVE ZERO             TO WRK-QTR-BAL                         DTSBX332
00470                               PREV-QTR-BAL                        DTSBX332
00471                               WRK-BATCH-NO                        DTSBX332
00472                               WRK-ITEM-NO.                        DTSBX332
00473      MOVE ALL-NINES-DATE   TO WRK-ESTB-DATE.                      DTSBX332
00474                                                                   DTSBX332
00475      PERFORM                                                      DTSBX332
00476        VARYING QTR-SUB FROM +1 BY +1                              DTSBX332
00477        UNTIL QTR-SUB > QTR-LAST                                   DTSBX332
00478          MOVE WRK-QTR-BAL      TO PREV-QTR-BAL                    DTSBX332
00479          ADD QTR-AMT (QTR-SUB) TO WRK-QTR-BAL                     DTSBX332
00480          IF WRK-QTR-BAL <= ZERO                                   DTSBX332
00481             SET WRK-RCVBL-FOUND-NO-88     TO TRUE                 DTSBX332
00482          ELSE                                                     DTSBX332
00483             IF QTR-ESTB-DATE (QTR-SUB) >= WRK-START-DATE          DTSBX332
00484             AND QTR-ESTB-DATE (QTR-SUB) <= WRK-END-DATE           DTSBX332
00485                PERFORM P5010-FIND-FIRST-RCVBL  THRU P5010-EXIT    DTSBX332
00486             END-IF                                                DTSBX332
00487          END-IF                                                   DTSBX332
00488      END-PERFORM.                                                 DTSBX332
00489                                                                   DTSBX332
00490      IF WRK-RCVBL-FOUND-NO-88                                     DTSBX332
00491      OR WRK-QTR-BAL < +100                                        DTSBX332
00492         GO TO P5000-EXIT                                          DTSBX332
00493      END-IF.                                                      DTSBX332
00494                                                                   DTSBX332
00495      PERFORM P5100-CHK-ASSIGN    THRU P5100-EXIT.                 DTSBX332
00496      IF WRK-MFAS-FOUND-NO-88                                      DTSBX332
00497         PERFORM P5200-WRITE-R332 THRU P5200-EXIT                  DTSBX332
00498         PERFORM P5300-ADD-MFAS   THRU P5300-EXIT                  DTSBX332
00499      END-IF.                                                      DTSBX332
00500                                                                   DTSBX332
00501  P5000-EXIT.                                                      DTSBX332
00502      EXIT.                                                        DTSBX332
00503                                                                   DTSBX332
00504  P5010-FIND-FIRST-RCVBL.                                          DTSBX332
00505      IF PREV-QTR-BAL <= ZERO                                      DTSBX332
00506         IF WRK-QTR-BAL > ZERO                                     DTSBX332
00507            SET WRK-RCVBL-FOUND-YES-88    TO TRUE                  DTSBX332
00508         END-IF                                                    DTSBX332
00509      ELSE                                                         DTSBX332
00510         IF WRK-QTR-BAL > PREV-QTR-BAL                             DTSBX332
00511            SET WRK-RCVBL-FOUND-YES-88    TO TRUE                  DTSBX332
00512         END-IF                                                    DTSBX332
00513      END-IF.                                                      DTSBX332
00514                                                                   DTSBX332
00515  P5010-EXIT.                                                      DTSBX332
00516      EXIT.                                                        DTSBX332
00517                                                                   DTSBX332
00518  P5100-CHK-ASSIGN.                                                DTSBX332
00519      SET WRK-MFAS-FOUND-NO-88   TO TRUE.                          DTSBX332
00520      MOVE LOW-VALUE             TO MFAS-REC.                      DTSBX332
00521      MOVE WRK-EMP-NO            TO MFAS-EMP-NO.                   DTSBX332
00522      SET MFAS-FAS-88            TO TRUE.                          DTSBX332
00523                                                                   DTSBX332
00524      MOVE MFAS-REC              TO MSKL-REC.                      DTSBX332
00525      PERFORM S910-START-BROWSE  THRU S910-EXIT.                   DTSBX332
00526      PERFORM                                                      DTSBX332
00527        UNTIL L910-NO-REC-88                                       DTSBX332
00528          MOVE MSKL-REC          TO MFAS-REC                       DTSBX332
00529          IF MFAS-ASSIGN-TYPE    = '13'                            DTSBX332
00530             IF MFAS-STATUS-ACTIVE-88                              DTSBX332
00531                SET WRK-MFAS-FOUND-YES-88 TO TRUE                  DTSBX332
00532                MOVE MFAS-ESTB-DATE       TO WRK-MFAS-ESTB-DATE    DTSBX332
00533             END-IF                                                DTSBX332
00534          END-IF                                                   DTSBX332
00535          PERFORM S910-READ-NEXT     THRU S910-EXIT                DTSBX332
00536      END-PERFORM.                                                 DTSBX332
00537                                                                   DTSBX332
00538  P5100-EXIT.                                                      DTSBX332
00539      EXIT.                                                        DTSBX332
00540                                                                   DTSBX332
00541  P5200-WRITE-R332.                                                DTSBX332
00542      MOVE LOW-VALUE             TO MSKL-REC.                      DTSBX332
00543      MOVE WRK-EMP-NO            TO MSKL-EMP-NO.                   DTSBX332
00544      SET MSKL-PRF-88            TO TRUE.                          DTSBX332
00545      PERFORM S910-READ          THRU S910-EXIT.                   DTSBX332
00546      IF L910-NO-REC-88                                            DTSBX332
00547         DISPLAY 'CANNOT FIND PROFILE RECORD ' WRK-EMP-NO          DTSBX332
00548         GO TO P5200-EXIT                                          DTSBX332
00549      ELSE                                                         DTSBX332
00550         MOVE MSKL-REC              TO MPRF-REC                    DTSBX332
00551      END-IF.                                                      DTSBX332
00552                                                                   DTSBX332
00553      MOVE WRK-EMP-NO               TO R332-EMP-NO.                DTSBX332
00554      MOVE WRK-FLD-REP-ID           TO R332-FLD-REP-ID.            DTSBX332
00555      MOVE WRK-PRIMARY-NAME         TO R332-PRIMARY-NAME.          DTSBX332
00556      MOVE WRK-YRQ                  TO R332-YRQ.                   DTSBX332
00557      MOVE WRK-START-DATE           TO R332-START-DATE.            DTSBX332
00558      MOVE WRK-END-DATE             TO R332-END-DATE.              DTSBX332
00559 ***  MOVE WRK-ESTB-DATE            TO R332-ESTB-DATE.             DTSBX332
00560 *    MOVE QTR-ESTB-DATE (QTR-SUB)  TO R332-ESTB-DATE.             DTSBX332
00561 *    MOVE QTR-BATCH-NO (QTR-SUB)   TO R332-BATCH-NO.              DTSBX332
00562 *    MOVE QTR-ITEM-NO (QTR-SUB)    TO R332-ITEM-NO.               DTSBX332
00563 *    MOVE QTR-TRAN-TYPE (QTR-SUB)  TO R332-TRAN-TYPE.             DTSBX332
00564      MOVE WRK-QTR-BAL              TO R332-UI-TAX-BAL.            DTSBX332
00565      COMPUTE R332-UI-TAX-BAL-XOR =                                DTSBX332
00566         (WRK-ALL-NINES-BAL - WRK-QTR-BAL).                        DTSBX332
00567                                                                   DTSBX332
00568      PERFORM S946-WRITE-R332 THRU S946-EXIT.                      DTSBX332
00569                                                                   DTSBX332
00570      ADD +1 TO WRK-R332-CNT.                                      DTSBX332
00571                                                                   DTSBX332
00572 *    MOVE WRK-EMP-NO               TO WRK-X332-EMP-NO.            DTSBX332
00573 *    MOVE WRK-YRQ                  TO L004-QTR-5-9.               DTSBX332
00574 *    PERFORM S004-FROM-5           THRU S004-EXIT.                DTSBX332
00575 *    MOVE L004-SLASH-QTR           TO WRK-X332-YRQ.               DTSBX332
00576 *    MOVE WRK-ESTB-DATE            TO L001-FED-8-DATE-9.          DTSBX332
00577 *    PERFORM S001-FROM-FED-8       THRU S001-EXIT.                DTSBX332
00578 *    MOVE L001-SLASH-8-DATE        TO WRK-X332-ESTB.              DTSBX332
00579 *    MOVE QTR-BATCH-NO (QTR-SUB)   TO WRK-X332-BATCH.             DTSBX332
00580 *    MOVE QTR-ITEM-NO (QTR-SUB)    TO WRK-X332-ITEM.              DTSBX332
00581 *    MOVE QTR-TRAN-TYPE (QTR-SUB)  TO WRK-X332-TRAN.              DTSBX332
00582 *    MOVE WRK-QTR-BAL              TO WRK-X332-AMT.               DTSBX332
00583 *                                                                 DTSBX332
00584 *    WRITE X332-OUT-REC            FROM WRK-X332-REC.             DTSBX332
00585 *    IF NOT X332-STATUS-OK-88                                     DTSBX332
00586 *       DISPLAY 'X332 WRITE ERROR : ' X332-STATUS                 DTSBX332
00587 *    ELSE                                                         DTSBX332
00588 *       ADD +1 TO WRK-X332-CNT                                    DTSBX332
00589 *    END-IF.                                                      DTSBX332
00590 *                                                                 DTSBX332
00591 *    MOVE WRK-QTR-BAL TO DISPLAY-AMT.                             DTSBX332
00592 *    DISPLAY 'P5200 '                                             DTSBX332
00593 *            WRK-EMP-NO '  ' WRK-YRQ                              DTSBX332
00594 *       '  ' WRK-ESTB-DATE                                        DTSBX332
00595 *       '  ' QTR-BATCH-NO (QTR-SUB)                               DTSBX332
00596 *       '  ' QTR-ITEM-NO (QTR-SUB)                                DTSBX332
00597 *       '  ' QTR-TRAN-TYPE (QTR-SUB)                              DTSBX332
00598 *       '  ' DISPLAY-AMT.                                         DTSBX332
00599                                                                   DTSBX332
00600  P5200-EXIT.                                                      DTSBX332
00601      EXIT.                                                        DTSBX332
00602                                                                   DTSBX332
00603  P5300-ADD-MFAS.                                                  DTSBX332
00604 *****************                                                 DTSBX332
00605 **   ADD ONLY ONE FIELD ASSIGNMENT, EVEN IF THERE ARE             DTSBX332
00606 **   MULTIPLE RECEIVABLES                                         DTSBX332
00607 *****************                                                 DTSBX332
00608                                                                   DTSBX332
00609      IF WRK-PARM-UPDATE-NO-88                                     DTSBX332
00610      OR MPRF-EMP-NO = WRK-MFAS-EMP-NO                             DTSBX332
00611         GO TO P5300-EXIT                                          DTSBX332
00612      ELSE                                                         DTSBX332
00613        MOVE MPRF-EMP-NO TO WRK-MFAS-EMP-NO                        DTSBX332
00614      END-IF.                                                      DTSBX332
00615                                                                   DTSBX332
00616      MOVE LOW-VALUES TO MFAS-REC.                                 DTSBX332
00617                                                                   DTSBX332
00618      MOVE MPRF-EMP-NO TO MFAS-EMP-NO.                             DTSBX332
00619                                                                   DTSBX332
00620      SET MFAS-FAS-88 TO TRUE.                                     DTSBX332
00621                                                                   DTSBX332
00622      ADD +1 TO WRK-ASSIGN-NO.                                     DTSBX332
00623                                                                   DTSBX332
00624      MOVE WRK-ASSIGN-NO TO MFAS-ASSIGN-NO.                        DTSBX332
00625                                                                   DTSBX332
00626      MOVE +0 TO MFAS-PURGE-DATE.                                  DTSBX332
00627                                                                   DTSBX332
00628      SET MFAS-STATUS-ACTIVE-88 TO TRUE.                           DTSBX332
00629                                                                   DTSBX332
00630      MOVE WRK-FLD-REP-ID     TO MFAS-FLD-REP-ID.                  DTSBX332
00631                                                                   DTSBX332
00632      MOVE '13'      TO MFAS-ASSIGN-TYPE.                          DTSBX332
00633                                                                   DTSBX332
00634      SET MFAS-ATTACHMENTS-NO-88  TO TRUE.                         DTSBX332
00635                                                                   DTSBX332
00636      SET MFAS-NON-AUDIT-88   TO TRUE.                             DTSBX332
00637                                                                   DTSBX332
00638      SET MFAS-ACCOUNTING-DESK-NO-88 TO TRUE.                      DTSBX332
00639                                                                   DTSBX332
00640      MOVE MHDR-CURR-MAIL-DATE  TO MFAS-START-DATE.                DTSBX332
00641                                                                   DTSBX332
00642      MOVE +0 TO MFAS-DUE-DATE                                     DTSBX332
00643                 MFAS-COMPLETED-DATE                               DTSBX332
00644                 MFAS-PROCESSED-DATE                               DTSBX332
00645                 MFAS-TAX-DOWNLOAD-DATE                            DTSBX332
00646                 MFAS-WAGE-DOWNLOAD-DATE.                          DTSBX332
00647                                                                   DTSBX332
00648      MOVE 'SYSTEM'   TO MFAS-SOURCE-OP-ID.                        DTSBX332
00649                                                                   DTSBX332
00650      MOVE ZERO              TO MFAS-CLAIMANT-SSN.                 DTSBX332
00651                                                                   DTSBX332
00652      MOVE SPACES             TO MFAS-CLAIMANT-NAME.               DTSBX332
00653                                                                   DTSBX332
00654      MOVE ZERO               TO MFAS-RELATED-EMP-NO.              DTSBX332
00655                                                                   DTSBX332
00656      MOVE +0 TO MFAS-START-YRQ                                    DTSBX332
00657                 MFAS-END-YRQ.                                     DTSBX332
00658                                                                   DTSBX332
00659      MOVE MPRF-SIC-CD TO MFAS-SIC-CD.                             DTSBX332
00660                                                                   DTSBX332
00661      MOVE MPRF-NAICS-CD TO MFAS-NAICS-CD.                         DTSBX332
00662                                                                   DTSBX332
00663      MOVE MPRF-OWN-CD TO MFAS-OWN-CD.                             DTSBX332
00664                                                                   DTSBX332
00665      SET MFAS-EMP-NON-AUDIT-88 TO TRUE.                           DTSBX332
00666                                                                   DTSBX332
00667      MOVE +0 TO MFAS-SEL-CNT.                                     DTSBX332
00668                                                                   DTSBX332
00669      SET MFAS-NOT-CONVERTED-88 TO TRUE.                           DTSBX332
00670                                                                   DTSBX332
00671      MOVE MHDR-PRIOR-RUN-DATE TO MFAS-ESTB-DATE                   DTSBX332
00672                                 MFAS-CHNG-DATE.                   DTSBX332
00673                                                                   DTSBX332
00674      MOVE +1 TO MFAS-TEXT-CNT.                                    DTSBX332
00675                                                                   DTSBX332
00676      MOVE                                                         DTSBX332
00677       'FIELD ASSIGN CREATED: RECEIVABLE OVER 120 DAYS OLD'        DTSBX332
00678        TO MFAS-TEXT (1).                                          DTSBX332
00679                                                                   DTSBX332
00680      MOVE MFAS-REC TO MSKL-REC.                                   DTSBX332
00681                                                                   DTSBX332
00682      PERFORM S910-WRITE THRU S910-EXIT.                           DTSBX332
00683                                                                   DTSBX332
00684      SET MPRF-MFAS-EXISTS-88 TO TRUE.                             DTSBX332
00685                                                                   DTSBX332
00686      PERFORM P5310-WRITE-MEVL THRU P5310-EXIT.                    DTSBX332
00687                                                                   DTSBX332
00688      PERFORM P5320-UPDATE-MPRF THRU P5320-EXIT.                   DTSBX332
00689                                                                   DTSBX332
00690  P5300-EXIT.                                                      DTSBX332
00691      EXIT.                                                        DTSBX332
00692                                                                   DTSBX332
00693  P5310-WRITE-MEVL.                                                DTSBX332
00694      MOVE LOW-VALUE TO MEVL-REC.                                  DTSBX332
00695                                                                   DTSBX332
00696      MOVE MPRF-EMP-NO TO MEVL-EMP-NO.                             DTSBX332
00697                                                                   DTSBX332
00698      SET MEVL-EVL-88 TO TRUE.                                     DTSBX332
00699                                                                   DTSBX332
00700      ADD +1000 TO WRK-ABSTIME.                                    DTSBX332
00701                                                                   DTSBX332
00702      MOVE WRK-ABSTIME TO L005-ABSTIME.                            DTSBX332
00703                                                                   DTSBX332
00704      SET L005-FROM-ABSTIME TO TRUE.                               DTSBX332
00705                                                                   DTSBX332
00706      PERFORM S005-CONVERT-TIME THRU S005-EXIT.                    DTSBX332
00707                                                                   DTSBX332
00708      MOVE L005-DATE TO MEVL-DATE.                                 DTSBX332
00709                                                                   DTSBX332
00710      MOVE L005-TIME TO MEVL-TIME.                                 DTSBX332
00711                                                                   DTSBX332
00712      MOVE +0 TO MEVL-PURGE-DATE.                                  DTSBX332
00713                                                                   DTSBX332
00714      MOVE WRK-EVENT-TXT TO MEVL-TEXT.                             DTSBX332
00715                                                                   DTSBX332
00716      SET MEVL-SOURCE-SYSTEM-88 TO TRUE.                           DTSBX332
00717                                                                   DTSBX332
00718      SET MEVL-NOT-CONVERTED-88 TO TRUE.                           DTSBX332
00719                                                                   DTSBX332
00720      MOVE MHDR-PRIOR-RUN-DATE TO MEVL-ESTB-DATE                   DTSBX332
00721                                  MEVL-CHNG-DATE.                  DTSBX332
00722                                                                   DTSBX332
00723      MOVE MEVL-REC TO MSKL-REC.                                   DTSBX332
00724                                                                   DTSBX332
00725      PERFORM S910-WRITE THRU S910-EXIT.                           DTSBX332
00726                                                                   DTSBX332
00727  P5310-EXIT.                                                      DTSBX332
00728      EXIT.                                                        DTSBX332
00729                                                                   DTSBX332
00730  P5320-UPDATE-MPRF.                                               DTSBX332
00731      MOVE MPRF-REC TO MSKL-REC.                                   DTSBX332
00732                                                                   DTSBX332
00733      PERFORM S910-REWRITE THRU S910-EXIT.                         DTSBX332
00734                                                                   DTSBX332
00735  P5320-EXIT.                                                      DTSBX332
00736      EXIT.                                                        DTSBX332
00737                                                                   DTSBX332
00738  T0000-TERMINATE.                                                 DTSBX332
00739      IF WRK-PARM-UPDATE-YES-88                                    DTSBX332
00740         PERFORM T1000-UPDATE-HDR       THRU T1000-EXIT            DTSBX332
00741      END-IF.                                                      DTSBX332
00742                                                                   DTSBX332
00743      CLOSE X332-FILE.                                             DTSBX332
00744 ***  CLOSE X332-OUT-FILE.                                         DTSBX332
00745      PERFORM S910-CLOSE             THRU S910-EXIT.               DTSBX332
00746      PERFORM S921-CLOSE             THRU S921-EXIT.               DTSBX332
00747                                                                   DTSBX332
00748      DISPLAY ' '.                                                 DTSBX332
00749                                                                   DTSBX332
00750      DISPLAY '*** DTSBX332 TERMINATION STATISTICS ***'.           DTSBX332
00751                                                                   DTSBX332
00752      DISPLAY '  '.                                                DTSBX332
00753      MOVE  WRK-R332-CNT         TO DISPLAY-CNT.                   DTSBX332
00754      DISPLAY 'R332 RECORDS WRITTEN                          : '   DTSBX332
00755          DISPLAY-CNT.                                             DTSBX332
00756 *    MOVE  WRK-X332-CNT         TO DISPLAY-CNT.                   DTSBX332
00757 *    DISPLAY 'X332 RECORDS WRITTEN                          : '   DTSBX332
00758 *        DISPLAY-CNT.                                             DTSBX332
00759                                                                   DTSBX332
00760      MOVE LOW-VALUES   TO R332-REC.                               DTSBX332
00761      MOVE -1 TO R332-LENGTH.                                      DTSBX332
00762                                                                   DTSBX332
00763      PERFORM S946-WRITE-R332 THRU S946-EXIT.                      DTSBX332
00764                                                                   DTSBX332
00765  T0000-EXIT.                                                      DTSBX332
00766      EXIT.                                                        DTSBX332
00767                                                                   DTSBX332
00768  T1000-UPDATE-HDR.                                                DTSBX332
00769      MOVE LOW-VALUES TO MHDR-KEY-AREA.                            DTSBX332
00770      MOVE +0 TO MHDR-EMP-NO.                                      DTSBX332
00771      SET MHDR-HDR-88 TO TRUE.                                     DTSBX332
00772      MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBX332
00773                                                                   DTSBX332
00774      PERFORM S910-READ THRU S910-EXIT.                            DTSBX332
00775                                                                   DTSBX332
00776      IF L910-NO-REC-88                                            DTSBX332
00777          MOVE 'MHDR RECORD NOT FOUND (T0000)'                     DTSBX332
00778            TO ABEND-MSG                                           DTSBX332
00779          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBX332
00780                                                                   DTSBX332
00781      MOVE MSKL-REC TO MHDR-REC.                                   DTSBX332
00782                                                                   DTSBX332
00783      MOVE WRK-ASSIGN-NO      TO MHDR-LAST-USED-ASSIGN-NO.         DTSBX332
00784                                                                   DTSBX332
00785      MOVE MHDR-PRIOR-RUN-DATE TO MHDR-CHNG-DATE.                  DTSBX332
00786                                                                   DTSBX332
00787      MOVE MHDR-REC TO MSKL-REC.                                   DTSBX332
00788                                                                   DTSBX332
00789      PERFORM S910-REWRITE THRU S910-EXIT.                         DTSBX332
00790                                                                   DTSBX332
00791  T1000-EXIT.                                                      DTSBX332
00792      EXIT.                                                        DTSBX332
00793                                                                   DTSBX332
00794  S001-FROM-FED-8.                                                 DTSBX332
00795      SET L001-FROM-FED-8 TO TRUE.                                 DTSBX332
00796      GO TO S001-DATE.                                             DTSBX332
00797                                                                   DTSBX332
00798  S001-FROM-ABS-DAY.                                               DTSBX332
00799      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBX332
00800      GO TO S001-DATE.                                             DTSBX332
00801                                                                   DTSBX332
00802  S001-FROM-CAL-6.                                                 DTSBX332
00803      SET L001-FROM-CAL-6 TO TRUE.                                 DTSBX332
00804      GO TO S001-DATE.                                             DTSBX332
00805                                                                   DTSBX332
00806  S001-DATE.                                                       DTSBX332
00807      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBX332
00808  S001-EXIT.                                                       DTSBX332
00809      EXIT.                                                        DTSBX332
00810      SKIP3                                                        DTSBX332
00811  S004-FROM-5.                                                     DTSBX332
00812      SET L004-FROM-5 TO TRUE.                                     DTSBX332
00813      GO TO S004-QTR.                                              DTSBX332
00814                                                                   DTSBX332
00815  S004-FROM-ABS.                                                   DTSBX332
00816      SET L004-FROM-ABS TO TRUE.                                   DTSBX332
00817      GO TO S004-QTR.                                              DTSBX332
00818                                                                   DTSBX332
00819  S004-FROM-3.                                                     DTSBX332
00820      SET L004-FROM-3 TO TRUE.                                     DTSBX332
00821      GO TO S004-QTR.                                              DTSBX332
00822                                                                   DTSBX332
00823  S004-FROM-DATE.                                                  DTSBX332
00824      SET L004-FROM-DATE TO TRUE.                                  DTSBX332
00825      GO TO S004-QTR.                                              DTSBX332
00826                                                                   DTSBX332
00827  S004-QTR.                                                        DTSBX332
00828                                                                   DTSBX332
00829      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBX332
00830                                                                   DTSBX332
00831  S004-EXIT.                                                       DTSBX332
00832      EXIT.                                                        DTSBX332
00833      SKIP3                                                        DTSBX332
00834                                                                   DTSBX332
00835  S005-CONVERT-TIME.                                               DTSBX332
00836      CALL 'DTSBU005' USING L005-LINK-AREA.                        DTSBX332
00837  S005-EXIT. EXIT.                                                 DTSBX332
00838                                                                   DTSBX332
00839  S910-OPEN-UPDATE.                                                DTSBX332
00840      SET L910-OPEN-UPDATE-88 TO TRUE.                             DTSBX332
00841      GO TO S910-MSTR-IO.                                          DTSBX332
00842                                                                   DTSBX332
00843  S910-OPEN-READ.                                                  DTSBX332
00844      SET L910-OPEN-READ-88   TO TRUE.                             DTSBX332
00845      GO TO S910-MSTR-IO.                                          DTSBX332
00846                                                                   DTSBX332
00847  S910-READ.                                                       DTSBX332
00848      SET L910-READ-88 TO TRUE.                                    DTSBX332
00849      GO TO S910-MSTR-IO.                                          DTSBX332
00850                                                                   DTSBX332
00851  S910-START-BROWSE.                                               DTSBX332
00852      SET L910-START-BROWSE-88 TO TRUE.                            DTSBX332
00853      GO TO S910-MSTR-IO.                                          DTSBX332
00854                                                                   DTSBX332
00855  S910-READ-NEXT.                                                  DTSBX332
00856      SET L910-READ-NEXT-88 TO TRUE.                               DTSBX332
00857      GO TO S910-MSTR-IO.                                          DTSBX332
00858                                                                   DTSBX332
00859  S910-WRITE.                                                      DTSBX332
00860      SET L910-WRITE-88     TO TRUE.                               DTSBX332
00861      GO TO S910-MSTR-IO.                                          DTSBX332
00862                                                                   DTSBX332
00863  S910-REWRITE.                                                    DTSBX332
00864      SET L910-REWRITE-88 TO TRUE.                                 DTSBX332
00865      GO TO S910-MSTR-IO.                                          DTSBX332
00866                                                                   DTSBX332
00867  S910-CLOSE.                                                      DTSBX332
00868      SET L910-CLOSE-88 TO TRUE.                                   DTSBX332
00869      GO TO S910-MSTR-IO.                                          DTSBX332
00870                                                                   DTSBX332
00871  S910-MSTR-IO.                                                    DTSBX332
00872      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBX332
00873                            MSKL-REC.                              DTSBX332
00874  S910-EXIT.                                                       DTSBX332
00875      EXIT.                                                        DTSBX332
00876                                                                   DTSBX332
00877  S921-OPEN-READ.                                                  DTSBX332
00878      SET L921-OPEN-READ-88 TO TRUE.                               DTSBX332
00879      GO TO S921-AIX-IO.                                           DTSBX332
00880                                                                   DTSBX332
00881  S921-OPEN-UPDATE.                                                DTSBX332
00882      SET L921-OPEN-UPDATE-88 TO TRUE.                             DTSBX332
00883      GO TO S921-AIX-IO.                                           DTSBX332
00884                                                                   DTSBX332
00885  S921-CLOSE.                                                      DTSBX332
00886      SET L921-CLOSE-88 TO TRUE.                                   DTSBX332
00887      GO TO S921-AIX-IO.                                           DTSBX332
00888                                                                   DTSBX332
00889  S921-AIX-IO.                                                     DTSBX332
00890      CALL 'DTSBU921' USING L921-LINK-AREA                         DTSBX332
00891                            ISKL-REC.                              DTSBX332
00892  S921-EXIT.                                                       DTSBX332
00893      EXIT.                                                        DTSBX332
00894                                                                   DTSBX332
00895  S946-WRITE-R332.                                                 DTSBX332
00896      CALL 'DTSBU946' USING R332-REC.                              DTSBX332
00897                                                                   DTSBX332
00898  S946-EXIT.                                                       DTSBX332
00899      EXIT.                                                        DTSBX332
00900      SKIP3                                                        DTSBX332
00901  S999-ABEND.                                                      DTSBX332
00902      DISPLAY '*** DTSBE774 ABENDING.  '                           DTSBX332
00903              ABEND-MSG.                                           DTSBX332
00904                                                                   DTSBX332
00905      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBX332
00906  S999-EXIT.                                                       DTSBX332
00907      EXIT.                                                        DTSBX332
