00001 IDENTIFICATION DIVISION. 12/05/16 00002 PROGRAM-ID. DTSZX550. DTSZX550 00003 AUTHOR. NGC. LV095 00004 DATE-WRITTEN. APRIL 2005. DTSZX550 00005 DATE-COMPILED. DTSZX550 00006 SKIP3 DTSZX550 00007 ***** DTSZX550 00008 * DTSZX550 00009 * FUNCTION: AMENDED REPORTS IMPORT DRIVER CL*95 00010 * READ DATA PASSED FROM WEB APPLICATION SERVER DTSZX550 00011 * AND CALL THE APPROPRIATE PROCESSING PROGRAM DTSZX550 00012 * FOR AMENDED, REPORTS, PAYMENTS, WAGES DELETIONS CL*95 00013 * AND ADDITIONS. CL*95 00014 * DTSZX550 00015 * ACCOUNTING BATCH HEADERS, REPORTS AND PAYMENTS DTSZX550 00016 * COMING FROM THE IN-HOUSE CASHIERING PROCESS ARE DTSZX550 00017 * PROCESSED LAST. IN THE SORT KEY, THE FIRST DTSZX550 00018 * ELEMENT (USED FOR THE EMPLOYER NUMBER FOR OTHER DTSZX550 00019 * PROCESSES) IS SET TO 999999. DTSZX550 00020 * DTSZX550 00021 * MODIFICATION HISTORY: DTSZX550 00022 * DTSZX550 00023 * 08-30-2015 INITIAL DEVELOPMENT COPIED FROM BX417 CL*63 00024 * REFERENCE RFP: ESSP AMENDED REPORTING ZL1 CL*63 00025 * DTSZX550 00026 * DTSZX550 00027 * CL*23 00028 * 10-22-2014 MODIFIED FOR ESSP INTERFACE CL*23 00029 * CHANGED SORT SEQUENCE FOR PROCESS X104 RECORDS CL*23 00030 * BEFORE PROCESSING NAMES X106. CL*23 00031 * RECORDS 102 AND 106 MUST BE PRESENT TO ADD A CL*23 00032 * NEW EMPLOYER TO DUTAS. IF X102 AND X104 PASS CL*23 00033 * ALL EDITS THEN NAME RECORD X106 RATE X108 AND CL*23 00034 * ADDRESS X110 MUST BE PRESENT FOR EMPLOYER TO ADD CL*23 00035 * CL*23 00036 * REFERENCE RFP: ZL1 CL*23 00037 * CL*23 00038 * DTSZX550 00039 * 11-01-2014 MODIFIED FOR ESSP INTERFACE CL*23 00040 * MODIFIED PROGRAM TO CALL A NEW PROGRAM BX430 TO CL*23 00041 * PROCESS REPORTS,WAGES AND PAYMENTS. CL*23 00042 * REPORTS X140 COMING FROM ESSP CANNOT BE PROCESSED CL*23 00043 * UNTIL A PAYMENT X145 IS PRESENT UNLESS IT IS A CL*23 00044 * ZERO WAGE REPORT (REMIT AMT = 0). ALSO CHANGED CL*23 00045 * THE SORT SEQ TO SORT PAYMENT X145 BEFORE X140 CL*23 00046 * PREVIOUS SORT KEY WAS 30 NOW 19. CL*23 00047 * REFERENCE RFP: ZL1 CL*23 00048 * CL*23 00049 * CL*23 00050 * 12-02-2016 MODIFIED FOR ESSP INTERFACE CL*95 00051 * DUTAS REJECTING AMENDMENTS THAT ARE NOT IN SEQUENC CL*95 00052 * E. MODIFIED PROGRAM TO MOVE SEQ NUMBER TO T28 LOG CL*95 00053 * NO. WITH BD140 SORT PROCESS ALL TRANSACTIONS WILL CL*95 00054 * BE PROCESSED AS RECEIVED. CL*95 00055 * CL*95 00056 * REFERENCE RFP: ESSP AMENDMENTS ZL1 CL*95 00057 * CL*40 00058 * CL*40 00059 ***** DTSZX550 00060 SKIP3 DTSZX550 00061 ENVIRONMENT DIVISION. DTSZX550 00062 SKIP2 DTSZX550 00063 INPUT-OUTPUT SECTION. DTSZX550 00064 DTSZX550 00065 FILE-CONTROL. DTSZX550 00066 DTSZX550 00067 SELECT WEB-IMP-FILE ASSIGN TO WEBREG DTSZX550 00068 FILE STATUS IS WEB-IMP-STATUS. DTSZX550 00069 DTSZX550 00070 ** SELECT CURR-BATCH-NO ASSIGN TO CURRBTCH DTSZX550 00071 ** FILE STATUS IS BATCH-STATUS. DTSZX550 00072 DTSZX550 00073 SELECT SORT-FILE ASSIGN TO SORTFILE. DTSZX550 00074 DTSZX550 00075 DATA DIVISION. DTSZX550 00076 DTSZX550 00077 FILE SECTION. DTSZX550 00078 DTSZX550 00079 FD WEB-IMP-FILE DTSZX550 00080 RECORDING MODE IS F DTSZX550 00081 BLOCK CONTAINS 0 RECORDS DTSZX550 00082 LABEL RECORDS ARE OMITTED. DTSZX550 00083 DTSZX550 00084 01 WEB-IMP-REC. DTSZX550 00085 05 WEB-IMP-TYPE PIC X(03). DTSZX550 00086 88 WEB-IMP-TYPE-PRF-88 VALUE '102'. DTSZX550 00087 88 WEB-IMP-TYPE-DETERM-88 VALUE '104'. DTSZX550 00088 88 WEB-IMP-TYPE-NAME-88 VALUE '106'. DTSZX550 00089 88 WEB-IMP-TYPE-RATE-88 VALUE '108'. DTSZX550 00090 88 WEB-IMP-TYPE-ADDR-88 VALUE '110'. DTSZX550 00091 88 WEB-IMP-TYPE-OPO-88 VALUE '120'. DTSZX550 00092 88 WEB-IMP-TYPE-REL-88 VALUE '130'. DTSZX550 00093 *** 88 WEB-IMP-TYPE-IND-88 VALUE '132'. DTSZX550 00094 88 WEB-IMP-TYPE-RPT-88 VALUE '140'. DTSZX550 00095 88 WEB-IMP-TYPE-WAGE-88 VALUE '144'. DTSZX550 00096 88 WEB-IMP-TYPE-PAY-88 VALUE '145'. DTSZX550 00097 88 WEB-IMP-TYPE-AWAGE-88 VALUE '147'. CL*63 00098 88 WEB-IMP-TYPE-BHDR-88 VALUE '149'. DTSZX550 00099 88 WEB-TYPE-REG-88 VALUE '102' '104' '106' DTSZX550 00100 '108' '130' '132'. DTSZX550 00101 88 WEB-TYPE-RPT-88 VALUE '140' '144' '147'. CL*63 00102 88 WEB-TYPE-PAY-88 VALUE '145'. DTSZX550 00103 88 WEB-TYPE-PRF-88 VALUE '110' '120'. DTSZX550 00104 05 FILLER PIC X(01). DTSZX550 00105 05 WEB-IMP-EMP-NO PIC 9(06). DTSZX550 00106 05 FILLER PIC X(01). DTSZX550 00107 05 WEB-IMP-QTR PIC X(06). DTSZX550 00108 05 FILLER PIC X(495). DTSZX550 00109 DTSZX550 00110 *FD CURR-BATCH-NO DTSZX550 00111 * RECORDING MODE IS F DTSZX550 00112 * BLOCK CONTAINS 0 RECORDS DTSZX550 00113 * LABEL RECORDS ARE OMITTED. DTSZX550 00114 * DTSZX550 00115 *01 CURR-BATCH-NO-REC. DTSZX550 00116 * 05 CURRENT-BATCH-NO PIC 9(05). DTSZX550 00117 * 05 CURRENT-ITEM-NO PIC 9(03). DTSZX550 00118 * 05 FILLER PIC X(01). DTSZX550 00119 * 05 CURRENT-ARCHIVE-YEAR PIC 9(04). DTSZX550 00120 * 05 FILLER PIC X(01). DTSZX550 00121 * 05 FIRST-ARCHIVE-YEAR PIC 9(04). DTSZX550 00122 * 05 FILLER PIC X(62). DTSZX550 00123 DTSZX550 00124 SD SORT-FILE. DTSZX550 00125 DTSZX550 00126 01 SORT-REC. DTSZX550 00127 05 SORT-KEY. DTSZX550 00128 10 SORT-EMP-NO PIC 9(06). DTSZX550 00129 10 SORT-SEQ2 PIC X(16). DTSZX550 00130 10 SORT-SEQ1 PIC S9(04) COMP. CL*60 00131 05 RPT-PAY-SORT-KEY REDEFINES SORT-KEY. CL*57 00132 10 SORT-PAY-EMP-NO PIC 9(06). CL*57 00133 10 SORT-PAY-QTR PIC X(06). CL*57 00134 10 SORT-FILLER PIC X(10). DTSZX550 00135 10 SORT-PAY-SEQ1 PIC S9(04) COMP. CL*60 00136 05 IN-HOUSE-SORT-KEY REDEFINES SORT-KEY. CL*57 00137 10 SORT-IN-HOUSE-SEQ PIC 9(06). CL*57 00138 10 SORT-BATCH PIC 9(05). CL*57 00139 10 SORT-ITEM PIC 9(03). CL*57 00140 10 SORT-FILLER PIC X(10). CL*57 00141 05 SORT-DATA PIC X(512). DTSZX550 00142 DTSZX550 00143 WORKING-STORAGE SECTION. DTSZX550 001435 77 PAN-VALET PICTURE X(24) VALUE '095DTSZX550 12/05/16'. DTSZX550 00144 77 PAN-VALET PICTURE X(24) VALUE '013DTSBX420 10/07/14'. DTSZX550 00145 77 PAN-VALET PICTURE X(24) VALUE '154DTSBX420 10/07/14'. DTSZX550 00146 SKIP3 DTSZX550 00147 01 WRK-AREA. DTSZX550 00148 05 W-ABEND-CD PIC S9(04) COMP VALUE 420. DTSZX550 00149 05 W-MOD-NAME PIC X(08) VALUE 'DTSBX420'.DTSZX550 00150 DTSZX550 00151 05 WEB-IMP-STATUS PIC X(02). DTSZX550 00152 88 WEB-IMP-STATUS-OK-88 VALUE '00'. DTSZX550 00153 88 WEB-IMP-STATUS-EOF-88 VALUE '10'. DTSZX550 00154 DTSZX550 00155 ** 05 BATCH-STATUS PIC X(02). DTSZX550 00156 * 88 BATCH-STATUS-OK-88 VALUE '00'. DTSZX550 00157 ** 88 BATCH-STATUS-EOF-88 VALUE '10'. DTSZX550 00158 DTSZX550 00159 05 SORT-EOF-IND PIC X(01). DTSZX550 00160 88 SORT-OK-88 VALUE '0'. DTSZX550 00161 88 SORT-EOF-88 VALUE '1'. DTSZX550 00162 DTSZX550 00163 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSZX550 00164 88 W-ERROR-YES-88 VALUE 'Y'. DTSZX550 00165 88 W-ERROR-NO-88 VALUE 'N'. DTSZX550 00166 DTSZX550 00167 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSZX550 00168 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSZX550 00169 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSZX550 00170 DTSZX550 00171 05 W-EMP-NO PIC 9(07) VALUE ZERO. DTSZX550 00172 05 W-PAY-QTR PIC X(06) VALUE SPACES. CL*57 00173 05 W-PSEUDO-BATCH-NO PIC 9(05) VALUE ZERO. DTSZX550 00174 05 W-CURR-RUN-DATE PIC S9(09) COMP-3. DTSZX550 00175 05 W-LAST-RATE-YEAR PIC 9(04). DTSZX550 00176 05 X102-KEY-AREA PIC X(06) VALUE SPACES. CL*15 00177 DTSZX550 00178 05 SUB PIC S9(04) COMP. DTSZX550 00179 ** 05 W-PSEUDO-BATCH-NO PIC 9(05) VALUE ZERO. DTSZX550 00180 * 05 FILLER REDEFINES W-PSEUDO-BATCH-NO. DTSZX550 00181 * 10 W-PSEUDO-DAYS PIC 9(03). DTSZX550 00182 ** 10 W-PSEUDO-BATCH-SEQ PIC 9(02). DTSZX550 00183 DTSZX550 00184 05 W-START-BATCH PIC 9(05) VALUE ZERO. DTSZX550 00185 05 W-END-BATCH PIC 9(05) VALUE ZERO. DTSZX550 00186 DTSZX550 00187 05 W-PSEUDO-ITEM-NO PIC 9(03) VALUE 0. DTSZX550 00188 DTSZX550 00189 05 W-500-DATE. DTSZX550 00190 10 W-500-DATE-MM PIC XX. DTSZX550 00191 10 FILLER PIC X. DTSZX550 00192 10 W-500-DATE-DD PIC XX. DTSZX550 00193 10 FILLER PIC X. DTSZX550 00194 10 W-500-DATE-YY PIC XXXX. DTSZX550 00195 DTSZX550 00196 05 W-500-FQTR. DTSZX550 00197 10 W-500-FQTR-YY PIC XXXX. DTSZX550 00198 10 FILLER PIC X VALUE '/'. DTSZX550 00199 10 W-500-FQTR-NO PIC X. DTSZX550 00200 DTSZX550 00201 05 W-INT-9 PIC 9(13). DTSZX550 00202 05 W-INT-X REDEFINES W-INT-9 DTSZX550 00203 PIC X(13). DTSZX550 00204 CL*70 00205 05 Z-INT-X. CL*78 00206 15 Z-INT-A PIC S9(11) VALUE ZEROS. CL*78 00207 15 Z-INT-B PIC X(01) VALUE '.'. CL*79 00208 15 Z-INT-C PIC 9(02) VALUE ZEROS. CL*78 00209 05 Z-INT-9. CL*78 00210 15 Z-INT-A9 PIC S9(11) VALUE ZEROS. CL*78 00211 15 Z-INT-C9 PIC 9(02) VALUE ZEROS. CL*78 00212 05 Z-INT-Z9 REDEFINES Z-INT-9 CL*78 00213 PIC S9(11)V99. CL*77 00214 CL*70 00215 05 W-INTEGER PIC S9(11) COMP-3. DTSZX550 00216 05 W-FRACTION PIC SV9(11) COMP-3. DTSZX550 00217 05 W-NUMBER PIC S9(11)V9(05) COMP-3. DTSZX550 00218 05 Z-NUMBER PIC S9(11)V9(05) VALUE 0. CL*69 00219 DTSZX550 00220 ** 05 W-MULTIPLIER PIC S9(11)V99 COMP-3 DTSZX550 00221 * VALUE +0. DTSZX550 00222 * 05 W-DIGIT PIC 9. DTSZX550 00223 * 05 W-AMT PIC S9(09)V99 COMP-3 DTSZX550 00224 * VALUE +0. DTSZX550 00225 * DTSZX550 00226 * 05 W-DECIMAL-FOUND-IND PIC X(01) VALUE 'N'. DTSZX550 00227 * 88 W-DECIMAL-FOUND-YES-88 VALUE 'Y'. DTSZX550 00228 * 88 W-DECIMAL-FOUND-NO-88 VALUE 'N'. DTSZX550 00229 * DTSZX550 00230 * 05 W-WAGES PIC S9(11)V99. DTSZX550 00231 * 05 W-WAGES-X PIC X(14). DTSZX550 00232 * 05 W-WAGES-9 REDEFINES W-WAGES-X DTSZX550 00233 * PIC 9(11).99. DTSZX550 00234 * 05 W-REMIT-X PIC X(12). DTSZX550 00235 * 05 W-REMIT-9 REDEFINES W-REMIT-X DTSZX550 00236 * PIC 9(09).99. DTSZX550 00237 05 W-TRACE-X. DTSZX550 00238 10 W-TRACE-A PIC X(05) VALUE '00000'. DTSZX550 00239 10 W-TRACE-B PIC X(08) VALUE ZEROS. DTSZX550 00240 05 W-TRACE-9 REDEFINES W-TRACE-X DTSZX550 00241 PIC 9(13). DTSZX550 00242 * 05 W-COUNT-X PIC X(07). DTSZX550 00243 * 05 W-COUNT-9 REDEFINES W-COUNT-X DTSZX550 00244 * PIC 9(07). DTSZX550 00245 * 05 W-EARNINGS-X PIC X(12). DTSZX550 00246 * 05 W-EARNINGS-9 REDEFINES W-EARNINGS-X DTSZX550 00247 * PIC 9(09).99. DTSZX550 00248 * 05 W-EARNINGS PIC S9(07)V99. DTSZX550 00249 * 05 W-RATE PIC S9V9(04). DTSZX550 00250 * 05 W-RATE-X PIC X(06). DTSZX550 00251 * 05 W-RATE-9 REDEFINES W-RATE-X DTSZX550 00252 * PIC 9.9999. DTSZX550 00253 * DTSZX550 00254 * 05 ISUB1 PIC S9(04) COMP. DTSZX550 00255 * 05 ISUB2 PIC S9(04) COMP. DTSZX550 00256 * 05 ISUB3 PIC S9(04) COMP. DTSZX550 00257 * 05 ISUB4 PIC S9(04) COMP. DTSZX550 00258 * 05 ISUB5 PIC S9(04) COMP. DTSZX550 00259 * 05 ISUB6 PIC S9(04) COMP. DTSZX550 00260 * 05 W-SLASH1 PIC S9(04) COMP. DTSZX550 00261 * 05 W-SLASH2 PIC S9(04) COMP. DTSZX550 00262 * 05 W-CURR-FIELD PIC S9(04) COMP. DTSZX550 00263 * 05 W-LAST-FIELD PIC S9(04) COMP. DTSZX550 00264 * 05 W-LAST-FIELD-LEN PIC S9(04) COMP. DTSZX550 00265 * 05 W-INPUT-LENGTH PIC S9(04) COMP DTSZX550 00266 * VALUE +502. DTSZX550 00267 * 05 W-INPUT-LINE PIC X(500). DTSZX550 00268 * 05 W-PARSE-COMPLETE-IND PIC X(01). DTSZX550 00269 * 88 W-PARSE-COMPLETE-YES-88 VALUE 'Y'. DTSZX550 00270 * 88 W-PARSE-COMPLETE-NO-88 VALUE 'N'. DTSZX550 00271 * 05 W-FIELD-LENGTH PIC S9(04) COMP. DTSZX550 00272 * 05 W-CONV-LINE PIC X(32). DTSZX550 00273 * DTSZX550 00274 * 05 W-MDY PIC X(04). DTSZX550 00275 * 05 FILLER REDEFINES W-MDY. DTSZX550 00276 * 10 FILLER PIC X(02). DTSZX550 00277 * 10 W-MDY-X-2 PIC X(02). DTSZX550 00278 * 10 FILLER REDEFINES W-MDY-X-2. DTSZX550 00279 * 15 FILLER PIC X(01). DTSZX550 00280 ** 15 W-MDY-X-1 PIC X(01). DTSZX550 00281 DTSZX550 00282 05 W-WEB-IMP-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX550 00283 05 W-102-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 00284 05 W-104-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 00285 05 W-106-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 00286 05 W-108-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 00287 05 W-110-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 00288 05 W-120-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 00289 05 W-140-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 00290 05 W-144-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 00291 05 W-145-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 00292 05 W-147-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*63 00293 DTSZX550 00294 05 W-WEB-IMP-LENGTH PIC S9(04) COMP. DTSZX550 00295 DTSZX550 00296 05 W-AMT-DISP1 PIC ----------9.99. DTSZX550 00297 05 W-AMT-DISP2 PIC ----------9.99. DTSZX550 00298 05 W-AMT-DISP4 PIC -.99999999999. DTSZX550 00299 05 W-AMT-DISP3 PIC ------------9. DTSZX550 00300 DTSZX550 00301 * PROFILE DTSZX550 00302 01 X102-REC. DTSZX550 00303 ++INCLUDE DTSIX102 DTSZX550 00304 DTSZX550 00305 * DETERMINATION DTSZX550 00306 01 X104-REC. DTSZX550 00307 ++INCLUDE DTSIX104 DTSZX550 00308 DTSZX550 00309 * NAME DTSZX550 00310 01 X106-REC. DTSZX550 00311 ++INCLUDE DTSIX106 DTSZX550 00312 DTSZX550 00313 * RATE DTSZX550 00314 01 X108-REC. DTSZX550 00315 ++INCLUDE DTSIX108 DTSZX550 00316 DTSZX550 00317 * ADDRESS DTSZX550 00318 01 X110-REC. DTSZX550 00319 ++INCLUDE DTSIX110 DTSZX550 00320 DTSZX550 00321 * OPO DTSZX550 00322 01 X120-REC. DTSZX550 00323 ++INCLUDE DTSIX120 DTSZX550 00324 DTSZX550 00325 * WORKING COPY OF X120 CL*41 00326 01 W120-REC. CL*41 00327 ++INCLUDE DTSWX120 CL*43 00328 CL*41 00329 * RELATIONSHIP DTSZX550 00330 01 X130-REC. DTSZX550 00331 ++INCLUDE DTSIX130 DTSZX550 00332 DTSZX550 00333 ** INDUSTRY DESCRIPTION DTSZX550 00334 *01 X132-REC. DTSZX550 00335 ***INCLUDE DTSIX132 DTSZX550 00336 DTSZX550 00337 * REPORT DUTAS CL*73 00338 01 X140-REC. DTSZX550 00339 ++INCLUDE DTSIX140 DTSZX550 00340 DTSZX550 00341 * REPORT ESSP CL*73 00342 01 W140-REC. CL*73 00343 ++INCLUDE DTSIW140 CL*73 00344 CL*73 00345 * EMPLOYEE WAGES DTSZX550 00346 01 X144-REC. DTSZX550 00347 ++INCLUDE DTSIX144 DTSZX550 00348 DTSZX550 00349 * EMPLOYEE WAGES-WORK COPY CL*50 00350 01 W144-REC. CL*50 00351 ++INCLUDE DTSIW144 CL*50 00352 CL*50 00353 * EMPLOYEE AMENDED WAGES (W2) CL*63 00354 01 X147-REC. CL*63 00355 ++INCLUDE DTSIX147 CL*63 00356 CL*63 00357 * PAYMENT DTSZX550 00358 01 X145-REC. DTSZX550 00359 ++INCLUDE DTSIX145 DTSZX550 00360 DTSZX550 00361 01 X149-REC. DTSZX550 00362 ++INCLUDE DTSIX149 DTSZX550 00363 DTSZX550 00364 01 L001-LINK-AREA. DTSZX550 00365 ++INCLUDE DTSIL001 DTSZX550 00366 DTSZX550 00367 01 L003-LINK-AREA. DTSZX550 00368 ++INCLUDE DTSIL003 DTSZX550 00369 DTSZX550 00370 01 L004-LINK-AREA. DTSZX550 00371 ++INCLUDE DTSIL004 DTSZX550 00372 DTSZX550 00373 01 L005-LINK-AREA. DTSZX550 00374 ++INCLUDE DTSIL005 DTSZX550 00375 DTSZX550 00376 01 L205-LINK-AREA. DTSZX550 00377 ++INCLUDE DTSIL205 DTSZX550 00378 DTSZX550 00379 01 LX42-LINK-AREA. DTSZX550 00380 ++INCLUDE DTSILX42 CL*39 00381 DTSZX550 00382 01 L910-LINK-AREA. DTSZX550 00383 ++INCLUDE DTSIL910 DTSZX550 00384 01 MSKL-REC. DTSZX550 00385 ++INCLUDE DTSIMSKL DTSZX550 00386 DTSZX550 00387 01 MHDR-REC. DTSZX550 00388 ++INCLUDE DTSIMHDR DTSZX550 00389 DTSZX550 00390 01 MPRF-REC. DTSZX550 00391 ++INCLUDE DTSIMPRF DTSZX550 00392 DTSZX550 00393 01 MSOL-REC. DTSZX550 00394 ++INCLUDE DTSIMSOL DTSZX550 00395 DTSZX550 00396 01 MQTR-REC. DTSZX550 00397 ++INCLUDE DTSIMQTR DTSZX550 00398 DTSZX550 00399 01 MOPO-REC. DTSZX550 00400 ++INCLUDE DTSIMOPO DTSZX550 00401 DTSZX550 00402 01 MTAD-REC. DTSZX550 00403 ++INCLUDE DTSIMTAD DTSZX550 00404 DTSZX550 00405 01 MNTE-REC. DTSZX550 00406 ++INCLUDE DTSIMNTE DTSZX550 00407 DTSZX550 00408 01 L921-LINK-AREA. DTSZX550 00409 ++INCLUDE DTSIL921 DTSZX550 00410 SKIP3 DTSZX550 00411 01 ISKL-REC. DTSZX550 00412 ++INCLUDE DTSIISKL DTSZX550 00413 SKIP3 DTSZX550 00414 01 IEIN-REC. DTSZX550 00415 ++INCLUDE DTSIIEIN DTSZX550 00416 DTSZX550 00417 01 L923-LINK-AREA. DTSZX550 00418 ++INCLUDE DTSIL923 DTSZX550 00419 EJECT DTSZX550 00420 01 ASKL-REC. DTSZX550 00421 ++INCLUDE DTSIASKL DTSZX550 00422 EJECT DTSZX550 00423 01 AHDR-REC. DTSZX550 00424 ++INCLUDE DTSIAHDR DTSZX550 00425 DTSZX550 00426 01 ARPT-REC. DTSZX550 00427 ++INCLUDE DTSIARPT DTSZX550 00428 DTSZX550 00429 01 APAY-REC. DTSZX550 00430 ++INCLUDE DTSIAPAY DTSZX550 00431 DTSZX550 00432 DTSZX550 00433 01 L927-LINK-AREA. DTSZX550 00434 ++INCLUDE DTSIL927 DTSZX550 00435 DTSZX550 00436 01 TSKL-REC. DTSZX550 00437 ++INCLUDE DTSITSKL DTSZX550 00438 DTSZX550 00439 01 L931-LINK-AREA. DTSZX550 00440 ++INCLUDE DTSIL931 DTSZX550 00441 DTSZX550 00442 01 FSKL-REC. DTSZX550 00443 ++INCLUDE DTSIFSKL DTSZX550 00444 DTSZX550 00445 PROCEDURE DIVISION. DTSZX550 00446 DTSZX550 00447 DTSBX420-MAIN. DTSZX550 00448 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSZX550 00449 IF W-FATAL-ERROR-YES-88 DTSZX550 00450 GO TO DTSBX420-MAIN-EXIT DTSZX550 00451 END-IF. DTSZX550 00452 DTSZX550 00453 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSZX550 00454 DTSZX550 00455 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSZX550 00456 IF W-ERROR-YES-88 DTSZX550 00457 MOVE +2 TO RETURN-CODE. DTSZX550 00458 DTSBX420-MAIN-EXIT. DTSZX550 00459 GOBACK. DTSZX550 00460 EJECT DTSZX550 00461 I0000-INITIATE. DTSZX550 00462 SET W-ERROR-NO-88 TO TRUE. DTSZX550 00463 SET W-FATAL-ERROR-NO-88 TO TRUE. DTSZX550 00464 DTSZX550 00465 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSZX550 00466 DTSZX550 00467 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSZX550 00468 IF W-FATAL-ERROR-YES-88 DTSZX550 00469 GO TO I0000-EXIT DTSZX550 00470 END-IF. DTSZX550 00471 DTSZX550 00472 PERFORM I3000-READ-HEADER THRU I3000-EXIT. DTSZX550 00473 IF W-FATAL-ERROR-YES-88 DTSZX550 00474 GO TO I0000-EXIT DTSZX550 00475 END-IF. DTSZX550 00476 DTSZX550 00477 ** PERFORM I4000-CURRENT-BATCH THRU I4000-EXIT DTSZX550 00478 * IF W-FATAL-ERROR-YES-88 DTSZX550 00479 * GO TO I0000-EXIT DTSZX550 00480 ** END-IF. DTSZX550 00481 DTSZX550 00482 PERFORM I5000-INITIAL-CALLS THRU I5000-EXIT. DTSZX550 00483 DTSZX550 00484 I0000-EXIT. DTSZX550 00485 EXIT. DTSZX550 00486 DTSZX550 00487 I2000-OPEN-FILES. DTSZX550 00488 OPEN INPUT WEB-IMP-FILE. DTSZX550 00489 IF NOT WEB-IMP-STATUS-OK-88 DTSZX550 00490 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX550 00491 DISPLAY 'NO ESSP UPDATES FILE TO PROCESS' DTSZX550 00492 MOVE +3 TO RETURN-CODE DTSZX550 00493 SET W-ERROR-YES-88 TO TRUE DTSZX550 00494 DISPLAY 'CANNOT OPEN WEB-IMP-FILE ' DTSZX550 00495 WEB-IMP-STATUS DTSZX550 00496 GO TO I2000-EXIT DTSZX550 00497 END-IF. DTSZX550 00498 DTSZX550 00499 READ WEB-IMP-FILE. DTSZX550 00500 IF NOT WEB-IMP-STATUS-OK-88 DTSZX550 00501 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX550 00502 DISPLAY 'NO ESSP FTP UPDATE FILES TO PROCESS' DTSZX550 00503 MOVE +3 TO RETURN-CODE DTSZX550 00504 SET W-ERROR-YES-88 TO TRUE DTSZX550 00505 DISPLAY 'NO RECORDS ON WEB-IMP-FILE ' DTSZX550 00506 WEB-IMP-STATUS DTSZX550 00507 GO TO I2000-EXIT DTSZX550 00508 END-IF. DTSZX550 00509 CLOSE WEB-IMP-FILE. DTSZX550 00510 OPEN INPUT WEB-IMP-FILE. DTSZX550 00511 IF NOT WEB-IMP-STATUS-OK-88 DTSZX550 00512 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX550 00513 DISPLAY 'NO ESSP UPDATES FILE TO PROCESS' DTSZX550 00514 MOVE +3 TO RETURN-CODE DTSZX550 00515 SET W-ERROR-YES-88 TO TRUE DTSZX550 00516 DISPLAY 'CANNOT OPEN WEB-IMP-FILE ' DTSZX550 00517 WEB-IMP-STATUS DTSZX550 00518 GO TO I2000-EXIT DTSZX550 00519 END-IF. DTSZX550 00520 DTSZX550 00521 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSZX550 00522 DTSZX550 00523 PERFORM S921-OPEN-READ THRU S921-EXIT. DTSZX550 00524 DTSZX550 00525 PERFORM S923-OPEN-READ THRU S923-EXIT. DTSZX550 00526 DTSZX550 00527 PERFORM S931-OPEN-READ THRU S931-EXIT. DTSZX550 00528 DTSZX550 00529 * MOVE 'N' TO L927-TRACE-IND. CL*44 00530 * MOVE W-MOD-NAME TO L927-MOD-NAME. CL*44 00531 * PERFORM S927A-OPEN THRU S927A-EXIT. CL*44 00532 DTSZX550 00533 I2000-EXIT. DTSZX550 00534 EXIT. DTSZX550 00535 DTSZX550 00536 I3000-READ-HEADER. DTSZX550 00537 MOVE LOW-VALUES TO MSKL-REC. DTSZX550 00538 MOVE +0 TO MSKL-EMP-NO. DTSZX550 00539 SET MSKL-HDR-88 TO TRUE. DTSZX550 00540 DTSZX550 00541 PERFORM S910-READ THRU S910-EXIT. DTSZX550 00542 IF L910-NO-REC-88 DTSZX550 00543 DISPLAY 'DTSBX420: MHDR RECORD IS MISSING' DTSZX550 00544 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX550 00545 MOVE +6 TO RETURN-CODE DTSZX550 00546 GO TO I3000-EXIT DTSZX550 00547 ELSE DTSZX550 00548 MOVE MSKL-REC TO MHDR-REC DTSZX550 00549 END-IF. DTSZX550 00550 DTSZX550 00551 MOVE MHDR-CURR-RUN-DATE TO W-CURR-RUN-DATE. DTSZX550 00552 DTSZX550 00553 MOVE MHDR-LAST-RATE-END-YRQ TO L004-QTR-5-9. DTSZX550 00554 MOVE L004-QTR-5-YR TO W-LAST-RATE-YEAR. DTSZX550 00555 DISPLAY 'LAST RATE YEAR ' W-LAST-RATE-YEAR. DTSZX550 00556 DTSZX550 00557 I3000-EXIT. DTSZX550 00558 EXIT. DTSZX550 00559 DTSZX550 00560 I5000-INITIAL-CALLS. DTSZX550 00561 DISPLAY '!!!!! BX420- INITILIZE RECORDS START BX420' CL*12 00562 SET LX42-INITIALIZE-88 TO TRUE. DTSZX550 00563 MOVE W-CURR-RUN-DATE TO LX42-CURR-RUN-DATE. DTSZX550 00564 MOVE L005-DATE TO LX42-SYS-DATE. DTSZX550 00565 MOVE L005-TIME TO LX42-SYS-TIME. DTSZX550 00566 * MOVE ZERO TO LX42-BATCH-NO DTSZX550 00566 MOVE ZERO TO LX42-PSEUDO-BATCH-NO DTSZX550 00568 LX42-LAST-DETERM-EMP DTSZX550 00569 LX42-RPT-CNT DTSZX550 00570 LX42-RPT-REMIT-AMT DTSZX550 00571 LX42-PAY-CNT DTSZX550 00572 LX42-PAY-REMIT-AMT. DTSZX550 00573 SET LX42-BATCH-ERR-NO-88 TO TRUE. DTSZX550 00574 SET LX42-ERROR-NO-88 TO TRUE. DTSZX550 00575 SET LX42-RPT-ERROR-NO-88 TO TRUE CL*29 00576 MOVE LOW-VALUES TO LX42-DATA-AREA. DTSZX550 00577 DTSZX550 00578 MOVE ZERO TO W-102-IMP-CNT CL*38 00579 W-104-IMP-CNT CL*38 00580 W-106-IMP-CNT CL*38 00581 W-108-IMP-CNT CL*38 00582 W-110-IMP-CNT CL*38 00583 W-120-IMP-CNT CL*38 00584 W-140-IMP-CNT CL*38 00585 W-144-IMP-CNT CL*38 00586 W-145-IMP-CNT. CL*38 00587 PERFORM S422-REPORT-PAYMT THRU S422-EXIT. CL*23 00588 * PERFORM S423-REPORT-WAGE THRU S423-EXIT. CL*59 00589 DTSZX550 00590 I5000-EXIT. DTSZX550 00591 EXIT. DTSZX550 00592 DTSZX550 00593 DTSZX550 00594 P0000-PROCESS. DTSZX550 00595 DISPLAY '!!!! BX420- START WEB IMPORT PRELIMINARY EDIT'. CL*12 00596 DISPLAY SPACE. DTSZX550 00597 DTSZX550 00598 SET W-ERROR-NO-88 TO TRUE. DTSZX550 00599 DTSZX550 00600 SORT SORT-FILE DTSZX550 00601 ON ASCENDING KEY SORT-KEY DTSZX550 00602 INPUT PROCEDURE P1000-PRE-SORT THRU P1000-EXIT DTSZX550 00603 OUTPUT PROCEDURE P2000-POST-SORT THRU P2000-EXIT. DTSZX550 00604 DTSZX550 00605 IF SORT-RETURN NOT = +0 DTSZX550 00606 DISPLAY 'SORT FAILED ' SORT-RETURN DTSZX550 00607 END-IF. DTSZX550 00608 DTSZX550 00609 P0000-EXIT. DTSZX550 00610 EXIT. DTSZX550 00611 DTSZX550 00612 DTSZX550 00613 P1000-PRE-SORT. DTSZX550 00614 PERFORM S1000-READ-WEB-IMP THRU S1000-EXIT. DTSZX550 00615 PERFORM UNTIL WEB-IMP-STATUS-EOF-88 DTSZX550 00616 PERFORM P1100-PARSE-IMPORT-REC THRU P1100-EXIT DTSZX550 00617 PERFORM P1200-BUILD-SORT-REC THRU P1200-EXIT DTSZX550 00618 PERFORM S1000-READ-WEB-IMP THRU S1000-EXIT DTSZX550 00619 END-PERFORM. DTSZX550 00620 DTSZX550 00621 DISPLAY '!!!!! BX420- ENDOF INPUT SORT PROCEDURE ****'. CL*12 00622 P1000-EXIT. DTSZX550 00623 EXIT. DTSZX550 00624 DTSZX550 00625 P1100-PARSE-IMPORT-REC. DTSZX550 00626 IF WEB-IMP-TYPE-BHDR-88 DTSZX550 00627 DISPLAY 'BX420 P1000 HDR ' WEB-IMP-REC(1:14) DTSZX550 00628 END-IF. DTSZX550 00629 CL*20 00630 * DISPLAY 'P1000 ' WEB-IMP-TYPE ' ' WEB-IMP-EMP-NO. CL*88 00631 DTSZX550 00632 PERFORM DTSZX550 00633 VARYING SUB FROM +1 BY +1 DTSZX550 00634 UNTIL SUB > +100 DTSZX550 00635 MOVE +0 TO L205-FIELD-LENGTH (SUB) DTSZX550 00636 L205-INTEGER (SUB) DTSZX550 00637 L205-FRACTION (SUB) DTSZX550 00638 MOVE SPACES TO L205-TEXT (SUB) DTSZX550 00639 L205-DATE (SUB) DTSZX550 00640 SET L205-TYPE-TEXT-88 (SUB) TO TRUE DTSZX550 00641 END-PERFORM. DTSZX550 00642 DTSZX550 00643 EVALUATE TRUE DTSZX550 00644 DTSZX550 00645 * WHEN WEB-IMP-TYPE-RPT-88 CL*81 00646 * PERFORM P1100H-RPT THRU P1100H-EXIT CL*81 00647 DTSZX550 00648 WHEN WEB-IMP-TYPE-WAGE-88 DTSZX550 00649 PERFORM P1100I-WAGE THRU P1100I-EXIT DTSZX550 00650 DTSZX550 00651 WHEN WEB-IMP-TYPE-AWAGE-88 CL*85 00652 PERFORM P1100X-AWAGE THRU P1100X-EXIT CL*85 00653 CL*85 00654 WHEN WEB-IMP-TYPE-PAY-88 DTSZX550 00655 PERFORM P1100J-PAY THRU P1100J-EXIT DTSZX550 00656 DTSZX550 00657 DTSZX550 00658 END-EVALUATE. DTSZX550 00659 DTSZX550 00660 IF WEB-IMP-TYPE-RPT-88 CL*83 00661 GO TO P1100-EXIT. CL*83 00662 MOVE WEB-IMP-REC TO L205-INPUT-DATA. DTSZX550 00663 CALL 'DTSBU205' USING L205-LINK-AREA. DTSZX550 00664 DTSZX550 00665 P1100-EXIT. DTSZX550 00666 EXIT. DTSZX550 00667 DTSZX550 00668 P1100H-RPT. DTSZX550 00669 * DISPLAY 'P1100H-RPT ' WEB-IMP-REC(1:126). CL*23 00670 MOVE +16 TO L205-LAST-FIELD. CL*24 00671 MOVE +14 TO L205-LAST-FIELD-LEN. CL*27 00672 DTSZX550 00673 MOVE +3 TO L205-FIELD-LENGTH (1). DTSZX550 00674 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSZX550 00675 DTSZX550 00676 MOVE +6 TO L205-FIELD-LENGTH (2). DTSZX550 00677 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSZX550 00678 DTSZX550 00679 MOVE +4 TO L205-FIELD-LENGTH (3). DTSZX550 00680 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSZX550 00681 DTSZX550 00682 MOVE +1 TO L205-FIELD-LENGTH (4). DTSZX550 00683 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSZX550 00684 DTSZX550 00685 MOVE +8 TO L205-FIELD-LENGTH (5). DTSZX550 00686 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSZX550 00687 DTSZX550 00688 MOVE +8 TO L205-FIELD-LENGTH (6). DTSZX550 00689 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSZX550 00690 DTSZX550 00691 MOVE +14 TO L205-FIELD-LENGTH (7). DTSZX550 00692 SET L205-TYPE-NUMBER-88 (7) TO TRUE. DTSZX550 00693 DTSZX550 00694 MOVE +14 TO L205-FIELD-LENGTH (8). DTSZX550 00695 SET L205-TYPE-NUMBER-88 (8) TO TRUE. DTSZX550 00696 DTSZX550 00697 MOVE +14 TO L205-FIELD-LENGTH (9). DTSZX550 00698 SET L205-TYPE-NUMBER-88 (9) TO TRUE. DTSZX550 00699 DTSZX550 00700 MOVE +04 TO L205-FIELD-LENGTH (10). DTSZX550 00701 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSZX550 00702 DTSZX550 00703 MOVE +10 TO L205-FIELD-LENGTH (11). DTSZX550 00704 SET L205-TYPE-TEXT-88 (11) TO TRUE. DTSZX550 00705 DTSZX550 00706 MOVE +8 TO L205-FIELD-LENGTH (12). DTSZX550 00707 SET L205-TYPE-TEXT-88 (12) TO TRUE. CL*48 00708 DTSZX550 00709 MOVE +8 TO L205-FIELD-LENGTH (13). DTSZX550 00710 SET L205-TYPE-TEXT-88 (13) TO TRUE. CL*48 00711 DTSZX550 00712 MOVE +8 TO L205-FIELD-LENGTH (14). DTSZX550 00713 SET L205-TYPE-TEXT-88 (14) TO TRUE. CL*48 00714 DTSZX550 00715 MOVE +4 TO L205-FIELD-LENGTH (15). DTSZX550 00716 SET L205-TYPE-TEXT-88 (15) TO TRUE. DTSZX550 00717 DTSZX550 00718 MOVE +14 TO L205-FIELD-LENGTH (16). CL*27 00719 SET L205-TYPE-NUMBER-88 (16) TO TRUE. CL*26 00720 CL*24 00721 ** MOVE +1 TO L205-FIELD-LENGTH (16). DTSZX550 00722 ** SET L205-TYPE-TEXT-88 (18) TO TRUE. DTSZX550 00723 DTSZX550 00724 ** MOVE +1 TO L205-FIELD-LENGTH (17). DTSZX550 00725 ** SET L205-TYPE-TEXT-88 (19) TO TRUE. DTSZX550 00726 DTSZX550 00727 ** MOVE +3 TO L205-FIELD-LENGTH (18). DTSZX550 00728 ** SET L205-TYPE-TEXT-88 (20) TO TRUE. DTSZX550 00729 DTSZX550 00730 ** MOVE +8 TO L205-FIELD-LENGTH (19). DTSZX550 00731 ** SET L205-TYPE-TEXT-88 (21) TO TRUE. DTSZX550 00732 ** DISPLAY 'NANCY '. CL*31 00733 P1100H-EXIT. DTSZX550 00734 EXIT. DTSZX550 00735 DTSZX550 00736 P1100I-WAGE. DTSZX550 00737 * DISPLAY 'P1100I-WAGE ' WEB-IMP-REC(1:126). CL*10 00738 INITIALIZE X144-REC. DTSZX550 00739 MOVE +10 TO L205-LAST-FIELD. DTSZX550 00740 MOVE +14 TO L205-LAST-FIELD-LEN. DTSZX550 00741 DTSZX550 00742 MOVE +3 TO L205-FIELD-LENGTH (1). DTSZX550 00743 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSZX550 00744 DTSZX550 00745 MOVE +6 TO L205-FIELD-LENGTH (2). DTSZX550 00746 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSZX550 00747 DTSZX550 00748 MOVE +4 TO L205-FIELD-LENGTH (3). DTSZX550 00749 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSZX550 00750 DTSZX550 00751 MOVE +1 TO L205-FIELD-LENGTH (4). DTSZX550 00752 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSZX550 00753 DTSZX550 00754 MOVE +8 TO L205-FIELD-LENGTH (5). DTSZX550 00755 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSZX550 00756 DTSZX550 00757 MOVE +9 TO L205-FIELD-LENGTH (6). DTSZX550 00758 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSZX550 00759 DTSZX550 00760 MOVE +30 TO L205-FIELD-LENGTH (7). DTSZX550 00761 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSZX550 00762 DTSZX550 00763 MOVE +30 TO L205-FIELD-LENGTH (8). DTSZX550 00764 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSZX550 00765 DTSZX550 00766 MOVE +1 TO L205-FIELD-LENGTH (9). DTSZX550 00767 SET L205-TYPE-TEXT-88 (9) TO TRUE. DTSZX550 00768 DTSZX550 00769 MOVE +14 TO L205-FIELD-LENGTH (10). DTSZX550 00770 SET L205-TYPE-NUMBER-88 (10) TO TRUE. DTSZX550 00771 P1100I-EXIT. DTSZX550 00772 EXIT. DTSZX550 00773 DTSZX550 00774 P1100J-PAY. DTSZX550 00775 * DISPLAY 'P1100J-PAY ' WEB-IMP-REC(1:84). CL*10 00776 INITIALIZE X145-REC. DTSZX550 00777 MOVE +12 TO L205-LAST-FIELD. DTSZX550 00778 MOVE +8 TO L205-LAST-FIELD-LEN. DTSZX550 00779 DTSZX550 00780 MOVE +3 TO L205-FIELD-LENGTH (1). DTSZX550 00781 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSZX550 00782 DTSZX550 00783 MOVE +6 TO L205-FIELD-LENGTH (2). DTSZX550 00784 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSZX550 00785 DTSZX550 00786 MOVE +6 TO L205-FIELD-LENGTH (3). DTSZX550 00787 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSZX550 00788 DTSZX550 00789 MOVE +6 TO L205-FIELD-LENGTH (4). DTSZX550 00790 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSZX550 00791 DTSZX550 00792 MOVE +3 TO L205-FIELD-LENGTH (5). DTSZX550 00793 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSZX550 00794 DTSZX550 00795 MOVE +2 TO L205-FIELD-LENGTH (6). DTSZX550 00796 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSZX550 00797 DTSZX550 00798 MOVE +2 TO L205-FIELD-LENGTH (7). DTSZX550 00799 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSZX550 00800 DTSZX550 00801 MOVE +2 TO L205-FIELD-LENGTH (8). DTSZX550 00802 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSZX550 00803 DTSZX550 00804 MOVE +14 TO L205-FIELD-LENGTH (9). DTSZX550 00805 SET L205-TYPE-NUMBER-88 (9) TO TRUE. DTSZX550 00806 DTSZX550 00807 MOVE +10 TO L205-FIELD-LENGTH (10). DTSZX550 00808 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSZX550 00809 DTSZX550 00810 MOVE +10 TO L205-FIELD-LENGTH (11). DTSZX550 00811 SET L205-TYPE-TEXT-88 (11) TO TRUE. DTSZX550 00812 DTSZX550 00813 MOVE +8 TO L205-FIELD-LENGTH (12). DTSZX550 00814 SET L205-TYPE-TEXT-88 (12) TO TRUE. DTSZX550 00815 DTSZX550 00816 DTSZX550 00817 P1100J-EXIT. DTSZX550 00818 EXIT. DTSZX550 00819 DTSZX550 00820 CL*85 00821 P1100X-AWAGE. CL*85 00822 * DISPLAY 'P1100I-WAGE ' WEB-IMP-REC(1:126). CL*85 00823 INITIALIZE X147-REC. CL*85 00824 MOVE +10 TO L205-LAST-FIELD. CL*85 00825 MOVE +14 TO L205-LAST-FIELD-LEN. CL*85 00826 CL*85 00827 MOVE +3 TO L205-FIELD-LENGTH (1). CL*85 00828 SET L205-TYPE-TEXT-88 (1) TO TRUE. CL*85 00829 CL*85 00830 MOVE +6 TO L205-FIELD-LENGTH (2). CL*85 00831 SET L205-TYPE-TEXT-88 (2) TO TRUE. CL*85 00832 CL*85 00833 MOVE +4 TO L205-FIELD-LENGTH (3). CL*85 00834 SET L205-TYPE-TEXT-88 (3) TO TRUE. CL*85 00835 CL*85 00836 MOVE +1 TO L205-FIELD-LENGTH (4). CL*85 00837 SET L205-TYPE-TEXT-88 (4) TO TRUE. CL*85 00838 CL*85 00839 MOVE +8 TO L205-FIELD-LENGTH (5). CL*85 00840 SET L205-TYPE-TEXT-88 (5) TO TRUE. CL*85 00841 CL*85 00842 MOVE +9 TO L205-FIELD-LENGTH (6). CL*85 00843 SET L205-TYPE-TEXT-88 (6) TO TRUE. CL*85 00844 CL*85 00845 MOVE +30 TO L205-FIELD-LENGTH (7). CL*85 00846 SET L205-TYPE-TEXT-88 (7) TO TRUE. CL*85 00847 CL*85 00848 MOVE +30 TO L205-FIELD-LENGTH (8). CL*85 00849 SET L205-TYPE-TEXT-88 (8) TO TRUE. CL*85 00850 CL*85 00851 MOVE +1 TO L205-FIELD-LENGTH (9). CL*85 00852 SET L205-TYPE-TEXT-88 (9) TO TRUE. CL*85 00853 CL*85 00854 MOVE +14 TO L205-FIELD-LENGTH (10). CL*85 00855 SET L205-TYPE-NUMBER-88 (10) TO TRUE. CL*85 00856 P1100X-EXIT. CL*85 00857 EXIT. CL*85 00858 CL*85 00859 DTSZX550 00860 P1200-BUILD-SORT-REC. DTSZX550 00861 MOVE LOW-VALUES TO SORT-REC. DTSZX550 00862 MOVE WEB-IMP-EMP-NO TO SORT-EMP-NO. DTSZX550 00863 DTSZX550 00864 EVALUATE TRUE DTSZX550 00865 DTSZX550 00866 WHEN WEB-IMP-TYPE-RPT-88 DTSZX550 00867 PERFORM P1200H-RPT THRU P1200H-EXIT CL*33 00868 MOVE +20 TO SORT-SEQ1 CL*33 00869 MOVE X140-QUARTER TO SORT-SEQ2 CL*56 00870 * STRING CL*56 00871 * X140-QUARTER '0' DELIMITED BY SIZE CL*56 00872 * INTO SORT-SEQ2 CL*56 00873 * END-STRING CL*56 00874 * END-IF CL*35 00875 MOVE X140-REC TO SORT-DATA CL*36 00876 DTSZX550 00877 WHEN WEB-IMP-TYPE-WAGE-88 DTSZX550 00878 PERFORM P1200I-WAGE THRU P1200I-EXIT DTSZX550 00879 MOVE +21 TO SORT-SEQ1 CL*61 00880 MOVE X144-QUARTER TO SORT-SEQ2 CL*61 00881 * STRING CL*61 00882 * X140-QUARTER '1' CL*61 00883 * DELIMITED BY SIZE CL*61 00884 * INTO CL*61 00885 * SORT-SEQ2 CL*61 00886 * END-STRING CL*61 00887 MOVE X144-REC TO SORT-DATA CL*36 00888 DTSZX550 00889 CL*85 00890 WHEN WEB-IMP-TYPE-AWAGE-88 CL*85 00891 PERFORM P1200X-AWAGE THRU P1200X-EXIT CL*86 00892 MOVE +21 TO SORT-SEQ1 CL*85 00893 MOVE X144-QUARTER TO SORT-SEQ2 CL*85 00894 * STRING CL*85 00895 * X140-QUARTER '1' CL*85 00896 * DELIMITED BY SIZE CL*85 00897 * INTO CL*85 00898 * SORT-SEQ2 CL*85 00899 * END-STRING CL*85 00900 MOVE X147-REC TO SORT-DATA CL*85 00901 CL*85 00902 ************************************************************ CL*23 00903 * CHANGED SORT SEQ FOR PAYMENT RECORDS FROM 30 TO 19 DUE TO ESSP CL*23 00904 * REPORTS X140 CANNOT BE PROCESSED WITHOUT A PAYMENT TRANSACTION CL*23 00905 * UNLESS IT IS A 0 WAGE REPORT = REMIT AMOUNT = 0 CL*23 00906 ************************************************************ CL*23 00907 CL*23 00908 WHEN WEB-IMP-TYPE-PAY-88 DTSZX550 00909 PERFORM P1200J-PAY THRU P1200J-EXIT DTSZX550 00910 MOVE +19 TO SORT-SEQ1 CL*23 00911 MOVE X145-QTR TO SORT-SEQ2 CL*56 00912 MOVE X145-REC TO SORT-DATA DTSZX550 00913 ** DISPLAY 'P2 PAY ' X145-REC DTSZX550 00914 DTSZX550 00915 DTSZX550 00916 END-EVALUATE. DTSZX550 00917 DTSZX550 00918 RELEASE SORT-REC. DTSZX550 00919 DTSZX550 00920 P1200-EXIT. DTSZX550 00921 EXIT. DTSZX550 00922 DTSZX550 00923 P1200H-RPT. DTSZX550 00924 * DISPLAY '01200H-RPT ' CL**9 00925 INITIALIZE X140-REC. CL*84 00926 MOVE WEB-IMP-REC TO W140-REC. CL*82 00927 DTSZX550 00928 MOVE W140-REC-TYPE TO X140-REC-TYPE. CL*73 00929 * DISPLAY 'X140-REC-TYPE' X140-REC-TYPE CL**9 00930 DTSZX550 00931 MOVE W140-EMP-NO TO X140-EMP-NO. CL*73 00932 DISPLAY 'X140-EMP-NO ' X140-EMP-NO CL*62 00933 DTSZX550 00934 MOVE W140-QUARTER-YR TO X140-QUARTER(1:04). CL*73 00935 MOVE '/' TO X140-QUARTER(5:01). DTSZX550 00936 MOVE W140-QUARTER-Q TO X140-QUARTER(6:01). CL*76 00937 DISPLAY 'X140 QTR' X140-QUARTER. CL*56 00938 DTSZX550 00939 MOVE '00' TO X140-SOURCE. DTSZX550 00940 ** DISPLAY 'X140-EMP-NO ' X140-EMP-NO DTSZX550 00941 DTSZX550 00942 IF W140-REPORT-TYPE = ZERO CL*73 00943 MOVE 'OR' TO X140-REPORT-TYPE DTSZX550 00944 ELSE DTSZX550 00945 MOVE 'EA' TO X140-REPORT-TYPE DTSZX550 00946 END-IF. DTSZX550 00947 CL*90 00948 IF W140-AMEND-TYPE > ZERO CL*90 00949 MOVE 'EA' TO X140-REPORT-TYPE CL*91 00950 END-IF. CL*90 00951 DTSZX550 00952 MOVE W140-WRKR-CNT-TOTAL TO X140-WRKR-CNT-TOTAL. CL*74 00953 * DISPLAY 'L205-TEXT (6) (2:07) ' L205-TEXT (6) (2:07) CL*53 00954 DTSZX550 00955 MOVE ZEROS TO X140-PSEUDO-BATCH-NO. DTSZX550 00956 ** DISPLAY 'X140-PSEUDO-BATCH-NO ' X140-PSEUDO-BATCH-NO DTSZX550 00957 DTSZX550 00958 MOVE ZEROS TO X140-PSEUDO-ITEM-NO. DTSZX550 00959 ** DISPLAY 'X140-PSEUDO-ITEM-NO ' X140-PSEUDO-ITEM-NO DTSZX550 00960 DTSZX550 00961 * MOVE L205-INTEGER (8) TO W-INTEGER. CL*66 00962 * MOVE L205-FRACTION (8) TO W-FRACTION. CL*66 00963 * COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. CL*66 00964 * MOVE L205-TYPE-NUMBER-88 (8) Z-INT-X CL*74 00965 * MOVE Z-INT-X TO AMT-DISP1. CL*74 00966 * DISPLAY 'ZINTX ' AMT-DISP1 CL*74 00967 * MOVE Z-INT-9 TO AMT-DISP1. CL*74 00968 * DISPLAY 'ZINT9 ' AMT-DISP1 CL*74 00969 * MOVE Z-INT-X TO X140-TAX-WAGES. CL*74 00970 * DISPLAY 'X140-TAX-WAGES ' X140-TAX-WAGES CL*74 00971 CL*74 00972 CL*78 00973 CL*78 00974 MOVE W140-TAX-WAGES TO X140-TAX-WAGES CL*80 00975 MOVE X140-TAX-WAGES TO W-AMT-DISP1. CL*80 00976 DISPLAY 'TAX-WAGES ' W-AMT-DISP1 CL*80 00977 CL*78 00978 * MOVE L205-INTEGER (9) TO W-INTEGER. CL*66 00979 * MOVE L205-FRACTION (9) TO W-FRACTION. CL*66 00980 * COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. CL*66 00981 * MOVE L205-TYPE-NUMBER-88 (9) TO X140-TOTAL-WAGES CL*74 00982 * MOVE W-NUMBER TO X140-TOTAL-WAGES. CL*66 00983 * DISPLAY 'X140-TOTAL-WAGES ' X140-TOTAL-WAGES CL*80 00984 DTSZX550 00985 CL*80 00986 MOVE W140-TOTAL-WAGES TO X140-TOTAL-WAGES CL*80 00987 MOVE X140-TOTAL-WAGES TO W-AMT-DISP1. CL*80 00988 DISPLAY 'TOTAL-WAGES ' W-AMT-DISP1 CL*80 00989 CL*80 00990 MOVE ZERO TO X140-CONFIRMATION. DTSZX550 00991 DTSZX550 00992 MOVE W140-RCVD-DATE TO X140-RCVD-DATE. CL*74 00993 * DISPLAY 'RECV DATE ' X140-RCVD-DATE. CL**9 00994 DTSZX550 00995 * MOVE L205-TEXT (12) (2:07) TO X140-WRKR-CNT-1ST-MNTH. CL*74 00996 MOVE W140-WRKR-CNT-1ST-MNTH TO X140-WRKR-CNT-1ST-MNTH CL*74 00997 * DISPLAY 'X140-WRKR-CNT-1ST-MNTH ' X140-WRKR-CNT-1ST-MNTH CL*74 00998 DTSZX550 00999 * MOVE L205-TEXT (13) (2:07) TO X140-WRKR-CNT-2ND-MNTH. CL*74 01000 MOVE W140-WRKR-CNT-2ND-MNTH TO X140-WRKR-CNT-2ND-MNTH CL*74 01001 * DISPLAY 'X140-WRKR-CNT-2ND-MNTH ' X140-WRKR-CNT-2ND-MNTH CL*74 01002 DTSZX550 01003 * MOVE L205-TEXT (14) (2:07) TO X140-WRKR-CNT-3RD-MNTH. CL*74 01004 MOVE W140-WRKR-CNT-3RD-MNTH TO X140-WRKR-CNT-3RD-MNTH CL*74 01005 * DISPLAY 'X140-WRKR-CNT-3RD-MNTH ' X140-WRKR-CNT-3RD-MNTH CL*74 01006 DTSZX550 01007 CL*25 01008 CL*82 01009 MOVE W140-REMITTANCE TO X140-REMITTANCE CL*82 01010 MOVE X140-REMITTANCE TO W-AMT-DISP1. CL*82 01011 DISPLAY 'REMITTANCE ' W-AMT-DISP1 CL*82 01012 CL*82 01013 * MOVE L205-INTEGER (16) TO W-INTEGER. CL*82 01014 * MOVE L205-FRACTION (16) TO W-FRACTION. CL*82 01015 * COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. CL*82 01016 * MOVE W-NUMBER TO X140-REMITTANCE. CL*82 01017 * DISPLAY 'X140-REMITTANCE ' X140-REMITTANCE. CL*30 01018 CL*25 01019 MOVE SPACES TO X140-CHECK-SCAN-DT. DTSZX550 01020 * DISPLAY 'X140-CHECK SCANDATE ' X140-CHECK-SCAN-DT. CL**9 01021 DTSZX550 01022 MOVE W140-AMEND-SEQ-NO TO X140-CHECK-SEQ-NBR. CL*93 01023 DISPLAY 'X140-CHECK-SEQ-NBR ' X140-CHECK-SEQ-NBR CL*93 01024 DTSZX550 01025 MOVE 'N' TO X140-WAIVE-INTEREST. DTSZX550 01026 * DISPLAY 'X140-WAIVE-INTEREST ' X140-WAIVE-INTEREST CL**9 01027 DTSZX550 01028 MOVE 'N' TO X140-WAIVE-PENALTY. DTSZX550 01029 * DISPLAY 'X140-WAIVE-PENALTY ' X140-WAIVE-PENALTY CL**9 01030 DTSZX550 01031 MOVE ' ' TO X140-RESP-ACTIVITY. DTSZX550 01032 * DISPLAY 'X140-RESP-ACTIVITY ' X140-RESP-ACTIVITY CL**9 01033 DTSZX550 01034 MOVE 'WEBESSP ' TO X140-RESP-OPID. DTSZX550 01035 * DISPLAY 'X140-RESP-OPID ' X140-RESP-OPID CL**9 01036 DTSZX550 01037 *& DTSZX550 01038 * DISPLAY 'BX420 P1200H: ' X140-REC. CL*30 01039 P1200H-EXIT. DTSZX550 01040 EXIT. DTSZX550 01041 DTSZX550 01042 P1200I-WAGE. DTSZX550 01043 MOVE WEB-IMP-REC TO W144-REC. CL*50 01044 CL*50 01045 * DISPLAY 'WEB-REC-WORK: ' W144-REC. CL*55 01046 MOVE W144-REC-TYPE TO X144-REC-TYPE. CL*50 01047 DTSZX550 01048 MOVE W144-EMP-NO TO X144-EMP-NO. CL*50 01049 DTSZX550 01050 DTSZX550 01051 MOVE '/' TO W144-QUARTER-SLASH. CL*50 01052 MOVE W144-QUARTER TO X144-QUARTER. CL*50 01053 DTSZX550 01054 MOVE W144-SSN TO X144-SSN. CL*50 01055 DTSZX550 01056 MOVE '5' TO X144-WAGE-STATUS. DTSZX550 01057 DTSZX550 01058 MOVE W144-LAST-NAME TO X144-LAST-NAME. CL*50 01059 DTSZX550 01060 MOVE W144-FIRST-NAME TO X144-FIRST-NAME. CL*50 01061 DTSZX550 01062 MOVE W144-MID-INIT TO X144-MID-INIT. CL*50 01063 DTSZX550 01064 MOVE W144-EARNINGS TO X144-EARNINGS. CL*50 01065 DTSZX550 01066 * DISPLAY 'W144REC: ' X144-REC. CL*55 01067 P1200I-EXIT. DTSZX550 01068 EXIT. DTSZX550 01069 DTSZX550 01070 P1200J-PAY. DTSZX550 01071 MOVE L205-TEXT (1) (1:03) TO X145-REC-TYPE. DTSZX550 01072 DTSZX550 01073 MOVE L205-TEXT (2) (1:06) TO X145-EMP-NO. DTSZX550 01074 DTSZX550 01075 MOVE '0' TO X145-SOURCE. DTSZX550 01076 DTSZX550 01077 MOVE L205-TEXT (3) (1:06) TO X145-QTR. DTSZX550 01078 DISPLAY 'X145 QTR ' X145-QTR. CL*56 01079 DTSZX550 01080 MOVE L205-TEXT (8) (1:02) TO X145-PAY-TYPE. DTSZX550 01081 * DISPLAY 'X145 PAY TYPE ' X145-PAY-TYPE. CL**9 01082 DTSZX550 01083 MOVE L205-INTEGER (9) TO W-INTEGER. DTSZX550 01084 MOVE L205-FRACTION (9) TO W-FRACTION. DTSZX550 01085 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSZX550 01086 MOVE W-NUMBER TO X145-REMITTANCE. DTSZX550 01087 * DISPLAY 'X145 PAY AMT ' X145-REMITTANCE. CL**9 01088 DTSZX550 01089 MOVE L205-TEXT (10) (1:10) TO X145-RCVD-DATE. DTSZX550 01090 * DISPLAY 'X145 PAY DATE ' X145-RCVD-DATE. CL**9 01091 DTSZX550 01092 MOVE L205-TEXT (12) TO W-TRACE-B. DTSZX550 01093 MOVE W-TRACE-9 TO X145-TRACE-NO. DTSZX550 01094 * DISPLAY 'X145 PAY NO ' X145-TRACE-NO. CL**9 01095 DTSZX550 01096 DTSZX550 01097 MOVE ZEROS TO X145-PSEUDO-BATCH. DTSZX550 01098 DTSZX550 01099 MOVE ZEROS TO X145-PSEUDO-ITEM. DTSZX550 01100 DTSZX550 01101 MOVE SPACES TO X145-APPLIC-ACCT. DTSZX550 01102 DTSZX550 01103 MOVE SPACES TO X145-CHECK-SCAN-DT. DTSZX550 01104 DTSZX550 01105 MOVE ZEROS TO X145-CHECK-SEQ-NBR. DTSZX550 01106 DTSZX550 01107 MOVE 'N' TO X145-WAIVE-INTEREST. DTSZX550 01108 DTSZX550 01109 MOVE 'N' TO X145-WAIVE-PENALTY. DTSZX550 01110 DTSZX550 01111 MOVE 'VOL' TO X145-RESP-ACTIVITY. DTSZX550 01112 DTSZX550 01113 MOVE 'WEBESSP ' TO X145-RESP-OPID. DTSZX550 01114 DTSZX550 01115 P1200J-EXIT. DTSZX550 01116 EXIT. DTSZX550 01117 DTSZX550 01118 P1200X-AWAGE. CL*86 01119 MOVE WEB-IMP-REC TO W144-REC. CL*85 01120 CL*85 01121 * DISPLAY 'WEB-REC-WORK: ' W144-REC. CL*85 01122 MOVE W144-REC-TYPE TO X147-REC-TYPE. CL*85 01123 CL*85 01124 MOVE W144-EMP-NO TO X147-EMP-NO. CL*85 01125 CL*85 01126 CL*85 01127 MOVE '/' TO W144-QUARTER-SLASH. CL*87 01128 MOVE W144-QUARTER TO X147-QUARTER. CL*85 01129 CL*85 01130 MOVE W144-SSN TO X147-SSN. CL*85 01131 CL*85 01132 MOVE '5' TO X147-WAGE-STATUS. CL*85 01133 CL*85 01134 MOVE W144-LAST-NAME TO X147-LAST-NAME. CL*85 01135 CL*85 01136 MOVE W144-FIRST-NAME TO X147-FIRST-NAME. CL*85 01137 CL*85 01138 MOVE W144-MID-INIT TO X147-MID-INIT. CL*85 01139 CL*85 01140 MOVE W144-EARNINGS TO X147-EARNINGS. CL*85 01141 CL*85 01142 * DISPLAY 'W144REC: ' X144-REC. CL*85 01143 P1200X-EXIT. CL*86 01144 EXIT. CL*85 01145 CL*85 01146 P2000-POST-SORT. DTSZX550 01147 SET SORT-OK-88 TO TRUE. DTSZX550 01148 DTSZX550 01149 DISPLAY 'P2000 BEG READING SORT-FILE ' SORT-EMP-NO. CL**7 01150 PERFORM P2100-PROCESS-SORT THRU P2100-EXIT DTSZX550 01151 UNTIL SORT-EOF-88. DTSZX550 01152 DTSZX550 01153 * SET LX42-TERMINATE-88 TO TRUE CL**9 01154 * DISPLAY 'BX420 P2000 END READING SORT-FILE ' SORT-EMP-NO. CL**9 01155 DISPLAY 'BX420 P2000 END READING SORT-FILE ' SORT-KEY ' ' CL**9 01156 SORT-DATA (1:14). CL**7 01157 P2000-EXIT. DTSZX550 01158 EXIT. DTSZX550 01159 DTSZX550 01160 P2100-PROCESS-SORT. DTSZX550 01161 * DISPLAY 'BX420 P2100 FIRST SORT-EMP-NO ' SORT-EMP-NO CL*38 01162 * ' ' SORT-DATA (1:14). CL*38 01163 RETURN SORT-FILE DTSZX550 01164 AT END DTSZX550 01165 SET SORT-EOF-88 TO TRUE DTSZX550 01166 GO TO P2100-EXIT DTSZX550 01167 END-RETURN. DTSZX550 01168 DTSZX550 01169 DISPLAY 'BX420 P2100 SORT-REC ' SORT-KEY ' ' CL*21 01170 SORT-DATA (1:14). CL*21 01171 DTSZX550 01172 MOVE SORT-DATA TO LX42-DATA-AREA. DTSZX550 01173 IF SORT-EMP-NO = 999999 DTSZX550 01174 IF SORT-BATCH = W-PSEUDO-BATCH-NO DTSZX550 01175 * DISPLAY 'BX420 NEW BATCH 999999 PROCESS' CL*53 01176 SET LX42-PROCESS-88 TO TRUE DTSZX550 01177 PERFORM P3000-PROCESS THRU P3000-EXIT DTSZX550 01178 ELSE DTSZX550 01179 MOVE SORT-BATCH TO W-PSEUDO-BATCH-NO DTSZX550 01180 * DISPLAY 'BX420 NEW BATCH ' CL*53 01181 ** PERFORM P2120-NEW-BATCH THRU P2120-EXIT DTSZX550 01182 SET LX42-PROCESS-88 TO TRUE DTSZX550 01183 SET LX42-ERROR-NO-88 TO TRUE DTSZX550 01184 SET LX42-RPT-ERROR-NO-88 TO TRUE CL*29 01185 ** DISPLAY 'BX420 NEW BATCH 888888 PROCESS' CL*13 01186 PERFORM P3000-PROCESS THRU P3000-EXIT DTSZX550 01187 END-IF DTSZX550 01188 ELSE CL*19 01189 IF SORT-EMP-NO = W-EMP-NO AND SORT-PAY-QTR = W-PAY-QTR CL*57 01190 * DISPLAY 'BX420 SORT-EMP-NO = W-EMP-NO ' CL*53 01191 SET LX42-PROCESS-88 TO TRUE DTSZX550 01192 PERFORM P3000-PROCESS THRU P3000-EXIT DTSZX550 01193 ELSE DTSZX550 01194 * DISPLAY 'BX420 SORT-EMP-NO < W-EMP-NO ' CL*53 01195 MOVE SORT-EMP-NO TO W-EMP-NO DTSZX550 01196 MOVE SORT-PAY-QTR TO W-PAY-QTR CL*57 01197 PERFORM P2110-NEW-EMP THRU P2110-EXIT DTSZX550 01198 SET LX42-PROCESS-88 TO TRUE DTSZX550 01199 SET LX42-ERROR-NO-88 TO TRUE DTSZX550 01200 SET LX42-RPT-ERROR-NO-88 TO TRUE CL*29 01201 PERFORM P3000-PROCESS THRU P3000-EXIT DTSZX550 01202 END-IF DTSZX550 01203 END-IF. DTSZX550 01204 DTSZX550 01205 P2100-EXIT. DTSZX550 01206 EXIT. DTSZX550 01207 DTSZX550 01208 P2110-NEW-EMP. DTSZX550 01209 DTSZX550 01210 DISPLAY 'BX420 >>>>>>>> NEW-EMP ' LX42-DATA-AREA (1:20). CL*11 01211 DTSZX550 01212 SET LX42-NEW-EMPLOYER-88 TO TRUE. DTSZX550 01213 MOVE ZERO TO LX42-LAST-DETERM-EMP. DTSZX550 01214 DTSZX550 01215 * PERFORM S421-REGISTRATION THRU S421-EXIT. CL*63 01216 PERFORM S422-REPORT-PAYMT THRU S422-EXIT. CL*23 01217 * PERFORM S423-REPORT-WAGE THRU S423-EXIT. CL*59 01218 * PERFORM S424-PROFILE THRU S424-EXIT. CL*63 01219 DTSZX550 01220 P2110-EXIT. DTSZX550 01221 EXIT. DTSZX550 01222 DTSZX550 01223 P2120-NEW-BATCH. DTSZX550 01224 *& DTSZX550 01225 * DISPLAY 'BX420 P2120 NEW BATCH ' LX42-PSEUDO-BATCH-NO DTSZX550 01226 * ' ' LX42-DATA-AREA (1:20). DTSZX550 01227 *& DTSZX550 01228 SET LX42-NEW-BATCH-88 TO TRUE. DTSZX550 01229 DTSZX550 01230 * PERFORM S426-HEADER THRU S426-EXIT. DTSZX550 01231 * IF LX42-BATCH-ERR-YES-88 DTSZX550 01232 * SET LX42-BATCH-ERROR-88 TO TRUE DTSZX550 01233 * END-IF. DTSZX550 01234 PERFORM S422-REPORT-PAYMT THRU S422-EXIT. CL*23 01235 * PERFORM S423-PAYMENT THRU S423-EXIT. CL*23 01236 DTSZX550 01237 MOVE W-PSEUDO-BATCH-NO TO LX42-PSEUDO-BATCH-NO. DTSZX550 01238 MOVE ZERO TO LX42-RPT-CNT DTSZX550 01239 LX42-RPT-REMIT-AMT DTSZX550 01240 LX42-PAY-CNT DTSZX550 01241 LX42-PAY-REMIT-AMT. DTSZX550 01242 SET LX42-BATCH-ERR-NO-88 TO TRUE. DTSZX550 01243 DTSZX550 01244 P2120-EXIT. DTSZX550 01245 EXIT. DTSZX550 01246 DTSZX550 01247 P3000-PROCESS. DTSZX550 01248 *& DTSZX550 01249 *& DTSZX550 01250 **************************************************************** DTSZX550 01251 * LX42-LAST-DETERM-EMP IS SET WHEN PROCESSING A DETERMINATION. DTSZX550 01252 * THE EMPLOYER ACCOUNT NUMBER IS PASSED THROUGH THIS FIELD DTSZX550 01253 * TO DTSBX422, WHICH PROCESSES REPORTS. IT IS USED DTSZX550 01254 * TO DETERMINE WHEN TO WAIVE P & I. THE WAIVER IS AUTOMATIC DTSZX550 01255 * FOR REPORTS WITHIN THE LAST 5 QUARTERS SUBMITTED ALONG DTSZX550 01256 * WITH A WEB REGISTRATION. DTSZX550 01257 **************************************************************** DTSZX550 01258 DTSZX550 01259 EVALUATE TRUE DTSZX550 01260 DTSZX550 01261 WHEN LX42-REC-TYPE-RPT-88 DTSZX550 01262 ADD +1 TO W-140-IMP-CNT CL*38 01263 PERFORM S422-REPORT-PAYMT THRU S422-EXIT CL*23 01264 CL**9 01265 WHEN LX42-REC-TYPE-WAGE-88 DTSZX550 01266 ADD +1 TO W-144-IMP-CNT CL*38 01267 PERFORM S422-REPORT-PAYMT THRU S422-EXIT CL*59 01268 DTSZX550 01269 WHEN LX42-REC-TYPE-AWAGE-88 CL*85 01270 ADD +1 TO W-147-IMP-CNT CL*85 01271 PERFORM S422-REPORT-PAYMT THRU S422-EXIT CL*85 01272 CL*85 01273 WHEN LX42-REC-TYPE-PAY-88 DTSZX550 01274 ADD +1 TO W-145-IMP-CNT CL*38 01275 PERFORM S422-REPORT-PAYMT THRU S422-EXIT CL*23 01276 DTSZX550 01277 END-EVALUATE. DTSZX550 01278 DTSZX550 01279 P3000-EXIT. DTSZX550 01280 EXIT. DTSZX550 01281 DTSZX550 01282 P3100-BATCH-NO. DTSZX550 01283 *& IF W-PSEUDO-ITEM-NO < 999 DTSZX550 01284 * ADD 1 TO W-PSEUDO-ITEM-NO DTSZX550 01285 * ELSE DTSZX550 01286 * ADD 1 TO W-PSEUDO-BATCH-NO DTSZX550 01287 * MOVE 1 TO W-PSEUDO-ITEM-NO DTSZX550 01288 * END-IF. DTSZX550 01289 * DTSZX550 01290 * MOVE W-PSEUDO-BATCH-NO TO LX42-PSEUDO-BATCH-NO. DTSZX550 01291 *& MOVE W-PSEUDO-ITEM-NO TO LX42-PSEUDO-ITEM-NO. DTSZX550 01292 DTSZX550 01293 P3100-EXIT. DTSZX550 01294 EXIT. DTSZX550 01295 DTSZX550 01296 DTSZX550 01297 T0000-TERMINATE. DTSZX550 01298 PERFORM T1000-FINAL-CALLS THRU T1000-EXIT. DTSZX550 01299 DTSZX550 01300 *** PERFORM T1100-UPDATE-CURR-BATCH THRU T1100-EXIT. DTSZX550 01301 DTSZX550 01302 DISPLAY ' '. DTSZX550 01303 DTSZX550 01304 DISPLAY '*** DTSBX450 TERMINATION AMENDED RPTS *'. CL*64 01305 DTSZX550 01306 DISPLAY '***************************************'. CL*30 01307 DISPLAY '*** WEB/ESSP IMPORT DRIVER COUNTS ***'. CL*38 01308 DISPLAY '*** ***'. CL*30 01309 DISPLAY 'TOTAL INPUT RECORDS READ: ' W-WEB-IMP-CNT. CL*38 01310 DISPLAY ' X140 RECORDS READ: ' W-140-IMP-CNT. CL*38 01311 DISPLAY ' X144 RECORDS READ: ' W-144-IMP-CNT. CL*38 01312 DISPLAY ' X145 RECORDS READ: ' W-145-IMP-CNT. CL*38 01313 DISPLAY ' X147 RECORDS READ: ' W-147-IMP-CNT. CL*63 01314 DISPLAY ' ' CL*38 01315 DISPLAY '*** ***'. CL*30 01316 DISPLAY '*********** END OF RUN ****************'. CL*38 01317 DTSZX550 01318 CLOSE WEB-IMP-FILE. DTSZX550 01319 *** CURR-BATCH-NO. DTSZX550 01320 *** TEMP-BTC-FILE. DTSZX550 01321 DTSZX550 01322 PERFORM S910-CLOSE THRU S910-EXIT. DTSZX550 01323 PERFORM S921-CLOSE THRU S921-EXIT. DTSZX550 01324 PERFORM S923-CLOSE THRU S923-EXIT. DTSZX550 01325 PERFORM S931-CLOSE THRU S931-EXIT. DTSZX550 01326 * PERFORM S927C-CLOSE THRU S927C-EXIT. CL*44 01327 DTSZX550 01328 T0000-EXIT. DTSZX550 01329 EXIT. DTSZX550 01330 DTSZX550 01331 T1000-FINAL-CALLS. DTSZX550 01332 *& DTSZX550 01333 DISPLAY 'BX420 T1000 ' LX42-DATA-AREA (1:20). CL**7 01334 *& DTSZX550 01335 SET LX42-TERMINATE-88 TO TRUE. DTSZX550 01336 MOVE LOW-VALUES TO LX42-DATA-AREA. DTSZX550 01337 DTSZX550 01338 PERFORM S422-REPORT-PAYMT THRU S422-EXIT. CL*23 01339 * PERFORM S423-REPORT-WAGE THRU S423-EXIT. CL*59 01340 DTSZX550 01341 T1000-EXIT. DTSZX550 01342 EXIT. DTSZX550 01343 DTSZX550 01344 DTSZX550 01345 S001-FROM-FED-8. DTSZX550 01346 SET L001-FROM-FED-8 TO TRUE. DTSZX550 01347 GO TO S001-DATE. DTSZX550 01348 DTSZX550 01349 S001-FROM-CAL-8. DTSZX550 01350 SET L001-FROM-CAL-8 TO TRUE. DTSZX550 01351 GO TO S001-DATE. DTSZX550 01352 DTSZX550 01353 S001-FROM-ABS-DAY. DTSZX550 01354 SET L001-FROM-ABS-DAY TO TRUE. DTSZX550 01355 GO TO S001-DATE. DTSZX550 01356 DTSZX550 01357 S001-DATE. DTSZX550 01358 CALL 'DTSBU001' USING L001-LINK-AREA. DTSZX550 01359 S001-EXIT. DTSZX550 01360 EXIT. DTSZX550 01361 DTSZX550 01362 S003-AGENCY-DAY. DTSZX550 01363 SET L003-AGENCY-DAY TO TRUE. DTSZX550 01364 GO TO S003-WORK-DAY. DTSZX550 01365 DTSZX550 01366 S003-WORK-DAY. DTSZX550 01367 CALL 'DTSBU003' USING L003-LINK-AREA. DTSZX550 01368 S003-EXIT. DTSZX550 01369 EXIT. DTSZX550 01370 DTSZX550 01371 S004-FROM-5. DTSZX550 01372 SET L004-FROM-5 TO TRUE. DTSZX550 01373 GO TO S004-YRQ. DTSZX550 01374 DTSZX550 01375 S004-FROM-DATE. DTSZX550 01376 SET L004-FROM-DATE TO TRUE. DTSZX550 01377 GO TO S004-YRQ. DTSZX550 01378 DTSZX550 01379 S004-FROM-ABS. DTSZX550 01380 SET L004-FROM-ABS TO TRUE. DTSZX550 01381 GO TO S004-YRQ. DTSZX550 01382 DTSZX550 01383 S004-YRQ. DTSZX550 01384 CALL 'DTSBU004' USING L004-LINK-AREA. DTSZX550 01385 DTSZX550 01386 S004-EXIT. DTSZX550 01387 EXIT. DTSZX550 01388 DTSZX550 01389 S005-FROM-SYS. DTSZX550 01390 SET L005-FROM-SYS TO TRUE. DTSZX550 01391 GO TO S005-ABSTIME. DTSZX550 01392 DTSZX550 01393 S005-ABSTIME. DTSZX550 01394 CALL 'DTSBU005' USING L005-LINK-AREA. DTSZX550 01395 S005-EXIT. DTSZX550 01396 EXIT. DTSZX550 01397 DTSZX550 01398 DTSZX550 01399 S422-REPORT-PAYMT. CL*23 01400 * DISPLAY 'CALL S422-REPORTS- WAGES AND PAYMENTS'. CL*88 01401 CALL 'DTSZX551' USING LX42-LINK-AREA. CL*92 01402 S422-EXIT. DTSZX550 01403 EXIT. DTSZX550 01404 DTSZX550 01405 *S423-REPORT-WAGE. CL*59 01406 * DISPLAY 'CALL S423-RPT-WAGES'. CL*59 01407 * CALL 'DTSBX423' USING LX42-LINK-AREA. CL*59 01408 *S423-EXIT. CL*59 01409 * EXIT. CL*59 01410 DTSZX550 01411 DTSZX550 01412 S426-HEADER. DTSZX550 01413 CALL 'DTSBX426' USING LX42-LINK-AREA. DTSZX550 01414 S426-EXIT. DTSZX550 01415 EXIT. DTSZX550 01416 DTSZX550 01417 DTSZX550 01418 S910-OPEN-READ. DTSZX550 01419 SET L910-OPEN-READ-88 TO TRUE. DTSZX550 01420 GO TO S910-MSTR-IO. DTSZX550 01421 DTSZX550 01422 S910-OPEN-UPDATE. DTSZX550 01423 SET L910-OPEN-UPDATE-88 TO TRUE. DTSZX550 01424 GO TO S910-MSTR-IO. DTSZX550 01425 DTSZX550 01426 S910-READ. DTSZX550 01427 SET L910-READ-88 TO TRUE. DTSZX550 01428 GO TO S910-MSTR-IO. DTSZX550 01429 DTSZX550 01430 S910-START-BROWSE. DTSZX550 01431 SET L910-START-BROWSE-88 TO TRUE. DTSZX550 01432 GO TO S910-MSTR-IO. DTSZX550 01433 DTSZX550 01434 S910-READ-NEXT. DTSZX550 01435 SET L910-READ-NEXT-88 TO TRUE. DTSZX550 01436 GO TO S910-MSTR-IO. DTSZX550 01437 DTSZX550 01438 S910-CLOSE. DTSZX550 01439 SET L910-CLOSE-88 TO TRUE. DTSZX550 01440 GO TO S910-MSTR-IO. DTSZX550 01441 DTSZX550 01442 S910-MSTR-IO. DTSZX550 01443 CALL 'DTSBU910' USING L910-LINK-AREA DTSZX550 01444 MSKL-REC. DTSZX550 01445 S910-EXIT. DTSZX550 01446 EXIT. DTSZX550 01447 DTSZX550 01448 S921-OPEN-READ. DTSZX550 01449 SET L921-OPEN-READ-88 TO TRUE. DTSZX550 01450 GO TO S921-AIX-IO. DTSZX550 01451 DTSZX550 01452 S921-READ. DTSZX550 01453 SET L921-READ-88 TO TRUE. DTSZX550 01454 GO TO S921-AIX-IO. DTSZX550 01455 DTSZX550 01456 S921-START-BROWSE. DTSZX550 01457 SET L921-START-BROWSE-88 TO TRUE. DTSZX550 01458 GO TO S921-AIX-IO. DTSZX550 01459 DTSZX550 01460 S921-READ-NEXT. DTSZX550 01461 SET L921-READ-NEXT-88 TO TRUE. DTSZX550 01462 GO TO S921-AIX-IO. DTSZX550 01463 DTSZX550 01464 S921-CLOSE. DTSZX550 01465 SET L921-CLOSE-88 TO TRUE. DTSZX550 01466 GO TO S921-AIX-IO. DTSZX550 01467 DTSZX550 01468 S921-AIX-IO. DTSZX550 01469 CALL 'DTSBU921' USING L921-LINK-AREA DTSZX550 01470 ISKL-REC. DTSZX550 01471 S921-EXIT. DTSZX550 01472 EXIT. DTSZX550 01473 DTSZX550 01474 S923-OPEN-UPDATE. DTSZX550 01475 SET L923-OPEN-UPDATE-88 TO TRUE. DTSZX550 01476 GO TO S923-ATC-CALL. DTSZX550 01477 DTSZX550 01478 S923-OPEN-READ. DTSZX550 01479 SET L923-OPEN-READ-88 TO TRUE. DTSZX550 01480 GO TO S923-ATC-CALL. DTSZX550 01481 DTSZX550 01482 S923-WRITE. DTSZX550 01483 SET L923-WRITE-88 TO TRUE. DTSZX550 01484 GO TO S923-ATC-CALL. DTSZX550 01485 DTSZX550 01486 S923-CLOSE. DTSZX550 01487 SET L923-CLOSE-88 TO TRUE. DTSZX550 01488 GO TO S923-ATC-CALL. DTSZX550 01489 DTSZX550 01490 S923-ATC-CALL. DTSZX550 01491 CALL 'DTSBU923' USING L923-LINK-AREA DTSZX550 01492 ASKL-REC. DTSZX550 01493 S923-EXIT. DTSZX550 01494 EXIT. DTSZX550 01495 DTSZX550 01496 S927A-OPEN. DTSZX550 01497 SET L927-OPEN-UPDATE-88 TO TRUE. DTSZX550 01498 PERFORM S927Z-IO THRU S927Z-EXIT. DTSZX550 01499 DTSZX550 01500 S927A-EXIT. DTSZX550 01501 EXIT. DTSZX550 01502 DTSZX550 01503 S927C-CLOSE. DTSZX550 01504 SET L927-CLOSE-88 TO TRUE. DTSZX550 01505 PERFORM S927Z-IO THRU S927Z-EXIT. DTSZX550 01506 DTSZX550 01507 S927C-EXIT. DTSZX550 01508 EXIT. DTSZX550 01509 DTSZX550 01510 S927Z-IO. DTSZX550 01511 CALL 'DTSBU927' USING L927-LINK-AREA DTSZX550 01512 TSKL-REC. DTSZX550 01513 S927Z-EXIT. DTSZX550 01514 EXIT. DTSZX550 01515 DTSZX550 01516 S931-OPEN-READ. DTSZX550 01517 SET L931-OPEN-READ-88 TO TRUE. DTSZX550 01518 GO TO S931-REF-IO. DTSZX550 01519 DTSZX550 01520 S931-CLOSE. DTSZX550 01521 SET L931-CLOSE-88 TO TRUE. DTSZX550 01522 GO TO S931-REF-IO. DTSZX550 01523 DTSZX550 01524 S931-REF-IO. DTSZX550 01525 CALL 'DTSBU931' USING L931-LINK-AREA DTSZX550 01526 FSKL-REC. DTSZX550 01527 S931-EXIT. DTSZX550 01528 EXIT. DTSZX550 01529 DTSZX550 01530 S1000-READ-WEB-IMP. DTSZX550 01531 READ WEB-IMP-FILE. DTSZX550 01532 IF WEB-IMP-STATUS-OK-88 DTSZX550 01533 ADD +1 TO W-WEB-IMP-CNT DTSZX550 01534 ELSE DTSZX550 01535 IF WEB-IMP-STATUS-EOF-88 DTSZX550 01536 DISPLAY 'ENE OF WEB-IMP-FILE ' WEB-IMP-STATUS CL**3 01537 ELSE DTSZX550 01538 DISPLAY 'CANNOT READ WEB-IMP-FILE ' WEB-IMP-STATUS DTSZX550 01539 SET W-ERROR-YES-88 TO TRUE DTSZX550 01540 END-IF DTSZX550 01541 END-IF. DTSZX550 01542 DTSZX550 01543 * DISPLAY 'S1000-READ WEB ' WEB-IMP-TYPE ' ' WEB-IMP-EMP-NO. CL*12 01544 DTSZX550 01545 S1000-EXIT. DTSZX550 01546 EXIT. DTSZX550 01547 DTSZX550 01548 S999-ABEND. DTSZX550 01549 CALL 'DTSBU999' USING W-ABEND-CD. DTSZX550 01550 S999-EXIT. DTSZX550 01551 EXIT. DTSZX550 01552 DTSZX550