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