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