1268 lines
100 KiB
COBOL
1268 lines
100 KiB
COBOL
00001 IDENTIFICATION DIVISION. 01/08/15
|
|
00002 PROGRAM-ID. DTSBX429. DTSBX429
|
|
00003 AUTHOR. NGC. LV063
|
|
00004 DATE-WRITTEN. SEPT 2014. CL*29
|
|
00005 DATE-COMPILED. DTSBX429
|
|
00006 SKIP3 DTSBX429
|
|
00007 ***** DTSBX429
|
|
00008 * DTSBX429
|
|
00009 * FUNCTION: CREATE PAYMENT TRANS (T025) FROM TDEC PAYMENT CL*28
|
|
00010 * FILE. PAYMENT WILL BE ADDED TO DUTAS FOR ESSP. CL*28
|
|
00011 * MODIFICATION HISTORY: DTSBX429
|
|
00012 * DTSBX429
|
|
00013 * 09-20-2014 INITIAL DEVELOPMENT CL*19
|
|
00014 * REFERENCE RFP: WEB REGISTRATION ESSP ZL1 CL*19
|
|
00015 * CL*19
|
|
00016 * DTSBX429
|
|
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 ***** DTSBX429
|
|
00021 SKIP3 DTSBX429
|
|
00022 ENVIRONMENT DIVISION. DTSBX429
|
|
00023 CONFIGURATION SECTION. CL*51
|
|
00024 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. CL*51
|
|
00025 CL*51
|
|
00026 INPUT-OUTPUT SECTION. DTSBX429
|
|
00027 DTSBX429
|
|
00028 FILE-CONTROL. DTSBX429
|
|
00029 DTSBX429
|
|
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 X429RPT1 CL*47
|
|
00039 FILE STATUS IS REPT-STATUS. CL*47
|
|
00040 CL*47
|
|
00041 SELECT REPT-PEND-FILE ASSIGN TO X429RPT2 CL*52
|
|
00042 FILE STATUS IS REPT-STATUS. CL*47
|
|
00043 CL*47
|
|
00044 DATA DIVISION. DTSBX429
|
|
00045 DTSBX429
|
|
00046 FILE SECTION. DTSBX429
|
|
00047 DTSBX429
|
|
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. DTSBX429
|
|
001045 77 PAN-VALET PICTURE X(24) VALUE '063DTSBX429 01/08/15'. DTSBX429
|
|
00105 SKIP3 DTSBX429
|
|
00106 01 WRK-AREA. DTSBX429
|
|
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 DTSBX429
|
|
00110 05 W-PREV-REC-TYPE PIC X(03) VALUE SPACES. DTSBX429
|
|
00111 88 W-PREV-REC-NULL-88 VALUE 'XXX'. DTSBX429
|
|
00112 88 W-PREV-REC-PRF-88 VALUE '102'. DTSBX429
|
|
00113 88 W-PREV-REC-DETERM-88 VALUE '104'. DTSBX429
|
|
00114 88 W-PREV-REC-NAME-88 VALUE '106'. DTSBX429
|
|
00115 88 W-PREV-REC-RATE-88 VALUE '108'. DTSBX429
|
|
00116 88 W-PREV-REC-ADDR-88 VALUE '110'. DTSBX429
|
|
00117 88 W-PREV-REC-OPO-88 VALUE '120'. DTSBX429
|
|
00118 88 W-PREV-REC-REL-88 VALUE '130'. DTSBX429
|
|
00119 88 W-PREV-REC-IND-88 VALUE '132'. DTSBX429
|
|
00120 88 W-PREV-REC-RPT-88 VALUE '140'. DTSBX429
|
|
00121 88 W-PREV-REC-WAGE-88 VALUE '144'. DTSBX429
|
|
00122 88 W-PREV-REC-PAY-88 VALUE '145'. DTSBX429
|
|
00123 DTSBX429
|
|
00124 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBX429
|
|
00125 88 W-ERROR-YES-88 VALUE 'Y'. DTSBX429
|
|
00126 88 W-ERROR-NO-88 VALUE 'N'. DTSBX429
|
|
00127 DTSBX429
|
|
00128 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSBX429
|
|
00129 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSBX429
|
|
00130 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSBX429
|
|
00131 DTSBX429
|
|
00132 05 BATCH-XREF-STATUS PIC X(02). DTSBX429
|
|
00133 88 BATCH-XREF-OK-88 VALUE '00'. DTSBX429
|
|
00134 DTSBX429
|
|
00135 05 W-EMP-FOUND-IND PIC X(01) VALUE 'N'. DTSBX429
|
|
00136 88 W-EMP-FOUND-YES-88 VALUE 'Y'. DTSBX429
|
|
00137 88 W-EMP-FOUND-NO-88 VALUE 'N'. DTSBX429
|
|
00138 DTSBX429
|
|
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. DTSBX429
|
|
00152 05 W-APAY-LAST PIC S9(04) COMP VALUE +0. DTSBX429
|
|
00153 05 PSUB PIC S9(04) COMP VALUE +0. DTSBX429
|
|
00154 05 W-APAY-TABLE. DTSBX429
|
|
00155 10 W-APAY-ENTRY OCCURS 100 TIMES PIC X(96). DTSBX429
|
|
00156 DTSBX429
|
|
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. DTSBX429
|
|
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. DTSBX429
|
|
00165 05 W-DEPOSIT-DATE PIC S9(09) COMP-3. DTSBX429
|
|
00166 05 W-CHK-SCAN-DATE PIC S9(09) COMP-3. DTSBX429
|
|
00167 05 W-REMIT-AMT PIC S9(09)V99 COMP-3. DTSBX429
|
|
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. DTSBX429
|
|
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 DTSBX429
|
|
00177 05 W-EARNINGS PIC S9(09)V99. DTSBX429
|
|
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 DTSBX429
|
|
00188 05 W-PAY-TYPE PIC X(02). DTSBX429
|
|
00189 88 W-PA-PAY-88 VALUE 'PA'. DTSBX429
|
|
00190 88 W-OR-PAY-88 VALUE 'OR'. DTSBX429
|
|
00191 88 W-EA-PAY-88 VALUE 'EA'. DTSBX429
|
|
00192 88 W-AU-PAY-88 VALUE 'AU'. DTSBX429
|
|
00193 88 W-FS-PAY-88 VALUE 'FS'. DTSBX429
|
|
00194 88 W-AC-PAY-88 VALUE 'AC'. DTSBX429
|
|
00195 88 W-ES-PAY-88 VALUE 'ES'. DTSBX429
|
|
00196 88 W-WD-PAY-88 VALUE 'WD'. DTSBX429
|
|
00197 88 W-PAY-REV-88 VALUE 'PR'. DTSBX429
|
|
00198 88 W-REFUND-88 VALUE 'RF'. DTSBX429
|
|
00199 88 W-REF-REV-88 VALUE 'RR'. DTSBX429
|
|
00200 88 W-NG-CHECK-88 VALUE 'NG'. DTSBX429
|
|
00201 88 W-VALID-PAY-88 VALUE 'PA' 'OR' 'EA' 'AU' DTSBX429
|
|
00202 'FS' 'AC'. DTSBX429
|
|
00203 DTSBX429
|
|
00204 05 W-SEQ-NO PIC 9(07) VALUE 0. DTSBX429
|
|
00205 DTSBX429
|
|
00206 05 W-SLASH-DATE PIC X(10). DTSBX429
|
|
00207 05 FILLER REDEFINES W-SLASH-DATE. DTSBX429
|
|
00208 10 W-SLASH-DT-MM PIC X(02). DTSBX429
|
|
00209 10 FILLER PIC X(01). DTSBX429
|
|
00210 10 W-SLASH-DT-DD PIC X(02). DTSBX429
|
|
00211 10 FILLER PIC X(01). DTSBX429
|
|
00212 10 W-SLASH-DT-CCYY PIC X(04). DTSBX429
|
|
00213 DTSBX429
|
|
00214 05 W-SLASH-QTR PIC X(06). DTSBX429
|
|
00215 05 FILLER REDEFINES W-SLASH-QTR. DTSBX429
|
|
00216 10 W-SLASH-QTR-CCYY PIC X(04). DTSBX429
|
|
00217 10 FILLER PIC X(01). DTSBX429
|
|
00218 10 W-SLASH-QTR-Q PIC X(01). DTSBX429
|
|
00219 DTSBX429
|
|
00220 * PAYMENT DTSBX429
|
|
00221 05 W-X212-CNT PIC S9(07) COMP-3 VALUE +0. CL*16
|
|
00222 DTSBX429
|
|
00223 05 W-APAY-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX429
|
|
00224 DTSBX429
|
|
00225 05 W-T025-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX429
|
|
00226 * 05 WS-T025-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. CL*57
|
|
00227 DTSBX429
|
|
00228 05 W-BX212-CNT PIC S9(07) COMP-3 VALUE +0. CL*16
|
|
00229 DTSBX429
|
|
00230 05 W-X212-LENGTH PIC S9(04) COMP. CL*16
|
|
00231 DTSBX429
|
|
00232 05 W-AMT-DISP1 PIC ----------9.99. DTSBX429
|
|
00233 05 W-AMT-DISP2 PIC ----------9.99. DTSBX429
|
|
00234 *RW1 DTSBX429
|
|
00235 05 WRK-R140-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX429
|
|
00236 05 DISPLAY-CNT PIC Z(06)9. DTSBX429
|
|
00237 05 WRK-MPRF-EMP-NO PIC 9(06). DTSBX429
|
|
00238 *RW2 DTSBX429
|
|
00239 DTSBX429
|
|
00240 01 MESSAGE-AREA. DTSBX429
|
|
00241 *** FATAL ERRORS MSG-A DTSBX429
|
|
00242 05 MSG-A1. DTSBX429
|
|
00243 10 FILLER PIC X(32) DTSBX429
|
|
00244 VALUE 'TYPE A REC NOT FIRST IN FILE: '. DTSBX429
|
|
00245 10 MSG-A1-PREV-REC-TYPE PIC X(01). DTSBX429
|
|
00246 DTSBX429
|
|
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 DEPOSITED CHECKS '. CL*54
|
|
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 CHECKS'. CL*54
|
|
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 CHECK PAYMENTS RECEIVED'. CL*60
|
|
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 APPLIED TO DUTAS '. CL*56
|
|
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 APPLID TO DUTAS '. CL*56
|
|
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 CHECK PAYMENTS RECEIVED '. CL*56
|
|
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 CHECKS PROCESSING ***'. CL*50
|
|
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. DTSBX429
|
|
00375 ++INCLUDE DTSIT025 DTSBX429
|
|
00376 DTSBX429
|
|
00377 * REPORT DTSBX429
|
|
00378 01 X140-REC. DTSBX429
|
|
00379 ++INCLUDE DTSIX140 DTSBX429
|
|
00380 DTSBX429
|
|
00381 * PAYMENT DTSBX429
|
|
00382 01 X145-REC. DTSBX429
|
|
00383 ++INCLUDE DTSIX145 DTSBX429
|
|
00384 DTSBX429
|
|
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 DTSBX429
|
|
00390 01 X214-REC. DTSBX429
|
|
00391 ++INCLUDE DTSIX214 DTSBX429
|
|
00392 DTSBX429
|
|
00393 * ERRORS DTSBX429
|
|
00394 *01 X907-REC. DTSBX429
|
|
00395 ***INCLUDE DTSIX907 DTSBX429
|
|
00396 DTSBX429
|
|
00397 01 L001-LINK-AREA. DTSBX429
|
|
00398 ++INCLUDE DTSIL001 DTSBX429
|
|
00399 DTSBX429
|
|
00400 01 L003-LINK-AREA. DTSBX429
|
|
00401 ++INCLUDE DTSIL003 DTSBX429
|
|
00402 DTSBX429
|
|
00403 01 L004-LINK-AREA. DTSBX429
|
|
00404 ++INCLUDE DTSIL004 DTSBX429
|
|
00405 DTSBX429
|
|
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. DTSBX429
|
|
00414 ++INCLUDE DTSIL910 DTSBX429
|
|
00415 01 MSKL-REC. DTSBX429
|
|
00416 ++INCLUDE DTSIMSKL DTSBX429
|
|
00417 DTSBX429
|
|
00418 01 MHDR-REC. DTSBX429
|
|
00419 ++INCLUDE DTSIMHDR DTSBX429
|
|
00420 DTSBX429
|
|
00421 01 MQTR-REC. CL*17
|
|
00422 ++INCLUDE DTSIMQTR CL*17
|
|
00423 CL*17
|
|
00424 01 MPRF-REC. DTSBX429
|
|
00425 ++INCLUDE DTSIMPRF DTSBX429
|
|
00426 DTSBX429
|
|
00427 01 MPAY-REC. DTSBX429
|
|
00428 ++INCLUDE DTSIMPAY DTSBX429
|
|
00429 DTSBX429
|
|
00430 01 MNTE-REC. DTSBX429
|
|
00431 ++INCLUDE DTSIMNTE DTSBX429
|
|
00432 DTSBX429
|
|
00433 01 L921-LINK-AREA. DTSBX429
|
|
00434 ++INCLUDE DTSIL921 DTSBX429
|
|
00435 SKIP3 DTSBX429
|
|
00436 01 ISKL-REC. DTSBX429
|
|
00437 ++INCLUDE DTSIISKL DTSBX429
|
|
00438 SKIP3 DTSBX429
|
|
00439 01 IEIN-REC. DTSBX429
|
|
00440 ++INCLUDE DTSIIEIN DTSBX429
|
|
00441 DTSBX429
|
|
00442 01 L923-LINK-AREA. DTSBX429
|
|
00443 ++INCLUDE DTSIL923 DTSBX429
|
|
00444 EJECT DTSBX429
|
|
00445 01 ASKL-REC. DTSBX429
|
|
00446 ++INCLUDE DTSIASKL DTSBX429
|
|
00447 EJECT DTSBX429
|
|
00448 01 AHDR-REC. DTSBX429
|
|
00449 ++INCLUDE DTSIAHDR DTSBX429
|
|
00450 EJECT DTSBX429
|
|
00451 01 ARPT-REC. DTSBX429
|
|
00452 ++INCLUDE DTSIARPT DTSBX429
|
|
00453 EJECT DTSBX429
|
|
00454 01 APAY-REC. DTSBX429
|
|
00455 ++INCLUDE DTSIAPAY DTSBX429
|
|
00456 DTSBX429
|
|
00457 01 L927-LINK-AREA. DTSBX429
|
|
00458 ++INCLUDE DTSIL927 DTSBX429
|
|
00459 DTSBX429
|
|
00460 01 TSKL-REC. DTSBX429
|
|
00461 ++INCLUDE DTSITSKL DTSBX429
|
|
00462 DTSBX429
|
|
00463 01 L931-LINK-AREA. DTSBX429
|
|
00464 ++INCLUDE DTSIL931 DTSBX429
|
|
00465 DTSBX429
|
|
00466 01 FSKL-REC. DTSBX429
|
|
00467 ++INCLUDE DTSIFSKL DTSBX429
|
|
00468 DTSBX429
|
|
00469 01 R140-REC. DTSBX429
|
|
00470 ++INCLUDE DTSIR140 DTSBX429
|
|
00471 DTSBX429
|
|
00472 LINKAGE SECTION. DTSBX429
|
|
00473 DTSBX429
|
|
00474 *01 LX42-LINK-AREA. CL*14
|
|
00475 *++INCLUDE DTSILX42 CL*14
|
|
00476 DTSBX429
|
|
00477 PROCEDURE DIVISION. CL*14
|
|
00478 DTSBX429
|
|
00479 DTSBX423-MAIN. DTSBX429
|
|
00480 PERFORM I0000-INITIATE THRU I0000-EXIT. CL*27
|
|
00481 DTSBX429
|
|
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 DTSBX429
|
|
00488 PERFORM T0000-TERMINATE THRU T0000-EXIT. CL*27
|
|
00489 MOVE WRK-RETURN-CODE TO RETURN-CODE. CL*40
|
|
00490 DTSBX429
|
|
00491 DTSBX429
|
|
00492 DTSBX423-MAIN-EXIT. DTSBX429
|
|
00493 GOBACK. DTSBX429
|
|
00494 DTSBX429
|
|
00495 I0000-INITIATE. DTSBX429
|
|
00496 SET W-ERROR-NO-88 TO TRUE. DTSBX429
|
|
00497 SET W-FATAL-ERROR-NO-88 TO TRUE. DTSBX429
|
|
00498 MOVE +0 TO WRK-RETURN-CODE CL*25
|
|
00499 DTSBX429
|
|
00500 MOVE LENGTH OF R140-REC TO R140-LENGTH. DTSBX429
|
|
00501 MOVE '140' TO R140-REC-TYPE. DTSBX429
|
|
00502 DTSBX429
|
|
00503 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX429
|
|
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 DTSBX429
|
|
00514 I0000-EXIT. DTSBX429
|
|
00515 EXIT. DTSBX429
|
|
00516 DTSBX429
|
|
00517 I2000-OPEN-FILES. DTSBX429
|
|
00518 DTSBX429
|
|
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. DTSBX429
|
|
00553 EXIT. DTSBX429
|
|
00554 DTSBX429
|
|
00555 P0000-PROCESS. DTSBX429
|
|
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 DTSBX429
|
|
00573 P0000-EXIT. DTSBX429
|
|
00574 EXIT. DTSBX429
|
|
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 DTSBX429
|
|
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. DTSBX429
|
|
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 DTSBX429
|
|
00705 SET W-QTR-FOUND-NO-88 TO TRUE. CL*17
|
|
00706 SET W-ERROR-NO-88 TO TRUE CL*17
|
|
00707 DTSBX429
|
|
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 'APPLIED TO DUTAS' TO P434-MESSAGE CL*48
|
|
00729 PERFORM P3000-WRITE-PAID-RPT THRU P3000-EXIT. CL*48
|
|
00730 DTSBX429
|
|
00731 P2100-EXIT. DTSBX429
|
|
00732 EXIT. DTSBX429
|
|
00733 DTSBX429
|
|
00734 P2110-EDIT-PAYMENT. DTSBX429
|
|
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 DTSBX429
|
|
00752 MOVE SPACES TO W-SLASH-QTR. CL*24
|
|
00753 IF X145-QTR = SPACES CL*29
|
|
00754 MOVE ZEROS TO W-REPORT-QTR DTSBX429
|
|
00755 ELSE DTSBX429
|
|
00756 MOVE X145-QTR TO W-SLASH-QTR CL*29
|
|
00757 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR DTSBX429
|
|
00758 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q DTSBX429
|
|
00759 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX429
|
|
00760 IF NOT L004-VALID-QTR DTSBX429
|
|
00761 SET W-ERROR-YES-88 TO TRUE DTSBX429
|
|
00762 MOVE SPACES TO R140-MESSAGE DTSBX429
|
|
00763 MOVE W-EMP-NO TO R140-EMP-NO DTSBX429
|
|
00764 STRING DTSBX429
|
|
00765 'PEND: INV PAY QUARTER ' W-SLASH-QTR CL*63
|
|
00766 DELIMITED BY SIZE DTSBX429
|
|
00767 INTO R140-MESSAGE DTSBX429
|
|
00768 END-STRING DTSBX429
|
|
00769 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX429
|
|
00770 DISPLAY R140-MESSAGE DTSBX429
|
|
00771 MOVE +2 TO WRK-RETURN-CODE CL*25
|
|
00772 ELSE DTSBX429
|
|
00773 MOVE L004-QTR-5-9 TO W-REPORT-QTR DTSBX429
|
|
00774 END-IF DTSBX429
|
|
00775 END-IF. DTSBX429
|
|
00776 DTSBX429
|
|
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*38
|
|
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*38
|
|
00794 END-IF. CL*38
|
|
00795 CL*38
|
|
00796 DTSBX429
|
|
00797 MOVE X145-RCVD-DATE TO W-SLASH-DATE CL*30
|
|
00798 MOVE W-SLASH-DT-MM TO L001-FED-8-MO DTSBX429
|
|
00799 MOVE W-SLASH-DT-DD TO L001-FED-8-DA DTSBX429
|
|
00800 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR DTSBX429
|
|
00801 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX429
|
|
00802 IF NOT L001-VALID-DATE DTSBX429
|
|
00803 SET W-ERROR-YES-88 TO TRUE DTSBX429
|
|
00804 MOVE SPACES TO R140-MESSAGE DTSBX429
|
|
00805 MOVE W-EMP-NO TO R140-EMP-NO DTSBX429
|
|
00806 STRING DTSBX429
|
|
00807 'INVALID PAY RECEIVED DATE ' X145-RCVD-DATE CL*30
|
|
00808 DELIMITED BY SIZE DTSBX429
|
|
00809 INTO R140-MESSAGE DTSBX429
|
|
00810 END-STRING DTSBX429
|
|
00811 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX429
|
|
00812 DISPLAY R140-MESSAGE DTSBX429
|
|
00813 MOVE +2 TO WRK-RETURN-CODE CL*25
|
|
00814 ELSE DTSBX429
|
|
00815 MOVE L001-FED-8-DATE-9 TO W-RECEIVED-DATE DTSBX429
|
|
00816 END-IF. DTSBX429
|
|
00817 DTSBX429
|
|
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 DTSBX429
|
|
00839 PERFORM P2112-CHECK-DATABASE THRU P2112-EXIT. CL*17
|
|
00840 P2110-EXIT. DTSBX429
|
|
00841 EXIT. DTSBX429
|
|
00842 DTSBX429
|
|
00843 P2112-CHECK-DATABASE. DTSBX429
|
|
00844 MOVE LOW-VALUE TO MPRF-KEY-AREA. DTSBX429
|
|
00845 MOVE W-EMP-NO TO MPRF-EMP-NO. DTSBX429
|
|
00846 SET MPRF-PRF-88 TO TRUE. DTSBX429
|
|
00847 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBX429
|
|
00848 DTSBX429
|
|
00849 PERFORM S910-READ THRU S910-EXIT. DTSBX429
|
|
00850 IF L910-NO-REC-88 DTSBX429
|
|
00851 SET W-ERROR-YES-88 TO TRUE CL*25
|
|
00852 SET W-EMP-FOUND-NO-88 TO TRUE DTSBX429
|
|
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 DTSBX429
|
|
00866 MOVE MSKL-REC TO MPRF-REC DTSBX429
|
|
00867 SET W-EMP-FOUND-YES-88 TO TRUE DTSBX429
|
|
00868 END-IF. DTSBX429
|
|
00869 DTSBX429
|
|
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 'PAID: QTR RPT NOT ON FILE ' CL*62
|
|
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. DTSBX429
|
|
00915 EXIT. DTSBX429
|
|
00916 DTSBX429
|
|
00917 P2120-SAVE-EXT-PAY. DTSBX429
|
|
00918 DISPLAY 'PAYMENT OK ' X212-EMP-NBR. CL*22
|
|
00919 PERFORM S005-FROM-SYS THRU S005-EXIT. CL*16
|
|
00920 DTSBX429
|
|
00921 MOVE LENGTH OF T025-REC TO T025-LENGTH DTSBX429
|
|
00922 MOVE '025' TO T025-REC-TYPE. DTSBX429
|
|
00923 DTSBX429
|
|
00924 MOVE W-EMP-NO TO T025-EMP-NO. DTSBX429
|
|
00925 MOVE 'WEB PAY ' TO T025-ORIGIN. CL*15
|
|
00926 MOVE L005-DATE TO T025-SYS-DATE. CL*16
|
|
00927 MOVE L005-TIME TO T025-SYS-TIME. CL*16
|
|
00928 CL*15
|
|
00929 IF W-REPORT-QTR > ZERO CL*62
|
|
00930 MOVE W-REPORT-QTR TO T025-APPLIC-YRQ CL*62
|
|
00931 MOVE 'PA' TO T025-PAY-TYPE CL*62
|
|
00932 ELSE CL*62
|
|
00933 MOVE ZERO TO T025-APPLIC-YRQ CL**6
|
|
00934 MOVE 'PA' TO T025-PAY-TYPE CL**6
|
|
00935 END-IF. CL*62
|
|
00936 DTSBX429
|
|
00937 MOVE SPACES TO T025-APPLIC-IND. DTSBX429
|
|
00938 MOVE ZERO TO T025-APPLIC-BATCH-NO DTSBX429
|
|
00939 T025-APPLIC-ITEM-NO. DTSBX429
|
|
00940 DTSBX429
|
|
00941 IF W-EMP-FOUND-YES-88 DTSBX429
|
|
00942 MOVE MPRF-PRIMARY-NAME (1:4) DTSBX429
|
|
00943 TO T025-NAME-CHECK DTSBX429
|
|
00944 ELSE DTSBX429
|
|
00945 MOVE SPACES TO T025-NAME-CHECK DTSBX429
|
|
00946 END-IF. DTSBX429
|
|
00947 DTSBX429
|
|
00948 MOVE W-RECEIVED-DATE TO T025-RECEIVED-DATE CL*15
|
|
00949 T025-DEPOSIT-DATE. CL*29
|
|
00950 DTSBX429
|
|
00951 DTSBX429
|
|
00952 MOVE W-REMITTANCE TO T025-REMIT-AMT. DTSBX429
|
|
00953 DTSBX429
|
|
00954 MOVE ZEROS TO T025-TRACE-NO. CL*15
|
|
00955 DTSBX429
|
|
00956 MOVE 'VOL' TO T025-RESPONSIBLE-ACTIVITY. DTSBX429
|
|
00957 MOVE 'TDECDCHK' TO T025-RESPONSIBLE-OP-ID. CL*45
|
|
00958 DTSBX429
|
|
00959 MOVE T025-REC TO TSKL-REC. DTSBX429
|
|
00960 PERFORM S927B-WRITE THRU S927B-EXIT. DTSBX429
|
|
00961 ADD +1 TO W-T025-WRITE-CNT. DTSBX429
|
|
00962 DTSBX429
|
|
00963 ** DISPLAY 'BX423 PAYMENT ' X145-EMP-NO. DTSBX429
|
|
00964 P2120-EXIT. DTSBX429
|
|
00965 EXIT. DTSBX429
|
|
00966 DTSBX429
|
|
00967 DTSBX429
|
|
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 DTSBX429
|
|
01011 T0000-TERMINATE. DTSBX429
|
|
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*55
|
|
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 DTSBX429
|
|
01037 CLOSE TDEC-PAYT-FILE TDEC-PEND-FILE. CL*29
|
|
01038 DTSBX429
|
|
01039 PERFORM S910-CLOSE THRU S910-EXIT. CL*35
|
|
01040 PERFORM S927C-CLOSE THRU S927C-EXIT. CL*43
|
|
01041 DISPLAY ' '. DTSBX429
|
|
01042 DTSBX429
|
|
01043 DISPLAY '*** DTSBX429 TERMINATION STATISTICS ***'. CL*28
|
|
01044 DTSBX429
|
|
01045 DISPLAY ' '. DTSBX429
|
|
01046 DTSBX429
|
|
01047 DISPLAY '*** TDEC DEPOSITED CHECKS FOR DOES *'. CL*45
|
|
01048 DTSBX429
|
|
01049 DISPLAY ' '. DTSBX429
|
|
01050 DTSBX429
|
|
01051 PERFORM T2000-DISPLAY-TOTALS THRU T2000-EXIT. DTSBX429
|
|
01052 DTSBX429
|
|
01053 DISPLAY '***************************************'. DTSBX429
|
|
01054 DTSBX429
|
|
01055 T0000-EXIT. DTSBX429
|
|
01056 EXIT. DTSBX429
|
|
01057 DTSBX429
|
|
01058 DTSBX429
|
|
01059 T2000-DISPLAY-TOTALS. DTSBX429
|
|
01060 DISPLAY 'TDEC CHECKS READ : ' CL*45
|
|
01061 W-X212-CNT. CL*17
|
|
01062 CL*17
|
|
01063 DISPLAY 'CHECKS DEPOSITD WRITTEN: ' CL*45
|
|
01064 W-T025-WRITE-CNT. DTSBX429
|
|
01065 DTSBX429
|
|
01066 DISPLAY 'TDEC CHECK ERRORS : ' CL*45
|
|
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 RECORDS WRITTEN: ' CL*17
|
|
01076 W-PEND-CNT. CL*17
|
|
01077 CL*17
|
|
01078 DTSBX429
|
|
01079 DISPLAY ' '. DTSBX429
|
|
01080 DTSBX429
|
|
01081 T2000-EXIT. DTSBX429
|
|
01082 EXIT. DTSBX429
|
|
01083 DTSBX429
|
|
01084 S001-FROM-FED-8. DTSBX429
|
|
01085 SET L001-FROM-FED-8 TO TRUE. DTSBX429
|
|
01086 GO TO S001-DATE. DTSBX429
|
|
01087 DTSBX429
|
|
01088 S001-FROM-CAL-8. DTSBX429
|
|
01089 SET L001-FROM-CAL-8 TO TRUE. DTSBX429
|
|
01090 GO TO S001-DATE. DTSBX429
|
|
01091 DTSBX429
|
|
01092 S001-FROM-ABS-DAY. DTSBX429
|
|
01093 SET L001-FROM-ABS-DAY TO TRUE. DTSBX429
|
|
01094 GO TO S001-DATE. DTSBX429
|
|
01095 DTSBX429
|
|
01096 S001-DATE. DTSBX429
|
|
01097 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX429
|
|
01098 S001-EXIT. DTSBX429
|
|
01099 EXIT. DTSBX429
|
|
01100 DTSBX429
|
|
01101 S003-AGENCY-DAY. DTSBX429
|
|
01102 SET L003-AGENCY-DAY TO TRUE. DTSBX429
|
|
01103 GO TO S003-WORK-DAY. DTSBX429
|
|
01104 DTSBX429
|
|
01105 S003-WORK-DAY. DTSBX429
|
|
01106 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBX429
|
|
01107 S003-EXIT. DTSBX429
|
|
01108 EXIT. DTSBX429
|
|
01109 DTSBX429
|
|
01110 S004-FROM-5. DTSBX429
|
|
01111 SET L004-FROM-5 TO TRUE. DTSBX429
|
|
01112 GO TO S004-YRQ. DTSBX429
|
|
01113 DTSBX429
|
|
01114 S004-FROM-DATE. DTSBX429
|
|
01115 SET L004-FROM-DATE TO TRUE. DTSBX429
|
|
01116 GO TO S004-YRQ. DTSBX429
|
|
01117 DTSBX429
|
|
01118 S004-FROM-ABS. DTSBX429
|
|
01119 SET L004-FROM-ABS TO TRUE. DTSBX429
|
|
01120 GO TO S004-YRQ. DTSBX429
|
|
01121 DTSBX429
|
|
01122 S004-YRQ. DTSBX429
|
|
01123 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX429
|
|
01124 DTSBX429
|
|
01125 S004-EXIT. DTSBX429
|
|
01126 EXIT. DTSBX429
|
|
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 DTSBX429
|
|
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. DTSBX429
|
|
01150 SET L910-READ-88 TO TRUE. DTSBX429
|
|
01151 GO TO S910-MSTR-IO. DTSBX429
|
|
01152 DTSBX429
|
|
01153 S910-START-BROWSE. DTSBX429
|
|
01154 SET L910-START-BROWSE-88 TO TRUE. DTSBX429
|
|
01155 GO TO S910-MSTR-IO. DTSBX429
|
|
01156 DTSBX429
|
|
01157 S910-READ-NEXT. DTSBX429
|
|
01158 SET L910-READ-NEXT-88 TO TRUE. DTSBX429
|
|
01159 GO TO S910-MSTR-IO. DTSBX429
|
|
01160 DTSBX429
|
|
01161 S910-CLOSE. CL*35
|
|
01162 SET L910-CLOSE-88 TO TRUE. CL*35
|
|
01163 GO TO S910-MSTR-IO. CL*35
|
|
01164 DTSBX429
|
|
01165 S910-MSTR-IO. DTSBX429
|
|
01166 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX429
|
|
01167 MSKL-REC. DTSBX429
|
|
01168 S910-EXIT. DTSBX429
|
|
01169 EXIT. DTSBX429
|
|
01170 DTSBX429
|
|
01171 *S921-OPEN-READ. DTSBX429
|
|
01172 * SET L921-OPEN-READ-88 TO TRUE. DTSBX429
|
|
01173 * GO TO S921-AIX-IO. DTSBX429
|
|
01174 DTSBX429
|
|
01175 S921-READ. DTSBX429
|
|
01176 SET L921-READ-88 TO TRUE. DTSBX429
|
|
01177 GO TO S921-AIX-IO. DTSBX429
|
|
01178 DTSBX429
|
|
01179 S921-START-BROWSE. DTSBX429
|
|
01180 SET L921-START-BROWSE-88 TO TRUE. DTSBX429
|
|
01181 GO TO S921-AIX-IO. DTSBX429
|
|
01182 DTSBX429
|
|
01183 S921-READ-NEXT. DTSBX429
|
|
01184 SET L921-READ-NEXT-88 TO TRUE. DTSBX429
|
|
01185 GO TO S921-AIX-IO. DTSBX429
|
|
01186 DTSBX429
|
|
01187 *S921-CLOSE. DTSBX429
|
|
01188 * SET L921-CLOSE-88 TO TRUE. DTSBX429
|
|
01189 * GO TO S921-AIX-IO. DTSBX429
|
|
01190 DTSBX429
|
|
01191 S921-AIX-IO. DTSBX429
|
|
01192 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX429
|
|
01193 ISKL-REC. DTSBX429
|
|
01194 S921-EXIT. DTSBX429
|
|
01195 EXIT. DTSBX429
|
|
01196 DTSBX429
|
|
01197 S923-OPEN-UPDATE. DTSBX429
|
|
01198 SET L923-OPEN-UPDATE-88 TO TRUE. DTSBX429
|
|
01199 GO TO S923-ATC-CALL. DTSBX429
|
|
01200 DTSBX429
|
|
01201 S923-WRITE. DTSBX429
|
|
01202 SET L923-WRITE-88 TO TRUE. DTSBX429
|
|
01203 GO TO S923-ATC-CALL. DTSBX429
|
|
01204 DTSBX429
|
|
01205 S923-CLOSE. DTSBX429
|
|
01206 SET L923-CLOSE-88 TO TRUE. DTSBX429
|
|
01207 GO TO S923-ATC-CALL. DTSBX429
|
|
01208 DTSBX429
|
|
01209 S923-ATC-CALL. DTSBX429
|
|
01210 CALL 'DTSBU923' USING L923-LINK-AREA DTSBX429
|
|
01211 ASKL-REC. DTSBX429
|
|
01212 S923-EXIT. DTSBX429
|
|
01213 EXIT. DTSBX429
|
|
01214 DTSBX429
|
|
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 DTSBX429
|
|
01222 S927B-WRITE. DTSBX429
|
|
01223 SET L927-WRITE-88 TO TRUE. DTSBX429
|
|
01224 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX429
|
|
01225 DTSBX429
|
|
01226 S927B-EXIT. DTSBX429
|
|
01227 EXIT. DTSBX429
|
|
01228 DTSBX429
|
|
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 DTSBX429
|
|
01236 S927Z-IO. DTSBX429
|
|
01237 CALL 'DTSBU927' USING L927-LINK-AREA DTSBX429
|
|
01238 TSKL-REC. DTSBX429
|
|
01239 S927Z-EXIT. DTSBX429
|
|
01240 EXIT. DTSBX429
|
|
01241 DTSBX429
|
|
01242 S931-OPEN-READ. DTSBX429
|
|
01243 SET L931-OPEN-READ-88 TO TRUE. DTSBX429
|
|
01244 GO TO S931-REF-IO. DTSBX429
|
|
01245 DTSBX429
|
|
01246 S931-CLOSE. DTSBX429
|
|
01247 SET L931-CLOSE-88 TO TRUE. DTSBX429
|
|
01248 GO TO S931-REF-IO. DTSBX429
|
|
01249 DTSBX429
|
|
01250 S931-REF-IO. DTSBX429
|
|
01251 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX429
|
|
01252 FSKL-REC. DTSBX429
|
|
01253 S931-EXIT. DTSBX429
|
|
01254 EXIT. DTSBX429
|
|
01255 DTSBX429
|
|
01256 S946-WRITE-R140. DTSBX429
|
|
01257 CALL 'DTSBU946' USING R140-REC. DTSBX429
|
|
01258 DTSBX429
|
|
01259 S946-EXIT. DTSBX429
|
|
01260 EXIT. DTSBX429
|
|
01261 DTSBX429
|
|
01262 S999-ABEND. DTSBX429
|
|
01263 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX429
|
|
01264 S999-EXIT. DTSBX429
|
|
01265 EXIT. DTSBX429
|
|
01266 DTSBX429
|