00001 IDENTIFICATION DIVISION. 01/23/15 00002 PROGRAM-ID. DTSBX437. DTSBX437 00003 AUTHOR. NGC. LV065 00004 DATE-WRITTEN. SEPT 2014. CL*29 00005 DATE-COMPILED. DTSBX437 00006 SKIP3 DTSBX437 00007 ***** DTSBX437 00008 * DTSBX437 00009 * FUNCTION: CREATE REPORT FOR ALL DAILY TDEC REPORT PAYMENTS CL*64 00010 * FILE. PAYMENT WILL BE ADDED TO DUTAS FOR ESSP. CL*28 00011 * MODIFICATION HISTORY: DTSBX437 00012 * DTSBX437 00013 * 09-20-2014 INITIAL DEVELOPMENT CL*19 00014 * REFERENCE RFP: WEB REGISTRATION ESSP ZL1 CL*19 00015 * CL*19 00016 * DTSBX437 00017 * 01-06-2015 MODIFIED PROGRAM TO PRODUCE REPORT OF ALL CL*49 00018 * TDEC CHECK DISPOSITION (PAID AND PENDING) ZL1 CL*49 00019 * CL*49 00020 ***** DTSBX437 00021 SKIP3 DTSBX437 00022 ENVIRONMENT DIVISION. DTSBX437 00023 CONFIGURATION SECTION. CL*51 00024 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. CL*51 00025 CL*51 00026 INPUT-OUTPUT SECTION. DTSBX437 00027 DTSBX437 00028 FILE-CONTROL. DTSBX437 00029 DTSBX437 00030 CL*14 00031 SELECT TDEC-PAYT-FILE ASSIGN TO DTSFX145 CL*34 00032 FILE STATUS IS TDEC-PAYT-STATUS. CL*28 00033 CL*14 00034 CL*16 00035 SELECT TDEC-PEND-FILE ASSIGN TO DTSPX145 CL*34 00036 FILE STATUS IS BATCH-XREF-STATUS. CL*16 00037 CL*47 00038 SELECT REPT-PAID-FILE ASSIGN TO X437RPT1 CL*64 00039 FILE STATUS IS REPT-STATUS. CL*47 00040 CL*47 00041 SELECT REPT-PEND-FILE ASSIGN TO X437RPT2 CL*64 00042 FILE STATUS IS REPT-STATUS. CL*47 00043 CL*47 00044 DATA DIVISION. DTSBX437 00045 DTSBX437 00046 FILE SECTION. DTSBX437 00047 DTSBX437 00048 CL*14 00049 FD TDEC-PAYT-FILE CL*28 00050 RECORDING MODE IS F CL*14 00051 BLOCK CONTAINS 0 RECORDS CL*14 00052 LABEL RECORDS ARE OMITTED. CL*14 00053 CL*14 00054 01 TDEC-PAYT-REC. CL*30 00055 05 WEB-IMP-TYPE PIC X(03). CL*30 00056 88 WEB-IMP-TYPE-PRF-88 VALUE '102'. CL*30 00057 88 WEB-IMP-TYPE-DETERM-88 VALUE '104'. CL*30 00058 88 WEB-IMP-TYPE-NAME-88 VALUE '106'. CL*30 00059 88 WEB-IMP-TYPE-RATE-88 VALUE '108'. CL*30 00060 88 WEB-IMP-TYPE-ADDR-88 VALUE '110'. CL*30 00061 88 WEB-IMP-TYPE-OPO-88 VALUE '120'. CL*30 00062 88 WEB-IMP-TYPE-REL-88 VALUE '130'. CL*30 00063 *** 88 WEB-IMP-TYPE-IND-88 VALUE '132'. CL*30 00064 88 WEB-IMP-TYPE-RPT-88 VALUE '140'. CL*30 00065 88 WEB-IMP-TYPE-WAGE-88 VALUE '144'. CL*30 00066 88 WEB-IMP-TYPE-PAY-88 VALUE '145'. CL*30 00067 88 WEB-IMP-TYPE-BHDR-88 VALUE '149'. CL*30 00068 88 WEB-TYPE-REG-88 VALUE '102' '104' '106' CL*30 00069 '108' '130' '132'. CL*30 00070 88 WEB-TYPE-RPT-88 VALUE '140' '144'. CL*30 00071 88 WEB-TYPE-PAY-88 VALUE '145'. CL*30 00072 88 WEB-TYPE-PRF-88 VALUE '110' '120'. CL*30 00073 05 FILLER PIC X(01). CL*30 00074 05 WEB-IMP-EMP-NO PIC 9(06). CL*30 00075 05 FILLER PIC X(01). CL*30 00076 05 WEB-IMP-QTR PIC X(06). CL*30 00077 05 FILLER PIC X(495). CL*30 00078 CL*30 00079 CL*14 00080 CL*16 00081 FD TDEC-PEND-FILE CL*28 00082 RECORDING MODE IS F CL*16 00083 BLOCK CONTAINS 0 RECORDS CL*16 00084 LABEL RECORDS ARE OMITTED. CL*16 00085 CL*16 00086 01 TDEC-PEND-REC PIC X(512). CL*30 00087 CL*48 00088 FD REPT-PAID-FILE CL*47 00089 RECORDING MODE IS F CL*47 00090 BLOCK CONTAINS 0 RECORDS CL*47 00091 LABEL RECORDS ARE OMITTED. CL*47 00092 CL*47 00093 01 REPT-PAID-REC PIC X(133). CL*47 00094 CL*47 00095 CL*47 00096 FD REPT-PEND-FILE CL*47 00097 RECORDING MODE IS F CL*47 00098 BLOCK CONTAINS 0 RECORDS CL*47 00099 LABEL RECORDS ARE OMITTED. CL*47 00100 CL*47 00101 01 REPT-PEND-REC PIC X(133). CL*47 00102 CL*47 00103 CL*16 00104 WORKING-STORAGE SECTION. DTSBX437 001045 77 PAN-VALET PICTURE X(24) VALUE '065DTSBX437 01/23/15'. DTSBX437 00105 SKIP3 DTSBX437 00106 01 WRK-AREA. DTSBX437 00107 05 W-ABEND-CD PIC S9(04) COMP VALUE 428. CL*18 00108 05 W-MOD-NAME PIC X(08) VALUE 'DTSBX429'. CL*28 00109 DTSBX437 00110 05 W-PREV-REC-TYPE PIC X(03) VALUE SPACES. DTSBX437 00111 88 W-PREV-REC-NULL-88 VALUE 'XXX'. DTSBX437 00112 88 W-PREV-REC-PRF-88 VALUE '102'. DTSBX437 00113 88 W-PREV-REC-DETERM-88 VALUE '104'. DTSBX437 00114 88 W-PREV-REC-NAME-88 VALUE '106'. DTSBX437 00115 88 W-PREV-REC-RATE-88 VALUE '108'. DTSBX437 00116 88 W-PREV-REC-ADDR-88 VALUE '110'. DTSBX437 00117 88 W-PREV-REC-OPO-88 VALUE '120'. DTSBX437 00118 88 W-PREV-REC-REL-88 VALUE '130'. DTSBX437 00119 88 W-PREV-REC-IND-88 VALUE '132'. DTSBX437 00120 88 W-PREV-REC-RPT-88 VALUE '140'. DTSBX437 00121 88 W-PREV-REC-WAGE-88 VALUE '144'. DTSBX437 00122 88 W-PREV-REC-PAY-88 VALUE '145'. DTSBX437 00123 DTSBX437 00124 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBX437 00125 88 W-ERROR-YES-88 VALUE 'Y'. DTSBX437 00126 88 W-ERROR-NO-88 VALUE 'N'. DTSBX437 00127 DTSBX437 00128 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSBX437 00129 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSBX437 00130 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSBX437 00131 DTSBX437 00132 05 BATCH-XREF-STATUS PIC X(02). DTSBX437 00133 88 BATCH-XREF-OK-88 VALUE '00'. DTSBX437 00134 DTSBX437 00135 05 W-EMP-FOUND-IND PIC X(01) VALUE 'N'. DTSBX437 00136 88 W-EMP-FOUND-YES-88 VALUE 'Y'. DTSBX437 00137 88 W-EMP-FOUND-NO-88 VALUE 'N'. DTSBX437 00138 DTSBX437 00139 05 W-QTR-FOUND-IND PIC X(01) VALUE 'N'. CL*21 00140 88 W-QTR-FOUND-YES-88 VALUE 'Y'. CL*21 00141 88 W-QTR-FOUND-NO-88 VALUE 'N'. CL*21 00142 CL*21 00143 05 TDEC-PAYT-STATUS PIC X(02) VALUE SPACES. CL*28 00144 88 W-TDEC-PAYT-EOF-88 VALUE '10'. CL*28 00145 88 W-TDEC-PAYT-OK-88 VALUE '00'. CL*28 00146 CL*21 00147 05 REPT-STATUS PIC X(02) VALUE SPACES. CL*50 00148 88 REPT-STATUS-EOF-88 VALUE '10'. CL*50 00149 88 REPT-STATUS-OK-88 VALUE '00'. CL*50 00150 CL*50 00151 05 W-APAY-MAX PIC S9(04) COMP VALUE +100. DTSBX437 00152 05 W-APAY-LAST PIC S9(04) COMP VALUE +0. DTSBX437 00153 05 PSUB PIC S9(04) COMP VALUE +0. DTSBX437 00154 05 W-APAY-TABLE. DTSBX437 00155 10 W-APAY-ENTRY OCCURS 100 TIMES PIC X(96). DTSBX437 00156 DTSBX437 00157 05 WRK-RETURN-CODE PIC S9(01) VALUE +0. CL*26 00158 05 W-EMP-NO PIC S9(07) COMP-3. CL*26 00159 05 W-REPORT-QTR PIC S9(05) COMP-3. DTSBX437 00160 05 W-REMITTANCE PIC S9(09)V99 VALUE 0. CL*59 00161 05 W-TOT-REMITTANCE PIC S9(09)V99 VALUE 0. CL*59 00162 05 W-TOT-PAID-REMITTANCE PIC S9(09)V99 VALUE 0. CL*59 00163 05 W-TOT-PEND-REMITTANCE PIC S9(09)V99 VALUE 0. CL*59 00164 05 W-RECEIVED-DATE PIC S9(09) COMP-3. DTSBX437 00165 05 W-DEPOSIT-DATE PIC S9(09) COMP-3. DTSBX437 00166 05 W-CHK-SCAN-DATE PIC S9(09) COMP-3. DTSBX437 00167 05 W-REMIT-AMT PIC S9(09)V99 COMP-3. DTSBX437 00168 05 W-X145-TOT-REMIT-AMT PIC S9(09)V99 VALUE 0. CL*51 00169 05 W-TRAN-CNT PIC S9(03) COMP-3. DTSBX437 00170 05 W-PEND-CNT PIC 9(05) VALUE 0. CL*37 00171 05 W-MPRF-CNT PIC 9(05) VALUE 0. CL*37 00172 05 W-MQTR-CNT PIC 9(05) VALUE 0. CL*37 00173 05 W-ERRO-CNT PIC 9(05) VALUE 0. CL*37 00174 05 W-X145-ERR-CNT PIC 9(05) VALUE 0. CL*58 00175 05 WRK-SYS-ABSTIME PIC S9(15) COMP-3 VALUE 0. CL*16 00176 DTSBX437 00177 05 W-EARNINGS PIC S9(09)V99. DTSBX437 00178 05 W-INTEGER PIC S9(11) COMP-3. CL*33 00179 05 W-FRACTION PIC SV9(11) COMP-3. CL*33 00180 05 W-NUMBER PIC S9(11)V9(05) COMP-3. CL*33 00181 05 SUB PIC S9(4) COMP. CL*33 00182 CL*48 00183 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. CL*48 00184 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. CL*48 00185 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. CL*48 00186 CL*48 00187 DTSBX437 00188 05 W-PAY-TYPE PIC X(02). DTSBX437 00189 88 W-PA-PAY-88 VALUE 'PA'. DTSBX437 00190 88 W-OR-PAY-88 VALUE 'OR'. DTSBX437 00191 88 W-EA-PAY-88 VALUE 'EA'. DTSBX437 00192 88 W-AU-PAY-88 VALUE 'AU'. DTSBX437 00193 88 W-FS-PAY-88 VALUE 'FS'. DTSBX437 00194 88 W-AC-PAY-88 VALUE 'AC'. DTSBX437 00195 88 W-ES-PAY-88 VALUE 'ES'. DTSBX437 00196 88 W-WD-PAY-88 VALUE 'WD'. DTSBX437 00197 88 W-PAY-REV-88 VALUE 'PR'. DTSBX437 00198 88 W-REFUND-88 VALUE 'RF'. DTSBX437 00199 88 W-REF-REV-88 VALUE 'RR'. DTSBX437 00200 88 W-NG-CHECK-88 VALUE 'NG'. DTSBX437 00201 88 W-VALID-PAY-88 VALUE 'PA' 'OR' 'EA' 'AU' DTSBX437 00202 'FS' 'AC'. DTSBX437 00203 DTSBX437 00204 05 W-SEQ-NO PIC 9(07) VALUE 0. DTSBX437 00205 DTSBX437 00206 05 W-SLASH-DATE PIC X(10). DTSBX437 00207 05 FILLER REDEFINES W-SLASH-DATE. DTSBX437 00208 10 W-SLASH-DT-MM PIC X(02). DTSBX437 00209 10 FILLER PIC X(01). DTSBX437 00210 10 W-SLASH-DT-DD PIC X(02). DTSBX437 00211 10 FILLER PIC X(01). DTSBX437 00212 10 W-SLASH-DT-CCYY PIC X(04). DTSBX437 00213 DTSBX437 00214 05 W-SLASH-QTR PIC X(06). DTSBX437 00215 05 FILLER REDEFINES W-SLASH-QTR. DTSBX437 00216 10 W-SLASH-QTR-CCYY PIC X(04). DTSBX437 00217 10 FILLER PIC X(01). DTSBX437 00218 10 W-SLASH-QTR-Q PIC X(01). DTSBX437 00219 DTSBX437 00220 * PAYMENT DTSBX437 00221 05 W-X212-CNT PIC S9(07) COMP-3 VALUE +0. CL*16 00222 DTSBX437 00223 05 W-APAY-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX437 00224 DTSBX437 00225 05 W-T025-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX437 00226 * 05 WS-T025-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. CL*57 00227 DTSBX437 00228 05 W-BX212-CNT PIC S9(07) COMP-3 VALUE +0. CL*16 00229 DTSBX437 00230 05 W-X212-LENGTH PIC S9(04) COMP. CL*16 00231 DTSBX437 00232 05 W-AMT-DISP1 PIC ----------9.99. DTSBX437 00233 05 W-AMT-DISP2 PIC ----------9.99. DTSBX437 00234 *RW1 DTSBX437 00235 05 WRK-R140-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX437 00236 05 DISPLAY-CNT PIC Z(06)9. DTSBX437 00237 05 WRK-MPRF-EMP-NO PIC 9(06). DTSBX437 00238 *RW2 DTSBX437 00239 DTSBX437 00240 01 MESSAGE-AREA. DTSBX437 00241 *** FATAL ERRORS MSG-A DTSBX437 00242 05 MSG-A1. DTSBX437 00243 10 FILLER PIC X(32) DTSBX437 00244 VALUE 'TYPE A REC NOT FIRST IN FILE: '. DTSBX437 00245 10 MSG-A1-PREV-REC-TYPE PIC X(01). DTSBX437 00246 DTSBX437 00247 01 HEADER-1. CL*47 00248 05 FILLER PIC X(01) VALUE SPACES. CL*47 00249 05 FILLER PIC X(49) VALUE '140R1'. CL*47 00250 05 FILLER PIC X(60) VALUE CL*47 00251 'DISTRICT OF COLUMBIA'. CL*47 00252 05 FILLER PIC X(06) VALUE 'DATE:'. CL*47 00253 05 HDR1-LRCM-SYS-DATE PIC X(10). CL*47 00254 01 HEADER-2. CL*47 00255 05 FILLER PIC X(54) VALUE SPACES. CL*47 00256 05 FILLER PIC X(56) VALUE CL*47 00257 'TAX DIVISION'. CL*47 00258 05 FILLER PIC X(06) VALUE 'TIME:'. CL*47 00259 05 HDR2-LRCM-SYS-TIME PIC X(08). CL*47 00260 CL*47 00261 01 HEADER-3. CL*47 00262 05 FILLER PIC X(01) VALUE SPACES. CL*47 00263 05 FILLER PIC X(38) VALUE CL*47 00264 'ROUTE TO: TAX ACCOUNTING STAFF'. CL*47 00265 05 HDR3-LITERAL PIC X(43) VALUE CL*47 00266 ' TDEC DAILY PROCESSED REPORT PAYMENTS'. CL*64 00267 05 FILLER PIC X(28) VALUE SPACES. CL*47 00268 05 FILLER PIC X(06) VALUE 'PAGE:'. CL*47 00269 05 HDR3-PAGE PIC ZZ,ZZ9. CL*47 00270 CL*47 00271 01 HEADER-4. CL*47 00272 05 FILLER PIC X(01) VALUE SPACES. CL*47 00273 05 FILLER PIC X(132) VALUE SPACES. CL*47 00274 01 HEADER-5. CL*47 00275 05 FILLER PIC X(02) VALUE SPACES. CL*47 00276 05 FILLER PIC X(34) VALUE CL*47 00277 'EMP NO EMPLOYER NAME '. CL*53 00278 05 FILLER PIC X(04) VALUE SPACES. CL*53 00279 05 FILLER PIC X(34) VALUE CL*47 00280 'QTR RECV-DATE PAID-AMT'. CL*54 00281 05 FILLER PIC X(02) VALUE SPACES. CL*47 00282 05 HDR5-NAME PIC X(28) VALUE CL*47 00283 ' DISPOSITION OF PAYMTS'. CL*64 00284 CL*47 00285 01 HEADER-6. CL*47 00286 05 FILLER PIC X(01) VALUE SPACES. CL*47 00287 05 FILLER PIC X(132) VALUE SPACES. CL*47 00288 CL*48 00289 01 DETAIL-LINE-1. CL*47 00290 15 FILLER PIC X(02) VALUE SPACES. CL*47 00291 15 X434-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL*47 00292 15 FILLER PIC X(02) VALUE SPACES. CL*47 00293 15 X434-NAME-CHECK PIC X(24) VALUE SPACES. CL*48 00294 15 FILLER PIC X(02) VALUE SPACES. CL*47 00295 15 X434-QTR PIC X(06). CL*47 00296 15 FILLER PIC X(02) VALUE SPACES. CL*47 00297 15 X434-RCVD-DATE PIC X(10). CL*47 00298 15 FILLER PIC X(05) VALUE SPACES. CL*48 00299 15 X434-X145-REMIT PIC -------9.99. CL*47 00300 15 FILLER PIC X(05) VALUE SPACES. CL*48 00301 15 X434-MESSAGE PIC X(20). CL*48 00302 CL*47 00303 01 DETAIL-PEND-1. CL*47 00304 15 FILLER PIC X(02) VALUE SPACES. CL*47 00305 15 P434-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL*47 00306 15 FILLER PIC X(02) VALUE SPACES. CL*47 00307 15 P434-NAME-CHECK PIC X(24) VALUE SPACES. CL*48 00308 15 FILLER PIC X(02) VALUE SPACES. CL*47 00309 15 P434-QTR PIC X(06). CL*47 00310 15 FILLER PIC X(02) VALUE SPACES. CL*47 00311 15 P434-RCVD-DATE PIC X(10). CL*47 00312 15 FILLER PIC X(05) VALUE SPACES. CL*48 00313 15 P434-X145-REMIT PIC --------9.99. CL*47 00314 15 FILLER PIC X(05) VALUE SPACES. CL*48 00315 15 P434-MESSAGE PIC X(30). CL*47 00316 CL*47 00317 01 FOOTING-LINE-1 PIC X(133) VALUE SPACES. CL*47 00318 01 FOOTING-LINE-2 PIC X(133) VALUE SPACES. CL*47 00319 CL*47 00320 01 FOOTING-LINE-3. CL*47 00321 05 FILLER PIC X(25) VALUE SPACES. CL*47 00322 05 WS-FOOTING-CNT PIC ZZ,ZZ9. CL*47 00323 05 FILLER PIC X(02) VALUE SPACES. CL*47 00324 05 FILLER PIC X(45) VALUE CL*47 00325 ' TOTAL REPORTS PAYMENTS RECEIVED'. CL*65 00326 05 FILLER PIC X(32) VALUE SPACES. CL*47 00327 CL*47 00328 01 FOOTING-LINE-4. CL*47 00329 05 FILLER PIC X(25) VALUE SPACES. CL*47 00330 05 WS-X145-ERR-CNT PIC ZZ,ZZ9. CL*47 00331 05 FILLER PIC X(02) VALUE SPACES. CL*47 00332 05 FILLER PIC X(34) VALUE CL*47 00333 ' # OF PAYMENTS HAD ERRORS '. CL*60 00334 05 FILLER PIC X(32) VALUE SPACES. CL*47 00335 CL*47 00336 01 FOOTING-LINE-5. CL*47 00337 05 FILLER PIC X(25) VALUE SPACES. CL*47 00338 05 WS-X145-PEN-CNT PIC ZZ,ZZ9. CL*47 00339 05 FILLER PIC X(02) VALUE SPACES. CL*47 00340 05 FILLER PIC X(40) VALUE CL*47 00341 ' # OF PAYMENTS WENT TO PENDING FILE '. CL*60 00342 05 FILLER PIC X(32) VALUE SPACES. CL*47 00343 01 FOOTING-LINE-6. CL*56 00344 05 FILLER PIC X(25) VALUE SPACES. CL*56 00345 05 WS-T025-WRITE-CNT PIC ZZ,ZZ9. CL*56 00346 05 FILLER PIC X(02) VALUE SPACES. CL*56 00347 05 FILLER PIC X(40) VALUE CL*56 00348 ' # OF PAYMENTS WAITING FOR PROCESSING '. CL*64 00349 05 FILLER PIC X(32) VALUE SPACES. CL*56 00350 01 FOOTING-LINE-7. CL*56 00351 05 FILLER PIC X(19) VALUE SPACES. CL*47 00352 05 WS-TOT-REMIT PIC $$$$$$$$9.99. CL*47 00353 05 FILLER PIC X(02) VALUE SPACES. CL*47 00354 05 FILLER PIC X(45) VALUE CL*47 00355 ' TOTAL PAYMENTS WAITING FOR PROCESSING'. CL*64 00356 05 FILLER PIC X(32) VALUE SPACES. CL*47 00357 CL*47 00358 01 FOOTING-LINE-8. CL*56 00359 05 FILLER PIC X(19) VALUE SPACES. CL*56 00360 05 WS-TOTAL-REMIT PIC $$$$$$$$9.99. CL*56 00361 05 FILLER PIC X(02) VALUE SPACES. CL*56 00362 05 FILLER PIC X(45) VALUE CL*56 00363 'TOTAL REPORT PAYMENTS RECEIVED '. CL*64 00364 05 FILLER PIC X(32) VALUE SPACES. CL*56 00365 CL*56 00366 01 FOOTING-LINE-13. CL*47 00367 05 FILLER PIC X(25) VALUE SPACES. CL*47 00368 05 FILLER PIC X(67) VALUE CL*47 00369 '*** END TDEC/DUTAS DAILY PAYMNT PROCESSING ***'. CL*64 00370 01 FOOTING-LINE-14 PIC X(133) VALUE SPACES. CL*47 00371 CL*47 00372 CL*47 00373 CL*47 00374 01 T025-REC. DTSBX437 00375 ++INCLUDE DTSIT025 DTSBX437 00376 DTSBX437 00377 * REPORT DTSBX437 00378 01 X140-REC. DTSBX437 00379 ++INCLUDE DTSIX140 DTSBX437 00380 DTSBX437 00381 * PAYMENT DTSBX437 00382 01 X145-REC. DTSBX437 00383 ++INCLUDE DTSIX145 DTSBX437 00384 DTSBX437 00385 * ICESA-REPT-FILE CL*16 00386 01 X212-REC. CL*16 00387 ++INCLUDE DTSIX212 CL*20 00388 CL*16 00389 * BATCH - PSEUDO-BATCH XREF DTSBX437 00390 01 X214-REC. DTSBX437 00391 ++INCLUDE DTSIX214 DTSBX437 00392 DTSBX437 00393 * ERRORS DTSBX437 00394 *01 X907-REC. DTSBX437 00395 ***INCLUDE DTSIX907 DTSBX437 00396 DTSBX437 00397 01 L001-LINK-AREA. DTSBX437 00398 ++INCLUDE DTSIL001 DTSBX437 00399 DTSBX437 00400 01 L003-LINK-AREA. DTSBX437 00401 ++INCLUDE DTSIL003 DTSBX437 00402 DTSBX437 00403 01 L004-LINK-AREA. DTSBX437 00404 ++INCLUDE DTSIL004 DTSBX437 00405 DTSBX437 00406 CL*16 00407 01 L005-LINK-AREA. CL*16 00408 ++INCLUDE DTSIL005 CL*16 00409 CL*31 00410 01 L205-LINK-AREA. CL*31 00411 ++INCLUDE DTSIL205 CL*31 00412 CL*16 00413 01 L910-LINK-AREA. DTSBX437 00414 ++INCLUDE DTSIL910 DTSBX437 00415 01 MSKL-REC. DTSBX437 00416 ++INCLUDE DTSIMSKL DTSBX437 00417 DTSBX437 00418 01 MHDR-REC. DTSBX437 00419 ++INCLUDE DTSIMHDR DTSBX437 00420 DTSBX437 00421 01 MQTR-REC. CL*17 00422 ++INCLUDE DTSIMQTR CL*17 00423 CL*17 00424 01 MPRF-REC. DTSBX437 00425 ++INCLUDE DTSIMPRF DTSBX437 00426 DTSBX437 00427 01 MPAY-REC. DTSBX437 00428 ++INCLUDE DTSIMPAY DTSBX437 00429 DTSBX437 00430 01 MNTE-REC. DTSBX437 00431 ++INCLUDE DTSIMNTE DTSBX437 00432 DTSBX437 00433 01 L921-LINK-AREA. DTSBX437 00434 ++INCLUDE DTSIL921 DTSBX437 00435 SKIP3 DTSBX437 00436 01 ISKL-REC. DTSBX437 00437 ++INCLUDE DTSIISKL DTSBX437 00438 SKIP3 DTSBX437 00439 01 IEIN-REC. DTSBX437 00440 ++INCLUDE DTSIIEIN DTSBX437 00441 DTSBX437 00442 01 L923-LINK-AREA. DTSBX437 00443 ++INCLUDE DTSIL923 DTSBX437 00444 EJECT DTSBX437 00445 01 ASKL-REC. DTSBX437 00446 ++INCLUDE DTSIASKL DTSBX437 00447 EJECT DTSBX437 00448 01 AHDR-REC. DTSBX437 00449 ++INCLUDE DTSIAHDR DTSBX437 00450 EJECT DTSBX437 00451 01 ARPT-REC. DTSBX437 00452 ++INCLUDE DTSIARPT DTSBX437 00453 EJECT DTSBX437 00454 01 APAY-REC. DTSBX437 00455 ++INCLUDE DTSIAPAY DTSBX437 00456 DTSBX437 00457 01 L927-LINK-AREA. DTSBX437 00458 ++INCLUDE DTSIL927 DTSBX437 00459 DTSBX437 00460 01 TSKL-REC. DTSBX437 00461 ++INCLUDE DTSITSKL DTSBX437 00462 DTSBX437 00463 01 L931-LINK-AREA. DTSBX437 00464 ++INCLUDE DTSIL931 DTSBX437 00465 DTSBX437 00466 01 FSKL-REC. DTSBX437 00467 ++INCLUDE DTSIFSKL DTSBX437 00468 DTSBX437 00469 01 R140-REC. DTSBX437 00470 ++INCLUDE DTSIR140 DTSBX437 00471 DTSBX437 00472 LINKAGE SECTION. DTSBX437 00473 DTSBX437 00474 *01 LX42-LINK-AREA. CL*14 00475 *++INCLUDE DTSILX42 CL*14 00476 DTSBX437 00477 PROCEDURE DIVISION. CL*14 00478 DTSBX437 00479 DTSBX423-MAIN. DTSBX437 00480 PERFORM I0000-INITIATE THRU I0000-EXIT. CL*27 00481 DTSBX437 00482 IF W-ERROR-YES-88 CL*27 00483 MOVE WRK-RETURN-CODE TO RETURN-CODE CL*40 00484 GO TO DTSBX423-MAIN-EXIT. CL*27 00485 CL*27 00486 PERFORM P0000-PROCESS THRU P0000-EXIT. CL*27 00487 DTSBX437 00488 PERFORM T0000-TERMINATE THRU T0000-EXIT. CL*27 00489 MOVE WRK-RETURN-CODE TO RETURN-CODE. CL*40 00490 DTSBX437 00491 DTSBX437 00492 DTSBX423-MAIN-EXIT. DTSBX437 00493 GOBACK. DTSBX437 00494 DTSBX437 00495 I0000-INITIATE. DTSBX437 00496 SET W-ERROR-NO-88 TO TRUE. DTSBX437 00497 SET W-FATAL-ERROR-NO-88 TO TRUE. DTSBX437 00498 MOVE +0 TO WRK-RETURN-CODE CL*25 00499 DTSBX437 00500 MOVE LENGTH OF R140-REC TO R140-LENGTH. DTSBX437 00501 MOVE '140' TO R140-REC-TYPE. DTSBX437 00502 DTSBX437 00503 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX437 00504 CL*16 00505 PERFORM S005-FROM-SYS THRU S005-EXIT. CL*16 00506 MOVE L005-ABSTIME TO WRK-SYS-ABSTIME. CL*16 00507 MOVE L005-SLASH-DATE TO W-SLASH-DATE. CL*49 00508 DISPLAY 'SYS DATE ' W-SLASH-DATE. CL*49 00509 MOVE W-SLASH-DATE TO HDR1-LRCM-SYS-DATE. CL*49 00510 CL*16 00511 PERFORM S910-OPEN-READ THRU S910-EXIT. CL*35 00512 PERFORM S927A-OPEN THRU S927A-EXIT. CL*42 00513 DTSBX437 00514 I0000-EXIT. DTSBX437 00515 EXIT. DTSBX437 00516 DTSBX437 00517 I2000-OPEN-FILES. DTSBX437 00518 DTSBX437 00519 OPEN INPUT TDEC-PAYT-FILE. CL*29 00520 IF W-TDEC-PAYT-EOF-88 CL*29 00521 DISPLAY 'NO TDEC PAYMENT FILES TO PROCESS ' CL*29 00522 MOVE +3 TO WRK-RETURN-CODE CL*27 00523 SET W-ERROR-YES-88 TO TRUE CL*27 00524 END-IF. CL*14 00525 CL*16 00526 OPEN OUTPUT TDEC-PEND-FILE. CL*29 00527 IF BATCH-XREF-OK-88 CL*16 00528 NEXT SENTENCE CL*16 00529 ELSE CL*16 00530 DISPLAY 'CANNOT OPEN TDEC PEND FILE ' CL*29 00531 BATCH-XREF-STATUS CL*16 00532 PERFORM S999-ABEND THRU S999-EXIT CL*16 00533 END-IF. CL*16 00534 OPEN OUTPUT REPT-PEND-FILE. CL*47 00535 IF REPT-STATUS-OK-88 CL*47 00536 NEXT SENTENCE CL*47 00537 ELSE CL*47 00538 DISPLAY 'CANNOT OPEN REPORT PENDING FILE ' CL*47 00539 REPT-STATUS CL*47 00540 PERFORM S999-ABEND THRU S999-EXIT CL*47 00541 END-IF. CL*47 00542 CL*47 00543 OPEN OUTPUT REPT-PAID-FILE. CL*47 00544 IF REPT-STATUS-OK-88 CL*47 00545 NEXT SENTENCE CL*47 00546 ELSE CL*47 00547 DISPLAY 'CANNOT OPEN REPORT PAID FILE ' CL*47 00548 REPT-STATUS CL*47 00549 PERFORM S999-ABEND THRU S999-EXIT CL*47 00550 END-IF. CL*47 00551 CL*16 00552 I2000-EXIT. DTSBX437 00553 EXIT. DTSBX437 00554 DTSBX437 00555 P0000-PROCESS. DTSBX437 00556 READ TDEC-PAYT-FILE CL*33 00557 CL*25 00558 IF W-TDEC-PAYT-EOF-88 CL*29 00559 DISPLAY 'TDEC INPUT FILE IS EMPTY ' CL*29 00560 MOVE +3 TO WRK-RETURN-CODE CL*25 00561 GO TO P0000-EXIT CL*25 00562 END-IF. CL*25 00563 CL*25 00564 PERFORM UNTIL W-TDEC-PAYT-EOF-88 CL*29 00565 PERFORM P1100-PARSE-TDEC-PAYT-REC THRU P1100-EXIT CL*30 00566 IF W-ERROR-NO-88 CL*31 00567 PERFORM P2100-PAYMENT THRU P2100-EXIT CL*25 00568 END-IF CL*31 00569 READ TDEC-PAYT-FILE CL*33 00570 END-PERFORM. CL*25 00571 CL*25 00572 DTSBX437 00573 P0000-EXIT. DTSBX437 00574 EXIT. DTSBX437 00575 P1100-PARSE-TDEC-PAYT-REC. CL*33 00576 SET W-ERROR-NO-88 TO TRUE. CL*36 00577 CL*30 00578 PERFORM CL*30 00579 VARYING SUB FROM +1 BY +1 CL*30 00580 UNTIL SUB > +100 CL*30 00581 MOVE +0 TO L205-FIELD-LENGTH (SUB) CL*30 00582 L205-INTEGER (SUB) CL*30 00583 L205-FRACTION (SUB) CL*30 00584 MOVE SPACES TO L205-TEXT (SUB) CL*30 00585 L205-DATE (SUB) CL*30 00586 SET L205-TYPE-TEXT-88 (SUB) TO TRUE CL*30 00587 END-PERFORM. CL*30 00588 CL*30 00589 IF WEB-IMP-TYPE-PAY-88 CL*30 00590 PERFORM P1100J-SET-205-FIELDS THRU P1100J-EXIT CL*31 00591 ELSE CL*30 00592 SET W-ERROR-YES-88 TO TRUE CL*30 00593 DISPLAY ' RECORD IS NOT PAY TYPE ' CL*30 00594 END-IF. CL*30 00595 DTSBX437 00596 CL*31 00597 * DISPLAY ' **** GOING TO 205 EDIT ESSP RECS ' CL*31 00598 * DISPLAY ' **** ' CL*31 00599 CL*31 00600 IF W-ERROR-NO-88 CL*31 00601 MOVE TDEC-PAYT-REC TO L205-INPUT-DATA CL*31 00602 CALL 'DTSBU205' USING L205-LINK-AREA CL*31 00603 PERFORM P1100K-BUILD-X145-REC THRU P1100K-EXIT. CL*31 00604 CL*31 00605 CL*31 00606 P1100-EXIT. CL*31 00607 EXIT. CL*31 00608 CL*31 00609 P1100J-SET-205-FIELDS. CL*31 00610 DISPLAY 'P1100J-PAY ' TDEC-PAYT-REC(1:84). CL*31 00611 INITIALIZE X145-REC. CL*31 00612 MOVE +12 TO L205-LAST-FIELD. CL*31 00613 MOVE +8 TO L205-LAST-FIELD-LEN. CL*31 00614 CL*31 00615 MOVE +3 TO L205-FIELD-LENGTH (1). CL*31 00616 SET L205-TYPE-TEXT-88 (1) TO TRUE. CL*31 00617 CL*31 00618 MOVE +6 TO L205-FIELD-LENGTH (2). CL*31 00619 SET L205-TYPE-TEXT-88 (2) TO TRUE. CL*31 00620 CL*31 00621 MOVE +6 TO L205-FIELD-LENGTH (3). CL*31 00622 SET L205-TYPE-TEXT-88 (3) TO TRUE. CL*31 00623 CL*31 00624 MOVE +6 TO L205-FIELD-LENGTH (4). CL*31 00625 SET L205-TYPE-TEXT-88 (4) TO TRUE. CL*31 00626 MOVE +3 TO L205-FIELD-LENGTH (5). CL*31 00627 SET L205-TYPE-TEXT-88 (5) TO TRUE. CL*31 00628 CL*31 00629 MOVE +2 TO L205-FIELD-LENGTH (6). CL*31 00630 SET L205-TYPE-TEXT-88 (6) TO TRUE. CL*31 00631 CL*31 00632 MOVE +2 TO L205-FIELD-LENGTH (7). CL*31 00633 SET L205-TYPE-TEXT-88 (7) TO TRUE. CL*31 00634 CL*31 00635 MOVE +2 TO L205-FIELD-LENGTH (8). CL*31 00636 SET L205-TYPE-TEXT-88 (8) TO TRUE. CL*31 00637 CL*31 00638 MOVE +14 TO L205-FIELD-LENGTH (9). CL*31 00639 SET L205-TYPE-NUMBER-88 (9) TO TRUE. CL*31 00640 MOVE +10 TO L205-FIELD-LENGTH (10). CL*31 00641 SET L205-TYPE-TEXT-88 (10) TO TRUE. CL*31 00642 CL*31 00643 MOVE +10 TO L205-FIELD-LENGTH (11). CL*31 00644 SET L205-TYPE-TEXT-88 (11) TO TRUE. CL*31 00645 CL*31 00646 MOVE +8 TO L205-FIELD-LENGTH (12). CL*31 00647 SET L205-TYPE-TEXT-88 (12) TO TRUE. CL*31 00648 CL*31 00649 CL*31 00650 P1100J-EXIT. CL*31 00651 EXIT. CL*31 00652 CL*31 00653 P1100K-BUILD-X145-REC. CL*31 00654 MOVE L205-TEXT (1) (1:03) TO X145-REC-TYPE. CL*31 00655 CL*31 00656 MOVE L205-TEXT (2) (1:06) TO X145-EMP-NO. CL*31 00657 CL*31 00658 MOVE '0' TO X145-SOURCE. CL*31 00659 CL*31 00660 MOVE L205-TEXT (3) (1:06) TO X145-QTR. CL*31 00661 * DISPLAY 'X145 QTR ' X145-QTR. CL*46 00662 CL*31 00663 MOVE L205-TEXT (8) (1:02) TO X145-PAY-TYPE. CL*31 00664 * DISPLAY 'X145 PAY TYPE ' X145-PAY-TYPE. CL*46 00665 CL*31 00666 MOVE L205-INTEGER (9) TO W-INTEGER. CL*31 00667 MOVE L205-FRACTION (9) TO W-FRACTION. CL*31 00668 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. CL*31 00669 MOVE W-NUMBER TO X145-REMITTANCE. CL*31 00670 * DISPLAY 'X145 PAY AMT ' X145-REMITTANCE. CL*46 00671 CL*31 00672 MOVE L205-TEXT (10) (1:10) TO X145-RCVD-DATE. CL*31 00673 * DISPLAY 'X145 PAY DATE ' X145-RCVD-DATE. CL*46 00674 CL*31 00675 MOVE L205-TEXT (12) TO X145-TRACE-NO. CL*31 00676 * DISPLAY 'X145 PAY NO ' X145-TRACE-NO. CL*46 00677 CL*31 00678 CL*31 00679 MOVE ZEROS TO X145-PSEUDO-BATCH. CL*31 00680 CL*31 00681 MOVE ZEROS TO X145-PSEUDO-ITEM. CL*31 00682 CL*31 00683 MOVE SPACES TO X145-APPLIC-ACCT. CL*31 00684 CL*31 00685 MOVE SPACES TO X145-CHECK-SCAN-DT. CL*31 00686 CL*31 00687 MOVE ZEROS TO X145-CHECK-SEQ-NBR. CL*31 00688 CL*31 00689 MOVE 'N' TO X145-WAIVE-INTEREST. CL*31 00690 CL*31 00691 MOVE 'N' TO X145-WAIVE-PENALTY. CL*31 00692 CL*31 00693 MOVE 'VOL' TO X145-RESP-ACTIVITY. CL*31 00694 CL*31 00695 MOVE 'TDECDCHK' TO X145-RESP-OPID. CL*45 00696 CL*31 00697 P1100K-EXIT. CL*31 00698 EXIT. CL*31 00699 CL*31 00700 P2100-PAYMENT. DTSBX437 00701 MOVE X145-EMP-NO TO W-EMP-NO. CL*29 00702 * DISPLAY ' EMP NO ' W-EMP-NO. CL*46 00703 SET W-EMP-FOUND-YES-88 TO TRUE. CL*47 00704 DTSBX437 00705 SET W-QTR-FOUND-NO-88 TO TRUE. CL*17 00706 SET W-ERROR-NO-88 TO TRUE CL*17 00707 DTSBX437 00708 ADD +1 TO W-X212-CNT. CL*29 00709 CL*29 00710 PERFORM P2110-EDIT-PAYMENT THRU P2110-EXIT. CL*29 00711 CL*47 00712 IF W-EMP-FOUND-NO-88 OR CL*47 00713 W-ERROR-YES-88 CL*47 00714 ADD 1 TO W-PEND-CNT CL*48 00715 ADD 1 TO W-MPRF-CNT CL*48 00716 ADD 1 TO W-ERRO-CNT CL*48 00717 ADD 1 TO W-X145-ERR-CNT CL*57 00718 ADD W-REMITTANCE TO W-TOT-PEND-REMITTANCE CL*57 00719 WRITE TDEC-PEND-REC FROM TDEC-PAYT-REC CL*47 00720 MOVE R140-MESSAGE TO P434-MESSAGE CL*48 00721 PERFORM P3000-WRITE-PAID-RPT THRU P3000-EXIT CL*48 00722 GO TO P2100-EXIT. CL*47 00723 CL*47 00724 CL*29 00725 CL*48 00726 PERFORM P2120-SAVE-EXT-PAY THRU P2120-EXIT CL*47 00727 ADD W-REMITTANCE TO W-TOT-PAID-REMITTANCE CL*57 00728 MOVE 'RECEIVED ' TO P434-MESSAGE CL*65 00729 PERFORM P3000-WRITE-PAID-RPT THRU P3000-EXIT. CL*48 00730 DTSBX437 00731 P2100-EXIT. DTSBX437 00732 EXIT. DTSBX437 00733 DTSBX437 00734 P2110-EDIT-PAYMENT. DTSBX437 00735 * MOVE X145-PAY-TYPE TO W-PAY-TYPE. CL*14 00736 * IF W-VALID-PAY-88 CL*14 00737 * NEXT SENTENCE CL*14 00738 * ELSE CL*14 00739 * SET W-ERROR-YES-88 TO TRUE CL*14 00740 * MOVE SPACES TO R140-MESSAGE CL*14 00741 * MOVE W-EMP-NO TO R140-EMP-NO CL*14 00742 * STRING CL*14 00743 * 'INVALID PAYMENT TYPE ' CL*14 00744 * X145-PAY-TYPE CL*14 00745 * DELIMITED BY SIZE CL*14 00746 * INTO R140-MESSAGE CL*14 00747 * END-STRING CL*14 00748 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL*14 00749 * DISPLAY R140-MESSAGE CL*14 00750 * END-IF. CL*14 00751 DTSBX437 00752 MOVE SPACES TO W-SLASH-QTR. CL*24 00753 IF X145-QTR = SPACES CL*29 00754 MOVE ZEROS TO W-REPORT-QTR DTSBX437 00755 ELSE DTSBX437 00756 MOVE X145-QTR TO W-SLASH-QTR CL*29 00757 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR DTSBX437 00758 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q DTSBX437 00759 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX437 00760 IF NOT L004-VALID-QTR DTSBX437 00761 SET W-ERROR-YES-88 TO TRUE DTSBX437 00762 MOVE SPACES TO R140-MESSAGE DTSBX437 00763 MOVE W-EMP-NO TO R140-EMP-NO DTSBX437 00764 STRING DTSBX437 00765 'PEND: INV PAY QUARTER ' W-SLASH-QTR CL*63 00766 DELIMITED BY SIZE DTSBX437 00767 INTO R140-MESSAGE DTSBX437 00768 END-STRING DTSBX437 00769 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX437 00770 DISPLAY R140-MESSAGE DTSBX437 00771 MOVE +2 TO WRK-RETURN-CODE CL*25 00772 ELSE DTSBX437 00773 MOVE L004-QTR-5-9 TO W-REPORT-QTR DTSBX437 00774 END-IF DTSBX437 00775 END-IF. DTSBX437 00776 DTSBX437 00777 MOVE X145-REMITTANCE TO W-REMITTANCE. CL*29 00778 * DISPLAY 'WREMITTANCE ' W-REMITTANCE. CL*46 00779 * DISPLAY 'XREMITTANCE ' X145-REMITTANCE. CL*46 00780 CL*38 00781 ADD W-REMITTANCE TO W-TOT-REMITTANCE. CL*57 00782 IF W-REMITTANCE = ZEROS CL*39 00783 * SET W-ERROR-YES-88 TO TRUE CL*64 00784 MOVE SPACES TO R140-MESSAGE CL*38 00785 MOVE W-EMP-NO TO R140-EMP-NO CL*38 00786 STRING CL*38 00787 'INVALID REMITTANCE AMOUNT ' X145-REMITTANCE CL*38 00788 DELIMITED BY SIZE CL*38 00789 INTO R140-MESSAGE CL*38 00790 END-STRING CL*38 00791 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*38 00792 DISPLAY R140-MESSAGE CL*38 00793 * MOVE +2 TO WRK-RETURN-CODE CL*64 00794 END-IF. CL*38 00795 CL*38 00796 DTSBX437 00797 MOVE X145-RCVD-DATE TO W-SLASH-DATE CL*30 00798 MOVE W-SLASH-DT-MM TO L001-FED-8-MO DTSBX437 00799 MOVE W-SLASH-DT-DD TO L001-FED-8-DA DTSBX437 00800 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR DTSBX437 00801 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX437 00802 IF NOT L001-VALID-DATE DTSBX437 00803 SET W-ERROR-YES-88 TO TRUE DTSBX437 00804 MOVE SPACES TO R140-MESSAGE DTSBX437 00805 MOVE W-EMP-NO TO R140-EMP-NO DTSBX437 00806 STRING DTSBX437 00807 'INVALID PAY RECEIVED DATE ' X145-RCVD-DATE CL*30 00808 DELIMITED BY SIZE DTSBX437 00809 INTO R140-MESSAGE DTSBX437 00810 END-STRING DTSBX437 00811 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX437 00812 DISPLAY R140-MESSAGE DTSBX437 00813 MOVE +2 TO WRK-RETURN-CODE CL*25 00814 ELSE DTSBX437 00815 MOVE L001-FED-8-DATE-9 TO W-RECEIVED-DATE DTSBX437 00816 END-IF. DTSBX437 00817 DTSBX437 00818 * MOVE X212-DEPOSIT-DT TO W-SLASH-DATE CL*29 00819 * MOVE W-SLASH-DT-MM TO L001-FED-8-MO CL*29 00820 * MOVE W-SLASH-DT-DD TO L001-FED-8-DA CL*29 00821 * MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR CL*29 00822 * PERFORM S001-FROM-FED-8 THRU S001-EXIT CL*29 00823 * IF NOT L001-VALID-DATE CL*29 00824 * SET W-ERROR-YES-88 TO TRUE CL*29 00825 * MOVE SPACES TO R140-MESSAGE CL*29 00826 * MOVE W-EMP-NO TO R140-EMP-NO CL*29 00827 * STRING CL*29 00828 * 'INVALID DEPOSIT DATE ' X212-DEPOSIT-DT CL*29 00829 * DELIMITED BY SIZE CL*29 00830 * INTO R140-MESSAGE CL*29 00831 * END-STRING CL*29 00832 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL*29 00833 * DISPLAY R140-MESSAGE CL*11 00834 * MOVE +2 TO WRK-RETURN-CODE CL*29 00835 * ELSE CL*29 00836 * MOVE L001-FED-8-DATE-9 TO W-DEPOSIT-DATE CL*29 00837 * END-IF. CL*11 00838 DTSBX437 00839 PERFORM P2112-CHECK-DATABASE THRU P2112-EXIT. CL*17 00840 P2110-EXIT. DTSBX437 00841 EXIT. DTSBX437 00842 DTSBX437 00843 P2112-CHECK-DATABASE. DTSBX437 00844 MOVE LOW-VALUE TO MPRF-KEY-AREA. DTSBX437 00845 MOVE W-EMP-NO TO MPRF-EMP-NO. DTSBX437 00846 SET MPRF-PRF-88 TO TRUE. DTSBX437 00847 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBX437 00848 DTSBX437 00849 PERFORM S910-READ THRU S910-EXIT. DTSBX437 00850 IF L910-NO-REC-88 DTSBX437 00851 SET W-ERROR-YES-88 TO TRUE CL*25 00852 SET W-EMP-FOUND-NO-88 TO TRUE DTSBX437 00853 DISPLAY 'PAYMENT: EMPLOYER NOT ON FILE ' W-EMP-NO CL*45 00854 MOVE SPACES TO R140-MESSAGE CL*15 00855 MOVE W-EMP-NO TO R140-EMP-NO CL*15 00856 STRING CL*15 00857 'PEND: EMP NOT ON DUTAS' CL*62 00858 X145-EMP-NO CL*30 00859 DELIMITED BY SIZE CL*15 00860 INTO R140-MESSAGE CL*15 00861 END-STRING CL*15 00862 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*15 00863 MOVE +2 TO WRK-RETURN-CODE CL*41 00864 * DISPLAY R140-MESSAGE CL*16 00865 ELSE DTSBX437 00866 MOVE MSKL-REC TO MPRF-REC DTSBX437 00867 SET W-EMP-FOUND-YES-88 TO TRUE DTSBX437 00868 END-IF. DTSBX437 00869 DTSBX437 00870 IF W-EMP-FOUND-NO-88 OR CL*62 00871 W-ERROR-YES-88 CL*62 00872 * WRITE TDEC-PEND-REC FROM TDEC-PAYT-REC CL*47 00873 * ADD 1 TO W-PEND-CNT CL*47 00874 * ADD 1 TO W-MPRF-CNT CL*47 00875 * ADD 1 TO W-ERRO-CNT CL*47 00876 GO TO P2112-EXIT. CL*62 00877 CL*16 00878 * IF EMPLOYER IS FOUND ON THE MPRF CHECK IF REPORT FOUND. CL*16 00879 * IF EITHER IS NOT FOUND WRITE T025 REC TO PENDING FILE. CL*16 00880 CL*16 00881 MOVE LOW-VALUE TO MQTR-KEY-AREA. CL*22 00882 MOVE W-EMP-NO TO MQTR-EMP-NO. CL*17 00883 MOVE W-REPORT-QTR TO MQTR-YRQ. CL*22 00884 SET MQTR-QTR-88 TO TRUE. CL*16 00885 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. CL*16 00886 CL*16 00887 PERFORM S910-READ THRU S910-EXIT. CL*16 00888 IF L910-NO-REC-88 CL*16 00889 * SET W-ERROR-YES-88 TO TRUE CL*45 00890 SET W-QTR-FOUND-NO-88 TO TRUE CL*17 00891 DISPLAY 'PAYMENT: EMPL QTR NOT ON FILE ' W-EMP-NO CL*45 00892 MOVE SPACES TO R140-MESSAGE CL*16 00893 MOVE W-EMP-NO TO R140-EMP-NO CL*16 00894 STRING CL*16 00895 'REPT: QTR RPT NOT ON FILE ' CL*64 00896 X145-EMP-NO ' QTR' W-SLASH-QTR CL*30 00897 DELIMITED BY SIZE CL*16 00898 INTO R140-MESSAGE CL*16 00899 END-STRING CL*16 00900 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*16 00901 * MOVE +2 TO WRK-RETURN-CODE CL*45 00902 * DISPLAY R140-MESSAGE CL*16 00903 ELSE CL*17 00904 SET W-QTR-FOUND-YES-88 TO TRUE CL*17 00905 END-IF. CL*16 00906 CL*16 00907 * IF W-QTR-FOUND-NO-88 OR CL*47 00908 * W-ERROR-YES-88 CL*47 00909 * WRITE TDEC-PEND-REC FROM TDEC-PAYT-REC CL*45 00910 * ADD 1 TO W-MQTR-CNT CL*47 00911 * ADD 1 TO W-ERRO-CNT CL*47 00912 * ADD 1 TO W-PEND-CNT. CL*47 00913 CL*16 00914 P2112-EXIT. DTSBX437 00915 EXIT. DTSBX437 00916 DTSBX437 00917 P2120-SAVE-EXT-PAY. DTSBX437 00918 * DISPLAY 'PAYMENT OK ' X212-EMP-NBR. CL*64 00919 * PERFORM S005-FROM-SYS THRU S005-EXIT. CL*64 00920 * CL*64 00921 * MOVE LENGTH OF T025-REC TO T025-LENGTH CL*64 00922 * MOVE '025' TO T025-REC-TYPE. CL*64 00923 * CL*64 00924 * MOVE W-EMP-NO TO T025-EMP-NO. CL*64 00925 * MOVE 'WEB PAY ' TO T025-ORIGIN. CL*64 00926 * MOVE L005-DATE TO T025-SYS-DATE. CL*64 00927 * MOVE L005-TIME TO T025-SYS-TIME. CL*64 00928 * CL*64 00929 * IF W-REPORT-QTR > ZERO CL*64 00930 * MOVE W-REPORT-QTR TO T025-APPLIC-YRQ CL*64 00931 * MOVE 'PA' TO T025-PAY-TYPE CL*64 00932 * ELSE CL*64 00933 * MOVE ZERO TO T025-APPLIC-YRQ CL*64 00934 * MOVE 'PA' TO T025-PAY-TYPE CL*64 00935 * END-IF. CL*64 00936 DTSBX437 00937 * MOVE SPACES TO T025-APPLIC-IND. CL*64 00938 * MOVE ZERO TO T025-APPLIC-BATCH-NO CL*64 00939 * T025-APPLIC-ITEM-NO. CL*64 00940 DTSBX437 00941 * IF W-EMP-FOUND-YES-88 CL*64 00942 * MOVE MPRF-PRIMARY-NAME (1:4) CL*64 00943 * TO T025-NAME-CHECK CL*64 00944 * ELSE CL*64 00945 * MOVE SPACES TO T025-NAME-CHECK CL*64 00946 * END-IF. CL*64 00947 DTSBX437 00948 * MOVE W-RECEIVED-DATE TO T025-RECEIVED-DATE CL*64 00949 * T025-DEPOSIT-DATE. CL*64 00950 DTSBX437 00951 DTSBX437 00952 * MOVE W-REMITTANCE TO T025-REMIT-AMT. CL*64 00953 DTSBX437 00954 * MOVE ZEROS TO T025-TRACE-NO. CL*64 00955 DTSBX437 00956 * MOVE 'VOL' TO T025-RESPONSIBLE-ACTIVITY. CL*64 00957 * MOVE 'TDECDCHK' TO T025-RESPONSIBLE-OP-ID. CL*64 00958 DTSBX437 00959 * MOVE T025-REC TO TSKL-REC. CL*64 00960 * PERFORM S927B-WRITE THRU S927B-EXIT. CL*64 00961 * ADD +1 TO W-T025-WRITE-CNT. CL*64 00962 DTSBX437 00963 ** DISPLAY 'BX423 PAYMENT ' X145-EMP-NO. DTSBX437 00964 P2120-EXIT. DTSBX437 00965 EXIT. DTSBX437 00966 DTSBX437 00967 DTSBX437 00968 P3000-WRITE-PAID-RPT. CL*48 00969 MOVE X145-EMP-NO TO P434-EMP-NO CL*48 00970 MOVE X145-QTR TO P434-QTR CL*48 00971 IF W-EMP-FOUND-YES-88 CL*48 00972 MOVE MPRF-PRIMARY-NAME (1:24) CL*48 00973 TO P434-NAME-CHECK CL*48 00974 ELSE CL*48 00975 MOVE SPACES TO P434-NAME-CHECK CL*48 00976 END-IF. CL*48 00977 CL*48 00978 MOVE X145-RCVD-DATE TO P434-RCVD-DATE CL*48 00979 MOVE W-REMITTANCE TO P434-X145-REMIT CL*53 00980 * ADD W-REMITTANCE TO W-X145-TOT-REMIT-AMT. CL*54 00981 CL*48 00982 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT. CL*48 00983 WRITE REPT-PAID-REC FROM DETAIL-PEND-1 AFTER 1. CL*48 00984 ADD 1 TO WS-LINE-CNT2. CL*48 00985 * ADD +1 TO WS-NUMBER-ONE. CL*50 00986 P3000-EXIT. CL*48 00987 EXIT. CL*48 00988 CL*48 00989 CL*48 00990 P4100-PRINT-HEADER. CL*48 00991 IF WS-LINE-CNT GREATER 58 OR CL*48 00992 WS-LINE-CNT2 GREATER 58 CL*48 00993 MOVE +0 TO WS-LINE-CNT CL*48 00994 MOVE +0 TO WS-LINE-CNT2 CL*48 00995 ADD +1 TO WS-PAGE-CNT CL*48 00996 MOVE WS-PAGE-CNT TO HDR3-PAGE CL*48 00997 * MOVE ' -/+ ----- MONTHLY COUNT' TO HDR5-NAME CL*50 00998 WRITE REPT-PAID-REC FROM HEADER-1 AFTER TOP-OF-PAGE CL*48 00999 WRITE REPT-PAID-REC FROM HEADER-2 AFTER 1 CL*48 01000 WRITE REPT-PAID-REC FROM HEADER-3 AFTER 1 CL*48 01001 WRITE REPT-PAID-REC FROM HEADER-4 AFTER 1 CL*48 01002 * WRITE REPT-PAID-REC FROM HEADER-42 AFTER 1 CL*50 01003 WRITE REPT-PAID-REC FROM HEADER-5 AFTER 1 CL*48 01004 WRITE REPT-PAID-REC FROM HEADER-6 AFTER 1 CL*48 01005 ADD +6 TO WS-LINE-CNT2. CL*48 01006 P4100-EXIT. CL*48 01007 EXIT. CL*48 01008 CL*48 01009 CL*48 01010 DTSBX437 01011 T0000-TERMINATE. DTSBX437 01012 IF WS-LINE-CNT2 > 52 CL*57 01013 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT CL*55 01014 END-IF. CL*55 01015 MOVE W-X212-CNT TO WS-FOOTING-CNT. CL*56 01016 MOVE W-T025-WRITE-CNT TO WS-T025-WRITE-CNT. CL*56 01017 MOVE W-X145-ERR-CNT TO WS-X145-ERR-CNT. CL*61 01018 MOVE W-X145-ERR-CNT TO WS-X145-PEN-CNT. CL*61 01019 MOVE W-TOT-PAID-REMITTANCE TO WS-TOT-REMIT. CL*57 01020 * MOVE W-TOT-REMIT-AMT TO WS-TOTAL-REMIT. CL*56 01021 MOVE W-TOT-REMITTANCE TO WS-TOTAL-REMIT. CL*60 01022 WRITE REPT-PAID-REC FROM FOOTING-LINE-1 AFTER 1. CL*55 01023 WRITE REPT-PAID-REC FROM FOOTING-LINE-2 AFTER 1. CL*55 01024 WRITE REPT-PAID-REC FROM FOOTING-LINE-3 AFTER 1. CL*55 01025 WRITE REPT-PAID-REC FROM FOOTING-LINE-4 AFTER 1. CL*55 01026 WRITE REPT-PAID-REC FROM FOOTING-LINE-5 AFTER 1. CL*55 01027 * WRITE REPT-PAID-REC FROM FOOTING-LINE-6 AFTER 1. CL*65 01028 WRITE REPT-PAID-REC FROM FOOTING-LINE-7 AFTER 1. CL*55 01029 WRITE REPT-PAID-REC FROM FOOTING-LINE-8 AFTER 1. CL*56 01030 WRITE REPT-PAID-REC FROM FOOTING-LINE-13 AFTER 3. CL*60 01031 WRITE REPT-PAID-REC FROM FOOTING-LINE-14 AFTER 1. CL*55 01032 CL*55 01033 DISPLAY ' '. CL*55 01034 CL*55 01035 CL*55 01036 DTSBX437 01037 CLOSE TDEC-PAYT-FILE TDEC-PEND-FILE. CL*29 01038 DTSBX437 01039 PERFORM S910-CLOSE THRU S910-EXIT. CL*35 01040 PERFORM S927C-CLOSE THRU S927C-EXIT. CL*43 01041 DISPLAY ' '. DTSBX437 01042 DTSBX437 01043 DISPLAY '*** DTSBX437 TERMINATION STATISTICS ***'. CL*64 01044 DTSBX437 01045 DISPLAY ' '. DTSBX437 01046 DTSBX437 01047 DISPLAY '*** TDEC REPORT PAYMENTS FOR DOES *'. CL*64 01048 DTSBX437 01049 DISPLAY ' '. DTSBX437 01050 DTSBX437 01051 PERFORM T2000-DISPLAY-TOTALS THRU T2000-EXIT. DTSBX437 01052 DTSBX437 01053 DISPLAY '***************************************'. DTSBX437 01054 DTSBX437 01055 T0000-EXIT. DTSBX437 01056 EXIT. DTSBX437 01057 DTSBX437 01058 DTSBX437 01059 T2000-DISPLAY-TOTALS. DTSBX437 01060 DISPLAY 'TDEC PAYMENTS READ : ' CL*64 01061 W-X212-CNT. CL*17 01062 CL*17 01063 DISPLAY 'TOTAL PAYMENTS PROCESSD: ' CL*64 01064 W-T025-WRITE-CNT. DTSBX437 01065 DTSBX437 01066 DISPLAY 'TOTAL PAYMTN HAD ERRORS: ' CL*64 01067 W-ERRO-CNT. CL*17 01068 CL*17 01069 DISPLAY 'MPRF RECORDS NOT FOUND : ' CL*17 01070 W-MPRF-CNT. CL*17 01071 CL*17 01072 DISPLAY 'MQTR RECORDS NOT FOUND : ' CL*17 01073 W-MQTR-CNT. CL*17 01074 CL*17 01075 DISPLAY 'PENDING PAYMENT WRITTEN: ' CL*64 01076 W-PEND-CNT. CL*17 01077 CL*17 01078 DTSBX437 01079 DISPLAY ' '. DTSBX437 01080 DTSBX437 01081 T2000-EXIT. DTSBX437 01082 EXIT. DTSBX437 01083 DTSBX437 01084 S001-FROM-FED-8. DTSBX437 01085 SET L001-FROM-FED-8 TO TRUE. DTSBX437 01086 GO TO S001-DATE. DTSBX437 01087 DTSBX437 01088 S001-FROM-CAL-8. DTSBX437 01089 SET L001-FROM-CAL-8 TO TRUE. DTSBX437 01090 GO TO S001-DATE. DTSBX437 01091 DTSBX437 01092 S001-FROM-ABS-DAY. DTSBX437 01093 SET L001-FROM-ABS-DAY TO TRUE. DTSBX437 01094 GO TO S001-DATE. DTSBX437 01095 DTSBX437 01096 S001-DATE. DTSBX437 01097 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX437 01098 S001-EXIT. DTSBX437 01099 EXIT. DTSBX437 01100 DTSBX437 01101 S003-AGENCY-DAY. DTSBX437 01102 SET L003-AGENCY-DAY TO TRUE. DTSBX437 01103 GO TO S003-WORK-DAY. DTSBX437 01104 DTSBX437 01105 S003-WORK-DAY. DTSBX437 01106 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBX437 01107 S003-EXIT. DTSBX437 01108 EXIT. DTSBX437 01109 DTSBX437 01110 S004-FROM-5. DTSBX437 01111 SET L004-FROM-5 TO TRUE. DTSBX437 01112 GO TO S004-YRQ. DTSBX437 01113 DTSBX437 01114 S004-FROM-DATE. DTSBX437 01115 SET L004-FROM-DATE TO TRUE. DTSBX437 01116 GO TO S004-YRQ. DTSBX437 01117 DTSBX437 01118 S004-FROM-ABS. DTSBX437 01119 SET L004-FROM-ABS TO TRUE. DTSBX437 01120 GO TO S004-YRQ. DTSBX437 01121 DTSBX437 01122 S004-YRQ. DTSBX437 01123 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX437 01124 DTSBX437 01125 S004-EXIT. DTSBX437 01126 EXIT. DTSBX437 01127 S005-FROM-SYS. CL*16 01128 SET L005-FROM-SYS TO TRUE. CL*16 01129 GO TO S005-ABSTIME. CL*16 01130 CL*16 01131 S005-FROM-ABSTIME. CL*16 01132 SET L005-FROM-ABSTIME TO TRUE. CL*16 01133 GO TO S005-ABSTIME. CL*16 01134 CL*16 01135 S005-ABSTIME. CL*16 01136 CALL 'DTSBU005' USING L005-LINK-AREA. CL*16 01137 S005-EXIT. CL*16 01138 EXIT. CL*16 01139 CL*32 01140 S205-WEB-EDITOR. CL*32 01141 CALL 'DTSBU205' USING L205-LINK-AREA. CL*32 01142 S205-EXIT. CL*32 01143 EXIT. CL*32 01144 DTSBX437 01145 S910-OPEN-READ. CL*35 01146 SET L910-OPEN-READ-88 TO TRUE. CL*35 01147 GO TO S910-MSTR-IO. CL*35 01148 CL*35 01149 S910-READ. DTSBX437 01150 SET L910-READ-88 TO TRUE. DTSBX437 01151 GO TO S910-MSTR-IO. DTSBX437 01152 DTSBX437 01153 S910-START-BROWSE. DTSBX437 01154 SET L910-START-BROWSE-88 TO TRUE. DTSBX437 01155 GO TO S910-MSTR-IO. DTSBX437 01156 DTSBX437 01157 S910-READ-NEXT. DTSBX437 01158 SET L910-READ-NEXT-88 TO TRUE. DTSBX437 01159 GO TO S910-MSTR-IO. DTSBX437 01160 DTSBX437 01161 S910-CLOSE. CL*35 01162 SET L910-CLOSE-88 TO TRUE. CL*35 01163 GO TO S910-MSTR-IO. CL*35 01164 DTSBX437 01165 S910-MSTR-IO. DTSBX437 01166 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX437 01167 MSKL-REC. DTSBX437 01168 S910-EXIT. DTSBX437 01169 EXIT. DTSBX437 01170 DTSBX437 01171 *S921-OPEN-READ. DTSBX437 01172 * SET L921-OPEN-READ-88 TO TRUE. DTSBX437 01173 * GO TO S921-AIX-IO. DTSBX437 01174 DTSBX437 01175 S921-READ. DTSBX437 01176 SET L921-READ-88 TO TRUE. DTSBX437 01177 GO TO S921-AIX-IO. DTSBX437 01178 DTSBX437 01179 S921-START-BROWSE. DTSBX437 01180 SET L921-START-BROWSE-88 TO TRUE. DTSBX437 01181 GO TO S921-AIX-IO. DTSBX437 01182 DTSBX437 01183 S921-READ-NEXT. DTSBX437 01184 SET L921-READ-NEXT-88 TO TRUE. DTSBX437 01185 GO TO S921-AIX-IO. DTSBX437 01186 DTSBX437 01187 *S921-CLOSE. DTSBX437 01188 * SET L921-CLOSE-88 TO TRUE. DTSBX437 01189 * GO TO S921-AIX-IO. DTSBX437 01190 DTSBX437 01191 S921-AIX-IO. DTSBX437 01192 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX437 01193 ISKL-REC. DTSBX437 01194 S921-EXIT. DTSBX437 01195 EXIT. DTSBX437 01196 DTSBX437 01197 S923-OPEN-UPDATE. DTSBX437 01198 SET L923-OPEN-UPDATE-88 TO TRUE. DTSBX437 01199 GO TO S923-ATC-CALL. DTSBX437 01200 DTSBX437 01201 S923-WRITE. DTSBX437 01202 SET L923-WRITE-88 TO TRUE. DTSBX437 01203 GO TO S923-ATC-CALL. DTSBX437 01204 DTSBX437 01205 S923-CLOSE. DTSBX437 01206 SET L923-CLOSE-88 TO TRUE. DTSBX437 01207 GO TO S923-ATC-CALL. DTSBX437 01208 DTSBX437 01209 S923-ATC-CALL. DTSBX437 01210 CALL 'DTSBU923' USING L923-LINK-AREA DTSBX437 01211 ASKL-REC. DTSBX437 01212 S923-EXIT. DTSBX437 01213 EXIT. DTSBX437 01214 DTSBX437 01215 S927A-OPEN. CL*42 01216 SET L927-OPEN-UPDATE-88 TO TRUE. CL*42 01217 PERFORM S927Z-IO THRU S927Z-EXIT. CL*42 01218 CL*42 01219 S927A-EXIT. CL*42 01220 EXIT. CL*42 01221 DTSBX437 01222 S927B-WRITE. DTSBX437 01223 SET L927-WRITE-88 TO TRUE. DTSBX437 01224 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX437 01225 DTSBX437 01226 S927B-EXIT. DTSBX437 01227 EXIT. DTSBX437 01228 DTSBX437 01229 S927C-CLOSE. CL*42 01230 SET L927-CLOSE-88 TO TRUE. CL*42 01231 PERFORM S927Z-IO THRU S927Z-EXIT. CL*42 01232 CL*42 01233 S927C-EXIT. CL*42 01234 EXIT. CL*42 01235 DTSBX437 01236 S927Z-IO. DTSBX437 01237 CALL 'DTSBU927' USING L927-LINK-AREA DTSBX437 01238 TSKL-REC. DTSBX437 01239 S927Z-EXIT. DTSBX437 01240 EXIT. DTSBX437 01241 DTSBX437 01242 S931-OPEN-READ. DTSBX437 01243 SET L931-OPEN-READ-88 TO TRUE. DTSBX437 01244 GO TO S931-REF-IO. DTSBX437 01245 DTSBX437 01246 S931-CLOSE. DTSBX437 01247 SET L931-CLOSE-88 TO TRUE. DTSBX437 01248 GO TO S931-REF-IO. DTSBX437 01249 DTSBX437 01250 S931-REF-IO. DTSBX437 01251 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX437 01252 FSKL-REC. DTSBX437 01253 S931-EXIT. DTSBX437 01254 EXIT. DTSBX437 01255 DTSBX437 01256 S946-WRITE-R140. DTSBX437 01257 CALL 'DTSBU946' USING R140-REC. DTSBX437 01258 DTSBX437 01259 S946-EXIT. DTSBX437 01260 EXIT. DTSBX437 01261 DTSBX437 01262 S999-ABEND. DTSBX437 01263 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX437 01264 S999-EXIT. DTSBX437 01265 EXIT. DTSBX437 01266 DTSBX437