00001  IDENTIFICATION DIVISION.                                         04/06/18
00002  PROGRAM-ID.             DTSBX425.                                DTSBX425
00003  AUTHOR.                 NGC.                                        LV042
00004  DATE-WRITTEN.           SEPT  2013.                                 CL**2
00005  DATE-COMPILED.                                                   DTSBX425
00006      SKIP3                                                        DTSBX425
00007 *****                                                             DTSBX425
00008 *    FUNCTION: READ A DAILY FILE FROM THE AUTOMATED CLEARING HOUSEDTSBX425
00009 *              THAT CONTAINS RECORDS FOR DISHONORED ELECTRONIC    DTSBX425
00010 *              PAYMENTS.  IT BUILDS DTSIT025 PAYMENT REVERSAL     DTSBX425
00011 *              TRANSACTION RECORDS AND WRITES THESE RECORDS       DTSBX425
00012 *              TO THE DAILY BTC FILE WHICH IS INPUT TO THE NIGHTLYDTSBX425
00013 *              ACCOUNTING UPDATE.                                 DTSBX425
00014 **                                                                DTSBX425
00015 **                                                                DTSBX425
00016      SKIP3                                                        DTSBX425
00017  ENVIRONMENT DIVISION.                                            DTSBX425
00018  CONFIGURATION SECTION.                                              CL*12
00019  SPECIAL-NAMES. C01 IS TOP-OF-PAGE.                                  CL*12
00020                                                                      CL*12
00021  INPUT-OUTPUT SECTION.                                            DTSBX425
00022                                                                   DTSBX425
00023  FILE-CONTROL.                                                    DTSBX425
00024                                                                   DTSBX425
00025      SELECT IN-FACH    ASSIGN TO EFTFACH                          DTSBX425
00026                              FILE STATUS IS FACH-STATUS.          DTSBX425
00027                                                                      CL**5
00028      SELECT ESSP-ACHD-FILE    ASSIGN TO X425RPT1                     CL**5
00029         FILE STATUS IS REPT-STATUS.                                  CL**5
00030                                                                      CL**5
00031      SELECT ESSP-ACHD-TOTAL   ASSIGN TO X425TOTL                     CL*41
00032         FILE STATUS IS REPT-STATUS.                                  CL*41
00033                                                                      CL*41
00034                                                                   DTSBX425
00035  DATA DIVISION.                                                   DTSBX425
00036                                                                   DTSBX425
00037  FILE SECTION.                                                    DTSBX425
00038                                                                   DTSBX425
00039  FD  IN-FACH                                                      DTSBX425
00040      LABEL RECORDS ARE STANDARD                                   DTSBX425
00041      RECORDING MODE IS F                                          DTSBX425
00042      BLOCK CONTAINS 0 RECORDS.                                    DTSBX425
00043                                                                   DTSBX425
00044  01  IN-FACH-REC                    PIC  X(94).                   DTSBX425
00045                                                                   DTSBX425
00046  FD  ESSP-ACHD-TOTAL                                                 CL*41
00047      LABEL RECORDS ARE STANDARD                                      CL*41
00048      RECORDING MODE IS F                                             CL*41
00049      BLOCK CONTAINS 0 RECORDS.                                       CL*41
00050                                                                      CL*41
00051  01  ESSP-ACHD-TOT-REC              PIC  X(80).                      CL*41
00052                                                                      CL*41
00053  FD  ESSP-ACHD-FILE                                                  CL**5
00054      RECORDING MODE IS F                                             CL**5
00055      BLOCK CONTAINS 0 RECORDS                                        CL**5
00056      LABEL RECORDS ARE OMITTED.                                      CL**5
00057                                                                      CL**5
00058  01  ESSP-ACHD-REC           PIC X(133).                             CL**8
00059                                                                      CL**5
00060                                                                   DTSBX425
00061  WORKING-STORAGE SECTION.                                         DTSBX425
000615 77  PAN-VALET PICTURE X(24) VALUE '042DTSBX425  04/06/18'.       DTSBX425
00062  77  PAN-VALET PICTURE X(24) VALUE '216DTSBX425  01/22/04'.          CL**2
00063                                                                   DTSBX425
00064  01  WRK-AREA.                                                    DTSBX425
00065                                                                   DTSBX425
00066      05  WRK-F907-REC-CNT            PIC S9(07)  COMP-3 VALUE +0. DTSBX425
00067                                                                   DTSBX425
00068      05  FACH-STATUS                 PIC  X(02).                  DTSBX425
00069          88 FACH-STATUS-EOF-88         VALUE '10'.                   CL**7
00070          88 FACH-STATUS-OK-88          VALUE '00'.                   CL**7
00071                                                                   DTSBX425
00072      05  REPT-STATUS                 PIC  X(02).                     CL*10
00073          88 REPT-STATUS-EOF-88         VALUE '10'.                   CL*10
00074          88 REPT-STATUS-OK-88          VALUE '00'.                   CL*12
00075                                                                      CL*10
00076      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +50. DTSBX425
00077                                                                   DTSBX425
00078      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBX425'.   CL**2
00079                                                                   DTSBX425
00080      05  WRK-MPAY-REMIT-AMT          PIC  S9(09)V9(02) COMP-3.    DTSBX425
00081                                                                   DTSBX425
00082      05  WRK-CURR-DATE               PIC S9(15)  COMP-3.          DTSBX425
00083      05  WRK-CURR-TIME               PIC S9(09)  COMP-3.          DTSBX425
00084                                                                   DTSBX425
00085      05  WRK-MPRF-READ-CNT           PIC S9(07)  COMP-3.          DTSBX425
00086      05  WRK-FAC6-RECORDS            PIC S9(07)  COMP-3.          DTSBX425
00087      05  WRK-FAC7-RECORDS            PIC S9(07)  COMP-3.             CL*10
00088      05  WRK-OTHER-RECORDS           PIC S9(07)  COMP-3.          DTSBX425
00089      05  WRK-HEADER-RECORDS          PIC S9(07)  COMP-3.          DTSBX425
00090      05  WRK-TRAILER-RECORDS         PIC S9(07)  COMP-3.          DTSBX425
00091      05  WRK-T025-WRITE-CNT          PIC S9(07)  COMP-3.          DTSBX425
00092      05  WRK-R907-WRITE-CNT          PIC S9(07)  COMP-3.          DTSBX425
00093      05  WRK-F907-WRITE-CNT          PIC S9(07)  COMP-3.          DTSBX425
00094      05  WRK-FACH-READ-CNT           PIC S9(07)  COMP-3.          DTSBX425
00095      05  WRK-TRAILER-REC-CNT         PIC S9(07)  COMP-3.          DTSBX425
00096      05  WRK-FACH-SELECTED-CNT       PIC S9(07)  COMP-3.          DTSBX425
00097      05  WRK-FAC6-AMOUNT             PIC S9(08)V99  COMP-3.       DTSBX425
00098      05  TOT-FAC6-AMOUNT             PIC S9(10)V99  COMP-3.       DTSBX425
00099      05  TOT-TRAILER-AMT             PIC S9(10)V99  COMP-3.       DTSBX425
00100      05  WS-LINE-CNT                 PIC  9(05)  VALUE 60.           CL*10
00101      05  WS-PAGE-CNT                 PIC  9(05)  VALUE 0.            CL*10
00102                                                                      CL*33
00103      05  WRK-SYS-ABSTIME         PIC S9(15)    COMP-3 VALUE 0.       CL*33
00104      05  W-SLASH-DATE            PIC  X(10).                         CL*33
00105      05  FILLER REDEFINES W-SLASH-DATE.                              CL*33
00106          10  W-SLASH-DT-MM       PIC  X(02).                         CL*33
00107          10  FILLER              PIC  X(01).                         CL*33
00108          10  W-SLASH-DT-DD       PIC  X(02).                         CL*33
00109          10  FILLER              PIC  X(01).                         CL*33
00110          10  W-SLASH-DT-CCYY     PIC  X(04).                         CL*33
00111                                                                      CL*33
00112                                                                   DTSBX425
00113      05  WRK-TEMP-TRACE-NO.                                       DTSBX425
00114          10  WRK-TEMP-TRACE-NOA      PIC X(06) VALUE ZEROS.          CL*21
00115          10  WRK-TEMP-TRACE-NOB      PIC X(09) VALUE ZEROS.          CL*21
00116                                                                   DTSBX425
00117      05  WRK-NUMR-TRACE-NO           PIC 9(13) VALUE ZEROS.          CL*21
00118                                                                   DTSBX425
00119      05  WRK-FAC6-DOES-TRACE-NO      PIC S9(13) COMP-3.              CL**4
00120                                                                   DTSBX425
00121      05  WRK-MPRF-IND                PIC  X(01).                  DTSBX425
00122          88 WRK-MPRF-OK           VALUE 'Y'.                      DTSBX425
00123          88 WRK-MPRF-NO-REC       VALUE 'N'.                      DTSBX425
00124                                                                   DTSBX425
00125      05  WRK-MPAY-IND                PIC  X(01).                  DTSBX425
00126          88 MPAY-FOUND-YES-88     VALUE 'Y'.                      DTSBX425
00127          88 MPAY-FOUND-NO-88      VALUE 'N'.                      DTSBX425
00128                                                                   DTSBX425
00129      05  WRITE-T025-IND              PIC  X(01).                  DTSBX425
00130          88 WRITE-T025-YES-88     VALUE 'Y'.                      DTSBX425
00131          88 WRITE-T025-NO-88      VALUE 'N'.                      DTSBX425
00132                                                                   DTSBX425
00133      05  WRK-DTSBU005-IND            PIC  X(01).                  DTSBX425
00134          88 WRK-DTSBU005-YES      VALUE 'Y'.                      DTSBX425
00135          88 WRK-DTSBU005-NO       VALUE 'N'.                      DTSBX425
00136                                                                   DTSBX425
00137      05  WRK-FAC1-IND                PIC  X(01).                  DTSBX425
00138          88 WRK-FAC1-FIRST-OK     VALUE 'Y'.                      DTSBX425
00139          88 WRK-FAC1-FIRST-NO     VALUE 'N'.                      DTSBX425
00140                                                                   DTSBX425
00141      05  WRK-FACH-IND                PIC  X(01).                  DTSBX425
00142          88 WRK-FACH-LAST-REC-88  VALUE 'Y'.                      DTSBX425
00143                                                                   DTSBX425
00144      05  WRK-TRACE-IND                   PIC  X(01).              DTSBX425
00145                                                                   DTSBX425
00146  01  MSG-TABLE.                                                   DTSBX425
00147                                                                   DTSBX425
00148      05  MSG1-NO-MPAY.                                            DTSBX425
00149          10  MSG1-ID.                                             DTSBX425
00150              15  MSG1-ID-A   PIC  X(08)  VALUE 'DTSBX425'.           CL**2
00151              15  MSG1-ID-B   PIC  X(03)  VALUE '907'.             DTSBX425
00152          10  MSG1-SHORT-TEXT PIC  X(20) VALUE 'FAC6 WITH NO MPRF'.DTSBX425
00153          10  MSG1-LONG-TEXT.                                      DTSBX425
00154              15  FILLER      PIC  X(30)                           DTSBX425
00155                    VALUE 'FAC6 RECORD ENCOUNTERED WITH N'.        DTSBX425
00156              15  FILLER      PIC  X(30)                           DTSBX425
00157                    VALUE 'O CORRESPONDING MPAY RECORD   '.        DTSBX425
00158  01  HEADER-1.                                                       CL**5
00159      05  FILLER                   PIC X(01) VALUE SPACES.            CL**5
00160      05  FILLER                   PIC X(49) VALUE '140R1'.           CL**5
00161      05  FILLER                   PIC X(54) VALUE                    CL*28
00162          'DISTRICT OF COLUMBIA'.                                     CL**5
00163      05  FILLER                   PIC X(06) VALUE 'DATE:'.           CL**5
00164      05  HDR1-LRCM-SYS-DATE       PIC X(10).                         CL**5
00165  01  HEADER-2.                                                       CL**5
00166      05  FILLER                   PIC X(54) VALUE SPACES.            CL**5
00167      05  FILLER                   PIC X(49) VALUE                    CL*28
00168          'TAX DIVISION'.                                             CL**5
00169      05  FILLER                   PIC X(06) VALUE 'TIME:'.           CL**5
00170      05  HDR2-LRCM-SYS-TIME       PIC X(08).                         CL**5
00171  01  HEADER-3.                                                       CL**5
00172      05  FILLER                   PIC X(01) VALUE SPACES.            CL**5
00173      05  FILLER                   PIC X(38) VALUE                    CL**5
00174          'ROUTE TO:  TAX ACCOUNTING  '.                              CL**6
00175      05  HDR3-LITERAL             PIC X(45) VALUE                    CL*27
00176          '  DOES DAILY TRANSMITTED ACH DEBIT DEPOSITS'.              CL*40
00177      05  FILLER                   PIC X(20) VALUE SPACES.            CL*27
00178      05  FILLER                   PIC X(06) VALUE 'PAGE:'.           CL**5
00179      05  HEADER-3-PAGE                PIC ZZ,ZZ9.                    CL*12
00180                                                                      CL**5
00181  01  HEADER-3A.                                                      CL**6
00182      05  FILLER                   PIC X(01) VALUE SPACES.            CL**6
00183      05  FILLER                   PIC X(23) VALUE                    CL*30
00184          'ACH DEBITS DATE/TIME: '.                                   CL*30
00185      05  FILLER                   PIC X(01) VALUE SPACES.            CL*26
00186      05  HEADER-3A-DATE               PIC X(06) VALUE SPACES.        CL*22
00187      05  FILLER                   PIC X(01) VALUE '/'.               CL*22
00188      05  HEADER-3A-TIME           PIC X(06) VALUE SPACES.            CL*22
00189                                                                      CL*22
00190  01  HEADER-4.                                                       CL**5
00191      05  FILLER                   PIC X(01)  VALUE SPACES.           CL**5
00192      05  FILLER                   PIC X(132) VALUE SPACES.           CL**5
00193  01  HEADER-5.                                                       CL**5
00194      05  FILLER                   PIC X(02)  VALUE SPACES.           CL**5
00195      05  FILLER                   PIC X(25)  VALUE                   CL*39
00196          'EMP NO   EMP NAME        '.                                CL*39
00197      05  FILLER                   PIC X(01)  VALUE SPACES.           CL*24
00198      05  FILLER                   PIC X(45)  VALUE                   CL*40
00199             'BANK ID     ACCT NO                ACH AMOUNT'.         CL*40
00200      05  FILLER                   PIC X(04)  VALUE SPACES.           CL**5
00201      05  FILLER                   PIC X(09)  VALUE                   CL**5
00202             'TRACE NO '.                                             CL**5
00203      05  FILLER                   PIC X(02)  VALUE SPACES.           CL**5
00204      05  HDR5-NAME                PIC X(28)  VALUE                   CL**5
00205               ' MESSAGES             '.                              CL*24
00206  01  HEADER-6.                                                       CL**5
00207      05  FILLER                   PIC X(01)  VALUE SPACES.           CL**5
00208      05  FILLER                   PIC X(132) VALUE SPACES.           CL**5
00209                                                                      CL**5
00210  01  DETAIL-LINE-1.                                                  CL**5
00211      15  FILLER                     PIC  X(02) VALUE SPACES.         CL**5
00212      15  X425-EMP-NO                PIC  999B999 BLANK WHEN ZERO.    CL**6
00213      15  FILLER                     PIC  X(02) VALUE SPACES.         CL**5
00214      15  X425-NAME-CHECK            PIC  X(15) VALUE SPACES.         CL*38
00215      15  FILLER                     PIC  X(02) VALUE SPACES.         CL**5
00216      15  X425-BANK-ID               PIC  X(10) VALUE SPACES.         CL*38
00217      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*38
00218      15  X425-ACCT-NUMBER           PIC  X(20) VALUE SPACES.         CL*38
00219      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*22
00220      15  X425-X145-REMIT            PIC   -------9.99.               CL**7
00221      15  FILLER                     PIC  X(04) VALUE SPACES.         CL*40
00222      15  X425-X145-TRACE-NOB        PIC  X(08) VALUE SPACES.         CL*10
00223      15  FILLER                     PIC  X(05) VALUE SPACES.         CL**5
00224      15  X425-MESSAGE               PIC  X(20).                      CL**7
00225                                                                      CL**5
00226  01  DETAIL-LINE-2.                                                  CL*30
00227      15  FILLER                     PIC  X(15) VALUE SPACES.         CL*30
00228      05  FILLER                   PIC X(56) VALUE                    CL*30
00229      ' ********* NO ACH DEBIT DEPOSITS **********'.                  CL*36
00230                                                                      CL*30
00231  01  FOOTING-LINE-1               PIC X(133) VALUE SPACES.           CL**5
00232  01  FOOTING-LINE-2               PIC X(133) VALUE SPACES.           CL**5
00233                                                                      CL**5
00234  01  FOOTING-LINE-3.                                                 CL**5
00235      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL**5
00236      05  WS-FOOTING-CNT           PIC  ZZ,ZZ9.                       CL**5
00237      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL**5
00238      05  FILLER                   PIC  X(45) VALUE                   CL**5
00239                    ' TOTAL ACH DEBIT DEPOSITS TRANSMITTED'.          CL*31
00240      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL**5
00241                                                                      CL**5
00242  01  FOOTING-LINE-4.                                                 CL**5
00243      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL**5
00244      05  WS-X145-ERR-CNT           PIC  ZZ,ZZ9.                      CL**5
00245      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL**5
00246      05  FILLER                   PIC  X(34) VALUE                   CL**5
00247                     ' # OF ACH PAYMENTS HAD ERRORS '.                CL**5
00248      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL**5
00249  01  FOOTING-LINE-5.                                                 CL**5
00250      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL**5
00251      05  WS-X145-PEN-CNT           PIC  ZZ,ZZ9.                      CL**5
00252      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL**5
00253      05  FILLER                   PIC  X(40) VALUE                   CL**5
00254                     ' # OF ACH PAYMTS WENT TO PENDING FILE '.        CL**5
00255      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL**5
00256  01  FOOTING-LINE-6.                                                 CL**5
00257      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL**5
00258      05  WS-T025-WRITE-CNT         PIC  ZZ,ZZ9.                      CL**5
00259      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL**5
00260      05  FILLER                   PIC  X(45) VALUE                   CL**5
00261                ' # OF ACH PAYMENTS WAITING FOR PROCESSING '.         CL**5
00262      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL**5
00263  01  FOOTING-LINE-7.                                                 CL**5
00264      05  FILLER                   PIC  X(19)  VALUE SPACES.          CL**5
00265      05  WS-TOT-REMIT             PIC  $$$$$$$$9.99.                 CL**5
00266      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL**5
00267      05  FILLER                   PIC  X(45) VALUE                   CL**5
00268                  ' TOTAL AMOUNT OF ACH PAYMENTS       '.             CL**8
00269      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL**5
00270                                                                      CL**5
00271  01  FOOTING-LINE-8.                                                 CL**5
00272      05  FILLER                   PIC  X(19)  VALUE SPACES.          CL**5
00273      05  WS-TOTAL-REMIT           PIC  $$$$$$$$9.99.                 CL**5
00274      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL**5
00275      05  FILLER                   PIC  X(45) VALUE                   CL**5
00276                       'TOTAL AMOUNT - ACH DEBITS DEPOSITED  '.       CL*31
00277      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL**5
00278  01  FOOTING-LINE-13.                                                CL**5
00279      05  FILLER                   PIC X(25)  VALUE SPACES.           CL**5
00280      05  FILLER                   PIC  X(67) VALUE                   CL**5
00281           '*** END DOES/WELLS FARGO DAILY ACH TRANSMISSION  ***'.    CL*40
00282  01  FOOTING-LINE-14              PIC  X(133) VALUE SPACES.          CL**5
00283                                                                      CL**5
00284  01  ESSP-ACHD-TOTALS.                                               CL*41
00285      05  TOT-ACH-DEPOSIT          PIC 9(5)  VALUE ZEROS.             CL*41
00286      05  TOT-AMT-DEPOSIT          PIC 9(11)V99  VALUE ZEROS.         CL*41
00287      05  FILLER                   PIC X(62)     VALUE SPACE.         CL*41
00288                                                                      CL*41
00289  01  FACH-LINK-REC.                                               DTSBX425
00290  ++INCLUDE DTSIXACH                                                  CL**2
00291      EJECT                                                        DTSBX425
00292  01  FAC1-LINK-REC.                                               DTSBX425
00293  ++INCLUDE DTSIXAC1                                                  CL**2
00294      EJECT                                                        DTSBX425
00295  01  FAC5-LINK-REC.                                                  CL**2
00296  ++INCLUDE DTSIXAC5                                                  CL**2
00297      EJECT                                                           CL**2
00298  01  FAC6-LINK-REC.                                               DTSBX425
00299  ++INCLUDE DTSIXAC6                                                  CL**2
00300      EJECT                                                        DTSBX425
00301  01  FAC7-LINK-REC.                                                  CL**3
00302  ++INCLUDE DTSIXAC7                                                  CL**3
00303      EJECT                                                           CL**3
00304  01  FAC9-LINK-REC.                                               DTSBX425
00305  ++INCLUDE DTSIXAC9                                                  CL**2
00306      EJECT                                                        DTSBX425
00307  01  MPAY-REC.                                                    DTSBX425
00308  ++INCLUDE DTSIMPAY                                               DTSBX425
00309      EJECT                                                        DTSBX425
00310  01  L005-LINK-AREA.                                              DTSBX425
00311  ++INCLUDE DTSIL005                                               DTSBX425
00312      EJECT                                                        DTSBX425
00313  01  RSK1-REC.                                                    DTSBX425
00314  ++INCLUDE DTSIRSK1                                               DTSBX425
00315      EJECT                                                        DTSBX425
00316  01  ITRT-REC.                                                    DTSBX425
00317  ++INCLUDE DTSIITRT                                               DTSBX425
00318      EJECT                                                        DTSBX425
00319  01  ISKL-REC.                                                    DTSBX425
00320  ++INCLUDE DTSIISKL                                               DTSBX425
00321      EJECT                                                        DTSBX425
00322  01  R907-REC.                                                    DTSBX425
00323  ++INCLUDE DTSIR907                                               DTSBX425
00324      EJECT                                                        DTSBX425
00325  01  EFT-BATCH-ERRORS-MESS.                                       DTSBX425
00326  ++INCLUDE EFTERMSG                                               DTSBX425
00327      EJECT                                                        DTSBX425
00328  01  F907-REC.                                                    DTSBX425
00329  ++INCLUDE EFTIF907                                               DTSBX425
00330      EJECT                                                        DTSBX425
00331  01  T025-REC.                                                    DTSBX425
00332  ++INCLUDE DTSIT025                                               DTSBX425
00333      EJECT                                                        DTSBX425
00334  01  L910-LINK-AREA.                                              DTSBX425
00335  ++INCLUDE DTSIL910                                               DTSBX425
00336      EJECT                                                        DTSBX425
00337  01  L921-LINK-AREA.                                              DTSBX425
00338  ++INCLUDE DTSIL921                                               DTSBX425
00339      EJECT                                                        DTSBX425
00340  01  L927-LINK-AREA.                                              DTSBX425
00341  ++INCLUDE DTSIL927                                               DTSBX425
00342      EJECT                                                        DTSBX425
00343  01  MSKL-REC.                                                    DTSBX425
00344  ++INCLUDE DTSIMSKL                                               DTSBX425
00345      EJECT                                                        DTSBX425
00346  01  TSKL-REC.                                                    DTSBX425
00347  ++INCLUDE DTSITSKL                                               DTSBX425
00348      EJECT                                                        DTSBX425
00349  01  MPRF-REC.                                                    DTSBX425
00350  ++INCLUDE DTSIMPRF                                               DTSBX425
00351      EJECT                                                        DTSBX425
00352  01  MTAD-REC.                                                    DTSBX425
00353  ++INCLUDE DTSIMTAD                                               DTSBX425
00354                                                                   DTSBX425
00355  PROCEDURE DIVISION.                                              DTSBX425
00356                                                                   DTSBX425
00357      PERFORM I0000-INITIATE THRU I0000-EXIT.                      DTSBX425
00358                                                                      CL*16
00359      IF RETURN-CODE = +3                                             CL*32
00360         PERFORM T0000-TERMINATE THRU T0000-EXIT                      CL*32
00361         GOBACK.                                                      CL*32
00362                                                                   DTSBX425
00363      PERFORM P0000-PROCESS THRU P0000-EXIT UNTIL                  DTSBX425
00364              WRK-FACH-IND = 'Y'.                                  DTSBX425
00365                                                                   DTSBX425
00366      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DTSBX425
00367                                                                   DTSBX425
00368      GOBACK.                                                      DTSBX425
00369                                                                   DTSBX425
00370  I0000-INITIATE.                                                  DTSBX425
00371                                                                   DTSBX425
00372      MOVE +0 TO WRK-FACH-READ-CNT                                 DTSBX425
00373                 WRK-MPAY-REMIT-AMT                                DTSBX425
00374                 WRK-FACH-SELECTED-CNT                             DTSBX425
00375                 WRK-R907-WRITE-CNT                                DTSBX425
00376                 WRK-OTHER-RECORDS                                 DTSBX425
00377                 WRK-FAC6-RECORDS                                  DTSBX425
00378                 WRK-HEADER-RECORDS                                DTSBX425
00379                 WRK-TRAILER-RECORDS                               DTSBX425
00380                 WRK-F907-WRITE-CNT                                DTSBX425
00381                 WRK-T025-WRITE-CNT                                DTSBX425
00382                 WRK-TRAILER-REC-CNT                               DTSBX425
00383                 WRK-FAC6-AMOUNT                                   DTSBX425
00384                 TOT-FAC6-AMOUNT                                   DTSBX425
00385                 TOT-TRAILER-AMT                                   DTSBX425
00386                 WRK-FAC6-DOES-TRACE-NO.                              CL**4
00387                                                                   DTSBX425
00388      MOVE ZEROS TO FAC1-LINK-REC                                  DTSBX425
00389                    FAC6-LINK-REC                                  DTSBX425
00390                    FAC9-LINK-REC.                                 DTSBX425
00391                                                                   DTSBX425
00392      MOVE 'N' TO WRK-TRACE-IND, WRK-FACH-IND.                     DTSBX425
00393                                                                   DTSBX425
00394      MOVE 'Y' TO WRK-FAC1-IND, WRK-DTSBU005-IND.                  DTSBX425
00395                                                                   DTSBX425
00396      PERFORM I2000-OPEN-FILES          THRU I2000-EXIT.           DTSBX425
00397                                                                   DTSBX425
00398  I0000-EXIT.                                                      DTSBX425
00399      EXIT.                                                        DTSBX425
00400  I2000-OPEN-FILES.                                                DTSBX425
00401                                                                   DTSBX425
00402      MOVE LENGTH OF T025-REC TO T025-LENGTH.                      DTSBX425
00403      MOVE LENGTH OF F907-REC TO F907-LENGTH.                      DTSBX425
00404                                                                   DTSBX425
00405      MOVE WRK-TRACE-IND TO L910-TRACE-IND, L921-TRACE-IND.        DTSBX425
00406                                                                   DTSBX425
00407      MOVE WRK-MOD-NAME TO L910-MOD-NAME, L921-MOD-NAME            DTSBX425
00408                                                                   DTSBX425
00409      PERFORM S910-OPEN-READ THRU S910-EXIT.                       DTSBX425
00410                                                                   DTSBX425
00411      PERFORM S921-OPEN-READ THRU S921-EXIT.                       DTSBX425
00412                                                                   DTSBX425
00413      MOVE 'N' TO L927-TRACE-IND.                                  DTSBX425
00414      MOVE WRK-MOD-NAME TO L927-MOD-NAME.                          DTSBX425
00415      PERFORM S927-OPEN-UPDATE THRU S927-EXIT.                     DTSBX425
00416                                                                      CL*32
00417      PERFORM S005-FROM-SYS THRU S005-EXIT.                           CL*32
00418      MOVE L005-ABSTIME TO WRK-SYS-ABSTIME.                           CL*32
00419      MOVE L005-SLASH-DATE TO W-SLASH-DATE.                           CL*32
00420      DISPLAY  'SYS DATE ' W-SLASH-DATE.                              CL*32
00421      MOVE W-SLASH-DATE TO HDR1-LRCM-SYS-DATE.                        CL*32
00422                                                                   DTSBX425
00423      OPEN INPUT IN-FACH.                                          DTSBX425
00424                                                                   DTSBX425
00425      IF NOT FACH-STATUS-OK-88                                        CL*17
00426         DISPLAY 'OPEN ERROR ON FACH INPUT FILE ** ' FACH-STATUS      CL*32
00427         MOVE +3 TO RETURN-CODE                                       CL*13
00428      ELSE                                                            CL**6
00429      IF FACH-STATUS-OK-88                                         DTSBX425
00430         NEXT SENTENCE                                             DTSBX425
00431      ELSE                                                         DTSBX425
00432         DISPLAY 'OPEN ERROR ON FACH INPUT FILE ** ' FACH-STATUS   DTSBX425
00433         PERFORM S999-ABEND THRU S999-EXIT                            CL*12
00434       END-IF                                                         CL**6
00435      END-IF.                                                         CL**6
00436                                                                      CL**6
00437      OPEN OUTPUT   ESSP-ACHD-FILE.                                   CL*35
00438      IF REPT-STATUS-OK-88                                            CL*35
00439         NEXT SENTENCE                                                CL*35
00440      ELSE                                                            CL*35
00441         DISPLAY 'CANNOT OPEN REPORT ACHD  FILE '                     CL*35
00442            REPT-STATUS                                               CL*35
00443         PERFORM S999-ABEND THRU S999-EXIT                            CL*35
00444      END-IF.                                                         CL*35
00445                                                                      CL*41
00446      OPEN OUTPUT   ESSP-ACHD-TOTAL.                                  CL*41
00447      IF REPT-STATUS-OK-88                                            CL*41
00448         NEXT SENTENCE                                                CL*41
00449      ELSE                                                            CL*41
00450         DISPLAY 'CANNOT OPEN TOTAL  ACHD  FILE '                     CL*41
00451            REPT-STATUS                                               CL*41
00452         PERFORM S999-ABEND THRU S999-EXIT                            CL*41
00453      END-IF.                                                         CL*41
00454                                                                      CL*35
00455       READ IN-FACH INTO FACH-LINK-REC                                CL*18
00456          AT END                                                      CL*18
00457         MOVE +3 TO RETURN-CODE                                       CL*18
00458         DISPLAY 'NO ACH PAYMENTS TO TRANSMITT  '                     CL*18
00459         MOVE 'Y' TO WRK-FACH-IND                                     CL*18
00460         GO TO I2000-EXIT.                                            CL*18
00461                                                                      CL*18
00462                                                                   DTSBX425
00463  I2000-EXIT.                                                      DTSBX425
00464      EXIT.                                                        DTSBX425
00465                                                                   DTSBX425
00466  P0000-PROCESS.                                                   DTSBX425
00467       DISPLAY ' 1000 - PROCESS'.                                  DTSBX425
00468                                                                   DTSBX425
00469 *     READ IN-FACH INTO FACH-LINK-REC                                CL*18
00470 *        AT END                                                      CL*18
00471 *        MOVE 'Y' TO WRK-FACH-IND                                    CL*18
00472 *       GO TO P0000-EXIT.                                            CL*18
00473                                                                   DTSBX425
00474       ADD +1 TO WRK-FACH-READ-CNT.                                DTSBX425
00475      MOVE ZEROS TO FAC6-HEADER-REC.                               DTSBX425
00476                                                                   DTSBX425
00477      IF FACH-TYPE-HEADER-88                                       DTSBX425
00478         MOVE FACH-LINK-REC TO FAC1-LINK-REC                       DTSBX425
00479         ADD 1 TO WRK-HEADER-RECORDS                               DTSBX425
00480         PERFORM P1005-HEADER-EDIT THRU P1005-EXIT                 DTSBX425
00481      ELSE                                                         DTSBX425
00482      IF FACH-TYPE-ENTRY-DETAIL-88                                 DTSBX425
00483         MOVE FACH-LINK-REC TO FAC6-LINK-REC                       DTSBX425
00484         ADD 1 TO WRK-FAC6-RECORDS                                 DTSBX425
00485         PERFORM P1010-FAC6-EDIT THRU P1010-EXIT                   DTSBX425
00486      ELSE                                                            CL**5
00487      IF FACH-TYPE-ADDENDA-88                                         CL*14
00488         MOVE FACH-LINK-REC TO FAC7-LINK-REC                          CL**5
00489         ADD 1 TO WRK-FAC7-RECORDS                                    CL**5
00490         PERFORM P1011-FAC7-EDIT THRU P1011-EXIT                      CL**5
00491      ELSE                                                            CL**3
00492      IF FACH-TYPE-TRAILER-88                                      DTSBX425
00493         MOVE FACH-LINK-REC TO FAC9-LINK-REC                       DTSBX425
00494         ADD 1 TO WRK-TRAILER-RECORDS                              DTSBX425
00495         ADD 1 TO WRK-TRAILER-REC-CNT                              DTSBX425
00496         PERFORM P1015-TRAILER-EDIT THRU P1015-EXIT                DTSBX425
00497      ELSE                                                         DTSBX425
00498         ADD 1 TO WRK-OTHER-RECORDS.                                  CL*18
00499                                                                      CL*18
00500       READ IN-FACH INTO FACH-LINK-REC                                CL*18
00501          AT END                                                      CL*18
00502          MOVE 'Y' TO WRK-FACH-IND                                    CL*18
00503         GO TO P0000-EXIT.                                            CL*18
00504                                                                   DTSBX425
00505  P0000-EXIT.                                                      DTSBX425
00506      EXIT.                                                        DTSBX425
00507                                                                   DTSBX425
00508                                                                   DTSBX425
00509  P1005-HEADER-EDIT.                                               DTSBX425
00510                                                                   DTSBX425
00511       DISPLAY ' 1005 - PROCESS'.                                  DTSBX425
00512      IF WRK-FACH-READ-CNT NOT = 1                                 DTSBX425
00513         MOVE 'Y' TO WRK-FACH-IND                                  DTSBX425
00514         DISPLAY ' FIRST RECORD OF FILE IS NOT A HEADER RECORD'    DTSBX425
00515         PERFORM S999-ABEND THRU S999-EXIT.                        DTSBX425
00516                                                                   DTSBX425
00517  P1005-EXIT.                                                      DTSBX425
00518      EXIT.                                                        DTSBX425
00519                                                                   DTSBX425
00520  P1010-FAC6-EDIT.                                                 DTSBX425
00521                                                                   DTSBX425
00522       SET WRITE-T025-NO-88 TO TRUE.                               DTSBX425
00523       SET MPAY-FOUND-NO-88 TO TRUE.                               DTSBX425
00524       DISPLAY ' 1010 - AMOUNT  '  FAC6-AMOUNT                     DTSBX425
00525       DISPLAY ' 1010 - TRACEIN '  FAC6-DOES-TRACE-NO                 CL**4
00526      MOVE ZEROS              TO  WRK-TEMP-TRACE-NO                DTSBX425
00527                                  WRK-FAC6-DOES-TRACE-NO.             CL*12
00528 *                                WRK-DOES-TRACE-NO.                  CL*12
00529      MOVE FAC6-AMOUNT        TO  WRK-FAC6-AMOUNT.                 DTSBX425
00530      MOVE FAC6-DOES-TRACE-NO TO  WRK-TEMP-TRACE-NO.                  CL*10
00531                                                                   DTSBX425
00532 *    MOVE ZEROS              TO  WRK-TEMP-TRACE-NOA.                 CL*21
00533 *    MOVE WRK-DOES-TRACE-NOB TO  WRK-TEMP-TRACE-NOB.                 CL*12
00534      MOVE WRK-TEMP-TRACE-NOA TO  WRK-FAC6-DOES-TRACE-NO.             CL*21
00535                                                                   DTSBX425
00536      DISPLAY  'TRACE-NO -TEMP  ' WRK-TEMP-TRACE-NO                DTSBX425
00537      DISPLAY  'TRACE-WRK-FAC6  ' WRK-FAC6-DOES-TRACE-NO              CL**4
00538                                                                   DTSBX425
00539      IF FAC6-AMOUNT = ZEROS                                       DTSBX425
00540          ADD 1 TO WRK-F907-WRITE-CNT                                 CL**8
00541         DISPLAY ' ACH PAYMENT = ZEROS ' FAC6-AMOUNT                  CL**8
00542         MOVE +2 TO RETURN-CODE.                                      CL*37
00543 *       MOVE EFT027 TO F907-MSG-TEXT                                 CL**8
00544 *       MOVE '027' TO F907-MSG-ID                                    CL**8
00545 *       MOVE ZEROS TO F907-EMP-NO                                    CL**8
00546 *       MOVE FAC6-AMOUNT TO F907-GOV1-REC                            CL**8
00547 *       PERFORM P1055-WRITE-F907     THRU P1055-EXIT                 CL**8
00548 *       GO TO P1010-EXIT.                                            CL**8
00549                                                                   DTSBX425
00550      IF FAC6-AMOUNT NOT NUMERIC                                   DTSBX425
00551          ADD 1 TO WRK-F907-WRITE-CNT                                 CL**8
00552         DISPLAY ' ACH PAYMENT NOT NUMERIC  ' FAC6-AMOUNT             CL**8
00553         MOVE +2 TO RETURN-CODE.                                      CL*37
00554 *       MOVE EFT028 TO F907-MSG-TEXT                                 CL**8
00555 *       MOVE '028' TO F907-MSG-ID                                    CL**8
00556 *       MOVE ZEROS TO F907-EMP-NO                                    CL**8
00557 *       MOVE WRK-FAC6-AMOUNT TO F907-GOV1-REC                        CL**8
00558 *       PERFORM P1055-WRITE-F907     THRU P1055-EXIT                 CL**8
00559 *       GO TO P1010-EXIT.                                            CL**8
00560                                                                   DTSBX425
00561      ADD WRK-FAC6-AMOUNT TO TOT-FAC6-AMOUNT.                      DTSBX425
00562                                                                   DTSBX425
00563      IF WRK-TEMP-TRACE-NO NOT NUMERIC                             DTSBX425
00564          ADD 1 TO WRK-F907-WRITE-CNT                                 CL**8
00565         DISPLAY 'TRACE-NO NOT NUMERIC ' WRK-TEMP-TRACE-NO            CL**8
00566         MOVE +2 TO RETURN-CODE.                                      CL*37
00567 *       MOVE EFT013 TO F907-MSG-TEXT                                 CL**8
00568 *       MOVE '013' TO F907-MSG-ID                                    CL**8
00569 *       MOVE ZEROS TO F907-EMP-NO                                    CL**8
00570 *       MOVE WRK-TEMP-TRACE-NO TO F907-GOV1-TRACE                    CL**8
00571 *       PERFORM P1055-WRITE-F907     THRU P1055-EXIT                 CL**8
00572 *       GO TO P1010-EXIT.                                            CL**8
00573                                                                   DTSBX425
00574      IF WRK-TEMP-TRACE-NO = ZEROS                                 DTSBX425
00575         DISPLAY 'TRACE-NO = ZEROS  ' WRK-TEMP-TRACE-NO               CL**8
00576         MOVE +2 TO RETURN-CODE.                                      CL*37
00577 *       MOVE EFT014 TO F907-MSG-TEXT                                 CL**8
00578 *       MOVE '014' TO F907-MSG-ID                                    CL**8
00579 *       MOVE ZEROS TO F907-EMP-NO                                    CL**8
00580 *       MOVE WRK-TEMP-TRACE-NO TO F907-GOV1-TRACE                    CL**8
00581 *       PERFORM P1055-WRITE-F907     THRU P1055-EXIT                 CL**8
00582 *       GO TO P1010-EXIT.                                            CL**8
00583                                                                   DTSBX425
00584                                                                   DTSBX425
00585      PERFORM P4000-PRNT-ACHD THRU P4000-EXIT.                        CL**7
00586                                                                      CL**7
00587 *    PERFORM P1020-FIND-MPAY THRU P1020-EXIT.                        CL**8
00588                                                                   DTSBX425
00589 *    IF MPAY-FOUND-YES-88                                            CL**8
00590 *       PERFORM P1040-BUILD-T025-RECORD THRU P1040-EXIT.             CL**8
00591                                                                   DTSBX425
00592 *    IF WRITE-T025-YES-88                                            CL**8
00593 *       PERFORM S927-WRITE         THRU S927-EXIT                    CL**8
00594 *       ADD 1 TO WRK-T025-WRITE-CNT.                                 CL**8
00595                                                                   DTSBX425
00596  P1010-EXIT.                                                      DTSBX425
00597      EXIT.                                                        DTSBX425
00598                                                                   DTSBX425
00599  P1011-FAC7-EDIT.                                                    CL*10
00600                                                                      CL*10
00601  P1011-EXIT.                                                         CL*10
00602      EXIT.                                                           CL*10
00603                                                                      CL*10
00604  P1015-TRAILER-EDIT.                                              DTSBX425
00605                                                                   DTSBX425
00606       DISPLAY ' 1015 - PROCESS'.                                  DTSBX425
00607      IF  WRK-TRAILER-REC-CNT > 1                                  DTSBX425
00608          GO TO  P1015-EXIT.                                       DTSBX425
00609          GO TO  P1015-EXIT.                                          CL*19
00610                                                                   DTSBX425
00611 *    IF FAC9-BATCH-CNT = ZEROS                                    DTSBX425
00612 *       MOVE EFT066 TO F907-MSG-TEXT                              DTSBX425
00613 *       MOVE '066' TO F907-MSG-ID                                 DTSBX425
00614 *       MOVE ZEROS TO F907-EMP-NO                                 DTSBX425
00615 *       MOVE FAC9-TRAILER-REC TO F907-GOV1-REC                    DTSBX425
00616 *       PERFORM P1055-WRITE-F907     THRU P1055-EXIT.             DTSBX425
00617                                                                   DTSBX425
00618                                                                   DTSBX425
00619 *    IF FAC9-BATCH-CNT NOT NUMERIC                                DTSBX425
00620 *       MOVE EFT064 TO F907-MSG-TEXT                              DTSBX425
00621 *       MOVE '064' TO F907-MSG-ID                                 DTSBX425
00622 *       MOVE ZEROS TO F907-EMP-NO                                 DTSBX425
00623 *       MOVE FAC9-TRAILER-REC TO F907-GOV1-REC                    DTSBX425
00624 *       PERFORM P1055-WRITE-F907     THRU P1055-EXIT.             DTSBX425
00625                                                                   DTSBX425
00626 *    IF WRK-FACH-READ-CNT NOT = FAC9-BATCH-CNT                    DTSBX425
00627 *       MOVE EFT065 TO F907-MSG-TEXT, R907-MSG-TEXT               DTSBX425
00628 *       MOVE '065' TO F907-MSG-ID, R907-MSG-ID                    DTSBX425
00629 *       MOVE ZEROS TO F907-EMP-NO                                 DTSBX425
00630 *       MOVE FAC9-TRAILER-REC TO F907-GOV1-REC                    DTSBX425
00631 *       PERFORM P1055-WRITE-F907     THRU P1055-EXIT.             DTSBX425
00632                                                                   DTSBX425
00633      MOVE FAC9-TOT-CREDIT-AMT TO TOT-TRAILER-AMT.                 DTSBX425
00634                                                                   DTSBX425
00635      IF TOT-FAC6-AMOUNT  NOT = TOT-TRAILER-AMT                    DTSBX425
00636         MOVE EFT067 TO F907-MSG-TEXT, R907-MSG-TEXT               DTSBX425
00637         MOVE '067' TO F907-MSG-ID, R907-MSG-ID                    DTSBX425
00638         MOVE ZEROS TO F907-EMP-NO                                 DTSBX425
00639         MOVE FAC9-TRAILER-REC TO F907-GOV1-REC                    DTSBX425
00640         PERFORM P1055-WRITE-F907     THRU P1055-EXIT.                CL*20
00641                                                                   DTSBX425
00642  P1015-EXIT.                                                      DTSBX425
00643      EXIT.                                                        DTSBX425
00644  P1020-FIND-MPAY.                                                 DTSBX425
00645                                                                   DTSBX425
00646       DISPLAY ' 1020 - PROCESS'.                                  DTSBX425
00647      SET MPAY-FOUND-NO-88 TO TRUE                                 DTSBX425
00648      MOVE LOW-VALUES    TO ITRT-KEY-AREA.                         DTSBX425
00649      SET ITRT-TRT-88    TO TRUE.                                  DTSBX425
00650                                                                   DTSBX425
00651      MOVE WRK-NUMR-TRACE-NO TO ITRT-TRACE-NO.                     DTSBX425
00652                                                                   DTSBX425
00653      MOVE ZEROS         TO ITRT-EMP-NO                            DTSBX425
00654                            ITRT-BATCH-NO                          DTSBX425
00655                            ITRT-ITEM-NO.                          DTSBX425
00656                                                                   DTSBX425
00657      MOVE ITRT-KEY-AREA TO ISKL-KEY-AREA.                         DTSBX425
00658                                                                   DTSBX425
00659       DISPLAY ' 1020 - PROCESS - ' WRK-NUMR-TRACE-NO.             DTSBX425
00660       DISPLAY ' 1020 - PROCESS - ' ITRT-KEY-AREA.                 DTSBX425
00661                                                                   DTSBX425
00662      PERFORM S921-START-BROWSE THRU S921-EXIT.                    DTSBX425
00663      IF L921-NO-REC-88                                            DTSBX425
00664         MOVE EFT001 TO F907-MSG-TEXT                              DTSBX425
00665         MOVE '001'                   TO F907-MSG-ID               DTSBX425
00666         MOVE ZEROS                   TO F907-EMP-NO               DTSBX425
00667         MOVE WRK-TEMP-TRACE-NO       TO F907-GOV1-TRACE           DTSBX425
00668         PERFORM P1055-WRITE-F907     THRU P1055-EXIT              DTSBX425
00669         GO TO P1020-EXIT                                          DTSBX425
00670      ELSE                                                         DTSBX425
00671         MOVE ISKL-REC       TO ITRT-REC.                          DTSBX425
00672                                                                   DTSBX425
00673      IF ITRT-TRACE-NO NOT = WRK-FAC6-DOES-TRACE-NO                   CL**4
00674       DISPLAY ' 1TRT - NOT FOU - ' WRK-NUMR-TRACE-NO              DTSBX425
00675       DISPLAY ' 1TRT - PACK    - ' WRK-FAC6-DOES-TRACE-NO            CL**4
00676         MOVE EFT001 TO F907-MSG-TEXT                              DTSBX425
00677         MOVE '001' TO F907-MSG-ID                                 DTSBX425
00678         MOVE ZEROS TO F907-EMP-NO                                 DTSBX425
00679         MOVE WRK-TEMP-TRACE-NO       TO F907-GOV1-TRACE           DTSBX425
00680         PERFORM P1055-WRITE-F907     THRU P1055-EXIT              DTSBX425
00681         GO TO P1020-EXIT.                                         DTSBX425
00682                                                                   DTSBX425
00683      DISPLAY ' TRACE FOUND IN - ' WRK-NUMR-TRACE-NO               DTSBX425
00684      DISPLAY ' TRACE FOUND TRT- ' ITRT-TRACE-NO.                  DTSBX425
00685                                                                   DTSBX425
00686      MOVE LOW-VALUES     TO MPAY-KEY-AREA.                        DTSBX425
00687      MOVE ITRT-EMP-NO    TO MPAY-EMP-NO.                          DTSBX425
00688      MOVE ITRT-BATCH-NO  TO MPAY-BATCH-NO.                        DTSBX425
00689      MOVE ITRT-ITEM-NO   TO MPAY-ITEM-NO.                         DTSBX425
00690      SET MPAY-PAY-88     TO TRUE.                                 DTSBX425
00691                                                                   DTSBX425
00692      MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA.                         DTSBX425
00693      DISPLAY ' MPAY KEY-'  MPAY-KEY-AREA.                         DTSBX425
00694      DISPLAY ' MPAY EMP-'  MPAY-EMP-NO.                           DTSBX425
00695      DISPLAY ' MPAY BAT-'  MPAY-BATCH-NO.                         DTSBX425
00696      DISPLAY ' MPAY ITM-'  MPAY-ITEM-NO.                          DTSBX425
00697      PERFORM S910-READ   THRU S910-EXIT.                          DTSBX425
00698                                                                   DTSBX425
00699      IF L910-NO-REC-88                                            DTSBX425
00700       DISPLAY ' MPAY - NOT FOU - ' WRK-NUMR-TRACE-NO              DTSBX425
00701       DISPLAY ' 1029 - PACK    - ' WRK-FAC6-DOES-TRACE-NO            CL**4
00702         SET MPAY-FOUND-NO-88 TO TRUE                              DTSBX425
00703         MOVE EFT001 TO F907-MSG-TEXT                              DTSBX425
00704         MOVE ZEROS TO F907-EMP-NO                                 DTSBX425
00705         MOVE WRK-TEMP-TRACE-NO TO F907-GOV1-TRACE                 DTSBX425
00706         MOVE '001' TO F907-MSG-ID                                 DTSBX425
00707         PERFORM P1055-WRITE-F907     THRU P1055-EXIT              DTSBX425
00708      ELSE                                                         DTSBX425
00709         SET MPAY-FOUND-YES-88 TO TRUE                             DTSBX425
00710         MOVE MSKL-REC         TO MPAY-REC.                        DTSBX425
00711                                                                   DTSBX425
00712  P1020-EXIT.                                                      DTSBX425
00713      EXIT.                                                        DTSBX425
00714                                                                   DTSBX425
00715                                                                   DTSBX425
00716  P1040-BUILD-T025-RECORD.                                         DTSBX425
00717       DISPLAY ' 1040 - PROCESS'.                                  DTSBX425
00718      SET WRITE-T025-YES-88  TO TRUE.                              DTSBX425
00719                                                                   DTSBX425
00720      IF WRK-DTSBU005-YES                                          DTSBX425
00721         PERFORM S005-FROM-SYS          THRU S005-EXIT             DTSBX425
00722         MOVE L005-DATE                TO WRK-CURR-DATE            DTSBX425
00723         MOVE L005-TIME                TO WRK-CURR-TIME            DTSBX425
00724         MOVE 'N' TO WRK-DTSBU005-IND.                             DTSBX425
00725                                                                   DTSBX425
00726      MOVE MPAY-EMP-NO         TO T025-EMP-NO.                     DTSBX425
00727      MOVE 'ACHNGCHK'          TO T025-ORIGIN.                     DTSBX425
00728                                                                   DTSBX425
00729      MOVE WRK-CURR-DATE       TO T025-SYS-DATE.                   DTSBX425
00730      MOVE WRK-CURR-TIME       TO T025-SYS-TIME.                   DTSBX425
00731                                                                   DTSBX425
00732      MOVE 'NG'                TO T025-PAY-TYPE.                   DTSBX425
00733                                                                   DTSBX425
00734      MOVE MPAY-EMP-NO TO MPRF-EMP-NO.                             DTSBX425
00735      PERFORM P1070-READ-MPRF THRU P1070-EXIT.                     DTSBX425
00736                                                                   DTSBX425
00737      IF L910-NO-REC-88                                            DTSBX425
00738         SET WRITE-T025-NO-88  TO TRUE                             DTSBX425
00739         DISPLAY '5350 NO MPRF FOUND HERE INSIDE P1040'            DTSBX425
00740         GO TO P1040-EXIT.                                         DTSBX425
00741                                                                   DTSBX425
00742      MOVE MPRF-PRIMARY-NAME   TO T025-NAME-CHECK.                 DTSBX425
00743                                                                   DTSBX425
00744      COMPUTE WRK-MPAY-REMIT-AMT = MPAY-REMIT-AMT * -1.            DTSBX425
00745      MOVE WRK-MPAY-REMIT-AMT  TO T025-REMIT-AMT.                  DTSBX425
00746                                                                   DTSBX425
00747      MOVE MPAY-TRACE-NO   TO T025-TRACE-NO.                       DTSBX425
00748      MOVE WRK-CURR-DATE   TO T025-RECEIVED-DATE                   DTSBX425
00749                              T025-DEPOSIT-DATE.                   DTSBX425
00750                                                                   DTSBX425
00751      MOVE ZERO              TO T025-APPLIC-YRQ.                   DTSBX425
00752      MOVE SPACES            TO T025-APPLIC-IND.                   DTSBX425
00753      MOVE MPAY-BATCH-NO     TO T025-APPLIC-BATCH-NO.              DTSBX425
00754      MOVE MPAY-ITEM-NO      TO T025-APPLIC-ITEM-NO.               DTSBX425
00755      MOVE SPACES            TO T025-RESPONSIBLE-ACTIVITY.         DTSBX425
00756      MOVE 'WEBESSP'         TO T025-RESPONSIBLE-OP-ID.               CL**3
00757                                                                   DTSBX425
00758      MOVE T025-REC          TO TSKL-REC.                          DTSBX425
00759                                                                   DTSBX425
00760  P1040-EXIT.                                                      DTSBX425
00761      EXIT.                                                        DTSBX425
00762                                                                   DTSBX425
00763  P1055-WRITE-F907.                                                DTSBX425
00764 **************************************************************    DTSBX425
00765 *  WRITE FACH ERROR RETURN FILE(F907)                        *    DTSBX425
00766 **************************************************************    DTSBX425
00767                                                                   DTSBX425
00768       DISPLAY ' 1055 - PROCESS'.                                  DTSBX425
00769      ADD +1             TO WRK-F907-WRITE-CNT.                    DTSBX425
00770      MOVE WRK-MOD-NAME  TO F907-MODULE-NAME.                      DTSBX425
00771      MOVE IN-FACH-REC   TO F907-GOV1-REC.                         DTSBX425
00772      MOVE ZEROS TO F907-EMP-NO.                                   DTSBX425
00773                                                                   DTSBX425
00774      CALL 'DTSBU946' USING F907-REC.                              DTSBX425
00775                                                                   DTSBX425
00776                                                                   DTSBX425
00777  P1055-EXIT.                                                      DTSBX425
00778       EXIT.                                                       DTSBX425
00779  P4000-PRNT-ACHD.                                                    CL**7
00780       PERFORM P4100-PRINT-HEADER THRU P4100-EXIT.                    CL**7
00781      MOVE FAC6-DUTAS-EMP-NO    TO  X425-EMP-NO                       CL**7
00782      MOVE FAC6-DUTAS-EMP-NAME  TO  X425-NAME-CHECK.                  CL*22
00783      MOVE FAC6-BANK-ACCT-NO    TO  X425-ACCT-NUMBER                  CL*22
00784      MOVE FAC6-RECV-BANK-ID    TO  X425-BANK-ID.                     CL*38
00785      MOVE WRK-FAC6-AMOUNT      TO  X425-X145-REMIT                   CL*22
00786      MOVE WRK-TEMP-TRACE-NOA   TO  X425-X145-TRACE-NOB.              CL*21
00787      MOVE SPACES               TO  X425-MESSAGE.                     CL*24
00788      PERFORM P4100-PRINT-HEADER THRU P4100-EXIT.                     CL**7
00789      WRITE ESSP-ACHD-REC FROM DETAIL-LINE-1  AFTER 1.                CL*12
00790      ADD  1    TO WS-LINE-CNT.                                       CL**7
00791  P4000-EXIT.                                                         CL**7
00792       EXIT.                                                          CL**7
00793  P4100-PRINT-HEADER.                                                 CL**6
00794       IF WS-LINE-CNT GREATER 58                                      CL**6
00795          MOVE +0          TO WS-LINE-CNT                             CL**6
00796          ADD  +1          TO WS-PAGE-CNT                             CL**6
00797          MOVE WS-PAGE-CNT TO HEADER-3-PAGE                           CL*10
00798 *        MOVE   '  -/+   ----- MONTHLY COUNT' TO HEADER-5-NAME       CL*10
00799          MOVE FAC1-FILE-CREATE-DATE TO HEADER-3A-DATE                CL*10
00800          MOVE FAC1-FILE-CREATE-TIME TO HEADER-3A-TIME                CL*10
00801          WRITE ESSP-ACHD-REC FROM HEADER-1 AFTER TOP-OF-PAGE         CL*10
00802          WRITE ESSP-ACHD-REC FROM HEADER-2 AFTER 1                   CL*10
00803          WRITE ESSP-ACHD-REC FROM HEADER-3 AFTER 1                   CL*10
00804          WRITE ESSP-ACHD-REC FROM HEADER-3A AFTER 1                  CL*10
00805          WRITE ESSP-ACHD-REC FROM HEADER-4 AFTER 1                   CL*10
00806          WRITE ESSP-ACHD-REC FROM HEADER-5 AFTER 1                   CL*10
00807          WRITE ESSP-ACHD-REC FROM HEADER-6 AFTER 1                   CL*10
00808          ADD +6    TO WS-LINE-CNT.                                   CL**6
00809  P4100-EXIT.                                                         CL**6
00810       EXIT.                                                          CL**6
00811                                                                      CL**6
00812  T0000-TERMINATE.                                                 DTSBX425
00813                                                                   DTSBX425
00814       IF NOT FACH-TYPE-TRAILER-88                                 DTSBX425
00815          DISPLAY ' LAST RECORD IS NOT A TRAILER RECORD '          DTSBX425
00816          DISPLAY '             '                                  DTSBX425
00817          DISPLAY ' LAST RECORD ' FACH-SKELETAL-REC                DTSBX425
00818          DISPLAY ' **** ACH FILE EMPTY *****'.                       CL*34
00819                                                                   DTSBX425
00820      IF  WRK-FACH-READ-CNT = 2                                    DTSBX425
00821          MOVE +3 TO RETURN-CODE                                      CL*32
00822          DISPLAY ' *** WELLS FARGO FILE CONTAINS 2 RECS '            CL**3
00823          DISPLAY ' ***  NO REJECTED PAYMENT RECORDS *'.           DTSBX425
00824                                                                   DTSBX425
00825                                                                   DTSBX425
00826 *    MOVE -1 TO F907-LENGTH.                                         CL**8
00827 *    CALL 'DTSBU946' USING F907-REC.                                 CL**8
00828                                                                   DTSBX425
00829                                                                   DTSBX425
00830                                                                   DTSBX425
00831      DISPLAY ' '.                                                 DTSBX425
00832                                                                   DTSBX425
00833      DISPLAY '*** DTSBX425 TERMINATION STATISTICS ***'.              CL**2
00834                                                                   DTSBX425
00835      DISPLAY ' '.                                                 DTSBX425
00836                                                                   DTSBX425
00837      DISPLAY 'NUMBER OF FACH RECORDS READ         :   '           DTSBX425
00838              WRK-FACH-READ-CNT.                                   DTSBX425
00839                                                                   DTSBX425
00840      DISPLAY 'NUMBER IN TRAILER BATCH COUNT       :   '           DTSBX425
00841               FAC9-BATCH-CNT.                                     DTSBX425
00842                                                                   DTSBX425
00843      DISPLAY 'HEADERS IN FACH FILE                :   '           DTSBX425
00844              WRK-HEADER-RECORDS.                                  DTSBX425
00845                                                                   DTSBX425
00846      DISPLAY 'TRAILERS IN FACH FILE               :   '           DTSBX425
00847              WRK-TRAILER-RECORDS.                                 DTSBX425
00848                                                                   DTSBX425
00849      DISPLAY 'DETAIL RECORDS IN FACH FILE         :   '           DTSBX425
00850              WRK-FAC6-RECORDS.                                    DTSBX425
00851                                                                   DTSBX425
00852      DISPLAY 'NUMBER OF OTHER RECORDS IN FACH FILE:   '           DTSBX425
00853              WRK-OTHER-RECORDS.                                   DTSBX425
00854                                                                   DTSBX425
00855      DISPLAY 'NUMBER OF T025 RECORDS WRITTEN      :   '           DTSBX425
00856              WRK-T025-WRITE-CNT.                                  DTSBX425
00857                                                                   DTSBX425
00858      DISPLAY 'NUMBER OF F907 RECORDS WRITTEN      :   '           DTSBX425
00859              WRK-F907-WRITE-CNT.                                  DTSBX425
00860 *    IF  WRK-F907-WRITE-CNT > 0                                      CL*24
00861 *        MOVE +3 TO RETURN-CODE                                      CL*24
00862 *        DISPLAY ' FACH INPUT FILE CONTAINS ERRORS+++'               CL*24
00863 *        DISPLAY ' PROGRAM WILL ABEND ***************'.              CL*24
00864 *        PERFORM S999-ABEND THRU S999-EXIT.                       DTSBX425
00865                                                                   DTSBX425
00866      IF WS-LINE-CNT  > 52 OR RETURN-CODE = +3                        CL*32
00867         PERFORM P4100-PRINT-HEADER THRU P4100-EXIT                   CL*24
00868         WRITE ESSP-ACHD-REC FROM DETAIL-LINE-1  AFTER 1              CL*32
00869         WRITE ESSP-ACHD-REC FROM DETAIL-LINE-2  AFTER 3              CL*36
00870      END-IF.                                                         CL*24
00871                                                                      CL*24
00872      MOVE WRK-FAC6-RECORDS  TO WS-FOOTING-CNT.                       CL*24
00873      MOVE TOT-FAC6-AMOUNT       TO WS-TOTAL-REMIT.                   CL*24
00874      WRITE ESSP-ACHD-REC FROM FOOTING-LINE-1 AFTER 1.                CL*25
00875      WRITE ESSP-ACHD-REC FROM FOOTING-LINE-2 AFTER 1.                CL*25
00876      WRITE ESSP-ACHD-REC FROM FOOTING-LINE-3 AFTER 1.                CL*25
00877 *    WRITE ESSP-ACHD-REC FROM FOOTING-LINE-4 AFTER 1.                CL*25
00878 *    WRITE REPT-PAID-REC FROM FOOTING-LINE-5 AFTER 1.                CL*25
00879 *    WRITE REPT-PAID-REC FROM FOOTING-LINE-6 AFTER 1.                CL*24
00880 *    WRITE ESSP-ACHD-REC FROM FOOTING-LINE-7  AFTER 1.               CL*25
00881      WRITE ESSP-ACHD-REC FROM FOOTING-LINE-8  AFTER 1.               CL*25
00882      WRITE ESSP-ACHD-REC FROM FOOTING-LINE-13 AFTER 3.               CL*25
00883      WRITE ESSP-ACHD-REC FROM FOOTING-LINE-14 AFTER 1.               CL*25
00884                                                                      CL*24
00885      DISPLAY ' '.                                                    CL*24
00886      MOVE WRK-FAC6-RECORDS  TO TOT-ACH-DEPOSIT.                      CL*41
00887      MOVE TOT-FAC6-AMOUNT   TO TOT-AMT-DEPOSIT.                      CL*41
00888                                                                   DTSBX425
00889      WRITE ESSP-ACHD-TOT-REC FROM ESSP-ACHD-TOTALS.                  CL*42
00890                                                                      CL*29
00891      CLOSE IN-FACH ESSP-ACHD-FILE ESSP-ACHD-TOTAL.                   CL*41
00892      PERFORM S910-CLOSE THRU S910-EXIT.                              CL*29
00893      PERFORM S927-CLOSE THRU S927-EXIT.                              CL*29
00894                                                                      CL*29
00895                                                                      CL*29
00896                                                                   DTSBX425
00897  T0000-EXIT.                                                      DTSBX425
00898      EXIT.                                                        DTSBX425
00899                                                                   DTSBX425
00900  P1070-READ-MPRF.                                                 DTSBX425
00901                                                                   DTSBX425
00902                                                                   DTSBX425
00903      MOVE LOW-VALUE TO MPRF-KEY-AREA.                             DTSBX425
00904      SET MPRF-PRF-88 TO TRUE.                                     DTSBX425
00905      MOVE MPAY-EMP-NO TO MPRF-EMP-NO.                             DTSBX425
00906      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSBX425
00907                                                                   DTSBX425
00908      PERFORM S910-READ THRU S910-EXIT.                            DTSBX425
00909                                                                   DTSBX425
00910      IF L910-OK-88                                                DTSBX425
00911          SET L910-OK-88  TO TRUE                                  DTSBX425
00912          MOVE MSKL-REC TO MPRF-REC                                DTSBX425
00913      ELSE                                                         DTSBX425
00914         DISPLAY 'NO MPRF-REC FOUND ' L910-RESULT-IND              DTSBX425
00915         SET L910-NO-REC-88 TO TRUE                                DTSBX425
00916         DISPLAY '6090 L910 NO RECORD FOUND '                      DTSBX425
00917         PERFORM P1055-WRITE-F907   THRU P1055-EXIT                DTSBX425
00918         GO TO P1070-EXIT.                                         DTSBX425
00919                                                                   DTSBX425
00920      MOVE MPRF-PRIMARY-NAME TO T025-NAME-CHECK.                   DTSBX425
00921                                                                   DTSBX425
00922  P1070-EXIT.                                                      DTSBX425
00923      EXIT.                                                        DTSBX425
00924                                                                   DTSBX425
00925                                                                   DTSBX425
00926  S005-FROM-SYS.                                                   DTSBX425
00927                                                                   DTSBX425
00928      SET L005-FROM-SYS TO TRUE.                                   DTSBX425
00929      GO TO S005-ABSTIME.                                          DTSBX425
00930                                                                   DTSBX425
00931  S005-ABSTIME.                                                    DTSBX425
00932                                                                   DTSBX425
00933      CALL 'DTSBU005' USING L005-LINK-AREA.                        DTSBX425
00934                                                                   DTSBX425
00935  S005-EXIT.                                                       DTSBX425
00936      EXIT.                                                        DTSBX425
00937                                                                   DTSBX425
00938                                                                   DTSBX425
00939  S910-OPEN-UPDATE-NO-AIX.                                         DTSBX425
00940      SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE.                      DTSBX425
00941      GO TO S910-MSTR-IO.                                          DTSBX425
00942                                                                   DTSBX425
00943      EJECT                                                        DTSBX425
00944  S910-OPEN-READ.                                                  DTSBX425
00945      SET L910-OPEN-READ-88 TO TRUE.                               DTSBX425
00946      GO TO S910-MSTR-IO.                                          DTSBX425
00947                                                                   DTSBX425
00948  S910-READ.                                                       DTSBX425
00949      SET L910-READ-88 TO TRUE.                                    DTSBX425
00950      GO TO S910-MSTR-IO.                                          DTSBX425
00951                                                                   DTSBX425
00952  S910-DELETE.                                                     DTSBX425
00953      SET L910-DELETE-88 TO TRUE.                                  DTSBX425
00954      GO TO S910-MSTR-IO.                                          DTSBX425
00955                                                                   DTSBX425
00956  S910-WRITE.                                                      DTSBX425
00957      SET L910-WRITE-88 TO TRUE.                                   DTSBX425
00958      GO TO S910-MSTR-IO.                                          DTSBX425
00959                                                                   DTSBX425
00960  S910-START-BROWSE.                                               DTSBX425
00961      SET L910-START-BROWSE-88 TO TRUE.                            DTSBX425
00962      GO TO S910-MSTR-IO.                                          DTSBX425
00963                                                                   DTSBX425
00964  S910-READ-NEXT.                                                  DTSBX425
00965      SET L910-READ-NEXT-88 TO TRUE.                               DTSBX425
00966      GO TO S910-MSTR-IO.                                          DTSBX425
00967                                                                   DTSBX425
00968  S910-REWRITE.                                                    DTSBX425
00969      SET L910-REWRITE-88 TO TRUE.                                 DTSBX425
00970      GO TO S910-MSTR-IO.                                          DTSBX425
00971                                                                   DTSBX425
00972  S910-CLOSE.                                                      DTSBX425
00973      SET L910-CLOSE-88     TO TRUE.                               DTSBX425
00974      GO TO S910-MSTR-IO.                                          DTSBX425
00975                                                                   DTSBX425
00976  S910-MSTR-IO.                                                    DTSBX425
00977      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBX425
00978                            MSKL-REC.                              DTSBX425
00979  S910-EXIT.                                                       DTSBX425
00980      EXIT.                                                        DTSBX425
00981                                                                   DTSBX425
00982      SKIP3                                                        DTSBX425
00983  S921-OPEN-READ.                                                  DTSBX425
00984      SET L921-OPEN-READ-88 TO TRUE.                               DTSBX425
00985      GO TO S921-AIX-IO.                                           DTSBX425
00986                                                                   DTSBX425
00987  S921-READ.                                                       DTSBX425
00988      SET L921-READ-88 TO TRUE.                                    DTSBX425
00989      GO TO S921-AIX-IO.                                           DTSBX425
00990                                                                   DTSBX425
00991  S921-START-BROWSE.                                               DTSBX425
00992      SET L921-START-BROWSE-88 TO TRUE.                            DTSBX425
00993      GO TO S921-AIX-IO.                                           DTSBX425
00994                                                                   DTSBX425
00995  S921-READ-NEXT.                                                  DTSBX425
00996      SET L921-READ-NEXT-88 TO TRUE.                               DTSBX425
00997      GO TO S921-AIX-IO.                                           DTSBX425
00998                                                                   DTSBX425
00999  S921-CLOSE.                                                      DTSBX425
01000      SET L921-CLOSE-88 TO TRUE.                                   DTSBX425
01001      GO TO S921-AIX-IO.                                           DTSBX425
01002                                                                   DTSBX425
01003  S921-AIX-IO.                                                     DTSBX425
01004      CALL 'DTSBU921' USING L921-LINK-AREA                         DTSBX425
01005                            ISKL-REC.                              DTSBX425
01006  S921-EXIT.                                                       DTSBX425
01007      EXIT.                                                        DTSBX425
01008                                                                   DTSBX425
01009  S927-OPEN-UPDATE.                                                DTSBX425
01010      SET L927-OPEN-UPDATE-88 TO TRUE.                             DTSBX425
01011      GO TO S927-BTC-O.                                            DTSBX425
01012                                                                   DTSBX425
01013  S927-WRITE.                                                      DTSBX425
01014      SET L927-WRITE-88 TO TRUE.                                   DTSBX425
01015      GO TO S927-BTC-O.                                            DTSBX425
01016                                                                   DTSBX425
01017  S927-CLOSE.                                                      DTSBX425
01018      SET L927-CLOSE-88 TO TRUE.                                   DTSBX425
01019      GO TO S927-BTC-O.                                            DTSBX425
01020                                                                   DTSBX425
01021  S927-BTC-O.                                                      DTSBX425
01022      CALL 'DTSBU927' USING L927-LINK-AREA                         DTSBX425
01023                           TSKL-REC.                               DTSBX425
01024  S927-EXIT.                                                       DTSBX425
01025       EXIT.                                                       DTSBX425
01026                                                                   DTSBX425
01027      EJECT                                                        DTSBX425
01028  S999-ABEND.                                                      DTSBX425
01029      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBX425
01030  S999-EXIT.                                                       DTSBX425
01031      EXIT.                                                        DTSBX425
