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