00001  IDENTIFICATION DIVISION.                                         01/22/04
00002  PROGRAM-ID.             EFTBD350.                                EFTBD350
00003  AUTHOR.                 TRW, INC.                                   LV216
00004  DATE-WRITTEN.           APRIL 2003.                                 CL**7
00005  DATE-COMPILED.                                                      CL**1
00006      SKIP3                                                           CL**1
00007 *****                                                                CL**1
00008 *    FUNCTION: READ A DAILY FILE FROM THE AUTOMATED CLEARING HOUSE   CL*81
00009 *              THAT CONTAINS RECORDS FOR DISHONORED ELECTRONIC       CL*81
00010 *              PAYMENTS.  IT BUILDS DTSIT025 PAYMENT REVERSAL        CL*81
00011 *              TRANSACTION RECORDS AND WRITES THESE RECORDS          CL*81
00012 *              TO THE DAILY BTC FILE WHICH IS INPUT TO THE NIGHTLY   CL*84
00013 *              ACCOUNTING UPDATE.                                    CL*81
00014 **                                                                   CL**2
00015 **                                                                   CL**2
00016      SKIP3                                                           CL**1
00017  ENVIRONMENT DIVISION.                                               CL**1
00018      SKIP2                                                           CL**1
00019  INPUT-OUTPUT SECTION.                                               CL**1
00020                                                                      CL**1
00021  FILE-CONTROL.                                                       CL**1
00022                                                                      CL*42
00023      SELECT IN-FACH    ASSIGN TO EFTFACH                             CL*44
00024                              FILE STATUS IS FACH-STATUS.             CL*41
00025                                                                      CL180
00026  DATA DIVISION.                                                      CL**1
00027                                                                      CL180
00028  FILE SECTION.                                                       CL**1
00029                                                                      CL158
00030  FD  IN-FACH                                                         CL110
00031      LABEL RECORDS ARE STANDARD                                      CL115
00032      RECORDING MODE IS F                                             CL115
00033      BLOCK CONTAINS 0 RECORDS.                                       CL124
00034                                                                      CL**1
00035  01  IN-FACH-REC                    PIC  X(94).                      CL115
00036                                                                      CL174
00037                                                                      CL**2
00038                                                                      CL*40
00039  WORKING-STORAGE SECTION.                                            CL**1
000395 77  PAN-VALET PICTURE X(24) VALUE '216EFTBD350  01/22/04'.          CL**1
00040                                                                      CL157
00041  01  WRK-AREA.                                                       CL**1
00042                                                                      CL*21
00043      05  WRK-F907-REC-CNT            PIC S9(07)  COMP-3 VALUE +0.    CL**2
00044                                                                      CL**2
00045      05  FACH-STATUS                 PIC  X(02).                     CL*43
00046          88 FACH-STATUS-OK-88          VALUE '00'.                   CL*43
00047                                                                      CL*43
00048      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +50.    CL*11
00049                                                                      CL**1
00050      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'EFTBD350'.   CL*16
00051                                                                      CL**1
00052      05  WRK-MPAY-REMIT-AMT          PIC  S9(09)V9(02) COMP-3.       CL111
00053                                                                      CL*38
00054      05  WRK-CURR-DATE               PIC S9(15)  COMP-3.             CL113
00055      05  WRK-CURR-TIME               PIC S9(09)  COMP-3.             CL113
00056                                                                      CL113
00057      05  WRK-MPRF-READ-CNT           PIC S9(07)  COMP-3.             CL113
00058      05  WRK-FAC6-RECORDS            PIC S9(07)  COMP-3.             CL151
00059      05  WRK-OTHER-RECORDS           PIC S9(07)  COMP-3.             CL151
00060      05  WRK-HEADER-RECORDS          PIC S9(07)  COMP-3.             CL156
00061      05  WRK-TRAILER-RECORDS         PIC S9(07)  COMP-3.             CL156
00062      05  WRK-T025-WRITE-CNT          PIC S9(07)  COMP-3.             CL*89
00063      05  WRK-R907-WRITE-CNT          PIC S9(07)  COMP-3.             CL*47
00064      05  WRK-F907-WRITE-CNT          PIC S9(07)  COMP-3.             CL**5
00065      05  WRK-FACH-READ-CNT           PIC S9(07)  COMP-3.             CL*19
00066      05  WRK-TRAILER-REC-CNT         PIC S9(07)  COMP-3.             CL108
00067      05  WRK-FACH-SELECTED-CNT       PIC S9(07)  COMP-3.             CL*17
00068      05  WRK-FAC6-AMOUNT             PIC S9(08)V99  COMP-3.          CL*94
00069      05  TOT-FAC6-AMOUNT             PIC S9(10)V99  COMP-3.          CL216
00070      05  TOT-TRAILER-AMT             PIC S9(10)V99  COMP-3.          CL216
00071                                                                      CL**1
00072      05  WRK-DOES-TRACE-NO.                                          CL195
00073          10  WRK-DOES-TRACE-NOA      PIC X(05) VALUE ZEROS.          CL198
00074          10  WRK-DOES-TRACE-NOB      PIC X(08) VALUE ZEROS.          CL198
00075                                                                      CL199
00076      05  WRK-TEMP-TRACE-NO.                                          CL200
00077          10  WRK-TEMP-TRACE-NOA      PIC 9(05) VALUE ZEROS.          CL198
00078          10  WRK-TEMP-TRACE-NOB      PIC 9(08) VALUE ZEROS.          CL198
00079                                                                      CL199
00080      05  WRK-NUMR-TRACE-NO REDEFINES WRK-TEMP-TRACE-NO               CL207
00081                                      PIC 9(13).                      CL208
00082                                                                      CL207
00083      05  WRK-FAC6-DOES-TRACE-NO      PIC S9(13) COMP-3.              CL199
00084                                                                      CL178
00085      05  WRK-MPRF-IND                PIC  X(01).                     CL**1
00086          88 WRK-MPRF-OK           VALUE 'Y'.                         CL**1
00087          88 WRK-MPRF-NO-REC       VALUE 'N'.                         CL**1
00088                                                                      CL**1
00089      05  WRK-MPAY-IND                PIC  X(01).                     CL184
00090          88 MPAY-FOUND-YES-88     VALUE 'Y'.                         CL184
00091          88 MPAY-FOUND-NO-88      VALUE 'N'.                         CL184
00092                                                                      CL184
00093      05  WRITE-T025-IND              PIC  X(01).                     CL184
00094          88 WRITE-T025-YES-88     VALUE 'Y'.                         CL184
00095          88 WRITE-T025-NO-88      VALUE 'N'.                         CL184
00096                                                                      CL184
00097      05  WRK-DTSBU005-IND            PIC  X(01).                     CL*37
00098          88 WRK-DTSBU005-YES      VALUE 'Y'.                         CL*37
00099          88 WRK-DTSBU005-NO       VALUE 'N'.                         CL*37
00100                                                                      CL*37
00101      05  WRK-FAC1-IND                PIC  X(01).                     CL*19
00102          88 WRK-FAC1-FIRST-OK     VALUE 'Y'.                         CL*21
00103          88 WRK-FAC1-FIRST-NO     VALUE 'N'.                         CL207
00104                                                                      CL207
00105      05  WRK-FACH-IND                PIC  X(01).                     CL*19
00106          88 WRK-FACH-LAST-REC-88  VALUE 'Y'.                         CL*29
00107                                                                      CL*17
00108      05  WRK-TRACE-IND                   PIC  X(01).                 CL**1
00109                                                                      CL**1
00110  01  MSG-TABLE.                                                      CL*44
00111                                                                      CL157
00112      05  MSG1-NO-MPAY.                                               CL*44
00113          10  MSG1-ID.                                                CL*44
00114              15  MSG1-ID-A   PIC  X(08)  VALUE 'EFTBD350'.           CL*44
00115              15  MSG1-ID-B   PIC  X(03)  VALUE '907'.                CL*44
00116          10  MSG1-SHORT-TEXT PIC  X(20) VALUE 'FAC6 WITH NO MPRF'.   CL*44
00117          10  MSG1-LONG-TEXT.                                         CL*44
00118              15  FILLER      PIC  X(30)                              CL*44
00119                    VALUE 'FAC6 RECORD ENCOUNTERED WITH N'.           CL*44
00120              15  FILLER      PIC  X(30)                              CL*44
00121                    VALUE 'O CORRESPONDING MPAY RECORD   '.           CL*44
00122                                                                      CL*44
00123  01  FACH-LINK-REC.                                                  CL173
00124  ++INCLUDE EFTIFACH                                                  CL139
00125      EJECT                                                           CL*34
00126  01  FAC1-LINK-REC.                                                  CL169
00127  ++INCLUDE EFTIFAC1                                                  CL139
00128      EJECT                                                           CL**9
00129  01  FAC6-LINK-REC.                                                  CL169
00130  ++INCLUDE EFTIFAC6                                                  CL139
00131      EJECT                                                           CL**8
00132  01  FAC9-LINK-REC.                                                  CL169
00133  ++INCLUDE EFTIFAC9                                                  CL139
00134      EJECT                                                           CL**8
00135  01  MPAY-REC.                                                       CL*98
00136  ++INCLUDE DTSIMPAY                                                  CL142
00137      EJECT                                                           CL*98
00138  01  L005-LINK-AREA.                                                 CL*98
00139  ++INCLUDE DTSIL005                                                  CL*98
00140      EJECT                                                           CL*92
00141  01  RSK1-REC.                                                       CL*92
00142  ++INCLUDE DTSIRSK1                                                  CL*92
00143      EJECT                                                           CL*69
00144  01  ITRT-REC.                                                       CL*70
00145  ++INCLUDE DTSIITRT                                                  CL140
00146      EJECT                                                           CL*70
00147  01  ISKL-REC.                                                       CL*70
00148  ++INCLUDE DTSIISKL                                                  CL140
00149      EJECT                                                           CL*66
00150  01  R907-REC.                                                       CL234
00151  ++INCLUDE DTSIR907                                                  CL234
00152      EJECT                                                           CL221
00153  01  EFT-BATCH-ERRORS-MESS.                                          CL234
00154  ++INCLUDE EFTERMSG                                                  CL234
00155      EJECT                                                           CL234
00156  01  F907-REC.                                                       CL235
00157  ++INCLUDE EFTIF907                                                  CL235
00158      EJECT                                                           CL221
00159  01  T025-REC.                                                       CL*73
00160  ++INCLUDE DTSIT025                                                  CL139
00161      EJECT                                                           CL**1
00162  01  L910-LINK-AREA.                                                 CL**1
00163  ++INCLUDE DTSIL910                                                  CL**1
00164      EJECT                                                           CL**1
00165  01  L921-LINK-AREA.                                                 CL*52
00166  ++INCLUDE DTSIL921                                                  CL*52
00167      EJECT                                                           CL189
00168  01  L927-LINK-AREA.                                                 CL189
00169  ++INCLUDE DTSIL927                                                  CL189
00170      EJECT                                                           CL*52
00171  01  MSKL-REC.                                                       CL**1
00172  ++INCLUDE DTSIMSKL                                                  CL**1
00173      EJECT                                                           CL189
00174  01  TSKL-REC.                                                       CL189
00175  ++INCLUDE DTSITSKL                                                  CL189
00176      EJECT                                                           CL**1
00177  01  MPRF-REC.                                                       CL**1
00178  ++INCLUDE DTSIMPRF                                                  CL139
00179      EJECT                                                           CL**1
00180  01  MTAD-REC.                                                       CL**1
00181  ++INCLUDE DTSIMTAD                                                  CL**1
00182                                                                      CL156
00183  PROCEDURE DIVISION.                                                 CL**1
00184                                                                      CL156
00185      PERFORM I0000-INITIATE THRU I0000-EXIT.                         CL**1
00186                                                                      CL**1
00187      PERFORM P0000-PROCESS THRU P0000-EXIT UNTIL                     CL183
00188              WRK-FACH-IND = 'Y'.                                     CL183
00189                                                                      CL183
00190      PERFORM T0000-TERMINATE THRU T0000-EXIT.                        CL**1
00191                                                                      CL156
00192      GOBACK.                                                         CL**1
00193                                                                      CL156
00194  I0000-INITIATE.                                                     CL**1
00195                                                                      CL*48
00196      MOVE +0 TO WRK-FACH-READ-CNT                                    CL*48
00197                 WRK-MPAY-REMIT-AMT                                   CL*39
00198                 WRK-FACH-SELECTED-CNT                                CL*89
00199                 WRK-R907-WRITE-CNT                                   CL114
00200                 WRK-OTHER-RECORDS                                    CL145
00201                 WRK-FAC6-RECORDS                                     CL151
00202                 WRK-HEADER-RECORDS                                   CL156
00203                 WRK-TRAILER-RECORDS                                  CL156
00204                 WRK-F907-WRITE-CNT                                   CL*48
00205                 WRK-T025-WRITE-CNT                                   CL*80
00206                 WRK-TRAILER-REC-CNT                                  CL108
00207                 WRK-FAC6-AMOUNT                                      CL*80
00208                 TOT-FAC6-AMOUNT                                      CL216
00209                 TOT-TRAILER-AMT                                      CL216
00210                 WRK-FAC6-DOES-TRACE-NO.                              CL191
00211                                                                      CL*49
00212      MOVE ZEROS TO FAC1-LINK-REC                                     CL169
00213                    FAC6-LINK-REC                                     CL169
00214                    FAC9-LINK-REC.                                    CL169
00215                                                                      CL150
00216      MOVE 'N' TO WRK-TRACE-IND, WRK-FACH-IND.                        CL*23
00217                                                                      CL155
00218      MOVE 'Y' TO WRK-FAC1-IND, WRK-DTSBU005-IND.                     CL154
00219                                                                      CL**1
00220      PERFORM I2000-OPEN-FILES          THRU I2000-EXIT.              CL**1
00221                                                                      CL**1
00222  I0000-EXIT.                                                         CL**1
00223      EXIT.                                                           CL**1
00224  I2000-OPEN-FILES.                                                   CL**1
00225                                                                      CL195
00226      MOVE LENGTH OF T025-REC TO T025-LENGTH.                         CL189
00227      MOVE LENGTH OF F907-REC TO F907-LENGTH.                         CL*71
00228                                                                      CL148
00229      MOVE WRK-TRACE-IND TO L910-TRACE-IND, L921-TRACE-IND.           CL*34
00230                                                                      CL**1
00231      MOVE WRK-MOD-NAME TO L910-MOD-NAME, L921-MOD-NAME               CL193
00232                                                                      CL**7
00233      PERFORM S910-OPEN-READ THRU S910-EXIT.                          CL**1
00234                                                                      CL*34
00235      PERFORM S921-OPEN-READ THRU S921-EXIT.                          CL*34
00236                                                                      CL189
00237      MOVE 'N' TO L927-TRACE-IND.                                     CL191
00238      MOVE WRK-MOD-NAME TO L927-MOD-NAME.                             CL191
00239      PERFORM S927-OPEN-UPDATE THRU S927-EXIT.                        CL191
00240                                                                      CL189
00241                                                                      CL148
00242      OPEN INPUT IN-FACH.                                             CL*40
00243                                                                      CL**3
00244      IF FACH-STATUS-OK-88                                            CL*40
00245         NEXT SENTENCE                                                CL*40
00246      ELSE                                                            CL*40
00247         DISPLAY 'OPEN ERROR ON FACH INPUT FILE ** ' FACH-STATUS      CL*45
00248         PERFORM S999-ABEND THRU S999-EXIT.                           CL*40
00249                                                                      CL*40
00250  I2000-EXIT.                                                         CL**1
00251      EXIT.                                                           CL**1
00252                                                                      CL156
00253  P0000-PROCESS.                                                      CL**1
00254       DISPLAY ' 1000 - PROCESS'.                                     CL187
00255                                                                      CL**1
00256       READ IN-FACH INTO FACH-LINK-REC                                CL183
00257          AT END                                                      CL183
00258          MOVE 'Y' TO WRK-FACH-IND                                    CL183
00259         GO TO P0000-EXIT.                                            CL183
00260                                                                      CL183
00261       ADD +1 TO WRK-FACH-READ-CNT.                                   CL183
00262      MOVE ZEROS TO FAC6-HEADER-REC.                                  CL183
00263                                                                      CL183
00264      IF FACH-TYPE-HEADER-88                                          CL183
00265         MOVE FACH-LINK-REC TO FAC1-LINK-REC                          CL183
00266         ADD 1 TO WRK-HEADER-RECORDS                                  CL183
00267         PERFORM P1005-HEADER-EDIT THRU P1005-EXIT                    CL185
00268      ELSE                                                            CL183
00269      IF FACH-TYPE-ENTRY-DETAIL-88                                    CL183
00270         MOVE FACH-LINK-REC TO FAC6-LINK-REC                          CL183
00271         ADD 1 TO WRK-FAC6-RECORDS                                    CL183
00272         PERFORM P1010-FAC6-EDIT THRU P1010-EXIT                      CL183
00273      ELSE                                                            CL183
00274      IF FACH-TYPE-TRAILER-88                                         CL183
00275         MOVE FACH-LINK-REC TO FAC9-LINK-REC                          CL183
00276         ADD 1 TO WRK-TRAILER-RECORDS                                 CL183
00277         ADD 1 TO WRK-TRAILER-REC-CNT                                 CL183
00278         PERFORM P1015-TRAILER-EDIT THRU P1015-EXIT                   CL183
00279      ELSE                                                            CL183
00280         ADD 1 TO WRK-OTHER-RECORDS                                   CL183
00281         GO TO P0000-EXIT.                                            CL183
00282                                                                      CL183
00283  P0000-EXIT.                                                         CL183
00284      EXIT.                                                           CL183
00285                                                                      CL**1
00286                                                                      CL**1
00287  P1005-HEADER-EDIT.                                                  CL186
00288                                                                      CL183
00289       DISPLAY ' 1005 - PROCESS'.                                     CL187
00290      IF WRK-FACH-READ-CNT NOT = 1                                    CL183
00291         MOVE 'Y' TO WRK-FACH-IND                                     CL183
00292         DISPLAY ' FIRST RECORD OF FILE IS NOT A HEADER RECORD'       CL183
00293         PERFORM S999-ABEND THRU S999-EXIT.                           CL183
00294                                                                      CL183
00295  P1005-EXIT.                                                         CL183
00296      EXIT.                                                           CL183
00297                                                                      CL*21
00298  P1010-FAC6-EDIT.                                                    CL*27
00299                                                                      CL*27
00300       SET WRITE-T025-NO-88 TO TRUE.                                  CL212
00301       SET MPAY-FOUND-NO-88 TO TRUE.                                  CL212
00302       DISPLAY ' 1010 - AMOUNT  '  FAC6-AMOUNT                        CL202
00303       DISPLAY ' 1010 - TRACEIN '  FAC6-DOES-TRACE-NO                 CL202
00304      MOVE ZEROS              TO  WRK-TEMP-TRACE-NO                   CL206
00305                                  WRK-FAC6-DOES-TRACE-NO              CL206
00306                                  WRK-DOES-TRACE-NO.                  CL206
00307      MOVE FAC6-AMOUNT        TO  WRK-FAC6-AMOUNT.                    CL183
00308      MOVE FAC6-DOES-TRACE-NO TO  WRK-DOES-TRACE-NO.                  CL198
00309                                                                      CL174
00310      MOVE ZEROS              TO  WRK-TEMP-TRACE-NOA.                 CL200
00311      MOVE WRK-DOES-TRACE-NOB TO  WRK-TEMP-TRACE-NOB.                 CL200
00312      MOVE WRK-NUMR-TRACE-NO  TO  WRK-FAC6-DOES-TRACE-NO.             CL207
00313                                                                      CL197
00314      DISPLAY  'TRACE-NO -TEMP  ' WRK-TEMP-TRACE-NO                   CL202
00315      DISPLAY  'TRACE-WRK-FAC6  ' WRK-FAC6-DOES-TRACE-NO              CL202
00316                                                                      CL191
00317      IF FAC6-AMOUNT = ZEROS                                          CL183
00318         MOVE EFT027 TO F907-MSG-TEXT                                 CL191
00319         MOVE '027' TO F907-MSG-ID                                    CL191
00320         MOVE ZEROS TO F907-EMP-NO                                    CL183
00321         MOVE FAC6-AMOUNT TO F907-GOV1-REC                            CL191
00322         PERFORM P1055-WRITE-F907     THRU P1055-EXIT                 CL183
00323         GO TO P1010-EXIT.                                            CL183
00324                                                                      CL183
00325      IF FAC6-AMOUNT NOT NUMERIC                                      CL183
00326         MOVE EFT028 TO F907-MSG-TEXT                                 CL191
00327         MOVE '028' TO F907-MSG-ID                                    CL191
00328         MOVE ZEROS TO F907-EMP-NO                                    CL183
00329         MOVE WRK-FAC6-AMOUNT TO F907-GOV1-REC                        CL183
00330         PERFORM P1055-WRITE-F907     THRU P1055-EXIT                 CL183
00331         GO TO P1010-EXIT.                                            CL183
00332                                                                      CL216
00333      ADD WRK-FAC6-AMOUNT TO TOT-FAC6-AMOUNT.                         CL216
00334                                                                      CL183
00335      IF WRK-TEMP-TRACE-NO NOT NUMERIC                                CL203
00336         DISPLAY 'TRACE-NO-' WRK-TEMP-TRACE-NO                        CL204
00337         MOVE EFT013 TO F907-MSG-TEXT                                 CL191
00338         MOVE '013' TO F907-MSG-ID                                    CL191
00339         MOVE ZEROS TO F907-EMP-NO                                    CL183
00340         MOVE WRK-TEMP-TRACE-NO TO F907-GOV1-TRACE                    CL206
00341         PERFORM P1055-WRITE-F907     THRU P1055-EXIT                 CL183
00342         GO TO P1010-EXIT.                                            CL183
00343                                                                      CL183
00344      IF WRK-TEMP-TRACE-NO = ZEROS                                    CL204
00345         MOVE EFT014 TO F907-MSG-TEXT                                 CL191
00346         MOVE '014' TO F907-MSG-ID                                    CL191
00347         MOVE ZEROS TO F907-EMP-NO                                    CL183
00348         MOVE WRK-TEMP-TRACE-NO TO F907-GOV1-TRACE                    CL206
00349         PERFORM P1055-WRITE-F907     THRU P1055-EXIT                 CL183
00350         GO TO P1010-EXIT.                                            CL215
00351                                                                      CL*78
00352                                                                      CL183
00353      PERFORM P1020-FIND-MPAY THRU P1020-EXIT.                        CL236
00354                                                                      CL183
00355      IF MPAY-FOUND-YES-88                                            CL183
00356         PERFORM P1040-BUILD-T025-RECORD THRU P1040-EXIT.             CL183
00357                                                                      CL183
00358      IF WRITE-T025-YES-88                                            CL183
00359         PERFORM S927-WRITE         THRU S927-EXIT                    CL183
00360         ADD 1 TO WRK-T025-WRITE-CNT.                                 CL183
00361                                                                      CL*29
00362  P1010-EXIT.                                                         CL*27
00363      EXIT.                                                           CL118
00364                                                                      CL*21
00365  P1015-TRAILER-EDIT.                                                 CL183
00366                                                                      CL183
00367       DISPLAY ' 1015 - PROCESS'.                                     CL187
00368      IF  WRK-TRAILER-REC-CNT > 1                                     CL183
00369          GO TO  P1015-EXIT.                                          CL216
00370                                                                      CL183
00371 *    IF FAC9-BATCH-CNT = ZEROS                                       CL216
00372 *       MOVE EFT066 TO F907-MSG-TEXT                                 CL216
00373 *       MOVE '066' TO F907-MSG-ID                                    CL216
00374 *       MOVE ZEROS TO F907-EMP-NO                                    CL216
00375 *       MOVE FAC9-TRAILER-REC TO F907-GOV1-REC                       CL216
00376 *       PERFORM P1055-WRITE-F907     THRU P1055-EXIT.                CL216
00377                                                                      CL183
00378                                                                      CL183
00379 *    IF FAC9-BATCH-CNT NOT NUMERIC                                   CL216
00380 *       MOVE EFT064 TO F907-MSG-TEXT                                 CL216
00381 *       MOVE '064' TO F907-MSG-ID                                    CL216
00382 *       MOVE ZEROS TO F907-EMP-NO                                    CL216
00383 *       MOVE FAC9-TRAILER-REC TO F907-GOV1-REC                       CL216
00384 *       PERFORM P1055-WRITE-F907     THRU P1055-EXIT.                CL216
00385                                                                      CL183
00386 *    IF WRK-FACH-READ-CNT NOT = FAC9-BATCH-CNT                       CL216
00387 *       MOVE EFT065 TO F907-MSG-TEXT, R907-MSG-TEXT                  CL216
00388 *       MOVE '065' TO F907-MSG-ID, R907-MSG-ID                       CL216
00389 *       MOVE ZEROS TO F907-EMP-NO                                    CL216
00390 *       MOVE FAC9-TRAILER-REC TO F907-GOV1-REC                       CL216
00391 *       PERFORM P1055-WRITE-F907     THRU P1055-EXIT.                CL216
00392                                                                      CL216
00393      MOVE FAC9-TOT-CREDIT-AMT TO TOT-TRAILER-AMT.                    CL216
00394                                                                      CL216
00395      IF TOT-FAC6-AMOUNT  NOT = TOT-TRAILER-AMT                       CL216
00396         MOVE EFT067 TO F907-MSG-TEXT, R907-MSG-TEXT                  CL216
00397         MOVE '067' TO F907-MSG-ID, R907-MSG-ID                       CL216
00398         MOVE ZEROS TO F907-EMP-NO                                    CL216
00399         MOVE FAC9-TRAILER-REC TO F907-GOV1-REC                       CL216
00400         PERFORM P1055-WRITE-F907     THRU P1055-EXIT.                CL216
00401                                                                      CL216
00402  P1015-EXIT.                                                         CL183
00403      EXIT.                                                           CL183
00404  P1020-FIND-MPAY.                                                    CL*28
00405                                                                      CL183
00406       DISPLAY ' 1020 - PROCESS'.                                     CL187
00407      SET MPAY-FOUND-NO-88 TO TRUE                                    CL183
00408      MOVE LOW-VALUES    TO ITRT-KEY-AREA.                            CL*45
00409      SET ITRT-TRT-88    TO TRUE.                                     CL*45
00410                                                                      CL*97
00411      MOVE WRK-NUMR-TRACE-NO TO ITRT-TRACE-NO.                        CL207
00412                                                                      CL182
00413      MOVE ZEROS         TO ITRT-EMP-NO                               CL125
00414                            ITRT-BATCH-NO                             CL*45
00415                            ITRT-ITEM-NO.                             CL*45
00416                                                                      CL182
00417      MOVE ITRT-KEY-AREA TO ISKL-KEY-AREA.                            CL*45
00418                                                                      CL205
00419       DISPLAY ' 1020 - PROCESS - ' WRK-NUMR-TRACE-NO.                CL207
00420       DISPLAY ' 1020 - PROCESS - ' ITRT-KEY-AREA.                    CL207
00421                                                                      CL*45
00422      PERFORM S921-START-BROWSE THRU S921-EXIT.                       CL128
00423      IF L921-NO-REC-88                                               CL*45
00424         MOVE EFT001 TO F907-MSG-TEXT                                 CL183
00425         MOVE '001'                   TO F907-MSG-ID                  CL183
00426         MOVE ZEROS                   TO F907-EMP-NO                  CL183
00427         MOVE WRK-TEMP-TRACE-NO       TO F907-GOV1-TRACE              CL205
00428         PERFORM P1055-WRITE-F907     THRU P1055-EXIT                 CL*20
00429         GO TO P1020-EXIT                                             CL183
00430      ELSE                                                            CL*45
00431         MOVE ISKL-REC       TO ITRT-REC.                             CL183
00432                                                                      CL183
00433      IF ITRT-TRACE-NO NOT = WRK-FAC6-DOES-TRACE-NO                   CL206
00434       DISPLAY ' 1TRT - NOT FOU - ' WRK-NUMR-TRACE-NO                 CL207
00435       DISPLAY ' 1TRT - PACK    - ' WRK-FAC6-DOES-TRACE-NO            CL207
00436         MOVE EFT001 TO F907-MSG-TEXT                                 CL183
00437         MOVE '001' TO F907-MSG-ID                                    CL183
00438         MOVE ZEROS TO F907-EMP-NO                                    CL183
00439         MOVE WRK-TEMP-TRACE-NO       TO F907-GOV1-TRACE              CL205
00440         PERFORM P1055-WRITE-F907     THRU P1055-EXIT                 CL183
00441         GO TO P1020-EXIT.                                            CL183
00442                                                                      CL183
00443      DISPLAY ' TRACE FOUND IN - ' WRK-NUMR-TRACE-NO                  CL210
00444      DISPLAY ' TRACE FOUND TRT- ' ITRT-TRACE-NO.                     CL210
00445                                                                      CL209
00446      MOVE LOW-VALUES     TO MPAY-KEY-AREA.                           CL183
00447      MOVE ITRT-EMP-NO    TO MPAY-EMP-NO.                             CL183
00448      MOVE ITRT-BATCH-NO  TO MPAY-BATCH-NO.                           CL183
00449      MOVE ITRT-ITEM-NO   TO MPAY-ITEM-NO.                            CL183
00450      SET MPAY-PAY-88     TO TRUE.                                    CL211
00451                                                                      CL211
00452      MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA.                            CL183
00453      DISPLAY ' MPAY KEY-'  MPAY-KEY-AREA.                            CL209
00454      DISPLAY ' MPAY EMP-'  MPAY-EMP-NO.                              CL210
00455      DISPLAY ' MPAY BAT-'  MPAY-BATCH-NO.                            CL210
00456      DISPLAY ' MPAY ITM-'  MPAY-ITEM-NO.                             CL210
00457      PERFORM S910-READ   THRU S910-EXIT.                             CL183
00458                                                                      CL127
00459      IF L910-NO-REC-88                                               CL183
00460       DISPLAY ' MPAY - NOT FOU - ' WRK-NUMR-TRACE-NO                 CL211
00461       DISPLAY ' 1029 - PACK    - ' WRK-FAC6-DOES-TRACE-NO            CL207
00462         SET MPAY-FOUND-NO-88 TO TRUE                                 CL212
00463         MOVE EFT001 TO F907-MSG-TEXT                                 CL183
00464         MOVE ZEROS TO F907-EMP-NO                                    CL183
00465         MOVE WRK-TEMP-TRACE-NO TO F907-GOV1-TRACE                    CL205
00466         MOVE '001' TO F907-MSG-ID                                    CL183
00467         PERFORM P1055-WRITE-F907     THRU P1055-EXIT                 CL183
00468      ELSE                                                            CL183
00469         SET MPAY-FOUND-YES-88 TO TRUE                                CL183
00470         MOVE MSKL-REC         TO MPAY-REC.                           CL183
00471                                                                      CL*74
00472  P1020-EXIT.                                                         CL*28
00473      EXIT.                                                           CL125
00474                                                                      CL*28
00475                                                                      CL*28
00476  P1040-BUILD-T025-RECORD.                                            CL*46
00477       DISPLAY ' 1040 - PROCESS'.                                     CL187
00478      SET WRITE-T025-YES-88  TO TRUE.                                 CL183
00479                                                                      CL184
00480      IF WRK-DTSBU005-YES                                             CL121
00481         PERFORM S005-FROM-SYS          THRU S005-EXIT                CL184
00482         MOVE L005-DATE                TO WRK-CURR-DATE               CL184
00483         MOVE L005-TIME                TO WRK-CURR-TIME               CL184
00484         MOVE 'N' TO WRK-DTSBU005-IND.                                CL165
00485                                                                      CL121
00486      MOVE MPAY-EMP-NO         TO T025-EMP-NO.                        CL121
00487      MOVE 'ACHNGCHK'          TO T025-ORIGIN.                        CL179
00488                                                                      CL121
00489      MOVE WRK-CURR-DATE       TO T025-SYS-DATE.                      CL121
00490      MOVE WRK-CURR-TIME       TO T025-SYS-TIME.                      CL121
00491                                                                      CL121
00492      MOVE 'NG'                TO T025-PAY-TYPE.                      CL121
00493                                                                      CL121
00494      MOVE MPAY-EMP-NO TO MPRF-EMP-NO.                                CL121
00495      PERFORM P1070-READ-MPRF THRU P1070-EXIT.                        CL121
00496                                                                      CL117
00497      IF L910-NO-REC-88                                               CL122
00498         SET WRITE-T025-NO-88  TO TRUE                                CL183
00499         DISPLAY '5350 NO MPRF FOUND HERE INSIDE P1040'               CL141
00500         GO TO P1040-EXIT.                                            CL122
00501                                                                      CL120
00502      MOVE MPRF-PRIMARY-NAME   TO T025-NAME-CHECK.                    CL121
00503                                                                      CL*40
00504      COMPUTE WRK-MPAY-REMIT-AMT = MPAY-REMIT-AMT * -1.               CL121
00505      MOVE WRK-MPAY-REMIT-AMT  TO T025-REMIT-AMT.                     CL121
00506                                                                      CL121
00507      MOVE MPAY-TRACE-NO   TO T025-TRACE-NO.                          CL122
00508      MOVE WRK-CURR-DATE   TO T025-RECEIVED-DATE                      CL183
00509                              T025-DEPOSIT-DATE.                      CL183
00510                                                                      CL121
00511      MOVE ZERO              TO T025-APPLIC-YRQ.                      CL214
00512      MOVE SPACES            TO T025-APPLIC-IND.                      CL214
00513      MOVE MPAY-BATCH-NO     TO T025-APPLIC-BATCH-NO.                 CL131
00514      MOVE MPAY-ITEM-NO      TO T025-APPLIC-ITEM-NO.                  CL131
00515      MOVE SPACES            TO T025-RESPONSIBLE-ACTIVITY.            CL136
00516      MOVE SPACES            TO T025-RESPONSIBLE-OP-ID.               CL131
00517                                                                      CL121
00518      MOVE T025-REC          TO TSKL-REC.                             CL183
00519                                                                      CL131
00520  P1040-EXIT.                                                         CL121
00521      EXIT.                                                           CL130
00522                                                                      CL121
00523  P1055-WRITE-F907.                                                   CL184
00524 **************************************************************       CL180
00525 *  WRITE FACH ERROR RETURN FILE(F907)                        *       CL180
00526 **************************************************************       CL180
00527                                                                      CL*20
00528       DISPLAY ' 1055 - PROCESS'.                                     CL187
00529      ADD +1             TO WRK-F907-WRITE-CNT.                       CL*99
00530      MOVE WRK-MOD-NAME  TO F907-MODULE-NAME.                         CL*20
00531      MOVE IN-FACH-REC   TO F907-GOV1-REC.                            CL159
00532      MOVE ZEROS TO F907-EMP-NO.                                      CL*70
00533                                                                      CL*70
00534      CALL 'DTSBU946' USING F907-REC.                                 CL160
00535                                                                      CL*20
00536                                                                      CL*20
00537  P1055-EXIT.                                                         CL184
00538       EXIT.                                                          CL*20
00539  T0000-TERMINATE.                                                    CL183
00540                                                                      CL183
00541       IF NOT FACH-TYPE-TRAILER-88                                    CL183
00542          DISPLAY ' LAST RECORD IS NOT A TRAILER RECORD '             CL183
00543          DISPLAY '             '                                     CL183
00544          DISPLAY ' LAST RECORD ' FACH-SKELETAL-REC                   CL183
00545          DISPLAY '             '                                     CL183
00546          PERFORM S999-ABEND THRU S999-EXIT.                          CL183
00547                                                                      CL183
00548      IF  WRK-FACH-READ-CNT = 2                                       CL183
00549          DISPLAY ' *** WACHOVIA FILE CONTAINS 2 RECS '               CL213
00550          DISPLAY ' ***  NO REJECTED PAYMENT RECORDS *'.              CL213
00551                                                                      CL183
00552                                                                      CL183
00553      MOVE -1 TO F907-LENGTH.                                         CL183
00554      CALL 'DTSBU946' USING F907-REC.                                 CL183
00555                                                                      CL183
00556      CLOSE IN-FACH.                                                  CL183
00557                                                                      CL183
00558                                                                      CL183
00559      DISPLAY ' '.                                                    CL183
00560                                                                      CL183
00561      DISPLAY '*** EFTBD350 TERMINATION STATISTICS ***'.              CL183
00562                                                                      CL183
00563      DISPLAY ' '.                                                    CL183
00564                                                                      CL183
00565      DISPLAY 'NUMBER OF FACH RECORDS READ         :   '              CL183
00566              WRK-FACH-READ-CNT.                                      CL183
00567                                                                      CL183
00568      DISPLAY 'NUMBER IN TRAILER BATCH COUNT       :   '              CL183
00569               FAC9-BATCH-CNT.                                        CL183
00570                                                                      CL183
00571      DISPLAY 'HEADERS IN FACH FILE                :   '              CL183
00572              WRK-HEADER-RECORDS.                                     CL183
00573                                                                      CL183
00574      DISPLAY 'TRAILERS IN FACH FILE               :   '              CL183
00575              WRK-TRAILER-RECORDS.                                    CL183
00576                                                                      CL183
00577      DISPLAY 'DETAIL RECORDS IN FACH FILE         :   '              CL183
00578              WRK-FAC6-RECORDS.                                       CL183
00579                                                                      CL183
00580      DISPLAY 'NUMBER OF OTHER RECORDS IN FACH FILE:   '              CL183
00581              WRK-OTHER-RECORDS.                                      CL183
00582                                                                      CL183
00583      DISPLAY 'NUMBER OF T025 RECORDS WRITTEN      :   '              CL183
00584              WRK-T025-WRITE-CNT.                                     CL183
00585                                                                      CL183
00586      DISPLAY 'NUMBER OF F907 RECORDS WRITTEN      :   '              CL183
00587              WRK-F907-WRITE-CNT.                                     CL183
00588                                                                      CL183
00589      PERFORM S910-CLOSE THRU S910-EXIT.                              CL183
00590      PERFORM S927-CLOSE THRU S927-EXIT.                              CL183
00591                                                                      CL183
00592                                                                      CL183
00593      IF  WRK-F907-WRITE-CNT > 0                                      CL183
00594          DISPLAY ' FACH INPUT FILE CONTAINS ERRORS+++'               CL183
00595          DISPLAY ' PROGRAM WILL ABEND ***************'.              CL183
00596 *        PERFORM S999-ABEND THRU S999-EXIT.                          CL189
00597                                                                      CL183
00598                                                                      CL183
00599                                                                      CL183
00600  T0000-EXIT.                                                         CL183
00601      EXIT.                                                           CL183
00602                                                                      CL*34
00603  P1070-READ-MPRF.                                                    CL184
00604                                                                      CL136
00605                                                                      CL136
00606      MOVE LOW-VALUE TO MPRF-KEY-AREA.                                CL*43
00607      SET MPRF-PRF-88 TO TRUE.                                        CL*43
00608      MOVE MPAY-EMP-NO TO MPRF-EMP-NO.                                CL125
00609      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                            CL*43
00610                                                                      CL*43
00611      PERFORM S910-READ THRU S910-EXIT.                               CL*43
00612                                                                      CL*43
00613      IF L910-OK-88                                                   CL*43
00614          SET L910-OK-88  TO TRUE                                     CL139
00615          MOVE MSKL-REC TO MPRF-REC                                   CL*43
00616      ELSE                                                            CL121
00617         DISPLAY 'NO MPRF-REC FOUND ' L910-RESULT-IND                 CL121
00618         SET L910-NO-REC-88 TO TRUE                                   CL121
00619         DISPLAY '6090 L910 NO RECORD FOUND '                         CL121
00620         PERFORM P1055-WRITE-F907   THRU P1055-EXIT                   CL112
00621         GO TO P1070-EXIT.                                            CL184
00622                                                                      CL*43
00623      MOVE MPRF-PRIMARY-NAME TO T025-NAME-CHECK.                      CL*43
00624                                                                      CL*43
00625  P1070-EXIT.                                                         CL184
00626      EXIT.                                                           CL*32
00627                                                                      CL*32
00628                                                                      CL*77
00629  S005-FROM-SYS.                                                      CL*77
00630                                                                      CL156
00631      SET L005-FROM-SYS TO TRUE.                                      CL*77
00632      GO TO S005-ABSTIME.                                             CL*77
00633                                                                      CL*77
00634  S005-ABSTIME.                                                       CL*77
00635                                                                      CL156
00636      CALL 'DTSBU005' USING L005-LINK-AREA.                           CL*77
00637                                                                      CL*77
00638  S005-EXIT.                                                          CL*77
00639      EXIT.                                                           CL*77
00640                                                                      CL*77
00641                                                                      CL138
00642  S910-OPEN-UPDATE-NO-AIX.                                            CL138
00643      SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE.                         CL138
00644      GO TO S910-MSTR-IO.                                             CL138
00645                                                                      CL138
00646      EJECT                                                           CL143
00647  S910-OPEN-READ.                                                     CL143
00648      SET L910-OPEN-READ-88 TO TRUE.                                  CL143
00649      GO TO S910-MSTR-IO.                                             CL143
00650                                                                      CL143
00651  S910-READ.                                                          CL138
00652      SET L910-READ-88 TO TRUE.                                       CL138
00653      GO TO S910-MSTR-IO.                                             CL138
00654                                                                      CL138
00655  S910-DELETE.                                                        CL138
00656      SET L910-DELETE-88 TO TRUE.                                     CL138
00657      GO TO S910-MSTR-IO.                                             CL138
00658                                                                      CL138
00659  S910-WRITE.                                                         CL138
00660      SET L910-WRITE-88 TO TRUE.                                      CL138
00661      GO TO S910-MSTR-IO.                                             CL138
00662                                                                      CL138
00663  S910-START-BROWSE.                                                  CL138
00664      SET L910-START-BROWSE-88 TO TRUE.                               CL138
00665      GO TO S910-MSTR-IO.                                             CL138
00666                                                                      CL138
00667  S910-READ-NEXT.                                                     CL138
00668      SET L910-READ-NEXT-88 TO TRUE.                                  CL138
00669      GO TO S910-MSTR-IO.                                             CL138
00670                                                                      CL138
00671  S910-REWRITE.                                                       CL138
00672      SET L910-REWRITE-88 TO TRUE.                                    CL138
00673      GO TO S910-MSTR-IO.                                             CL138
00674                                                                      CL138
00675  S910-CLOSE.                                                         CL138
00676      SET L910-CLOSE-88     TO TRUE.                                  CL138
00677      GO TO S910-MSTR-IO.                                             CL138
00678                                                                      CL138
00679  S910-MSTR-IO.                                                       CL138
00680      CALL 'DTSBU910' USING L910-LINK-AREA                            CL138
00681                            MSKL-REC.                                 CL138
00682  S910-EXIT.                                                          CL138
00683      EXIT.                                                           CL138
00684                                                                      CL138
00685      SKIP3                                                           CL138
00686  S921-OPEN-READ.                                                     CL138
00687      SET L921-OPEN-READ-88 TO TRUE.                                  CL138
00688      GO TO S921-AIX-IO.                                              CL138
00689                                                                      CL138
00690  S921-READ.                                                          CL138
00691      SET L921-READ-88 TO TRUE.                                       CL138
00692      GO TO S921-AIX-IO.                                              CL138
00693                                                                      CL138
00694  S921-START-BROWSE.                                                  CL138
00695      SET L921-START-BROWSE-88 TO TRUE.                               CL138
00696      GO TO S921-AIX-IO.                                              CL138
00697                                                                      CL138
00698  S921-READ-NEXT.                                                     CL138
00699      SET L921-READ-NEXT-88 TO TRUE.                                  CL138
00700      GO TO S921-AIX-IO.                                              CL138
00701                                                                      CL138
00702  S921-CLOSE.                                                         CL138
00703      SET L921-CLOSE-88 TO TRUE.                                      CL138
00704      GO TO S921-AIX-IO.                                              CL138
00705                                                                      CL138
00706  S921-AIX-IO.                                                        CL138
00707      CALL 'DTSBU921' USING L921-LINK-AREA                            CL138
00708                            ISKL-REC.                                 CL138
00709  S921-EXIT.                                                          CL138
00710      EXIT.                                                           CL138
00711                                                                      CL189
00712  S927-OPEN-UPDATE.                                                   CL190
00713      SET L927-OPEN-UPDATE-88 TO TRUE.                                CL190
00714      GO TO S927-BTC-O.                                               CL190
00715                                                                      CL190
00716  S927-WRITE.                                                         CL190
00717      SET L927-WRITE-88 TO TRUE.                                      CL190
00718      GO TO S927-BTC-O.                                               CL190
00719                                                                      CL190
00720  S927-CLOSE.                                                         CL190
00721      SET L927-CLOSE-88 TO TRUE.                                      CL190
00722      GO TO S927-BTC-O.                                               CL190
00723                                                                      CL190
00724  S927-BTC-O.                                                         CL190
00725      CALL 'DTSBU927' USING L927-LINK-AREA                            CL190
00726                           TSKL-REC.                                  CL190
00727  S927-EXIT.                                                          CL190
00728       EXIT.                                                          CL190
00729                                                                      CL192
00730      EJECT                                                           CL*77
00731  S999-ABEND.                                                         CL*58
00732      CALL 'DTSBU999' USING WRK-ABEND-CD.                             CL*58
00733  S999-EXIT.                                                          CL*58
00734      EXIT.                                                           CL*58
