00001  IDENTIFICATION DIVISION.                                         11/04/04
00002  PROGRAM-ID.             DTSBX330.                                DTSBX330
00003  AUTHOR.                 TRW.                                        LV023
00004  DATE-WRITTEN.           NOVEMBER 2002.                           DTSBX330
00005  DATE-COMPILED.                                                   DTSBX330
00006      SKIP3                                                        DTSBX330
00007 *****                                                             DTSBX330
00008 *                                                                 DTSBX330
00009 *                                                                 DTSBX330
00010 *    FUNCTION:  BUILD REPORT RECORDS FOR DAILY CREDITS AND DEBITS    CL*15
00011 *               ESTABLISHED REPORT FROM X330 RECORDS PASSED FROM     CL*18
00012 *               DTSBE330.                                            CL*18
00013 *                                                                    CL*15
00014 *                                                                 DTSBX330
00015 *    MODIFICATION LOG:                                            DTSBX330
00016 *                                                                 DTSBX330
00017 *    11/28/2002  INITIAL DEVELOPMENT.                             DTSBX330
00018 *                REFERENCE:                     PROGRAMMER: GD       CL*15
00019 *                                                                 DTSBX330
00020 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBX330
00021 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBX330
00022 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBX330
00023 *                                                                 DTSBX330
00024 *                                                                 DTSBX330
00025 *  DESCRIPTION:                                                   DTSBX330
00026 *                                                                 DTSBX330
00027 *                                                                 DTSBX330
00028 *    INITIATION:                                                  DTSBX330
00029 *                                                                 DTSBX330
00030 *      OPEN DTSX774                                               DTSBX330
00031 *                                                                 DTSBX330
00032 *                                                                 DTSBX330
00033 *                                                                 DTSBX330
00034 *    PROCESSING:                                                  DTSBX330
00035 *                                                                 DTSBX330
00036 *      BUILD X774 OUTPUT RECORDS FROM DTSIY774 INPUT.             DTSBX330
00037 *                                                                 DTSBX330
00038 *                                                                 DTSBX330
00039 *    TERMINATION:                                                 DTSBX330
00040 *                                                                 DTSBX330
00041 *      CLOSE DTSX774                                              DTSBX330
00042 *                                                                 DTSBX330
00043 *    RECORDS READ:                                                DTSBX330
00044 *                                                                 DTSBX330
00045 *      MASTER:                                                    DTSBX330
00046 *                                                                 DTSBX330
00047 *        NONE                                                     DTSBX330
00048 *                                                                 DTSBX330
00049 *      ALTERNATE INDEX:                                           DTSBX330
00050 *                                                                 DTSBX330
00051 *        NONE.                                                    DTSBX330
00052 *                                                                 DTSBX330
00053 *                                                                 DTSBX330
00054 *      REFERENCE:                                                 DTSBX330
00055 *                                                                 DTSBX330
00056 *                                                                 DTSBX330
00057 *                                                                 DTSBX330
00058 *    RECORDS UPDATED:                                             DTSBX330
00059 *                                                                 DTSBX330
00060 *        NONE                                                     DTSBX330
00061 *                                                                 DTSBX330
00062 *                                                                 DTSBX330
00063 *    OUTPUT RECORDS WRITTEN:                                      DTSBX330
00064 *                                                                 DTSBX330
00065 *        DTSIR330                                                    CL*22
00066 *                                                                 DTSBX330
00067 *                                                                 DTSBX330
00068 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBX330
00069 *                                                                 DTSBX330
00070 *        NONE.                                                    DTSBX330
00071 *                                                                 DTSBX330
00072 *                                                                 DTSBX330
00073 *    MODULES CALLED:                                              DTSBX330
00074 *                                                                 DTSBX330
00075 *        DTSBU001  DATE EDIT/CONVERSION.                          DTSBX330
00076 *        DTSBU004  QUARTER EDIT/CONVERSION.                       DTSBX330
00077 *                                                                 DTSBX330
00078 *                                                                 DTSBX330
00079 *                                                                 DTSBX330
00080 *****                                                             DTSBX330
00081      SKIP3                                                        DTSBX330
00082  ENVIRONMENT DIVISION.                                            DTSBX330
00083  INPUT-OUTPUT SECTION.                                            DTSBX330
00084  FILE-CONTROL.                                                    DTSBX330
00085      SELECT X330-FILE         ASSIGN TO DTSX330                      CL*18
00086             FILE STATUS IS X330-STATUS.                              CL*18
00087                                                                      CL*15
00088      SELECT BE330-PARM-FILE   ASSIGN TO BE330PRM                     CL*18
00089             FILE STATUS IS PARM-STATUS.                              CL*17
00090      EJECT                                                           CL*15
00091  DATA DIVISION.                                                   DTSBX330
00092  FILE SECTION.                                                    DTSBX330
00093  FD  X330-FILE                                                       CL*18
00094      RECORDING MODE IS F                                          DTSBX330
00095      LABEL RECORDS ARE STANDARD                                   DTSBX330
00096      BLOCK CONTAINS 0 RECORDS.                                    DTSBX330
00097  01  X330-REC.                                                       CL*18
00098  ++INCLUDE DTSIX330                                                  CL*18
00099                                                                      CL*15
00100  FD  BE330-PARM-FILE                                                 CL*18
00101      RECORDING MODE IS F                                             CL*15
00102      LABEL RECORDS ARE STANDARD                                      CL*15
00103      BLOCK CONTAINS 0 CHARACTERS.                                    CL*15
00104                                                                      CL*15
00105  01  BE330-PARM-REC                 PIC S9(09) COMP-3.               CL*18
00106                                                                      CL*15
00107  WORKING-STORAGE SECTION.                                         DTSBX330
001075 77  PAN-VALET PICTURE X(24) VALUE '023DTSBX330  11/04/04'.       DTSBX330
00108      SKIP3                                                        DTSBX330
00109  01  WRK-AREA.                                                    DTSBX330
00110      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +330.   CL*18
00111                                                                   DTSBX330
00112      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBX330'.   CL*18
00113                                                                   DTSBX330
00114      05  ABEND-MSG                   PIC  X(60).                  DTSBX330
00115                                                                   DTSBX330
00116      05  X330-STATUS                 PIC X(02) VALUE SPACES.         CL*18
00117          88 X330-STATUS-OK-88     VALUE ZEROS.                       CL*18
00118          88 X330-STATUS-EOF-88    VALUE '10'.                        CL*18
00119                                                                   DTSBX330
00120      05  PARM-STATUS                 PIC X(02) VALUE SPACES.         CL*17
00121          88 PARM-STATUS-OK-88     VALUE ZEROS.                       CL*15
00122          88 PARM-STATUS-EOF-88    VALUE '10'.                        CL*15
00123                                                                      CL*15
00124      05  WRK-SUBJECT-DATE            PIC S9(09) COMP-3               CL*16
00125                                       VALUE +0.                      CL*16
00126      05  WRK-EMP-NO                  PIC S9(07) COMP-3               CL**2
00127                                       VALUE +0.                      CL**2
00128      05  WRK-YRQ                     PIC S9(05) COMP-3               CL**2
00129                                       VALUE +0.                      CL**2
00130      05  WRK-TRAN-TYPE               PIC  X(02).                     CL*16
00131                                                                      CL*16
00132      05  WRK-QTR-BAL                 PIC S9(11)V99  COMP-3           CL**6
00133                                       VALUE +0.                      CL**6
00134                                                                   DTSBX330
00135      05  WRK-REC-AREA                PIC  X(155).                 DTSBX330
00136                                                                   DTSBX330
00137 ******************************************************************DTSBX330
00138 * THE RECEIVABLE TABLE CONTAINS ONE ENTRY FOR EACH RECEIVABLE     DTSBX330
00139 * FOR A GIVEN EMPLOYER/QUARTER. THE PROCESSED DATE, RECEIVED      DTSBX330
00140 * DATE AND AMOUNT COME FROM THE DTSIY774 RECORD. THE OTHER        DTSBX330
00141 * FIELDS ARE CALCULATED.  THE START BALANCE IS THE RECEIVABLE     DTSBX330
00142 * BALANCE DUE BEFORE APPLYING ANY REPORT QUARTER LIQUIDATIONS.    DTSBX330
00143 * THE END BALANCE IS THE RECEIVABLE BALANCE DUE AFTER APPLYING    DTSBX330
00144 * ANY REPORT QUARTER LIQUIDATIONS.                                DTSBX330
00145 ******************************************************************DTSBX330
00146      05  QTR-SUB                     PIC S9(04)  COMP VALUE +0.      CL**2
00147      05  QTR-LAST                    PIC S9(04)  COMP VALUE +0.      CL**2
00148      05  QTR-MAX                     PIC S9(04)  COMP VALUE +200.    CL**2
00149      05  QTR-TABLE               OCCURS 200 TIMES.                   CL**2
00150          10  QTR-BATCH-NO            PIC S9(05)    COMP-3.           CL*12
00151          10  QTR-ITEM-NO             PIC S9(03)    COMP-3.           CL*12
00152          10  QTR-TRAN-TYPE           PIC  X(02).                     CL*15
00153          10  QTR-AMT                 PIC S9(09)V99 COMP-3.           CL**2
00154                                                                   DTSBX330
00155      05  WRK-BATCH-NO            PIC S9(05)    COMP-3.               CL*12
00156      05  WRK-ITEM-NO             PIC S9(03)    COMP-3.               CL*12
00157                                                                      CL*12
00158      05  WRK-R330-CNT               PIC S9(07)  COMP-3               CL*19
00159                                      VALUE +0.                    DTSBX330
00160                                                                   DTSBX330
00161      05  WRK-DISP-EMP                PIC S9(07) COMP-3            DTSBX330
00162                                      VALUE +010169.               DTSBX330
00163                                                                   DTSBX330
00164      05  DISPLAY-CNT                 PIC  Z(06)9.                 DTSBX330
00165      05  DISPLAY-AMT-X               PIC  X(15).                  DTSBX330
00166      05  DISPLAY-AMT REDEFINES DISPLAY-AMT-X                      DTSBX330
00167                                      PIC  ZZZ,ZZZ,ZZ9.99-.        DTSBX330
00168      05  DISPLAY-AMT1-X               PIC  X(15).                    CL**8
00169      05  DISPLAY-AMT1 REDEFINES DISPLAY-AMT1-X                       CL**8
00170                                      PIC  ZZZ,ZZZ,ZZ9.99-.           CL**8
00171      EJECT                                                        DTSBX330
00172  01  L001-LINK-AREA.                                              DTSBX330
00173  ++INCLUDE DTSIL001                                               DTSBX330
00174                                                                      CL*19
00175  01  L004-LINK-AREA.                                              DTSBX330
00176  ++INCLUDE DTSIL004                                               DTSBX330
00177                                                                      CL*19
00178  01  R330-REC.                                                       CL*19
00179  ++INCLUDE DTSIR330                                                  CL*19
00180                                                                      CL*19
00181      SKIP3                                                        DTSBX330
00182  PROCEDURE DIVISION.                                                 CL**2
00183                                                                   DTSBX330
00184      PERFORM I0000-INITIALIZE THRU I0000-EXIT.                       CL**2
00185                                                                      CL**2
00186      PERFORM P0000-PROCESS THRU P0000-EXIT                           CL**3
00187         UNTIL X330-STATUS-EOF-88.                                    CL*18
00188                                                                      CL**2
00189      PERFORM T0000-TERMINATE THRU T0000-EXIT.                        CL**2
00190      SKIP2                                                        DTSBX330
00191      GOBACK.                                                      DTSBX330
00192      EJECT                                                        DTSBX330
00193  I0000-INITIALIZE.                                                DTSBX330
00194      MOVE +0         TO QTR-SUB.                                     CL**2
00195                                                                   DTSBX330
00196      MOVE LENGTH OF R330-REC    TO R330-LENGTH.                      CL*19
00197      MOVE '330'                 TO R330-REC-TYPE.                    CL*19
00198                                                                      CL*19
00199      OPEN INPUT  X330-FILE                                           CL*18
00200      IF NOT X330-STATUS-OK-88                                        CL*18
00201         DISPLAY 'X330 FILE STATUS IS : ' X330-STATUS                 CL*18
00202         MOVE 'CANNOT OPEN OUTPUT FILE '  TO ABEND-MSG             DTSBX330
00203         PERFORM S999-ABEND THRU S999-EXIT                            CL*16
00204      END-IF.                                                         CL*16
00205                                                                   DTSBX330
00206      OPEN INPUT  BE330-PARM-FILE                                     CL*18
00207      IF NOT PARM-STATUS-OK-88                                        CL*16
00208         DISPLAY 'PARM FILE STATUS IS : ' PARM-STATUS                 CL*16
00209         MOVE 'CANNOT OPEN PARM FILE '  TO ABEND-MSG                  CL*16
00210         PERFORM S999-ABEND THRU S999-EXIT                            CL*16
00211      END-IF.                                                         CL*16
00212                                                                      CL*16
00213      READ  BE330-PARM-FILE                                           CL*18
00214      IF PARM-STATUS-OK-88                                            CL*16
00215         MOVE BE330-PARM-REC     TO WRK-SUBJECT-DATE                  CL*18
00216         DISPLAY 'SUBJECT DATE ' WRK-SUBJECT-DATE                     CL*16
00217      ELSE                                                            CL*16
00218         DISPLAY 'PARM FILE STATUS IS : ' PARM-STATUS                 CL*16
00219         MOVE 'CANNOT READ PARM FILE '  TO ABEND-MSG                  CL*16
00220         PERFORM S999-ABEND THRU S999-EXIT                            CL*16
00221      END-IF.                                                         CL*16
00222                                                                      CL*16
00223      CLOSE BE330-PARM-FILE.                                          CL*18
00224                                                                      CL*16
00225  I0000-EXIT.                                                      DTSBX330
00226      EXIT.                                                        DTSBX330
00227                                                                   DTSBX330
00228  P0000-PROCESS.                                                   DTSBX330
00229      READ X330-FILE.                                                 CL*18
00230      IF X330-STATUS-EOF-88                                           CL*18
00231         GO TO P0000-EXIT                                             CL**9
00232      ELSE                                                            CL**9
00233         IF NOT X330-STATUS-OK-88                                     CL*18
00234            DISPLAY 'BAD READ: ' X330-STATUS                          CL*18
00235            SET X330-STATUS-EOF-88 TO TRUE                            CL*18
00236            GO TO P0000-EXIT                                          CL**9
00237         END-IF                                                       CL**9
00238      END-IF.                                                         CL**3
00239                                                                      CL**2
00240      IF WRK-EMP-NO = ZERO                                         DTSBX330
00241         PERFORM P1300-INIT-TABLES              THRU P1300-EXIT    DTSBX330
00242         PERFORM P1000-BUILD-QTR-TABLE          THRU P1000-EXIT       CL**4
00243      ELSE                                                         DTSBX330
00244         IF X330-EMP-NO = WRK-EMP-NO                                  CL*18
00245         AND X330-YRQ = WRK-YRQ                                       CL*18
00246            PERFORM P1000-BUILD-QTR-TABLE       THRU P1000-EXIT       CL**5
00247         ELSE                                                      DTSBX330
00248            PERFORM P5000-WRITE-OUTPUT          THRU P5000-EXIT    DTSBX330
00249            PERFORM P1300-INIT-TABLES           THRU P1300-EXIT    DTSBX330
00250            PERFORM P1000-BUILD-QTR-TABLE       THRU P1000-EXIT       CL**4
00251         END-IF                                                       CL**3
00252      END-IF.                                                         CL**3
00253                                                                   DTSBX330
00254  P0000-EXIT.                                                      DTSBX330
00255      EXIT.                                                        DTSBX330
00256                                                                   DTSBX330
00257                                                                   DTSBX330
00258  P1000-BUILD-QTR-TABLE.                                              CL**4
00259      IF QTR-SUB < QTR-MAX                                            CL**2
00260         ADD +1 TO QTR-SUB                                            CL**2
00261                   QTR-LAST                                           CL**2
00262      ELSE                                                         DTSBX330
00263          MOVE 'RECEIVABLE TABLE LENGTH EXCEEDED'                  DTSBX330
00264            TO ABEND-MSG                                           DTSBX330
00265          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBX330
00266                                                                   DTSBX330
00267      MOVE X330-BATCH-NO        TO QTR-BATCH-NO (QTR-SUB).            CL*18
00268      MOVE X330-ITEM-NO         TO QTR-ITEM-NO (QTR-SUB).             CL*18
00269      MOVE X330-TRAN-TYPE       TO QTR-TRAN-TYPE (QTR-SUB).           CL*18
00270      ADD X330-AMT              TO QTR-AMT (QTR-SUB).                 CL*18
00271                                                                      CL**3
00272  P1000-EXIT.                                                         CL**4
00273      EXIT.                                                        DTSBX330
00274                                                                   DTSBX330
00275  P1300-INIT-TABLES.                                               DTSBX330
00276      MOVE X330-EMP-NO                       TO WRK-EMP-NO.           CL*18
00277      MOVE X330-YRQ                          TO WRK-YRQ.              CL*18
00278                                                                   DTSBX330
00279      PERFORM                                                      DTSBX330
00280        VARYING QTR-SUB FROM +1 BY +1                                 CL**2
00281        UNTIL QTR-SUB > QTR-MAX                                       CL**2
00282          MOVE +0               TO QTR-BATCH-NO (QTR-SUB)             CL**3
00283                                   QTR-ITEM-NO (QTR-SUB)              CL**3
00284                                   QTR-AMT (QTR-SUB)                  CL**3
00285          MOVE SPACES            TO QTR-TRAN-TYPE (QTR-SUB)           CL*16
00286      END-PERFORM.                                                 DTSBX330
00287                                                                   DTSBX330
00288      MOVE +0                   TO QTR-SUB                            CL**2
00289                                   QTR-LAST.                          CL**3
00290                                                                   DTSBX330
00291  P1300-EXIT.                                                      DTSBX330
00292      EXIT.                                                        DTSBX330
00293                                                                   DTSBX330
00294                                                                   DTSBX330
00295  P5000-WRITE-OUTPUT.                                              DTSBX330
00296      MOVE ZERO             TO WRK-QTR-BAL                            CL*12
00297                               WRK-BATCH-NO                           CL*12
00298                               WRK-ITEM-NO.                           CL*12
00299      MOVE SPACES           TO WRK-TRAN-TYPE.                         CL*16
00300                                                                      CL**6
00301      PERFORM                                                      DTSBX330
00302       VARYING QTR-SUB FROM +1 BY +1                                  CL**2
00303       UNTIL QTR-SUB > QTR-LAST                                       CL**2
00304          ADD QTR-AMT (QTR-SUB) TO WRK-QTR-BAL                        CL**6
00305      END-PERFORM.                                                    CL**3
00306                                                                   DTSBX330
00307      IF WRK-QTR-BAL > ZERO                                           CL*23
00308         PERFORM                                                      CL**6
00309          VARYING QTR-SUB FROM +1 BY +1                               CL**6
00310          UNTIL QTR-SUB > QTR-LAST                                    CL**6
00311             PERFORM P5100-WRITE-R330    THRU P5100-EXIT              CL*19
00312         END-PERFORM                                                  CL**6
00313      END-IF.                                                         CL**6
00314                                                                   DTSBX330
00315  P5000-EXIT.                                                      DTSBX330
00316      EXIT.                                                        DTSBX330
00317                                                                   DTSBX330
00318  P5100-WRITE-R330.                                                   CL*19
00319      MOVE WRK-EMP-NO               TO R330-EMP-NO.                   CL*19
00320      MOVE WRK-SUBJECT-DATE         TO R330-SUBJECT-DATE.             CL*19
00321      SET  R330-RPT-TYPE-DAILY-88   TO TRUE.                          CL*19
00322      IF WRK-YRQ < +99999                                             CL*22
00323         SET R330-DEBIT-88          TO TRUE                           CL*19
00324      ELSE                                                            CL*19
00325         SET R330-CREDIT-88         TO TRUE                           CL*19
00326      END-IF.                                                         CL*19
00327      MOVE QTR-BATCH-NO (QTR-SUB)   TO R330-BATCH-NO.                 CL*19
00328      MOVE QTR-ITEM-NO (QTR-SUB)    TO R330-ITEM-NO.                  CL*19
00329      MOVE QTR-TRAN-TYPE (QTR-SUB)  TO R330-TRAN-TYPE.                CL*19
00330      MOVE QTR-AMT(QTR-SUB)         TO R330-AMT.                      CL*19
00331                                                                      CL*19
00332      PERFORM S946-WRITE-R330 THRU S946-EXIT.                         CL*19
00333                                                                      CL*19
00334      ADD +1 TO WRK-R330-CNT.                                         CL*19
00335                                                                      CL*19
00336      MOVE WRK-QTR-BAL TO DISPLAY-AMT.                                CL*19
00337      MOVE QTR-AMT(QTR-SUB) TO DISPLAY-AMT1.                          CL*19
00338      DISPLAY WRK-EMP-NO '  ' WRK-YRQ                                 CL*19
00339         '  ' DISPLAY-AMT1                                            CL*19
00340         '  ' QTR-BATCH-NO (QTR-SUB)                                  CL*19
00341         '  ' QTR-ITEM-NO (QTR-SUB)                                   CL*19
00342         '  ' QTR-TRAN-TYPE (QTR-SUB)                                 CL*19
00343         '  ' DISPLAY-AMT.                                            CL*19
00344                                                                      CL*19
00345  P5100-EXIT.                                                         CL*19
00346      EXIT.                                                           CL*19
00347                                                                      CL*19
00348  T0000-TERMINATE.                                                 DTSBX330
00349                                                                   DTSBX330
00350      CLOSE X330-FILE.                                                CL*18
00351                                                                      CL*15
00352      DISPLAY ' '.                                                 DTSBX330
00353                                                                   DTSBX330
00354      DISPLAY '*** DTSBX330 TERMINATION STATISTICS ***'.              CL*19
00355                                                                   DTSBX330
00356      DISPLAY '  '.                                                DTSBX330
00357      MOVE  WRK-R330-CNT         TO DISPLAY-CNT.                      CL*19
00358      DISPLAY 'R330 RECORDS WRITTEN                          : '      CL*19
00359          DISPLAY-CNT.                                             DTSBX330
00360                                                                   DTSBX330
00361      MOVE LOW-VALUES   TO R330-REC.                                  CL*21
00362      MOVE -1 TO R330-LENGTH.                                         CL*20
00363                                                                      CL*19
00364      PERFORM S946-WRITE-R330 THRU S946-EXIT.                         CL*19
00365                                                                      CL*19
00366  T0000-EXIT.                                                      DTSBX330
00367      EXIT.                                                        DTSBX330
00368                                                                   DTSBX330
00369  S001-FROM-FED-8.                                                 DTSBX330
00370      SET L001-FROM-FED-8 TO TRUE.                                 DTSBX330
00371      GO TO S001-DATE.                                             DTSBX330
00372                                                                   DTSBX330
00373  S001-FROM-ABS-DAY.                                               DTSBX330
00374      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBX330
00375      GO TO S001-DATE.                                             DTSBX330
00376                                                                   DTSBX330
00377  S001-FROM-CAL-6.                                                 DTSBX330
00378      SET L001-FROM-CAL-6 TO TRUE.                                 DTSBX330
00379      GO TO S001-DATE.                                             DTSBX330
00380                                                                   DTSBX330
00381  S001-DATE.                                                       DTSBX330
00382      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBX330
00383  S001-EXIT.                                                       DTSBX330
00384      EXIT.                                                        DTSBX330
00385      SKIP3                                                        DTSBX330
00386  S004-FROM-5.                                                     DTSBX330
00387      SET L004-FROM-5 TO TRUE.                                     DTSBX330
00388      GO TO S004-QTR.                                              DTSBX330
00389                                                                   DTSBX330
00390  S004-FROM-ABS.                                                   DTSBX330
00391      SET L004-FROM-ABS TO TRUE.                                   DTSBX330
00392      GO TO S004-QTR.                                              DTSBX330
00393                                                                   DTSBX330
00394  S004-FROM-3.                                                     DTSBX330
00395      SET L004-FROM-3 TO TRUE.                                     DTSBX330
00396      GO TO S004-QTR.                                              DTSBX330
00397                                                                   DTSBX330
00398  S004-FROM-DATE.                                                  DTSBX330
00399      SET L004-FROM-DATE TO TRUE.                                  DTSBX330
00400      GO TO S004-QTR.                                              DTSBX330
00401                                                                   DTSBX330
00402  S004-QTR.                                                        DTSBX330
00403                                                                   DTSBX330
00404      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBX330
00405                                                                   DTSBX330
00406  S004-EXIT.                                                       DTSBX330
00407      EXIT.                                                        DTSBX330
00408      SKIP3                                                        DTSBX330
00409                                                                   DTSBX330
00410  S946-WRITE-R330.                                                    CL*19
00411      CALL 'DTSBU946' USING R330-REC.                                 CL*19
00412                                                                      CL*19
00413  S946-EXIT.                                                          CL*19
00414      EXIT.                                                           CL*19
00415      SKIP3                                                           CL*19
00416  S999-ABEND.                                                      DTSBX330
00417      DISPLAY '*** DTSBE774 ABENDING.  '                           DTSBX330
00418              ABEND-MSG.                                           DTSBX330
00419                                                                   DTSBX330
00420      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBX330
00421  S999-EXIT.                                                       DTSBX330
00422      EXIT.                                                        DTSBX330
