00001  IDENTIFICATION DIVISION.                                         09/30/10
00002  PROGRAM-ID.             DTSBX347.                                DTSBX347
00003  AUTHOR.                 NGC.                                        LV003
00004  DATE-WRITTEN.           JANUARY 2010.                            DTSBX347
00005  DATE-COMPILED.                                                   DTSBX347
00006      SKIP3                                                        DTSBX347
00007 *****                                                             DTSBX347
00008 *                                                                 DTSBX347
00009 *    FUNCTION:  INTERNAL WEB MAINFRAME EXTRACT -                  DTSBX347
00010 *               ACCOUNTING TRANSACTION UPDATES                    DTSBX347
00011 *                                                                 DTSBX347
00012 *                                                                 DTSBX347
00013 *****                                                             DTSBX347
00014 ******************************************************************DTSBX347
00015 * MODIFICATION HISTORY:                                          *DTSBX347
00016 *                                                                *DTSBX347
00017 * 12-16-2009 CORRECTED PROGRAM CODE - CHANGED TO PIC X.          *DTSBX347
00018 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *DTSBX347
00019 *                                                                *DTSBX347
00020 ******************************************************************DTSBX347
00021      SKIP3                                                        DTSBX347
00022  ENVIRONMENT DIVISION.                                            DTSBX347
00023      SKIP2                                                        DTSBX347
00024  INPUT-OUTPUT SECTION.                                            DTSBX347
00025                                                                   DTSBX347
00026  FILE-CONTROL.                                                    DTSBX347
00027      SELECT ATH-FILE ASSIGN TO AS-DTSFATHI                        DTSBX347
00028          ORGANIZATION IS SEQUENTIAL                               DTSBX347
00029          FILE STATUS IS ATH-FILE-STATUS                           DTSBX347
00030          ACCESS IS SEQUENTIAL.                                    DTSBX347
00031                                                                   DTSBX347
00032      SELECT ATH-TRANS-FILE ASSIGN TO ATHFTRNO                     DTSBX347
00033             FILE STATUS IS ATH-TRANS-FILE-STATUS.                 DTSBX347
00034                                                                   DTSBX347
00035      SELECT ATH-HDR-FILE   ASSIGN TO ATHFHDRO                     DTSBX347
00036             FILE STATUS IS ATH-HDR-FILE-STATUS.                   DTSBX347
00037                                                                   DTSBX347
00038      SELECT ATH-RPT-FILE   ASSIGN TO ATHFRPTO                     DTSBX347
00039             FILE STATUS IS ATH-RPT-FILE-STATUS.                   DTSBX347
00040                                                                   DTSBX347
00041      SELECT ATH-ATX-FILE ASSIGN TO ATHFATXO                       DTSBX347
00042             FILE STATUS IS ATH-ATX-FILE-STATUS.                   DTSBX347
00043                                                                   DTSBX347
00044      SELECT ATH-PAY-FILE ASSIGN TO ATHFPAYO                       DTSBX347
00045             FILE STATUS IS ATH-PAY-FILE-STATUS.                   DTSBX347
00046                                                                   DTSBX347
00047      SELECT ATH-ADJ-FILE ASSIGN TO ATHFADJO                       DTSBX347
00048             FILE STATUS IS ATH-ADJ-FILE-STATUS.                   DTSBX347
00049                                                                   DTSBX347
00050  DATA DIVISION.                                                   DTSBX347
00051      SKIP3                                                        DTSBX347
00052  FILE SECTION.                                                    DTSBX347
00053  FD  ATH-FILE                                                     DTSBX347
00054      RECORD CONTAINS 256 CHARACTERS                               DTSBX347
00055      DATA RECORD IS ATH-REC.                                      DTSBX347
00056  01  ATH-REC.                                                     DTSBX347
00057  ++INCLUDE DTSIAATH                                               DTSBX347
00058                                                                   DTSBX347
00059  FD  ATH-TRANS-FILE                                               DTSBX347
00060      RECORDING MODE IS F                                          DTSBX347
00061      BLOCK CONTAINS 0 CHARACTERS                                  DTSBX347
00062      LABEL RECORDS ARE STANDARD.                                  DTSBX347
00063                                                                   DTSBX347
00064  01  ATH-TRANS-REC                   PIC  X(48).                  DTSBX347
00065                                                                   DTSBX347
00066  FD  ATH-HDR-FILE                                                 DTSBX347
00067      RECORDING MODE IS F                                          DTSBX347
00068      BLOCK CONTAINS 0 CHARACTERS                                  DTSBX347
00069      LABEL RECORDS ARE STANDARD.                                  DTSBX347
00070                                                                   DTSBX347
00071  01  ATH-HDR-REC                     PIC  X(134).                 DTSBX347
00072                                                                   DTSBX347
00073  FD  ATH-RPT-FILE                                                 DTSBX347
00074      RECORDING MODE IS F                                          DTSBX347
00075      BLOCK CONTAINS 0 CHARACTERS                                  DTSBX347
00076      LABEL RECORDS ARE STANDARD.                                  DTSBX347
00077                                                                   DTSBX347
00078  01  ATH-RPT-REC                     PIC  X(190).                 DTSBX347
00079                                                                   DTSBX347
00080  FD  ATH-ATX-FILE                                                 DTSBX347
00081      RECORDING MODE IS F                                          DTSBX347
00082      BLOCK CONTAINS 0 CHARACTERS                                  DTSBX347
00083      LABEL RECORDS ARE STANDARD.                                  DTSBX347
00084                                                                   DTSBX347
00085  01  ATH-ATX-REC                     PIC  X(234).                 DTSBX347
00086                                                                   DTSBX347
00087  FD  ATH-PAY-FILE                                                 DTSBX347
00088      RECORDING MODE IS F                                          DTSBX347
00089      BLOCK CONTAINS 0 CHARACTERS                                  DTSBX347
00090      LABEL RECORDS ARE STANDARD.                                  DTSBX347
00091                                                                   DTSBX347
00092  01  ATH-PAY-REC                     PIC  X(113).                 DTSBX347
00093                                                                   DTSBX347
00094  FD  ATH-ADJ-FILE                                                 DTSBX347
00095      RECORDING MODE IS F                                          DTSBX347
00096      BLOCK CONTAINS 0 CHARACTERS                                  DTSBX347
00097      LABEL RECORDS ARE STANDARD.                                  DTSBX347
00098                                                                   DTSBX347
00099  01  ATH-ADJ-REC                     PIC  X(138).                 DTSBX347
00100                                                                   DTSBX347
00101      EJECT                                                        DTSBX347
00102  WORKING-STORAGE SECTION.                                         DTSBX347
001025 77  PAN-VALET PICTURE X(24) VALUE '003DTSBX347  09/30/10'.       DTSBX347
00103                                                                   DTSBX347
00104  01  WRK-AREA.                                                    DTSBX347
00105      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +347.DTSBX347
00106                                                                   DTSBX347
00107      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBX347'.DTSBX347
00108                                                                   DTSBX347
00109      05  ATH-FILE-STATUS             PIC  X(02)  VALUE SPACES.    DTSBX347
00110          88  ATH-FILE-OK-88        VALUE ZERO.                    DTSBX347
00111          88  ATH-FILE-EOF-88       VALUE '10'.                    DTSBX347
00112                                                                   DTSBX347
00113      05  ATH-TRANS-FILE-STATUS       PIC X(02) VALUE SPACES.      DTSBX347
00114          88  ATH-TRANS-FILE-OK-88  VALUE ZERO.                    DTSBX347
00115                                                                   DTSBX347
00116      05  ATH-HDR-FILE-STATUS         PIC X(02) VALUE SPACES.      DTSBX347
00117          88  ATH-HDR-FILE-OK-88    VALUE ZERO.                    DTSBX347
00118                                                                   DTSBX347
00119      05  ATH-RPT-FILE-STATUS         PIC X(02) VALUE SPACES.      DTSBX347
00120          88  ATH-RPT-FILE-OK-88    VALUE ZERO.                    DTSBX347
00121                                                                   DTSBX347
00122      05  ATH-ATX-FILE-STATUS         PIC X(02) VALUE SPACES.      DTSBX347
00123          88  ATH-ATX-FILE-OK-88    VALUE ZERO.                    DTSBX347
00124                                                                   DTSBX347
00125      05  ATH-PAY-FILE-STATUS         PIC X(02) VALUE SPACES.      DTSBX347
00126          88  ATH-PAY-FILE-OK-88    VALUE ZERO.                    DTSBX347
00127                                                                   DTSBX347
00128      05  ATH-ADJ-FILE-STATUS         PIC X(02) VALUE SPACES.      DTSBX347
00129          88  ATH-ADJ-FILE-OK-88    VALUE ZERO.                    DTSBX347
00130                                                                   DTSBX347
00131      05  WRK-FIRST-DATE              PIC S9(09) COMP-3            DTSBX347
00132                                        VALUE +999999999.          DTSBX347
00133      05  WRK-ATH-FILE-IN-CNT         PIC  9(07) COMP-3 VALUE 0.   DTSBX347
00134      05  WRK-ATH-TRANS-CNT           PIC  9(07) COMP-3 VALUE 0.   DTSBX347
00135      05  WRK-ATH-HDR-CNT             PIC  9(07) COMP-3 VALUE 0.   DTSBX347
00136      05  WRK-ATH-RPT-CNT             PIC  9(07) COMP-3 VALUE 0.   DTSBX347
00137      05  WRK-ATH-ATX-CNT             PIC  9(07) COMP-3 VALUE 0.   DTSBX347
00138      05  WRK-ATH-PAY-CNT             PIC  9(07) COMP-3 VALUE 0.   DTSBX347
00139      05  WRK-ATH-ADJ-CNT             PIC  9(07) COMP-3 VALUE 0.   DTSBX347
00140                                                                   DTSBX347
00141      05  WRK-SEQ                     PIC  9(05) COMP-3 VALUE 0.   DTSBX347
00142                                                                   DTSBX347
00143  01  WRK-TRANS-REC.                                               DTSBX347
00144      05  TRN-SEQ                     PIC  9(05).                  DTSBX347
00145      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00146      05  TRN-BATCH                   PIC  X(05).                  DTSBX347
00147      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00148      05  TRN-ITEM                    PIC  X(03).                  DTSBX347
00149      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00150      05  TRN-DATE                    PIC  X(10).                  DTSBX347
00151      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00152      05  TRN-TIME                    PIC  X(08).                  DTSBX347
00153      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00154      05  TRN-REC-TYPE                PIC  X(01).                  DTSBX347
00155      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00156      05  TRN-ACTION                  PIC  X(01).                  DTSBX347
00157      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00158      05  TRN-OPID                    PIC  X(08).                  DTSBX347
00159                                                                   DTSBX347
00160  01  WRK-HDR-REC.                                                 DTSBX347
00161      05  HDR-SEQ                     PIC  9(05).                  DTSBX347
00162      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00163      05  HDR-BAL-IND                 PIC  X(01).                  DTSBX347
00164      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00165      05  HDR-HELD-IND                PIC  X(01).                  DTSBX347
00166      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00167      05  HDR-ESTB-OPID               PIC  X(08).                  DTSBX347
00168      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00169      05  HDR-ESTB-DATE               PIC  X(10).                  DTSBX347
00170      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00171      05  HDR-CHNG-OPID               PIC  X(08).                  DTSBX347
00172      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00173      05  HDR-CHNG-DATE               PIC  X(10).                  DTSBX347
00174      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00175      05  HDR-DEPOSIT-DATE            PIC  X(10).                  DTSBX347
00176      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00177      05  HDR-RCVD-DATE               PIC  X(10).                  DTSBX347
00178      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00179      05  HDR-LAST-ITEM               PIC  9(03).                  DTSBX347
00180      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00181      05  HDR-CNTL-TRAN-CNT           PIC  9(03).                  DTSBX347
00182      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00183      05  HDR-ATC-TRAN-CNT            PIC  9(03).                  DTSBX347
00184      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00185      05  HDR-PROCESS-TRAN-CNT        PIC  9(03).                  DTSBX347
00186      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00187      05  HDR-CNTL-REMIT-AMT          PIC  --------9.99.           DTSBX347
00188      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00189      05  HDR-ATC-REMIT-AMT           PIC  --------9.99.           DTSBX347
00190      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00191      05  HDR-PROCESS-REMIT-AMT       PIC  --------9.99.           DTSBX347
00192      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00193      05  HDR-ANN-BATCH-IND           PIC  X(01).                  DTSBX347
00194      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00195      05  HDR-BANK-BATCH              PIC  X(05).                  DTSBX347
00196                                                                   DTSBX347
00197  01  WRK-RPT-REC.                                                 DTSBX347
00198      05  RPT-SEQ                     PIC  9(05).                  DTSBX347
00199      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00200      05  RPT-NAME-CHECK              PIC  X(04).                  DTSBX347
00201      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00202      05  RPT-EMP-NBR                 PIC  9(06).                  DTSBX347
00203      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00204      05  RPT-RPT-TYPE                PIC  X(02).                  DTSBX347
00205      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00206      05  RPT-QTR                     PIC  X(06).                  DTSBX347
00207      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00208      05  RPT-TOT-WAGE                PIC  ----------9.99.         DTSBX347
00209      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00210      05  RPT-EXCESS-WAGE             PIC  ----------9.99.         DTSBX347
00211      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00212      05  RPT-TAX-WAGE                PIC  ----------9.99.         DTSBX347
00213      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00214      05  RPT-REMIT-AMT               PIC  --------9.99.           DTSBX347
00215      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00216      05  RPT-WAGE-RPT-IND            PIC  X(01).                  DTSBX347
00217      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00218      05  RPT-WAIVE-BOTH-IND          PIC  X(01).                  DTSBX347
00219      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00220      05  RPT-WAIVE-INT-IND           PIC  X(01).                  DTSBX347
00221      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00222      05  RPT-WAIVE-PEN-IND           PIC  X(01).                  DTSBX347
00223      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00224      05  RPT-TOT-WORKER-CNT          PIC  9(07).                  DTSBX347
00225      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00226      05  RPT-MONTH1-CNT              PIC  9(07).                  DTSBX347
00227      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00228      05  RPT-MONTH2-CNT              PIC  9(07).                  DTSBX347
00229      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00230      05  RPT-MONTH3-CNT              PIC  9(07).                  DTSBX347
00231      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00232      05  RPT-RCVD-DATE               PIC  X(10).                  DTSBX347
00233      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00234      05  RPT-DEPOSIT-DATE            PIC  X(10).                  DTSBX347
00235      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00236      05  RPT-RESP-ACTIVITY           PIC  X(03).                  DTSBX347
00237      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00238      05  RPT-RESP-OPID               PIC  X(08).                  DTSBX347
00239      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00240      05  RPT-PASSED-FULL-EDITS       PIC  X(01).                  DTSBX347
00241      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00242      05  RPT-TRACE-NBR               PIC  X(15).                  DTSBX347
00243      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00244      05  RPT-PSEUDO-BATCH            PIC  X(05).                  DTSBX347
00245      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00246      05  RPT-PSEUDO-ITEM             PIC  X(03).                  DTSBX347
00247      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00248      05  RPT-STATUS-CHNG             PIC  X(01).                  DTSBX347
00249                                                                   DTSBX347
00250  01  WRK-ATX-REC.                                                 DTSBX347
00251      05  ATX-SEQ                     PIC  9(05).                  DTSBX347
00252      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00253      05  ATX-NAME-CHECK              PIC  X(04).                  DTSBX347
00254      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00255      05  ATX-EMP-NBR                 PIC  9(06).                  DTSBX347
00256      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00257      05  ATX-RPT-TYPE                PIC  X(02).                  DTSBX347
00258      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00259      05  ATX-QTR                     PIC  X(06).                  DTSBX347
00260      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00261      05  ATX-TOT-WAGE                PIC  ----------9.99.         DTSBX347
00262      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00263      05  ATX-EXCESS-WAGE             PIC  ----------9.99.         DTSBX347
00264      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00265      05  ATX-TAX-WAGE                PIC  ----------9.99.         DTSBX347
00266      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00267      05  ATX-REMIT-AMT               PIC  --------9.99.           DTSBX347
00268      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00269      05  ATX-WAIVE-BOTH-IND          PIC  X(01).                  DTSBX347
00270      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00271      05  ATX-WAIVE-INT-IND           PIC  X(01).                  DTSBX347
00272      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00273      05  ATX-WAIVE-PEN-IND           PIC  X(01).                  DTSBX347
00274      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00275      05  ATX-TOT-WORKER-CNT          PIC  9(07).                  DTSBX347
00276      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00277      05  ATX-JAN-CNT                 PIC  9(07).                  DTSBX347
00278      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00279      05  ATX-FEB-CNT                 PIC  9(07).                  DTSBX347
00280      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00281      05  ATX-MAR-CNT                 PIC  9(07).                  DTSBX347
00282      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00283      05  ATX-APR-CNT                 PIC  9(07).                  DTSBX347
00284      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00285      05  ATX-MAY-CNT                 PIC  9(07).                  DTSBX347
00286      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00287      05  ATX-JUN-CNT                 PIC  9(07).                  DTSBX347
00288      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00289      05  ATX-JUL-CNT                 PIC  9(07).                  DTSBX347
00290      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00291      05  ATX-AUG-CNT                 PIC  9(07).                  DTSBX347
00292      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00293      05  ATX-SEP-CNT                 PIC  9(07).                  DTSBX347
00294      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00295      05  ATX-OCT-CNT                 PIC  9(07).                  DTSBX347
00296      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00297      05  ATX-NOV-CNT                 PIC  9(07).                  DTSBX347
00298      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00299      05  ATX-DEC-CNT                 PIC  9(07).                  DTSBX347
00300      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00301      05  ATX-RCVD-DATE               PIC  X(10).                  DTSBX347
00302      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00303      05  ATX-DEPOSIT-DATE            PIC  X(10).                  DTSBX347
00304      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00305      05  ATX-RESP-ACTIVITY           PIC  X(03).                  DTSBX347
00306      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00307      05  ATX-RESP-OPID               PIC  X(08).                  DTSBX347
00308      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00309      05  ATX-PASSED-FULL-EDITS       PIC  X(01).                  DTSBX347
00310      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00311      05  ATX-STATUS-CHNG             PIC  X(01).                  DTSBX347
00312                                                                   DTSBX347
00313  01  WRK-PAY-REC.                                                 DTSBX347
00314      05  PAY-SEQ                     PIC  9(05).                  DTSBX347
00315      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00316      05  PAY-NAME-CHECK              PIC  X(04).                  DTSBX347
00317      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00318      05  PAY-EMP-NBR                 PIC  9(06).                  DTSBX347
00319      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00320      05  PAY-PAY-TYPE                PIC  X(02).                  DTSBX347
00321      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00322      05  PAY-REMIT-AMT               PIC  --------9.99.           DTSBX347
00323      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00324      05  PAY-WAIVE-INT-IND           PIC  X(01).                  DTSBX347
00325      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00326      05  PAY-WAIVE-PEN-IND           PIC  X(01).                  DTSBX347
00327      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00328      05  PAY-NSF-PEN-CHG-IND         PIC  X(01).                  DTSBX347
00329      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00330      05  PAY-RCVD-DATE               PIC  X(10).                  DTSBX347
00331      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00332      05  PAY-DEPOSIT-DATE            PIC  X(10).                  DTSBX347
00333      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00334      05  PAY-APPLIC-QTR              PIC  X(06).                  DTSBX347
00335      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00336      05  PAY-APPLIC-IND              PIC  X(02).                  DTSBX347
00337      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00338      05  PAY-APPLIC-BATCH            PIC  X(05).                  DTSBX347
00339      05  FILLER                      PIC  X(03) VALUE ';'.        DTSBX347
00340      05  PAY-APPLIC-ITEM             PIC  X(02).                  DTSBX347
00341      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00342      05  PAY-RESP-ACTIVITY           PIC  X(03).                  DTSBX347
00343      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00344      05  PAY-RESP-OPID               PIC  X(08).                  DTSBX347
00345      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00346      05  PAY-ANN-RPT-IND             PIC  X(01).                  DTSBX347
00347      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00348      05  PAY-TRACE-NBR               PIC  X(15).                  DTSBX347
00349                                                                   DTSBX347
00350  01  WRK-ADJ-REC.                                                 DTSBX347
00351      05  ADJ-SEQ                     PIC  9(05).                  DTSBX347
00352      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00353      05  ADJ-NAME-CHECK              PIC  X(04).                  DTSBX347
00354      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00355      05  ADJ-EMP-NBR                 PIC  9(06).                  DTSBX347
00356      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00357      05  ADJ-ADJ-TYPE                PIC  X(02).                  DTSBX347
00358      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00359      05  ADJ-AMT                     PIC  --------9.99.           DTSBX347
00360      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00361      05  ADJ-RCVD-DATE               PIC  X(10).                  DTSBX347
00362      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00363      05  ADJ-DEPOSIT-DATE            PIC  X(10).                  DTSBX347
00364      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00365      05  ADJ-APPLIC-QTR              PIC  X(06).                  DTSBX347
00366      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00367      05  ADJ-APPLIC-IND              PIC  X(02).                  DTSBX347
00368      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00369      05  ADJ-APPLIC-BATCH            PIC  X(05).                  DTSBX347
00370      05  FILLER                      PIC  X(03) VALUE ';'.        DTSBX347
00371      05  ADJ-APPLIC-ITEM             PIC  X(02).                  DTSBX347
00372      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00373      05  ADJ-DATE1                   PIC  X(10).                  DTSBX347
00374      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00375      05  ADJ-DATE2                   PIC  X(10).                  DTSBX347
00376      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00377      05  ADJ-INT-SPAN-IND            PIC  X(01).                  DTSBX347
00378      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00379      05  ADJ-INT-RATE                PIC  99.9.                   DTSBX347
00380      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00381      05  ADJ-RESP-ACTIVITY           PIC  X(03).                  DTSBX347
00382      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00383      05  ADJ-RESP-OPID               PIC  X(08).                  DTSBX347
00384      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00385      05  ADJ-COMPROMISE-DT           PIC  X(10).                  DTSBX347
00386      05  FILLER                      PIC  X(01) VALUE ';'.        DTSBX347
00387      05  ADJ-COMPROMISE-TIME         PIC  X(08).                  DTSBX347
00388      EJECT                                                        DTSBX347
00389  01  L001-LINK-AREA.                                              DTSBX347
00390  ++INCLUDE DTSIL001                                               DTSBX347
00391                                                                   DTSBX347
00392  01  L004-LINK-AREA.                                              DTSBX347
00393  ++INCLUDE DTSIL004                                               DTSBX347
00394                                                                   DTSBX347
00395  01  L005-LINK-AREA.                                              DTSBX347
00396  ++INCLUDE DTSIL005                                               DTSBX347
00397                                                                   DTSBX347
00398  01  WRK-AHDR-REC.                                                DTSBX347
00399  ++INCLUDE DTSIAHDR                                               DTSBX347
00400                                                                   DTSBX347
00401  01  WRK-ARPT-REC.                                                DTSBX347
00402  ++INCLUDE DTSIARPT                                               DTSBX347
00403                                                                   DTSBX347
00404  01  WRK-AATX-REC.                                                DTSBX347
00405  ++INCLUDE DTSIAATX                                               DTSBX347
00406                                                                   DTSBX347
00407  01  WRK-APAY-REC.                                                DTSBX347
00408  ++INCLUDE DTSIAPAY                                               DTSBX347
00409                                                                   DTSBX347
00410  01  WRK-AADJ-REC.                                                DTSBX347
00411  ++INCLUDE DTSIAADJ                                               DTSBX347
00412                                                                   DTSBX347
00413  PROCEDURE DIVISION.                                              DTSBX347
00414                                                                   DTSBX347
00415      PERFORM I0000-INITIATE       THRU I0000-EXIT.                DTSBX347
00416      PERFORM P0000-PROCESS        THRU P0000-EXIT.                DTSBX347
00417      PERFORM T0000-TERMINATE      THRU T0000-EXIT.                DTSBX347
00418                                                                   DTSBX347
00419      GOBACK.                                                      DTSBX347
00420      EJECT                                                        DTSBX347
00421  I0000-INITIATE.                                                  DTSBX347
00422      PERFORM I2000-OPEN-FILES          THRU I2000-EXIT.           DTSBX347
00423                                                                   DTSBX347
00424  I0000-EXIT.                                                      DTSBX347
00425      EXIT.                                                        DTSBX347
00426  I2000-OPEN-FILES.                                                DTSBX347
00427      OPEN INPUT ATH-FILE.                                         DTSBX347
00428      IF NOT ATH-FILE-OK-88                                        DTSBX347
00429         DISPLAY 'ATH FILE OPEN ERROR: ' ATH-FILE-STATUS           DTSBX347
00430         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX347
00431      END-IF.                                                      DTSBX347
00432                                                                   DTSBX347
00433      OPEN OUTPUT ATH-TRANS-FILE.                                  DTSBX347
00434      IF NOT ATH-TRANS-FILE-OK-88                                  DTSBX347
00435         DISPLAY 'TRANS FILE OPEN ERROR: '                         DTSBX347
00436            ATH-TRANS-FILE-STATUS                                  DTSBX347
00437         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX347
00438      END-IF.                                                      DTSBX347
00439                                                                   DTSBX347
00440      OPEN OUTPUT ATH-HDR-FILE.                                    DTSBX347
00441      IF NOT ATH-HDR-FILE-OK-88                                    DTSBX347
00442         DISPLAY 'HDR FILE OPEN ERROR: '                           DTSBX347
00443            ATH-HDR-FILE-STATUS                                    DTSBX347
00444         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX347
00445      END-IF.                                                      DTSBX347
00446                                                                   DTSBX347
00447      OPEN OUTPUT ATH-RPT-FILE.                                    DTSBX347
00448      IF NOT ATH-RPT-FILE-OK-88                                    DTSBX347
00449         DISPLAY 'RPT FILE OPEN ERROR: '                           DTSBX347
00450            ATH-RPT-FILE-STATUS                                    DTSBX347
00451         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX347
00452      END-IF.                                                      DTSBX347
00453                                                                   DTSBX347
00454      OPEN OUTPUT ATH-ATX-FILE.                                    DTSBX347
00455      IF NOT ATH-ATX-FILE-OK-88                                    DTSBX347
00456         DISPLAY 'ATX FILE OPEN ERROR: '                           DTSBX347
00457            ATH-ATX-FILE-STATUS                                    DTSBX347
00458         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX347
00459      END-IF.                                                      DTSBX347
00460                                                                   DTSBX347
00461      OPEN OUTPUT ATH-PAY-FILE.                                    DTSBX347
00462      IF NOT ATH-PAY-FILE-OK-88                                    DTSBX347
00463         DISPLAY 'PAY FILE OPEN ERROR: '                           DTSBX347
00464            ATH-PAY-FILE-STATUS                                    DTSBX347
00465         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX347
00466      END-IF.                                                      DTSBX347
00467                                                                   DTSBX347
00468      OPEN OUTPUT ATH-ADJ-FILE.                                    DTSBX347
00469      IF NOT ATH-ADJ-FILE-OK-88                                    DTSBX347
00470         DISPLAY 'ADJ FILE OPEN ERROR: '                           DTSBX347
00471            ATH-ADJ-FILE-STATUS                                    DTSBX347
00472         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX347
00473      END-IF.                                                      DTSBX347
00474                                                                   DTSBX347
00475  I2000-EXIT.                                                      DTSBX347
00476      EXIT.                                                        DTSBX347
00477                                                                   DTSBX347
00478  P0000-PROCESS.                                                   DTSBX347
00479      READ ATH-FILE NEXT.                                          DTSBX347
00480                                                                   DTSBX347
00481      IF NOT ATH-FILE-OK-88                                        DTSBX347
00482         DISPLAY 'BAD FIRST READ ' ATH-FILE-STATUS                 DTSBX347
00483         GO TO P0000-EXIT                                          DTSBX347
00484      ELSE                                                         DTSBX347
00485         PERFORM UNTIL ATH-FILE-EOF-88                             DTSBX347
00486          PERFORM P1000-BUILD-OUTPUT   THRU P1000-EXIT             DTSBX347
00487          READ ATH-FILE NEXT                                       DTSBX347
00488         END-PERFORM                                               DTSBX347
00489      END-IF.                                                      DTSBX347
00490                                                                   DTSBX347
00491                                                                   DTSBX347
00492  P0000-EXIT.                                                      DTSBX347
00493      EXIT.                                                        DTSBX347
00494                                                                   DTSBX347
00495  P1000-BUILD-OUTPUT.                                              DTSBX347
00496      ADD +1                         TO WRK-ATH-FILE-IN-CNT.       DTSBX347
00497      ADD +1                         TO WRK-SEQ.                   DTSBX347
00498                                                                   DTSBX347
00499      DISPLAY SPACE.                                               DTSBX347
00500      DISPLAY AATH-BATCH-NO '  ' AATH-ITEM-NO                      DTSBX347
00501         '  ' AATH-REC-TYPE '  ' AATH-ACTION                       DTSBX347
00502         '  ' AATH-OP-ID.                                          DTSBX347
00503                                                                   DTSBX347
00504      IF AATH-DOC-NO = LOW-VALUES                                  DTSBX347
00505         DISPLAY 'DUMMY   REC-TYPE BYPASSED ' AATH-KEY-AREA        DTSBX347
00506 **      SET AATH-PAY-88             TO TRUE                       DTSBX347
00507         GO TO P1000-EXIT                                          DTSBX347
00508      END-IF.                                                      DTSBX347
00509                                                                   DTSBX347
00510      INITIALIZE WRK-TRANS-REC.                                    DTSBX347
00511                                                                   DTSBX347
00512      PERFORM P1100-BUILD-TRANS      THRU P1100-EXIT.              DTSBX347
00513                                                                   DTSBX347
00514      EVALUATE TRUE                                                DTSBX347
00515        WHEN AATH-HDR-88                                           DTSBX347
00516           PERFORM P1110-BUILD-HDR   THRU P1110-EXIT               DTSBX347
00517        WHEN AATH-RPT-88                                           DTSBX347
00518           PERFORM P1120-BUILD-RPT   THRU P1120-EXIT               DTSBX347
00519        WHEN AATH-ATX-88                                           DTSBX347
00520           PERFORM P1130-BUILD-ATX   THRU P1130-EXIT               DTSBX347
00521        WHEN AATH-PAY-88                                           DTSBX347
00522           PERFORM P1140-BUILD-PAY   THRU P1140-EXIT               DTSBX347
00523        WHEN AATH-ADJ-88                                           DTSBX347
00524           PERFORM P1150-BUILD-ADJ   THRU P1150-EXIT               DTSBX347
00525      END-EVALUATE.                                                DTSBX347
00526                                                                   DTSBX347
00527  P1000-EXIT.                                                      DTSBX347
00528      EXIT.                                                        DTSBX347
00529                                                                   DTSBX347
00530  P1100-BUILD-TRANS.                                               DTSBX347
00531      MOVE WRK-SEQ                TO TRN-SEQ.                      DTSBX347
00532      MOVE AATH-BATCH-NO          TO TRN-BATCH.                    DTSBX347
00533      MOVE AATH-ITEM-NO           TO TRN-ITEM.                     DTSBX347
00534      MOVE AATH-REC-TYPE          TO TRN-REC-TYPE.                 DTSBX347
00535      MOVE AATH-DATE              TO L005-DATE.                    DTSBX347
00536      MOVE AATH-TIME              TO L005-TIME.                    DTSBX347
00537      SET L005-FROM-DATE-TIME     TO TRUE.                         DTSBX347
00538      PERFORM S005-DATE           THRU S005-EXIT.                  DTSBX347
00539      MOVE L005-SLASH-8-DATE      TO TRN-DATE.                     DTSBX347
00540      MOVE L005-DISPLAY-TIME      TO TRN-TIME.                     DTSBX347
00541      MOVE AATH-ACTION            TO TRN-ACTION.                   DTSBX347
00542      MOVE AATH-OP-ID             TO TRN-OPID.                     DTSBX347
00543                                                                   DTSBX347
00544      WRITE ATH-TRANS-REC         FROM WRK-TRANS-REC.              DTSBX347
00545      IF ATH-TRANS-FILE-OK-88                                      DTSBX347
00546         ADD 1  TO  WRK-ATH-TRANS-CNT                              DTSBX347
00547      ELSE                                                         DTSBX347
00548         DISPLAY 'TRANS FILE WRITE ERROR: ' ATH-TRANS-FILE-STATUS  DTSBX347
00549         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX347
00550      END-IF.                                                      DTSBX347
00551                                                                   DTSBX347
00552  P1100-EXIT.                                                      DTSBX347
00553      EXIT.                                                        DTSBX347
00554                                                                   DTSBX347
00555  P1110-BUILD-HDR.                                                 DTSBX347
00556      INITIALIZE                   WRK-HDR-REC.                    DTSBX347
00557      MOVE WRK-SEQ                 TO HDR-SEQ.                     DTSBX347
00558      MOVE AATH-DATA-AREA          TO AHDR-DATA-AREA.              DTSBX347
00559                                                                   DTSBX347
00560      MOVE AHDR-BATCH-BALANCED-IND TO HDR-BAL-IND.                 DTSBX347
00561      MOVE AHDR-BATCH-HELD-IND     TO HDR-HELD-IND.                DTSBX347
00562      MOVE AHDR-ESTB-OP-ID         TO HDR-ESTB-OPID.               DTSBX347
00563      MOVE AHDR-ESTB-DATE          TO L001-FED-8-DATE-9.           DTSBX347
00564      PERFORM S001-FROM-FED-8      THRU S001-EXIT.                 DTSBX347
00565      IF L001-INVALID-DATE                                         DTSBX347
00566         MOVE SPACES               TO HDR-ESTB-DATE                DTSBX347
00567      ELSE                                                         DTSBX347
00568         MOVE L001-SLASH-8-DATE    TO HDR-ESTB-DATE                DTSBX347
00569      END-IF.                                                      DTSBX347
00570      MOVE AHDR-CHNG-OP-ID         TO HDR-CHNG-OPID.               DTSBX347
00571      MOVE AHDR-CHNG-DATE          TO L001-FED-8-DATE-9.           DTSBX347
00572      PERFORM S001-FROM-FED-8      THRU S001-EXIT.                 DTSBX347
00573      IF L001-INVALID-DATE                                         DTSBX347
00574         MOVE SPACES               TO HDR-CHNG-DATE                DTSBX347
00575      ELSE                                                         DTSBX347
00576         MOVE L001-SLASH-8-DATE    TO HDR-CHNG-DATE                DTSBX347
00577      END-IF.                                                      DTSBX347
00578      MOVE AHDR-DEPOSIT-DATE       TO L001-FED-8-DATE-9.           DTSBX347
00579      PERFORM S001-FROM-FED-8      THRU S001-EXIT.                 DTSBX347
00580      IF L001-INVALID-DATE                                         DTSBX347
00581         MOVE SPACES               TO HDR-DEPOSIT-DATE             DTSBX347
00582      ELSE                                                         DTSBX347
00583         MOVE L001-SLASH-8-DATE    TO HDR-DEPOSIT-DATE             DTSBX347
00584      END-IF.                                                      DTSBX347
00585      MOVE AHDR-RECEIVED-DATE      TO L001-FED-8-DATE-9.           DTSBX347
00586      PERFORM S001-FROM-FED-8      THRU S001-EXIT.                 DTSBX347
00587      IF L001-INVALID-DATE                                         DTSBX347
00588         MOVE SPACES               TO HDR-RCVD-DATE                DTSBX347
00589      ELSE                                                         DTSBX347
00590         MOVE L001-SLASH-8-DATE    TO HDR-RCVD-DATE                DTSBX347
00591      END-IF.                                                      DTSBX347
00592      MOVE AHDR-LAST-USED-ITEM-NO  TO HDR-LAST-ITEM.               DTSBX347
00593      MOVE AHDR-CONTROL-TRAN-CNT   TO HDR-CNTL-TRAN-CNT.           DTSBX347
00594      MOVE AHDR-ATC-FILE-TRAN-CNT  TO HDR-ATC-TRAN-CNT.            DTSBX347
00595      MOVE AHDR-PROC-TRAN-CNT      TO HDR-PROCESS-TRAN-CNT.        DTSBX347
00596      IF AHDR-CONTROL-REMIT-AMT NOT NUMERIC                        DTSBX347
00597         MOVE ZERO                 TO HDR-CNTL-REMIT-AMT           DTSBX347
00598      ELSE                                                         DTSBX347
00599         MOVE AHDR-CONTROL-REMIT-AMT                               DTSBX347
00600                                   TO HDR-CNTL-REMIT-AMT           DTSBX347
00601      END-IF.                                                      DTSBX347
00602      MOVE AHDR-ATC-FILE-REMIT-AMT TO HDR-ATC-REMIT-AMT.           DTSBX347
00603      MOVE AHDR-PROC-REMIT-AMT     TO HDR-PROCESS-REMIT-AMT.       DTSBX347
00604      MOVE AHDR-ANNUAL-BATCH-IND   TO HDR-ANN-BATCH-IND.           DTSBX347
00605      MOVE AHDR-BANK-BATCH-NO      TO HDR-BANK-BATCH.              DTSBX347
00606                                                                   DTSBX347
00607      WRITE ATH-HDR-REC            FROM WRK-HDR-REC.               DTSBX347
00608      IF ATH-HDR-FILE-OK-88                                        DTSBX347
00609         ADD 1  TO  WRK-ATH-HDR-CNT                                DTSBX347
00610      ELSE                                                         DTSBX347
00611         DISPLAY 'HDR FILE WRITE ERROR: ' ATH-HDR-FILE-STATUS      DTSBX347
00612         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX347
00613      END-IF.                                                      DTSBX347
00614                                                                   DTSBX347
00615  P1110-EXIT.                                                      DTSBX347
00616      EXIT.                                                        DTSBX347
00617                                                                   DTSBX347
00618  P1120-BUILD-RPT.                                                 DTSBX347
00619      INITIALIZE                   WRK-RPT-REC.                    DTSBX347
00620      MOVE WRK-SEQ                 TO RPT-SEQ.                     DTSBX347
00621      MOVE AATH-DATA-AREA          TO ARPT-DATA-AREA.              DTSBX347
00622                                                                   DTSBX347
00623      INSPECT ARPT-NAME-CHECK REPLACING ALL ';' BY SPACE.          DTSBX347
00624      INSPECT ARPT-NAME-CHECK REPLACING ALL ',' BY SPACE.          DTSBX347
00625      MOVE ARPT-NAME-CHECK         TO RPT-NAME-CHECK.              DTSBX347
00626      MOVE ARPT-EMP-NO             TO RPT-EMP-NBR.                 DTSBX347
00627      MOVE ARPT-RPT-TYPE           TO RPT-RPT-TYPE.                DTSBX347
00628      MOVE ARPT-YRQ                TO L004-QTR-5-9.                DTSBX347
00629      PERFORM S004-FROM-5          THRU S004-EXIT.                 DTSBX347
00630      MOVE L004-SLASH-5-QTR        TO RPT-QTR.                     DTSBX347
00631      IF ARPT-TOT-WAGE NOT NUMERIC                                 DTSBX347
00632         MOVE ZERO                 TO RPT-TOT-WAGE                 DTSBX347
00633      ELSE                                                         DTSBX347
00634         MOVE ARPT-TOT-WAGE        TO RPT-TOT-WAGE                 DTSBX347
00635      END-IF.                                                      DTSBX347
00636      IF ARPT-EXCESS-WAGE NOT NUMERIC                              DTSBX347
00637         MOVE ZERO                 TO RPT-EXCESS-WAGE              DTSBX347
00638      ELSE                                                         DTSBX347
00639         MOVE ARPT-EXCESS-WAGE     TO RPT-EXCESS-WAGE              DTSBX347
00640      END-IF.                                                      DTSBX347
00641      IF ARPT-TAX-WAGE NOT NUMERIC                                 DTSBX347
00642         MOVE ZERO                 TO RPT-TAX-WAGE                 DTSBX347
00643      ELSE                                                         DTSBX347
00644         MOVE ARPT-TAX-WAGE        TO RPT-TAX-WAGE                 DTSBX347
00645      END-IF.                                                      DTSBX347
00646      IF ARPT-REMIT-AMT NOT NUMERIC                                DTSBX347
00647         MOVE ZERO                 TO RPT-REMIT-AMT                DTSBX347
00648      ELSE                                                         DTSBX347
00649         MOVE ARPT-REMIT-AMT       TO RPT-REMIT-AMT                DTSBX347
00650      END-IF.                                                      DTSBX347
00651      MOVE ARPT-WAGE-RPT-IND       TO RPT-WAGE-RPT-IND.            DTSBX347
00652      MOVE ARPT-WAIVE-BOTH-IND     TO RPT-WAIVE-BOTH-IND.          DTSBX347
00653      MOVE ARPT-WAIVE-INT-IND      TO RPT-WAIVE-INT-IND.           DTSBX347
00654      MOVE ARPT-WAIVE-LATE-PEN-IND TO RPT-WAIVE-PEN-IND.           DTSBX347
00655      MOVE ARPT-TOTAL-EMPL-CNT     TO RPT-TOT-WORKER-CNT.          DTSBX347
00656      MOVE ARPT-1ST-MTH-EMPL-CNT   TO RPT-MONTH1-CNT.              DTSBX347
00657      MOVE ARPT-2ND-MTH-EMPL-CNT   TO RPT-MONTH2-CNT.              DTSBX347
00658      MOVE ARPT-3RD-MTH-EMPL-CNT   TO RPT-MONTH3-CNT.              DTSBX347
00659      MOVE ARPT-RECEIVED-DATE      TO L001-FED-8-DATE-9.           DTSBX347
00660      PERFORM S001-FROM-FED-8      THRU S001-EXIT.                 DTSBX347
00661      IF L001-INVALID-DATE                                         DTSBX347
00662         MOVE SPACES               TO RPT-RCVD-DATE                DTSBX347
00663      ELSE                                                         DTSBX347
00664         MOVE L001-SLASH-8-DATE    TO RPT-RCVD-DATE                DTSBX347
00665      END-IF.                                                      DTSBX347
00666      MOVE ARPT-DEPOSIT-DATE       TO L001-FED-8-DATE-9.           DTSBX347
00667      PERFORM S001-FROM-FED-8      THRU S001-EXIT.                 DTSBX347
00668      IF L001-INVALID-DATE                                         DTSBX347
00669         MOVE SPACES               TO RPT-DEPOSIT-DATE             DTSBX347
00670      ELSE                                                         DTSBX347
00671         MOVE L001-SLASH-8-DATE    TO RPT-DEPOSIT-DATE             DTSBX347
00672      END-IF.                                                      DTSBX347
00673      MOVE ARPT-RESPONSIBLE-ACTIVITY                               DTSBX347
00674                                   TO RPT-RESP-ACTIVITY.           DTSBX347
00675      MOVE ARPT-RESPONSIBLE-OP-ID  TO RPT-RESP-OPID.               DTSBX347
00676      MOVE ARPT-PASSED-FULL-EDITS-IND                              DTSBX347
00677                                   TO RPT-PASSED-FULL-EDITS.       DTSBX347
00678      MOVE ARPT-TRACE-NO           TO RPT-TRACE-NBR.               DTSBX347
00679      MOVE ARPT-PSEUDO-BATCH-NO    TO RPT-PSEUDO-BATCH.            DTSBX347
00680      MOVE ARPT-PSEUDO-ITEM-NO     TO RPT-PSEUDO-ITEM.             DTSBX347
00681      MOVE ARPT-STATUS-CHNG-IND    TO RPT-STATUS-CHNG.             DTSBX347
00682                                                                   DTSBX347
00683      WRITE ATH-RPT-REC            FROM WRK-RPT-REC.               DTSBX347
00684      IF ATH-RPT-FILE-OK-88                                        DTSBX347
00685         ADD 1  TO  WRK-ATH-RPT-CNT                                DTSBX347
00686      ELSE                                                         DTSBX347
00687         DISPLAY 'RPT FILE WRITE ERROR: ' ATH-RPT-FILE-STATUS      DTSBX347
00688         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX347
00689      END-IF.                                                      DTSBX347
00690                                                                   DTSBX347
00691  P1120-EXIT.                                                      DTSBX347
00692      EXIT.                                                        DTSBX347
00693                                                                   DTSBX347
00694  P1130-BUILD-ATX.                                                 DTSBX347
00695      INITIALIZE                   WRK-ATX-REC.                    DTSBX347
00696      MOVE WRK-SEQ                 TO ATX-SEQ.                     DTSBX347
00697      MOVE AATH-DATA-AREA          TO AATX-DATA-AREA.              DTSBX347
00698                                                                   DTSBX347
00699      MOVE AATX-NAME-CHECK         TO ATX-NAME-CHECK.              DTSBX347
00700      MOVE AATX-EMP-NO             TO ATX-EMP-NBR.                 DTSBX347
00701      MOVE AATX-RPT-TYPE           TO ATX-RPT-TYPE.                DTSBX347
00702      MOVE AATX-YRQ                TO L004-QTR-5-9.                DTSBX347
00703      PERFORM S004-FROM-5          THRU S004-EXIT.                 DTSBX347
00704      MOVE L004-SLASH-5-QTR        TO ATX-QTR.                     DTSBX347
00705      IF AATX-TOT-WAGE NOT NUMERIC                                 DTSBX347
00706         MOVE ZERO                 TO ATX-TOT-WAGE                 DTSBX347
00707      ELSE                                                         DTSBX347
00708         MOVE AATX-TOT-WAGE        TO ATX-TOT-WAGE                 DTSBX347
00709      END-IF.                                                      DTSBX347
00710      IF AATX-EXCESS-WAGE NOT NUMERIC                              DTSBX347
00711         MOVE ZERO                 TO ATX-EXCESS-WAGE              DTSBX347
00712      ELSE                                                         DTSBX347
00713         MOVE AATX-EXCESS-WAGE     TO ATX-EXCESS-WAGE              DTSBX347
00714      END-IF.                                                      DTSBX347
00715      IF AATX-TAX-WAGE NOT NUMERIC                                 DTSBX347
00716         MOVE ZERO                 TO ATX-TAX-WAGE                 DTSBX347
00717      ELSE                                                         DTSBX347
00718         MOVE AATX-TAX-WAGE        TO ATX-TAX-WAGE                 DTSBX347
00719      END-IF.                                                      DTSBX347
00720      IF AATX-REMIT-AMT NOT NUMERIC                                DTSBX347
00721         MOVE ZERO                 TO ATX-REMIT-AMT                DTSBX347
00722      ELSE                                                         DTSBX347
00723         MOVE AATX-REMIT-AMT       TO ATX-REMIT-AMT                DTSBX347
00724      END-IF.                                                      DTSBX347
00725      MOVE AATX-WAIVE-BOTH-IND     TO ATX-WAIVE-BOTH-IND.          DTSBX347
00726      MOVE AATX-WAIVE-INT-IND      TO ATX-WAIVE-INT-IND.           DTSBX347
00727      MOVE AATX-WAIVE-LATE-PEN-IND TO ATX-WAIVE-PEN-IND.           DTSBX347
00728      MOVE AATX-TOTAL-EMPL-CNT     TO ATX-TOT-WORKER-CNT.          DTSBX347
00729      MOVE AATX-JAN-EMPL-CNT       TO ATX-JAN-CNT.                 DTSBX347
00730      MOVE AATX-FEB-EMPL-CNT       TO ATX-FEB-CNT.                 DTSBX347
00731      MOVE AATX-MAR-EMPL-CNT       TO ATX-MAR-CNT.                 DTSBX347
00732      MOVE AATX-APR-EMPL-CNT       TO ATX-APR-CNT.                 DTSBX347
00733      MOVE AATX-MAY-EMPL-CNT       TO ATX-MAY-CNT.                 DTSBX347
00734      MOVE AATX-JUN-EMPL-CNT       TO ATX-JUN-CNT.                 DTSBX347
00735      MOVE AATX-JUL-EMPL-CNT       TO ATX-JUL-CNT.                 DTSBX347
00736      MOVE AATX-AUG-EMPL-CNT       TO ATX-AUG-CNT.                 DTSBX347
00737      MOVE AATX-SEP-EMPL-CNT       TO ATX-SEP-CNT.                 DTSBX347
00738      MOVE AATX-OCT-EMPL-CNT       TO ATX-OCT-CNT.                 DTSBX347
00739      MOVE AATX-NOV-EMPL-CNT       TO ATX-NOV-CNT.                 DTSBX347
00740      MOVE AATX-DEC-EMPL-CNT       TO ATX-DEC-CNT.                 DTSBX347
00741      MOVE AATX-RECEIVED-DATE      TO L001-FED-8-DATE-9.           DTSBX347
00742      PERFORM S001-FROM-FED-8      THRU S001-EXIT.                 DTSBX347
00743      IF L001-INVALID-DATE                                         DTSBX347
00744         MOVE SPACES               TO ATX-RCVD-DATE                DTSBX347
00745      ELSE                                                         DTSBX347
00746         MOVE L001-SLASH-8-DATE    TO ATX-RCVD-DATE                DTSBX347
00747      END-IF.                                                      DTSBX347
00748      MOVE AATX-DEPOSIT-DATE       TO L001-FED-8-DATE-9.           DTSBX347
00749      PERFORM S001-FROM-FED-8      THRU S001-EXIT.                 DTSBX347
00750      IF L001-INVALID-DATE                                         DTSBX347
00751         MOVE SPACES               TO ATX-DEPOSIT-DATE             DTSBX347
00752      ELSE                                                         DTSBX347
00753         MOVE L001-SLASH-8-DATE    TO ATX-DEPOSIT-DATE             DTSBX347
00754      END-IF.                                                      DTSBX347
00755      MOVE AATX-RESPONSIBLE-ACTIVITY                               DTSBX347
00756                                   TO ATX-RESP-ACTIVITY.           DTSBX347
00757      MOVE AATX-RESPONSIBLE-OP-ID  TO ATX-RESP-OPID.               DTSBX347
00758      MOVE AATX-PASSED-FULL-EDITS-IND                              DTSBX347
00759                                   TO ATX-PASSED-FULL-EDITS.       DTSBX347
00760      MOVE AATX-STATUS-CHANGE-IND  TO ATX-STATUS-CHNG.             DTSBX347
00761                                                                   DTSBX347
00762      WRITE ATH-ATX-REC            FROM WRK-ATX-REC.               DTSBX347
00763      IF ATH-ATX-FILE-OK-88                                        DTSBX347
00764         ADD 1  TO  WRK-ATH-ATX-CNT                                DTSBX347
00765      ELSE                                                         DTSBX347
00766         DISPLAY 'ATX FILE WRITE ERROR: ' ATH-ATX-FILE-STATUS      DTSBX347
00767         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX347
00768      END-IF.                                                      DTSBX347
00769                                                                   DTSBX347
00770  P1130-EXIT.                                                      DTSBX347
00771      EXIT.                                                        DTSBX347
00772                                                                   DTSBX347
00773  P1140-BUILD-PAY.                                                 DTSBX347
00774      INITIALIZE                   WRK-PAY-REC.                    DTSBX347
00775      MOVE WRK-SEQ                 TO PAY-SEQ.                     DTSBX347
00776      MOVE AATH-DATA-AREA          TO APAY-DATA-AREA.              DTSBX347
00777                                                                   DTSBX347
00778      MOVE APAY-NAME-CHECK         TO PAY-NAME-CHECK.              DTSBX347
00779      MOVE APAY-EMP-NO             TO PAY-EMP-NBR.                 DTSBX347
00780      MOVE APAY-PAY-TYPE           TO PAY-PAY-TYPE.                DTSBX347
00781      IF APAY-REMIT-AMT NOT NUMERIC                                DTSBX347
00782         MOVE ZERO                 TO PAY-REMIT-AMT                DTSBX347
00783      ELSE                                                         DTSBX347
00784         MOVE APAY-REMIT-AMT       TO PAY-REMIT-AMT                DTSBX347
00785      END-IF.                                                      DTSBX347
00786      MOVE APAY-WAIVE-INT-IND      TO PAY-WAIVE-INT-IND.           DTSBX347
00787      MOVE APAY-WAIVE-LATE-PEN-IND TO PAY-WAIVE-PEN-IND.           DTSBX347
00788      MOVE APAY-NSF-PEN-CHARGE-IND TO PAY-NSF-PEN-CHG-IND.         DTSBX347
00789      MOVE APAY-RECEIVED-DATE      TO L001-FED-8-DATE-9.           DTSBX347
00790      PERFORM S001-FROM-FED-8      THRU S001-EXIT.                 DTSBX347
00791      IF L001-INVALID-DATE                                         DTSBX347
00792         MOVE SPACES               TO PAY-RCVD-DATE                DTSBX347
00793      ELSE                                                         DTSBX347
00794         MOVE L001-SLASH-8-DATE    TO PAY-RCVD-DATE                DTSBX347
00795      END-IF.                                                      DTSBX347
00796      MOVE APAY-DEPOSIT-DATE       TO L001-FED-8-DATE-9.           DTSBX347
00797      PERFORM S001-FROM-FED-8      THRU S001-EXIT.                 DTSBX347
00798      IF L001-INVALID-DATE                                         DTSBX347
00799         MOVE SPACES               TO PAY-DEPOSIT-DATE             DTSBX347
00800      ELSE                                                         DTSBX347
00801         MOVE L001-SLASH-8-DATE     TO PAY-DEPOSIT-DATE            DTSBX347
00802      END-IF.                                                      DTSBX347
00803      MOVE APAY-APPLIC-YRQ         TO L004-QTR-5-9.                DTSBX347
00804      PERFORM S004-FROM-5          THRU S004-EXIT.                 DTSBX347
00805      MOVE L004-SLASH-5-QTR        TO PAY-APPLIC-QTR.              DTSBX347
00806      MOVE APAY-APPLIC-IND         TO PAY-APPLIC-IND.              DTSBX347
00807      MOVE APAY-APPLIC-BATCH-NO    TO PAY-APPLIC-BATCH.            DTSBX347
00808      MOVE APAY-APPLIC-ITEM-NO     TO PAY-APPLIC-ITEM.             DTSBX347
00809      MOVE APAY-RESPONSIBLE-ACTIVITY                               DTSBX347
00810                                   TO PAY-RESP-ACTIVITY.           DTSBX347
00811      MOVE APAY-RESPONSIBLE-OP-ID  TO PAY-RESP-OPID.               DTSBX347
00812      MOVE APAY-ANNUAL-RPT-IND     TO PAY-ANN-RPT-IND.             DTSBX347
00813      MOVE APAY-TRACE-NO           TO PAY-TRACE-NBR.               DTSBX347
00814                                                                   DTSBX347
00815      WRITE ATH-PAY-REC            FROM WRK-PAY-REC.               DTSBX347
00816      IF ATH-PAY-FILE-OK-88                                        DTSBX347
00817         ADD 1  TO  WRK-ATH-PAY-CNT                                DTSBX347
00818      ELSE                                                         DTSBX347
00819         DISPLAY 'PAY FILE WRITE ERROR: ' ATH-PAY-FILE-STATUS      DTSBX347
00820         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX347
00821      END-IF.                                                      DTSBX347
00822                                                                   DTSBX347
00823                                                                   DTSBX347
00824  P1140-EXIT.                                                      DTSBX347
00825      EXIT.                                                        DTSBX347
00826                                                                   DTSBX347
00827  P1150-BUILD-ADJ.                                                 DTSBX347
00828      INITIALIZE                   WRK-ADJ-REC.                    DTSBX347
00829      MOVE WRK-SEQ                 TO ADJ-SEQ.                     DTSBX347
00830      MOVE AATH-DATA-AREA          TO AADJ-DATA-AREA.              DTSBX347
00831                                                                   DTSBX347
00832      MOVE AADJ-NAME-CHECK         TO ADJ-NAME-CHECK.              DTSBX347
00833      MOVE AADJ-EMP-NO             TO ADJ-EMP-NBR.                 DTSBX347
00834      MOVE AADJ-ADJ-TYPE           TO ADJ-ADJ-TYPE.                DTSBX347
00835      IF AADJ-AMT NOT NUMERIC                                      DTSBX347
00836         MOVE ZERO                 TO ADJ-AMT                      DTSBX347
00837      ELSE                                                         DTSBX347
00838         MOVE AADJ-AMT             TO ADJ-AMT                      DTSBX347
00839      END-IF.                                                      DTSBX347
00840      MOVE AADJ-RECEIVED-DATE      TO L001-FED-8-DATE-9.           DTSBX347
00841      PERFORM S001-FROM-FED-8      THRU S001-EXIT.                 DTSBX347
00842      IF L001-INVALID-DATE                                         DTSBX347
00843         MOVE SPACES               TO ADJ-RCVD-DATE                DTSBX347
00844      ELSE                                                         DTSBX347
00845         MOVE L001-SLASH-8-DATE    TO ADJ-RCVD-DATE                DTSBX347
00846      END-IF.                                                      DTSBX347
00847      MOVE AADJ-DEPOSIT-DATE       TO L001-FED-8-DATE-9.           DTSBX347
00848      PERFORM S001-FROM-FED-8      THRU S001-EXIT.                 DTSBX347
00849      IF L001-INVALID-DATE                                         DTSBX347
00850         MOVE SPACES               TO ADJ-DEPOSIT-DATE             DTSBX347
00851      ELSE                                                         DTSBX347
00852         MOVE L001-SLASH-8-DATE    TO ADJ-DEPOSIT-DATE             DTSBX347
00853      END-IF.                                                      DTSBX347
00854      MOVE AADJ-APPLIC-YRQ         TO L004-QTR-5-9.                DTSBX347
00855      PERFORM S004-FROM-5          THRU S004-EXIT.                 DTSBX347
00856      MOVE L004-SLASH-5-QTR        TO ADJ-APPLIC-QTR.              DTSBX347
00857      MOVE AADJ-APPLIC-IND         TO ADJ-APPLIC-IND.              DTSBX347
00858      MOVE AADJ-APPLIC-BATCH-NO    TO ADJ-APPLIC-BATCH.            DTSBX347
00859      MOVE AADJ-APPLIC-ITEM-NO     TO ADJ-APPLIC-ITEM.             DTSBX347
00860      MOVE AADJ-DATE-1             TO L001-FED-8-DATE-9.           DTSBX347
00861      PERFORM S001-FROM-FED-8      THRU S001-EXIT.                 DTSBX347
00862      IF L001-INVALID-DATE                                         DTSBX347
00863         MOVE SPACES               TO ADJ-DATE1                    DTSBX347
00864      ELSE                                                         DTSBX347
00865         MOVE L001-SLASH-8-DATE    TO ADJ-DATE1                    DTSBX347
00866      END-IF.                                                      DTSBX347
00867      MOVE AADJ-DATE-2             TO L001-FED-8-DATE-9.           DTSBX347
00868      PERFORM S001-FROM-FED-8      THRU S001-EXIT.                 DTSBX347
00869      IF L001-INVALID-DATE                                         DTSBX347
00870         MOVE SPACES               TO ADJ-DATE2                    DTSBX347
00871      ELSE                                                         DTSBX347
00872         MOVE L001-SLASH-8-DATE    TO ADJ-DATE2                    DTSBX347
00873      END-IF.                                                      DTSBX347
00874      MOVE AADJ-INT-SPAN-IND       TO ADJ-INT-SPAN-IND.            DTSBX347
00875      IF AADJ-INT-RATE NUMERIC                                     DTSBX347
00876         COMPUTE ADJ-INT-RATE = (AADJ-INT-RATE * 100)              DTSBX347
00877      ELSE                                                         DTSBX347
00878         MOVE ZERO                 TO ADJ-INT-RATE                 DTSBX347
00879      END-IF.                                                      DTSBX347
00880      MOVE AADJ-RESPONSIBLE-ACTIVITY                               DTSBX347
00881                                   TO ADJ-RESP-ACTIVITY.           DTSBX347
00882      MOVE AADJ-RESPONSIBLE-OP-ID  TO ADJ-RESP-OPID.               DTSBX347
00883      IF AADJ-CMP-ESTB-ABSTIME NOT NUMERIC                         DTSBX347
00884         MOVE SPACES                  TO ADJ-COMPROMISE-DT         DTSBX347
00885                                         ADJ-COMPROMISE-TIME       DTSBX347
00886      ELSE                                                         DTSBX347
00887         MOVE AADJ-CMP-ESTB-ABSTIME   TO L005-ABSTIME              DTSBX347
00888         SET L005-FROM-ABSTIME        TO TRUE                      DTSBX347
00889         PERFORM S005-DATE            THRU S005-EXIT               DTSBX347
00890         MOVE L005-DATE               TO L001-FED-8-DATE-9         DTSBX347
00891         PERFORM S001-FROM-FED-8      THRU S001-EXIT               DTSBX347
00892         IF L001-INVALID-DATE                                      DTSBX347
00893            MOVE SPACES               TO ADJ-COMPROMISE-DT         DTSBX347
00894                                      ADJ-COMPROMISE-TIME          DTSBX347
00895         ELSE                                                      DTSBX347
00896            MOVE L005-SLASH-8-DATE    TO ADJ-COMPROMISE-DT         DTSBX347
00897            MOVE L005-DISPLAY-TIME    TO ADJ-COMPROMISE-TIME       DTSBX347
00898            MOVE L005-SLASH-8-DATE    TO L001-FED-8-DATE-X         DTSBX347
00899         END-IF                                                    DTSBX347
00900      END-IF.                                                      DTSBX347
00901                                                                   DTSBX347
00902      WRITE ATH-ADJ-REC            FROM WRK-ADJ-REC.               DTSBX347
00903      IF ATH-ADJ-FILE-OK-88                                        DTSBX347
00904         ADD 1  TO  WRK-ATH-ADJ-CNT                                DTSBX347
00905      ELSE                                                         DTSBX347
00906         DISPLAY 'ADJ FILE WRITE ERROR: ' ATH-ADJ-FILE-STATUS      DTSBX347
00907         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX347
00908      END-IF.                                                      DTSBX347
00909                                                                   DTSBX347
00910  P1150-EXIT.                                                      DTSBX347
00911      EXIT.                                                        DTSBX347
00912                                                                   DTSBX347
00913  T0000-TERMINATE.                                                 DTSBX347
00914                                                                   DTSBX347
00915      DISPLAY ' '.                                                 DTSBX347
00916                                                                   DTSBX347
00917      DISPLAY '*** DTSBX347 TERMINATION STATISTICS ***'.           DTSBX347
00918                                                                   DTSBX347
00919      DISPLAY ' '.                                                 DTSBX347
00920                                                                   DTSBX347
00921      DISPLAY 'EARLIEST DATE ' WRK-FIRST-DATE.                     DTSBX347
00922      DISPLAY ' INPUT RECORDS READ                      : '        DTSBX347
00923         WRK-ATH-FILE-IN-CNT.                                      DTSBX347
00924                                                                   DTSBX347
00925      DISPLAY ' TRANS RECORDS WRITTEN                   : '        DTSBX347
00926         WRK-ATH-TRANS-CNT.                                        DTSBX347
00927                                                                   DTSBX347
00928      DISPLAY ' HEADER RECORDS WRITTEN                  : '        DTSBX347
00929         WRK-ATH-HDR-CNT.                                          DTSBX347
00930                                                                   DTSBX347
00931      DISPLAY ' REPORT RECORDS WRITTEN                  : '        DTSBX347
00932         WRK-ATH-RPT-CNT.                                          DTSBX347
00933                                                                   DTSBX347
00934      DISPLAY ' PAY RECORDS WRITTEN                     : '        DTSBX347
00935         WRK-ATH-PAY-CNT.                                          DTSBX347
00936                                                                   DTSBX347
00937      DISPLAY ' ANNUAL REPORT RECORDS WRITTEN           : '        DTSBX347
00938         WRK-ATH-ATX-CNT.                                          DTSBX347
00939                                                                   DTSBX347
00940      DISPLAY ' ADJUSTMENT RECORDS WRITTEN              : '        DTSBX347
00941         WRK-ATH-ADJ-CNT.                                          DTSBX347
00942                                                                   DTSBX347
00943      DISPLAY ' '.                                                 DTSBX347
00944                                                                   DTSBX347
00945                                                                   DTSBX347
00946      CLOSE ATH-FILE                                               DTSBX347
00947            ATH-HDR-FILE                                           DTSBX347
00948            ATH-RPT-FILE                                           DTSBX347
00949            ATH-ATX-FILE                                           DTSBX347
00950            ATH-PAY-FILE                                           DTSBX347
00951            ATH-ADJ-FILE.                                          DTSBX347
00952                                                                   DTSBX347
00953  T0000-EXIT.                                                      DTSBX347
00954      EXIT.                                                        DTSBX347
00955                                                                   DTSBX347
00956  S001-FROM-FED-8.                                                 DTSBX347
00957      SET L001-FROM-FED-8 TO TRUE.                                 DTSBX347
00958      GO TO S001-DATE.                                             DTSBX347
00959                                                                   DTSBX347
00960  S001-DATE.                                                       DTSBX347
00961      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBX347
00962                                                                   DTSBX347
00963  S001-EXIT.                                                       DTSBX347
00964      EXIT.                                                        DTSBX347
00965      SKIP3                                                        DTSBX347
00966  S004-FROM-5.                                                     DTSBX347
00967      SET L004-FROM-5 TO TRUE.                                     DTSBX347
00968      GO TO S004-QTR.                                              DTSBX347
00969                                                                   DTSBX347
00970  S004-FROM-ABS.                                                   DTSBX347
00971      SET L004-FROM-ABS TO TRUE.                                   DTSBX347
00972      GO TO S004-QTR.                                              DTSBX347
00973                                                                   DTSBX347
00974  S004-FROM-DATE.                                                  DTSBX347
00975      SET L004-FROM-DATE TO TRUE.                                  DTSBX347
00976      GO TO S004-QTR.                                              DTSBX347
00977                                                                   DTSBX347
00978  S004-QTR.                                                        DTSBX347
00979                                                                   DTSBX347
00980      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBX347
00981                                                                   DTSBX347
00982  S004-EXIT.                                                       DTSBX347
00983      EXIT.                                                        DTSBX347
00984                                                                   DTSBX347
00985  S005-DATE.                                                       DTSBX347
00986      CALL 'DTSBU005' USING L005-LINK-AREA.                        DTSBX347
00987  S005-EXIT.                                                       DTSBX347
00988      EXIT.                                                        DTSBX347
00989                                                                   DTSBX347
00990  S999-ABEND.                                                      DTSBX347
00991      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBX347
00992  S999-EXIT.                                                       DTSBX347
00993      EXIT.                                                        DTSBX347
