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