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