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