Files
DUTAS/Batch/DTSZX550.cob

1554 lines
123 KiB
COBOL

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