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