2893 lines
229 KiB
COBOL
2893 lines
229 KiB
COBOL
00001 IDENTIFICATION DIVISION. 07/15/19
|
|
00002 PROGRAM-ID. DTSBX530. DTSBX530
|
|
00003 AUTHOR. NGC. LV252
|
|
00004 DATE-WRITTEN. APRIL 2005. DTSBX530
|
|
00005 DATE-COMPILED. DTSBX530
|
|
00006 SKIP3 DTSBX530
|
|
00007 ***** DTSBX530
|
|
00008 * DTSBX530
|
|
00009 * >>> PROCESSING FOR ESSP PAYMENTS ONLY. SEPERATED REPORT CL184
|
|
00010 * >>> AND PAYMENT DUE TO ERROR PROCESSING AMENDED REPORTS. CL184
|
|
00011 * DTSBX530
|
|
00012 * FUNCTION: EDIT PAYMENT DATA FROM ESSP APPLICATION. CL184
|
|
00013 * DTSBX530
|
|
00014 * MODIFICATION HISTORY: DTSBX530
|
|
00015 * DTSBX530
|
|
00016 * 04-05-2005 INITIAL DEVELOPMENT DTSBX530
|
|
00017 * REFERENCE RFP: ESSP PAYMENTS CL184
|
|
00018 * DTSBX530
|
|
00019 * DTSBX530
|
|
00020 * CL**9
|
|
00021 * 06-15-2016 MODIFIED PROGRAM TO WRITE T25 RECORDS ONLY CL184
|
|
00022 * TO X530BTC FILE. ALSO NO WAGE RECORDS ARE CL184
|
|
00023 * WRITTEN TO TO THE WAGE BTC FILE DUE TO NO CL**9
|
|
00024 * BATCH NUMBERS, WAGE RECORDS ARE NOW WRITTEN CL**9
|
|
00025 * TO THE WAGE NAME FILE ZL1. CL184
|
|
00026 ***** DTSBX530
|
|
00027 SKIP3 DTSBX530
|
|
00028 ENVIRONMENT DIVISION. DTSBX530
|
|
00029 CL122
|
|
00030 CONFIGURATION SECTION. CL122
|
|
00031 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. CL122
|
|
00032 CL122
|
|
00033 INPUT-OUTPUT SECTION. DTSBX530
|
|
00034 DTSBX530
|
|
00035 FILE-CONTROL. DTSBX530
|
|
00036 DTSBX530
|
|
00037 SELECT TEMP-BTC-FILE ASSIGN TO X530BTC CL184
|
|
00038 FILE STATUS IS TEMP-BTC-STATUS. DTSBX530
|
|
00039 CL*59
|
|
00040 SELECT PEND-X140-FILE ASSIGN TO P530X140 CL229
|
|
00041 FILE STATUS IS REPT-140-STATUS. CL*63
|
|
00042 CL*59
|
|
00043 SELECT PEND-X144-FILE ASSIGN TO P530X144 CL229
|
|
00044 FILE STATUS IS WAGE-144-STATUS. CL*63
|
|
00045 CL*59
|
|
00046 SELECT PEND-X145-FILE ASSIGN TO P530X145 CL229
|
|
00047 FILE STATUS IS PAYT-145-STATUS. CL*63
|
|
00048 CL*59
|
|
00049 SELECT WAGE-FILE-TEMP ASSIGN TO P530WAGE CL234
|
|
00050 FILE STATUS IS WAGE-TEMP-STATUS. DTSBX530
|
|
00051 DTSBX530
|
|
00052 SELECT WAGE-FILE-OUT ASSIGN TO P530WOUT CL234
|
|
00053 FILE STATUS IS WAGE-OUT-STATUS. CL*20
|
|
00054 DTSBX530
|
|
00055 SELECT BATCH-XREF-FILE ASSIGN TO P530XREF CL234
|
|
00056 FILE STATUS IS BATCH-XREF-STATUS. DTSBX530
|
|
00057 CL119
|
|
00058 SELECT X530-PAID-FILE ASSIGN TO X530RPT1 CL233
|
|
00059 FILE STATUS IS REPT-STATUS. CL119
|
|
00060 CL119
|
|
00061 SELECT X530-PEND-FILE ASSIGN TO X530RPT2 CL233
|
|
00062 FILE STATUS IS REPT-STATUS. CL119
|
|
00063 CL119
|
|
00064 DTSBX530
|
|
00065 DATA DIVISION. DTSBX530
|
|
00066 DTSBX530
|
|
00067 FILE SECTION. DTSBX530
|
|
00068 DTSBX530
|
|
00069 FD TEMP-BTC-FILE DTSBX530
|
|
00070 RECORDING MODE IS V DTSBX530
|
|
00071 BLOCK CONTAINS 0 RECORDS. DTSBX530
|
|
00072 DTSBX530
|
|
00073 01 TEMP-BTC-REC. DTSBX530
|
|
00074 ++INCLUDE DTSIRVAR DTSBX530
|
|
00075 DTSBX530
|
|
00076 01 TSKL-REC. DTSBX530
|
|
00077 ++INCLUDE DTSITSKL DTSBX530
|
|
00078 DTSBX530
|
|
00079 FD WAGE-FILE-TEMP DTSBX530
|
|
00080 RECORDING MODE IS F DTSBX530
|
|
00081 BLOCK CONTAINS 0 RECORDS DTSBX530
|
|
00082 LABEL RECORDS ARE OMITTED. DTSBX530
|
|
00083 DTSBX530
|
|
00084 01 WAGE-TEMP-REC PIC X(128). DTSBX530
|
|
00085 DTSBX530
|
|
00086 FD WAGE-FILE-OUT CL*20
|
|
00087 RECORDING MODE IS F CL*20
|
|
00088 BLOCK CONTAINS 0 RECORDS CL*20
|
|
00089 LABEL RECORDS ARE OMITTED. CL*20
|
|
00090 DTSBX530
|
|
00091 01 WAGE-OUT-REC PIC X(80). CL*20
|
|
00092 DTSBX530
|
|
00093 FD BATCH-XREF-FILE DTSBX530
|
|
00094 RECORDING MODE IS F DTSBX530
|
|
00095 BLOCK CONTAINS 0 RECORDS DTSBX530
|
|
00096 LABEL RECORDS ARE OMITTED. DTSBX530
|
|
00097 DTSBX530
|
|
00098 01 BATCH-XREF-REC PIC X(30). DTSBX530
|
|
00099 CL*11
|
|
00100 CL*59
|
|
00101 FD PEND-X140-FILE CL*59
|
|
00102 RECORDING MODE IS F CL*59
|
|
00103 BLOCK CONTAINS 0 RECORDS CL*59
|
|
00104 LABEL RECORDS ARE OMITTED. CL*59
|
|
00105 CL*59
|
|
00106 01 PEND-X140-REC PIC X(512). CL*59
|
|
00107 DTSBX530
|
|
00108 FD PEND-X144-FILE CL*59
|
|
00109 RECORDING MODE IS F CL*59
|
|
00110 BLOCK CONTAINS 0 RECORDS CL*59
|
|
00111 LABEL RECORDS ARE OMITTED. CL*59
|
|
00112 CL*59
|
|
00113 01 PEND-X144-REC PIC X(512). CL*59
|
|
00114 CL*59
|
|
00115 FD PEND-X145-FILE CL*59
|
|
00116 RECORDING MODE IS F CL*59
|
|
00117 BLOCK CONTAINS 0 RECORDS CL*59
|
|
00118 LABEL RECORDS ARE OMITTED. CL*59
|
|
00119 CL*59
|
|
00120 01 PEND-X145-REC PIC X(512). CL*59
|
|
00121 CL119
|
|
00122 FD X530-PAID-FILE CL233
|
|
00123 RECORDING MODE IS F CL119
|
|
00124 BLOCK CONTAINS 0 RECORDS CL119
|
|
00125 LABEL RECORDS ARE OMITTED. CL119
|
|
00126 CL119
|
|
00127 01 REPT-PAID-REC PIC X(133). CL121
|
|
00128 CL119
|
|
00129 CL119
|
|
00130 FD X530-PEND-FILE CL233
|
|
00131 RECORDING MODE IS F CL119
|
|
00132 BLOCK CONTAINS 0 RECORDS CL119
|
|
00133 LABEL RECORDS ARE OMITTED. CL119
|
|
00134 CL119
|
|
00135 01 REPT-PEND-REC PIC X(133). CL119
|
|
00136 CL119
|
|
00137 CL*59
|
|
00138 WORKING-STORAGE SECTION. DTSBX530
|
|
001385 77 PAN-VALET PICTURE X(24) VALUE '252DTSBX530 07/15/19'. DTSBX530
|
|
00139 77 PAN-VALET PICTURE X(24) VALUE '015DTSBX422 10/07/14'. DTSBX530
|
|
00140 77 PAN-VALET PICTURE X(24) VALUE '047DTSBX422 09/27/14'. DTSBX530
|
|
00141 SKIP3 DTSBX530
|
|
00142 01 WRK-AREA. DTSBX530
|
|
00143 05 W-ABEND-CD PIC S9(04) COMP VALUE 430. CL*47
|
|
00144 05 W-MOD-NAME PIC X(08) VALUE 'DTSBX530'. CL184
|
|
00145 05 WS-NUMBER-ONE PIC S9(05) COMP-3 VALUE +0. CL121
|
|
00146 CL121
|
|
00147 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. CL121
|
|
00148 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. CL121
|
|
00149 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. CL121
|
|
00150 CL133
|
|
00151 05 WSP-LINE-CNT PIC S9(02) COMP-3 VALUE 60. CL133
|
|
00152 05 WSP-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. CL133
|
|
00153 05 WSP-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. CL133
|
|
00154 CL121
|
|
00155 05 W-PREV-REC-TYPE PIC X(03) VALUE SPACES. DTSBX530
|
|
00156 88 W-PREV-REC-NULL-88 VALUE 'XXX'. CL*87
|
|
00157 88 W-PREV-RPT-NULL-88 VALUE 'XXX'. CL*87
|
|
00158 88 W-PREV-REC-PRF-88 VALUE '102'. DTSBX530
|
|
00159 88 W-PREV-REC-DETERM-88 VALUE '104'. DTSBX530
|
|
00160 88 W-PREV-REC-NAME-88 VALUE '106'. DTSBX530
|
|
00161 88 W-PREV-REC-RATE-88 VALUE '108'. DTSBX530
|
|
00162 88 W-PREV-REC-ADDR-88 VALUE '110'. DTSBX530
|
|
00163 88 W-PREV-REC-OPO-88 VALUE '120'. DTSBX530
|
|
00164 88 W-PREV-REC-REL-88 VALUE '130'. DTSBX530
|
|
00165 88 W-PREV-REC-IND-88 VALUE '132'. DTSBX530
|
|
00166 88 W-PREV-REC-RPT-88 VALUE '140'. DTSBX530
|
|
00167 88 W-PREV-RPT-RPT-88 VALUE '140'. CL*86
|
|
00168 88 W-PREV-REC-WAGE-88 VALUE '144'. DTSBX530
|
|
00169 88 W-PREV-RPT-WAGE-88 VALUE '144'. CL*86
|
|
00170 88 W-PREV-REC-PAY-88 VALUE '145'. DTSBX530
|
|
00171 88 W-PREV-RPT-PAY-88 VALUE '145'. CL*86
|
|
00172 88 W-PREV-REC-BHDR-88 VALUE '149'. DTSBX530
|
|
00173 DTSBX530
|
|
00174 05 TEMP-BTC-STATUS PIC X(02). DTSBX530
|
|
00175 88 TEMP-BTC-STATUS-OK-88 VALUE '00'. DTSBX530
|
|
00176 88 TEMP-BTC-STATUS-EOF-88 VALUE '10'. DTSBX530
|
|
00177 DTSBX530
|
|
00178 05 WAGE-TEMP-STATUS PIC X(02). DTSBX530
|
|
00179 88 WAGE-TEMP-STATUS-OK-88 VALUE '00'. DTSBX530
|
|
00180 88 WAGE-TEMP-STATUS-EOF-88 VALUE '10'. DTSBX530
|
|
00181 DTSBX530
|
|
00182 05 WAGE-OUT-STATUS PIC X(02). DTSBX530
|
|
00183 88 WAGE-OUT-STATUS-OK-88 VALUE '00'. DTSBX530
|
|
00184 DTSBX530
|
|
00185 05 BATCH-XREF-STATUS PIC X(02). DTSBX530
|
|
00186 88 BATCH-XREF-OK-88 VALUE '00'. DTSBX530
|
|
00187 DTSBX530
|
|
00188 05 VAR-CHAR-CNT PIC S9(04) COMP. DTSBX530
|
|
00189 CL*12
|
|
00190 05 WAGE-TRANS-STATUS PIC X(02). CL*12
|
|
00191 88 WAGE-TRANS-FILE-OK-88 VALUE '00' '97'. CL*12
|
|
00192 88 WAGE-TRANS-FILE-NO-REC-88 VALUE '10' '23'. CL*12
|
|
00193 88 WAGE-TRANS-FILE-VERIFY-88 VALUE '97'. CL*12
|
|
00194 CL*12
|
|
00195 05 REPT-140-STATUS PIC X(02). CL*63
|
|
00196 88 REPT-140-OK-88 VALUE '00' '97'. CL*63
|
|
00197 88 REPT-140--NO-REC-88 VALUE '10' '23'. CL*63
|
|
00198 CL*61
|
|
00199 05 WAGE-144-STATUS PIC X(02). CL*63
|
|
00200 88 WAGE-144-OK-88 VALUE '00' '97'. CL*63
|
|
00201 88 WAGE-144--NO-REC-88 VALUE '10' '23'. CL*63
|
|
00202 CL*61
|
|
00203 05 PAYT-145-STATUS PIC X(02). CL*63
|
|
00204 88 PAYT-145-OK-88 VALUE '00' '97'. CL*64
|
|
00205 88 PAYT-145-NO-REC-88 VALUE '10' '23'. CL*64
|
|
00206 DTSBX530
|
|
00207 CL119
|
|
00208 05 REPT-STATUS PIC X(02). CL119
|
|
00209 88 REPT-STATUS-OK-88 VALUE '00'. CL119
|
|
00210 88 REPT-STATUS-EOF-88 VALUE '10'. CL119
|
|
00211 CL119
|
|
00212 05 W-RPT-ERROR-IND PIC X(01) VALUE 'N'. CL*80
|
|
00213 88 W-RPT-ERROR-YES-88 VALUE 'Y'. CL*81
|
|
00214 88 W-RPT-ERROR-NO-88 VALUE 'N'. CL*81
|
|
00215 DTSBX530
|
|
00216 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSBX530
|
|
00217 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSBX530
|
|
00218 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSBX530
|
|
00219 DTSBX530
|
|
00220 05 W-X145-PAYMENT-FOUND-IND PIC X(01) VALUE 'N'. CL*54
|
|
00221 88 W-X145-PAYMENT-YES-88 VALUE 'Y'. CL*54
|
|
00222 88 W-X145-PAYMENT-NO-88 VALUE 'N'. CL*54
|
|
00223 CL*54
|
|
00224 05 W-X145-PAYMENT-DUPLIC-IND PIC X(01) VALUE 'N'. CL170
|
|
00225 88 X145-PAYMENT-DUP-YES-88 VALUE 'Y'. CL170
|
|
00226 88 X145-PAYMENT-DUP-NO-88 VALUE 'N'. CL170
|
|
00227 CL170
|
|
00228 05 W-WRITE-T025-TRAN PIC X(01) VALUE 'N'. CL*73
|
|
00229 88 W-WRITE-T025-TRAN-YES-88 VALUE 'Y'. CL*73
|
|
00230 88 W-WRITE-T025-TRAN-NO-88 VALUE 'N'. CL*73
|
|
00231 CL*73
|
|
00232 05 W-EMP-FOUND-IND PIC X(01) VALUE 'N'. DTSBX530
|
|
00233 88 W-EMP-FOUND-YES-88 VALUE 'Y'. DTSBX530
|
|
00234 88 W-EMP-FOUND-NO-88 VALUE 'N'. DTSBX530
|
|
00235 DTSBX530
|
|
00236 05 W-RPT-IN-PROGRESS-IND PIC X(01) VALUE 'N'. DTSBX530
|
|
00237 88 W-RPT-IN-PROGRESS-YES-88 VALUE 'Y'. DTSBX530
|
|
00238 88 W-RPT-IN-PROGRESS-NO-88 VALUE 'N'. DTSBX530
|
|
00239 DTSBX530
|
|
00240 05 W-WAGE-IN-PROGRESS-IND PIC X(01) VALUE 'N'. DTSBX530
|
|
00241 88 W-WAGE-IN-PROGRESS-YES-88 VALUE 'Y'. DTSBX530
|
|
00242 88 W-WAGE-IN-PROGRESS-NO-88 VALUE 'N'. DTSBX530
|
|
00243 DTSBX530
|
|
00244 05 W-ARPT-MAX PIC S9(04) COMP VALUE +100. DTSBX530
|
|
00245 05 W-ARPT-LAST PIC S9(04) COMP VALUE +0. DTSBX530
|
|
00246 05 RSUB PIC S9(04) COMP VALUE +0. DTSBX530
|
|
00247 05 W-ARPT-TABLE. DTSBX530
|
|
00248 10 W-ARPT-ENTRY OCCURS 100 TIMES PIC X(128). DTSBX530
|
|
00249 DTSBX530
|
|
00250 05 W-EMP-NO PIC S9(07) COMP-3. DTSBX530
|
|
00251 05 W-PAY-QTR PIC X(06) VALUE SPACES. CL166
|
|
00252 05 W-X140-DUP PIC S9(03) COMP-3 VALUE +0. CL*41
|
|
00253 05 W-TRAN-CNT PIC S9(03) COMP-3 VALUE +0. CL*41
|
|
00254 05 W-REMIT-AMT PIC S9(09)V99 COMP-3 VALUE +0. DTSBX530
|
|
00255 05 W-T025-REMIT-AMT PIC S9(09)V99 COMP-3 VALUE +0. CL*73
|
|
00256 05 W-CURR-RPT-QTR PIC S9(05) COMP-3 VALUE +0. DTSBX530
|
|
00257 05 W-CURR-WAGE-QTR PIC S9(05) COMP-3 VALUE +0. DTSBX530
|
|
00258 05 WRK-CURR-DATE PIC 9(08) VALUE 0. CL250
|
|
00259 05 W-WAIVER-QTR PIC S9(05) COMP-3 VALUE +0. DTSBX530
|
|
00260 05 W-CURENT-QTR PIC X(06) VALUE SPACES. CL245
|
|
00261 05 W-X140-REPORT-QTR PIC S9(05) COMP-3. CL*54
|
|
00262 05 W-X145-PAYMENT-QTR PIC S9(05) COMP-3. CL*54
|
|
00263 05 W-X144-WAGE-QTR PIC S9(05) COMP-3. CL*54
|
|
00264 05 WRK-REPORT-QTR PIC 9(05). DTSBX530
|
|
00265 05 W-X145-TRACE-NO PIC X(13) VALUE SPACES. CL158
|
|
00266 05 W-X145-TRACE-NO-N REDEFINES W-X145-TRACE-NO. CL157
|
|
00267 10 W-X145-TRACE-NO-A PIC 9(08). CL158
|
|
00268 10 W-X145-TRACE-NO-B PIC 9(05). CL158
|
|
00269 05 W-TOT-WAGE PIC S9(11)V99 VALUE +0. DTSBX530
|
|
00270 05 W-TAX-WAGE PIC S9(11)V99 VALUE +0. CL123
|
|
00271 05 W-WRKR-TOT-WAGE PIC S9(11)V99 VALUE +0. DTSBX530
|
|
00272 05 W-WRKR-TAX-WAGE PIC S9(11)V99 VALUE +0. CL123
|
|
00273 05 WS-X140-REMITTANCE PIC S9(09)V99 VALUE +0. CL149
|
|
00274 05 W-X140-REMITTANCE PIC S9(09)V99 VALUE +0. CL149
|
|
00275 05 W-X145-REMITTANCE PIC S9(09)V99 VALUE +0. CL123
|
|
00276 05 W-TOT-REMIT-AMT PIC S9(09)V99 VALUE +0. CL123
|
|
00277 05 W-A145-TOT-AMT PIC S9(09)V99 VALUE +0. CL219
|
|
00278 05 W-C145-TOT-AMT PIC S9(09)V99 VALUE +0. CL219
|
|
00279 05 W-S145-TOT-AMT PIC S9(09)V99 VALUE +0. CL219
|
|
00280 05 W-OTOT-REMIT-AMT PIC S9(09)V99 VALUE +0. CL212
|
|
00281 05 W-X145-TOT-REMIT-AMT PIC S9(09)V99 VALUE +0. CL123
|
|
00282 05 W-X145-RECEIVED-DATE PIC S9(09) COMP-3. CL*72
|
|
00283 05 W-X140-RECEIVED-DATE PIC S9(09) COMP-3. CL*72
|
|
00284 05 W-ESTB-DATE PIC S9(09) COMP-3. DTSBX530
|
|
00285 05 W-X145-DEPOSIT-DATE PIC S9(09) COMP-3. CL*72
|
|
00286 05 W-CHK-SCAN-DATE PIC S9(09) COMP-3. DTSBX530
|
|
00287 05 W-1ST-MNTH-CNT PIC S9(07) COMP-3. DTSBX530
|
|
00288 05 W-2ND-MNTH-CNT PIC S9(07) COMP-3. DTSBX530
|
|
00289 05 W-3RD-MNTH-CNT PIC S9(07) COMP-3. DTSBX530
|
|
00290 05 W-WAGE-QTR PIC S9(05) COMP-3. DTSBX530
|
|
00291 05 W-SSN PIC S9(09) COMP-3. DTSBX530
|
|
00292 05 W-EARNINGS-X PIC X(12). DTSBX530
|
|
00293 05 W-EARNINGS-9 REDEFINES W-EARNINGS-X DTSBX530
|
|
00294 PIC 9(09).99. DTSBX530
|
|
00295 05 W-EARNINGS PIC S9(09)V99. DTSBX530
|
|
00296 CL180
|
|
00297 05 WS-Z145-DUP-REC PIC X(50) VALUE SPACES. CL181
|
|
00298 05 W-WORKER-NAME. DTSBX530
|
|
00299 10 W-WRKR-FIRST-NAME PIC X(15). DTSBX530
|
|
00300 10 W-WRKR-MID-INIT PIC X(01). DTSBX530
|
|
00301 10 W-WRKR-LAST-NAME PIC X(20). DTSBX530
|
|
00302 DTSBX530
|
|
00303 05 W-RPT-TYPE PIC X(02). DTSBX530
|
|
00304 88 W-ORIG-88 VALUE 'OR'. DTSBX530
|
|
00305 88 W-EMP-AMEND-88 VALUE 'EA'. DTSBX530
|
|
00306 88 W-AUDIT-88 VALUE 'AU'. DTSBX530
|
|
00307 88 W-FLD-SUP-88 VALUE 'FS'. DTSBX530
|
|
00308 88 W-ADMIN-CORR-88 VALUE 'AC'. DTSBX530
|
|
00309 88 W-ESTIM-88 VALUE 'ES'. DTSBX530
|
|
00310 88 W-WITHDRW-88 VALUE 'WD'. DTSBX530
|
|
00311 88 W-SUPPLEM-88 VALUE 'EA' 'AU' DTSBX530
|
|
00312 'FS' 'AC'. DTSBX530
|
|
00313 88 W-RPT-TYPE-VALID-88 VALUE 'OR' 'EA' 'AU' DTSBX530
|
|
00314 'FS' 'AC' 'ES'. CL*55
|
|
00315 05 WS-HOLD-X145-REC PIC X(512) VALUE SPACES. CL170
|
|
00316 CL*55
|
|
00317 05 W-PAY-TYPE PIC X(02). CL200
|
|
00318 88 W-PAY-ACH-88 VALUE '00'. CL200
|
|
00319 88 W-PAY-CHK-88 VALUE '01'. CL200
|
|
00320 88 W-PAY-SCK-88 VALUE '02'. CL200
|
|
00321 88 W-PAY-OTH-88 VALUE '03'. CL200
|
|
00322 88 W-VALID-PAY-88 VALUE '00' '01' '02' '03'. CL241
|
|
00323 88 W-VALID-EPAY-88 VALUE '00' '02'. CL241
|
|
00324 DTSBX530
|
|
00325 05 W-SEQ-NO PIC 9(07) VALUE 0. DTSBX530
|
|
00326 05 W-TRACE-NO. CL206
|
|
00327 10 W-TRACE-NOA PIC X(7). CL206
|
|
00328 10 W-TRACE-NOB PIC X(6). CL206
|
|
00329 DTSBX530
|
|
00330 05 W-MNTE-SUBJECT PIC X(40). DTSBX530
|
|
00331 88 W-MNTE-NOT-LIAB-88 VALUE DTSBX530
|
|
00332 'REASON FOR NOT-LIABLE DETERMINATION '. DTSBX530
|
|
00333 88 W-MNTE-KEY-WORD-88 VALUE DTSBX530
|
|
00334 'FR-500 INDUSTRY DESCRIPTION - KEY WORD '. DTSBX530
|
|
00335 88 W-MNTE-DATA-ENTRY-88 VALUE DTSBX530
|
|
00336 'FR-500 INDUSTRY DESCRIPTION - DATA ENTRY'. DTSBX530
|
|
00337 88 W-MNTE-RELATIONSHIP-88 VALUE DTSBX530
|
|
00338 'WEB REGISTRATION RELATED EMPLOYER '. DTSBX530
|
|
00339 DTSBX530
|
|
00340 05 W-MNTE-COMPLETE-IND PIC X(01) VALUE 'N'. DTSBX530
|
|
00341 88 W-MNTE-COMPLETE-YES-88 VALUE 'Y'. DTSBX530
|
|
00342 88 W-MNTE-COMPLETE-NO-88 VALUE 'N'. DTSBX530
|
|
00343 DTSBX530
|
|
00344 05 TSUB1 PIC S9(04) COMP. DTSBX530
|
|
00345 05 TSUB2 PIC S9(04) COMP. DTSBX530
|
|
00346 05 W-LAST-SPACE PIC S9(04) COMP. DTSBX530
|
|
00347 DTSBX530
|
|
00348 05 W-MNTE-LINE PIC X(72). DTSBX530
|
|
00349 DTSBX530
|
|
00350 05 W-SLASH-DATE PIC X(10). DTSBX530
|
|
00351 05 FILLER REDEFINES W-SLASH-DATE. DTSBX530
|
|
00352 10 W-SLASH-DT-MM PIC X(02). DTSBX530
|
|
00353 10 FILLER PIC X(01). DTSBX530
|
|
00354 10 W-SLASH-DT-DD PIC X(02). DTSBX530
|
|
00355 10 FILLER PIC X(01). DTSBX530
|
|
00356 10 W-SLASH-DT-CCYY PIC X(04). DTSBX530
|
|
00357 DTSBX530
|
|
00358 05 W-SLASH-QTR PIC X(06). DTSBX530
|
|
00359 05 FILLER REDEFINES W-SLASH-QTR. DTSBX530
|
|
00360 10 W-SLASH-QTR-CCYY PIC X(04). DTSBX530
|
|
00361 10 FILLER PIC X(01). DTSBX530
|
|
00362 10 W-SLASH-QTR-Q PIC X(01). DTSBX530
|
|
00363 DTSBX530
|
|
00364 05 W-EMP-WAGE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX530
|
|
00365 * BATCH HEADER DTSBX530
|
|
00366 05 W-X149-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX530
|
|
00367 * REPORT DTSBX530
|
|
00368 05 W-X140-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL*54
|
|
00369 05 W-X140-DUP-CNT PIC S9(07) COMP-3 VALUE +0. CL*54
|
|
00370 05 W-X140-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL*54
|
|
00371 05 W-X140-PEN-CNT PIC S9(07) COMP-3 VALUE +0. CL*94
|
|
00372 05 W-X140-PRO-CNT PIC S9(07) COMP-3 VALUE +0. CL*95
|
|
00373 05 W-X140-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL*95
|
|
00374 * EMPLOYEE WAGES DTSBX530
|
|
00375 05 W-X144-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL*54
|
|
00376 05 W-X144-DUP-CNT PIC S9(07) COMP-3 VALUE +0. CL*54
|
|
00377 05 W-X144-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL*54
|
|
00378 05 W-X144-PEN-CNT PIC S9(07) COMP-3 VALUE +0. CL*94
|
|
00379 05 W-X144-PRO-CNT PIC S9(07) COMP-3 VALUE +0. CL*95
|
|
00380 05 W-X144-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL*55
|
|
00381 DTSBX530
|
|
00382 * EMPLOYER PAYMENT CL*54
|
|
00383 05 W-X145-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL*54
|
|
00384 05 W-X145-DUP-CNT PIC S9(07) COMP-3 VALUE +0. CL*54
|
|
00385 05 W-X145-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL*54
|
|
00386 05 W-X145-PEN-CNT PIC S9(07) COMP-3 VALUE +0. CL*94
|
|
00387 05 W-X145-PRO-CNT PIC S9(07) COMP-3 VALUE +0. CL*95
|
|
00388 05 W-X145-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL*55
|
|
00389 * EMPLOYER PAYMENT-TOTALS CL220
|
|
00390 05 WS-A145-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL220
|
|
00391 05 WS-C145-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL220
|
|
00392 05 WS-S145-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL220
|
|
00393 * EMPLOYER PAYMENT-ACH CL217
|
|
00394 05 W-A145-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL217
|
|
00395 05 W-A145-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL217
|
|
00396 05 W-A145-PEN-CNT PIC S9(07) COMP-3 VALUE +0. CL217
|
|
00397 05 W-A145-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL217
|
|
00398 * EMPLOYER PAYMENT-CHECK CL217
|
|
00399 05 W-C145-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL217
|
|
00400 05 W-C145-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL217
|
|
00401 05 W-C145-PEN-CNT PIC S9(07) COMP-3 VALUE +0. CL217
|
|
00402 05 W-C145-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL217
|
|
00403 * EMPLOYER PAYMENT-SUPER CHECK CL217
|
|
00404 05 W-S145-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL217
|
|
00405 05 W-S145-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL217
|
|
00406 05 W-S145-PEN-CNT PIC S9(07) COMP-3 VALUE +0. CL217
|
|
00407 05 W-S145-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL217
|
|
00408 * EMPLOYEE W4 COUNT CL*13
|
|
00409 05 W-W4-CNT PIC S9(07) COMP-3 VALUE +0. CL*13
|
|
00410 CL*13
|
|
00411 ** 05 W-T027-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX530
|
|
00412 05 W-T028-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX530
|
|
00413 05 W-T028-WRITEO-CNT PIC S9(07) COMP-3 VALUE +0. CL100
|
|
00414 05 W-T028-WRITEE-CNT PIC S9(07) COMP-3 VALUE +0. CL102
|
|
00415 05 W-T025-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX530
|
|
00416 05 W-T025-WRITEO-CNT PIC S9(07) COMP-3 VALUE +0. CL100
|
|
00417 05 W-X145-WRITEO-CNT PIC S9(07) COMP-3 VALUE +0. CL189
|
|
00418 05 W-W001-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX530
|
|
00419 05 W-ARPT-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX530
|
|
00420 05 W-BX214-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX530
|
|
00421 DTSBX530
|
|
00422 05 W-X140-LENGTH PIC S9(04) COMP. DTSBX530
|
|
00423 05 W-X144-LENGTH PIC S9(04) COMP. DTSBX530
|
|
00424 05 W-X145-LENGTH PIC S9(04) COMP. CL*54
|
|
00425 DTSBX530
|
|
00426 05 W-AMT-DISP1 PIC ----------9.99. DTSBX530
|
|
00427 05 W-AMT-DISP2 PIC ----------9.99. DTSBX530
|
|
00428 *RW1 DTSBX530
|
|
00429 05 WRK-R140-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX530
|
|
00430 05 DISPLAY-CNT PIC Z(06)9. DTSBX530
|
|
00431 05 WRK-MPRF-EMP-NO PIC 9(06). DTSBX530
|
|
00432 *RW2 DTSBX530
|
|
00433 DTSBX530
|
|
00434 01 MESSAGE-AREA. DTSBX530
|
|
00435 *** FATAL ERRORS MSG-A DTSBX530
|
|
00436 05 MSG-A1. DTSBX530
|
|
00437 10 FILLER PIC X(32) DTSBX530
|
|
00438 VALUE 'TYPE A REC NOT FIRST IN FILE: '. DTSBX530
|
|
00439 10 MSG-A1-PREV-REC-TYPE PIC X(01). DTSBX530
|
|
00440 01 HEADER-1. CL119
|
|
00441 05 FILLER PIC X(01) VALUE SPACES. CL119
|
|
00442 05 FILLER PIC X(49) VALUE '140R1'. CL119
|
|
00443 05 FILLER PIC X(60) VALUE CL119
|
|
00444 'DISTRICT OF COLUMBIA'. CL119
|
|
00445 05 FILLER PIC X(06) VALUE 'DATE:'. CL119
|
|
00446 05 HDR1-LRCM-SYS-DATE PIC X(10). CL251
|
|
00447 01 HEADER-2. CL119
|
|
00448 05 FILLER PIC X(54) VALUE SPACES. CL119
|
|
00449 05 FILLER PIC X(56) VALUE CL119
|
|
00450 'TAX DIVISION'. CL119
|
|
00451 05 FILLER PIC X(06) VALUE 'TIME:'. CL119
|
|
00452 05 HDR2-LRCM-SYS-TIME PIC X(08). CL119
|
|
00453 CL119
|
|
00454 01 HEADER-3. CL119
|
|
00455 05 FILLER PIC X(01) VALUE SPACES. CL119
|
|
00456 05 FILLER PIC X(38) VALUE CL119
|
|
00457 'ROUTE TO: TAX ACCOUNTING STAFF'. CL119
|
|
00458 05 HDR3-LITERAL PIC X(43) VALUE CL119
|
|
00459 ' DAILY TOTAL PAYMENTS RECEIVED REPORT '. CL222
|
|
00460 05 FILLER PIC X(28) VALUE SPACES. CL119
|
|
00461 05 FILLER PIC X(06) VALUE 'PAGE:'. CL119
|
|
00462 05 HDR3-PAGE PIC ZZ,ZZ9. CL119
|
|
00463 CL119
|
|
00464 01 HEADER-31. CL131
|
|
00465 05 FILLER PIC X(01) VALUE SPACES. CL131
|
|
00466 05 FILLER PIC X(38) VALUE CL131
|
|
00467 'ROUTE TO: TAX ACCOUNTING STAFF'. CL131
|
|
00468 05 HDR3-LITERAL PIC X(43) VALUE CL131
|
|
00469 ' ESSP-TDEC DAILY PAYMENTS REPORT '. CL188
|
|
00470 05 FILLER PIC X(28) VALUE SPACES. CL131
|
|
00471 05 FILLER PIC X(06) VALUE 'PAGE:'. CL131
|
|
00472 05 HDR31-PAGE PIC ZZ,ZZ9. CL131
|
|
00473 CL131
|
|
00474 01 HEADER-4. CL119
|
|
00475 05 FILLER PIC X(01) VALUE SPACES. CL119
|
|
00476 05 FILLER PIC X(132) VALUE SPACES. CL119
|
|
00477 01 HEADER-42. CL144
|
|
00478 05 FILLER PIC X(02) VALUE SPACES. CL144
|
|
00479 05 FILLER PIC X(34) VALUE CL144
|
|
00480 ' '. CL144
|
|
00481 05 FILLER PIC X(02) VALUE SPACES. CL144
|
|
00482 05 FILLER PIC X(25) VALUE CL144
|
|
00483 ' '. CL144
|
|
00484 05 FILLER PIC X(03) VALUE SPACES. CL144
|
|
00485 05 FILLER PIC X(43) VALUE CL153
|
|
00486 ' '. CL195
|
|
00487 05 FILLER PIC X(30) VALUE CL152
|
|
00488 ' '. CL195
|
|
00489 CL119
|
|
00490 01 HEADER-5. CL119
|
|
00491 05 FILLER PIC X(02) VALUE SPACES. CL126
|
|
00492 05 FILLER PIC X(34) VALUE CL119
|
|
00493 'EMP NO NAME QTR '. CL202
|
|
00494 05 FILLER PIC X(02) VALUE SPACES. CL126
|
|
00495 05 FILLER PIC X(36) VALUE CL209
|
|
00496 ' PAID AMT PAY-ID PAY-TYPE '. CL210
|
|
00497 05 FILLER PIC X(01) VALUE SPACES. CL210
|
|
00498 05 FILLER PIC X(11) VALUE CL210
|
|
00499 'RECV-DATE '. CL210
|
|
00500 05 FILLER PIC X(01) VALUE SPACES. CL210
|
|
00501 05 HDR5-NAME PIC X(28) VALUE CL138
|
|
00502 ' '. CL195
|
|
00503 CL119
|
|
00504 01 HEADER-6. CL119
|
|
00505 05 FILLER PIC X(01) VALUE SPACES. CL119
|
|
00506 05 FILLER PIC X(132) VALUE SPACES. CL119
|
|
00507 01 DETAIL-LINE-1. CL119
|
|
00508 15 FILLER PIC X(02) VALUE SPACES. CL119
|
|
00509 15 X434-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL119
|
|
00510 15 FILLER PIC X(02) VALUE SPACES. CL119
|
|
00511 15 X434-NAME-CHECK PIC X(04) VALUE SPACES. CL119
|
|
00512 15 FILLER PIC X(02) VALUE SPACES. CL119
|
|
00513 15 X434-QTR PIC X(06). CL119
|
|
00514 15 FILLER PIC X(02) VALUE SPACES. CL119
|
|
00515 15 X434-RCVD-DATE PIC X(10). CL119
|
|
00516 15 FILLER PIC X(01) VALUE SPACES. CL119
|
|
00517 15 X434-TOT-WAGE PIC --------9.99. CL119
|
|
00518 15 FILLER PIC X(01) VALUE SPACES. CL119
|
|
00519 15 X434-EXC-WAGE PIC --------9.99. CL119
|
|
00520 15 FILLER PIC X(01) VALUE SPACES. CL119
|
|
00521 15 X434-TAX-WAGE PIC --------9.99. CL119
|
|
00522 15 FILLER PIC X(01) VALUE SPACES. CL119
|
|
00523 15 X434-X140-REMIT PIC --------9.99. CL119
|
|
00524 15 FILLER PIC X(01) VALUE SPACES. CL119
|
|
00525 15 X434-X145-REMIT PIC --------9.99. CL119
|
|
00526 15 FILLER PIC X(01) VALUE SPACES. CL148
|
|
00527 15 X434-DIFF PIC ----9.99. CL148
|
|
00528 * 15 X434-MESSAGE PIC X(20). CL125
|
|
00529 15 X434-M1-CNT PIC ZZZZZZ9. CL129
|
|
00530 15 X434-M2-CNT PIC ZZZZZZ9. CL129
|
|
00531 15 X434-M3-CNT PIC ZZZZZZ9. CL129
|
|
00532 CL119
|
|
00533 01 DETAIL-PEND-1. CL131
|
|
00534 15 FILLER PIC X(02) VALUE SPACES. CL131
|
|
00535 15 P434-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL131
|
|
00536 15 FILLER PIC X(02) VALUE SPACES. CL131
|
|
00537 15 P434-NAME-CHECK PIC X(15) VALUE SPACES. CL190
|
|
00538 15 FILLER PIC X(02) VALUE SPACES. CL131
|
|
00539 15 P434-QTR PIC X(06). CL131
|
|
00540 15 FILLER PIC X(02) VALUE SPACES. CL131
|
|
00541 15 P434-X145-REMIT PIC --------9.99. CL190
|
|
00542 15 FILLER PIC X(05) VALUE SPACES. CL206
|
|
00543 15 P434-TRACE-NO PIC X(06). CL207
|
|
00544 15 FILLER PIC X(05) VALUE SPACES. CL206
|
|
00545 15 P434-X145-TYPE PIC X(09). CL207
|
|
00546 15 FILLER PIC X(02) VALUE SPACES. CL199
|
|
00547 15 P434-RCVD-DATE PIC X(10). CL131
|
|
00548 15 FILLER PIC X(03) VALUE SPACES. CL196
|
|
00549 15 P434-MESSAGE PIC X(30). CL136
|
|
00550 CL131
|
|
00551 01 FOOTING-LINE-1 PIC X(133) VALUE SPACES. CL119
|
|
00552 01 FOOTING-LINE-2 PIC X(133) VALUE SPACES. CL119
|
|
00553 CL119
|
|
00554 01 FOOTING-LINE-3. CL119
|
|
00555 05 FILLER PIC X(25) VALUE SPACES. CL119
|
|
00556 05 WS-FOOTING-CNT PIC ZZ,ZZ9. CL119
|
|
00557 05 FILLER PIC X(02) VALUE SPACES. CL119
|
|
00558 05 FILLER PIC X(34) VALUE CL119
|
|
00559 'TOTAL DAILY PAYMENT RECEIVED'. CL195
|
|
00560 05 FILLER PIC X(32) VALUE CL221
|
|
00561 ' '. CL222
|
|
00562 CL119
|
|
00563 01 FOOTING-LINE-4. CL153
|
|
00564 05 FILLER PIC X(25) VALUE SPACES. CL119
|
|
00565 05 WS-X145-ERR-CNT PIC ZZ,ZZ9. CL119
|
|
00566 05 FILLER PIC X(02) VALUE SPACES. CL119
|
|
00567 05 FILLER PIC X(34) VALUE CL119
|
|
00568 ' # OF PAYMENTS HAD ERRORS '. CL119
|
|
00569 05 FILLER PIC X(32) VALUE SPACES. CL119
|
|
00570 CL119
|
|
00571 01 FOOTING-LINE-5. CL153
|
|
00572 05 FILLER PIC X(25) VALUE SPACES. CL119
|
|
00573 05 WS-X145-PEN-CNT PIC ZZ,ZZ9. CL119
|
|
00574 05 FILLER PIC X(02) VALUE SPACES. CL119
|
|
00575 05 FILLER PIC X(40) VALUE CL130
|
|
00576 ' # OF PAYMENTS WENT TO PENDING STATUS'. CL130
|
|
00577 05 FILLER PIC X(32) VALUE SPACES. CL119
|
|
00578 01 FOOTING-LINE-6. CL153
|
|
00579 05 FILLER PIC X(25) VALUE SPACES. CL130
|
|
00580 05 WS-A145-RED-CNT PIC ZZ,ZZ9. CL214
|
|
00581 05 FILLER PIC X(02) VALUE SPACES. CL130
|
|
00582 05 FILLER PIC X(34) VALUE CL130
|
|
00583 'TOTAL ACH PAYMENT RECV FROM ESSP '. CL211
|
|
00584 05 FILLER PIC X(32) VALUE SPACES. CL130
|
|
00585 01 FOOTING-LINE-7. CL153
|
|
00586 05 FILLER PIC X(25) VALUE SPACES. CL130
|
|
00587 05 WS-A145-ERR-CNT PIC ZZ,ZZ9. CL214
|
|
00588 05 FILLER PIC X(02) VALUE SPACES. CL130
|
|
00589 05 FILLER PIC X(34) VALUE CL130
|
|
00590 ' # OF ACH PAYMENTS HAD ERRORS '. CL211
|
|
00591 05 FILLER PIC X(32) VALUE SPACES. CL130
|
|
00592 CL130
|
|
00593 01 FOOTING-LINE-8. CL153
|
|
00594 05 FILLER PIC X(19) VALUE SPACES. CL214
|
|
00595 05 WS-A145-TOT-AMT PIC $$$$$$$$9.99. CL219
|
|
00596 05 FILLER PIC X(02) VALUE SPACES. CL130
|
|
00597 05 FILLER PIC X(40) VALUE CL130
|
|
00598 ' $AMT ACH PAYMENTS SENT TO DUTAS '. CL224
|
|
00599 05 FILLER PIC X(32) VALUE SPACES. CL130
|
|
00600 CL119
|
|
00601 01 FOOTING-LINE-9. CL153
|
|
00602 05 FILLER PIC X(24) VALUE SPACES. CL153
|
|
00603 05 WS-C145-RED-CNT PIC ZZZ,ZZ9. CL213
|
|
00604 05 FILLER PIC X(02) VALUE SPACES. CL153
|
|
00605 05 FILLER PIC X(36) VALUE CL211
|
|
00606 'TOTAL CHECK PAYMENTS RECV FROM TDEC'. CL211
|
|
00607 05 FILLER PIC X(32) VALUE SPACES. CL153
|
|
00608 01 FOOTING-LINE-10. CL153
|
|
00609 05 FILLER PIC X(24) VALUE SPACES. CL153
|
|
00610 05 WS-C145-ERR-CNT PIC ZZZ,ZZ9. CL213
|
|
00611 05 FILLER PIC X(02) VALUE SPACES. CL153
|
|
00612 05 FILLER PIC X(34) VALUE CL153
|
|
00613 ' # OF CHECK PAYMTS HAD ERRORS '. CL211
|
|
00614 05 FILLER PIC X(32) VALUE SPACES. CL153
|
|
00615 CL153
|
|
00616 01 FOOTING-LINE-11. CL153
|
|
00617 05 FILLER PIC X(19) VALUE SPACES. CL214
|
|
00618 05 WS-C145-TOT-AMT PIC $$$$$$$$9.99. CL220
|
|
00619 05 FILLER PIC X(02) VALUE SPACES. CL153
|
|
00620 05 FILLER PIC X(40) VALUE CL153
|
|
00621 ' $AMT CHECK PAYMENTS SENT TO DUTAS '. CL224
|
|
00622 05 FILLER PIC X(32) VALUE SPACES. CL218
|
|
00623 01 FOOTING-LINE-12. CL218
|
|
00624 05 FILLER PIC X(24) VALUE SPACES. CL218
|
|
00625 05 WS-S145-RED-CNT PIC ZZZ,ZZ9. CL218
|
|
00626 05 FILLER PIC X(02) VALUE SPACES. CL218
|
|
00627 05 FILLER PIC X(36) VALUE CL218
|
|
00628 'TOTAL SUPER CHECK PAYMENTS RECEIVED'. CL218
|
|
00629 05 FILLER PIC X(32) VALUE SPACES. CL218
|
|
00630 01 FOOTING-LINE-13. CL218
|
|
00631 05 FILLER PIC X(24) VALUE SPACES. CL218
|
|
00632 05 WS-S145-ERR-CNT PIC ZZZ,ZZ9. CL218
|
|
00633 05 FILLER PIC X(02) VALUE SPACES. CL218
|
|
00634 05 FILLER PIC X(34) VALUE CL218
|
|
00635 ' # OF S-CHECK PAYMTS HAD ERRORS'. CL219
|
|
00636 05 FILLER PIC X(32) VALUE SPACES. CL218
|
|
00637 CL218
|
|
00638 01 FOOTING-LINE-14. CL218
|
|
00639 05 FILLER PIC X(19) VALUE SPACES. CL218
|
|
00640 05 WS-S145-TOT-AMT PIC $$$$$$$$9.99. CL219
|
|
00641 05 FILLER PIC X(02) VALUE SPACES. CL218
|
|
00642 05 FILLER PIC X(41) VALUE CL219
|
|
00643 ' $AMT S-CHECK PAYMENTS SENT TO DUTAS'. CL222
|
|
00644 05 FILLER PIC X(32) VALUE SPACES. CL218
|
|
00645 01 FOOTING-LINE-14-2. CL224
|
|
00646 05 FILLER PIC X(23) VALUE SPACES. CL224
|
|
00647 05 FILLER PIC X(70) VALUE CL224
|
|
00648 '----------------------------------------------'. CL224
|
|
00649 05 FILLER PIC X(32) VALUE SPACES. CL224
|
|
00650 01 FOOTING-LINE-15. CL218
|
|
00651 05 FILLER PIC X(19) VALUE SPACES. CL119
|
|
00652 05 WS-TOT-REMIT PIC $$$$$$$$9.99. CL119
|
|
00653 05 FILLER PIC X(02) VALUE SPACES. CL119
|
|
00654 05 FILLER PIC X(36) VALUE CL119
|
|
00655 ' TOTAL REMIT AMOUNT --SENT- TO DUTAS'. CL214
|
|
00656 05 FILLER PIC X(32) VALUE SPACES. CL119
|
|
00657 CL119
|
|
00658 01 FOOTING-LINE-16. CL218
|
|
00659 05 FILLER PIC X(23) VALUE SPACES. CL224
|
|
00660 05 FILLER PIC X(70) VALUE CL224
|
|
00661 '******** END DAILY PAYMENT PROCESSING ********'. CL223
|
|
00662 01 FOOTING-LINE-17 PIC X(133) VALUE SPACES. CL223
|
|
00663 DTSBX530
|
|
00664 01 T003-REC. DTSBX530
|
|
00665 ++INCLUDE DTSIT003 DTSBX530
|
|
00666 DTSBX530
|
|
00667 01 T025-REC. DTSBX530
|
|
00668 ++INCLUDE DTSIT025 DTSBX530
|
|
00669 DTSBX530
|
|
00670 *01 T027-REC. DTSBX530
|
|
00671 *++INCLUDE DTSIT027 DTSBX530
|
|
00672 DTSBX530
|
|
00673 01 T028-REC. DTSBX530
|
|
00674 ++INCLUDE DTSIT028 DTSBX530
|
|
00675 DTSBX530
|
|
00676 CL*11
|
|
00677 01 W001-REC. DTSBX530
|
|
00678 ++INCLUDE DTSIW001 DTSBX530
|
|
00679 CL*11
|
|
00680 01 WAGE-TRANS-AREA. CL*11
|
|
00681 05 ESP-TRANSACTION-AREA PIC X(80). CL*11
|
|
00682 ++INCLUDE EWGTRNW4 CL*11
|
|
00683 CL*11
|
|
00684 DTSBX530
|
|
00685 * ACCOUNTING BATCH HEADER DTSBX530
|
|
00686 01 X149-REC. DTSBX530
|
|
00687 ++INCLUDE DTSIX149 DTSBX530
|
|
00688 DTSBX530
|
|
00689 * REPORT DTSBX530
|
|
00690 01 X140-REC. DTSBX530
|
|
00691 ++INCLUDE DTSIX140 DTSBX530
|
|
00692 DTSBX530
|
|
00693 * EMPLOYEE WAGES DTSBX530
|
|
00694 01 X144-REC. DTSBX530
|
|
00695 ++INCLUDE DTSIX144 DTSBX530
|
|
00696 DTSBX530
|
|
00697 * PAYMENTS CL*47
|
|
00698 01 X145-REC. CL*47
|
|
00699 ++INCLUDE DTSIX145 CL*47
|
|
00700 CL*47
|
|
00701 * BATCH - PSEUDO-BATCH XREF DTSBX530
|
|
00702 01 X214-REC. DTSBX530
|
|
00703 ++INCLUDE DTSIX214 DTSBX530
|
|
00704 DTSBX530
|
|
00705 * ERRORS DTSBX530
|
|
00706 *01 X907-REC. DTSBX530
|
|
00707 ***INCLUDE DTSIX907 DTSBX530
|
|
00708 DTSBX530
|
|
00709 01 L001-LINK-AREA. DTSBX530
|
|
00710 ++INCLUDE DTSIL001 DTSBX530
|
|
00711 DTSBX530
|
|
00712 01 L003-LINK-AREA. DTSBX530
|
|
00713 ++INCLUDE DTSIL003 DTSBX530
|
|
00714 DTSBX530
|
|
00715 01 L004-LINK-AREA. DTSBX530
|
|
00716 ++INCLUDE DTSIL004 DTSBX530
|
|
00717 DTSBX530
|
|
00718 01 L516-LINK-AREA. DTSBX530
|
|
00719 ++INCLUDE DTSIL516 DTSBX530
|
|
00720 DTSBX530
|
|
00721 01 L910-LINK-AREA. DTSBX530
|
|
00722 ++INCLUDE DTSIL910 DTSBX530
|
|
00723 01 MSKL-REC. DTSBX530
|
|
00724 ++INCLUDE DTSIMSKL DTSBX530
|
|
00725 DTSBX530
|
|
00726 01 MHDR-REC. DTSBX530
|
|
00727 ++INCLUDE DTSIMHDR DTSBX530
|
|
00728 DTSBX530
|
|
00729 01 MPRF-REC. DTSBX530
|
|
00730 ++INCLUDE DTSIMPRF DTSBX530
|
|
00731 DTSBX530
|
|
00732 01 MSOL-REC. DTSBX530
|
|
00733 ++INCLUDE DTSIMSOL DTSBX530
|
|
00734 DTSBX530
|
|
00735 01 MQTR-REC. DTSBX530
|
|
00736 ++INCLUDE DTSIMQTR DTSBX530
|
|
00737 DTSBX530
|
|
00738 01 MRPT-REC. CL178
|
|
00739 ++INCLUDE DTSIMRPT CL178
|
|
00740 CL178
|
|
00741 01 MOPO-REC. DTSBX530
|
|
00742 ++INCLUDE DTSIMOPO DTSBX530
|
|
00743 DTSBX530
|
|
00744 01 MTAD-REC. DTSBX530
|
|
00745 ++INCLUDE DTSIMTAD DTSBX530
|
|
00746 DTSBX530
|
|
00747 01 MNTE-REC. DTSBX530
|
|
00748 ++INCLUDE DTSIMNTE DTSBX530
|
|
00749 DTSBX530
|
|
00750 01 L921-LINK-AREA. DTSBX530
|
|
00751 ++INCLUDE DTSIL921 DTSBX530
|
|
00752 SKIP3 DTSBX530
|
|
00753 01 ISKL-REC. DTSBX530
|
|
00754 ++INCLUDE DTSIISKL DTSBX530
|
|
00755 SKIP3 DTSBX530
|
|
00756 01 IEIN-REC. DTSBX530
|
|
00757 ++INCLUDE DTSIIEIN DTSBX530
|
|
00758 DTSBX530
|
|
00759 01 L923-LINK-AREA. DTSBX530
|
|
00760 ++INCLUDE DTSIL923 DTSBX530
|
|
00761 EJECT DTSBX530
|
|
00762 01 ASKL-REC. DTSBX530
|
|
00763 ++INCLUDE DTSIASKL DTSBX530
|
|
00764 EJECT DTSBX530
|
|
00765 01 AHDR-REC. DTSBX530
|
|
00766 ++INCLUDE DTSIAHDR DTSBX530
|
|
00767 EJECT DTSBX530
|
|
00768 01 ARPT-REC. DTSBX530
|
|
00769 ++INCLUDE DTSIARPT DTSBX530
|
|
00770 EJECT DTSBX530
|
|
00771 01 APAY-REC. DTSBX530
|
|
00772 ++INCLUDE DTSIAPAY DTSBX530
|
|
00773 DTSBX530
|
|
00774 01 L927-LINK-AREA. DTSBX530
|
|
00775 ++INCLUDE DTSIL927 DTSBX530
|
|
00776 DTSBX530
|
|
00777 01 L931-LINK-AREA. DTSBX530
|
|
00778 ++INCLUDE DTSIL931 DTSBX530
|
|
00779 DTSBX530
|
|
00780 01 FSKL-REC. DTSBX530
|
|
00781 ++INCLUDE DTSIFSKL DTSBX530
|
|
00782 DTSBX530
|
|
00783 01 R140-REC. DTSBX530
|
|
00784 ++INCLUDE DTSIR140 DTSBX530
|
|
00785 DTSBX530
|
|
00786 LINKAGE DTSBX530
|
|
00787 SECTION. DTSBX530
|
|
00788 DTSBX530
|
|
00789 01 LX42-LINK-AREA. DTSBX530
|
|
00790 ++INCLUDE DTSILX42 CL112
|
|
00791 DTSBX530
|
|
00792 PROCEDURE DIVISION USING LX42-LINK-AREA. DTSBX530
|
|
00793 DTSBX530
|
|
00794 DTSBX430-MAIN. CL*47
|
|
00795 * DISPLAY 'LX42-LINK-AREA' LX42-LINK-AREA CL*80
|
|
00796 MOVE LX42-RPT-ERROR-IND TO W-RPT-ERROR-IND. CL*80
|
|
00797 CL*80
|
|
00798 IF W-RPT-ERROR-YES-88 CL*80
|
|
00799 DISPLAY 'BX430 LX42 EMP REC HAS ERROR ' LX42-EMP-NO CL*80
|
|
00800 ' ' LX42-RPT-ERROR-IND ' ' W-RPT-ERROR-IND CL*80
|
|
00801 ELSE CL*80
|
|
00802 DISPLAY 'BX430 EMP REC HAS NO ERROR ' W-RPT-ERROR-IND CL*81
|
|
00803 END-IF. CL*80
|
|
00804 EVALUATE TRUE DTSBX530
|
|
00805 WHEN LX42-INITIALIZE-88 DTSBX530
|
|
00806 PERFORM I0000-INITIATE THRU I0000-EXIT DTSBX530
|
|
00807 DTSBX530
|
|
00808 WHEN LX42-NEW-EMPLOYER-88 DTSBX530
|
|
00809 PERFORM P5000-NEW-EMP THRU P5000-EXIT DTSBX530
|
|
00810 DTSBX530
|
|
00811 WHEN LX42-PROCESS-88 DTSBX530
|
|
00812 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX530
|
|
00813 DTSBX530
|
|
00814 WHEN LX42-TERMINATE-88 DTSBX530
|
|
00815 DISPLAY ' TERMINATE 430' CL*47
|
|
00816 PERFORM P5000-NEW-EMP THRU P5000-EXIT DTSBX530
|
|
00817 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBX530
|
|
00818 DTSBX530
|
|
00819 END-EVALUATE. DTSBX530
|
|
00820 CL*80
|
|
00821 IF LX42-PROCESS-88 CL*80
|
|
00822 MOVE W-RPT-ERROR-IND TO LX42-RPT-ERROR-IND CL*80
|
|
00823 END-IF. CL*80
|
|
00824 DTSBX530
|
|
00825 DTSBX430-MAIN-EXIT. CL*47
|
|
00826 GOBACK. DTSBX530
|
|
00827 DTSBX530
|
|
00828 I0000-INITIATE. DTSBX530
|
|
00829 SET W-RPT-ERROR-NO-88 TO TRUE. CL*81
|
|
00830 SET W-FATAL-ERROR-NO-88 TO TRUE. DTSBX530
|
|
00831 SET X145-PAYMENT-DUP-NO-88 TO TRUE. CL171
|
|
00832 DTSBX530
|
|
00833 MOVE LENGTH OF X140-REC TO W-X140-LENGTH. DTSBX530
|
|
00834 MOVE LENGTH OF X144-REC TO W-X144-LENGTH. DTSBX530
|
|
00835 MOVE LENGTH OF X145-REC TO W-X145-LENGTH. CL*47
|
|
00836 DTSBX530
|
|
00837 * FOR VARIABLE REPORT FILE. DTSBX530
|
|
00838 MOVE LENGTH OF R140-REC TO R140-LENGTH. DTSBX530
|
|
00839 MOVE '140' TO R140-REC-TYPE. DTSBX530
|
|
00840 DTSBX530
|
|
00841 MOVE LX42-CURR-RUN-DATE TO L004-DATE. DTSBX530
|
|
00842 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBX530
|
|
00843 SUBTRACT +5 FROM L004-ABS-QTR. DTSBX530
|
|
00844 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBX530
|
|
00845 MOVE L004-QTR-5-9 TO W-WAIVER-QTR. DTSBX530
|
|
00846 DISPLAY 'BX530 CURR RUN DATE ' LX42-CURR-RUN-DATE. CL184
|
|
00847 DISPLAY 'BX530 WAIVE QTR ' W-WAIVER-QTR. CL184
|
|
00848 DTSBX530
|
|
00849 CL235
|
|
00850 MOVE LX42-CURR-RUN-DATE TO L004-DATE. CL235
|
|
00851 PERFORM S004-FROM-DATE THRU S004-EXIT. CL235
|
|
00852 PERFORM S004-FROM-ABS THRU S004-EXIT. CL235
|
|
00853 MOVE LX42-CURR-QTR TO W-CURENT-QTR. CL240
|
|
00854 DISPLAY 'BX530 CURR RUN DATE ' LX42-CURR-RUN-DATE. CL235
|
|
00855 DISPLAY 'BX530 CURENT QTR ' W-CURENT-QTR. CL235
|
|
00856 CL235
|
|
00857 MOVE LX42-CURR-RUN-DATE TO WRK-CURR-DATE. CL250
|
|
00858 MOVE WRK-CURR-DATE TO L001-DATE-8-AREA. CL250
|
|
00859 PERFORM S001-FROM-FED-8 THRU S001-EXIT CL150
|
|
00860 DISPLAY 'RPT CURR RUN DATE ' L001-SLASH-DATE. CL151
|
|
00861 MOVE L001-SLASH-8-DATE TO HDR1-LRCM-SYS-DATE. CL252
|
|
00862 CL150
|
|
00863 PERFORM I2000-OPEN-FILES THRU I2000-EXIT DTSBX530
|
|
00864 IF W-FATAL-ERROR-YES-88 DTSBX530
|
|
00865 GO TO I0000-EXIT DTSBX530
|
|
00866 END-IF. DTSBX530
|
|
00867 DTSBX530
|
|
00868 MOVE +0 TO W-ARPT-LAST. DTSBX530
|
|
00869 PERFORM DTSBX530
|
|
00870 VARYING RSUB FROM +1 BY +1 DTSBX530
|
|
00871 UNTIL RSUB > W-ARPT-MAX DTSBX530
|
|
00872 MOVE LOW-VALUES TO W-ARPT-ENTRY (RSUB) DTSBX530
|
|
00873 END-PERFORM. DTSBX530
|
|
00874 DTSBX530
|
|
00875 I0000-EXIT. DTSBX530
|
|
00876 EXIT. DTSBX530
|
|
00877 DTSBX530
|
|
00878 I2000-OPEN-FILES. DTSBX530
|
|
00879 PERFORM S1040-OPEN-TEMP-BTC-OUT THRU S1040-EXIT. DTSBX530
|
|
00880 IF W-FATAL-ERROR-YES-88 DTSBX530
|
|
00881 DISPLAY 'CANNOT OPEN TEMP X530BTC FILE ' CL184
|
|
00882 TEMP-BTC-STATUS DTSBX530
|
|
00883 PERFORM S999-ABEND THRU S999-EXIT CL*15
|
|
00884 END-IF. DTSBX530
|
|
00885 DTSBX530
|
|
00886 PERFORM S1100-OPEN-WAGE-TEMP-OUT THRU S1100-EXIT. DTSBX530
|
|
00887 IF W-FATAL-ERROR-YES-88 DTSBX530
|
|
00888 DISPLAY 'CANNOT OPEN WAGE TEMP FILE ' DTSBX530
|
|
00889 WAGE-TEMP-STATUS DTSBX530
|
|
00890 PERFORM S999-ABEND THRU S999-EXIT CL*15
|
|
00891 END-IF. DTSBX530
|
|
00892 DTSBX530
|
|
00893 PERFORM S1150-OPEN-WAGE-FILE-OUT THRU S1150-EXIT. CL*20
|
|
00894 IF W-FATAL-ERROR-YES-88 CL*20
|
|
00895 DISPLAY 'CANNOT OPEN WAGE OUT FILE ' CL*20
|
|
00896 WAGE-OUT-STATUS CL*20
|
|
00897 PERFORM S999-ABEND THRU S999-EXIT CL*20
|
|
00898 END-IF. CL*20
|
|
00899 DTSBX530
|
|
00900 OPEN OUTPUT BATCH-XREF-FILE. DTSBX530
|
|
00901 IF BATCH-XREF-OK-88 DTSBX530
|
|
00902 NEXT SENTENCE DTSBX530
|
|
00903 ELSE DTSBX530
|
|
00904 DISPLAY 'CANNOT OPEN BATCH XREF FILE ' DTSBX530
|
|
00905 BATCH-XREF-STATUS DTSBX530
|
|
00906 PERFORM S999-ABEND THRU S999-EXIT DTSBX530
|
|
00907 END-IF. DTSBX530
|
|
00908 CL*12
|
|
00909 CL*59
|
|
00910 OPEN OUTPUT PEND-X140-FILE. CL*59
|
|
00911 IF REPT-140-OK-88 CL*62
|
|
00912 NEXT SENTENCE CL*59
|
|
00913 ELSE CL*59
|
|
00914 DISPLAY 'CANNOT OPEN PENDING 530X140 FILE' CL244
|
|
00915 REPT-140-STATUS CL*62
|
|
00916 PERFORM S999-ABEND THRU S999-EXIT CL*59
|
|
00917 END-IF. CL*59
|
|
00918 CL*59
|
|
00919 OPEN OUTPUT PEND-X144-FILE. CL*59
|
|
00920 IF WAGE-144-OK-88 CL*62
|
|
00921 NEXT SENTENCE CL*59
|
|
00922 ELSE CL*59
|
|
00923 DISPLAY 'CANNOT OPEN PENDING X144 FILE' CL*59
|
|
00924 WAGE-144-STATUS CL*62
|
|
00925 PERFORM S999-ABEND THRU S999-EXIT CL*59
|
|
00926 END-IF. CL*59
|
|
00927 CL*59
|
|
00928 OPEN OUTPUT PEND-X145-FILE. CL*59
|
|
00929 IF PAYT-145-OK-88 CL*62
|
|
00930 NEXT SENTENCE CL*59
|
|
00931 ELSE CL*59
|
|
00932 DISPLAY 'CANNOT OPEN PENDING X145 FILE' CL*59
|
|
00933 PAYT-145-STATUS CL*62
|
|
00934 PERFORM S999-ABEND THRU S999-EXIT CL*59
|
|
00935 END-IF. CL*59
|
|
00936 CL119
|
|
00937 CL119
|
|
00938 OPEN OUTPUT X530-PEND-FILE. CL233
|
|
00939 IF REPT-STATUS-OK-88 CL119
|
|
00940 NEXT SENTENCE CL119
|
|
00941 ELSE CL119
|
|
00942 DISPLAY 'CANNOT OPEN X503 PENDING FILE ' CL232
|
|
00943 REPT-STATUS CL119
|
|
00944 PERFORM S999-ABEND THRU S999-EXIT CL119
|
|
00945 END-IF. CL119
|
|
00946 DTSBX530
|
|
00947 OPEN OUTPUT X530-PAID-FILE. CL233
|
|
00948 IF REPT-STATUS-OK-88 CL119
|
|
00949 NEXT SENTENCE CL119
|
|
00950 ELSE CL119
|
|
00951 DISPLAY 'CANNOT OPEN X503 PAID FILE ' CL232
|
|
00952 REPT-STATUS CL119
|
|
00953 PERFORM S999-ABEND THRU S999-EXIT CL119
|
|
00954 END-IF. CL119
|
|
00955 CL119
|
|
00956 I2000-EXIT. DTSBX530
|
|
00957 EXIT. DTSBX530
|
|
00958 DTSBX530
|
|
00959 P0000-PROCESS. DTSBX530
|
|
00960 CL**2
|
|
00961 EVALUATE TRUE DTSBX530
|
|
00962 WHEN LX42-REC-TYPE-PAY-88 CL*47
|
|
00963 PERFORM P1000-PAYMENT THRU P1000-EXIT CL*47
|
|
00964 DTSBX530
|
|
00965 WHEN LX42-REC-TYPE-RPT-88 CL*47
|
|
00966 PERFORM P2000-REPORT THRU P2000-EXIT CL*47
|
|
00967 CL*47
|
|
00968 WHEN LX42-REC-TYPE-WAGE-88 DTSBX530
|
|
00969 PERFORM P3000-WAGES THRU P3000-EXIT DTSBX530
|
|
00970 CL*47
|
|
00971 WHEN OTHER CL*47
|
|
00972 DISPLAY 'DTSBX430 ABENDING - INVALID RECORD TYPE ' CL*47
|
|
00973 LX42-REC-TYPE CL*47
|
|
00974 PERFORM S999-ABEND THRU S999-EXIT CL*47
|
|
00975 CL*47
|
|
00976 END-EVALUATE. DTSBX530
|
|
00977 DTSBX530
|
|
00978 P0000-EXIT. DTSBX530
|
|
00979 EXIT. DTSBX530
|
|
00980 P1000-PAYMENT. CL*47
|
|
00981 INITIALIZE X145-REC CL227
|
|
00982 * SET W-EMP-IN-PROGRESS-YES-88 TO TRUE. CL*57
|
|
00983 MOVE LX42-DATA-AREA TO X145-REC. CL*50
|
|
00984 *& CL*50
|
|
00985 MOVE X145-EMP-NO TO W-EMP-NO. CL*50
|
|
00986 MOVE X145-QTR TO W-PAY-QTR. CL166
|
|
00987 SET W-EMP-FOUND-NO-88 TO TRUE. CL*50
|
|
00988 CL*50
|
|
00989 ADD +1 TO W-X145-RED-CNT CL*50
|
|
00990 DISPLAY SPACE. CL*50
|
|
00991 DISPLAY 'BX530- NEW EMPLOYER PAYMENT ' X145-EMP-NO. CL184
|
|
00992 DISPLAY ' X145-KEY ' X145-EMP-NO. CL*50
|
|
00993 DISPLAY 'LX145-KEY ' LX42-X145-KEY-AREA. CL*50
|
|
00994 SET W-RPT-ERROR-NO-88 TO TRUE. CL186
|
|
00995 CL215
|
|
00996 * DISPLAY '** PAY TYPE ' X145-PAY-TYPE ' ' X145-EMP-NO. CL228
|
|
00997 * IF W-PAY-ACH-88 CL228
|
|
00998 IF X145-PAY-TYPE = '00' CL228
|
|
00999 ADD +1 TO W-A145-RED-CNT CL215
|
|
01000 ELSE CL215
|
|
01001 * IF W-PAY-CHK-88 CL228
|
|
01002 IF X145-PAY-TYPE = '01' CL228
|
|
01003 ADD +1 TO W-C145-RED-CNT CL215
|
|
01004 ELSE CL215
|
|
01005 * IF W-PAY-SCK-88 CL228
|
|
01006 IF X145-PAY-TYPE = '02' CL228
|
|
01007 ADD +1 TO W-S145-RED-CNT CL215
|
|
01008 ELSE CL215
|
|
01009 DISPLAY '** UNK PAY TYPE ' X145-PAY-TYPE ' ' X145-EMP-NO. CL225
|
|
01010 CL215
|
|
01011 CL*51
|
|
01012 * IF LX42-X145-EMP-NO = '999999' CL185
|
|
01013 * SET W-RPT-ERROR-YES-88 TO TRUE CL185
|
|
01014 * MOVE SPACES TO R140-MESSAGE CL185
|
|
01015 * MOVE W-EMP-NO TO R140-EMP-NO CL185
|
|
01016 * STRING CL185
|
|
01017 * 'PAYMENT CONTAINS ERRORS CANNOT PROCESS - PYMTS ' CL185
|
|
01018 * DELIMITED BY SIZE CL185
|
|
01019 * INTO R140-MESSAGE CL185
|
|
01020 * END-STRING CL185
|
|
01021 * MOVE R140-MESSAGE TO P434-MESSAGE CL185
|
|
01022 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL185
|
|
01023 * MOVE '999999' TO LX42-X145-EMP-NO CL185
|
|
01024 * ADD +1 TO W-X145-ERR-CNT CL185
|
|
01025 * ADD +1 TO W-X145-PEN-CNT CL185
|
|
01026 * WRITE PEND-X145-REC FROM X145-REC CL185
|
|
01027 * PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT CL185
|
|
01028 * GO TO P1000-EXIT. CL185
|
|
01029 CL*51
|
|
01030 CL*51
|
|
01031 * IF LX42-REC-TYPE-PAY-88 CL183
|
|
01032 * IF LX42-X145-KEY-AREA = X145-EMP-NO AND CL183
|
|
01033 * LX42-X145-QTR-AREA = X145-QTR CL183
|
|
01034 * SET W-PREV-RPT-NULL-88 TO TRUE CL183
|
|
01035 * ADD +1 TO W-X145-DUP-CNT CL183
|
|
01036 * DISPLAY 'X145 DUPLICATE PAYMENT RECORD ' W-EMP-NO CL183
|
|
01037 * ' ERR IND ' W-RPT-ERROR-IND CL183
|
|
01038 * MOVE SPACES TO R140-MESSAGE CL183
|
|
01039 * MOVE W-EMP-NO TO R140-EMP-NO CL183
|
|
01040 * MOVE SPACES TO R140-MESSAGE CL183
|
|
01041 * MOVE W-EMP-NO TO R140-EMP-NO CL183
|
|
01042 * STRING CL183
|
|
01043 * ': POSSIBLE DUPLICATE PAYMENT RECORD ----PROCESS ' CL183
|
|
01044 * DELIMITED BY SIZE CL183
|
|
01045 * INTO R140-MESSAGE CL183
|
|
01046 * END-STRING CL183
|
|
01047 * SET X145-PAYMENT-DUP-YES-88 TO TRUE CL183
|
|
01048 * WRITE PEND-X145-REC FROM WS-HOLD-X145-REC CL183
|
|
01049 * MOVE R140-MESSAGE TO P434-MESSAGE CL183
|
|
01050 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL183
|
|
01051 * PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT CL183
|
|
01052 * ELSE CL183
|
|
01053 MOVE X145-EMP-NO TO LX42-X145-KEY-AREA CL107
|
|
01054 * END-IF CL183
|
|
01055 * END-IF. CL183
|
|
01056 CL*51
|
|
01057 CL*51
|
|
01058 MOVE X145-EMP-NO TO LX42-X145-EMP-NO. CL*51
|
|
01059 MOVE X145-QTR TO LX42-X145-QTR-AREA CL*83
|
|
01060 CL*50
|
|
01061 * DISPLAY ' PREV REC TYPE ' W-PREV-REC-TYPE. CL184
|
|
01062 * IF W-PREV-RPT-NULL-88 OR CL184
|
|
01063 * LX42-REC-TYPE-PAY-88 CL184
|
|
01064 * SET W-PREV-RPT-PAY-88 TO TRUE CL184
|
|
01065 * SET W-PREV-REC-PAY-88 TO TRUE CL107
|
|
01066 CL184
|
|
01067 ADD +1 TO W-X145-PRO-CNT CL*50
|
|
01068 PERFORM P1110-EDIT-PAYMENT THRU P1110-EXIT CL*51
|
|
01069 CL184
|
|
01070 IF W-RPT-ERROR-NO-88 CL*81
|
|
01071 PERFORM P1112-CHECK-PAYMENT THRU P1112-EXIT CL*51
|
|
01072 ELSE CL185
|
|
01073 MOVE '999999' TO LX42-X145-EMP-NO CL185
|
|
01074 ADD +1 TO W-X145-ERR-CNT CL185
|
|
01075 ADD +1 TO W-X145-PEN-CNT CL185
|
|
01076 SET W-RPT-ERROR-YES-88 TO TRUE CL185
|
|
01077 WRITE PEND-X145-REC FROM X145-REC CL185
|
|
01078 PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT CL185
|
|
01079 PERFORM P7000-COUNT-X145 THRU P7000-EXIT CL215
|
|
01080 GO TO P1000-EXIT CL185
|
|
01081 END-IF. CL185
|
|
01082 CL185
|
|
01083 IF W-RPT-ERROR-NO-88 CL*81
|
|
01084 * DISPLAY 'X145 PAYMENT REC PASS EDITS ' W-EMP-NO CL186
|
|
01085 * DISPLAY 'X145 SAVED ' W-EMP-NO ' ' W-PAY-QTR ' ' CL186
|
|
01086 * ' ' X145-REMITTANCE CL186
|
|
01087 * ADD +1 TO W-X145-SAV-CNT CL188
|
|
01088 PERFORM P1120-SAVE-PAYMENT THRU P1120-EXIT CL*51
|
|
01089 PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT CL190
|
|
01090 ELSE CL*51
|
|
01091 MOVE '999999' TO LX42-X145-EMP-NO CL*51
|
|
01092 ADD +1 TO W-X145-ERR-CNT CL*51
|
|
01093 ADD +1 TO W-X145-PEN-CNT CL*92
|
|
01094 SET W-RPT-ERROR-YES-88 TO TRUE CL*81
|
|
01095 WRITE PEND-X145-REC FROM X145-REC CL*93
|
|
01096 PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT CL131
|
|
01097 PERFORM P7000-COUNT-X145 THRU P7000-EXIT CL215
|
|
01098 END-IF. CL186
|
|
01099 * PERFORM S946-WRITE-R140 THRU S946-EXIT. CL186
|
|
01100 CL*49
|
|
01101 P1000-EXIT. CL*51
|
|
01102 EXIT. CL*49
|
|
01103 CL*49
|
|
01104 P1110-EDIT-PAYMENT. CL*47
|
|
01105 CL*54
|
|
01106 MOVE X145-PAY-TYPE TO W-PAY-TYPE. CL*54
|
|
01107 IF W-VALID-PAY-88 CL*54
|
|
01108 NEXT SENTENCE CL*54
|
|
01109 ELSE CL*54
|
|
01110 SET W-RPT-ERROR-YES-88 TO TRUE CL*81
|
|
01111 MOVE SPACES TO R140-MESSAGE CL*54
|
|
01112 MOVE W-EMP-NO TO R140-EMP-NO CL*54
|
|
01113 STRING CL*54
|
|
01114 ':PAY- INVALID PAYMENT TYPE ' CL144
|
|
01115 X145-PAY-TYPE CL*54
|
|
01116 DELIMITED BY SIZE CL*54
|
|
01117 INTO R140-MESSAGE CL*54
|
|
01118 END-STRING CL*54
|
|
01119 MOVE '999999' TO LX42-X145-EMP-NO CL*51
|
|
01120 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*54
|
|
01121 MOVE R140-MESSAGE TO P434-MESSAGE CL136
|
|
01122 END-IF. CL*54
|
|
01123 * IF X145-QTR = SPACES CL241
|
|
01124 IF W-VALID-EPAY-88 CL242
|
|
01125 MOVE W-CURENT-QTR TO W-SLASH-QTR CL248
|
|
01126 * MOVE '2019/1' TO W-SLASH-QTR CL248
|
|
01127 ELSE CL*47
|
|
01128 MOVE X145-QTR TO W-SLASH-QTR. CL*47
|
|
01129 CL*47
|
|
01130 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR CL*47
|
|
01131 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q CL*47
|
|
01132 PERFORM S004-FROM-5 THRU S004-EXIT CL*47
|
|
01133 IF NOT L004-VALID-QTR CL*47
|
|
01134 SET W-RPT-ERROR-YES-88 TO TRUE CL*81
|
|
01135 MOVE SPACES TO R140-MESSAGE CL*47
|
|
01136 MOVE W-EMP-NO TO R140-EMP-NO CL*47
|
|
01137 STRING CL*47
|
|
01138 ':PAY- INVALID QUARTER ' W-SLASH-QTR CL144
|
|
01139 DELIMITED BY SIZE CL*47
|
|
01140 INTO R140-MESSAGE CL*47
|
|
01141 END-STRING CL*47
|
|
01142 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*47
|
|
01143 MOVE '999999' TO LX42-X145-EMP-NO CL*51
|
|
01144 MOVE R140-MESSAGE TO P434-MESSAGE CL136
|
|
01145 ELSE CL*48
|
|
01146 MOVE L004-QTR-5-9 TO W-X145-PAYMENT-QTR CL*56
|
|
01147 END-IF. CL*48
|
|
01148 CL*48
|
|
01149 * DISPLAY 'X145Q ' W-SLASH-QTR ' WQTR ' W-X145-PAYMENT-QTR CL*92
|
|
01150 CL*53
|
|
01151 MOVE X145-REMITTANCE TO W-X145-REMITTANCE. CL*53
|
|
01152 DISPLAY 'W145REMITCE ' W-X145-REMITTANCE. CL*53
|
|
01153 DISPLAY 'X145REMITCE ' X145-REMITTANCE. CL*53
|
|
01154 CL*51
|
|
01155 IF W-X145-REMITTANCE = ZEROS CL201
|
|
01156 * SET W-RPT-ERROR-YES-88 TO TRUE CL*81
|
|
01157 MOVE SPACES TO R140-MESSAGE CL201
|
|
01158 MOVE W-EMP-NO TO R140-EMP-NO CL201
|
|
01159 STRING CL201
|
|
01160 'X430- REVIEW REMITTANCE AMOUNT= 0 ' CL201
|
|
01161 DELIMITED BY SIZE CL201
|
|
01162 INTO R140-MESSAGE CL201
|
|
01163 END-STRING CL201
|
|
01164 PERFORM S946-WRITE-R140 THRU S946-EXIT CL201
|
|
01165 END-IF. CL201
|
|
01166 CL*51
|
|
01167 MOVE ZEROS TO W-X145-RECEIVED-DATE CL*72
|
|
01168 MOVE X145-RCVD-DATE TO W-SLASH-DATE CL*48
|
|
01169 MOVE W-SLASH-DT-MM TO L001-FED-8-MO CL*48
|
|
01170 MOVE W-SLASH-DT-DD TO L001-FED-8-DA CL*48
|
|
01171 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR CL*48
|
|
01172 PERFORM S001-FROM-FED-8 THRU S001-EXIT CL*48
|
|
01173 IF NOT L001-VALID-DATE CL*48
|
|
01174 SET W-RPT-ERROR-YES-88 TO TRUE CL*81
|
|
01175 MOVE SPACES TO R140-MESSAGE CL*48
|
|
01176 MOVE W-EMP-NO TO R140-EMP-NO CL*48
|
|
01177 STRING CL*48
|
|
01178 ':PAY- INVALID RECEIVED DATE ' CL144
|
|
01179 ' ' X145-RCVD-DATE CL*48
|
|
01180 DELIMITED BY SIZE CL*48
|
|
01181 INTO R140-MESSAGE CL*48
|
|
01182 END-STRING CL*48
|
|
01183 MOVE R140-MESSAGE TO P434-MESSAGE CL136
|
|
01184 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*48
|
|
01185 MOVE '999999' TO LX42-X145-EMP-NO CL*51
|
|
01186 ELSE CL*48
|
|
01187 MOVE L001-FED-8-DATE-9 TO W-X145-RECEIVED-DATE CL*72
|
|
01188 END-IF. CL*48
|
|
01189 CL*55
|
|
01190 P1110-EXIT. CL*55
|
|
01191 EXIT. CL*55
|
|
01192 CL*55
|
|
01193 P1112-CHECK-PAYMENT. CL*51
|
|
01194 MOVE LOW-VALUE TO MPRF-KEY-AREA. CL*48
|
|
01195 MOVE W-EMP-NO TO MPRF-EMP-NO. CL*48
|
|
01196 SET MPRF-PRF-88 TO TRUE. CL*48
|
|
01197 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. CL*48
|
|
01198 CL*48
|
|
01199 PERFORM S910-READ THRU S910-EXIT. CL*48
|
|
01200 IF L910-NO-REC-88 CL*48
|
|
01201 SET W-RPT-ERROR-YES-88 TO TRUE CL*81
|
|
01202 SET W-EMP-FOUND-NO-88 TO TRUE CL*48
|
|
01203 MOVE SPACES TO R140-MESSAGE CL*48
|
|
01204 MOVE W-EMP-NO TO R140-EMP-NO CL*48
|
|
01205 STRING CL*48
|
|
01206 ':EMP NOT ON DUTAS -CANNOT PAY ' CL144
|
|
01207 X145-EMP-NO CL*48
|
|
01208 DELIMITED BY SIZE CL*48
|
|
01209 INTO R140-MESSAGE CL*48
|
|
01210 END-STRING CL*48
|
|
01211 MOVE R140-MESSAGE TO P434-MESSAGE CL136
|
|
01212 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*48
|
|
01213 MOVE '999999' TO LX42-X145-EMP-NO CL*51
|
|
01214 ELSE CL*48
|
|
01215 MOVE MSKL-REC TO MPRF-REC CL*48
|
|
01216 SET W-EMP-FOUND-YES-88 TO TRUE CL*48
|
|
01217 END-IF. CL*48
|
|
01218 CL*48
|
|
01219 P1112-EXIT. CL*51
|
|
01220 EXIT. CL*48
|
|
01221 CL*48
|
|
01222 CL*51
|
|
01223 P1120-SAVE-PAYMENT. CL186
|
|
01224 IF W-X145-REMITTANCE = ZEROS CL186
|
|
01225 ADD +1 TO W-X145-WRITEO-CNT CL188
|
|
01226 GO TO P1120-EXIT. CL186
|
|
01227 CL188
|
|
01228 * DISPLAY ' SAVE PAYMENT RECORD ' W-EMP-NO. CL186
|
|
01229 MOVE W-X145-REMITTANCE TO W-X145-TOT-REMIT-AMT. CL186
|
|
01230 ADD W-X145-REMITTANCE TO W-TOT-REMIT-AMT. CL222
|
|
01231 ADD +1 TO W-X145-SAV-CNT. CL186
|
|
01232 PERFORM P2021-WRITE-T025 THRU P2021-EXIT. CL186
|
|
01233 P1120-EXIT. CL186
|
|
01234 EXIT. CL186
|
|
01235 CL186
|
|
01236 CL*48
|
|
01237 DTSBX530
|
|
01238 P2000-REPORT. DTSBX530
|
|
01239 MOVE LX42-DATA-AREA TO X140-REC. DTSBX530
|
|
01240 CL**2
|
|
01241 * SET W-RPT-IN-PROGRESS-YES-88 TO TRUE CL*56
|
|
01242 CL**2
|
|
01243 MOVE X140-EMP-NO TO W-EMP-NO. DTSBX530
|
|
01244 MOVE X140-QUARTER TO W-PAY-QTR. CL166
|
|
01245 ADD +1 TO W-X140-RED-CNT. CL*56
|
|
01246 DISPLAY ' PREV RPT REC TYPE ' W-PREV-REC-TYPE. CL*87
|
|
01247 IF W-PREV-RPT-NULL-88 CL*80
|
|
01248 SET W-PREV-RPT-RPT-88 TO TRUE CL*84
|
|
01249 SET W-X145-PAYMENT-NO-88 TO TRUE CL*52
|
|
01250 ELSE CL*52
|
|
01251 SET W-X145-PAYMENT-YES-88 TO TRUE CL*52
|
|
01252 END-IF. CL*52
|
|
01253 CL*52
|
|
01254 IF LX42-REC-TYPE-RPT-88 CL*40
|
|
01255 IF LX42-X140-KEY-AREA = X140-EMP-NO AND CL*80
|
|
01256 LX42-X140-QTR-AREA = X140-QUARTER CL*80
|
|
01257 SET W-RPT-ERROR-YES-88 TO TRUE CL*81
|
|
01258 ADD +1 TO W-X140-DUP-CNT CL*92
|
|
01259 ADD +1 TO W-X140-PEN-CNT CL*92
|
|
01260 DISPLAY ':ERROR-RPT DUPLICATE REPORT D ' CL144
|
|
01261 ' ERR IND ' W-RPT-ERROR-IND CL*80
|
|
01262 MOVE SPACES TO R140-MESSAGE CL*40
|
|
01263 MOVE W-EMP-NO TO R140-EMP-NO CL*40
|
|
01264 STRING CL*40
|
|
01265 ':RPT- DUPLICATE REPORT RECORD ' CL144
|
|
01266 DELIMITED BY SIZE CL*40
|
|
01267 INTO R140-MESSAGE CL*40
|
|
01268 END-STRING CL*40
|
|
01269 MOVE R140-MESSAGE TO P434-MESSAGE CL136
|
|
01270 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*40
|
|
01271 PERFORM P6000-WRITE-PEND-X140 THRU P6000-EXIT CL131
|
|
01272 WRITE PEND-X140-REC FROM X140-REC CL*93
|
|
01273 MOVE '999999' TO LX42-X140-EMP-NO CL*51
|
|
01274 GO TO P2000-EXIT CL*40
|
|
01275 ELSE CL*40
|
|
01276 MOVE X140-EMP-NO TO LX42-X140-KEY-AREA CL*80
|
|
01277 END-IF CL*40
|
|
01278 END-IF. CL*40
|
|
01279 CL*40
|
|
01280 MOVE X140-EMP-NO TO LX42-X140-EMP-NO. CL**3
|
|
01281 MOVE X140-QUARTER TO LX42-X140-QTR-AREA CL*80
|
|
01282 SET W-EMP-FOUND-NO-88 TO TRUE. DTSBX530
|
|
01283 CL*51
|
|
01284 IF LX42-X145-EMP-NO = '999999' CL*51
|
|
01285 SET W-RPT-ERROR-YES-88 TO TRUE CL*81
|
|
01286 MOVE SPACES TO R140-MESSAGE CL*40
|
|
01287 MOVE W-EMP-NO TO R140-EMP-NO CL*40
|
|
01288 STRING CL*40
|
|
01289 ':PAY RECORD INVALID -RPT BYPASSED ' CL144
|
|
01290 DELIMITED BY SIZE CL*40
|
|
01291 INTO R140-MESSAGE CL*40
|
|
01292 END-STRING CL*40
|
|
01293 MOVE '999999' TO LX42-X140-EMP-NO CL*40
|
|
01294 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*40
|
|
01295 ADD +1 TO W-X140-PEN-CNT CL*93
|
|
01296 WRITE PEND-X140-REC FROM X140-REC CL*93
|
|
01297 MOVE R140-MESSAGE TO P434-MESSAGE CL136
|
|
01298 PERFORM P6000-WRITE-PEND-X140 THRU P6000-EXIT CL131
|
|
01299 GO TO P2000-EXIT. CL*40
|
|
01300 CL*40
|
|
01301 SET W-PREV-RPT-RPT-88 TO TRUE. CL*84
|
|
01302 DTSBX530
|
|
01303 DTSBX530
|
|
01304 PERFORM P2010-EDIT-REPORT THRU P2010-EXIT DTSBX530
|
|
01305 CL**3
|
|
01306 IF W-RPT-ERROR-YES-88 CL*81
|
|
01307 MOVE '999999' TO LX42-X140-EMP-NO CL**3
|
|
01308 GO TO P2000-EDIT-REPORT-CONTINUE. CL*32
|
|
01309 CL**3
|
|
01310 PERFORM P2012-CHECK-MPRF THRU P2012-EXIT CL**3
|
|
01311 IF W-RPT-ERROR-YES-88 CL*81
|
|
01312 MOVE '999999' TO LX42-X140-EMP-NO CL**3
|
|
01313 GO TO P2000-EDIT-REPORT-CONTINUE. CL*32
|
|
01314 CL**3
|
|
01315 PERFORM P2015-CHECK-MRPT THRU P2015-EXIT CL178
|
|
01316 IF W-RPT-ERROR-YES-88 CL*81
|
|
01317 MOVE '999999' TO LX42-X140-EMP-NO CL*60
|
|
01318 GO TO P2000-EDIT-REPORT-CONTINUE. CL*60
|
|
01319 CL*32
|
|
01320 P2000-EDIT-REPORT-CONTINUE. CL*32
|
|
01321 IF W-RPT-ERROR-NO-88 CL166
|
|
01322 PERFORM P2020-SAVE-EXT-REPORT THRU P2020-EXIT CL166
|
|
01323 ADD +1 TO W-X140-SAV-CNT CL166
|
|
01324 GO TO P2000-EXIT. CL166
|
|
01325 CL166
|
|
01326 SET W-RPT-ERROR-YES-88 TO TRUE CL*81
|
|
01327 MOVE SPACES TO R140-MESSAGE CL*32
|
|
01328 MOVE W-EMP-NO TO R140-EMP-NO CL*32
|
|
01329 STRING CL*32
|
|
01330 ': REPORT CONTAINS ERRORS CANNOT PROCESS -REPORT' CL144
|
|
01331 ' ' X140-QUARTER CL*32
|
|
01332 DELIMITED BY SIZE CL*32
|
|
01333 INTO R140-MESSAGE CL*32
|
|
01334 END-STRING CL*32
|
|
01335 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*32
|
|
01336 ADD +1 TO W-X140-PEN-CNT CL*93
|
|
01337 WRITE PEND-X140-REC FROM X140-REC CL*93
|
|
01338 PERFORM P6000-WRITE-PEND-X140 THRU P6000-EXIT CL131
|
|
01339 MOVE R140-MESSAGE TO P434-MESSAGE CL144
|
|
01340 IF W-X145-PAYMENT-YES-88 CL166
|
|
01341 WRITE PEND-X145-REC FROM X145-REC CL166
|
|
01342 PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT. CL166
|
|
01343 DTSBX530
|
|
01344 P2000-EXIT. DTSBX530
|
|
01345 EXIT. DTSBX530
|
|
01346 DTSBX530
|
|
01347 P2010-EDIT-REPORT. DTSBX530
|
|
01348 MOVE X140-QUARTER TO W-SLASH-QTR. DTSBX530
|
|
01349 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR. DTSBX530
|
|
01350 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q. DTSBX530
|
|
01351 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX530
|
|
01352 IF NOT L004-VALID-QTR DTSBX530
|
|
01353 SET W-RPT-ERROR-YES-88 TO TRUE CL*81
|
|
01354 MOVE SPACES TO R140-MESSAGE DTSBX530
|
|
01355 MOVE W-EMP-NO TO R140-EMP-NO DTSBX530
|
|
01356 STRING DTSBX530
|
|
01357 ':RPT- INVALID QUARTER ' CL144
|
|
01358 X140-QUARTER DTSBX530
|
|
01359 DELIMITED BY SIZE DTSBX530
|
|
01360 INTO R140-MESSAGE DTSBX530
|
|
01361 END-STRING DTSBX530
|
|
01362 MOVE R140-MESSAGE TO P434-MESSAGE CL136
|
|
01363 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX530
|
|
01364 ELSE DTSBX530
|
|
01365 MOVE L004-QTR-5-9 TO W-X140-REPORT-QTR CL*56
|
|
01366 END-IF. DTSBX530
|
|
01367 DTSBX530
|
|
01368 MOVE X140-REPORT-TYPE TO W-RPT-TYPE. DTSBX530
|
|
01369 IF NOT W-RPT-TYPE-VALID-88 DTSBX530
|
|
01370 SET W-RPT-ERROR-YES-88 TO TRUE CL*81
|
|
01371 MOVE SPACES TO R140-MESSAGE DTSBX530
|
|
01372 MOVE W-EMP-NO TO R140-EMP-NO DTSBX530
|
|
01373 STRING DTSBX530
|
|
01374 'ERROR-RPT INVALID REPORT TYPE ' CL144
|
|
01375 X140-REPORT-TYPE CL**2
|
|
01376 DELIMITED BY SIZE DTSBX530
|
|
01377 INTO R140-MESSAGE DTSBX530
|
|
01378 END-STRING DTSBX530
|
|
01379 MOVE R140-MESSAGE TO P434-MESSAGE CL136
|
|
01380 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX530
|
|
01381 END-IF. DTSBX530
|
|
01382 CL113
|
|
01383 IF W-RPT-TYPE NOT = 'OR' CL115
|
|
01384 SET W-RPT-ERROR-YES-88 TO TRUE CL113
|
|
01385 MOVE SPACES TO R140-MESSAGE CL113
|
|
01386 MOVE W-EMP-NO TO R140-EMP-NO CL113
|
|
01387 STRING CL113
|
|
01388 ':RPT- AMENDED RPT - CANNOT PROCESS ' CL144
|
|
01389 ' ' W-RPT-TYPE CL116
|
|
01390 DELIMITED BY SIZE CL113
|
|
01391 INTO R140-MESSAGE CL113
|
|
01392 END-STRING CL113
|
|
01393 MOVE R140-MESSAGE TO P434-MESSAGE CL136
|
|
01394 PERFORM S946-WRITE-R140 THRU S946-EXIT CL113
|
|
01395 END-IF. CL113
|
|
01396 CL113
|
|
01397 DTSBX530
|
|
01398 * IF W-CURR-RPT-QTR NOT = W-X140-REPORT-QTR CL*82
|
|
01399 * MOVE ZERO TO W-TOT-WAGE CL*82
|
|
01400 * MOVE W-X140-REPORT-QTR TO W-CURR-RPT-QTR CL*82
|
|
01401 * END-IF. CL*82
|
|
01402 MOVE X140-TOTAL-WAGES TO W-TOT-WAGE. DTSBX530
|
|
01403 MOVE X140-TAX-WAGES TO W-TAX-WAGE. DTSBX530
|
|
01404 CL*44
|
|
01405 * IF W-EMP-NO = 177462 CL*53
|
|
01406 * MOVE 1352.07 TO X140-REMITTANCE CL*53
|
|
01407 DISPLAY ' X140-RMT ' X140-REMITTANCE. CL*70
|
|
01408 DTSBX530
|
|
01409 MOVE X140-REMITTANCE TO W-X140-REMITTANCE. CL*53
|
|
01410 DISPLAY ' W-X140-RMT ' W-X140-REMITTANCE. CL*70
|
|
01411 *& DTSBX530
|
|
01412 CL*52
|
|
01413 DISPLAY ' PAY FOUND IND ' W-X145-PAYMENT-FOUND-IND. CL*68
|
|
01414 CL*68
|
|
01415 * IF W-X145-PAYMENT-NO-88 AND W-X140-REMITTANCE > 0 CL175
|
|
01416 * MOVE SPACES TO R140-MESSAGE CL175
|
|
01417 * SET W-RPT-ERROR-YES-88 TO TRUE CL175
|
|
01418 * MOVE W-EMP-NO TO R140-EMP-NO CL175
|
|
01419 * STRING CL175
|
|
01420 * 'ESSP AMT DUE > 0 AND NO PAYMT ' CL175
|
|
01421 * DELIMITED BY SIZE CL175
|
|
01422 * INTO R140-MESSAGE CL175
|
|
01423 * END-STRING CL175
|
|
01424 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL175
|
|
01425 * MOVE R140-MESSAGE TO P434-MESSAGE CL175
|
|
01426 * GO TO P2010-EDIT-CONTINUE CL175
|
|
01427 * END-IF. CL175
|
|
01428 CL*52
|
|
01429 IF W-X145-PAYMENT-NO-88 AND W-X140-REMITTANCE = 0 CL*69
|
|
01430 MOVE SPACES TO R140-MESSAGE CL*69
|
|
01431 MOVE W-EMP-NO TO R140-EMP-NO CL*69
|
|
01432 STRING CL*69
|
|
01433 'X140 REMIT AMT = 0 AND NO X145 FOUND -PROCESS ' CL*70
|
|
01434 ' ' X140-REMITTANCE CL*70
|
|
01435 DELIMITED BY SIZE CL*69
|
|
01436 INTO R140-MESSAGE CL*69
|
|
01437 END-STRING CL*69
|
|
01438 MOVE R140-MESSAGE TO P434-MESSAGE CL136
|
|
01439 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*69
|
|
01440 GO TO P2010-EDIT-CONTINUE CL*69
|
|
01441 END-IF. CL*69
|
|
01442 CL*69
|
|
01443 IF W-X145-TOT-REMIT-AMT > W-X140-REMITTANCE CL*71
|
|
01444 MOVE SPACES TO R140-MESSAGE CL*53
|
|
01445 MOVE W-EMP-NO TO R140-EMP-NO CL*53
|
|
01446 * SET W-WRITE-T025-TRAN-YES-88 TO TRUE CL108
|
|
01447 STRING CL*53
|
|
01448 'X430 X145-PAY AMT > X140-REMIT AMT --PROCESS ' CL113
|
|
01449 X145-REMITTANCE ' ' X140-REMITTANCE CL*75
|
|
01450 DELIMITED BY SIZE CL*53
|
|
01451 INTO R140-MESSAGE CL*53
|
|
01452 END-STRING CL*53
|
|
01453 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*53
|
|
01454 END-IF. CL*53
|
|
01455 CL*53
|
|
01456 IF W-X145-TOT-REMIT-AMT < W-X140-REMITTANCE CL*71
|
|
01457 * SET W-RPT-ERROR-YES-88 TO TRUE CL108
|
|
01458 MOVE SPACES TO R140-MESSAGE CL*67
|
|
01459 MOVE W-EMP-NO TO R140-EMP-NO CL*67
|
|
01460 STRING CL*67
|
|
01461 'X430 X145-PAY AMT < X140-REMIT AMT ' CL*67
|
|
01462 X145-REMITTANCE ' ' X140-REMITTANCE CL*73
|
|
01463 DELIMITED BY SIZE CL*67
|
|
01464 INTO R140-MESSAGE CL*67
|
|
01465 END-STRING CL*67
|
|
01466 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*67
|
|
01467 END-IF. CL*67
|
|
01468 CL*67
|
|
01469 IF W-X145-TOT-REMIT-AMT > 0 AND W-X140-REMITTANCE = 0 CL*71
|
|
01470 * SET W-RPT-ERROR-YES-88 TO TRUE CL108
|
|
01471 MOVE SPACES TO R140-MESSAGE CL*67
|
|
01472 MOVE W-EMP-NO TO R140-EMP-NO CL*67
|
|
01473 STRING CL*67
|
|
01474 'X430 X145-PAY AMT > 0 AND X140-REMIT AMT = 0 ' CL*71
|
|
01475 X145-REMITTANCE ' ' X140-REMITTANCE CL*73
|
|
01476 DELIMITED BY SIZE CL*67
|
|
01477 INTO R140-MESSAGE CL*67
|
|
01478 END-STRING CL*67
|
|
01479 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*67
|
|
01480 END-IF. CL*67
|
|
01481 CL*67
|
|
01482 IF W-X145-TOT-REMIT-AMT = W-X140-REMITTANCE CL102
|
|
01483 ADD 1 TO W-T028-WRITEE-CNT CL102
|
|
01484 SET W-RPT-ERROR-NO-88 TO TRUE CL102
|
|
01485 MOVE SPACES TO R140-MESSAGE CL102
|
|
01486 MOVE W-EMP-NO TO R140-EMP-NO CL102
|
|
01487 STRING CL102
|
|
01488 'X430 ++++ X145-REMIT AMT = X140-REMIT AMT ' CL102
|
|
01489 X145-REMITTANCE ' ' X140-REMITTANCE CL102
|
|
01490 DELIMITED BY SIZE CL102
|
|
01491 INTO R140-MESSAGE CL102
|
|
01492 END-STRING CL102
|
|
01493 PERFORM S946-WRITE-R140 THRU S946-EXIT CL102
|
|
01494 END-IF. CL102
|
|
01495 CL102
|
|
01496 P2010-EDIT-CONTINUE. CL*69
|
|
01497 DISPLAY 'BX430 P1210: ' W-EMP-NO ' TAX: ' X140-TAX-WAGES CL*47
|
|
01498 ' TOT: ' X140-TOTAL-WAGES ' RMT: ' W-X140-REMITTANCE CL*57
|
|
01499 *& DTSBX530
|
|
01500 MOVE ZERO TO W-X140-RECEIVED-DATE. CL*72
|
|
01501 MOVE X140-RCVD-DATE TO W-SLASH-DATE. DTSBX530
|
|
01502 MOVE W-SLASH-DT-MM TO L001-FED-8-MO. DTSBX530
|
|
01503 MOVE W-SLASH-DT-DD TO L001-FED-8-DA. DTSBX530
|
|
01504 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR. DTSBX530
|
|
01505 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX530
|
|
01506 IF NOT L001-VALID-DATE DTSBX530
|
|
01507 SET W-RPT-ERROR-YES-88 TO TRUE CL*81
|
|
01508 MOVE SPACES TO R140-MESSAGE DTSBX530
|
|
01509 MOVE W-EMP-NO TO R140-EMP-NO DTSBX530
|
|
01510 STRING DTSBX530
|
|
01511 ':RPT- INVALID RECEIVED DATE ' CL144
|
|
01512 X140-RCVD-DATE CL**2
|
|
01513 DELIMITED BY SIZE DTSBX530
|
|
01514 INTO R140-MESSAGE DTSBX530
|
|
01515 END-STRING DTSBX530
|
|
01516 MOVE R140-MESSAGE TO P434-MESSAGE CL136
|
|
01517 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX530
|
|
01518 ELSE DTSBX530
|
|
01519 MOVE L001-FED-8-DATE-9 TO W-X140-RECEIVED-DATE CL*72
|
|
01520 END-IF. DTSBX530
|
|
01521 DTSBX530
|
|
01522 MOVE ZERO TO W-CHK-SCAN-DATE. DTSBX530
|
|
01523 * IF X140-IN-HOUSE-88 DTSBX530
|
|
01524 * MOVE X140-CHECK-SCAN-DT TO W-SLASH-DATE DTSBX530
|
|
01525 * MOVE W-SLASH-DT-MM TO L001-FED-8-MO DTSBX530
|
|
01526 * MOVE W-SLASH-DT-DD TO L001-FED-8-DA DTSBX530
|
|
01527 * MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR DTSBX530
|
|
01528 * PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX530
|
|
01529 * IF NOT L001-VALID-DATE DTSBX530
|
|
01530 * SET W-RPT-ERROR-YES-88 TO TRUE CL*81
|
|
01531 * MOVE SPACES TO R140-MESSAGE DTSBX530
|
|
01532 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX530
|
|
01533 * STRING DTSBX530
|
|
01534 * 'REPORT: INVALID CHK SCAN DATE ' DTSBX530
|
|
01535 * X140-CHECK-SCAN-DT DTSBX530
|
|
01536 * DELIMITED BY SIZE DTSBX530
|
|
01537 * INTO R140-MESSAGE DTSBX530
|
|
01538 * END-STRING DTSBX530
|
|
01539 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX530
|
|
01540 ** DISPLAY R140-MESSAGE DTSBX530
|
|
01541 * ELSE DTSBX530
|
|
01542 * MOVE L001-FED-8-DATE-9 TO W-CHK-SCAN-DATE DTSBX530
|
|
01543 * END-IF DTSBX530
|
|
01544 * END-IF. DTSBX530
|
|
01545 DTSBX530
|
|
01546 MOVE X140-WRKR-CNT-1ST-MNTH TO W-1ST-MNTH-CNT. DTSBX530
|
|
01547 MOVE X140-WRKR-CNT-2ND-MNTH TO W-2ND-MNTH-CNT. DTSBX530
|
|
01548 MOVE X140-WRKR-CNT-3RD-MNTH TO W-3RD-MNTH-CNT. DTSBX530
|
|
01549 DTSBX530
|
|
01550 DTSBX530
|
|
01551 P2010-EXIT. DTSBX530
|
|
01552 EXIT. DTSBX530
|
|
01553 DTSBX530
|
|
01554 P2012-CHECK-MPRF. CL**2
|
|
01555 MOVE LOW-VALUE TO MPRF-KEY-AREA. DTSBX530
|
|
01556 MOVE W-EMP-NO TO MPRF-EMP-NO. DTSBX530
|
|
01557 SET MPRF-PRF-88 TO TRUE. DTSBX530
|
|
01558 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBX530
|
|
01559 DTSBX530
|
|
01560 PERFORM S910-READ THRU S910-EXIT. DTSBX530
|
|
01561 CL**2
|
|
01562 IF L910-OK-88 CL**2
|
|
01563 MOVE MSKL-REC TO MPRF-REC CL**2
|
|
01564 MOVE W-X140-REPORT-QTR TO L516-YRQ CL*56
|
|
01565 PERFORM S516-LIABILITY-INFO THRU S516-EXIT CL**2
|
|
01566 IF L516-LIABLE-88 CL*57
|
|
01567 SET W-RPT-ERROR-NO-88 TO TRUE CL*81
|
|
01568 SET W-EMP-FOUND-YES-88 TO TRUE CL*57
|
|
01569 DISPLAY 'X430 -EMPLOYER FOUND LIAB FOR QTR ' MPRF-EMP-NO CL*57
|
|
01570 GO TO P2012-EXIT CL*57
|
|
01571 ELSE CL*57
|
|
01572 SET W-RPT-ERROR-YES-88 TO TRUE CL*81
|
|
01573 MOVE SPACES TO R140-MESSAGE CL**2
|
|
01574 MOVE W-EMP-NO TO R140-EMP-NO CL**2
|
|
01575 STRING CL**2
|
|
01576 ':EMP NOT LIABLE FOR QTRLY RPT ' CL144
|
|
01577 X140-QUARTER CL**7
|
|
01578 DELIMITED BY SIZE CL**2
|
|
01579 INTO R140-MESSAGE CL**2
|
|
01580 END-STRING CL**2
|
|
01581 MOVE R140-MESSAGE TO P434-MESSAGE CL136
|
|
01582 PERFORM S946-WRITE-R140 THRU S946-EXIT CL**2
|
|
01583 SET W-EMP-FOUND-NO-88 TO TRUE CL**2
|
|
01584 GO TO P2012-EXIT CL*51
|
|
01585 ELSE CL*51
|
|
01586 SET W-RPT-ERROR-YES-88 TO TRUE CL*81
|
|
01587 MOVE SPACES TO R140-MESSAGE CL*51
|
|
01588 MOVE W-EMP-NO TO R140-EMP-NO CL*51
|
|
01589 STRING CL*51
|
|
01590 ':EMP NOT FOUND ON DUTAS-CANNOT PRCESS RPT' CL144
|
|
01591 X140-EMP-NO CL*51
|
|
01592 DELIMITED BY SIZE CL*51
|
|
01593 INTO R140-MESSAGE CL*51
|
|
01594 END-STRING CL*51
|
|
01595 MOVE R140-MESSAGE TO P434-MESSAGE CL136
|
|
01596 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*51
|
|
01597 SET W-EMP-FOUND-NO-88 TO TRUE CL*51
|
|
01598 END-IF. CL*51
|
|
01599 CL**2
|
|
01600 P2012-EXIT. CL**2
|
|
01601 EXIT. DTSBX530
|
|
01602 DTSBX530
|
|
01603 CL**2
|
|
01604 P2015-CHECK-MRPT. CL178
|
|
01605 CL178
|
|
01606 MOVE LOW-VALUES TO MRPT-KEY-AREA. CL178
|
|
01607 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. CL178
|
|
01608 MOVE W-X140-REPORT-QTR TO MRPT-YRQ. CL178
|
|
01609 MOVE ZEROS TO MRPT-BATCH-NO. CL178
|
|
01610 MOVE ZEROS TO MRPT-ITEM-NO CL178
|
|
01611 CL178
|
|
01612 SET MRPT-RPT-88 TO TRUE. CL178
|
|
01613 MOVE MRPT-REC TO MSKL-REC. CL178
|
|
01614 CL178
|
|
01615 PERFORM S910-START-BROWSE THRU S910-EXIT. CL178
|
|
01616 IF L910-OK-88 CL178
|
|
01617 PERFORM P2016-SCAN-MRPT THRU P2016-EXIT CL178
|
|
01618 UNTIL L910-NO-REC-88 CL178
|
|
01619 ELSE CL178
|
|
01620 SET W-RPT-ERROR-NO-88 TO TRUE CL178
|
|
01621 DISPLAY 'P2013 X430 ORIG RPT NOT ON DUTAS- PROCESS ' CL178
|
|
01622 W-EMP-NO ' ' W-X140-REPORT-QTR CL178
|
|
01623 DISPLAY ' ' CL178
|
|
01624 GO TO P2015-EXIT. CL178
|
|
01625 CL178
|
|
01626 CL178
|
|
01627 P2015-EXIT. CL178
|
|
01628 EXIT. CL178
|
|
01629 CL178
|
|
01630 P2016-SCAN-MRPT. CL178
|
|
01631 MOVE MSKL-REC TO MRPT-REC. CL178
|
|
01632 IF MRPT-YRQ = W-X140-REPORT-QTR CL178
|
|
01633 NEXT SENTENCE CL178
|
|
01634 ELSE CL178
|
|
01635 IF MRPT-YRQ > W-X140-REPORT-QTR CL178
|
|
01636 SET W-RPT-ERROR-NO-88 TO TRUE CL178
|
|
01637 SET L910-NO-REC-88 TO TRUE CL178
|
|
01638 GO TO P2016-EXIT CL178
|
|
01639 ELSE CL178
|
|
01640 GO TO P2016-READ-NEXT CL178
|
|
01641 END-IF CL178
|
|
01642 END-IF. CL178
|
|
01643 CL178
|
|
01644 IF MRPT-ORIG-88 CL178
|
|
01645 SET W-RPT-ERROR-YES-88 TO TRUE CL178
|
|
01646 SET L910-NO-REC-88 TO TRUE CL178
|
|
01647 MOVE SPACES TO R140-MESSAGE CL179
|
|
01648 MOVE W-EMP-NO TO R140-EMP-NO CL179
|
|
01649 STRING CL179
|
|
01650 ':ORIGINAL RPT EXIST IN DUTAS -NOT ADDED ' CL179
|
|
01651 X140-QUARTER CL179
|
|
01652 DELIMITED BY SIZE CL179
|
|
01653 INTO R140-MESSAGE CL179
|
|
01654 END-STRING CL179
|
|
01655 MOVE R140-MESSAGE TO P434-MESSAGE CL179
|
|
01656 PERFORM S946-WRITE-R140 THRU S946-EXIT CL179
|
|
01657 GO TO P2016-EXIT CL178
|
|
01658 END-IF. CL178
|
|
01659 CL178
|
|
01660 CL178
|
|
01661 P2016-READ-NEXT. CL178
|
|
01662 PERFORM S910-READ-NEXT THRU S910-EXIT. CL178
|
|
01663 IF L910-NO-REC-88 CL178
|
|
01664 SET W-RPT-ERROR-NO-88 TO TRUE. CL178
|
|
01665 P2016-EXIT. CL178
|
|
01666 CL**3
|
|
01667 P2020-SAVE-EXT-REPORT. DTSBX530
|
|
01668 DISPLAY 'P2020-SAVE-EXT-REPORT ' DTSBX530
|
|
01669 ************************************************************ DTSBX530
|
|
01670 * REPORTS FROM EXTERNAL SOURCES. REPORTS WILL BE DTSBX530
|
|
01671 * ASSEMBLED INTO BATCHES IN DTSBD140. CHANGED ALL T027 DTSBX530
|
|
01672 * TO BE T028 PER DOCUMENTATION IN BD140 FROM GIL 4/10/12 DTSBX530
|
|
01673 ************************************************************ DTSBX530
|
|
01674 MOVE LENGTH OF T028-REC TO T028-LENGTH DTSBX530
|
|
01675 MOVE '028' TO T028-REC-TYPE. DTSBX530
|
|
01676 DTSBX530
|
|
01677 MOVE W-EMP-NO TO T028-EMP-NO. DTSBX530
|
|
01678 MOVE 'WEB ESSP' TO T028-ORIGIN. DTSBX530
|
|
01679 MOVE LX42-SYS-DATE TO T028-SYS-DATE. DTSBX530
|
|
01680 MOVE LX42-SYS-TIME TO T028-SYS-TIME. DTSBX530
|
|
01681 SET T028-WEB-RPT-88 TO TRUE. DTSBX530
|
|
01682 DTSBX530
|
|
01683 MOVE LX42-EXT-PSEUDO-BATCH TO T028-PSEUDO-BATCH-NO. DTSBX530
|
|
01684 MOVE LX42-EXT-PSEUDO-ITEM TO T028-PSEUDO-ITEM-NO. DTSBX530
|
|
01685 DTSBX530
|
|
01686 MOVE W-X140-REPORT-QTR TO T028-YRQ. CL*56
|
|
01687 IF W-EMP-FOUND-YES-88 DTSBX530
|
|
01688 MOVE MPRF-PRIMARY-NAME (1:4) DTSBX530
|
|
01689 TO T028-NAME-CHECK DTSBX530
|
|
01690 ELSE DTSBX530
|
|
01691 MOVE SPACES TO T028-NAME-CHECK DTSBX530
|
|
01692 END-IF. DTSBX530
|
|
01693 MOVE W-RPT-TYPE TO T028-RPT-TYPE. DTSBX530
|
|
01694 DTSBX530
|
|
01695 **************************************************************** DTSBX530
|
|
01696 * LX42-LAST-DETERM-EMP IS SET BY DTSBX420 WHEN PROCESSING DTSBX530
|
|
01697 * A DETERMINATION. IT IS USED TO DETERMINE WHEN TO WAIVE DTSBX530
|
|
01698 * P & I. THE WAIVER IS AUTOMATIC FOR REPORTS WITHIN DTSBX530
|
|
01699 * THE LAST 5 QUARTERS SUBMITTED ALONG WITH A WEB DTSBX530
|
|
01700 * REGISTRATION. DTSBX530
|
|
01701 **************************************************************** DTSBX530
|
|
01702 IF (W-EMP-NO = LX42-LAST-DETERM-EMP DTSBX530
|
|
01703 AND W-X140-REPORT-QTR >= W-WAIVER-QTR) CL*56
|
|
01704 SET T028-WAIVE-BOTH-YES-88 TO TRUE DTSBX530
|
|
01705 ELSE DTSBX530
|
|
01706 SET T028-WAIVE-BOTH-NO-88 TO TRUE DTSBX530
|
|
01707 END-IF. DTSBX530
|
|
01708 SET T028-WAIVE-INT-NO-88 TO TRUE. DTSBX530
|
|
01709 SET T028-WAIVE-LATE-PEN-NO-88 TO TRUE. DTSBX530
|
|
01710 MOVE W-X140-RECEIVED-DATE TO T028-RECEIVED-DATE CL*72
|
|
01711 T028-DEPOSIT-DATE. DTSBX530
|
|
01712 DTSBX530
|
|
01713 MOVE W-TOT-WAGE TO T028-TOT-WAGE. DTSBX530
|
|
01714 DTSBX530
|
|
01715 IF W-EMP-FOUND-NO-88 DTSBX530
|
|
01716 MOVE W-TAX-WAGE TO T028-TAX-WAGE DTSBX530
|
|
01717 COMPUTE T028-EXCESS-WAGE = DTSBX530
|
|
01718 (T028-TOT-WAGE - T028-TAX-WAGE) DTSBX530
|
|
01719 ELSE DTSBX530
|
|
01720 IF MPRF-CLASS-SELF-INS-88 DTSBX530
|
|
01721 MOVE ZERO TO T028-TAX-WAGE DTSBX530
|
|
01722 T028-EXCESS-WAGE DTSBX530
|
|
01723 ELSE DTSBX530
|
|
01724 MOVE W-TAX-WAGE TO T028-TAX-WAGE DTSBX530
|
|
01725 COMPUTE T028-EXCESS-WAGE = DTSBX530
|
|
01726 (T028-TOT-WAGE - T028-TAX-WAGE) DTSBX530
|
|
01727 END-IF DTSBX530
|
|
01728 END-IF. DTSBX530
|
|
01729 DTSBX530
|
|
01730 MOVE ZERO TO T028-TOTAL-EMPL-CNT. DTSBX530
|
|
01731 MOVE X140-WRKR-CNT-1ST-MNTH TO T028-1ST-MTH-EMPL-CNT. DTSBX530
|
|
01732 MOVE X140-WRKR-CNT-2ND-MNTH TO T028-2ND-MTH-EMPL-CNT. DTSBX530
|
|
01733 MOVE X140-WRKR-CNT-3RD-MNTH TO T028-3RD-MTH-EMPL-CNT. DTSBX530
|
|
01734 DTSBX530
|
|
01735 DISPLAY ' X145 PAY AMT ' X145-REMITTANCE CL109
|
|
01736 DISPLAY ' X140 PAY AMT ' X140-REMITTANCE CL109
|
|
01737 CL108
|
|
01738 MOVE W-X145-TOT-REMIT-AMT TO W-X140-REMITTANCE CL108
|
|
01739 MOVE W-X140-REMITTANCE TO T028-REMIT-AMT. CL100
|
|
01740 DTSBX530
|
|
01741 ADD W-X145-TOT-REMIT-AMT TO W-TOT-REMIT-AMT. CL142
|
|
01742 SET T028-PASSED-FULL-EDITS-YES-88 TO TRUE DTSBX530
|
|
01743 CL156
|
|
01744 CL163
|
|
01745 IF X145-TRACE-NO > SPACES CL164
|
|
01746 MOVE X145-TRACE-NO TO T028-TRACE-NO CL164
|
|
01747 ELSE CL156
|
|
01748 MOVE ZERO TO T028-TRACE-NO. CL156
|
|
01749 DTSBX530
|
|
01750 MOVE 'VOL' TO T028-RESPONSIBLE-ACTIVITY. DTSBX530
|
|
01751 IF W-PAY-TYPE = '01' CL243
|
|
01752 MOVE 'TDECCHK ' TO T028-RESPONSIBLE-OP-ID CL243
|
|
01753 ELSE CL243
|
|
01754 MOVE 'WEBESSP ' TO T028-RESPONSIBLE-OP-ID. CL243
|
|
01755 DTSBX530
|
|
01756 DISPLAY 'BX430 WEB RPT ' X140-EMP-NO ' ' X140-QUARTER. CL*47
|
|
01757 PERFORM S1032-WRITE-TEMP-T028 THRU S1032-EXIT. DTSBX530
|
|
01758 DTSBX530
|
|
01759 PERFORM P4000-WRITE-X434-PAID-REPT THRU P4000-EXIT. CL124
|
|
01760 CL124
|
|
01761 * DISPLAY W-EMP-NO ',' T028-TOT-WAGE CL124
|
|
01762 * ',' T028-EXCESS-WAGE CL124
|
|
01763 * ',' T028-TAX-WAGE CL124
|
|
01764 * ',' X140-REMITTANCE CL124
|
|
01765 * ',' X145-REMITTANCE. CL124
|
|
01766 CL110
|
|
01767 IF W-X140-REMITTANCE > 0 CL100
|
|
01768 ADD 1 TO W-T028-WRITE-CNT CL100
|
|
01769 ELSE CL100
|
|
01770 ADD 1 TO W-T028-WRITE-CNT CL100
|
|
01771 ADD 1 TO W-T028-WRITEO-CNT. CL100
|
|
01772 CL100
|
|
01773 * IF W-WRITE-T025-TRAN-YES-88 CL108
|
|
01774 * PERFORM P2021-WRITE-T025 THRU P2021-EXIT CL108
|
|
01775 * ELSE CL108
|
|
01776 SET W-RPT-ERROR-NO-88 TO TRUE CL*81
|
|
01777 MOVE SPACES TO R140-MESSAGE CL*71
|
|
01778 MOVE W-EMP-NO TO R140-EMP-NO CL*71
|
|
01779 STRING CL*71
|
|
01780 'X430 -:>>>>> REPORT ADDED TO DUTAS - ' X140-QUARTER CL*93
|
|
01781 DELIMITED BY SIZE CL*71
|
|
01782 INTO R140-MESSAGE CL*71
|
|
01783 END-STRING CL*71
|
|
01784 PERFORM S946-WRITE-R140 THRU S946-EXIT. CL*71
|
|
01785 P2020-EXIT. DTSBX530
|
|
01786 EXIT. DTSBX530
|
|
01787 DTSBX530
|
|
01788 P2021-WRITE-T025. CL*71
|
|
01789 ** CL*73
|
|
01790 **PAYMENT TRANSACTION REMIT AMT > 0 CL186
|
|
01791 **WRITE A PA T025 TRANSACTION. CL186
|
|
01792 ** CL*73
|
|
01793 DISPLAY 'PAYMENT OK ' X145-EMP-NO. CL*71
|
|
01794 CL*71
|
|
01795 MOVE LENGTH OF T025-REC TO T025-LENGTH CL*71
|
|
01796 MOVE '025' TO T025-REC-TYPE. CL*71
|
|
01797 CL*71
|
|
01798 MOVE W-EMP-NO TO T025-EMP-NO. CL*71
|
|
01799 MOVE 'WEB PAY' TO T025-ORIGIN. CL*71
|
|
01800 MOVE LX42-SYS-DATE TO T025-SYS-DATE. CL*71
|
|
01801 MOVE LX42-SYS-TIME TO T025-SYS-TIME. CL*71
|
|
01802 * CL*71
|
|
01803 * IF W-PAY-ACH-88 OR W-PAY-SCK-88 CL246
|
|
01804 * MOVE +0 TO T025-APPLIC-YRQ CL246
|
|
01805 * ELSE CL246
|
|
01806 MOVE W-X145-PAYMENT-QTR TO T025-APPLIC-YRQ. CL239
|
|
01807 CL239
|
|
01808 MOVE 'PA' TO T025-PAY-TYPE CL186
|
|
01809 CL*71
|
|
01810 MOVE SPACES TO T025-APPLIC-IND. CL*71
|
|
01811 MOVE ZERO TO T025-APPLIC-BATCH-NO CL*71
|
|
01812 T025-APPLIC-ITEM-NO. CL*71
|
|
01813 CL*71
|
|
01814 IF W-EMP-FOUND-YES-88 CL*71
|
|
01815 MOVE MPRF-PRIMARY-NAME (1:4) CL*71
|
|
01816 TO T025-NAME-CHECK CL*71
|
|
01817 ELSE CL*71
|
|
01818 MOVE SPACES TO T025-NAME-CHECK CL*71
|
|
01819 END-IF. CL*71
|
|
01820 CL*71
|
|
01821 MOVE W-X145-RECEIVED-DATE TO T025-RECEIVED-DATE CL*72
|
|
01822 T025-DEPOSIT-DATE. CL*71
|
|
01823 CL*71
|
|
01824 * COMPUTE W-T025-REMIT-AMT = W-X145-TOT-REMIT-AMT - CL186
|
|
01825 * W-X140-REMITTANCE. CL186
|
|
01826 CL*71
|
|
01827 * MOVE W-T025-REMIT-AMT TO T025-REMIT-AMT. CL186
|
|
01828 MOVE W-X145-TOT-REMIT-AMT TO T025-REMIT-AMT. CL186
|
|
01829 CL*71
|
|
01830 CL186
|
|
01831 IF X145-TRACE-NO > SPACES CL186
|
|
01832 MOVE X145-TRACE-NO TO T025-TRACE-NO CL186
|
|
01833 ELSE CL186
|
|
01834 MOVE ZEROS TO T025-TRACE-NO. CL186
|
|
01835 CL186
|
|
01836 CL*71
|
|
01837 MOVE 'VOL' TO T025-RESPONSIBLE-ACTIVITY. CL*71
|
|
01838 MOVE 'WEBESSP' TO T025-RESPONSIBLE-OP-ID. CL*71
|
|
01839 CL*71
|
|
01840 * MOVE T025-REC TO TSKL-REC. CL*71
|
|
01841 * PERFORM S927B-WRITE THRU S927B-EXIT. CL*71
|
|
01842 CL*71
|
|
01843 PERFORM S1033-WRITE-TEMP-T025 THRU S1033-EXIT. CL*71
|
|
01844 ADD +1 TO W-T025-WRITE-CNT. CL*71
|
|
01845 CL*71
|
|
01846 CL215
|
|
01847 IF W-PAY-ACH-88 CL220
|
|
01848 ADD +1 TO W-A145-SAV-CNT CL217
|
|
01849 ADD W-X145-TOT-REMIT-AMT TO W-A145-TOT-AMT CL217
|
|
01850 ELSE CL215
|
|
01851 IF W-PAY-CHK-88 CL220
|
|
01852 ADD +1 TO W-C145-SAV-CNT CL217
|
|
01853 ADD W-X145-TOT-REMIT-AMT TO W-C145-TOT-AMT CL217
|
|
01854 ELSE CL215
|
|
01855 IF W-PAY-SCK-88 CL221
|
|
01856 ADD +1 TO W-S145-SAV-CNT CL217
|
|
01857 ADD W-X145-TOT-REMIT-AMT TO W-S145-TOT-AMT CL217
|
|
01858 ELSE CL215
|
|
01859 DISPLAY ' ****** ERROR UNKNOW PAY TYPE ' X145-EMP-NO. CL215
|
|
01860 CL215
|
|
01861 MOVE ZEROS TO W-T025-REMIT-AMT CL*72
|
|
01862 * W-S145-TOT-AMT CL224
|
|
01863 * W-C145-TOT-AMT CL224
|
|
01864 * W-A145-TOT-AMT CL224
|
|
01865 W-X145-TOT-REMIT-AMT CL*72
|
|
01866 W-X140-REMITTANCE. CL*72
|
|
01867 CL*72
|
|
01868 * PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT. CL193
|
|
01869 * WRITE REPT-PAID-REC FROM DETAIL-PEND-1 AFTER 1. CL188
|
|
01870 MOVE ZEROS TO W-T025-REMIT-AMT CL186
|
|
01871 W-X145-TOT-REMIT-AMT CL186
|
|
01872 W-X140-REMITTANCE. CL186
|
|
01873 CL186
|
|
01874 SET W-WRITE-T025-TRAN-NO-88 TO TRUE. CL186
|
|
01875 CL186
|
|
01876 SET W-RPT-ERROR-NO-88 TO TRUE CL186
|
|
01877 MOVE SPACES TO R140-MESSAGE CL186
|
|
01878 MOVE W-EMP-NO TO R140-EMP-NO CL186
|
|
01879 STRING CL186
|
|
01880 'X430 -: >>>>> PAYMENT T025 CREATED ' CL186
|
|
01881 'REMIT AMT' CL186
|
|
01882 DELIMITED BY SIZE CL186
|
|
01883 INTO R140-MESSAGE CL186
|
|
01884 END-STRING CL186
|
|
01885 PERFORM S946-WRITE-R140 THRU S946-EXIT. CL186
|
|
01886 P2021-EXIT. CL*71
|
|
01887 EXIT. CL*71
|
|
01888 CL*71
|
|
01889 DTSBX530
|
|
01890 P3000-WAGES. DTSBX530
|
|
01891 MOVE LX42-DATA-AREA TO X144-REC. DTSBX530
|
|
01892 * DISPLAY 'X144: ' X144-REC. CL160
|
|
01893 MOVE X144-EMP-NO TO W-EMP-NO. CL*38
|
|
01894 * CL**4
|
|
01895 ADD +1 TO W-X144-RED-CNT CL*96
|
|
01896 SET W-RPT-ERROR-NO-88 TO TRUE. CL147
|
|
01897 SET W-PREV-REC-WAGE-88 TO TRUE. CL162
|
|
01898 * CL**4
|
|
01899 * DISPLAY 'LX-E ' LX42-X140-EMP-NO ' X145-E ' W-EMP-NO. CL*97
|
|
01900 * IF LX42-X145-EMP-NO = '999999' OR CL157
|
|
01901 * LX42-X140-EMP-NO = '999999' OR CL157
|
|
01902 * LX42-X145-EMP-NO = SPACES OR CL157
|
|
01903 * LX42-X140-EMP-NO = SPACES OR CL157
|
|
01904 * W-PREV-RPT-NULL-88 CL157
|
|
01905 * SET W-RPT-ERROR-YES-88 TO TRUE CL157
|
|
01906 * MOVE SPACES TO R140-MESSAGE CL157
|
|
01907 * MOVE W-EMP-NO TO R140-EMP-NO CL157
|
|
01908 * STRING CL157
|
|
01909 * 'X430 -: X144 WAGES HAS NO X140 REPORT -- CANCEL - WAGES ' CL157
|
|
01910 * ' ' X144-QUARTER CL157
|
|
01911 * DELIMITED BY SIZE CL157
|
|
01912 * INTO R140-MESSAGE CL157
|
|
01913 * END-STRING CL157
|
|
01914 * WRITE PEND-X144-REC FROM X144-REC CL157
|
|
01915 * ADD +1 TO W-X144-ERR-CNT CL157
|
|
01916 * ADD +1 TO W-X144-PEN-CNT CL157
|
|
01917 * PERFORM P6000-WRITE-PEND-FILES THRU P6000-EXIT CL117
|
|
01918 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL*83
|
|
01919 * GO TO P3000-EXIT. CL159
|
|
01920 CL*36
|
|
01921 * CL**4
|
|
01922 * IF W-PREV-RPT-RPT-88 CL157
|
|
01923 * OR W-PREV-RPT-WAGE-88 CL157
|
|
01924 * SET W-PREV-RPT-WAGE-88 TO TRUE CL162
|
|
01925 ADD +1 TO W-X144-PRO-CNT CL*56
|
|
01926 PERFORM P3010-EDIT-WAGES THRU P3010-EXIT DTSBX530
|
|
01927 IF W-RPT-ERROR-NO-88 CL*81
|
|
01928 PERFORM P3011-WRITE-WAGES-X144 THRU P3011-EXIT DTSBX530
|
|
01929 ADD +1 TO W-X144-SAV-CNT CL*96
|
|
01930 GO TO P3000-EXIT CL160
|
|
01931 ELSE CL*36
|
|
01932 SET W-RPT-ERROR-YES-88 TO TRUE CL*81
|
|
01933 MOVE SPACES TO R140-MESSAGE CL*36
|
|
01934 MOVE W-EMP-NO TO R140-EMP-NO CL*36
|
|
01935 STRING CL*36
|
|
01936 'X430 -: WAGE RECORD CONTAINS ERRORS CANNOT PROCESS ' CL*47
|
|
01937 ' ' X144-SSN CL*36
|
|
01938 DELIMITED BY SIZE CL*36
|
|
01939 INTO R140-MESSAGE CL*36
|
|
01940 END-STRING CL*36
|
|
01941 ADD +1 TO W-X144-ERR-CNT CL*93
|
|
01942 ADD +1 TO W-X144-PEN-CNT CL*96
|
|
01943 WRITE PEND-X144-REC FROM X144-REC CL*93
|
|
01944 PERFORM P6000-WRITE-PEND-X144 THRU P6000-EXIT CL144
|
|
01945 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*36
|
|
01946 GO TO P3000-EXIT CL*36
|
|
01947 * ELSE CL157
|
|
01948 * SET W-RPT-ERROR-YES-88 TO TRUE CL157
|
|
01949 * MOVE SPACES TO R140-MESSAGE CL157
|
|
01950 * MOVE W-EMP-NO TO R140-EMP-NO CL157
|
|
01951 * STRING CL157
|
|
01952 * 'X430 -: REPORT RECORD X140 NOT FOUND OR MISSING ' CL157
|
|
01953 * ' ' X144-SSN CL157
|
|
01954 * DELIMITED BY SIZE CL157
|
|
01955 * INTO R140-MESSAGE CL157
|
|
01956 * END-STRING CL157
|
|
01957 * WRITE PEND-X144-REC FROM X144-REC CL157
|
|
01958 * ADD +1 TO W-X144-ERR-CNT CL157
|
|
01959 * ADD +1 TO W-X144-PEN-CNT CL157
|
|
01960 * PERFORM P6000-WRITE-PEND-FILES THRU P6000-EXIT CL*93
|
|
01961 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL157
|
|
01962 END-IF. DTSBX530
|
|
01963 DTSBX530
|
|
01964 P3000-EXIT. DTSBX530
|
|
01965 EXIT. DTSBX530
|
|
01966 DTSBX530
|
|
01967 P3010-EDIT-WAGES. DTSBX530
|
|
01968 DISPLAY 'P3010-EDIT-WAGES ' CL162
|
|
01969 * DISPLAY 'X144-QUARTER ' X144-QUARTER CL*36
|
|
01970 MOVE X144-QUARTER TO W-SLASH-QTR. DTSBX530
|
|
01971 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR. DTSBX530
|
|
01972 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q. DTSBX530
|
|
01973 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX530
|
|
01974 IF NOT L004-VALID-QTR DTSBX530
|
|
01975 SET W-RPT-ERROR-YES-88 TO TRUE CL*81
|
|
01976 MOVE SPACES TO R140-MESSAGE DTSBX530
|
|
01977 MOVE W-EMP-NO TO R140-EMP-NO DTSBX530
|
|
01978 STRING DTSBX530
|
|
01979 ': WAGE RECORD HAS INVALID QUARTER ' CL144
|
|
01980 X144-QUARTER ' ' X144-SSN CL*36
|
|
01981 DELIMITED BY SIZE DTSBX530
|
|
01982 INTO R140-MESSAGE DTSBX530
|
|
01983 END-STRING DTSBX530
|
|
01984 MOVE R140-MESSAGE TO P434-MESSAGE CL144
|
|
01985 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX530
|
|
01986 ELSE CL*13
|
|
01987 MOVE L004-QTR-5-9 TO W-X144-WAGE-QTR CL*53
|
|
01988 END-IF. DTSBX530
|
|
01989 CL*15
|
|
01990 * IF L004-QTR-5-9 NOT = W-X140-REPORT-QTR CL161
|
|
01991 * SET W-RPT-ERROR-YES-88 TO TRUE CL161
|
|
01992 * MOVE SPACES TO R140-MESSAGE CL161
|
|
01993 * MOVE W-EMP-NO TO R140-EMP-NO CL161
|
|
01994 * MOVE W-X140-REPORT-QTR TO WRK-REPORT-QTR CL161
|
|
01995 * STRING CL161
|
|
01996 * ':WAGE QTR NOT = RPT QTR ' CL161
|
|
01997 * X144-QUARTER ' ' WRK-REPORT-QTR CL161
|
|
01998 * DELIMITED BY SIZE CL161
|
|
01999 * INTO R140-MESSAGE CL161
|
|
02000 * END-STRING CL161
|
|
02001 * MOVE R140-MESSAGE TO P434-MESSAGE CL161
|
|
02002 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL161
|
|
02003 * END-IF. CL161
|
|
02004 DTSBX530
|
|
02005 IF X144-SSN NOT NUMERIC DTSBX530
|
|
02006 * DISPLAY 'X144-SSN ' X144-SSN CL*36
|
|
02007 SET W-RPT-ERROR-YES-88 TO TRUE CL*81
|
|
02008 MOVE SPACES TO R140-MESSAGE DTSBX530
|
|
02009 MOVE W-EMP-NO TO R140-EMP-NO DTSBX530
|
|
02010 STRING DTSBX530
|
|
02011 ':WAGE RECORD NON-NUMERIC SSN ' CL144
|
|
02012 X144-SSN DTSBX530
|
|
02013 DELIMITED BY SIZE DTSBX530
|
|
02014 INTO R140-MESSAGE DTSBX530
|
|
02015 END-STRING DTSBX530
|
|
02016 MOVE R140-MESSAGE TO P434-MESSAGE CL144
|
|
02017 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX530
|
|
02018 ELSE DTSBX530
|
|
02019 MOVE X144-SSN TO W-SSN DTSBX530
|
|
02020 END-IF. DTSBX530
|
|
02021 DTSBX530
|
|
02022 IF X144-SSN = ZEROS CL*53
|
|
02023 * DISPLAY 'X144-SSN ' X144-SSN CL*53
|
|
02024 SET W-RPT-ERROR-YES-88 TO TRUE CL*81
|
|
02025 MOVE SPACES TO R140-MESSAGE CL*53
|
|
02026 MOVE W-EMP-NO TO R140-EMP-NO CL*53
|
|
02027 STRING CL*53
|
|
02028 ':WAGE RECORD SSN = ZEROS ' CL144
|
|
02029 X144-SSN CL*53
|
|
02030 DELIMITED BY SIZE CL*53
|
|
02031 INTO R140-MESSAGE CL*53
|
|
02032 END-STRING CL*53
|
|
02033 MOVE R140-MESSAGE TO P434-MESSAGE CL144
|
|
02034 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*53
|
|
02035 ELSE CL*53
|
|
02036 MOVE X144-SSN TO W-SSN CL*53
|
|
02037 END-IF. CL*53
|
|
02038 CL*53
|
|
02039 * DISPLAY 'SSN: ' X144-SSN ' LN: ' X144-LAST-NAME CL162
|
|
02040 * ' FN: ' X144-FIRST-NAME. CL162
|
|
02041 IF X144-LAST-NAME = SPACES CL*36
|
|
02042 SET W-RPT-ERROR-YES-88 TO TRUE CL*81
|
|
02043 MOVE SPACES TO R140-MESSAGE CL*36
|
|
02044 MOVE W-EMP-NO TO R140-EMP-NO CL*36
|
|
02045 STRING CL*36
|
|
02046 ':WAGE RECORD BLANK LAST NAME ' CL144
|
|
02047 X144-SSN CL*36
|
|
02048 DELIMITED BY SIZE CL*36
|
|
02049 INTO R140-MESSAGE CL*36
|
|
02050 END-STRING CL*36
|
|
02051 MOVE R140-MESSAGE TO P434-MESSAGE CL144
|
|
02052 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*36
|
|
02053 END-IF. CL*36
|
|
02054 CL*36
|
|
02055 IF X144-FIRST-NAME = SPACES CL*36
|
|
02056 SET W-RPT-ERROR-YES-88 TO TRUE CL*81
|
|
02057 MOVE SPACES TO R140-MESSAGE CL*36
|
|
02058 MOVE W-EMP-NO TO R140-EMP-NO CL*36
|
|
02059 STRING CL*36
|
|
02060 ':WAGE RECORD BLANK FIRST NAME ' CL144
|
|
02061 X144-SSN CL*36
|
|
02062 DELIMITED BY SIZE CL*36
|
|
02063 INTO R140-MESSAGE CL*36
|
|
02064 END-STRING CL*36
|
|
02065 MOVE R140-MESSAGE TO P434-MESSAGE CL144
|
|
02066 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*36
|
|
02067 END-IF. CL*36
|
|
02068 CL*36
|
|
02069 * IF W-CURR-WAGE-QTR NOT = W-WAGE-QTR DTSBX530
|
|
02070 * MOVE ZERO TO W-WRKR-TOT-WAGE DTSBX530
|
|
02071 * MOVE W-WAGE-QTR TO W-CURR-WAGE-QTR DTSBX530
|
|
02072 * END-IF. DTSBX530
|
|
02073 DTSBX530
|
|
02074 * MOVE X144-EARNINGS TO W-EARNINGS-X. DTSBX530
|
|
02075 * MOVE W-EARNINGS-9 TO W-EARNINGS. DTSBX530
|
|
02076 * ADD W-EARNINGS TO W-WRKR-TOT-WAGE. DTSBX530
|
|
02077 * DISPLAY 'X144-LAST-NAME ' X144-LAST-NAME DTSBX530
|
|
02078 * MOVE X144-LAST-NAME TO W-WRKR-LAST-NAME. DTSBX530
|
|
02079 * MOVE X144-FIRST-NAME TO W-WRKR-FIRST-NAME. DTSBX530
|
|
02080 * MOVE X144-MID-INIT TO W-WRKR-MID-INIT. DTSBX530
|
|
02081 DTSBX530
|
|
02082 P3010-EXIT. DTSBX530
|
|
02083 EXIT. DTSBX530
|
|
02084 DTSBX530
|
|
02085 P3011-WRITE-WAGES-X144. DTSBX530
|
|
02086 DTSBX530
|
|
02087 ************************************************************** CL*11
|
|
02088 * WRITE W4 WAGES FOR DOCS CL*11
|
|
02089 ************************************************************** CL*11
|
|
02090 * CL*11
|
|
02091 MOVE LOW-VALUES TO ESP-TRANSACTION-AREA. CL*11
|
|
02092 MOVE X144-SSN TO W4-SSN. CL*11
|
|
02093 MOVE 'W4' TO W4-TRAN-ID. CL*11
|
|
02094 MOVE '00044001' TO W4-TRAN-OPER-ID. CL*11
|
|
02095 MOVE MHDR-CURR-RUN-DATE TO W4-DATE-ENTERED. CL*11
|
|
02096 MOVE ZEROS TO W4-TIME-ENTERED. CL*11
|
|
02097 MOVE X144-LAST-NAME (1:3) TO W4-NAME-CHECK. CL*11
|
|
02098 MOVE W-X144-WAGE-QTR TO W4-QUARTER. CL118
|
|
02099 MOVE X144-EARNINGS TO W4-QUARTER-EARNINGS. CL*11
|
|
02100 MOVE 2 TO W4-AFFI-CODE. CL*11
|
|
02101 MOVE X144-EMP-NO TO W4-ACCOUNT. CL*11
|
|
02102 MOVE MPRF-PRIMARY-NAME (1:4) TO W4-EMP-NAME. CL*11
|
|
02103 CL*11
|
|
02104 * MOVE ESP-TRANSACTION-AREA TO WAGE-TRANS-REC. CL*20
|
|
02105 MOVE ESP-TRANSACTION-AREA TO WAGE-OUT-REC. CL*20
|
|
02106 CL*11
|
|
02107 * WRITE WAGE-TRANS-REC. CL*20
|
|
02108 WRITE WAGE-OUT-REC. CL*20
|
|
02109 CL*11
|
|
02110 IF WAGE-TEMP-STATUS-OK-88 CL*32
|
|
02111 ADD +1 TO W-W4-CNT CL*11
|
|
02112 * DISPLAY 'WRITE W4 ' W4-ACCOUNT ' ' W4-QUARTER CL162
|
|
02113 * ' ' W4-SSN CL162
|
|
02114 ELSE CL*11
|
|
02115 DISPLAY 'ERROR WRITING W4- WAGE FILE ' CL*36
|
|
02116 WAGE-TEMP-STATUS CL*32
|
|
02117 END-IF. CL*11
|
|
02118 CL*11
|
|
02119 CL*11
|
|
02120 P3011-EXIT. CL*25
|
|
02121 EXIT. DTSBX530
|
|
02122 P4000-WRITE-X434-PAID-REPT. CL119
|
|
02123 CL119
|
|
02124 MOVE X140-EMP-NO TO X434-EMP-NO CL119
|
|
02125 MOVE X140-QUARTER TO X434-QTR CL125
|
|
02126 IF W-EMP-FOUND-YES-88 CL119
|
|
02127 MOVE MPRF-PRIMARY-NAME (1:15) CL119
|
|
02128 TO X434-NAME-CHECK CL119
|
|
02129 ELSE CL119
|
|
02130 MOVE SPACES TO X434-NAME-CHECK CL119
|
|
02131 END-IF. CL119
|
|
02132 CL119
|
|
02133 MOVE X140-RCVD-DATE TO X434-RCVD-DATE CL121
|
|
02134 MOVE T028-TOT-WAGE TO X434-TOT-WAGE CL119
|
|
02135 MOVE T028-EXCESS-WAGE TO X434-EXC-WAGE CL119
|
|
02136 MOVE T028-TAX-WAGE TO X434-TAX-WAGE CL119
|
|
02137 MOVE X140-REMITTANCE TO X434-X140-REMIT CL119
|
|
02138 WS-X140-REMITTANCE CL149
|
|
02139 MOVE W-X140-REMITTANCE TO X434-X145-REMIT CL119
|
|
02140 CL148
|
|
02141 COMPUTE W-T025-REMIT-AMT = W-X145-TOT-REMIT-AMT - CL149
|
|
02142 WS-X140-REMITTANCE. CL149
|
|
02143 CL149
|
|
02144 MOVE W-T025-REMIT-AMT TO X434-DIFF. CL149
|
|
02145 CL148
|
|
02146 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. CL121
|
|
02147 MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. CL125
|
|
02148 MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. CL125
|
|
02149 MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. CL125
|
|
02150 CL119
|
|
02151 * IF W-ERROR-NO-88 CL120
|
|
02152 * MOVE 'PROCESSED' TO P434-MESSAGE CL188
|
|
02153 * ELSE CL120
|
|
02154 * MOVE 'PENDING ' TO P434-MESSAGE CL188
|
|
02155 * MOVE R140-MESSAGE TO X434-MESSAGE CL120
|
|
02156 CL119
|
|
02157 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT. CL121
|
|
02158 WRITE REPT-PAID-REC FROM DETAIL-LINE-1 AFTER 1. CL120
|
|
02159 ADD 1 TO WS-LINE-CNT2. CL119
|
|
02160 ADD +1 TO WS-NUMBER-ONE. CL119
|
|
02161 CL119
|
|
02162 CL119
|
|
02163 P4000-EXIT. CL119
|
|
02164 EXIT. CL119
|
|
02165 P4100-PRINT-HEADER. CL121
|
|
02166 IF WS-LINE-CNT GREATER 58 OR CL121
|
|
02167 WS-LINE-CNT2 GREATER 58 CL121
|
|
02168 MOVE +0 TO WS-LINE-CNT CL121
|
|
02169 MOVE +0 TO WS-LINE-CNT2 CL121
|
|
02170 ADD +1 TO WS-PAGE-CNT CL121
|
|
02171 MOVE WS-PAGE-CNT TO HDR3-PAGE CL121
|
|
02172 * MOVE L001-SLASH-DATE TO HDR1-LRCM-SYS-DATE CL249
|
|
02173 MOVE '-/+ ----- MONTHLY COUNT' TO HDR5-NAME CL153
|
|
02174 WRITE REPT-PAID-REC FROM HEADER-1 AFTER TOP-OF-PAGE CL122
|
|
02175 WRITE REPT-PAID-REC FROM HEADER-2 AFTER 1 CL122
|
|
02176 WRITE REPT-PAID-REC FROM HEADER-3 AFTER 1 CL122
|
|
02177 WRITE REPT-PAID-REC FROM HEADER-4 AFTER 1 CL122
|
|
02178 WRITE REPT-PAID-REC FROM HEADER-42 AFTER 1 CL153
|
|
02179 WRITE REPT-PAID-REC FROM HEADER-5 AFTER 1 CL122
|
|
02180 WRITE REPT-PAID-REC FROM HEADER-6 AFTER 1 CL122
|
|
02181 ADD +6 TO WS-LINE-CNT2. CL121
|
|
02182 P4100-EXIT. CL121
|
|
02183 EXIT. CL121
|
|
02184 CL121
|
|
02185 P4200-PRINT-HEADER. CL133
|
|
02186 IF WSP-LINE-CNT GREATER 58 OR CL133
|
|
02187 WSP-LINE-CNT2 GREATER 58 CL133
|
|
02188 MOVE +0 TO WSP-LINE-CNT CL133
|
|
02189 MOVE +0 TO WSP-LINE-CNT2 CL133
|
|
02190 ADD +1 TO WSP-PAGE-CNT CL133
|
|
02191 MOVE WSP-PAGE-CNT TO HDR31-PAGE CL133
|
|
02192 MOVE ' * STATUS OF PAYMENTS *' TO HDR5-NAME CL196
|
|
02193 * MOVE L001-SLASH-DATE TO HDR1-LRCM-SYS-DATE CL249
|
|
02194 WRITE REPT-PEND-REC FROM HEADER-1 AFTER TOP-OF-PAGE CL133
|
|
02195 WRITE REPT-PEND-REC FROM HEADER-2 AFTER 1 CL133
|
|
02196 WRITE REPT-PEND-REC FROM HEADER-3 AFTER 1 CL224
|
|
02197 WRITE REPT-PEND-REC FROM HEADER-4 AFTER 1 CL133
|
|
02198 WRITE REPT-PEND-REC FROM HEADER-42 AFTER 1 CL144
|
|
02199 WRITE REPT-PEND-REC FROM HEADER-5 AFTER 1 CL133
|
|
02200 WRITE REPT-PEND-REC FROM HEADER-6 AFTER 1 CL133
|
|
02201 ADD +6 TO WSP-LINE-CNT2. CL133
|
|
02202 P4200-EXIT. CL133
|
|
02203 EXIT. CL133
|
|
02204 CL133
|
|
02205 DTSBX530
|
|
02206 P5000-NEW-EMP. DTSBX530
|
|
02207 *& DTSBX530
|
|
02208 DISPLAY ' 5000-NEW-EMP ' W-PREV-REC-TYPE CL*89
|
|
02209 ' ERROR-IND ' W-RPT-ERROR-IND CL*88
|
|
02210 * IF W-PREV-RPT-PAY-88 AND CL188
|
|
02211 * W-RPT-ERROR-NO-88 CL188
|
|
02212 * LX42-X140-EMP-NO = SPACES AND CL*85
|
|
02213 * LX42-X145-EMP-NO = SPACES CL*85
|
|
02214 * ADD +1 TO W-X145-PEN-CNT CL188
|
|
02215 * MOVE SPACES TO R140-MESSAGE CL188
|
|
02216 * MOVE W-EMP-NO TO R140-EMP-NO CL188
|
|
02217 * DISPLAY 'NO REPORT FOR PAYMENT ' W-EMP-NO ' ' W-PAY-QTR CL188
|
|
02218 * ' ' X145-REMITTANCE CL188
|
|
02219 * STRING CL188
|
|
02220 * ': NO REPORT FOR PAYMENT ' CL188
|
|
02221 * DELIMITED BY SIZE CL188
|
|
02222 * INTO R140-MESSAGE CL188
|
|
02223 * END-STRING CL188
|
|
02224 * MOVE R140-MESSAGE TO P434-MESSAGE CL188
|
|
02225 * PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT CL188
|
|
02226 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL188
|
|
02227 * WRITE PEND-X145-REC FROM X145-REC. CL188
|
|
02228 CL*82
|
|
02229 DISPLAY 'BX530 P5000-NEW-EMP-PAY ' W-EMP-NO ' ' LX42-EMP-NO. CL188
|
|
02230 DTSBX530
|
|
02231 MOVE LX42-EMP-NO TO W-EMP-NO. DTSBX530
|
|
02232 SET W-RPT-ERROR-NO-88 TO TRUE. CL*80
|
|
02233 * SET W-PREV-REC-NULL-88 TO TRUE. CL107
|
|
02234 SET W-PREV-RPT-NULL-88 TO TRUE. CL104
|
|
02235 SET X145-PAYMENT-DUP-NO-88 TO TRUE CL171
|
|
02236 MOVE ZERO TO W-X140-REPORT-QTR CL*56
|
|
02237 W-X145-PAYMENT-QTR CL*57
|
|
02238 W-X144-WAGE-QTR CL*56
|
|
02239 W-TOT-WAGE DTSBX530
|
|
02240 W-TAX-WAGE DTSBX530
|
|
02241 W-WRKR-TOT-WAGE DTSBX530
|
|
02242 W-X145-REMITTANCE CL*53
|
|
02243 W-X140-REMITTANCE CL*53
|
|
02244 W-X140-RECEIVED-DATE CL*72
|
|
02245 W-X145-DEPOSIT-DATE CL*72
|
|
02246 W-X145-RECEIVED-DATE CL*72
|
|
02247 W-1ST-MNTH-CNT DTSBX530
|
|
02248 W-2ND-MNTH-CNT DTSBX530
|
|
02249 W-3RD-MNTH-CNT DTSBX530
|
|
02250 W-SSN DTSBX530
|
|
02251 W-EARNINGS DTSBX530
|
|
02252 W-EMP-WAGE-CNT DTSBX530
|
|
02253 W-SEQ-NO CL*77
|
|
02254 W-T025-REMIT-AMT CL*76
|
|
02255 W-X145-TOT-REMIT-AMT CL*76
|
|
02256 W-X140-REMITTANCE CL*83
|
|
02257 LX42-X140-KEY-AREA CL*83
|
|
02258 LX42-X144-KEY-AREA CL*83
|
|
02259 LX42-X145-KEY-AREA. CL*83
|
|
02260 CL*76
|
|
02261 SET W-WRITE-T025-TRAN-NO-88 TO TRUE. CL*76
|
|
02262 CL*76
|
|
02263 DTSBX530
|
|
02264 MOVE SPACES TO W-WRKR-FIRST-NAME DTSBX530
|
|
02265 W-WRKR-LAST-NAME DTSBX530
|
|
02266 W-WRKR-MID-INIT CL*56
|
|
02267 W-X145-PAYMENT-FOUND-IND CL*79
|
|
02268 LX42-X140-EMP-NO CL*79
|
|
02269 LX42-X144-EMP-NO CL*82
|
|
02270 LX42-X145-EMP-NO CL*82
|
|
02271 LX42-X140-QTR-AREA CL*82
|
|
02272 LX42-X144-QTR-AREA CL*82
|
|
02273 P434-MESSAGE CL138
|
|
02274 LX42-X145-QTR-AREA. CL*82
|
|
02275 CL*53
|
|
02276 INITIALIZE X140-REC DTSBX530
|
|
02277 X144-REC CL*47
|
|
02278 WS-HOLD-X145-REC CL174
|
|
02279 X145-REC. CL173
|
|
02280 CL*48
|
|
02281 *& CL*88
|
|
02282 DISPLAY ' 5000-INI-EMP ' W-PREV-REC-TYPE CL*90
|
|
02283 ' W-RROR-IND ' W-RPT-ERROR-IND CL*88
|
|
02284 'LX-W-RROR-IND ' W-RPT-ERROR-IND. CL*90
|
|
02285 P5000-EXIT. CL*25
|
|
02286 EXIT. DTSBX530
|
|
02287 DTSBX530
|
|
02288 P6000-WRITE-PEND-X145. CL132
|
|
02289 * IF LX42-REC-TYPE-RPT-88 AND W-X145-PAYMENT-NO-88 CL132
|
|
02290 * WRITE PEND-X140-REC FROM X140-REC CL132
|
|
02291 * ELSE CL132
|
|
02292 * IF LX42-REC-TYPE-RPT-88 AND W-X145-PAYMENT-YES-88 CL132
|
|
02293 * WRITE PEND-X140-REC FROM X140-REC CL132
|
|
02294 * WRITE PEND-X145-REC FROM X145-REC CL132
|
|
02295 * ELSE CL132
|
|
02296 * IF LX42-REC-TYPE-WAGE-88 CL132
|
|
02297 * WRITE PEND-X144-REC FROM X144-REC CL132
|
|
02298 * ELSE CL132
|
|
02299 * IF LX42-REC-TYPE-PAY-88 CL132
|
|
02300 * WRITE PEND-X145-REC FROM X145-REC CL132
|
|
02301 * ELSE CL132
|
|
02302 * DISPLAY ' INVALID RECORD TYPE ' LX42-REC-TYPE CL132
|
|
02303 * PERFORM S999-ABEND THRU S999-EXIT. CL132
|
|
02304 CL133
|
|
02305 MOVE X145-REMITTANCE TO W-X145-REMITTANCE CL201
|
|
02306 MOVE X145-EMP-NO TO P434-EMP-NO CL133
|
|
02307 MOVE X145-QTR TO P434-QTR CL134
|
|
02308 IF W-EMP-FOUND-YES-88 CL190
|
|
02309 MOVE MPRF-PRIMARY-NAME (1:15) CL190
|
|
02310 TO P434-NAME-CHECK CL190
|
|
02311 ELSE CL190
|
|
02312 MOVE '***NOT IN DUTAS' TO P434-NAME-CHECK CL196
|
|
02313 END-IF. CL190
|
|
02314 CL191
|
|
02315 DISPLAY 'PAY TPE ' X145-PAY-TYPE CL196
|
|
02316 IF X145-PAY-ACH-88 CL191
|
|
02317 MOVE ' ACH ' TO P434-X145-TYPE CL212
|
|
02318 ELSE CL191
|
|
02319 IF X145-PAY-SCK-88 CL212
|
|
02320 MOVE ' SUP ' TO P434-X145-TYPE CL212
|
|
02321 ELSE CL212
|
|
02322 MOVE ' CHK ' TO P434-X145-TYPE. CL212
|
|
02323 CL197
|
|
02324 MOVE SPACES TO P434-TRACE-NO W-TRACE-NO CL206
|
|
02325 MOVE X145-TRACE-NO TO W-TRACE-NO CL206
|
|
02326 MOVE W-TRACE-NOB TO P434-TRACE-NO CL206
|
|
02327 CL133
|
|
02328 MOVE X145-RCVD-DATE TO P434-RCVD-DATE CL133
|
|
02329 MOVE X145-REMITTANCE TO P434-X145-REMIT CL198
|
|
02330 * MOVE X145-REMITTANCE TO W-X145-REMIT CL220
|
|
02331 CL133
|
|
02332 IF W-RPT-ERROR-NO-88 CL189
|
|
02333 MOVE '-X530 - PASSED TO DUTAS ' TO P434-MESSAGE CL206
|
|
02334 ELSE CL188
|
|
02335 MOVE '*X530 - **ERROR SENT TO PENDING ' TO P434-MESSAGE. CL206
|
|
02336 CL133
|
|
02337 PERFORM P4200-PRINT-HEADER THRU P4200-EXIT. CL133
|
|
02338 WRITE REPT-PEND-REC FROM DETAIL-PEND-1 AFTER 1. CL133
|
|
02339 ADD 1 TO WS-LINE-CNT2. CL133
|
|
02340 ADD +1 TO WS-NUMBER-ONE. CL133
|
|
02341 GO TO P6000-EXIT. CL133
|
|
02342 CL132
|
|
02343 P6000-WRITE-PEND-X140. CL132
|
|
02344 CL132
|
|
02345 MOVE X140-EMP-NO TO P434-EMP-NO CL132
|
|
02346 MOVE X140-QUARTER TO P434-QTR CL132
|
|
02347 * IF W-EMP-FOUND-YES-88 CL135
|
|
02348 * MOVE MPRF-PRIMARY-NAME (1:15) CL135
|
|
02349 * TO P434-NAME-CHECK CL135
|
|
02350 * ELSE CL135
|
|
02351 MOVE 'RPT' TO P434-NAME-CHECK CL135
|
|
02352 * END-IF. CL135
|
|
02353 CL132
|
|
02354 MOVE X140-RCVD-DATE TO P434-RCVD-DATE CL132
|
|
02355 * MOVE X140-TOTAL-WAGES TO P434-TOT-WAGE CL192
|
|
02356 * MOVE ZEROS TO P434-EXC-WAGE CL192
|
|
02357 * MOVE T028-EXCESS-WAGE TO P434-EXC-WAGE CL141
|
|
02358 * MOVE X140-TAX-WAGES TO P434-TAX-WAGE CL192
|
|
02359 * MOVE X140-REMITTANCE TO P434-X140-REMIT CL192
|
|
02360 MOVE ZEROS TO P434-X145-REMIT CL138
|
|
02361 CL132
|
|
02362 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. CL132
|
|
02363 * MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. CL132
|
|
02364 * MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. CL132
|
|
02365 * MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. CL132
|
|
02366 CL132
|
|
02367 * IF W-ERROR-NO-88 CL132
|
|
02368 * MOVE 'PROCESSED' TO X434-DISPOSITION CL132
|
|
02369 * ELSE CL132
|
|
02370 * MOVE 'PENDING ' TO X434-DISPOSITION. CL132
|
|
02371 * MOVE R140-MESSAGE TO P434-MESSAGE CL137
|
|
02372 CL132
|
|
02373 PERFORM P4200-PRINT-HEADER THRU P4200-EXIT. CL133
|
|
02374 WRITE REPT-PEND-REC FROM DETAIL-PEND-1 AFTER 1. CL132
|
|
02375 ADD 1 TO WS-LINE-CNT2. CL132
|
|
02376 ADD +1 TO WS-NUMBER-ONE. CL132
|
|
02377 GO TO P6000-EXIT. CL144
|
|
02378 CL132
|
|
02379 P6000-WRITE-PEND-X144. CL144
|
|
02380 CL144
|
|
02381 MOVE X140-EMP-NO TO P434-EMP-NO CL144
|
|
02382 MOVE X140-QUARTER TO P434-QTR CL144
|
|
02383 * IF W-EMP-FOUND-YES-88 CL144
|
|
02384 * MOVE MPRF-PRIMARY-NAME (1:15) CL144
|
|
02385 * TO P434-NAME-CHECK CL144
|
|
02386 * ELSE CL144
|
|
02387 MOVE 'WAGE' TO P434-NAME-CHECK CL144
|
|
02388 * END-IF. CL144
|
|
02389 CL144
|
|
02390 MOVE SPACES TO P434-RCVD-DATE CL144
|
|
02391 * MOVE ZEROS TO P434-TOT-WAGE CL192
|
|
02392 * MOVE ZEROS TO P434-EXC-WAGE CL192
|
|
02393 * MOVE T028-EXCESS-WAGE TO P434-EXC-WAGE CL144
|
|
02394 * MOVE ZEROS TO P434-TAX-WAGE CL192
|
|
02395 * MOVE ZEROS TO P434-X140-REMIT CL192
|
|
02396 MOVE ZEROS TO P434-X145-REMIT CL144
|
|
02397 CL144
|
|
02398 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. CL144
|
|
02399 * MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. CL144
|
|
02400 * MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. CL144
|
|
02401 * MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. CL144
|
|
02402 CL144
|
|
02403 * IF W-ERROR-NO-88 CL144
|
|
02404 * MOVE 'PROCESSED' TO X434-DISPOSITION CL144
|
|
02405 * ELSE CL144
|
|
02406 * MOVE 'PENDING ' TO X434-DISPOSITION. CL144
|
|
02407 * MOVE R140-MESSAGE TO P434-MESSAGE CL144
|
|
02408 CL144
|
|
02409 PERFORM P4200-PRINT-HEADER THRU P4200-EXIT. CL144
|
|
02410 WRITE REPT-PEND-REC FROM DETAIL-PEND-1 AFTER 1. CL144
|
|
02411 ADD 1 TO WS-LINE-CNT2. CL144
|
|
02412 ADD +1 TO WS-NUMBER-ONE. CL144
|
|
02413 CL144
|
|
02414 CL144
|
|
02415 CL*59
|
|
02416 P6000-EXIT. CL*59
|
|
02417 EXIT. CL*59
|
|
02418 CL*59
|
|
02419 DTSBX530
|
|
02420 P7000-COUNT-X145. CL215
|
|
02421 CL215
|
|
02422 IF W-PAY-ACH-88 CL220
|
|
02423 ADD +1 TO W-A145-ERR-CNT CL215
|
|
02424 ELSE CL215
|
|
02425 IF W-PAY-CHK-88 CL220
|
|
02426 ADD +1 TO W-C145-ERR-CNT CL215
|
|
02427 ELSE CL215
|
|
02428 IF W-PAY-SCK-88 CL221
|
|
02429 ADD +1 TO W-S145-ERR-CNT CL215
|
|
02430 ELSE CL215
|
|
02431 DISPLAY ' ****** ERROR UNKNOW PAY TYPE ' X145-EMP-NO. CL215
|
|
02432 CL215
|
|
02433 P7000-EXIT. CL215
|
|
02434 EXIT. CL215
|
|
02435 CL215
|
|
02436 T0000-TERMINATE. DTSBX530
|
|
02437 IF WS-LINE-CNT2 > 52 OR WS-NUMBER-ONE = ZERO CL121
|
|
02438 PERFORM P4200-PRINT-HEADER THRU P4200-EXIT CL194
|
|
02439 END-IF. CL121
|
|
02440 MOVE W-X145-RED-CNT TO WS-FOOTING-CNT. CL128
|
|
02441 MOVE W-X145-ERR-CNT TO WS-X145-ERR-CNT. CL121
|
|
02442 MOVE W-X145-PEN-CNT TO WS-X145-PEN-CNT. CL121
|
|
02443 MOVE W-A145-RED-CNT TO WS-A145-RED-CNT. CL213
|
|
02444 MOVE W-A145-ERR-CNT TO WS-A145-ERR-CNT. CL213
|
|
02445 MOVE W-A145-SAV-CNT TO WS-A145-SAV-CNT. CL217
|
|
02446 MOVE W-C145-RED-CNT TO WS-C145-RED-CNT. CL213
|
|
02447 MOVE W-C145-ERR-CNT TO WS-C145-ERR-CNT. CL213
|
|
02448 MOVE W-C145-SAV-CNT TO WS-C145-SAV-CNT. CL217
|
|
02449 MOVE W-S145-RED-CNT TO WS-S145-RED-CNT. CL215
|
|
02450 MOVE W-S145-ERR-CNT TO WS-S145-ERR-CNT. CL215
|
|
02451 MOVE W-S145-SAV-CNT TO WS-S145-SAV-CNT. CL217
|
|
02452 MOVE W-S145-TOT-AMT TO WS-S145-TOT-AMT. CL217
|
|
02453 MOVE W-A145-TOT-AMT TO WS-A145-TOT-AMT. CL217
|
|
02454 MOVE W-C145-TOT-AMT TO WS-C145-TOT-AMT. CL217
|
|
02455 MOVE W-TOT-REMIT-AMT TO WS-TOT-REMIT. CL121
|
|
02456 WRITE REPT-PEND-REC FROM FOOTING-LINE-1 AFTER 1. CL194
|
|
02457 WRITE REPT-PEND-REC FROM FOOTING-LINE-2 AFTER 1. CL194
|
|
02458 WRITE REPT-PEND-REC FROM FOOTING-LINE-6 AFTER 1. CL222
|
|
02459 WRITE REPT-PEND-REC FROM FOOTING-LINE-7 AFTER 1. CL222
|
|
02460 WRITE REPT-PEND-REC FROM FOOTING-LINE-8 AFTER 1. CL222
|
|
02461 WRITE REPT-PEND-REC FROM FOOTING-LINE-1 AFTER 1. CL222
|
|
02462 WRITE REPT-PEND-REC FROM FOOTING-LINE-9 AFTER 1. CL194
|
|
02463 WRITE REPT-PEND-REC FROM FOOTING-LINE-10 AFTER 1. CL194
|
|
02464 WRITE REPT-PEND-REC FROM FOOTING-LINE-11 AFTER 1. CL194
|
|
02465 WRITE REPT-PEND-REC FROM FOOTING-LINE-1 AFTER 1. CL222
|
|
02466 WRITE REPT-PEND-REC FROM FOOTING-LINE-12 AFTER 1. CL194
|
|
02467 WRITE REPT-PEND-REC FROM FOOTING-LINE-13 AFTER 1. CL194
|
|
02468 WRITE REPT-PEND-REC FROM FOOTING-LINE-14 AFTER 1. CL194
|
|
02469 WRITE REPT-PEND-REC FROM FOOTING-LINE-1 AFTER 1. CL222
|
|
02470 WRITE REPT-PEND-REC FROM FOOTING-LINE-3 AFTER 1. CL222
|
|
02471 WRITE REPT-PEND-REC FROM FOOTING-LINE-4 AFTER 1. CL222
|
|
02472 WRITE REPT-PEND-REC FROM FOOTING-LINE-5 AFTER 1. CL222
|
|
02473 WRITE REPT-PEND-REC FROM FOOTING-LINE-1 AFTER 1. CL222
|
|
02474 WRITE REPT-PEND-REC FROM FOOTING-LINE-14-2 BEFORE 1. CL224
|
|
02475 WRITE REPT-PEND-REC FROM FOOTING-LINE-1 AFTER 1. CL224
|
|
02476 WRITE REPT-PEND-REC FROM FOOTING-LINE-15 AFTER 1. CL222
|
|
02477 WRITE REPT-PEND-REC FROM FOOTING-LINE-1 AFTER 1. CL222
|
|
02478 WRITE REPT-PEND-REC FROM FOOTING-LINE-1 AFTER 1. CL222
|
|
02479 WRITE REPT-PEND-REC FROM FOOTING-LINE-16 AFTER 1. CL222
|
|
02480 DISPLAY ' '. DTSBX530
|
|
02481 DTSBX530
|
|
02482 DTSBX530
|
|
02483 DISPLAY ' '. DTSBX530
|
|
02484 DISPLAY '***************************************'. CL*47
|
|
02485 DISPLAY '*** DTSBX530 TERMINATION STATISTICS ***'. CL188
|
|
02486 DISPLAY '*** ***ESSP-TDEC PAYMENTS SUMMARY *****'. CL188
|
|
02487 DISPLAY '***************************************'. CL*47
|
|
02488 DISPLAY ' '. DTSBX530
|
|
02489 DTSBX530
|
|
02490 PERFORM T2000-DISPLAY-TOTALS THRU T2000-EXIT. DTSBX530
|
|
02491 DTSBX530
|
|
02492 DISPLAY '***************************************'. DTSBX530
|
|
02493 DTSBX530
|
|
02494 CLOSE WAGE-FILE-OUT CL*20
|
|
02495 PEND-X140-FILE CL*59
|
|
02496 PEND-X144-FILE CL*59
|
|
02497 X530-PAID-FILE CL233
|
|
02498 X530-PEND-FILE CL233
|
|
02499 PEND-X145-FILE CL120
|
|
02500 TEMP-BTC-FILE CL*59
|
|
02501 BATCH-XREF-FILE. CL*26
|
|
02502 T0000-EXIT. DTSBX530
|
|
02503 EXIT. DTSBX530
|
|
02504 DTSBX530
|
|
02505 DTSBX530
|
|
02506 T2000-DISPLAY-TOTALS. DTSBX530
|
|
02507 DISPLAY ' '. CL*92
|
|
02508 DISPLAY '*X530 ESSP/TDEC CHECK AND ACH PAYMENTS **'. CL188
|
|
02509 DISPLAY ' '. CL186
|
|
02510 DISPLAY 'TOTAL X145-PAYMENTS RECORDS READ.......: ' CL*96
|
|
02511 W-X145-RED-CNT. CL*92
|
|
02512 CL*92
|
|
02513 DISPLAY ' NO OF X145-PAYMENTS PASSED ALL EDITS...: ' CL*98
|
|
02514 W-X145-SAV-CNT. CL*92
|
|
02515 CL*92
|
|
02516 DISPLAY ' NO OF X145-PAYMENTS T025 TRANS WRITTEN.: ' CL*96
|
|
02517 W-T025-WRITE-CNT. CL*94
|
|
02518 CL*94
|
|
02519 DISPLAY ' NO OF X145-PAYMENTS WITH ZERO REMIT....: ' CL188
|
|
02520 W-T025-WRITEO-CNT. CL100
|
|
02521 CL100
|
|
02522 DISPLAY ' NO OF X145-PAYMENTS WRITTEN TO PENDING.: ' CL*96
|
|
02523 W-X145-PEN-CNT. CL*92
|
|
02524 DISPLAY ' NO OF X145-PAYMENTS HAD ERRORS.........: ' CL188
|
|
02525 W-X145-ERR-CNT. CL*92
|
|
02526 * DISPLAY ' NO OF X145-PAYMENTS HAS DUPLICATE......: ' CL188
|
|
02527 * W-X145-DUP-CNT. CL188
|
|
02528 CL*92
|
|
02529 CL*10
|
|
02530 DISPLAY ' '. DTSBX530
|
|
02531 DISPLAY '***** END X530 ESSP/TDEC PAYMENTS **** '. CL188
|
|
02532 DTSBX530
|
|
02533 T2000-EXIT. DTSBX530
|
|
02534 EXIT. DTSBX530
|
|
02535 DTSBX530
|
|
02536 S001-FROM-FED-8. DTSBX530
|
|
02537 SET L001-FROM-FED-8 TO TRUE. DTSBX530
|
|
02538 GO TO S001-DATE. DTSBX530
|
|
02539 DTSBX530
|
|
02540 S001-FROM-CAL-8. DTSBX530
|
|
02541 SET L001-FROM-CAL-8 TO TRUE. DTSBX530
|
|
02542 GO TO S001-DATE. DTSBX530
|
|
02543 DTSBX530
|
|
02544 S001-FROM-ABS-DAY. DTSBX530
|
|
02545 SET L001-FROM-ABS-DAY TO TRUE. DTSBX530
|
|
02546 GO TO S001-DATE. DTSBX530
|
|
02547 DTSBX530
|
|
02548 S001-DATE. DTSBX530
|
|
02549 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX530
|
|
02550 S001-EXIT. DTSBX530
|
|
02551 EXIT. DTSBX530
|
|
02552 DTSBX530
|
|
02553 S003-AGENCY-DAY. DTSBX530
|
|
02554 SET L003-AGENCY-DAY TO TRUE. DTSBX530
|
|
02555 GO TO S003-WORK-DAY. DTSBX530
|
|
02556 DTSBX530
|
|
02557 S003-WORK-DAY. DTSBX530
|
|
02558 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBX530
|
|
02559 S003-EXIT. DTSBX530
|
|
02560 EXIT. DTSBX530
|
|
02561 DTSBX530
|
|
02562 S004-FROM-5. DTSBX530
|
|
02563 SET L004-FROM-5 TO TRUE. DTSBX530
|
|
02564 GO TO S004-YRQ. DTSBX530
|
|
02565 DTSBX530
|
|
02566 S004-FROM-DATE. DTSBX530
|
|
02567 SET L004-FROM-DATE TO TRUE. DTSBX530
|
|
02568 GO TO S004-YRQ. DTSBX530
|
|
02569 DTSBX530
|
|
02570 S004-FROM-ABS. DTSBX530
|
|
02571 SET L004-FROM-ABS TO TRUE. DTSBX530
|
|
02572 GO TO S004-YRQ. DTSBX530
|
|
02573 DTSBX530
|
|
02574 S004-YRQ. DTSBX530
|
|
02575 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX530
|
|
02576 DTSBX530
|
|
02577 S004-EXIT. DTSBX530
|
|
02578 EXIT. DTSBX530
|
|
02579 DTSBX530
|
|
02580 S516-LIABILITY-INFO. DTSBX530
|
|
02581 CALL 'DTSBU516' USING L516-LINK-AREA DTSBX530
|
|
02582 MPRF-REC. DTSBX530
|
|
02583 S516-EXIT. DTSBX530
|
|
02584 EXIT. DTSBX530
|
|
02585 DTSBX530
|
|
02586 S910-OPEN-READ. DTSBX530
|
|
02587 SET L910-OPEN-READ-88 TO TRUE. DTSBX530
|
|
02588 GO TO S910-MSTR-IO. DTSBX530
|
|
02589 DTSBX530
|
|
02590 S910-READ. DTSBX530
|
|
02591 SET L910-READ-88 TO TRUE. DTSBX530
|
|
02592 GO TO S910-MSTR-IO. DTSBX530
|
|
02593 DTSBX530
|
|
02594 S910-START-BROWSE. DTSBX530
|
|
02595 SET L910-START-BROWSE-88 TO TRUE. DTSBX530
|
|
02596 GO TO S910-MSTR-IO. DTSBX530
|
|
02597 DTSBX530
|
|
02598 S910-READ-NEXT. DTSBX530
|
|
02599 SET L910-READ-NEXT-88 TO TRUE. DTSBX530
|
|
02600 GO TO S910-MSTR-IO. DTSBX530
|
|
02601 DTSBX530
|
|
02602 S910-CLOSE. DTSBX530
|
|
02603 SET L910-CLOSE-88 TO TRUE. DTSBX530
|
|
02604 GO TO S910-MSTR-IO. DTSBX530
|
|
02605 DTSBX530
|
|
02606 S910-MSTR-IO. DTSBX530
|
|
02607 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX530
|
|
02608 MSKL-REC. DTSBX530
|
|
02609 S910-EXIT. DTSBX530
|
|
02610 EXIT. DTSBX530
|
|
02611 DTSBX530
|
|
02612 S921-OPEN-READ. DTSBX530
|
|
02613 SET L921-OPEN-READ-88 TO TRUE. DTSBX530
|
|
02614 GO TO S921-AIX-IO. DTSBX530
|
|
02615 DTSBX530
|
|
02616 S921-READ. DTSBX530
|
|
02617 SET L921-READ-88 TO TRUE. DTSBX530
|
|
02618 GO TO S921-AIX-IO. DTSBX530
|
|
02619 DTSBX530
|
|
02620 S921-START-BROWSE. DTSBX530
|
|
02621 SET L921-START-BROWSE-88 TO TRUE. DTSBX530
|
|
02622 GO TO S921-AIX-IO. DTSBX530
|
|
02623 DTSBX530
|
|
02624 S921-READ-NEXT. DTSBX530
|
|
02625 SET L921-READ-NEXT-88 TO TRUE. DTSBX530
|
|
02626 GO TO S921-AIX-IO. DTSBX530
|
|
02627 DTSBX530
|
|
02628 S921-CLOSE. DTSBX530
|
|
02629 SET L921-CLOSE-88 TO TRUE. DTSBX530
|
|
02630 GO TO S921-AIX-IO. DTSBX530
|
|
02631 DTSBX530
|
|
02632 S921-AIX-IO. DTSBX530
|
|
02633 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX530
|
|
02634 ISKL-REC. DTSBX530
|
|
02635 S921-EXIT. DTSBX530
|
|
02636 EXIT. DTSBX530
|
|
02637 DTSBX530
|
|
02638 S923-OPEN-UPDATE. DTSBX530
|
|
02639 SET L923-OPEN-UPDATE-88 TO TRUE. DTSBX530
|
|
02640 GO TO S923-ATC-CALL. DTSBX530
|
|
02641 DTSBX530
|
|
02642 S923-WRITE. DTSBX530
|
|
02643 SET L923-WRITE-88 TO TRUE. DTSBX530
|
|
02644 GO TO S923-ATC-CALL. DTSBX530
|
|
02645 DTSBX530
|
|
02646 S923-CLOSE. DTSBX530
|
|
02647 SET L923-CLOSE-88 TO TRUE. DTSBX530
|
|
02648 GO TO S923-ATC-CALL. DTSBX530
|
|
02649 DTSBX530
|
|
02650 S923-ATC-CALL. DTSBX530
|
|
02651 CALL 'DTSBU923' USING L923-LINK-AREA DTSBX530
|
|
02652 ASKL-REC. DTSBX530
|
|
02653 S923-EXIT. DTSBX530
|
|
02654 EXIT. DTSBX530
|
|
02655 DTSBX530
|
|
02656 *S927A-OPEN. DTSBX530
|
|
02657 * SET L927-OPEN-UPDATE-88 TO TRUE. DTSBX530
|
|
02658 * PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX530
|
|
02659 * DTSBX530
|
|
02660 *S927A-EXIT. DTSBX530
|
|
02661 * EXIT. DTSBX530
|
|
02662 DTSBX530
|
|
02663 S927B-WRITE. DTSBX530
|
|
02664 SET L927-WRITE-88 TO TRUE. DTSBX530
|
|
02665 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX530
|
|
02666 DTSBX530
|
|
02667 S927B-EXIT. DTSBX530
|
|
02668 EXIT. DTSBX530
|
|
02669 DTSBX530
|
|
02670 *S927C-CLOSE. DTSBX530
|
|
02671 * SET L927-CLOSE-88 TO TRUE. DTSBX530
|
|
02672 * PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX530
|
|
02673 * DTSBX530
|
|
02674 *S927C-EXIT. DTSBX530
|
|
02675 * EXIT. DTSBX530
|
|
02676 DTSBX530
|
|
02677 S927Z-IO. DTSBX530
|
|
02678 CALL 'DTSBU927' USING L927-LINK-AREA DTSBX530
|
|
02679 TSKL-REC. DTSBX530
|
|
02680 S927Z-EXIT. DTSBX530
|
|
02681 EXIT. DTSBX530
|
|
02682 DTSBX530
|
|
02683 S931-OPEN-READ. DTSBX530
|
|
02684 SET L931-OPEN-READ-88 TO TRUE. DTSBX530
|
|
02685 GO TO S931-REF-IO. DTSBX530
|
|
02686 DTSBX530
|
|
02687 S931-CLOSE. DTSBX530
|
|
02688 SET L931-CLOSE-88 TO TRUE. DTSBX530
|
|
02689 GO TO S931-REF-IO. DTSBX530
|
|
02690 DTSBX530
|
|
02691 S931-REF-IO. DTSBX530
|
|
02692 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX530
|
|
02693 FSKL-REC. DTSBX530
|
|
02694 S931-EXIT. DTSBX530
|
|
02695 EXIT. DTSBX530
|
|
02696 DTSBX530
|
|
02697 S1032-WRITE-TEMP-T028. DTSBX530
|
|
02698 MOVE T028-LENGTH TO VAR-CHAR-CNT. DTSBX530
|
|
02699 MOVE T028-REC TO TEMP-BTC-REC. DTSBX530
|
|
02700 WRITE TEMP-BTC-REC. DTSBX530
|
|
02701 IF TEMP-BTC-STATUS-OK-88 DTSBX530
|
|
02702 NEXT SENTENCE DTSBX530
|
|
02703 ELSE DTSBX530
|
|
02704 SET W-RPT-ERROR-YES-88 TO TRUE CL*81
|
|
02705 DISPLAY 'CANNOT WRITE TEMP T028: ' DTSBX530
|
|
02706 TEMP-BTC-STATUS DTSBX530
|
|
02707 END-IF. DTSBX530
|
|
02708 DTSBX530
|
|
02709 S1032-EXIT. CL**9
|
|
02710 EXIT. DTSBX530
|
|
02711 DTSBX530
|
|
02712 S1033-WRITE-TEMP-T025. DTSBX530
|
|
02713 MOVE T025-LENGTH TO VAR-CHAR-CNT. DTSBX530
|
|
02714 MOVE T025-REC TO TEMP-BTC-REC. DTSBX530
|
|
02715 WRITE TEMP-BTC-REC. DTSBX530
|
|
02716 IF TEMP-BTC-STATUS-OK-88 DTSBX530
|
|
02717 NEXT SENTENCE DTSBX530
|
|
02718 ELSE DTSBX530
|
|
02719 SET W-RPT-ERROR-YES-88 TO TRUE CL*81
|
|
02720 DISPLAY 'CANNOT WRITE BTC X530: ' CL186
|
|
02721 TEMP-BTC-STATUS DTSBX530
|
|
02722 END-IF. DTSBX530
|
|
02723 DTSBX530
|
|
02724 S1033-EXIT. DTSBX530
|
|
02725 EXIT. DTSBX530
|
|
02726 DTSBX530
|
|
02727 S1040-OPEN-TEMP-BTC-OUT. DTSBX530
|
|
02728 OPEN OUTPUT TEMP-BTC-FILE. DTSBX530
|
|
02729 IF TEMP-BTC-STATUS-OK-88 DTSBX530
|
|
02730 NEXT SENTENCE DTSBX530
|
|
02731 *** SET WAGE-TEMP-OPEN-88 TO TRUE DTSBX530
|
|
02732 *** DISPLAY 'TEMP BTC OPENED OUTPUT ' DTSBX530
|
|
02733 ELSE DTSBX530
|
|
02734 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX530
|
|
02735 DISPLAY 'CANNOT OPEN X530 BTC FILE OUTPUT: ' CL186
|
|
02736 TEMP-BTC-STATUS DTSBX530
|
|
02737 END-IF. DTSBX530
|
|
02738 DTSBX530
|
|
02739 S1040-EXIT. DTSBX530
|
|
02740 EXIT. DTSBX530
|
|
02741 DTSBX530
|
|
02742 S1050-OPEN-TEMP-BTC-IN. DTSBX530
|
|
02743 OPEN INPUT TEMP-BTC-FILE. DTSBX530
|
|
02744 IF TEMP-BTC-STATUS-OK-88 DTSBX530
|
|
02745 NEXT SENTENCE DTSBX530
|
|
02746 *** SET WAGE-TEMP-OPEN-88 TO TRUE DTSBX530
|
|
02747 *** DISPLAY 'TEMP BTC OPENED INP ' DTSBX530
|
|
02748 ELSE DTSBX530
|
|
02749 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX530
|
|
02750 DISPLAY 'CANNOT OPEN TEMP BTC FILE INPUT: ' DTSBX530
|
|
02751 TEMP-BTC-STATUS DTSBX530
|
|
02752 END-IF. DTSBX530
|
|
02753 DTSBX530
|
|
02754 S1050-EXIT. DTSBX530
|
|
02755 EXIT. DTSBX530
|
|
02756 DTSBX530
|
|
02757 S1060-CLOSE-TEMP-BTC. DTSBX530
|
|
02758 CLOSE TEMP-BTC-FILE. DTSBX530
|
|
02759 IF TEMP-BTC-STATUS-OK-88 DTSBX530
|
|
02760 *** DISPLAY 'TEMP-BTC CLOSED' DTSBX530
|
|
02761 NEXT SENTENCE DTSBX530
|
|
02762 ELSE DTSBX530
|
|
02763 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX530
|
|
02764 DISPLAY 'CANNOT CLOSE TEMP BTC FILE: ' DTSBX530
|
|
02765 TEMP-BTC-STATUS DTSBX530
|
|
02766 END-IF. DTSBX530
|
|
02767 DTSBX530
|
|
02768 S1060-EXIT. DTSBX530
|
|
02769 EXIT. DTSBX530
|
|
02770 DTSBX530
|
|
02771 S1070-READ-TEMP-BTC. DTSBX530
|
|
02772 READ TEMP-BTC-FILE. DTSBX530
|
|
02773 IF TEMP-BTC-STATUS-OK-88 DTSBX530
|
|
02774 COMPUTE VAR-CHAR-CNT = (RVAR-LENGTH - 2) DTSBX530
|
|
02775 ELSE DTSBX530
|
|
02776 IF TEMP-BTC-STATUS-EOF-88 DTSBX530
|
|
02777 NEXT SENTENCE DTSBX530
|
|
02778 ELSE DTSBX530
|
|
02779 DISPLAY 'CANNOT READ TEMP-BTC FILE ' DTSBX530
|
|
02780 TEMP-BTC-STATUS DTSBX530
|
|
02781 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX530
|
|
02782 END-IF DTSBX530
|
|
02783 END-IF. DTSBX530
|
|
02784 DTSBX530
|
|
02785 S1070-EXIT. DTSBX530
|
|
02786 EXIT. DTSBX530
|
|
02787 DTSBX530
|
|
02788 S1100-OPEN-WAGE-TEMP-OUT. DTSBX530
|
|
02789 OPEN OUTPUT WAGE-FILE-TEMP. DTSBX530
|
|
02790 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX530
|
|
02791 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX530
|
|
02792 DISPLAY 'CANNOT OPEN WAGE TEMP FILE OUTPUT: ' DTSBX530
|
|
02793 WAGE-TEMP-STATUS DTSBX530
|
|
02794 END-IF. DTSBX530
|
|
02795 DTSBX530
|
|
02796 S1100-EXIT. DTSBX530
|
|
02797 EXIT. DTSBX530
|
|
02798 DTSBX530
|
|
02799 S1110-CLOSE-WAGE-TEMP. DTSBX530
|
|
02800 CLOSE WAGE-FILE-TEMP. DTSBX530
|
|
02801 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX530
|
|
02802 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX530
|
|
02803 DISPLAY 'CANNOT CLOSE WAGE TEMP FILE: ' DTSBX530
|
|
02804 WAGE-TEMP-STATUS DTSBX530
|
|
02805 END-IF. DTSBX530
|
|
02806 DTSBX530
|
|
02807 S1110-EXIT. DTSBX530
|
|
02808 EXIT. DTSBX530
|
|
02809 DTSBX530
|
|
02810 S1120-WRITE-WAGE-TEMP. DTSBX530
|
|
02811 WRITE WAGE-TEMP-REC FROM W001-REC. DTSBX530
|
|
02812 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX530
|
|
02813 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX530
|
|
02814 DISPLAY 'CANNOT WRITE WAGE TEMP FILE: ' DTSBX530
|
|
02815 WAGE-TEMP-STATUS DTSBX530
|
|
02816 END-IF. DTSBX530
|
|
02817 DTSBX530
|
|
02818 S1120-EXIT. DTSBX530
|
|
02819 EXIT. DTSBX530
|
|
02820 DTSBX530
|
|
02821 S1130-OPEN-WAGE-TEMP-IN. DTSBX530
|
|
02822 OPEN INPUT WAGE-FILE-TEMP. DTSBX530
|
|
02823 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX530
|
|
02824 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX530
|
|
02825 DISPLAY 'CANNOT OPEN WAGE TEMP FILE INPUT: ' DTSBX530
|
|
02826 WAGE-TEMP-STATUS DTSBX530
|
|
02827 END-IF. DTSBX530
|
|
02828 DTSBX530
|
|
02829 S1130-EXIT. DTSBX530
|
|
02830 EXIT. DTSBX530
|
|
02831 DTSBX530
|
|
02832 S1140-READ-WAGE-TEMP. DTSBX530
|
|
02833 READ WAGE-FILE-TEMP INTO W001-REC. DTSBX530
|
|
02834 IF WAGE-TEMP-STATUS-EOF-88 DTSBX530
|
|
02835 NEXT SENTENCE DTSBX530
|
|
02836 ELSE DTSBX530
|
|
02837 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX530
|
|
02838 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX530
|
|
02839 DISPLAY 'READ ERROR ON WAGE TEMP FILE: ' DTSBX530
|
|
02840 WAGE-TEMP-STATUS DTSBX530
|
|
02841 END-IF DTSBX530
|
|
02842 END-IF. DTSBX530
|
|
02843 DTSBX530
|
|
02844 S1140-EXIT. DTSBX530
|
|
02845 EXIT. DTSBX530
|
|
02846 DTSBX530
|
|
02847 S1150-OPEN-WAGE-FILE-OUT. CL*20
|
|
02848 OPEN OUTPUT WAGE-FILE-OUT. CL*20
|
|
02849 IF NOT WAGE-OUT-STATUS-OK-88 CL*20
|
|
02850 SET W-FATAL-ERROR-YES-88 TO TRUE CL*20
|
|
02851 DISPLAY 'CANNOT OPEN WAGE FILE OUTPUT: ' CL*20
|
|
02852 WAGE-OUT-STATUS CL*20
|
|
02853 END-IF. CL*20
|
|
02854 DTSBX530
|
|
02855 S1150-EXIT. CL*20
|
|
02856 EXIT. CL*20
|
|
02857 DTSBX530
|
|
02858 S1160-CLOSE-WAGE-OUT. CL*20
|
|
02859 CLOSE WAGE-FILE-OUT. CL*20
|
|
02860 IF NOT WAGE-OUT-STATUS-OK-88 CL*20
|
|
02861 SET W-FATAL-ERROR-YES-88 TO TRUE CL*20
|
|
02862 DISPLAY 'CANNOT CLOSE WAGE FILE: ' CL*20
|
|
02863 WAGE-OUT-STATUS CL*20
|
|
02864 END-IF. CL*20
|
|
02865 DTSBX530
|
|
02866 S1160-EXIT. CL*20
|
|
02867 EXIT. CL*20
|
|
02868 DTSBX530
|
|
02869 S1170-WRITE-WAGE-OUT. CL*20
|
|
02870 MOVE ESP-TRANSACTION-AREA TO WAGE-OUT-REC. CL*20
|
|
02871 WRITE WAGE-OUT-REC. CL*20
|
|
02872 IF NOT WAGE-OUT-STATUS-OK-88 CL*20
|
|
02873 SET W-FATAL-ERROR-YES-88 TO TRUE CL*20
|
|
02874 DISPLAY 'CANNOT WRITE WAGE OUT FILE: ' CL*20
|
|
02875 WAGE-OUT-STATUS CL*20
|
|
02876 END-IF. CL*20
|
|
02877 DTSBX530
|
|
02878 S1170-EXIT. CL*20
|
|
02879 EXIT. CL*20
|
|
02880 DTSBX530
|
|
02881 S946-WRITE-R140. DTSBX530
|
|
02882 CALL 'DTSBU946' USING R140-REC. DTSBX530
|
|
02883 DTSBX530
|
|
02884 S946-EXIT. DTSBX530
|
|
02885 EXIT. DTSBX530
|
|
02886 DTSBX530
|
|
02887 S999-ABEND. DTSBX530
|
|
02888 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX530
|
|
02889 S999-EXIT. DTSBX530
|
|
02890 EXIT. DTSBX530
|
|
02891 DTSBX530
|