00001  IDENTIFICATION DIVISION.                                         09/14/25
00002  PROGRAM-ID.             DTSBX426.                                DTSBX426
00003  AUTHOR.                 NGC.                                        LV149
00004  DATE-WRITTEN.           SEPT  2013.                                 CL**2
00005  DATE-COMPILED.                                                   DTSBX426
00006      SKIP3                                                        DTSBX426
00007 *****THIS COPY HAS BEEN MOVED TO RAINCODE - 09/14/2025 ****          CL149
00008 *****                                                             DTSBX426
00009 *    FUNCTION: READ A DAILY FILE FROM THE AUTOMATED CLEARING HOUSEDTSBX426
00010 *              THAT CONTAINS RECORDS FOR DISHONORED ELECTRONIC    DTSBX426
00011 *              PAYMENTS.  IT BUILDS DTSIT025 PAYMENT REVERSAL     DTSBX426
00012 *              TRANSACTION RECORDS AND WRITES THESE RECORDS       DTSBX426
00013 *              TO THE DAILY BTC FILE WHICH IS INPUT TO THE NIGHTLYDTSBX426
00014 *              ACCOUNTING UPDATE.                                 DTSBX426
00015 **                                                                DTSBX426
00016 ** 04/16/2015  PER UI CHIEF DO NOT CHARGE 65.00 RETURN FEE           CL*77
00017 **             FOR ACH RETURNS LESS THAN 15.00                ZL1    CL*77
00018 **                                                                   CL*77
00019 ** 04/21/2015  ALL ACH RETURN TRANSACTIONS WILL BE AUTO REVERSD      CL109
00020 **             ALL EMPLOYERS WITH SAME TRACE NO WILL BE CHARGED      CL109
00021 **             A 65.00 RETURN FEE. AN EMPLOYER WITH MULTIPLE ACH     CL109
00022 **             TRANSACTIONS WITH SAME TRACE NO WILL HAVE ONLY ONE    CL109
00023 **             65.00 RETURN CHARGE FEE                        ZL1    CL109
00024      SKIP3                                                        DTSBX426
00025 ** 04/27/2015  ALL ACH RETURN TRANSACTIONS WILL BE AUTO REVERSD      CL120
00026 **             ALL EMPLOYERS WITH SAME TRACE NO WILL BE CHARGED      CL120
00027 **             A 65.00 RETURN FEE. AN EMPLOYER WITH MULTIPLE ACH     CL120
00028 **             TRANSACTIONS WITH SAME TRACE NO WILL HAVE ONLY ONE    CL120
00029 **             65.00 RETURN CHARGE FEE. ALL TRANSACTIONS WILL HAVE   CL120
00030 **             THE NG TRANSACTION TYPE.                       ZL1    CL120
00031      SKIP3                                                           CL120
00032  ENVIRONMENT DIVISION.                                            DTSBX426
00033  CONFIGURATION SECTION.                                              CL*12
00034  SPECIAL-NAMES. C01 IS TOP-OF-PAGE.                                  CL*12
00035                                                                      CL*12
00036  INPUT-OUTPUT SECTION.                                            DTSBX426
00037                                                                   DTSBX426
00038  FILE-CONTROL.                                                    DTSBX426
00039                                                                   DTSBX426
00040      SELECT IN-FACH    ASSIGN TO EFTFACH                          DTSBX426
00041                              FILE STATUS IS FACH-STATUS.          DTSBX426
00042                                                                      CL**5
00043      SELECT ESSP-ACHD-FILE    ASSIGN TO X426RPT1                     CL*41
00044         FILE STATUS IS REPT-STATUS.                                  CL**5
00045                                                                      CL*79
00046      SELECT ESSP-ACHR-FILE    ASSIGN TO X426RPT2                     CL*83
00047         FILE STATUS IS REPT-STATUS.                                  CL*83
00048                                                                      CL*83
00049      SELECT PEND-FACH-FILE    ASSIGN TO PENDFACH                     CL*79
00050         FILE STATUS IS REPT-STATUS.                                  CL*79
00051                                                                      CL**5
00052                                                                   DTSBX426
00053  DATA DIVISION.                                                   DTSBX426
00054                                                                   DTSBX426
00055  FILE SECTION.                                                    DTSBX426
00056                                                                   DTSBX426
00057  FD  IN-FACH                                                      DTSBX426
00058      LABEL RECORDS ARE STANDARD                                   DTSBX426
00059      RECORDING MODE IS F                                          DTSBX426
00060      BLOCK CONTAINS 0 RECORDS.                                    DTSBX426
00061                                                                   DTSBX426
00062  01  IN-FACH-REC.                                                    CL*50
00063      05 FACH-REC-94                    PIC  X(94).                   CL*50
00064      05 FILLER                         PIC  X(418).                  CL*50
00065                                                                   DTSBX426
00066  FD  PEND-FACH-FILE                                                  CL*79
00067      LABEL RECORDS ARE STANDARD                                      CL*79
00068      RECORDING MODE IS F                                             CL*79
00069      BLOCK CONTAINS 0 RECORDS.                                       CL*79
00070                                                                      CL*79
00071  01  PEND-FACH-REC                     PIC  X(512).                  CL*79
00072                                                                      CL*79
00073  FD  ESSP-ACHD-FILE                                                  CL**5
00074      RECORDING MODE IS F                                             CL**5
00075      BLOCK CONTAINS 0 RECORDS                                        CL**5
00076      LABEL RECORDS ARE OMITTED.                                      CL**5
00077                                                                      CL**5
00078  01  ESSP-ACHD-REC           PIC X(133).                             CL**8
00079                                                                      CL**5
00080  FD  ESSP-ACHR-FILE                                                  CL*83
00081      RECORDING MODE IS F                                             CL*83
00082      BLOCK CONTAINS 0 RECORDS                                        CL*83
00083      LABEL RECORDS ARE OMITTED.                                      CL*83
00084                                                                      CL*83
00085  01  ESSP-ACHR-REC           PIC X(133).                             CL*83
00086                                                                      CL*83
00087                                                                   DTSBX426
00088  WORKING-STORAGE SECTION.                                         DTSBX426
000885 77  PAN-VALET PICTURE X(24) VALUE '149DTSBX426  09/14/25'.       DTSBX426
00089  77  PAN-VALET PICTURE X(24) VALUE '216DTSBX425  01/22/04'.          CL**2
00090                                                                   DTSBX426
00091  01  WRK-AREA.                                                    DTSBX426
00092                                                                   DTSBX426
00093      05  WRK-F907-REC-CNT            PIC S9(07)  COMP-3 VALUE +0. DTSBX426
00094      05  WRK-FAC6-EMP-NO             PIC 9(06) VALUE 0.              CL125
00095      05  WS-FAC6-DUTAS-EMP-NAME.                                     CL129
00096         10  WS-FAC6-DUTAS-EMP-NAMEA  PIC X(4) VALUE SPACES.          CL129
00097         10  WS-FAC6-DUTAS-EMP-NAMEB  PIC X(36) VALUE SPACES.         CL129
00098                                                                   DTSBX426
00099      05  FACH-STATUS                 PIC  X(02).                  DTSBX426
00100          88 FACH-STATUS-EOF-88         VALUE '10'.                   CL**7
00101          88 FACH-STATUS-OK-88          VALUE '00'.                   CL**7
00102                                                                   DTSBX426
00103      05  REPT-STATUS                 PIC  X(02).                     CL*10
00104          88 REPT-STATUS-EOF-88         VALUE '10'.                   CL*10
00105          88 REPT-STATUS-OK-88          VALUE '00'.                   CL*12
00106                                                                      CL*10
00107      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +50. DTSBX426
00108                                                                   DTSBX426
00109      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBX425'.   CL**2
00110      05  WRK-RTN-CD                  PIC  X(05)  VALUE SPACES.       CL*46
00111      05  WRK-FAC7-RTN-CD             PIC  X(05)  VALUE SPACES.       CL*83
00112      05  WRK-DTS-RTN-CD              PIC  X(05)  VALUE SPACES.       CL*84
00113                                                                   DTSBX426
00114      05  WRK-MPAY-REMIT-AMT          PIC  S9(09)V9(02) COMP-3.    DTSBX426
00115      05  TOT-MPAY-AMOUNT             PIC  S9(09)V9(02) COMP-3.       CL115
00116      05  WRK-MPAY-EMP-AMT            PIC  S9(09)V9(02) COMP-3.       CL137
00117                                                                   DTSBX426
00118      05  WRK-CURR-DATE               PIC S9(15)  COMP-3.          DTSBX426
00119      05  WRK-CURR-TIME               PIC S9(09)  COMP-3.          DTSBX426
00120                                                                   DTSBX426
00121      05  WRK-MPAY-EMP-CNT            PIC S9(07)  COMP-3.             CL137
00122      05  WRK-MPRF-READ-CNT           PIC S9(07)  COMP-3.             CL137
00123      05  WRK-MPAY-HOLD-EMP-NO        PIC S9(07)  COMP-3.             CL106
00124      05  WRK-FAC6-RECORDS            PIC S9(07)  COMP-3.          DTSBX426
00125      05  WRK-FAC7-RECORDS            PIC S9(07)  COMP-3.             CL*10
00126      05  WRK-OTHER-RECORDS           PIC S9(07)  COMP-3.          DTSBX426
00127      05  WRK-HEADER-RECORDS          PIC S9(07)  COMP-3.          DTSBX426
00128      05  WRK-TRAILER-RECORDS         PIC S9(07)  COMP-3.          DTSBX426
00129      05  WRK-T025-WRITE-CNT          PIC S9(07)  COMP-3.          DTSBX426
00130      05  WRK-T003-WRITE-CNT          PIC S9(07)  COMP-3.             CL*72
00131      05  WRK-R907-WRITE-CNT          PIC S9(07)  COMP-3.          DTSBX426
00132      05  WRK-F907-WRITE-CNT          PIC S9(07)  COMP-3.          DTSBX426
00133      05  WS-FAC7-PEN-CNT            PIC S9(07)  COMP-3.              CL*85
00134      05  WRK-FACH-READ-CNT           PIC S9(07)  COMP-3.          DTSBX426
00135      05  WRK-TRAILER-REC-CNT         PIC S9(07)  COMP-3.          DTSBX426
00136      05  WRK-FACH-SELECTED-CNT       PIC S9(07)  COMP-3.          DTSBX426
00137      05  WRK-FAC6-AMOUNT             PIC S9(08)V99  COMP-3.       DTSBX426
00138      05  WRK-MPAY-AMOUNT             PIC S9(08)V99  COMP-3.          CL*99
00139      05  WRK-TOLR-AMOUNT             PIC S9(08)V99  COMP-3           CL*98
00140                                       VALUE +15.00.                  CL102
00141      05  TOT-FAC6-AMOUNT             PIC S9(10)V99  COMP-3.       DTSBX426
00142      05  TOT-TRAILER-AMT             PIC S9(10)V99  COMP-3.       DTSBX426
00143      05  WS-LINE-CNT                 PIC  9(05)  VALUE 60.           CL*10
00144      05  WS-RETN-CNT                 PIC  9(05)  VALUE 60.           CL*88
00145      05  WS-PAGE-CNT                 PIC  9(05)  VALUE 0.            CL*10
00146      05  WRK-MPAY-CNT                PIC  9(05)  VALUE 0.            CL107
00147      05  WRK-FAC6-AMT-DISP           PIC ---,---,999.99.             CL*95
00148      05  WRK-AMT-DISP1               PIC ---,---,999.99.             CL*95
00149      05  WRK-AMT-DISP2               PIC ---,---,999.99.             CL*95
00150                                                                      CL*33
00151      05  WRK-SYS-ABSTIME         PIC S9(15)    COMP-3 VALUE 0.       CL*33
00152      05  W-SLASH-DATE            PIC  X(10).                         CL*33
00153      05  FILLER REDEFINES W-SLASH-DATE.                              CL*33
00154          10  W-SLASH-DT-MM       PIC  X(02).                         CL*33
00155          10  FILLER              PIC  X(01).                         CL*33
00156          10  W-SLASH-DT-DD       PIC  X(02).                         CL*33
00157          10  FILLER              PIC  X(01).                         CL*33
00158          10  W-SLASH-DT-CCYY     PIC  X(04).                         CL*33
00159                                                                      CL*33
00160      05  WRK-FAC1-DATE.                                              CL*92
00161          10  WRK-FAC1-DATE-YY    PIC  X(02).                         CL*92
00162          10  WRK-FAC1-DATE-MM    PIC  X(02).                         CL*92
00163          10  WRK-FAC1-DATE-DD    PIC  X(02).                         CL*92
00164                                                                      CL*92
00165      05  WRK-RTN-DATE.                                               CL*92
00166          10  WRK-RTN-DATE-CC     PIC  9(02) VALUE 20.                CL*94
00167          10  WRK-RTN-DATE-YY     PIC  9(02).                         CL*94
00168          10  WRK-RTN-DATE-MM     PIC  9(02).                         CL*92
00169          10  WRK-RTN-DATE-DD     PIC  9(02).                         CL*93
00170                                                                      CL*92
00171      05  WRK-RECV-DATE           PIC  9(8)  VALUE ZERO.              CL*92
00172                                                                      CL*46
00173      05  WS-HOLD-ITRT-REC           PIC  X(63).                      CL*47
00174                                                                      CL*47
00175      05  WRK-FAC7-RTN-CODE          PIC  X(01).                      CL*47
00176          88 WRK-FAC7-RTN-VALID-88   VALUE 'Y'.                       CL*46
00177          88 WRK-FAC7-RTN-INVALID-88 VALUE 'N'.                       CL*46
00178                                                                   DTSBX426
00179      05  WRK-TEMP-TRACE-NO.                                       DTSBX426
00180          10  WRK-TEMP-TRACE-NOA      PIC X(06) VALUE ZEROS.          CL*21
00181          10  WRK-TEMP-TRACE-NOB      PIC X(09) VALUE ZEROS.          CL*21
00182                                                                   DTSBX426
00183      05  WRK-NUMR-TRACE-NO           PIC 9(13) VALUE ZEROS.          CL*21
00184                                                                   DTSBX426
00185      05  WRK-FAC6-DOES-TRACE-NO      PIC S9(13) COMP-3.              CL**4
00186                                                                      CL106
00187      05  WRK-TRACE-NO-IND            PIC  X(01).                     CL106
00188          88 TRACE-NO-END-YES-88  VALUE 'Y'.                          CL107
00189          88 TRACE-NO-END-NO-88   VALUE 'N'.                          CL107
00190                                                                      CL106
00191                                                                   DTSBX426
00192      05  WRK-MPRF-IND                PIC  X(01).                  DTSBX426
00193          88 WRK-MPRF-OK           VALUE 'Y'.                      DTSBX426
00194          88 WRK-MPRF-NO-REC       VALUE 'N'.                      DTSBX426
00195                                                                   DTSBX426
00196      05  WRK-MPAY-IND                PIC  X(01).                  DTSBX426
00197          88 MPAY-FOUND-YES-88     VALUE 'Y'.                      DTSBX426
00198          88 MPAY-FOUND-NO-88      VALUE 'N'.                      DTSBX426
00199                                                                   DTSBX426
00200      05  WRK-TOLR-IND                PIC  X(01).                     CL*98
00201          88 WRK-TOLR-YES-88     VALUE 'Y'.                           CL*98
00202          88 WRK-TOLR-NO-88      VALUE 'N'.                           CL*98
00203                                                                      CL*98
00204      05  WRK-MPRF-IND                PIC  X(01).                     CL*66
00205          88 MPRF-FOUND-YES-88     VALUE 'Y'.                         CL*66
00206          88 MPRF-FOUND-NO-88      VALUE 'N'.                         CL*66
00207                                                                      CL*66
00208      05  WRK-ITRT-IND                PIC  X(01).                     CL*79
00209          88 ITRT-FOUND-YES-88     VALUE 'Y'.                         CL*79
00210          88 ITRT-FOUND-NO-88      VALUE 'N'.                         CL*79
00211                                                                      CL*79
00212      05  WRITE-T025-IND              PIC  X(01).                  DTSBX426
00213          88 WRITE-T025-YES-88     VALUE 'Y'.                      DTSBX426
00214          88 WRITE-T025-NO-88      VALUE 'N'.                      DTSBX426
00215                                                                   DTSBX426
00216      05  WRK-DTSBU005-IND            PIC  X(01).                  DTSBX426
00217          88 WRK-DTSBU005-YES      VALUE 'Y'.                      DTSBX426
00218          88 WRK-DTSBU005-NO       VALUE 'N'.                      DTSBX426
00219                                                                   DTSBX426
00220      05  WRK-FACH-PEND               PIC  X(01).                     CL*84
00221          88 WRK-FACH-PEND-REC-YES-88 VALUE 'Y'.                      CL*83
00222          88 WRK-FACH-PEND-REC-NO-88  VALUE 'N'.                      CL*83
00223                                                                      CL*83
00224      05  WRK-FAC1-IND                PIC  X(01).                  DTSBX426
00225          88 WRK-FAC1-FIRST-OK     VALUE 'Y'.                      DTSBX426
00226          88 WRK-FAC1-FIRST-NO     VALUE 'N'.                      DTSBX426
00227                                                                   DTSBX426
00228      05  WRK-FACH-IND                PIC  X(01).                  DTSBX426
00229          88 WRK-FACH-LAST-REC-88  VALUE 'Y'.                      DTSBX426
00230                                                                   DTSBX426
00231      05  WRK-TRACE-IND                   PIC  X(01).              DTSBX426
00232                                                                   DTSBX426
00233  01  WRK-MNTE-SUBJECT.                                               CL*74
00234           10  NTE-SUBJ               PIC X(19)                       CL*70
00235               VALUE 'ACH PAYMENT RETURN '.                           CL*70
00236  01  WRK-MNTE-REASON.                                                CL*70
00237           10  FILLER                 PIC X(13)                       CL*70
00238               VALUE 'CODE/REASON: '.                                 CL*70
00239           10  NTE-REASON             PIC X(54).                      CL*70
00240  01  WRK-MNTE-TRACE-NO.                                              CL*70
00241           10  FILLER                 PIC X(13)                       CL*70
00242               VALUE '   TRACE NO: '.                                 CL*70
00243           10  NTE-TRACE-NO           PIC X(13).                      CL*70
00244  01  WRK-MNTE-DEP-DATE.                                              CL*70
00245           10  FILLER                 PIC X(13)                       CL*70
00246               VALUE 'RECEIVD DTE: '.                                 CL121
00247           10  NTE-DEPOSIT-DATE       PIC X(13).                      CL*70
00248  01  WRK-MNTE-BATCH-ITEM.                                            CL*70
00249           10  FILLER                 PIC X(13)                       CL*70
00250               VALUE ' BATCH/ITEM: '.                                 CL*70
00251           10  NTE-BATCH-NO           PIC X(5).                       CL*70
00252           10  FILLER                 PIC X(1) VALUE '/'.             CL*70
00253           10  NTE-ITEM-NO            PIC XXX.                        CL*70
00254  01  WRK-MNTE-ACCT-NO.                                               CL*72
00255           10  FILLER                 PIC X(13)                       CL*71
00256               VALUE ' ACCOUNT NO: '.                                 CL*71
00257           10  NTE-ACCT-NO            PIC X(20).                      CL*71
00258  01  WRK-MNTE-AMOUNT.                                                CL*72
00259           10  FILLER                 PIC X(13)                       CL*71
00260               VALUE ' DEP AMOUNT: '.                                 CL*71
00261           10  NTE-AMOUNT             PIC ---,---,999.99.             CL*96
00262  01  WRK-MNTE-NO-FEE.                                                CL*77
00263           10  FILLER                 PIC X(39)                       CL*77
00264               VALUE ' RETURN FEE: NO RETURN FEE WAS CHARGED '.       CL*77
00265           10  FILLER                 PIC X(29)                       CL*77
00266               VALUE 'RETURN AMOUNT LESS THAN 15.00'.                 CL*77
00267  01  MSG-TABLE.                                                      CL*70
00268      05  MSG1-NO-MPAY.                                            DTSBX426
00269          10  MSG1-ID.                                             DTSBX426
00270              15  MSG1-ID-A   PIC  X(08)  VALUE 'DTSBX425'.           CL**2
00271              15  MSG1-ID-B   PIC  X(03)  VALUE '907'.             DTSBX426
00272          10  MSG1-SHORT-TEXT PIC  X(20) VALUE 'FAC6 WITH NO MPRF'.DTSBX426
00273          10  MSG1-LONG-TEXT.                                      DTSBX426
00274              15  FILLER      PIC  X(30)                           DTSBX426
00275                    VALUE 'FAC6 RECORD ENCOUNTERED WITH N'.        DTSBX426
00276              15  FILLER      PIC  X(30)                           DTSBX426
00277                    VALUE 'O CORRESPONDING MPAY RECORD   '.        DTSBX426
00278  01  HEADER-1.                                                       CL**5
00279      05  FILLER                   PIC X(01) VALUE SPACES.            CL**5
00280      05  FILLER                   PIC X(49) VALUE '140R1'.           CL**5
00281      05  FILLER                   PIC X(54) VALUE                    CL*28
00282          'DISTRICT OF COLUMBIA'.                                     CL**5
00283      05  FILLER                   PIC X(06) VALUE 'DATE:'.           CL**5
00284      05  HDR1-LRCM-SYS-DATE       PIC X(10).                         CL**5
00285  01  HEADER-2.                                                       CL**5
00286      05  FILLER                   PIC X(54) VALUE SPACES.            CL**5
00287      05  FILLER                   PIC X(49) VALUE                    CL*28
00288          'TAX DIVISION'.                                             CL**5
00289      05  FILLER                   PIC X(06) VALUE 'TIME:'.           CL**5
00290      05  HDR2-LRCM-SYS-TIME       PIC X(08).                         CL**5
00291  01  HEADER-3.                                                       CL**5
00292      05  FILLER                   PIC X(01) VALUE SPACES.            CL**5
00293      05  FILLER                   PIC X(40) VALUE                    CL119
00294          'ROUTE TO:  TAX ACCOUNTING  '.                              CL**6
00295      05  HDR3-LITERAL             PIC X(57) VALUE SPACES.            CL117
00296      05  FILLER                   PIC X(20) VALUE SPACES.            CL*27
00297      05  FILLER                   PIC X(06) VALUE 'PAGE:'.           CL**5
00298      05  HEADER-3-PAGE                PIC ZZ,ZZ9.                    CL*12
00299                                                                      CL**5
00300  01  HEADER-3A.                                                      CL**6
00301      05  FILLER                   PIC X(01) VALUE SPACES.            CL**6
00302      05  FILLER                   PIC X(23) VALUE                    CL*30
00303          'ACH RETURNS DATE/TIME: '.                                  CL*41
00304      05  FILLER                   PIC X(01) VALUE SPACES.            CL*26
00305      05  HEADER-3A-DATE               PIC X(06) VALUE SPACES.        CL*22
00306      05  FILLER                   PIC X(01) VALUE '/'.               CL*22
00307      05  HEADER-3A-TIME           PIC X(06) VALUE SPACES.            CL*22
00308                                                                      CL*22
00309  01  HEADER-4.                                                       CL**5
00310      05  FILLER                   PIC X(01)  VALUE SPACES.           CL**5
00311      05  FILLER                   PIC X(132) VALUE SPACES.           CL**5
00312  01  HEADER-5.                                                       CL**5
00313      05  FILLER                   PIC X(02)  VALUE SPACES.           CL**5
00314      05  FILLER                   PIC X(28)  VALUE                   CL*55
00315          'EMP NO   NAME  REV BTCH/ITM '.                             CL*55
00316      05  FILLER                   PIC X(01)  VALUE SPACES.           CL*55
00317      05  FILLER                   PIC X(44)  VALUE                   CL*69
00318             'BANK ID     ACCT NO             ACH AMOUNT  '.          CL*69
00319 *    05  FILLER                   PIC X(04)  VALUE SPACES.           CL*63
00320      05  FILLER                   PIC X(09)  VALUE                   CL**5
00321             'TRACE NO '.                                             CL**5
00322 *    05  FILLER                   PIC X(02)  VALUE SPACES.           CL*63
00323      05  HDR5-NAME                PIC X(50)  VALUE                   CL119
00324               ' CODE  REASON BANK RETURNED ACH DEBIT PAYMENT'.       CL119
00325  01  HEADER-6.                                                       CL**5
00326      05  FILLER                   PIC X(01)  VALUE SPACES.           CL**5
00327      05  FILLER                   PIC X(132) VALUE SPACES.           CL**5
00328                                                                      CL*56
00329  01  ZNOTE1.                                                         CL*56
00330      05  FILLER                   PIC X(02)  VALUE SPACES.           CL*56
00331      05  FILLER                   PIC X(53)  VALUE                   CL*56
00332          '** NOTE 1. CODE BEGINNING WITH 98 INDICATES A NOC    '.    CL*69
00333                                                                      CL*56
00334  01  CNOTE1.                                                         CL*56
00335      05  FILLER                   PIC X(02)  VALUE SPACES.           CL*56
00336      05  FILLER                   PIC X(53)  VALUE                   CL*56
00337          'THE ACH NETWORK PROVIDED NOTIFICATION THAT SOMETHING '.    CL*56
00338      05  FILLER                   PIC X(53)  VALUE                   CL*56
00339          'ABOUT THE BANK ACCOUNT HAS CHANGED.  WELLS FARGO HAS '.    CL*56
00340                                                                      CL*56
00341  01  CNOTE2.                                                         CL*56
00342      05  FILLER                   PIC X(02)  VALUE SPACES.           CL*56
00343      05  FILLER                   PIC X(53)  VALUE                   CL*56
00344          'CORRECTED SUBSEQUENT PAYMENTS FOR THE AFFTECTED BANK '.    CL*56
00345      05  FILLER                   PIC X(53)  VALUE                   CL*56
00346          'ACCOUNT USING THE UPDATED INFORMATION.               '.    CL*56
00347                                                                      CL*56
00348  01  CNOTE3.                                                         CL*56
00349      05  FILLER                   PIC X(02)  VALUE SPACES.           CL*56
00350      05  FILLER                   PIC X(53)  VALUE                   CL*56
00351          '>>>>>>>> USE THE NOTIFICATION OF CHANGE REPORT  FROM '.    CL*56
00352      05  FILLER                   PIC X(53)  VALUE                   CL*56
00353          'WELLS FARGO TO UPDATE YOUR SYSTEM INFORMATION. <<<<< '.    CL*56
00354                                                                      CL*56
00355  01  DETAIL-LINE-1.                                                  CL**5
00356      15  FILLER                     PIC  X(02) VALUE SPACES.         CL**5
00357      15  X425-EMP-NO                PIC  999B999 BLANK WHEN ZERO.    CL**6
00358      15  FILLER                     PIC  X(02) VALUE SPACES.         CL**5
00359      15  X425-NAME-CHECK            PIC  X(04) VALUE SPACES.         CL*53
00360      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*53
00361      15  X425-AUTO-REV              PIC  X(02) VALUE SPACES.         CL*53
00362      15  FILLER                     PIC  X(01) VALUE SPACES.         CL*53
00363      15  X425-AUTO-BATCH            PIC  X(05) VALUE SPACES.         CL*53
00364      15  X425-AUTO-FILL             PIC  X(01) VALUE '/'.            CL*53
00365      15  X425-AUTO-ITEM             PIC  X(03) VALUE SPACES.         CL*53
00366      15  FILLER                     PIC  X(02) VALUE SPACES.         CL**5
00367      15  X425-BANK-ID               PIC  X(10) VALUE SPACES.         CL*38
00368      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*38
00369      15  X425-ACCT-NUMBER           PIC  X(17) VALUE SPACES.         CL*58
00370      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*22
00371      15  X425-X145-REMIT            PIC   -------9.99.               CL**7
00372      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*58
00373      15  X425-X145-TRACE-NOB        PIC  X(08) VALUE SPACES.         CL*10
00374      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*58
00375      15  X425-MESSAGE               PIC  X(54).                      CL*58
00376                                                                      CL**5
00377                                                                      CL*83
00378  01  DETAIL-LINE-2.                                                  CL*30
00379      15  FILLER                     PIC  X(15) VALUE SPACES.         CL*30
00380      05  FILLER                   PIC X(56) VALUE                    CL*30
00381      ' ********* NO ACH DEBIT RETURNS **********'.                   CL*41
00382                                                                      CL*30
00383  01  FOOTING-LINE-1               PIC X(133) VALUE SPACES.           CL**5
00384  01  FOOTING-LINE-2               PIC X(133) VALUE                   CL117
00385      ' *** WELLS FARGO  TRANSACTIONS **'.                            CL117
00386                                                                      CL**5
00387  01  FOOTDTS-LINE-2               PIC X(133) VALUE                   CL117
00388      ' *** DOES DUTAS   TRANSACTIONS **'.                            CL117
00389  01  FOOTING-LINE-3.                                                 CL**5
00390      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL**5
00391      05  WS-FOOTING-CNT           PIC  ZZ,ZZ9.                       CL**5
00392      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL**5
00393      05  FILLER                   PIC  X(45) VALUE                   CL**5
00394                    ' TOTAL ACH DEBIT DEPOSITS RETURNED   '.          CL*41
00395      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL**5
00396                                                                      CL**5
00397  01  FOOTING-LINE-4.                                                 CL**5
00398      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL**5
00399      05  WS-X145-ERR-CNT           PIC  ZZ,ZZ9.                      CL**5
00400      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL**5
00401      05  FILLER                   PIC  X(40) VALUE                   CL118
00402                    ' # OF ACH DEBITS RETURNED HAD ERRORS'.           CL117
00403      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL**5
00404  01  FOOTING-LINE-5.                                                 CL**5
00405      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL**5
00406      05  WS-X145-PEN-CNT           PIC  ZZ,ZZ9.                      CL**5
00407      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL**5
00408      05  FILLER                   PIC  X(40) VALUE                   CL**5
00409                     ' # OF ACH RETURNS WENT TO PENDING FILE '.       CL*83
00410      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL**5
00411  01  FOOTING-LINE-6.                                                 CL**5
00412      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL**5
00413      05  WS-T025-WRITE-CNT         PIC  ZZ,ZZ9.                      CL**5
00414      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL**5
00415      05  FILLER                   PIC  X(45) VALUE                   CL**5
00416                ' # OF ACH REVERSAL TRANS SENT TO DUTAS    '.         CL117
00417      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL**5
00418  01  FOOTING-LINE-7.                                                 CL**5
00419      05  FILLER                   PIC  X(19)  VALUE SPACES.          CL**5
00420      05  WS-TOT-REMIT             PIC  $$$$$$$$9.99.                 CL**5
00421      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL**5
00422      05  FILLER                   PIC  X(50) VALUE                   CL114
00423                  ' TOTAL AMOUNT OF ACH PAYMENTS REVERSED'.           CL114
00424      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL**5
00425                                                                      CL**5
00426  01  FOOTING-LINE-8.                                                 CL**5
00427      05  FILLER                   PIC  X(19)  VALUE SPACES.          CL**5
00428      05  WS-TOTAL-REMIT           PIC  $$$$$$$$9.99.                 CL**5
00429      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL**5
00430      05  FILLER                   PIC  X(45) VALUE                   CL**5
00431                       'TOTAL AMOUNT - ACH DEBITS RETURNED   '.       CL*41
00432      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL**5
00433  01  FOOTING-LINE-13.                                                CL**5
00434      05  FILLER                   PIC X(25)  VALUE SPACES.           CL**5
00435      05  FILLER                   PIC  X(67) VALUE                   CL**5
00436           '*** END DOES/WELLS FARGO DAILY ACH TRANSMISSION  ***'.    CL*40
00437  01  FOOTING-LINE-14              PIC  X(133) VALUE SPACES.          CL**5
00438                                                                      CL**5
00439                                                                   DTSBX426
00440  01  FACH-LINK-REC.                                               DTSBX426
00441  ++INCLUDE DTSIXACH                                                  CL**2
00442      EJECT                                                        DTSBX426
00443  01  FAC0-LINK-REC.                                                  CL*45
00444  ++INCLUDE DTSIXAC0                                                  CL*45
00445      EJECT                                                        DTSBX426
00446      EJECT                                                           CL*45
00447  01  FAC1-LINK-REC.                                                  CL*45
00448  ++INCLUDE DTSIXAC1                                                  CL*45
00449      EJECT                                                           CL*45
00450  01  FAC5-LINK-REC.                                                  CL**2
00451  ++INCLUDE DTSIXAC5                                                  CL**2
00452      EJECT                                                           CL**2
00453  01  FAC6-LINK-REC.                                               DTSBX426
00454  ++INCLUDE DTSIXAC6                                                  CL**2
00455      EJECT                                                        DTSBX426
00456  01  FAC7-LINK-REC.                                                  CL**3
00457  ++INCLUDE DTSIXAC7                                                  CL**3
00458      EJECT                                                           CL**3
00459  01  FAC9-LINK-REC.                                               DTSBX426
00460  ++INCLUDE DTSIXAC9                                                  CL**2
00461      EJECT                                                        DTSBX426
00462  01  MNTE-REC.                                                       CL*70
00463  ++INCLUDE DTSIMNTE                                                  CL*70
00464      EJECT                                                        DTSBX426
00465  01  MPAY-REC.                                                       CL*70
00466  ++INCLUDE DTSIMPAY                                                  CL*70
00467      EJECT                                                           CL*70
00468  01  L005-LINK-AREA.                                              DTSBX426
00469  ++INCLUDE DTSIL005                                               DTSBX426
00470      EJECT                                                        DTSBX426
00471  01  L001-LINK-AREA.                                                 CL*71
00472  ++INCLUDE DTSIL001                                                  CL*71
00473      EJECT                                                           CL*71
00474  01  RSK1-REC.                                                    DTSBX426
00475  ++INCLUDE DTSIRSK1                                               DTSBX426
00476      EJECT                                                        DTSBX426
00477  01  ITRT-REC.                                                    DTSBX426
00478  ++INCLUDE DTSIITRT                                               DTSBX426
00479      EJECT                                                        DTSBX426
00480  01  ISKL-REC.                                                    DTSBX426
00481  ++INCLUDE DTSIISKL                                               DTSBX426
00482      EJECT                                                        DTSBX426
00483  01  R907-REC.                                                    DTSBX426
00484  ++INCLUDE DTSIR907                                               DTSBX426
00485      EJECT                                                        DTSBX426
00486  01  EFT-BATCH-ERRORS-MESS.                                       DTSBX426
00487  ++INCLUDE EFTERMSG                                               DTSBX426
00488      EJECT                                                        DTSBX426
00489  01  F907-REC.                                                    DTSBX426
00490  ++INCLUDE EFTIF907                                               DTSBX426
00491      EJECT                                                        DTSBX426
00492  01  T025-REC.                                                    DTSBX426
00493  ++INCLUDE DTSIT025                                               DTSBX426
00494      EJECT                                                        DTSBX426
00495  01  T003-REC.                                                       CL*71
00496  ++INCLUDE DTSIT003                                                  CL*71
00497      EJECT                                                           CL*71
00498  01  L910-LINK-AREA.                                              DTSBX426
00499  ++INCLUDE DTSIL910                                               DTSBX426
00500      EJECT                                                        DTSBX426
00501  01  L921-LINK-AREA.                                              DTSBX426
00502  ++INCLUDE DTSIL921                                               DTSBX426
00503      EJECT                                                        DTSBX426
00504  01  L927-LINK-AREA.                                              DTSBX426
00505  ++INCLUDE DTSIL927                                               DTSBX426
00506      EJECT                                                        DTSBX426
00507  01  MSKL-REC.                                                    DTSBX426
00508  ++INCLUDE DTSIMSKL                                               DTSBX426
00509      EJECT                                                        DTSBX426
00510  01  TSKL-REC.                                                    DTSBX426
00511  ++INCLUDE DTSITSKL                                               DTSBX426
00512      EJECT                                                        DTSBX426
00513  01  MPRF-REC.                                                    DTSBX426
00514  ++INCLUDE DTSIMPRF                                               DTSBX426
00515      EJECT                                                        DTSBX426
00516  01  MTAD-REC.                                                    DTSBX426
00517  ++INCLUDE DTSIMTAD                                               DTSBX426
00518                                                                   DTSBX426
00519  PROCEDURE DIVISION.                                              DTSBX426
00520                                                                   DTSBX426
00521      PERFORM I0000-INITIATE THRU I0000-EXIT.                      DTSBX426
00522                                                                      CL*16
00523      IF RETURN-CODE = +3                                             CL*32
00524         PERFORM T0000-TERMINATE THRU T0000-EXIT                      CL*32
00525         PERFORM S999-ABEND      THRU S999-EXIT                       CL146
00526         GOBACK.                                                      CL146
00527                                                                   DTSBX426
00528      PERFORM P0000-PROCESS THRU P0000-EXIT UNTIL                  DTSBX426
00529              WRK-FACH-IND = 'Y'.                                  DTSBX426
00530                                                                   DTSBX426
00531      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DTSBX426
00532                                                                   DTSBX426
00533      GOBACK.                                                      DTSBX426
00534                                                                   DTSBX426
00535  I0000-INITIATE.                                                  DTSBX426
00536                                                                   DTSBX426
00537      MOVE +0 TO WRK-FACH-READ-CNT                                 DTSBX426
00538                 WRK-MPAY-REMIT-AMT                                DTSBX426
00539                 WRK-FACH-SELECTED-CNT                             DTSBX426
00540                 WRK-R907-WRITE-CNT                                DTSBX426
00541                 WRK-OTHER-RECORDS                                 DTSBX426
00542                 WS-FAC7-PEN-CNT                                      CL*86
00543                 WRK-FAC6-RECORDS                                  DTSBX426
00544                 WRK-FAC7-RECORDS                                     CL*43
00545                 WRK-HEADER-RECORDS                                DTSBX426
00546                 WRK-TRAILER-RECORDS                               DTSBX426
00547                 WRK-F907-WRITE-CNT                                DTSBX426
00548                 WRK-T025-WRITE-CNT                                DTSBX426
00549                 WRK-T003-WRITE-CNT                                   CL*76
00550                 WRK-TRAILER-REC-CNT                               DTSBX426
00551                 WRK-FAC6-AMOUNT                                   DTSBX426
00552                 WRK-MPAY-AMOUNT                                      CL*99
00553                 TOT-FAC6-AMOUNT                                   DTSBX426
00554                 TOT-MPAY-AMOUNT                                      CL115
00555                 WRK-MPAY-HOLD-EMP-NO                                 CL106
00556                 WRK-MPAY-CNT                                         CL106
00557                 TOT-TRAILER-AMT                                      CL106
00558                 WRK-FAC6-DOES-TRACE-NO.                              CL**4
00559                                                                   DTSBX426
00560      MOVE ZEROS TO FAC1-LINK-REC                                  DTSBX426
00561                    FAC6-LINK-REC                                  DTSBX426
00562                    FAC7-LINK-REC                                     CL*48
00563                    FAC9-LINK-REC.                                 DTSBX426
00564                                                                   DTSBX426
00565      MOVE 'N' TO WRK-TRACE-IND, WRK-FACH-IND.                     DTSBX426
00566                                                                   DTSBX426
00567      MOVE 'Y' TO WRK-FAC1-IND, WRK-DTSBU005-IND.                  DTSBX426
00568                                                                   DTSBX426
00569      PERFORM I2000-OPEN-FILES          THRU I2000-EXIT.           DTSBX426
00570                                                                   DTSBX426
00571  I0000-EXIT.                                                      DTSBX426
00572      EXIT.                                                        DTSBX426
00573  I2000-OPEN-FILES.                                                DTSBX426
00574                                                                   DTSBX426
00575      MOVE LENGTH OF T025-REC TO T025-LENGTH.                      DTSBX426
00576      MOVE LENGTH OF F907-REC TO F907-LENGTH.                      DTSBX426
00577                                                                   DTSBX426
00578      MOVE WRK-TRACE-IND TO L910-TRACE-IND, L921-TRACE-IND.        DTSBX426
00579                                                                   DTSBX426
00580      MOVE WRK-MOD-NAME TO L910-MOD-NAME, L921-MOD-NAME            DTSBX426
00581                                                                   DTSBX426
00582      PERFORM S910-OPEN-READ THRU S910-EXIT.                       DTSBX426
00583                                                                   DTSBX426
00584      PERFORM S921-OPEN-READ THRU S921-EXIT.                       DTSBX426
00585                                                                   DTSBX426
00586      MOVE 'N' TO L927-TRACE-IND.                                  DTSBX426
00587      MOVE WRK-MOD-NAME TO L927-MOD-NAME.                          DTSBX426
00588      PERFORM S927-OPEN-UPDATE THRU S927-EXIT.                     DTSBX426
00589                                                                      CL*32
00590      PERFORM S005-FROM-SYS THRU S005-EXIT.                           CL*32
00591      MOVE L005-ABSTIME TO WRK-SYS-ABSTIME.                           CL*32
00592      MOVE L005-SLASH-DATE TO W-SLASH-DATE.                           CL*32
00593      DISPLAY  'SYS DATE ' W-SLASH-DATE.                              CL*32
00594      MOVE W-SLASH-DATE TO HDR1-LRCM-SYS-DATE.                        CL*32
00595                                                                   DTSBX426
00596      OPEN INPUT IN-FACH.                                          DTSBX426
00597                                                                   DTSBX426
00598      IF NOT FACH-STATUS-OK-88                                        CL*17
00599         DISPLAY 'OPEN ERROR ON FACH INPUT FILE ** ' FACH-STATUS      CL*32
00600         MOVE +3 TO RETURN-CODE                                       CL*13
00601      ELSE                                                            CL**6
00602      IF FACH-STATUS-OK-88                                         DTSBX426
00603         NEXT SENTENCE                                             DTSBX426
00604      ELSE                                                         DTSBX426
00605         DISPLAY 'OPEN ERROR ON FACH INPUT FILE ** ' FACH-STATUS   DTSBX426
00606         PERFORM S999-ABEND THRU S999-EXIT                            CL*12
00607       END-IF                                                         CL**6
00608      END-IF.                                                         CL**6
00609                                                                      CL**6
00610      OPEN OUTPUT   ESSP-ACHD-FILE.                                   CL*35
00611      IF REPT-STATUS-OK-88                                            CL*35
00612         NEXT SENTENCE                                                CL*35
00613      ELSE                                                            CL*35
00614         DISPLAY 'CANNOT OPEN REPORT ACHD  FILE '                     CL*35
00615            REPT-STATUS                                               CL*35
00616         PERFORM S999-ABEND THRU S999-EXIT                            CL*35
00617      END-IF.                                                         CL*35
00618                                                                      CL*35
00619      OPEN OUTPUT   ESSP-ACHR-FILE.                                   CL*83
00620      IF REPT-STATUS-OK-88                                            CL*83
00621         NEXT SENTENCE                                                CL*83
00622      ELSE                                                            CL*83
00623         DISPLAY 'CANNOT OPEN REPORT ACHR  FILE '                     CL*83
00624            REPT-STATUS                                               CL*83
00625         PERFORM S999-ABEND THRU S999-EXIT                            CL*83
00626      END-IF.                                                         CL*83
00627                                                                      CL*83
00628      OPEN OUTPUT   PEND-FACH-FILE.                                   CL*79
00629      IF REPT-STATUS-OK-88                                            CL*79
00630         NEXT SENTENCE                                                CL*79
00631      ELSE                                                            CL*79
00632         DISPLAY 'CANNOT OPEN OUTPUT ACH PENDING FILE '               CL*79
00633            REPT-STATUS                                               CL*79
00634         PERFORM S999-ABEND THRU S999-EXIT                            CL*79
00635      END-IF.                                                         CL*79
00636                                                                      CL*79
00637       READ IN-FACH                                                   CL*50
00638          AT END                                                      CL*18
00639         MOVE +3 TO RETURN-CODE                                       CL*18
00640         DISPLAY 'NO ACH DEPOSITS RETURNED      '                     CL*41
00641         MOVE 'Y' TO WRK-FACH-IND                                     CL*18
00642         GO TO I2000-EXIT.                                            CL*18
00643                                                                      CL*18
00644                                                                   DTSBX426
00645  I2000-EXIT.                                                      DTSBX426
00646      EXIT.                                                        DTSBX426
00647                                                                   DTSBX426
00648  P0000-PROCESS.                                                   DTSBX426
00649       DISPLAY ' 1000 - PROCESS'.                                  DTSBX426
00650                                                                   DTSBX426
00651       MOVE FACH-REC-94 TO FACH-LINK-REC.                             CL*50
00652                                                                   DTSBX426
00653       ADD +1 TO WRK-FACH-READ-CNT.                                DTSBX426
00654 *    MOVE ZEROS TO FAC6-HEADER-REC.                                  CL*81
00655                                                                   DTSBX426
00656      IF FACH-TYPE-HEADER-88                                       DTSBX426
00657         MOVE FACH-LINK-REC TO FAC1-LINK-REC                       DTSBX426
00658         ADD 1 TO WRK-HEADER-RECORDS                               DTSBX426
00659         PERFORM P1005-HEADER-EDIT THRU P1005-EXIT                 DTSBX426
00660      ELSE                                                         DTSBX426
00661      IF FACH-TYPE-ENTRY-DETAIL-88                                 DTSBX426
00662       SET WRK-FACH-PEND-REC-NO-88 TO TRUE                            CL*83
00663         MOVE FACH-LINK-REC TO FAC6-LINK-REC                       DTSBX426
00664         ADD 1 TO WRK-FAC6-RECORDS                                 DTSBX426
00665         PERFORM P1010-FAC6-EDIT THRU P1010-EXIT                   DTSBX426
00666      ELSE                                                            CL**5
00667      IF FACH-TYPE-ADDENDA-88                                         CL*14
00668         MOVE FACH-LINK-REC TO FAC7-LINK-REC                          CL**5
00669         ADD 1 TO WRK-FAC7-RECORDS                                    CL**5
00670         PERFORM P1011-FAC7-EDIT THRU P1011-EXIT                      CL**5
00671      ELSE                                                            CL**3
00672      IF FACH-TYPE-TRAILER-88                                      DTSBX426
00673         MOVE FACH-LINK-REC TO FAC9-LINK-REC                       DTSBX426
00674         ADD 1 TO WRK-TRAILER-RECORDS                              DTSBX426
00675         ADD 1 TO WRK-TRAILER-REC-CNT                              DTSBX426
00676         PERFORM P1015-TRAILER-EDIT THRU P1015-EXIT                DTSBX426
00677      ELSE                                                         DTSBX426
00678         ADD 1 TO WRK-OTHER-RECORDS.                                  CL*18
00679                                                                      CL*18
00680       READ IN-FACH                                                   CL*50
00681          AT END                                                      CL*18
00682          MOVE 'Y' TO WRK-FACH-IND                                    CL*18
00683         GO TO P0000-EXIT.                                            CL*18
00684                                                                   DTSBX426
00685  P0000-EXIT.                                                      DTSBX426
00686      EXIT.                                                        DTSBX426
00687                                                                   DTSBX426
00688                                                                   DTSBX426
00689  P1005-HEADER-EDIT.                                               DTSBX426
00690                                                                   DTSBX426
00691       DISPLAY ' 1005 - HEADER PROCESS'.                              CL*49
00692      IF WRK-FACH-READ-CNT NOT = 1                                 DTSBX426
00693         MOVE 'Y' TO WRK-FACH-IND                                  DTSBX426
00694         DISPLAY ' FIRST RECORD OF FILE IS NOT A HEADER RECORD'    DTSBX426
00695         PERFORM S999-ABEND THRU S999-EXIT.                        DTSBX426
00696         MOVE FAC1-FILE-CREATE-DATE  TO WRK-FAC1-DATE.                CL*92
00697         MOVE WRK-FAC1-DATE-YY       TO WRK-RTN-DATE-YY.              CL*92
00698         MOVE WRK-FAC1-DATE-MM       TO WRK-RTN-DATE-MM.              CL*92
00699         MOVE WRK-FAC1-DATE-DD       TO WRK-RTN-DATE-DD.              CL*92
00700         MOVE WRK-RTN-DATE           TO WRK-RECV-DATE.                CL*92
00701  P1005-EXIT.                                                      DTSBX426
00702      EXIT.                                                        DTSBX426
00703                                                                   DTSBX426
00704  P1010-FAC6-EDIT.                                                 DTSBX426
00705       DISPLAY '1010 - TYPE6 PROCESS EMP NO: ' FAC6-DUTAS-EMP-NO.     CL*91
00706                                                                   DTSBX426
00707       SET WRITE-T025-NO-88 TO TRUE.                               DTSBX426
00708       SET MPAY-FOUND-YES-88 TO TRUE.                                 CL105
00709       DISPLAY ' 1010 - AMOUNT  '  FAC6-AMOUNT                     DTSBX426
00710       DISPLAY ' 1010 - TRACEIN '  FAC6-DOES-TRACE-NO                 CL**4
00711      MOVE ZEROS              TO  WRK-TEMP-TRACE-NO                DTSBX426
00712                                  WRK-FAC6-DOES-TRACE-NO.             CL*12
00713 *                                WRK-DOES-TRACE-NO.                  CL*12
00714      MOVE FAC6-AMOUNT        TO  WRK-FAC6-AMOUNT.                    CL*74
00715      MOVE FAC6-DOES-TRACE-NO TO  WRK-TEMP-TRACE-NO.                  CL*10
00716                                                                   DTSBX426
00717      MOVE FAC6-AMOUNT        TO  WRK-FAC6-AMT-DISP.                  CL*73
00718      MOVE WRK-FAC6-AMT-DISP  TO  NTE-AMOUNT.                         CL*73
00719 *    MOVE ZEROS              TO  WRK-TEMP-TRACE-NOA.                 CL*21
00720 *    MOVE WRK-DOES-TRACE-NOB TO  WRK-TEMP-TRACE-NOB.                 CL*12
00721      MOVE WRK-TEMP-TRACE-NOA TO  WRK-FAC6-DOES-TRACE-NO.             CL*21
00722                                                                   DTSBX426
00723      DISPLAY  'TRACE-NO -TEMP  ' WRK-TEMP-TRACE-NO                DTSBX426
00724      DISPLAY  'TRACE-WRK-FAC6  ' WRK-FAC6-DOES-TRACE-NO              CL**4
00725                                                                   DTSBX426
00726      IF FAC6-AMOUNT = ZEROS                                       DTSBX426
00727          ADD 1 TO WRK-F907-WRITE-CNT                                 CL**8
00728         DISPLAY ' ACH PAYMENT = ZEROS ' FAC6-AMOUNT                  CL**8
00729         MOVE +2 TO RETURN-CODE.                                      CL*37
00730 *       MOVE EFT027 TO F907-MSG-TEXT                                 CL**8
00731 *       MOVE '027' TO F907-MSG-ID                                    CL**8
00732 *       MOVE ZEROS TO F907-EMP-NO                                    CL**8
00733 *       MOVE FAC6-AMOUNT TO F907-GOV1-REC                            CL**8
00734 *       PERFORM P1055-WRITE-F907     THRU P1055-EXIT                 CL**8
00735 *       GO TO P1010-EXIT.                                            CL**8
00736                                                                   DTSBX426
00737      IF FAC6-AMOUNT NOT NUMERIC                                   DTSBX426
00738          ADD 1 TO WRK-F907-WRITE-CNT                                 CL**8
00739         DISPLAY ' ACH PAYMENT NOT NUMERIC  ' FAC6-AMOUNT             CL**8
00740         MOVE +2 TO RETURN-CODE.                                      CL*37
00741 *       MOVE EFT028 TO F907-MSG-TEXT                                 CL**8
00742 *       MOVE '028' TO F907-MSG-ID                                    CL**8
00743 *       MOVE ZEROS TO F907-EMP-NO                                    CL**8
00744 *       MOVE WRK-FAC6-AMOUNT TO F907-GOV1-REC                        CL**8
00745 *       PERFORM P1055-WRITE-F907     THRU P1055-EXIT                 CL**8
00746 *       GO TO P1010-EXIT.                                            CL**8
00747                                                                   DTSBX426
00748      ADD WRK-FAC6-AMOUNT TO TOT-FAC6-AMOUNT.                      DTSBX426
00749                                                                   DTSBX426
00750      IF WRK-TEMP-TRACE-NO NOT NUMERIC                             DTSBX426
00751          ADD 1 TO WRK-F907-WRITE-CNT                                 CL**8
00752         DISPLAY 'TRACE-NO NOT NUMERIC ' WRK-TEMP-TRACE-NO            CL**8
00753         MOVE +2 TO RETURN-CODE.                                      CL*37
00754 *       MOVE EFT013 TO F907-MSG-TEXT                                 CL**8
00755 *       MOVE '013' TO F907-MSG-ID                                    CL**8
00756 *       MOVE ZEROS TO F907-EMP-NO                                    CL**8
00757 *       MOVE WRK-TEMP-TRACE-NO TO F907-GOV1-TRACE                    CL**8
00758 *       PERFORM P1055-WRITE-F907     THRU P1055-EXIT                 CL**8
00759 *       GO TO P1010-EXIT.                                            CL**8
00760                                                                   DTSBX426
00761      IF WRK-TEMP-TRACE-NO = ZEROS                                 DTSBX426
00762         DISPLAY 'TRACE-NO = ZEROS  ' WRK-TEMP-TRACE-NO               CL**8
00763         MOVE +2 TO RETURN-CODE.                                      CL*37
00764 *       MOVE EFT014 TO F907-MSG-TEXT                                 CL**8
00765 *       MOVE '014' TO F907-MSG-ID                                    CL**8
00766 *       MOVE ZEROS TO F907-EMP-NO                                    CL**8
00767 *       MOVE WRK-TEMP-TRACE-NO TO F907-GOV1-TRACE                    CL**8
00768 *       PERFORM P1055-WRITE-F907     THRU P1055-EXIT                 CL**8
00769 *       GO TO P1010-EXIT.                                            CL**8
00770                                                                   DTSBX426
00771      SET MPRF-FOUND-YES-88  TO TRUE.                                 CL135
00772                                                                      CL123
00773 *    IF FAC6-DUTAS-EMP-NOA = 'DC'                                    CL135
00774 *       GO TO P1010-EXIT.                                            CL135
00775                                                                      CL133
00776                                                                      CL133
00777 *    DISPLAY 'ZEMP-NO: ' FAC6-DUTAS-EMP-NO                           CL135
00778                                                                      CL132
00779 *    PERFORM P1070-READ-MPRF THRU P1070-EXIT.                        CL135
00780                                                                      CL*65
00781 *    IF L910-NO-REC-88                                               CL135
00782 *       SET MPRF-FOUND-NO-88 TO TRUE                                 CL135
00783 *       SET WRITE-T025-NO-88  TO TRUE                                CL135
00784 *       SET WRK-FACH-PEND-REC-YES-88 TO TRUE                         CL135
00785 *       MOVE 'DTS01' TO WRK-DTS-RTN-CD                               CL135
00786 *       DISPLAY '***NO MPRF FOUND ON DUTAS -ERROR  ' MPRF-EMP-NO.    CL135
00787                                                                      CL*65
00788 *    IF FAC6-AMOUNT = ZEROS OR MPRF-FOUND-NO-88                      CL135
00789 *       SET MPAY-FOUND-NO-88 TO TRUE.                                CL135
00790  P1010-EXIT.                                                      DTSBX426
00791      EXIT.                                                        DTSBX426
00792                                                                   DTSBX426
00793  P1011-FAC7-EDIT.                                                    CL*10
00794      DISPLAY ' 1011 - TYPE7  PROCESS'.                               CL*56
00795      DISPLAY ' FAC7 RETURN CODE ' FAC7-RTN-CD.                       CL*60
00796                                                                      CL*61
00797                                                                      CL*56
00798 *    IF FAC7-RTN-CD = '98'                                           CL*65
00799 *      DISPLAY ' ***** CODE 98 NO T025 WRITTEN ' MPAY-EMP-NO         CL*65
00800 *      MOVE 'N'       TO X425-AUTO-REV                               CL*65
00801 *      MOVE '*****'   TO X425-AUTO-BATCH                             CL*65
00802 *      MOVE 'NOC'     TO X425-AUTO-ITEM.                             CL*65
00803                                                                      CL*87
00804         MOVE '  DOES-ESSP ACH DEBIT RETURNS/REVERSALS         '      CL113
00805          TO HDR3-LITERAL.                                            CL110
00806                                                                      CL110
00807       PERFORM P4100-PRINT-HEADER THRU P4100-EXIT.                    CL110
00808      PERFORM P4000-PRNT-ACHD THRU P4000-EXIT.                        CL110
00809      MOVE FAC7-RTN-CD    TO WRK-FAC7-RTN-CD                          CL110
00810      PERFORM P5000-ACH-RETURN-CODE THRU P5000-EXIT.                  CL110
00811      WRITE ESSP-ACHD-REC FROM DETAIL-LINE-1  AFTER 1.                CL110
00812      ADD  1    TO WS-LINE-CNT.                                       CL110
00813                                                                      CL147
00814      IF FAC7-TRANS-CD = '98'                                         CL148
00815        DISPLAY ' ***** CODE 98 NO T025 WRITTEN ' MPAY-EMP-NO         CL147
00816        GO TO P1011-EXIT.                                             CL147
00817                                                                      CL109
00818      IF MPAY-FOUND-YES-88                                            CL109
00819         DISPLAY ' MPAY SET TO TRUE '                                 CL111
00820        PERFORM P1020-FIND-MPAY-INDEX THRU P1020-EXIT.                CL109
00821                                                                      CL109
00822                                                                      CL105
00823      IF WRK-FACH-PEND-REC-YES-88                                     CL*83
00824         MOVE '  DOES-ESSP ACH DEBIT RETURNS NOT FOUND ON DUTAS'      CL*87
00825          TO HDR3-LITERAL                                             CL*87
00826         PERFORM P4200-PRINT-HEADER THRU P4200-EXIT                   CL*90
00827         PERFORM P4000-PRNT-ACHD THRU P4000-EXIT                      CL*87
00828         MOVE WRK-DTS-RTN-CD    TO WRK-FAC7-RTN-CD                    CL*83
00829         PERFORM P5000-ACH-RETURN-CODE THRU P5000-EXIT                CL*83
00830         WRITE ESSP-ACHR-REC FROM DETAIL-LINE-1  AFTER 1              CL*83
00831         WRITE PEND-FACH-REC FROM FAC1-LINK-REC                       CL*84
00832         WRITE PEND-FACH-REC FROM FAC6-LINK-REC                       CL*84
00833         WRITE PEND-FACH-REC FROM FAC7-LINK-REC                       CL*84
00834         ADD  1    TO WS-FAC7-PEN-CNT                                 CL114
00835         ADD  1    TO WS-LINE-CNT.                                    CL*83
00836                                                                      CL*83
00837  P1011-EXIT.                                                         CL*10
00838      EXIT.                                                           CL*10
00839                                                                      CL*10
00840  P1015-TRAILER-EDIT.                                              DTSBX426
00841                                                                   DTSBX426
00842       DISPLAY ' 1015 - TRAILER PROCESS'.                             CL*49
00843      IF  WRK-TRAILER-REC-CNT > 1                                  DTSBX426
00844          GO TO  P1015-EXIT.                                       DTSBX426
00845          GO TO  P1015-EXIT.                                          CL*19
00846                                                                   DTSBX426
00847 *    IF FAC9-BATCH-CNT = ZEROS                                    DTSBX426
00848 *       MOVE EFT066 TO F907-MSG-TEXT                              DTSBX426
00849 *       MOVE '066' TO F907-MSG-ID                                 DTSBX426
00850 *       MOVE ZEROS TO F907-EMP-NO                                 DTSBX426
00851 *       MOVE FAC9-TRAILER-REC TO F907-GOV1-REC                    DTSBX426
00852 *       PERFORM P1055-WRITE-F907     THRU P1055-EXIT.             DTSBX426
00853                                                                   DTSBX426
00854                                                                   DTSBX426
00855 *    IF FAC9-BATCH-CNT NOT NUMERIC                                DTSBX426
00856 *       MOVE EFT064 TO F907-MSG-TEXT                              DTSBX426
00857 *       MOVE '064' TO F907-MSG-ID                                 DTSBX426
00858 *       MOVE ZEROS TO F907-EMP-NO                                 DTSBX426
00859 *       MOVE FAC9-TRAILER-REC TO F907-GOV1-REC                    DTSBX426
00860 *       PERFORM P1055-WRITE-F907     THRU P1055-EXIT.             DTSBX426
00861                                                                   DTSBX426
00862 *    IF WRK-FACH-READ-CNT NOT = FAC9-BATCH-CNT                    DTSBX426
00863 *       MOVE EFT065 TO F907-MSG-TEXT, R907-MSG-TEXT               DTSBX426
00864 *       MOVE '065' TO F907-MSG-ID, R907-MSG-ID                    DTSBX426
00865 *       MOVE ZEROS TO F907-EMP-NO                                 DTSBX426
00866 *       MOVE FAC9-TRAILER-REC TO F907-GOV1-REC                    DTSBX426
00867 *       PERFORM P1055-WRITE-F907     THRU P1055-EXIT.             DTSBX426
00868                                                                   DTSBX426
00869      MOVE FAC9-TOT-CREDIT-AMT TO TOT-TRAILER-AMT.                 DTSBX426
00870                                                                   DTSBX426
00871      IF TOT-FAC6-AMOUNT  NOT = TOT-TRAILER-AMT                    DTSBX426
00872         MOVE EFT067 TO F907-MSG-TEXT, R907-MSG-TEXT               DTSBX426
00873         MOVE '067' TO F907-MSG-ID, R907-MSG-ID                    DTSBX426
00874         MOVE ZEROS TO F907-EMP-NO                                 DTSBX426
00875         MOVE FAC9-TRAILER-REC TO F907-GOV1-REC                    DTSBX426
00876         DISPLAY '****ERROR TYPE6 AMT NOT = TRAILER AMT '             CL122
00877                       FAC9-TRAILER-REC.                              CL122
00878 *       PERFORM P1055-WRITE-F907     THRU P1055-EXIT.                CL122
00879                                                                   DTSBX426
00880  P1015-EXIT.                                                      DTSBX426
00881      EXIT.                                                        DTSBX426
00882  P1020-FIND-MPAY-INDEX.                                              CL105
00883                                                                   DTSBX426
00884       DISPLAY ' 1020 - PROCESS'.                                  DTSBX426
00885      SET MPAY-FOUND-NO-88   TO TRUE                                  CL111
00886      SET TRACE-NO-END-NO-88 TO TRUE.                                 CL111
00887      MOVE LOW-VALUES    TO ITRT-KEY-AREA.                         DTSBX426
00888      SET ITRT-TRT-88    TO TRUE.                                  DTSBX426
00889                                                                   DTSBX426
00890      DISPLAY  'TRACE-WRK-FAC6  ' WRK-FAC6-DOES-TRACE-NO              CL*46
00891 *    MOVE WRK-NUMR-TRACE-NO TO ITRT-TRACE-NO.                        CL*46
00892      MOVE WRK-FAC6-DOES-TRACE-NO TO ITRT-TRACE-NO.                   CL*46
00893                                                                   DTSBX426
00894 *    MOVE ZEROS         TO ITRT-EMP-NO                               CL141
00895 *                          ITRT-BATCH-NO                             CL141
00896 *                          ITRT-ITEM-NO                              CL141
00897      MOVE ZEROS         TO WRK-MPAY-EMP-AMT                          CL141
00898                            WRK-MPAY-EMP-CNT                          CL136
00899                            WRK-MPAY-CNT.                             CL136
00900                                                                   DTSBX426
00901      MOVE ITRT-KEY-AREA TO ISKL-KEY-AREA.                         DTSBX426
00902                                                                   DTSBX426
00903      PERFORM S921-START-BROWSE THRU S921-EXIT.                    DTSBX426
00904      IF L921-NO-REC-88                                            DTSBX426
00905         DISPLAY ' TRACE NO NOT FOUND ' WRK-FAC6-DOES-TRACE-NO        CL*46
00906         SET WRK-FACH-PEND-REC-YES-88 TO TRUE                         CL*83
00907         MOVE 'DTS02' TO WRK-DTS-RTN-CD                               CL*83
00908         GO TO P1020-EXIT                                          DTSBX426
00909      ELSE                                                         DTSBX426
00910       PERFORM P1021-FIND-MPAY-RECORD THRU P1021-EXIT UNTIL           CL105
00911            TRACE-NO-END-YES-88.                                      CL105
00912  P1020-EXIT.                                                         CL105
00913      EXIT.                                                           CL105
00914                                                                      CL105
00915  P1021-FIND-MPAY-RECORD.                                             CL107
00916                                                                      CL105
00917       DISPLAY ' 1021 - PROCESS'.                                     CL111
00918      ADD 1 TO WRK-MPAY-CNT.                                          CL105
00919      MOVE ISKL-REC       TO ITRT-REC.                                CL105
00920 *       DISPLAY ' MMAY CNT         ' WRK-MPAY-CNT.                   CL145
00921 *       DISPLAY ' 1TRT TRACE NO  - ' ITRT-TRACE-NO                   CL145
00922 *       DISPLAY ' 1FAC6 TRACE NO - '                                 CL145
00923 *               WRK-FAC6-DOES-TRACE-NO.                              CL145
00924 *       DISPLAY ' TRANSACTION TYPE ' ITRT-TRAN-TYPE                  CL145
00925 *    DISPLAY 'ITRT EMP   ' ITRT-EMP-NO.                              CL145
00926 *    DISPLAY 'ITRT BATCH ' ITRT-BATCH-NO                             CL145
00927 *    DISPLAY 'ITRT ITEM  ' ITRT-ITEM-NO.                             CL145
00928                                                                   DTSBX426
00929      IF ITRT-TRACE-NO NOT = WRK-FAC6-DOES-TRACE-NO                   CL**4
00930       SET  TRACE-NO-END-YES-88 TO TRUE                               CL105
00931       IF WRK-MPAY-CNT = 1                                            CL105
00932         DISPLAY ' 1TRT TRACE NO  - NOT FOUND - ' ITRT-TRACE-NO       CL105
00933         DISPLAY ' 1FAC6 TRACE NO - NOT FOUND - '                     CL105
00934                 WRK-FAC6-DOES-TRACE-NO                               CL105
00935         SET WRK-FACH-PEND-REC-YES-88 TO TRUE                         CL*83
00936         MOVE 'DTS02' TO WRK-DTS-RTN-CD                               CL*83
00937         GO TO P1021-EXIT                                             CL105
00938       ELSE                                                           CL105
00939         GO TO P1021-EXIT                                             CL105
00940       END-IF                                                         CL105
00941      END-IF.                                                         CL105
00942                                                                      CL105
00943      MOVE LOW-VALUES     TO MPAY-KEY-AREA.                        DTSBX426
00944      MOVE ITRT-EMP-NO    TO MPAY-EMP-NO.                          DTSBX426
00945      MOVE ITRT-BATCH-NO  TO MPAY-BATCH-NO.                        DTSBX426
00946      MOVE ITRT-ITEM-NO   TO MPAY-ITEM-NO.                         DTSBX426
00947      SET MPAY-PAY-88     TO TRUE.                                 DTSBX426
00948                                                                   DTSBX426
00949      MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA.                         DTSBX426
00950      DISPLAY ' MPAY EMP-'  MPAY-EMP-NO.                           DTSBX426
00951      DISPLAY ' MPAY BAT-'  MPAY-BATCH-NO.                         DTSBX426
00952      DISPLAY ' MPAY ITM-'  MPAY-ITEM-NO.                          DTSBX426
00953      PERFORM S910-READ   THRU S910-EXIT.                          DTSBX426
00954                                                                   DTSBX426
00955      IF L910-NO-REC-88                                            DTSBX426
00956       DISPLAY ' MPAY - TRACE NO NOT FOUND - ' WRK-NUMR-TRACE-NO      CL*78
00957       DISPLAY ' FAC6 - TRACE NO        - ' WRK-FAC6-DOES-TRACE-NO    CL*78
00958         SET WRK-FACH-PEND-REC-YES-88 TO TRUE                         CL*83
00959         MOVE 'DTS03' TO WRK-DTS-RTN-CD                               CL*83
00960         SET MPAY-FOUND-NO-88 TO TRUE                              DTSBX426
00961         SET  TRACE-NO-END-YES-88 TO TRUE                             CL105
00962         GO TO P1021-EXIT                                             CL105
00963      ELSE                                                         DTSBX426
00964         MOVE MSKL-REC         TO MPAY-REC.                           CL*82
00965         SET MPAY-FOUND-YES-88 TO TRUE                             DTSBX426
00966                                                                      CL*82
00967      MOVE FAC6-AMOUNT         TO WRK-FAC6-AMOUNT                     CL*98
00968      MOVE MPAY-REMIT-AMT      TO WRK-MPAY-AMOUNT                     CL*98
00969      ADD  MPAY-REMIT-AMT      TO WRK-MPAY-EMP-AMT                    CL136
00970      MOVE FAC6-AMOUNT         TO WRK-AMT-DISP1                       CL*98
00971      MOVE MPAY-REMIT-AMT      TO WRK-AMT-DISP2                       CL*92
00972      MOVE MPAY-REMIT-AMT      TO NTE-AMOUNT.                         CL140
00973                                                                      CL*82
00974       ADD WRK-MPAY-AMOUNT TO TOT-MPAY-AMOUNT.                        CL114
00975       DISPLAY ' WF RETURN AMOUNT ' WRK-AMT-DISP1                     CL*82
00976       DISPLAY 'MPAYRETURN AMOUNT ' WRK-AMT-DISP2                     CL*82
00977                                                                      CL*82
00978      IF MPAY-FOUND-YES-88                                            CL105
00979         MOVE MPAY-EMP-NO TO WRK-FAC6-EMP-NO                          CL124
00980         MOVE WRK-FAC6-EMP-NO TO FAC6-DUTAS-EMP-NO                    CL124
00981         PERFORM P1070-READ-MPRF THRU P1070-EXIT                      CL123
00982         PERFORM P1040-BUILD-T025-RECORD THRU P1040-EXIT              CL105
00983         PERFORM P1045-BUILD-T003-RECORD THRU P1045-EXIT              CL105
00984        IF WRITE-T025-YES-88                                          CL105
00985           MOVE T025-REC          TO TSKL-REC                         CL105
00986           PERFORM S927-WRITE         THRU S927-EXIT                  CL105
00987           MOVE T003-REC              TO TSKL-REC                     CL105
00988           PERFORM S927-WRITE         THRU S927-EXIT                  CL105
00989           ADD 1 TO WRK-T025-WRITE-CNT                                CL105
00990           ADD 1 TO WRK-T003-WRITE-CNT                                CL105
00991        END-IF                                                        CL105
00992      END-IF.                                                         CL105
00993                                                                      CL105
00994      PERFORM S921-READ-NEXT THRU S921-EXIT.                          CL105
00995                                                                      CL105
00996      IF L921-NO-REC-88                                               CL105
00997         DISPLAY ' TRACE NO NXT NOT FOUND ' WRK-FAC6-DOES-TRACE-NO    CL105
00998         SET  TRACE-NO-END-YES-88 TO TRUE.                            CL105
00999                                                                      CL105
01000  P1021-EXIT.                                                         CL105
01001      EXIT.                                                           CL105
01002                                                                      CL105
01003                                                                   DTSBX426
01004  P1040-BUILD-T025-RECORD.                                         DTSBX426
01005       DISPLAY ' 1040 - PROCESS'.                                  DTSBX426
01006      SET WRITE-T025-YES-88  TO TRUE.                              DTSBX426
01007      SET WRK-TOLR-NO-88 TO TRUE                                      CL*98
01008      MOVE LENGTH OF T025-REC TO T025-LENGTH.                         CL*71
01009                                                                   DTSBX426
01010 *    IF WRK-DTSBU005-YES                                             CL*46
01011         PERFORM S005-FROM-SYS          THRU S005-EXIT             DTSBX426
01012         MOVE L005-DATE                TO WRK-CURR-DATE            DTSBX426
01013         MOVE L005-TIME                TO WRK-CURR-TIME            DTSBX426
01014 *       MOVE 'N' TO WRK-DTSBU005-IND.                                CL*46
01015                                                                   DTSBX426
01016      MOVE MPAY-EMP-NO         TO T025-EMP-NO.                     DTSBX426
01017      MOVE 'WEB PAY'          TO T025-ORIGIN.                         CL*83
01018                                                                   DTSBX426
01019      MOVE WRK-CURR-DATE       TO T025-SYS-DATE.                   DTSBX426
01020      MOVE WRK-CURR-TIME       TO T025-SYS-TIME.                   DTSBX426
01021                                                                      CL138
01022      IF MPAY-EMP-NO NOT = WRK-MPAY-HOLD-EMP-NO                       CL138
01023         MOVE MPAY-REMIT-AMT  TO WRK-MPAY-EMP-AMT                     CL139
01024         MOVE ZEROS TO WRK-MPAY-EMP-CNT.                              CL138
01025                                                                      CL*77
01026      IF WRK-MPAY-EMP-CNT = 1                                         CL136
01027         MOVE MPAY-EMP-NO         TO WRK-MPAY-HOLD-EMP-NO             CL136
01028         SET T025-NSF-PEN-CHARGE-NO-88 TO TRUE                        CL136
01029         MOVE 'NG'                TO T025-PAY-TYPE                    CL136
01030         GO TO P1040-BUILD-T025-CONT.                                 CL136
01031                                                                      CL136
01032      IF WRK-MPAY-EMP-AMT < WRK-TOLR-AMOUNT                           CL136
01033         MOVE MPAY-EMP-NO TO WRK-MPAY-HOLD-EMP-NO                     CL136
01034         DISPLAY 'FAC6 < 15: ' WRK-MPAY-AMOUNT ' ' WRK-TOLR-AMOUNT    CL136
01035         SET T025-NSF-PEN-CHARGE-NO-88 TO TRUE                        CL136
01036         MOVE 'NG'                TO T025-PAY-TYPE                    CL136
01037         GO TO P1040-BUILD-T025-CONT.                                 CL136
01038                                                                      CL136
01039 *    IF WRK-MPAY-EMP-AMT < WRK-TOLR-AMOUNT OR                        CL136
01040 *       WRK-MPAY-HOLD-EMP-NO = MPAY-EMP-NO                           CL136
01041 *       MOVE MPAY-EMP-NO TO WRK-MPAY-HOLD-EMP-NO                     CL136
01042 *       DISPLAY 'FAC6 < 15: ' WRK-MPAY-AMOUNT ' ' WRK-TOLR-AMOUNT    CL136
01043 *       SET T025-NSF-PEN-CHARGE-NO-88 TO TRUE                        CL136
01044 *       MOVE 'NG'                TO T025-PAY-TYPE                    CL136
01045 *    ELSE                                                            CL136
01046         MOVE MPAY-EMP-NO         TO WRK-MPAY-HOLD-EMP-NO             CL106
01047         MOVE 1                   TO WRK-MPAY-EMP-CNT                 CL136
01048         SET T025-NSF-PEN-CHARGE-YES-88 TO TRUE                       CL120
01049         MOVE 'NG'                TO T025-PAY-TYPE.                   CL*77
01050                                                                   DTSBX426
01051  P1040-BUILD-T025-CONT.                                              CL136
01052      MOVE MPRF-PRIMARY-NAME   TO T025-NAME-CHECK.                 DTSBX426
01053                                                                   DTSBX426
01054      COMPUTE WRK-MPAY-REMIT-AMT = MPAY-REMIT-AMT * -1.            DTSBX426
01055      MOVE WRK-MPAY-REMIT-AMT  TO T025-REMIT-AMT.                  DTSBX426
01056                                                                      CL*78
01057      MOVE MPAY-TRACE-NO   TO T025-TRACE-NO.                       DTSBX426
01058      MOVE WRK-RECV-DATE   TO T025-RECEIVED-DATE                      CL*92
01059                              T025-DEPOSIT-DATE.                   DTSBX426
01060                                                                   DTSBX426
01061      SET T025-WAIVE-INT-NO-88       TO TRUE                          CL120
01062      SET T025-WAIVE-LATE-PEN-NO-88  TO TRUE                          CL120
01063      MOVE ZERO              TO T025-APPLIC-YRQ.                   DTSBX426
01064      MOVE SPACES            TO T025-APPLIC-IND.                   DTSBX426
01065      MOVE MPAY-BATCH-NO     TO T025-APPLIC-BATCH-NO.              DTSBX426
01066      MOVE MPAY-ITEM-NO      TO T025-APPLIC-ITEM-NO.               DTSBX426
01067      MOVE SPACES            TO T025-RESPONSIBLE-ACTIVITY.         DTSBX426
01068      MOVE 'WEBESSP'         TO T025-RESPONSIBLE-OP-ID.               CL**3
01069                                                                   DTSBX426
01070                                                                      CL107
01071       DISPLAY ' EMP PAYMENT REVERSED ' MPAY-EMP-NO                   CL107
01072       DISPLAY '     WF RETURN AMOUNT ' WRK-AMT-DISP1                 CL107
01073       DISPLAY '  MPAY  RETURN AMOUNT ' WRK-AMT-DISP2                 CL107
01074       DISPLAY '           PAY   TYPE ' T025-PAY-TYPE.                CL107
01075                                                                      CL107
01076      PERFORM P4300-PRNT-REVR THRU P4300-EXIT.                        CL110
01077      WRITE ESSP-ACHD-REC FROM DETAIL-LINE-1  AFTER 1.                CL110
01078      ADD  1    TO WS-LINE-CNT.                                       CL110
01079                                                                      CL110
01080                                                                   DTSBX426
01081  P1040-EXIT.                                                      DTSBX426
01082      EXIT.                                                        DTSBX426
01083                                                                   DTSBX426
01084  P1045-BUILD-T003-RECORD.                                            CL*71
01085                                                                      CL*70
01086      PERFORM S3000-INIT-T003        THRU S3000-EXIT.                 CL*70
01087                                                                      CL*70
01088      MOVE WRK-MNTE-SUBJECT          TO MNTE-SUBJECT                  CL*70
01089                                                                      CL*70
01090      MOVE +1                      TO MNTE-TEXT-CNT.                  CL*70
01091      MOVE WRK-MNTE-REASON          TO MNTE-TEXT(MNTE-TEXT-CNT)       CL*75
01092      DISPLAY 'MNTE-REASON: '          MNTE-TEXT(MNTE-TEXT-CNT)       CL*98
01093                                                                      CL*70
01094      ADD  +1                      TO MNTE-TEXT-CNT.                  CL*95
01095      MOVE WRK-MNTE-TRACE-NO        TO MNTE-TEXT(MNTE-TEXT-CNT)       CL*75
01096      DISPLAY 'MNTE-TRACEN: '          MNTE-TEXT(MNTE-TEXT-CNT)       CL*98
01097                                                                      CL*74
01098      ADD  +1                      TO MNTE-TEXT-CNT.                  CL*95
01099      MOVE WRK-MNTE-DEP-DATE        TO MNTE-TEXT(MNTE-TEXT-CNT)       CL*75
01100      DISPLAY 'MNTE-DEPDTE: '          MNTE-TEXT(MNTE-TEXT-CNT)       CL*98
01101                                                                      CL*74
01102      ADD  +1                      TO MNTE-TEXT-CNT.                  CL*95
01103      MOVE WRK-MNTE-BATCH-ITEM      TO MNTE-TEXT(MNTE-TEXT-CNT)       CL*75
01104      DISPLAY 'MNTE-BTHITM: '          MNTE-TEXT(MNTE-TEXT-CNT)       CL*98
01105                                                                      CL*74
01106      ADD  +1                      TO MNTE-TEXT-CNT.                  CL*95
01107      MOVE WRK-MNTE-ACCT-NO         TO MNTE-TEXT(MNTE-TEXT-CNT)       CL*75
01108      DISPLAY 'MNTE-ACCTNO: '          MNTE-TEXT(MNTE-TEXT-CNT)       CL*98
01109                                                                      CL*74
01110      ADD  +1                      TO MNTE-TEXT-CNT.                  CL*95
01111      MOVE WRK-MNTE-AMOUNT          TO MNTE-TEXT(MNTE-TEXT-CNT)       CL*75
01112      DISPLAY 'MNTE-AMOUNT: '          MNTE-TEXT(MNTE-TEXT-CNT)       CL*98
01113                                                                      CL*74
01114 *    ADD  +1                      TO MNTE-TEXT-CNT.                  CL*98
01115 *    MOVE WRK-MNTE-AMOUNT          TO MNTE-TEXT(MNTE-TEXT-CNT)       CL*98
01116                                                                      CL*77
01117      IF WRK-MPAY-EMP-AMT < WRK-TOLR-AMOUNT                           CL140
01118         SET WRK-TOLR-YES-88 TO TRUE.                                 CL106
01119                                                                      CL106
01120      IF WRK-TOLR-YES-88                                              CL*98
01121       DISPLAY 'P1045 - TOLERATED NO FEE: ' WRK-MPAY-AMOUNT           CL112
01122      ADD  +1                      TO MNTE-TEXT-CNT                   CL*95
01123      MOVE WRK-MNTE-NO-FEE          TO MNTE-TEXT(MNTE-TEXT-CNT).      CL*77
01124                                                                      CL*77
01125      MOVE MNTE-REC                  TO T003-MNTE-REC.                CL*70
01126                                                                      CL*70
01127  P1045-EXIT.                                                         CL*70
01128        EXIT.                                                         CL*70
01129  P1055-WRITE-F907.                                                   CL*70
01130 **************************************************************    DTSBX426
01131 *  WRITE FACH ERROR RETURN FILE(F907)                        *    DTSBX426
01132 **************************************************************    DTSBX426
01133                                                                   DTSBX426
01134       DISPLAY ' 1055 - PROCESS'.                                  DTSBX426
01135      ADD +1             TO WRK-F907-WRITE-CNT.                    DTSBX426
01136      MOVE WRK-MOD-NAME  TO F907-MODULE-NAME.                      DTSBX426
01137      MOVE IN-FACH-REC   TO F907-GOV1-REC.                         DTSBX426
01138      MOVE ZEROS TO F907-EMP-NO.                                   DTSBX426
01139                                                                   DTSBX426
01140      CALL 'DTSBU946' USING F907-REC.                              DTSBX426
01141                                                                   DTSBX426
01142                                                                   DTSBX426
01143  P1055-EXIT.                                                      DTSBX426
01144       EXIT.                                                       DTSBX426
01145  P4000-PRNT-ACHD.                                                    CL**7
01146      MOVE FAC6-DUTAS-EMP-NO    TO  X425-EMP-NO                       CL**7
01147      MOVE FAC6-DUTAS-EMP-NAME  TO  X425-NAME-CHECK.                  CL127
01148      MOVE FAC6-BANK-ACCT-NO    TO  X425-ACCT-NUMBER NTE-ACCT-NO      CL*71
01149      MOVE FAC6-RECV-BANK-ID    TO  X425-BANK-ID.                     CL*38
01150      MOVE WRK-FAC6-AMOUNT      TO  X425-X145-REMIT                   CL*72
01151      MOVE WRK-TEMP-TRACE-NOA   TO  X425-X145-TRACE-NOB.              CL*21
01152      MOVE WRK-TEMP-TRACE-NOA   TO  NTE-TRACE-NO.                     CL*71
01153 *    MOVE SPACES               TO  X425-MESSAGE.                     CL*51
01154 *    IF MPAY-FOUND-YES-88                                            CL110
01155 *       MOVE MPAY-BATCH-NO     TO  X425-AUTO-BATCH NTE-BATCH-NO      CL110
01156 *       MOVE MPAY-ITEM-NO      TO  X425-AUTO-ITEM  NTE-ITEM-NO       CL110
01157 *       MOVE '/'               TO  X425-AUTO-FILL                    CL110
01158 *       MOVE 'Y '              TO  X425-AUTO-REV                     CL110
01159 *       MOVE MPAY-DEPOSIT-DATE TO L001-FED-8-DATE-9                  CL110
01160 *       SET L001-FROM-FED-8    TO TRUE                               CL110
01161 *       PERFORM S001-DATE THRU S001-EXIT                             CL110
01162 *       MOVE L001-SLASH-8-DATE TO NTE-DEPOSIT-DATE                   CL110
01163 *    ELSE                                                            CL110
01164         MOVE ' '               TO  X425-AUTO-FILL                    CL*53
01165         MOVE 'FARGO'           TO  X425-AUTO-BATCH                   CL110
01166         MOVE 'RTN'             TO  X425-AUTO-ITEM                    CL110
01167         MOVE '* '              TO  X425-AUTO-REV.                    CL110
01168                                                                      CL*71
01169                                                                      CL*53
01170  P4000-EXIT.                                                         CL**7
01171       EXIT.                                                          CL**7
01172  P4100-PRINT-HEADER.                                                 CL**6
01173       IF WS-LINE-CNT > 58                                            CL*90
01174          ADD  +1          TO WS-PAGE-CNT                             CL**6
01175          MOVE WS-PAGE-CNT TO HEADER-3-PAGE                           CL*89
01176 *        MOVE   '  -/+   ----- MONTHLY COUNT' TO HEADER-5-NAME       CL*10
01177          MOVE FAC1-FILE-CREATE-DATE TO HEADER-3A-DATE                CL*10
01178          MOVE FAC1-FILE-CREATE-TIME TO HEADER-3A-TIME                CL*10
01179          WRITE ESSP-ACHD-REC FROM HEADER-1 AFTER TOP-OF-PAGE         CL*10
01180          WRITE ESSP-ACHD-REC FROM HEADER-2 AFTER 1                   CL*10
01181          WRITE ESSP-ACHD-REC FROM HEADER-3 AFTER 1                   CL*10
01182          WRITE ESSP-ACHD-REC FROM HEADER-3A AFTER 1                  CL*10
01183          WRITE ESSP-ACHD-REC FROM HEADER-4 AFTER 1                   CL*10
01184          WRITE ESSP-ACHD-REC FROM HEADER-5 AFTER 1                   CL*10
01185          WRITE ESSP-ACHD-REC FROM HEADER-6 AFTER 1                   CL*90
01186          MOVE +6    TO WS-LINE-CNT.                                  CL*90
01187  P4100-EXIT.                                                         CL**6
01188       EXIT.                                                          CL**6
01189                                                                      CL**6
01190  P4200-PRINT-HEADER.                                                 CL*90
01191       IF WS-RETN-CNT > 58                                            CL*90
01192          ADD  +1          TO WS-PAGE-CNT                             CL*90
01193          MOVE WS-PAGE-CNT TO HEADER-3-PAGE                           CL*90
01194 *        MOVE   '  -/+   ----- MONTHLY COUNT' TO HEADER-5-NAME       CL*90
01195          MOVE FAC1-FILE-CREATE-DATE TO HEADER-3A-DATE                CL*90
01196          MOVE FAC1-FILE-CREATE-TIME TO HEADER-3A-TIME                CL*90
01197          WRITE ESSP-ACHR-REC FROM HEADER-1 AFTER TOP-OF-PAGE         CL*90
01198          WRITE ESSP-ACHR-REC FROM HEADER-2 AFTER 1                   CL*90
01199          WRITE ESSP-ACHR-REC FROM HEADER-3 AFTER 1                   CL*90
01200          WRITE ESSP-ACHR-REC FROM HEADER-3A AFTER 1                  CL*90
01201          WRITE ESSP-ACHR-REC FROM HEADER-4 AFTER 1                   CL*90
01202          WRITE ESSP-ACHR-REC FROM HEADER-5 AFTER 1                   CL*90
01203          WRITE ESSP-ACHR-REC FROM HEADER-6 AFTER 1                   CL*90
01204          MOVE +6    TO WS-RETN-CNT.                                  CL*90
01205  P4200-EXIT.                                                         CL*90
01206       EXIT.                                                          CL*90
01207                                                                      CL*90
01208  P4300-PRNT-REVR.                                                    CL110
01209      MOVE FAC6-DUTAS-EMP-NO    TO  X425-EMP-NO                       CL110
01210      MOVE FAC6-DUTAS-EMP-NAME  TO  X425-NAME-CHECK.                  CL127
01211      MOVE FAC6-BANK-ACCT-NO    TO  X425-ACCT-NUMBER NTE-ACCT-NO      CL110
01212      MOVE FAC6-RECV-BANK-ID    TO  X425-BANK-ID.                     CL110
01213      MOVE WRK-MPAY-REMIT-AMT   TO  X425-X145-REMIT                   CL110
01214      MOVE WRK-TEMP-TRACE-NOA   TO  X425-X145-TRACE-NOB.              CL110
01215      MOVE WRK-TEMP-TRACE-NOA   TO  NTE-TRACE-NO.                     CL110
01216 *    MOVE SPACES               TO  X425-MESSAGE.                     CL119
01217      IF MPAY-FOUND-YES-88                                            CL110
01218         MOVE MPAY-BATCH-NO     TO  X425-AUTO-BATCH NTE-BATCH-NO      CL110
01219         MOVE MPAY-ITEM-NO      TO  X425-AUTO-ITEM  NTE-ITEM-NO       CL110
01220         MOVE '/'               TO  X425-AUTO-FILL                    CL110
01221         MOVE 'Y '              TO  X425-AUTO-REV                     CL110
01222         MOVE MPAY-DEPOSIT-DATE TO L001-FED-8-DATE-9                  CL110
01223         SET L001-FROM-FED-8    TO TRUE                               CL110
01224         PERFORM S001-DATE THRU S001-EXIT                             CL110
01225         MOVE L001-SLASH-8-DATE TO NTE-DEPOSIT-DATE                   CL110
01226      ELSE                                                            CL110
01227         MOVE ' '               TO  X425-AUTO-FILL                    CL110
01228         MOVE 'STAFF'           TO  X425-AUTO-BATCH                   CL110
01229         MOVE 'REV'             TO  X425-AUTO-ITEM                    CL110
01230         MOVE 'N '              TO  X425-AUTO-REV.                    CL110
01231                                                                      CL110
01232                                                                      CL110
01233  P4300-EXIT.                                                         CL110
01234       EXIT.                                                          CL110
01235  P5000-ACH-RETURN-CODE.                                              CL*45
01236         IF WRK-FAC7-RTN-CD = WRK-RTN-CD                              CL*83
01237            GO TO P5000-EXIT.                                         CL*45
01238                                                                      CL*45
01239      SET WRK-FAC7-RTN-INVALID-88 TO TRUE                             CL*46
01240                                                                      CL*45
01241      PERFORM VARYING ACH-RTN-IDX FROM 1 BY 1                         CL*45
01242         UNTIL WRK-FAC7-RTN-VALID-88                                  CL*46
01243            OR ACH-RTN-IDX             > ACH-RTN-CD-CNT               CL*45
01244            OR ACH-RTN-CD(ACH-RTN-IDX) = SPACE                        CL*45
01245              IF WRK-FAC7-RTN-CD =                                    CL*83
01246                      ACH-RTN-CD(ACH-RTN-IDX)                         CL*46
01247               SET  WRK-FAC7-RTN-VALID-88       TO TRUE               CL*46
01248               MOVE ACH-RTN-CD (ACH-RTN-IDX)  TO WRK-RTN-CD           CL*45
01249               MOVE ACH-RTN-VALUE(ACH-RTN-IDX) TO X425-MESSAGE        CL*57
01250               MOVE ACH-RTN-VALUE(ACH-RTN-IDX) TO NTE-REASON          CL*71
01251              END-IF                                                  CL*45
01252      END-PERFORM.                                                    CL*45
01253                                                                      CL*45
01254      IF WRK-FAC7-RTN-INVALID-88                                      CL*46
01255         MOVE '???????? INVALID RETURN CODE ' TO X425-MESSAGE         CL*57
01256         GO TO P5000-EXIT.                                            CL*45
01257  P5000-EXIT.                                                         CL*45
01258       EXIT.                                                          CL*45
01259                                                                      CL*45
01260  T0000-TERMINATE.                                                 DTSBX426
01261                                                                   DTSBX426
01262       IF NOT FACH-TYPE-TRAILER-88                                 DTSBX426
01263          DISPLAY ' LAST RECORD IS NOT A TRAILER RECORD '          DTSBX426
01264          DISPLAY '             '                                  DTSBX426
01265          DISPLAY ' LAST RECORD ' FACH-SKELETAL-REC                DTSBX426
01266          DISPLAY ' **** ACH FILE EMPTY *****'.                       CL*34
01267                                                                   DTSBX426
01268      IF  WRK-FACH-READ-CNT = 2                                    DTSBX426
01269          MOVE +3 TO RETURN-CODE                                      CL*32
01270          DISPLAY ' *** WELLS FARGO FILE CONTAINS 2 RECS '            CL**3
01271          DISPLAY ' ***  NO REJECTED PAYMENT RECORDS *'.           DTSBX426
01272                                                                   DTSBX426
01273                                                                   DTSBX426
01274 *    MOVE -1 TO F907-LENGTH.                                         CL**8
01275 *    CALL 'DTSBU946' USING F907-REC.                                 CL**8
01276                                                                   DTSBX426
01277                                                                   DTSBX426
01278                                                                   DTSBX426
01279      DISPLAY ' '.                                                 DTSBX426
01280                                                                   DTSBX426
01281      DISPLAY '*** DTSBX426 TERMINATION STATISTICS ***'.              CL*41
01282                                                                   DTSBX426
01283      DISPLAY ' '.                                                 DTSBX426
01284                                                                   DTSBX426
01285      DISPLAY 'NUMBER OF FACH RECORDS READ         :   '           DTSBX426
01286              WRK-FACH-READ-CNT.                                   DTSBX426
01287                                                                   DTSBX426
01288      DISPLAY 'NUMBER IN TRAILER BATCH COUNT       :   '           DTSBX426
01289               FAC9-BATCH-CNT.                                     DTSBX426
01290                                                                   DTSBX426
01291      DISPLAY 'HEADERS IN FACH FILE                :   '           DTSBX426
01292              WRK-HEADER-RECORDS.                                  DTSBX426
01293                                                                   DTSBX426
01294      DISPLAY 'TRAILERS IN FACH FILE               :   '           DTSBX426
01295              WRK-TRAILER-RECORDS.                                 DTSBX426
01296                                                                   DTSBX426
01297      DISPLAY 'DETAIL RECORDS IN FACH FILE         :   '           DTSBX426
01298              WRK-FAC6-RECORDS.                                    DTSBX426
01299                                                                   DTSBX426
01300      DISPLAY 'NUMBER OF OTHER RECORDS IN FACH FILE:   '           DTSBX426
01301              WRK-OTHER-RECORDS.                                   DTSBX426
01302                                                                   DTSBX426
01303      DISPLAY 'NUMBER OF T025 RECORDS WRITTEN      :   '           DTSBX426
01304              WRK-T025-WRITE-CNT.                                  DTSBX426
01305                                                                   DTSBX426
01306      DISPLAY 'NUMBER OF F907 RECORDS WRITTEN      :   '           DTSBX426
01307              WRK-F907-WRITE-CNT.                                  DTSBX426
01308 *    IF  WRK-F907-WRITE-CNT > 0                                      CL*24
01309 *        MOVE +3 TO RETURN-CODE                                      CL*24
01310 *        DISPLAY ' FACH INPUT FILE CONTAINS ERRORS+++'               CL*24
01311 *        DISPLAY ' PROGRAM WILL ABEND ***************'.              CL*24
01312 *        PERFORM S999-ABEND THRU S999-EXIT.                       DTSBX426
01313                                                                   DTSBX426
01314      IF WS-LINE-CNT  > 52 OR RETURN-CODE = +3                        CL*32
01315         PERFORM P4100-PRINT-HEADER THRU P4100-EXIT                   CL*24
01316         WRITE ESSP-ACHD-REC FROM DETAIL-LINE-1  AFTER 1              CL*32
01317         WRITE ESSP-ACHD-REC FROM DETAIL-LINE-2  AFTER 3              CL*36
01318      END-IF.                                                         CL*24
01319                                                                      CL114
01320      MOVE WRK-FAC6-RECORDS  TO WS-FOOTING-CNT.                       CL*24
01321      MOVE TOT-FAC6-AMOUNT       TO WS-TOTAL-REMIT.                   CL*24
01322      WRITE ESSP-ACHD-REC FROM FOOTING-LINE-1 AFTER 1.                CL*25
01323      WRITE ESSP-ACHD-REC FROM FOOTING-LINE-2 AFTER 1.                CL*25
01324      WRITE ESSP-ACHD-REC FROM FOOTING-LINE-3 AFTER 1.                CL*25
01325 *    WRITE ESSP-ACHD-REC FROM FOOTING-LINE-4 AFTER 1.                CL*25
01326 *    WRITE REPT-PAID-REC FROM FOOTING-LINE-5 AFTER 1.                CL*25
01327 *    WRITE REPT-PAID-REC FROM FOOTING-LINE-6 AFTER 1.                CL*24
01328 *    WRITE ESSP-ACHD-REC FROM FOOTING-LINE-7  AFTER 1.               CL*25
01329      WRITE ESSP-ACHD-REC FROM FOOTING-LINE-8  AFTER 1.               CL*25
01330 *    WRITE ESSP-ACHD-REC FROM FOOTING-LINE-13 AFTER 3.               CL117
01331      WRITE ESSP-ACHD-REC FROM FOOTING-LINE-14 AFTER 1.               CL*25
01332                                                                      CL*24
01333      DISPLAY ' '.                                                    CL*24
01334                                                                   DTSBX426
01335      MOVE WRK-FAC6-RECORDS      TO WS-FOOTING-CNT.                   CL114
01336      MOVE WS-FAC7-PEN-CNT       TO WS-X145-ERR-CNT WS-X145-PEN-CNT   CL114
01337      MOVE TOT-MPAY-AMOUNT       TO WS-TOT-REMIT.                     CL114
01338      MOVE WRK-T025-WRITE-CNT    TO   WS-T025-WRITE-CNT.              CL115
01339      WRITE ESSP-ACHD-REC FROM FOOTING-LINE-1 AFTER 1.                CL*88
01340      WRITE ESSP-ACHD-REC FROM FOOTDTS-LINE-2 AFTER 1.                CL117
01341 *    WRITE ESSP-ACHD-REC FROM FOOTING-LINE-3 AFTER 1.                CL114
01342      WRITE ESSP-ACHD-REC FROM FOOTING-LINE-4 AFTER 1.                CL114
01343      WRITE ESSP-ACHD-REC FROM FOOTING-LINE-5 AFTER 1.                CL116
01344      WRITE ESSP-ACHD-REC FROM FOOTING-LINE-6 AFTER 1.                CL116
01345      WRITE ESSP-ACHD-REC FROM FOOTING-LINE-7  AFTER 1.               CL114
01346 *    WRITE ESSP-ACHD-REC FROM FOOTING-LINE-8  AFTER 1.               CL114
01347      WRITE ESSP-ACHD-REC FROM FOOTING-LINE-13 AFTER 3.               CL*88
01348      WRITE ESSP-ACHD-REC FROM FOOTING-LINE-14 AFTER 1.               CL*88
01349                                                                      CL*88
01350      IF RETURN-CODE NOT = +3                                         CL114
01351         WRITE ESSP-ACHD-REC FROM ZNOTE1         AFTER 2              CL114
01352         WRITE ESSP-ACHD-REC FROM CNOTE1         AFTER 1              CL114
01353         WRITE ESSP-ACHD-REC FROM CNOTE2         AFTER 1              CL114
01354         WRITE ESSP-ACHD-REC FROM CNOTE3         AFTER 1              CL114
01355      END-IF.                                                         CL114
01356                                                                      CL*58
01357                                                                      CL*29
01358      CLOSE IN-FACH ESSP-ACHD-FILE PEND-FACH-FILE                     CL*86
01359            ESSP-ACHR-FILE.                                           CL*86
01360      PERFORM S910-CLOSE THRU S910-EXIT.                              CL*29
01361      PERFORM S927-CLOSE THRU S927-EXIT.                              CL*29
01362                                                                      CL*29
01363                                                                      CL*29
01364                                                                   DTSBX426
01365  T0000-EXIT.                                                      DTSBX426
01366      EXIT.                                                        DTSBX426
01367                                                                   DTSBX426
01368  P1070-READ-MPRF.                                                 DTSBX426
01369                                                                   DTSBX426
01370                                                                   DTSBX426
01371      MOVE LOW-VALUE TO MPRF-KEY-AREA.                             DTSBX426
01372      SET MPRF-PRF-88 TO TRUE.                                     DTSBX426
01373      DISPLAY ' FAC6EMP ' FAC6-DUTAS-EMP-NO.                          CL130
01374      DISPLAY ' MPAYEMP ' MPAY-EMP-NO.                                CL131
01375      MOVE MPAY-EMP-NO TO MPRF-EMP-NO.                                CL131
01376      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSBX426
01377                                                                   DTSBX426
01378      PERFORM S910-READ THRU S910-EXIT.                            DTSBX426
01379                                                                   DTSBX426
01380      IF L910-OK-88                                                DTSBX426
01381          SET L910-OK-88  TO TRUE                                  DTSBX426
01382          MOVE MSKL-REC TO MPRF-REC                                DTSBX426
01383      ELSE                                                         DTSBX426
01384         DISPLAY '********NO MPRF-REC FOUND ' L910-RESULT-IND         CL131
01385         SET L910-NO-REC-88 TO TRUE                                DTSBX426
01386         DISPLAY '6090 L910 NO RECORD FOUND '                      DTSBX426
01387         PERFORM P1055-WRITE-F907   THRU P1055-EXIT                DTSBX426
01388         GO TO P1070-EXIT.                                         DTSBX426
01389                                                                   DTSBX426
01390      MOVE MPRF-PRIMARY-NAME TO T025-NAME-CHECK                       CL127
01391                                WS-FAC6-DUTAS-EMP-NAME.               CL129
01392      DISPLAY ' EMP ' MPRF-PRIMARY-NAME  ' ' MPRF-EMP-NO              CL129
01393      DISPLAY ' T25 ' T025-NAME-CHECK  ' ' MPRF-EMP-NO                CL129
01394      MOVE WS-FAC6-DUTAS-EMP-NAMEA  TO FAC6-DUTAS-EMP-NAME.           CL129
01395  P1070-EXIT.                                                      DTSBX426
01396      EXIT.                                                        DTSBX426
01397                                                                   DTSBX426
01398  S3000-INIT-T003.                                                    CL*70
01399      MOVE LOW-VALUES              TO MNTE-KEY-AREA.                  CL*70
01400      MOVE MPAY-EMP-NO             TO MNTE-EMP-NO.                    CL*70
01401      SET MNTE-NTE-88              TO TRUE.                           CL*70
01402      MOVE +0                      TO MNTE-PURGE-DATE.                CL*70
01403      SET MNTE-NOT-CONVERTED-88    TO TRUE.                           CL*70
01404                                                                      CL*70
01405      MOVE L005-DATE               TO MNTE-ESTB-DATE                  CL*72
01406                                      MNTE-CHNG-DATE.                 CL*70
01407      MOVE ZERO                    TO MNTE-KEY-ESTB-ABSTIME           CL*70
01408                                      MNTE-DATA-ESTB-ABSTIME          CL*70
01409                                      MNTE-CHNG-ABSTIME.              CL*70
01410      MOVE 'WEBESSP '              TO MNTE-ESTB-OP-ID                 CL*70
01411                                      MNTE-CHNG-OP-ID.                CL*70
01412      MOVE +0                      TO MNTE-TEXT-CNT.                  CL*70
01413      MOVE SPACES                  TO MNTE-TEXT-AREA.                 CL*70
01414                                                                      CL*70
01415      MOVE LENGTH OF T003-REC        TO T003-LENGTH                   CL*70
01416      MOVE '003'                     TO T003-REC-TYPE.                CL*70
01417      MOVE LENGTH OF T003-REC        TO T003-LENGTH                   CL*70
01418      MOVE '003'                     TO T003-REC-TYPE.                CL*70
01419      MOVE MPAY-EMP-NO               TO T003-EMP-NO.                  CL*70
01420      MOVE 'WEB PAY '                TO T003-ORIGIN.                  CL*70
01421      MOVE L005-DATE                 TO T003-SYS-DATE.                CL*72
01422      MOVE L005-TIME                 TO T003-SYS-TIME.                CL*72
01423      SET T003-ADD-MNTE-88           TO TRUE.                         CL*70
01424                                                                      CL*70
01425  S3000-EXIT.                                                         CL*70
01426      EXIT.                                                           CL*70
01427                                                                      CL*70
01428                                                                   DTSBX426
01429  S001-FROM-FED-8.                                                    CL*71
01430      SET L001-FROM-FED-8 TO TRUE.                                    CL*71
01431      GO TO S001-DATE.                                                CL*71
01432                                                                      CL*71
01433  S001-DATE.                                                          CL*71
01434      SKIP1                                                           CL*71
01435      CALL 'DTSBU001' USING L001-LINK-AREA.                           CL*71
01436  S001-EXIT.                                                          CL*71
01437      EXIT.                                                           CL*71
01438  S005-FROM-SYS.                                                      CL*71
01439                                                                   DTSBX426
01440      SET L005-FROM-SYS TO TRUE.                                   DTSBX426
01441      GO TO S005-ABSTIME.                                          DTSBX426
01442                                                                   DTSBX426
01443  S005-ABSTIME.                                                    DTSBX426
01444                                                                   DTSBX426
01445      CALL 'DTSBU005' USING L005-LINK-AREA.                        DTSBX426
01446                                                                   DTSBX426
01447  S005-EXIT.                                                       DTSBX426
01448      EXIT.                                                        DTSBX426
01449                                                                   DTSBX426
01450                                                                   DTSBX426
01451  S910-OPEN-UPDATE-NO-AIX.                                         DTSBX426
01452      SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE.                      DTSBX426
01453      GO TO S910-MSTR-IO.                                          DTSBX426
01454                                                                   DTSBX426
01455      EJECT                                                        DTSBX426
01456  S910-OPEN-READ.                                                  DTSBX426
01457      SET L910-OPEN-READ-88 TO TRUE.                               DTSBX426
01458      GO TO S910-MSTR-IO.                                          DTSBX426
01459                                                                   DTSBX426
01460  S910-READ.                                                       DTSBX426
01461      SET L910-READ-88 TO TRUE.                                    DTSBX426
01462      GO TO S910-MSTR-IO.                                          DTSBX426
01463                                                                   DTSBX426
01464  S910-DELETE.                                                     DTSBX426
01465      SET L910-DELETE-88 TO TRUE.                                  DTSBX426
01466      GO TO S910-MSTR-IO.                                          DTSBX426
01467                                                                   DTSBX426
01468  S910-WRITE.                                                      DTSBX426
01469      SET L910-WRITE-88 TO TRUE.                                   DTSBX426
01470      GO TO S910-MSTR-IO.                                          DTSBX426
01471                                                                   DTSBX426
01472  S910-START-BROWSE.                                               DTSBX426
01473      SET L910-START-BROWSE-88 TO TRUE.                            DTSBX426
01474      GO TO S910-MSTR-IO.                                          DTSBX426
01475                                                                   DTSBX426
01476  S910-READ-NEXT.                                                  DTSBX426
01477      SET L910-READ-NEXT-88 TO TRUE.                               DTSBX426
01478      GO TO S910-MSTR-IO.                                          DTSBX426
01479                                                                   DTSBX426
01480  S910-REWRITE.                                                    DTSBX426
01481      SET L910-REWRITE-88 TO TRUE.                                 DTSBX426
01482      GO TO S910-MSTR-IO.                                          DTSBX426
01483                                                                   DTSBX426
01484  S910-CLOSE.                                                      DTSBX426
01485      SET L910-CLOSE-88     TO TRUE.                               DTSBX426
01486      GO TO S910-MSTR-IO.                                          DTSBX426
01487                                                                   DTSBX426
01488  S910-MSTR-IO.                                                    DTSBX426
01489      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBX426
01490                            MSKL-REC.                              DTSBX426
01491  S910-EXIT.                                                       DTSBX426
01492      EXIT.                                                        DTSBX426
01493                                                                   DTSBX426
01494      SKIP3                                                        DTSBX426
01495  S921-OPEN-READ.                                                  DTSBX426
01496      SET L921-OPEN-READ-88 TO TRUE.                               DTSBX426
01497      GO TO S921-AIX-IO.                                           DTSBX426
01498                                                                   DTSBX426
01499  S921-READ.                                                       DTSBX426
01500      SET L921-READ-88 TO TRUE.                                    DTSBX426
01501      GO TO S921-AIX-IO.                                           DTSBX426
01502                                                                   DTSBX426
01503  S921-START-BROWSE.                                               DTSBX426
01504      SET L921-START-BROWSE-88 TO TRUE.                            DTSBX426
01505      GO TO S921-AIX-IO.                                           DTSBX426
01506                                                                   DTSBX426
01507  S921-READ-NEXT.                                                  DTSBX426
01508      SET L921-READ-NEXT-88 TO TRUE.                               DTSBX426
01509      GO TO S921-AIX-IO.                                           DTSBX426
01510                                                                   DTSBX426
01511  S921-CLOSE.                                                      DTSBX426
01512      SET L921-CLOSE-88 TO TRUE.                                   DTSBX426
01513      GO TO S921-AIX-IO.                                           DTSBX426
01514                                                                   DTSBX426
01515  S921-AIX-IO.                                                     DTSBX426
01516      CALL 'DTSBU921' USING L921-LINK-AREA                         DTSBX426
01517                            ISKL-REC.                              DTSBX426
01518  S921-EXIT.                                                       DTSBX426
01519      EXIT.                                                        DTSBX426
01520                                                                   DTSBX426
01521  S927-OPEN-UPDATE.                                                DTSBX426
01522      SET L927-OPEN-UPDATE-88 TO TRUE.                             DTSBX426
01523      GO TO S927-BTC-O.                                            DTSBX426
01524                                                                   DTSBX426
01525  S927-WRITE.                                                      DTSBX426
01526      SET L927-WRITE-88 TO TRUE.                                   DTSBX426
01527      GO TO S927-BTC-O.                                            DTSBX426
01528                                                                   DTSBX426
01529  S927-CLOSE.                                                      DTSBX426
01530      SET L927-CLOSE-88 TO TRUE.                                   DTSBX426
01531      GO TO S927-BTC-O.                                            DTSBX426
01532                                                                   DTSBX426
01533  S927-BTC-O.                                                      DTSBX426
01534      CALL 'DTSBU927' USING L927-LINK-AREA                         DTSBX426
01535                           TSKL-REC.                               DTSBX426
01536  S927-EXIT.                                                       DTSBX426
01537       EXIT.                                                       DTSBX426
01538                                                                   DTSBX426
01539      EJECT                                                        DTSBX426
01540  S999-ABEND.                                                      DTSBX426
01541      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBX426
01542  S999-EXIT.                                                       DTSBX426
01543      EXIT.                                                        DTSBX426
