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