00001 IDENTIFICATION DIVISION. 08/27/25 00002 PROGRAM-ID. DTSBX418. DTSBX418 00003 AUTHOR. NGC. LV052 00004 DATE-WRITTEN. APRIL 2005. DTSBX418 00005 DATE-COMPILED. DTSBX418 00006 SKIP3 DTSBX418 00007 ***** DTSBX418 00008 * DTSBX418 00009 * FUNCTION: WEB REGISTRATION IMPORT DRIVER DTSBX418 00010 * READ DATA PASSED FROM WEB APPLICATION SERVER DTSBX418 00011 * AND CALL THE APPROPRIATE PROCESSING PROGRAM DTSBX418 00012 * FOR REGISTRATIONS, REPORTS, PAYMENTS OR DTSBX418 00013 * PROFILE UPDATES. DTSBX418 00014 * DTSBX418 00015 * ACCOUNTING BATCH HEADERS, REPORTS AND PAYMENTS DTSBX418 00016 * COMING FROM THE IN-HOUSE CASHIERING PROCESS ARE DTSBX418 00017 * PROCESSED LAST. IN THE SORT KEY, THE FIRST DTSBX418 00018 * ELEMENT (USED FOR THE EMPLOYER NUMBER FOR OTHER DTSBX418 00019 * PROCESSES) IS SET TO 999999. DTSBX418 00020 * DTSBX418 00021 * MODIFICATION HISTORY: DTSBX418 00022 * DTSBX418 00023 * 07-23-2007 INITIAL DEVELOPMENT DTSBX418 00024 * REFERENCE RFP: WEB REPORTING DTSBX418 00025 * DTSBX418 00026 * 10-21-2008 MODIFIED FOR NEW VERSION OF DTSIX144. DTSBX418 00027 * THE NEW RECORD INCLUDES EMPLOYEE NAME. DTSBX418 00028 * REFERENCE RFP: WEB REPORTING DTSBX418 00029 * DTSBX418 00030 * 05-28-2010 MODIFIED FOR IN-HOUSE CHECK-SCANNING AND DTSBX418 00031 * CASHIERING PROCESS. DTSBX418 00032 * REFERENCE RFP: GD DTSBX418 00033 * DTSBX418 00034 * CL*23 00035 * 10-22-2014 MODIFIED FOR ESSP INTERFACE CL*23 00036 * CHANGED SORT SEQUENCE FOR PROCESS X104 RECORDS CL*23 00037 * BEFORE PROCESSING NAMES X106. CL*23 00038 * RECORDS 102 AND 106 MUST BE PRESENT TO ADD A CL*23 00039 * NEW EMPLOYER TO DUTAS. IF X102 AND X104 PASS CL*23 00040 * ALL EDITS THEN NAME RECORD X106 RATE X108 AND CL*23 00041 * ADDRESS X110 MUST BE PRESENT FOR EMPLOYER TO ADD CL*23 00042 * CL*23 00043 * REFERENCE RFP: ZL1 CL*23 00044 * CL*23 00045 * DTSBX418 00046 * 11-01-2014 MODIFIED FOR ESSP INTERFACE CL*23 00047 * MODIFIED PROGRAM TO CALL A NEW PROGRAM BX430 TO CL*23 00048 * PROCESS REPORTS,WAGES AND PAYMENTS. CL*23 00049 * REPORTS X140 COMING FROM ESSP CANNOT BE PROCESSED CL*23 00050 * UNTIL A PAYMENT X145 IS PRESENT UNLESS IT IS A CL*23 00051 * ZERO WAGE REPORT (REMIT AMT = 0). ALSO CHANGED CL*23 00052 * THE SORT SEQ TO SORT PAYMENT X145 BEFORE X140 CL*23 00053 * PREVIOUS SORT KEY WAS 30 NOW 19. CL*23 00054 * REFERENCE RFP: ZL1 CL*23 00055 * CL*23 00056 * CL*23 00057 * 11-24-2014 MODIFIED FOR ESSP INTERFACE CL*40 00058 * MODIFIED PROGRAM TO MOVE ESSP IMPORT RECORDS TYPE CL*40 00059 * X120 TO A WORKING COPY OF DUTAS X120 CL*40 00060 * FIELDS ON THE INPUT RECORD IS LARGER THAT DUTAS CL*40 00061 * FIELDS. WITH NO PHARSING FIELD LENGTHS ARE CL*40 00062 * THE EDITS TO FAILING. CL*40 00063 * REFERENCE RFP: ESSP REGISTRTION ZL1 CL*40 00064 * CL*40 00065 * CL*40 00066 ***** DTSBX418 00067 SKIP3 DTSBX418 00068 ENVIRONMENT DIVISION. DTSBX418 00069 SKIP2 DTSBX418 00070 INPUT-OUTPUT SECTION. DTSBX418 00071 DTSBX418 00072 FILE-CONTROL. DTSBX418 00073 DTSBX418 00074 SELECT WEB-IMP-FILE ASSIGN TO WEBREG DTSBX418 00075 FILE STATUS IS WEB-IMP-STATUS. DTSBX418 00076 DTSBX418 00077 ** SELECT CURR-BATCH-NO ASSIGN TO CURRBTCH DTSBX418 00078 ** FILE STATUS IS BATCH-STATUS. DTSBX418 00079 DTSBX418 00080 SELECT SORT-FILE ASSIGN TO SORTFILE. DTSBX418 00081 DTSBX418 00082 DATA DIVISION. DTSBX418 00083 DTSBX418 00084 FILE SECTION. DTSBX418 00085 DTSBX418 00086 FD WEB-IMP-FILE DTSBX418 00087 RECORDING MODE IS F DTSBX418 00088 BLOCK CONTAINS 0 RECORDS DTSBX418 00089 LABEL RECORDS ARE OMITTED. DTSBX418 00090 DTSBX418 00091 01 WEB-IMP-REC. DTSBX418 00092 05 WEB-IMP-TYPE PIC X(03). DTSBX418 00093 88 WEB-IMP-TYPE-PRF-88 VALUE '102'. DTSBX418 00094 88 WEB-IMP-TYPE-DETERM-88 VALUE '104'. DTSBX418 00095 88 WEB-IMP-TYPE-NAME-88 VALUE '106'. DTSBX418 00096 88 WEB-IMP-TYPE-RATE-88 VALUE '108'. DTSBX418 00097 88 WEB-IMP-TYPE-ADDR-88 VALUE '110'. DTSBX418 00098 88 WEB-IMP-TYPE-OPO-88 VALUE '120'. DTSBX418 00099 88 WEB-IMP-TYPE-REL-88 VALUE '130'. DTSBX418 00100 *** 88 WEB-IMP-TYPE-IND-88 VALUE '132'. DTSBX418 00101 88 WEB-IMP-TYPE-RPT-88 VALUE '140'. DTSBX418 00102 88 WEB-IMP-TYPE-WAGE-88 VALUE '144'. DTSBX418 00103 88 WEB-IMP-TYPE-PAY-88 VALUE '145'. DTSBX418 00104 88 WEB-IMP-TYPE-BHDR-88 VALUE '149'. DTSBX418 00105 88 WEB-TYPE-REG-88 VALUE '102' '104' '106' DTSBX418 00106 '108' '130' '132'. DTSBX418 00107 88 WEB-TYPE-RPT-88 VALUE '140' '144'. DTSBX418 00108 88 WEB-TYPE-PAY-88 VALUE '145'. DTSBX418 00109 88 WEB-TYPE-PRF-88 VALUE '110' '120'. DTSBX418 00110 05 FILLER PIC X(01). DTSBX418 00111 05 WEB-IMP-EMP-NO PIC 9(06). DTSBX418 00112 05 FILLER PIC X(01). DTSBX418 00113 05 WEB-IMP-QTR PIC X(06). DTSBX418 00114 05 FILLER PIC X(495). DTSBX418 00115 DTSBX418 00116 *FD CURR-BATCH-NO DTSBX418 00117 * RECORDING MODE IS F DTSBX418 00118 * BLOCK CONTAINS 0 RECORDS DTSBX418 00119 * LABEL RECORDS ARE OMITTED. DTSBX418 00120 * DTSBX418 00121 *01 CURR-BATCH-NO-REC. DTSBX418 00122 * 05 CURRENT-BATCH-NO PIC 9(05). DTSBX418 00123 * 05 CURRENT-ITEM-NO PIC 9(03). DTSBX418 00124 * 05 FILLER PIC X(01). DTSBX418 00125 * 05 CURRENT-ARCHIVE-YEAR PIC 9(04). DTSBX418 00126 * 05 FILLER PIC X(01). DTSBX418 00127 * 05 FIRST-ARCHIVE-YEAR PIC 9(04). DTSBX418 00128 * 05 FILLER PIC X(62). DTSBX418 00129 DTSBX418 00130 SD SORT-FILE. DTSBX418 00131 DTSBX418 00132 01 SORT-REC. DTSBX418 00133 05 SORT-KEY. DTSBX418 00134 10 SORT-EMP-NO PIC 9(06). DTSBX418 00135 10 SORT-SEQ1 PIC S9(04) COMP. DTSBX418 00136 10 SORT-SEQ2 PIC X(16). DTSBX418 00137 05 IN-HOUSE-SORT-KEY REDEFINES SORT-KEY. DTSBX418 00138 10 SORT-IN-HOUSE-SEQ PIC 9(06). DTSBX418 00139 10 SORT-BATCH PIC 9(05). DTSBX418 00140 10 SORT-ITEM PIC 9(03). DTSBX418 00141 10 SORT-FILLER PIC X(10). DTSBX418 00142 05 SORT-DATA PIC X(512). DTSBX418 00143 DTSBX418 00144 WORKING-STORAGE SECTION. DTSBX418 001445 77 PAN-VALET PICTURE X(24) VALUE '052DTSBX418 08/27/25'. DTSBX418 00145 77 PAN-VALET PICTURE X(24) VALUE '013DTSBX418 10/07/14'. CL*49 00146 77 PAN-VALET PICTURE X(24) VALUE '154DTSBX418 10/07/14'. CL*49 00147 SKIP3 DTSBX418 00148 01 WRK-AREA. DTSBX418 00149 05 W-ABEND-CD PIC S9(04) COMP VALUE 418. CL*49 00150 05 W-MOD-NAME PIC X(08) VALUE 'DTSBX418'. CL*49 00151 DTSBX418 00152 05 WEB-IMP-STATUS PIC X(02). DTSBX418 00153 88 WEB-IMP-STATUS-OK-88 VALUE '00'. DTSBX418 00154 88 WEB-IMP-STATUS-EOF-88 VALUE '10'. DTSBX418 00155 DTSBX418 00156 ** 05 BATCH-STATUS PIC X(02). DTSBX418 00157 * 88 BATCH-STATUS-OK-88 VALUE '00'. DTSBX418 00158 ** 88 BATCH-STATUS-EOF-88 VALUE '10'. DTSBX418 00159 DTSBX418 00160 05 SORT-EOF-IND PIC X(01). DTSBX418 00161 88 SORT-OK-88 VALUE '0'. DTSBX418 00162 88 SORT-EOF-88 VALUE '1'. DTSBX418 00163 DTSBX418 00164 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBX418 00165 88 W-ERROR-YES-88 VALUE 'Y'. DTSBX418 00166 88 W-ERROR-NO-88 VALUE 'N'. DTSBX418 00167 DTSBX418 00168 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSBX418 00169 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSBX418 00170 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSBX418 00171 DTSBX418 00172 05 W-EMP-NO PIC 9(07) VALUE ZERO. DTSBX418 00173 05 W-PSEUDO-BATCH-NO PIC 9(05) VALUE ZERO. DTSBX418 00174 05 W-CURR-RUN-DATE PIC S9(09) COMP-3. DTSBX418 00175 05 W-LAST-RATE-YEAR PIC 9(04). DTSBX418 00176 05 X102-KEY-AREA PIC X(06) VALUE SPACES. CL*15 00177 DTSBX418 00178 05 SUB PIC S9(04) COMP. DTSBX418 00179 ** 05 W-PSEUDO-BATCH-NO PIC 9(05) VALUE ZERO. DTSBX418 00180 * 05 FILLER REDEFINES W-PSEUDO-BATCH-NO. DTSBX418 00181 * 10 W-PSEUDO-DAYS PIC 9(03). DTSBX418 00182 ** 10 W-PSEUDO-BATCH-SEQ PIC 9(02). DTSBX418 00183 DTSBX418 00184 05 W-START-BATCH PIC 9(05) VALUE ZERO. DTSBX418 00185 05 W-END-BATCH PIC 9(05) VALUE ZERO. DTSBX418 00186 DTSBX418 00187 05 W-PSEUDO-ITEM-NO PIC 9(03) VALUE 0. DTSBX418 00188 DTSBX418 00189 05 W-500-DATE. DTSBX418 00190 10 W-500-DATE-MM PIC XX. DTSBX418 00191 10 FILLER PIC X. DTSBX418 00192 10 W-500-DATE-DD PIC XX. DTSBX418 00193 10 FILLER PIC X. DTSBX418 00194 10 W-500-DATE-YY PIC XXXX. DTSBX418 00195 DTSBX418 00196 05 W-500-FQTR. DTSBX418 00197 10 W-500-FQTR-YY PIC XXXX. DTSBX418 00198 10 FILLER PIC X VALUE '/'. DTSBX418 00199 10 W-500-FQTR-NO PIC X. DTSBX418 00200 DTSBX418 00201 05 W-INT-9 PIC 9(13). DTSBX418 00202 05 W-INT-X REDEFINES W-INT-9 DTSBX418 00203 PIC X(13). DTSBX418 00204 05 W-INTEGER PIC S9(11) COMP-3. DTSBX418 00205 05 W-FRACTION PIC SV9(11) COMP-3. DTSBX418 00206 05 W-NUMBER PIC S9(11)V9(05) COMP-3. DTSBX418 00207 DTSBX418 00208 ** 05 W-MULTIPLIER PIC S9(11)V99 COMP-3 DTSBX418 00209 * VALUE +0. DTSBX418 00210 * 05 W-DIGIT PIC 9. DTSBX418 00211 * 05 W-AMT PIC S9(09)V99 COMP-3 DTSBX418 00212 * VALUE +0. DTSBX418 00213 * DTSBX418 00214 * 05 W-DECIMAL-FOUND-IND PIC X(01) VALUE 'N'. DTSBX418 00215 * 88 W-DECIMAL-FOUND-YES-88 VALUE 'Y'. DTSBX418 00216 * 88 W-DECIMAL-FOUND-NO-88 VALUE 'N'. DTSBX418 00217 * DTSBX418 00218 * 05 W-WAGES PIC S9(11)V99. DTSBX418 00219 * 05 W-WAGES-X PIC X(14). DTSBX418 00220 * 05 W-WAGES-9 REDEFINES W-WAGES-X DTSBX418 00221 * PIC 9(11).99. DTSBX418 00222 * 05 W-REMIT-X PIC X(12). DTSBX418 00223 * 05 W-REMIT-9 REDEFINES W-REMIT-X DTSBX418 00224 * PIC 9(09).99. DTSBX418 00225 05 W-TRACE-X. DTSBX418 00226 10 W-TRACE-A PIC X(05) VALUE '00000'. DTSBX418 00227 10 W-TRACE-B PIC X(08) VALUE ZEROS. DTSBX418 00228 05 W-TRACE-9 REDEFINES W-TRACE-X DTSBX418 00229 PIC 9(13). DTSBX418 00230 * 05 W-COUNT-X PIC X(07). DTSBX418 00231 * 05 W-COUNT-9 REDEFINES W-COUNT-X DTSBX418 00232 * PIC 9(07). DTSBX418 00233 * 05 W-EARNINGS-X PIC X(12). DTSBX418 00234 * 05 W-EARNINGS-9 REDEFINES W-EARNINGS-X DTSBX418 00235 * PIC 9(09).99. DTSBX418 00236 * 05 W-EARNINGS PIC S9(07)V99. DTSBX418 00237 * 05 W-RATE PIC S9V9(04). DTSBX418 00238 * 05 W-RATE-X PIC X(06). DTSBX418 00239 * 05 W-RATE-9 REDEFINES W-RATE-X DTSBX418 00240 * PIC 9.9999. DTSBX418 00241 * DTSBX418 00242 * 05 ISUB1 PIC S9(04) COMP. DTSBX418 00243 * 05 ISUB2 PIC S9(04) COMP. DTSBX418 00244 * 05 ISUB3 PIC S9(04) COMP. DTSBX418 00245 * 05 ISUB4 PIC S9(04) COMP. DTSBX418 00246 * 05 ISUB5 PIC S9(04) COMP. DTSBX418 00247 * 05 ISUB6 PIC S9(04) COMP. DTSBX418 00248 * 05 W-SLASH1 PIC S9(04) COMP. DTSBX418 00249 * 05 W-SLASH2 PIC S9(04) COMP. DTSBX418 00250 * 05 W-CURR-FIELD PIC S9(04) COMP. DTSBX418 00251 * 05 W-LAST-FIELD PIC S9(04) COMP. DTSBX418 00252 * 05 W-LAST-FIELD-LEN PIC S9(04) COMP. DTSBX418 00253 * 05 W-INPUT-LENGTH PIC S9(04) COMP DTSBX418 00254 * VALUE +502. DTSBX418 00255 * 05 W-INPUT-LINE PIC X(500). DTSBX418 00256 * 05 W-PARSE-COMPLETE-IND PIC X(01). DTSBX418 00257 * 88 W-PARSE-COMPLETE-YES-88 VALUE 'Y'. DTSBX418 00258 * 88 W-PARSE-COMPLETE-NO-88 VALUE 'N'. DTSBX418 00259 * 05 W-FIELD-LENGTH PIC S9(04) COMP. DTSBX418 00260 * 05 W-CONV-LINE PIC X(32). DTSBX418 00261 * DTSBX418 00262 * 05 W-MDY PIC X(04). DTSBX418 00263 * 05 FILLER REDEFINES W-MDY. DTSBX418 00264 * 10 FILLER PIC X(02). DTSBX418 00265 * 10 W-MDY-X-2 PIC X(02). DTSBX418 00266 * 10 FILLER REDEFINES W-MDY-X-2. DTSBX418 00267 * 15 FILLER PIC X(01). DTSBX418 00268 ** 15 W-MDY-X-1 PIC X(01). DTSBX418 00269 DTSBX418 00270 05 W-WEB-IMP-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX418 00271 05 W-102-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 00272 05 W-104-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 00273 05 W-106-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 00274 05 W-108-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 00275 05 W-110-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 00276 05 W-120-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 00277 05 W-140-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 00278 05 W-144-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 00279 05 W-145-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 00280 DTSBX418 00281 05 W-WEB-IMP-LENGTH PIC S9(04) COMP. DTSBX418 00282 DTSBX418 00283 05 W-AMT-DISP1 PIC ----------9.99. DTSBX418 00284 05 W-AMT-DISP2 PIC ----------9.99. DTSBX418 00285 05 W-AMT-DISP4 PIC -.99999999999. DTSBX418 00286 05 W-AMT-DISP3 PIC ------------9. DTSBX418 00287 DTSBX418 00288 * PROFILE DTSBX418 00289 01 X102-REC. DTSBX418 00290 ++INCLUDE DTSIX102 DTSBX418 00291 DTSBX418 00292 * DETERMINATION DTSBX418 00293 01 X104-REC. DTSBX418 00294 ++INCLUDE DTSIX104 DTSBX418 00295 DTSBX418 00296 * NAME DTSBX418 00297 01 X106-REC. DTSBX418 00298 ++INCLUDE DTSIX106 DTSBX418 00299 DTSBX418 00300 * RATE DTSBX418 00301 01 X108-REC. DTSBX418 00302 ++INCLUDE DTSIX108 DTSBX418 00303 DTSBX418 00304 * ADDRESS DTSBX418 00305 01 X110-REC. DTSBX418 00306 ++INCLUDE DTSIX110 DTSBX418 00307 DTSBX418 00308 * OPO DTSBX418 00309 01 X120-REC. DTSBX418 00310 ++INCLUDE DTSIX120 DTSBX418 00311 DTSBX418 00312 * WORKING COPY OF X120 CL*41 00313 01 W120-REC. CL*41 00314 ++INCLUDE DTSWX120 CL*43 00315 CL*41 00316 * RELATIONSHIP DTSBX418 00317 01 X130-REC. DTSBX418 00318 ++INCLUDE DTSIX130 DTSBX418 00319 DTSBX418 00320 ** INDUSTRY DESCRIPTION DTSBX418 00321 *01 X132-REC. DTSBX418 00322 ***INCLUDE DTSIX132 DTSBX418 00323 DTSBX418 00324 * REPORT DTSBX418 00325 01 X140-REC. DTSBX418 00326 ++INCLUDE DTSIX140 DTSBX418 00327 DTSBX418 00328 * EMPLOYEE WAGES DTSBX418 00329 01 X144-REC. DTSBX418 00330 ++INCLUDE DTSIX144 DTSBX418 00331 DTSBX418 00332 * PAYMENT DTSBX418 00333 01 X145-REC. DTSBX418 00334 ++INCLUDE DTSIX145 DTSBX418 00335 DTSBX418 00336 01 X149-REC. DTSBX418 00337 ++INCLUDE DTSIX149 DTSBX418 00338 DTSBX418 00339 01 L001-LINK-AREA. DTSBX418 00340 ++INCLUDE DTSIL001 DTSBX418 00341 DTSBX418 00342 01 L003-LINK-AREA. DTSBX418 00343 ++INCLUDE DTSIL003 DTSBX418 00344 DTSBX418 00345 01 L004-LINK-AREA. DTSBX418 00346 ++INCLUDE DTSIL004 DTSBX418 00347 DTSBX418 00348 01 L005-LINK-AREA. DTSBX418 00349 ++INCLUDE DTSIL005 DTSBX418 00350 DTSBX418 00351 01 L205-LINK-AREA. DTSBX418 00352 ++INCLUDE DTSIL205 DTSBX418 00353 DTSBX418 00354 01 LX42-LINK-AREA. DTSBX418 00355 ++INCLUDE DTSILX42 CL*39 00356 DTSBX418 00357 01 L910-LINK-AREA. DTSBX418 00358 ++INCLUDE DTSIL910 DTSBX418 00359 01 MSKL-REC. DTSBX418 00360 ++INCLUDE DTSIMSKL DTSBX418 00361 DTSBX418 00362 01 MHDR-REC. DTSBX418 00363 ++INCLUDE DTSIMHDR DTSBX418 00364 DTSBX418 00365 01 MPRF-REC. DTSBX418 00366 ++INCLUDE DTSIMPRF DTSBX418 00367 DTSBX418 00368 01 MSOL-REC. DTSBX418 00369 ++INCLUDE DTSIMSOL DTSBX418 00370 DTSBX418 00371 01 MQTR-REC. DTSBX418 00372 ++INCLUDE DTSIMQTR DTSBX418 00373 DTSBX418 00374 01 MOPO-REC. DTSBX418 00375 ++INCLUDE DTSIMOPO DTSBX418 00376 DTSBX418 00377 01 MTAD-REC. DTSBX418 00378 ++INCLUDE DTSIMTAD DTSBX418 00379 DTSBX418 00380 01 MNTE-REC. DTSBX418 00381 ++INCLUDE DTSIMNTE DTSBX418 00382 DTSBX418 00383 01 L921-LINK-AREA. DTSBX418 00384 ++INCLUDE DTSIL921 DTSBX418 00385 SKIP3 DTSBX418 00386 01 ISKL-REC. DTSBX418 00387 ++INCLUDE DTSIISKL DTSBX418 00388 SKIP3 DTSBX418 00389 01 IEIN-REC. DTSBX418 00390 ++INCLUDE DTSIIEIN DTSBX418 00391 DTSBX418 00392 01 L923-LINK-AREA. DTSBX418 00393 ++INCLUDE DTSIL923 DTSBX418 00394 EJECT DTSBX418 00395 01 ASKL-REC. DTSBX418 00396 ++INCLUDE DTSIASKL DTSBX418 00397 EJECT DTSBX418 00398 01 AHDR-REC. DTSBX418 00399 ++INCLUDE DTSIAHDR DTSBX418 00400 DTSBX418 00401 01 ARPT-REC. DTSBX418 00402 ++INCLUDE DTSIARPT DTSBX418 00403 DTSBX418 00404 01 APAY-REC. DTSBX418 00405 ++INCLUDE DTSIAPAY DTSBX418 00406 DTSBX418 00407 DTSBX418 00408 01 L927-LINK-AREA. DTSBX418 00409 ++INCLUDE DTSIL927 DTSBX418 00410 DTSBX418 00411 01 TSKL-REC. DTSBX418 00412 ++INCLUDE DTSITSKL DTSBX418 00413 DTSBX418 00414 01 L931-LINK-AREA. DTSBX418 00415 ++INCLUDE DTSIL931 DTSBX418 00416 DTSBX418 00417 01 FSKL-REC. DTSBX418 00418 ++INCLUDE DTSIFSKL DTSBX418 00419 DTSBX418 00420 PROCEDURE DIVISION. DTSBX418 00421 DTSBX418 00422 DTSBX418-MAIN. CL*49 00423 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX418 00424 IF W-FATAL-ERROR-YES-88 DTSBX418 00425 GO TO DTSBX418-MAIN-EXIT CL*49 00426 END-IF. DTSBX418 00427 DTSBX418 00428 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBX418 00429 DTSBX418 00430 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX418 00431 IF W-ERROR-YES-88 DTSBX418 00432 MOVE +2 TO RETURN-CODE. DTSBX418 00433 DTSBX418-MAIN-EXIT. CL*49 00434 GOBACK. DTSBX418 00435 EJECT DTSBX418 00436 I0000-INITIATE. DTSBX418 00437 SET W-ERROR-NO-88 TO TRUE. DTSBX418 00438 SET W-FATAL-ERROR-NO-88 TO TRUE. DTSBX418 00439 DTSBX418 00440 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBX418 00441 DTSBX418 00442 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX418 00443 IF W-FATAL-ERROR-YES-88 DTSBX418 00444 GO TO I0000-EXIT DTSBX418 00445 END-IF. DTSBX418 00446 DTSBX418 00447 PERFORM I3000-READ-HEADER THRU I3000-EXIT. DTSBX418 00448 IF W-FATAL-ERROR-YES-88 DTSBX418 00449 GO TO I0000-EXIT DTSBX418 00450 END-IF. DTSBX418 00451 DTSBX418 00452 ** PERFORM I4000-CURRENT-BATCH THRU I4000-EXIT DTSBX418 00453 * IF W-FATAL-ERROR-YES-88 DTSBX418 00454 * GO TO I0000-EXIT DTSBX418 00455 ** END-IF. DTSBX418 00456 DTSBX418 00457 PERFORM I5000-INITIAL-CALLS THRU I5000-EXIT. DTSBX418 00458 DTSBX418 00459 I0000-EXIT. DTSBX418 00460 EXIT. DTSBX418 00461 DTSBX418 00462 I2000-OPEN-FILES. DTSBX418 00463 OPEN INPUT WEB-IMP-FILE. DTSBX418 00464 IF NOT WEB-IMP-STATUS-OK-88 DTSBX418 00465 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX418 00466 DISPLAY 'NO ESSP UPDATES FILE TO PROCESS' DTSBX418 00467 MOVE +3 TO RETURN-CODE DTSBX418 00468 SET W-ERROR-YES-88 TO TRUE DTSBX418 00469 DISPLAY 'CANNOT OPEN WEB-IMP-FILE ' DTSBX418 00470 WEB-IMP-STATUS DTSBX418 00471 GO TO I2000-EXIT DTSBX418 00472 END-IF. DTSBX418 00473 DTSBX418 00474 READ WEB-IMP-FILE. DTSBX418 00475 IF NOT WEB-IMP-STATUS-OK-88 DTSBX418 00476 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX418 00477 DISPLAY 'NO ESSP FTP UPDATE FILES TO PROCESS' DTSBX418 00478 MOVE +3 TO RETURN-CODE DTSBX418 00479 SET W-ERROR-YES-88 TO TRUE DTSBX418 00480 DISPLAY 'NO RECORDS ON WEB-IMP-FILE ' DTSBX418 00481 WEB-IMP-STATUS DTSBX418 00482 GO TO I2000-EXIT DTSBX418 00483 END-IF. DTSBX418 00484 CLOSE WEB-IMP-FILE. DTSBX418 00485 OPEN INPUT WEB-IMP-FILE. DTSBX418 00486 IF NOT WEB-IMP-STATUS-OK-88 DTSBX418 00487 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX418 00488 DISPLAY 'NO ESSP UPDATES FILE TO PROCESS' DTSBX418 00489 MOVE +3 TO RETURN-CODE DTSBX418 00490 SET W-ERROR-YES-88 TO TRUE DTSBX418 00491 DISPLAY 'CANNOT OPEN WEB-IMP-FILE ' DTSBX418 00492 WEB-IMP-STATUS DTSBX418 00493 GO TO I2000-EXIT DTSBX418 00494 END-IF. DTSBX418 00495 DTSBX418 00496 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBX418 00497 DTSBX418 00498 PERFORM S921-OPEN-READ THRU S921-EXIT. DTSBX418 00499 DTSBX418 00500 PERFORM S923-OPEN-READ THRU S923-EXIT. DTSBX418 00501 DTSBX418 00502 PERFORM S931-OPEN-READ THRU S931-EXIT. DTSBX418 00503 DTSBX418 00504 * MOVE 'N' TO L927-TRACE-IND. CL*44 00505 * MOVE W-MOD-NAME TO L927-MOD-NAME. CL*44 00506 * PERFORM S927A-OPEN THRU S927A-EXIT. CL*44 00507 DTSBX418 00508 I2000-EXIT. DTSBX418 00509 EXIT. DTSBX418 00510 DTSBX418 00511 I3000-READ-HEADER. DTSBX418 00512 MOVE LOW-VALUES TO MSKL-REC. DTSBX418 00513 MOVE +0 TO MSKL-EMP-NO. DTSBX418 00514 SET MSKL-HDR-88 TO TRUE. DTSBX418 00515 DTSBX418 00516 PERFORM S910-READ THRU S910-EXIT. DTSBX418 00517 IF L910-NO-REC-88 DTSBX418 00518 DISPLAY 'DTSBX418: MHDR RECORD IS MISSING' CL*49 00519 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX418 00520 MOVE +6 TO RETURN-CODE DTSBX418 00521 GO TO I3000-EXIT DTSBX418 00522 ELSE DTSBX418 00523 MOVE MSKL-REC TO MHDR-REC DTSBX418 00524 END-IF. DTSBX418 00525 DTSBX418 00526 MOVE MHDR-CURR-RUN-DATE TO W-CURR-RUN-DATE. DTSBX418 00527 DTSBX418 00528 MOVE MHDR-LAST-RATE-END-YRQ TO L004-QTR-5-9. DTSBX418 00529 MOVE L004-QTR-5-YR TO W-LAST-RATE-YEAR. DTSBX418 00530 DISPLAY 'LAST RATE YEAR ' W-LAST-RATE-YEAR. DTSBX418 00531 DTSBX418 00532 I3000-EXIT. DTSBX418 00533 EXIT. DTSBX418 00534 DTSBX418 00535 *I4000-CURRENT-BATCH. DTSBX418 00536 * OPEN I-O CURR-BATCH-NO. DTSBX418 00537 * IF NOT BATCH-STATUS-OK-88 DTSBX418 00538 * SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX418 00539 * DISPLAY 'CANNOT OPEN CURR BATCH NUMBER FILE ' DTSBX418 00540 * BATCH-STATUS DTSBX418 00541 * GO TO I4000-EXIT DTSBX418 00542 * END-IF. DTSBX418 00543 * DTSBX418 00544 * READ CURR-BATCH-NO DTSBX418 00545 * IF BATCH-STATUS-OK-88 DTSBX418 00546 * DISPLAY 'OLD BATCH ' CURRENT-BATCH-NO DTSBX418 00547 * COMPUTE W-PSEUDO-BATCH-NO = (CURRENT-BATCH-NO + 1) DTSBX418 00548 * MOVE W-PSEUDO-BATCH-NO TO W-START-BATCH DTSBX418 00549 * MOVE ZERO TO W-PSEUDO-ITEM-NO DTSBX418 00550 * DISPLAY 'CURRENT BATCH ' W-PSEUDO-BATCH-NO DTSBX418 00551 * DISPLAY 'CURRENT ITEM ' W-PSEUDO-ITEM-NO DTSBX418 00552 * ELSE DTSBX418 00553 * SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX418 00554 * DISPLAY 'CANNOT READ CURR BATCH NUMBER FILE ' DTSBX418 00555 * BATCH-STATUS DTSBX418 00556 * GO TO I4000-EXIT DTSBX418 00557 * END-IF. DTSBX418 00558 * DTSBX418 00559 *I4000-EXIT. DTSBX418 00560 * EXIT. DTSBX418 00561 DTSBX418 00562 I5000-INITIAL-CALLS. DTSBX418 00563 DISPLAY '!!!!! BX418- INITILIZE RECORDS START BX418' CL*49 00564 SET LX42-INITIALIZE-88 TO TRUE. DTSBX418 00565 MOVE W-CURR-RUN-DATE TO LX42-CURR-RUN-DATE. DTSBX418 00566 MOVE L005-DATE TO LX42-SYS-DATE. DTSBX418 00567 MOVE L005-TIME TO LX42-SYS-TIME. DTSBX418 00568 * MOVE ZERO TO LX42-BATCH-NO CL*52 00569 MOVE ZERO TO LX42-PSEUDO-BATCH-NO CL*52 00570 LX42-LAST-DETERM-EMP DTSBX418 00571 LX42-RPT-CNT DTSBX418 00572 LX42-RPT-REMIT-AMT DTSBX418 00573 LX42-PAY-CNT DTSBX418 00574 LX42-PAY-REMIT-AMT. DTSBX418 00575 SET LX42-BATCH-ERR-NO-88 TO TRUE. DTSBX418 00576 SET LX42-ERROR-NO-88 TO TRUE. DTSBX418 00577 SET LX42-RPT-ERROR-NO-88 TO TRUE CL*29 00578 MOVE LOW-VALUES TO LX42-DATA-AREA. DTSBX418 00579 DTSBX418 00580 MOVE ZERO TO W-102-IMP-CNT CL*38 00581 W-104-IMP-CNT CL*38 00582 W-106-IMP-CNT CL*38 00583 W-108-IMP-CNT CL*38 00584 W-110-IMP-CNT CL*38 00585 W-120-IMP-CNT CL*38 00586 W-140-IMP-CNT CL*38 00587 W-144-IMP-CNT CL*38 00588 W-145-IMP-CNT. CL*38 00589 * PERFORM S421-REGISTRATION THRU S421-EXIT. CL*45 00590 PERFORM S422-REPORT-PAYMT THRU S422-EXIT. CL*23 00591 * PERFORM S423-PAYMENT THRU S423-EXIT. CL*23 00592 * PERFORM S424-PROFILE THRU S424-EXIT. CL*45 00593 ** PERFORM S426-HEADER THRU S426-EXIT. DTSBX418 00594 DTSBX418 00595 I5000-EXIT. DTSBX418 00596 EXIT. DTSBX418 00597 DTSBX418 00598 DTSBX418 00599 P0000-PROCESS. DTSBX418 00600 DISPLAY '!!!! BX418- START WEB IMPORT PRELIMINARY EDIT'. CL*49 00601 DISPLAY SPACE. DTSBX418 00602 DTSBX418 00603 SET W-ERROR-NO-88 TO TRUE. DTSBX418 00604 DTSBX418 00605 SORT SORT-FILE DTSBX418 00606 ON ASCENDING KEY SORT-KEY DTSBX418 00607 INPUT PROCEDURE P1000-PRE-SORT THRU P1000-EXIT DTSBX418 00608 OUTPUT PROCEDURE P2000-POST-SORT THRU P2000-EXIT. DTSBX418 00609 DTSBX418 00610 IF SORT-RETURN NOT = +0 DTSBX418 00611 DISPLAY 'SORT FAILED ' SORT-RETURN DTSBX418 00612 END-IF. DTSBX418 00613 DTSBX418 00614 P0000-EXIT. DTSBX418 00615 EXIT. DTSBX418 00616 DTSBX418 00617 DTSBX418 00618 P1000-PRE-SORT. DTSBX418 00619 PERFORM S1000-READ-WEB-IMP THRU S1000-EXIT. DTSBX418 00620 PERFORM UNTIL WEB-IMP-STATUS-EOF-88 DTSBX418 00621 PERFORM P1100-PARSE-IMPORT-REC THRU P1100-EXIT DTSBX418 00622 PERFORM P1200-BUILD-SORT-REC THRU P1200-EXIT DTSBX418 00623 PERFORM S1000-READ-WEB-IMP THRU S1000-EXIT DTSBX418 00624 END-PERFORM. DTSBX418 00625 DTSBX418 00626 DISPLAY '!!!!! BX418- ENDOF INPUT SORT PROCEDURE ****'. CL*49 00627 P1000-EXIT. DTSBX418 00628 EXIT. DTSBX418 00629 DTSBX418 00630 P1100-PARSE-IMPORT-REC. DTSBX418 00631 IF WEB-IMP-TYPE-BHDR-88 DTSBX418 00632 DISPLAY 'BX418 P1000 HDR ' WEB-IMP-REC(1:14) CL*49 00633 END-IF. DTSBX418 00634 CL*20 00635 * DISPLAY 'P1000 ' WEB-IMP-TYPE ' ' WEB-IMP-EMP-NO. CL*21 00636 DTSBX418 00637 PERFORM DTSBX418 00638 VARYING SUB FROM +1 BY +1 DTSBX418 00639 UNTIL SUB > +100 DTSBX418 00640 MOVE +0 TO L205-FIELD-LENGTH (SUB) DTSBX418 00641 L205-INTEGER (SUB) DTSBX418 00642 L205-FRACTION (SUB) DTSBX418 00643 MOVE SPACES TO L205-TEXT (SUB) DTSBX418 00644 L205-DATE (SUB) DTSBX418 00645 SET L205-TYPE-TEXT-88 (SUB) TO TRUE DTSBX418 00646 END-PERFORM. DTSBX418 00647 DTSBX418 00648 EVALUATE TRUE DTSBX418 00649 * WHEN WEB-IMP-TYPE-PRF-88 CL*45 00650 * PERFORM P1100A-PRF THRU P1100A-EXIT CL*45 00651 DTSBX418 00652 * WHEN WEB-IMP-TYPE-DETERM-88 CL*45 00653 * PERFORM P1100B-DETERM THRU P1100B-EXIT CL*45 00654 DTSBX418 00655 * WHEN WEB-IMP-TYPE-NAME-88 CL*45 00656 * PERFORM P1100C-NAME THRU P1100C-EXIT CL*45 00657 DTSBX418 00658 * WHEN WEB-IMP-TYPE-RATE-88 CL*45 00659 * PERFORM P1100D-RATE THRU P1100D-EXIT CL*45 00660 DTSBX418 00661 * WHEN WEB-IMP-TYPE-ADDR-88 CL*45 00662 * PERFORM P1100E-ADDR THRU P1100E-EXIT CL*45 00663 DTSBX418 00664 * WHEN WEB-IMP-TYPE-OPO-88 CL*45 00665 * PERFORM P1100F-OPO THRU P1100F-EXIT CL*45 00666 DTSBX418 00667 * WHEN WEB-IMP-TYPE-REL-88 CL*45 00668 * PERFORM P1100G-REL THRU P1100G-EXIT CL*45 00669 DTSBX418 00670 *** WHEN WEB-IMP-TYPE-IND-88 DTSBX418 00671 * PERFORM P1100X-IND THRU P1100X-EXIT DTSBX418 00672 * INITIALIZE X132-REC DTSBX418 00673 * MOVE +4 TO L205-LAST-FIELD DTSBX418 00674 *** MOVE +500 TO L205-LAST-FIELD-LEN DTSBX418 00675 DTSBX418 00676 WHEN WEB-IMP-TYPE-RPT-88 DTSBX418 00677 PERFORM P1100H-RPT THRU P1100H-EXIT DTSBX418 00678 DTSBX418 00679 WHEN WEB-IMP-TYPE-WAGE-88 DTSBX418 00680 PERFORM P1100I-WAGE THRU P1100I-EXIT DTSBX418 00681 DTSBX418 00682 WHEN WEB-IMP-TYPE-PAY-88 DTSBX418 00683 PERFORM P1100J-PAY THRU P1100J-EXIT DTSBX418 00684 DTSBX418 00685 * WHEN WEB-IMP-TYPE-BHDR-88 DTSBX418 00686 * PERFORM P1100K-BATCH-HEADER THRU P1100K-EXIT DTSBX418 00687 DTSBX418 00688 END-EVALUATE. DTSBX418 00689 DTSBX418 00690 * MOVE WEB-IMP-REC TO L205-INPUT-DATA. CL*45 00691 * CALL 'DTSBU205' USING L205-LINK-AREA. CL*45 00692 DTSBX418 00693 P1100-EXIT. DTSBX418 00694 EXIT. DTSBX418 00695 DTSBX418 00696 P1100A-PRF. DTSBX418 00697 INITIALIZE X102-REC DTSBX418 00698 MOVE +7 TO L205-LAST-FIELD DTSBX418 00699 MOVE +1 TO L205-LAST-FIELD-LEN DTSBX418 00700 DTSBX418 00701 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX418 00702 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX418 00703 DTSBX418 00704 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX418 00705 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX418 00706 DTSBX418 00707 MOVE +9 TO L205-FIELD-LENGTH (3). DTSBX418 00708 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX418 00709 DTSBX418 00710 MOVE +1 TO L205-FIELD-LENGTH (4). DTSBX418 00711 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX418 00712 DTSBX418 00713 MOVE +1 TO L205-FIELD-LENGTH (5). DTSBX418 00714 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX418 00715 DTSBX418 00716 MOVE +2 TO L205-FIELD-LENGTH (6). DTSBX418 00717 SET L205-TYPE-NUMBER-88 (6) TO TRUE. DTSBX418 00718 DTSBX418 00719 MOVE +1 TO L205-FIELD-LENGTH (7). DTSBX418 00720 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX418 00721 DTSBX418 00722 P1100A-EXIT. DTSBX418 00723 EXIT. DTSBX418 00724 DTSBX418 00725 P1100B-DETERM. DTSBX418 00726 INITIALIZE X104-REC DTSBX418 00727 MOVE +18 TO L205-LAST-FIELD DTSBX418 00728 MOVE +1 TO L205-LAST-FIELD-LEN DTSBX418 00729 DTSBX418 00730 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX418 00731 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX418 00732 DTSBX418 00733 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX418 00734 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX418 00735 DTSBX418 00736 MOVE +1 TO L205-FIELD-LENGTH (3). DTSBX418 00737 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX418 00738 DTSBX418 00739 MOVE +2 TO L205-FIELD-LENGTH (4). DTSBX418 00740 SET L205-TYPE-NUMBER-88 (4) TO TRUE. DTSBX418 00741 DTSBX418 00742 MOVE +2 TO L205-FIELD-LENGTH (5). DTSBX418 00743 SET L205-TYPE-NUMBER-88 (5) TO TRUE. DTSBX418 00744 DTSBX418 00745 MOVE +6 TO L205-FIELD-LENGTH (6). DTSBX418 00746 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX418 00747 DTSBX418 00748 MOVE +3 TO L205-FIELD-LENGTH (7). DTSBX418 00749 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX418 00750 DTSBX418 00751 MOVE +2 TO L205-FIELD-LENGTH (8). DTSBX418 00752 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSBX418 00753 DTSBX418 00754 MOVE +10 TO L205-FIELD-LENGTH (9). DTSBX418 00755 SET L205-TYPE-DATE-88 (9) TO TRUE. DTSBX418 00756 DTSBX418 00757 MOVE +1 TO L205-FIELD-LENGTH (10). DTSBX418 00758 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSBX418 00759 DTSBX418 00760 MOVE +10 TO L205-FIELD-LENGTH (11). DTSBX418 00761 SET L205-TYPE-DATE-88 (11) TO TRUE. DTSBX418 00762 DTSBX418 00763 MOVE +10 TO L205-FIELD-LENGTH (12). DTSBX418 00764 SET L205-TYPE-TEXT-88 (12) TO TRUE. DTSBX418 00765 DTSBX418 00766 MOVE +1 TO L205-FIELD-LENGTH (13). DTSBX418 00767 SET L205-TYPE-TEXT-88 (13) TO TRUE. DTSBX418 00768 DTSBX418 00769 MOVE +1 TO L205-FIELD-LENGTH (14). DTSBX418 00770 SET L205-TYPE-TEXT-88 (14) TO TRUE. DTSBX418 00771 DTSBX418 00772 MOVE +1 TO L205-FIELD-LENGTH (15). DTSBX418 00773 SET L205-TYPE-TEXT-88 (15) TO TRUE. DTSBX418 00774 DTSBX418 00775 MOVE +1 TO L205-FIELD-LENGTH (16). DTSBX418 00776 SET L205-TYPE-TEXT-88 (16) TO TRUE. DTSBX418 00777 DTSBX418 00778 MOVE +1 TO L205-FIELD-LENGTH (17). DTSBX418 00779 SET L205-TYPE-TEXT-88 (17) TO TRUE. DTSBX418 00780 DTSBX418 00781 MOVE +1 TO L205-FIELD-LENGTH (18). DTSBX418 00782 SET L205-TYPE-TEXT-88 (18) TO TRUE. DTSBX418 00783 DTSBX418 00784 P1100B-EXIT. DTSBX418 00785 EXIT. DTSBX418 00786 DTSBX418 00787 P1100C-NAME. DTSBX418 00788 INITIALIZE X106-REC DTSBX418 00789 MOVE +4 TO L205-LAST-FIELD DTSBX418 00790 MOVE +40 TO L205-LAST-FIELD-LEN DTSBX418 00791 DTSBX418 00792 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX418 00793 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX418 00794 DTSBX418 00795 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX418 00796 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX418 00797 DTSBX418 00798 MOVE +1 TO L205-FIELD-LENGTH (3). DTSBX418 00799 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX418 00800 DTSBX418 00801 MOVE +40 TO L205-FIELD-LENGTH (4). DTSBX418 00802 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX418 00803 DTSBX418 00804 P1100C-EXIT. DTSBX418 00805 EXIT. DTSBX418 00806 DTSBX418 00807 P1100D-RATE. DTSBX418 00808 ** DISPLAY 'RATE P1100D ' WEB-IMP-REC (1:23). DTSBX418 00809 DTSBX418 00810 INITIALIZE X108-REC. DTSBX418 00811 MOVE +4 TO L205-LAST-FIELD. DTSBX418 00812 MOVE +6 TO L205-LAST-FIELD-LEN. DTSBX418 00813 DTSBX418 00814 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX418 00815 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX418 00816 DTSBX418 00817 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX418 00818 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX418 00819 DTSBX418 00820 MOVE +4 TO L205-FIELD-LENGTH (3). DTSBX418 00821 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX418 00822 DTSBX418 00823 MOVE +6 TO L205-FIELD-LENGTH (4). DTSBX418 00824 SET L205-TYPE-NUMBER-88 (4) TO TRUE. DTSBX418 00825 DTSBX418 00826 P1100D-EXIT. DTSBX418 00827 EXIT. DTSBX418 00828 DTSBX418 00829 P1100E-ADDR. DTSBX418 00830 INITIALIZE X110-REC. DTSBX418 00831 MOVE +14 TO L205-LAST-FIELD. DTSBX418 00832 MOVE +40 TO L205-LAST-FIELD-LEN. DTSBX418 00833 DTSBX418 00834 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX418 00835 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX418 00836 DTSBX418 00837 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX418 00838 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX418 00839 DTSBX418 00840 MOVE +2 TO L205-FIELD-LENGTH (3). DTSBX418 00841 SET L205-TYPE-NUMBER-88 (3) TO TRUE. DTSBX418 00842 DTSBX418 00843 MOVE +40 TO L205-FIELD-LENGTH (4). DTSBX418 00844 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX418 00845 DTSBX418 00846 MOVE +40 TO L205-FIELD-LENGTH (5). DTSBX418 00847 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX418 00848 DTSBX418 00849 MOVE +40 TO L205-FIELD-LENGTH (6). DTSBX418 00850 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX418 00851 DTSBX418 00852 MOVE +25 TO L205-FIELD-LENGTH (7). DTSBX418 00853 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX418 00854 DTSBX418 00855 MOVE +2 TO L205-FIELD-LENGTH (8). DTSBX418 00856 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSBX418 00857 DTSBX418 00858 MOVE +10 TO L205-FIELD-LENGTH (9). DTSBX418 00859 SET L205-TYPE-TEXT-88 (9) TO TRUE. DTSBX418 00860 DTSBX418 00861 MOVE +15 TO L205-FIELD-LENGTH (10). DTSBX418 00862 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSBX418 00863 DTSBX418 00864 MOVE +15 TO L205-FIELD-LENGTH (11). DTSBX418 00865 SET L205-TYPE-TEXT-88 (11) TO TRUE. DTSBX418 00866 DTSBX418 00867 MOVE +40 TO L205-FIELD-LENGTH (12). DTSBX418 00868 SET L205-TYPE-TEXT-88 (12) TO TRUE. DTSBX418 00869 DTSBX418 00870 MOVE +40 TO L205-FIELD-LENGTH (13). DTSBX418 00871 SET L205-TYPE-TEXT-88 (13) TO TRUE. DTSBX418 00872 DTSBX418 00873 MOVE +40 TO L205-FIELD-LENGTH (14). DTSBX418 00874 SET L205-TYPE-TEXT-88 (14) TO TRUE. DTSBX418 00875 DTSBX418 00876 P1100E-EXIT. DTSBX418 00877 EXIT. DTSBX418 00878 DTSBX418 00879 P1100F-OPO. DTSBX418 00880 INITIALIZE X120-REC. DTSBX418 00881 MOVE +18 TO L205-LAST-FIELD. DTSBX418 00882 MOVE +40 TO L205-LAST-FIELD-LEN. DTSBX418 00883 DTSBX418 00884 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX418 00885 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX418 00886 DTSBX418 00887 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX418 00888 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX418 00889 DTSBX418 00890 MOVE +2 TO L205-FIELD-LENGTH (3). DTSBX418 00891 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX418 00892 DTSBX418 00893 MOVE +40 TO L205-FIELD-LENGTH (4). CL*22 00894 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX418 00895 DTSBX418 00896 MOVE +1 TO L205-FIELD-LENGTH (5). DTSBX418 00897 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX418 00898 DTSBX418 00899 MOVE +40 TO L205-FIELD-LENGTH (6). CL*22 00900 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX418 00901 DTSBX418 00902 MOVE +40 TO L205-FIELD-LENGTH (7). DTSBX418 00903 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX418 00904 DTSBX418 00905 MOVE +9 TO L205-FIELD-LENGTH (8). DTSBX418 00906 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSBX418 00907 DTSBX418 00908 MOVE +40 TO L205-FIELD-LENGTH (9). DTSBX418 00909 SET L205-TYPE-TEXT-88 (9) TO TRUE. DTSBX418 00910 DTSBX418 00911 MOVE +40 TO L205-FIELD-LENGTH (10). DTSBX418 00912 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSBX418 00913 DTSBX418 00914 MOVE +40 TO L205-FIELD-LENGTH (11). DTSBX418 00915 SET L205-TYPE-TEXT-88 (11) TO TRUE. DTSBX418 00916 DTSBX418 00917 MOVE +40 TO L205-FIELD-LENGTH (12). DTSBX418 00918 SET L205-TYPE-TEXT-88 (12) TO TRUE. DTSBX418 00919 DTSBX418 00920 MOVE +25 TO L205-FIELD-LENGTH (13). DTSBX418 00921 SET L205-TYPE-TEXT-88 (13) TO TRUE. DTSBX418 00922 DTSBX418 00923 MOVE +2 TO L205-FIELD-LENGTH (14). DTSBX418 00924 SET L205-TYPE-TEXT-88 (14) TO TRUE. DTSBX418 00925 DTSBX418 00926 MOVE +10 TO L205-FIELD-LENGTH (15). DTSBX418 00927 SET L205-TYPE-TEXT-88 (15) TO TRUE. DTSBX418 00928 DTSBX418 00929 MOVE +15 TO L205-FIELD-LENGTH (16). DTSBX418 00930 SET L205-TYPE-TEXT-88 (16) TO TRUE. DTSBX418 00931 DTSBX418 00932 MOVE +16 TO L205-FIELD-LENGTH (17). CL*22 00933 SET L205-TYPE-TEXT-88 (17) TO TRUE. DTSBX418 00934 DTSBX418 00935 MOVE +40 TO L205-FIELD-LENGTH (18). DTSBX418 00936 SET L205-TYPE-TEXT-88 (18) TO TRUE. DTSBX418 00937 DTSBX418 00938 P1100F-EXIT. DTSBX418 00939 EXIT. DTSBX418 00940 DTSBX418 00941 P1100G-REL. DTSBX418 00942 INITIALIZE X130-REC. DTSBX418 00943 MOVE +16 TO L205-LAST-FIELD. DTSBX418 00944 MOVE +40 TO L205-LAST-FIELD-LEN. DTSBX418 00945 DTSBX418 00946 P1100G-EXIT. DTSBX418 00947 EXIT. DTSBX418 00948 DTSBX418 00949 P1100H-RPT. DTSBX418 00950 * DISPLAY 'P1100H-RPT ' WEB-IMP-REC(1:126). CL*23 00951 INITIALIZE X140-REC. DTSBX418 00952 GO TO P1100H-EXIT. CL*45 00953 CL*45 00954 MOVE +16 TO L205-LAST-FIELD. CL*24 00955 MOVE +14 TO L205-LAST-FIELD-LEN. CL*27 00956 DTSBX418 00957 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX418 00958 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX418 00959 DTSBX418 00960 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX418 00961 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX418 00962 DTSBX418 00963 MOVE +4 TO L205-FIELD-LENGTH (3). DTSBX418 00964 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX418 00965 DTSBX418 00966 MOVE +1 TO L205-FIELD-LENGTH (4). DTSBX418 00967 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX418 00968 DTSBX418 00969 MOVE +8 TO L205-FIELD-LENGTH (5). DTSBX418 00970 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX418 00971 DTSBX418 00972 MOVE +8 TO L205-FIELD-LENGTH (6). DTSBX418 00973 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX418 00974 DTSBX418 00975 MOVE +14 TO L205-FIELD-LENGTH (7). DTSBX418 00976 SET L205-TYPE-NUMBER-88 (7) TO TRUE. DTSBX418 00977 DTSBX418 00978 MOVE +14 TO L205-FIELD-LENGTH (8). DTSBX418 00979 SET L205-TYPE-NUMBER-88 (8) TO TRUE. DTSBX418 00980 DTSBX418 00981 MOVE +14 TO L205-FIELD-LENGTH (9). DTSBX418 00982 SET L205-TYPE-NUMBER-88 (9) TO TRUE. DTSBX418 00983 DTSBX418 00984 MOVE +04 TO L205-FIELD-LENGTH (10). DTSBX418 00985 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSBX418 00986 DTSBX418 00987 MOVE +10 TO L205-FIELD-LENGTH (11). DTSBX418 00988 SET L205-TYPE-TEXT-88 (11) TO TRUE. DTSBX418 00989 DTSBX418 00990 MOVE +8 TO L205-FIELD-LENGTH (12). DTSBX418 00991 SET L205-TYPE-TEXT-88 (12) TO TRUE. CL*47 00992 DTSBX418 00993 MOVE +8 TO L205-FIELD-LENGTH (13). DTSBX418 00994 SET L205-TYPE-TEXT-88 (13) TO TRUE. CL*47 00995 DTSBX418 00996 MOVE +8 TO L205-FIELD-LENGTH (14). DTSBX418 00997 SET L205-TYPE-TEXT-88 (14) TO TRUE. CL*47 00998 DTSBX418 00999 MOVE +4 TO L205-FIELD-LENGTH (15). DTSBX418 01000 SET L205-TYPE-TEXT-88 (15) TO TRUE. DTSBX418 01001 DTSBX418 01002 MOVE +14 TO L205-FIELD-LENGTH (16). CL*27 01003 SET L205-TYPE-NUMBER-88 (16) TO TRUE. CL*26 01004 CL*24 01005 ** MOVE +1 TO L205-FIELD-LENGTH (16). DTSBX418 01006 ** SET L205-TYPE-TEXT-88 (18) TO TRUE. DTSBX418 01007 DTSBX418 01008 ** MOVE +1 TO L205-FIELD-LENGTH (17). DTSBX418 01009 ** SET L205-TYPE-TEXT-88 (19) TO TRUE. DTSBX418 01010 DTSBX418 01011 ** MOVE +3 TO L205-FIELD-LENGTH (18). DTSBX418 01012 ** SET L205-TYPE-TEXT-88 (20) TO TRUE. DTSBX418 01013 DTSBX418 01014 ** MOVE +8 TO L205-FIELD-LENGTH (19). DTSBX418 01015 ** SET L205-TYPE-TEXT-88 (21) TO TRUE. DTSBX418 01016 ** DISPLAY 'NANCY '. CL*31 01017 P1100H-EXIT. DTSBX418 01018 EXIT. DTSBX418 01019 DTSBX418 01020 P1100I-WAGE. DTSBX418 01021 * DISPLAY 'P1100I-WAGE ' WEB-IMP-REC(1:126). CL*10 01022 INITIALIZE X144-REC. DTSBX418 01023 GO TO P1100I-EXIT. CL*45 01024 CL*45 01025 MOVE +10 TO L205-LAST-FIELD. DTSBX418 01026 MOVE +14 TO L205-LAST-FIELD-LEN. DTSBX418 01027 DTSBX418 01028 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX418 01029 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX418 01030 DTSBX418 01031 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX418 01032 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX418 01033 DTSBX418 01034 MOVE +4 TO L205-FIELD-LENGTH (3). DTSBX418 01035 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX418 01036 DTSBX418 01037 MOVE +1 TO L205-FIELD-LENGTH (4). DTSBX418 01038 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX418 01039 DTSBX418 01040 MOVE +8 TO L205-FIELD-LENGTH (5). DTSBX418 01041 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX418 01042 DTSBX418 01043 MOVE +9 TO L205-FIELD-LENGTH (6). DTSBX418 01044 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX418 01045 DTSBX418 01046 MOVE +30 TO L205-FIELD-LENGTH (7). DTSBX418 01047 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX418 01048 DTSBX418 01049 MOVE +30 TO L205-FIELD-LENGTH (8). DTSBX418 01050 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSBX418 01051 DTSBX418 01052 MOVE +1 TO L205-FIELD-LENGTH (9). DTSBX418 01053 SET L205-TYPE-TEXT-88 (9) TO TRUE. DTSBX418 01054 DTSBX418 01055 MOVE +14 TO L205-FIELD-LENGTH (10). DTSBX418 01056 SET L205-TYPE-NUMBER-88 (10) TO TRUE. DTSBX418 01057 P1100I-EXIT. DTSBX418 01058 EXIT. DTSBX418 01059 DTSBX418 01060 P1100J-PAY. DTSBX418 01061 * DISPLAY 'P1100J-PAY ' WEB-IMP-REC(1:84). CL*10 01062 INITIALIZE X145-REC. DTSBX418 01063 GO TO P1100J-EXIT. CL*45 01064 CL*45 01065 MOVE +12 TO L205-LAST-FIELD. DTSBX418 01066 MOVE +8 TO L205-LAST-FIELD-LEN. DTSBX418 01067 DTSBX418 01068 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX418 01069 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX418 01070 DTSBX418 01071 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX418 01072 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX418 01073 DTSBX418 01074 MOVE +6 TO L205-FIELD-LENGTH (3). DTSBX418 01075 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX418 01076 DTSBX418 01077 MOVE +6 TO L205-FIELD-LENGTH (4). DTSBX418 01078 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX418 01079 DTSBX418 01080 MOVE +3 TO L205-FIELD-LENGTH (5). DTSBX418 01081 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX418 01082 DTSBX418 01083 MOVE +2 TO L205-FIELD-LENGTH (6). DTSBX418 01084 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX418 01085 DTSBX418 01086 MOVE +2 TO L205-FIELD-LENGTH (7). DTSBX418 01087 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX418 01088 DTSBX418 01089 MOVE +2 TO L205-FIELD-LENGTH (8). DTSBX418 01090 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSBX418 01091 DTSBX418 01092 MOVE +14 TO L205-FIELD-LENGTH (9). DTSBX418 01093 SET L205-TYPE-NUMBER-88 (9) TO TRUE. DTSBX418 01094 DTSBX418 01095 MOVE +10 TO L205-FIELD-LENGTH (10). DTSBX418 01096 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSBX418 01097 DTSBX418 01098 MOVE +10 TO L205-FIELD-LENGTH (11). DTSBX418 01099 SET L205-TYPE-TEXT-88 (11) TO TRUE. DTSBX418 01100 DTSBX418 01101 MOVE +8 TO L205-FIELD-LENGTH (12). DTSBX418 01102 SET L205-TYPE-TEXT-88 (12) TO TRUE. DTSBX418 01103 DTSBX418 01104 DTSBX418 01105 P1100J-EXIT. DTSBX418 01106 EXIT. DTSBX418 01107 DTSBX418 01108 P1100K-BATCH-HEADER. DTSBX418 01109 ** DISPLAY 'BX418 P1100K-HDR ' WEB-IMP-REC(1:84). CL*49 01110 INITIALIZE X149-REC. DTSBX418 01111 MOVE +13 TO L205-LAST-FIELD. DTSBX418 01112 MOVE +1 TO L205-LAST-FIELD-LEN. DTSBX418 01113 DTSBX418 01114 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX418 01115 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX418 01116 DTSBX418 01117 MOVE +5 TO L205-FIELD-LENGTH (2). DTSBX418 01118 SET L205-TYPE-TEXT-88(2) TO TRUE. DTSBX418 01119 DTSBX418 01120 MOVE +3 TO L205-FIELD-LENGTH (3). DTSBX418 01121 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX418 01122 DTSBX418 01123 MOVE +8 TO L205-FIELD-LENGTH (4). DTSBX418 01124 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX418 01125 DTSBX418 01126 MOVE +10 TO L205-FIELD-LENGTH (5). DTSBX418 01127 SET L205-TYPE-DATE-88 (5) TO TRUE. DTSBX418 01128 DTSBX418 01129 MOVE +10 TO L205-FIELD-LENGTH (6). DTSBX418 01130 SET L205-TYPE-DATE-88 (6) TO TRUE. DTSBX418 01131 DTSBX418 01132 MOVE +10 TO L205-FIELD-LENGTH (7). DTSBX418 01133 SET L205-TYPE-DATE-88 (7) TO TRUE. DTSBX418 01134 DTSBX418 01135 MOVE +3 TO L205-FIELD-LENGTH (8). DTSBX418 01136 SET L205-TYPE-NUMBER-88 (8) TO TRUE. DTSBX418 01137 DTSBX418 01138 MOVE +3 TO L205-FIELD-LENGTH (9). DTSBX418 01139 SET L205-TYPE-NUMBER-88 (9) TO TRUE. DTSBX418 01140 DTSBX418 01141 MOVE +12 TO L205-FIELD-LENGTH (10). DTSBX418 01142 SET L205-TYPE-NUMBER-88 (10) TO TRUE. DTSBX418 01143 DTSBX418 01144 MOVE +3 TO L205-FIELD-LENGTH (11). DTSBX418 01145 SET L205-TYPE-NUMBER-88 (11) TO TRUE. DTSBX418 01146 DTSBX418 01147 MOVE +10 TO L205-FIELD-LENGTH (12). DTSBX418 01148 SET L205-TYPE-DATE-88 (12) TO TRUE. DTSBX418 01149 DTSBX418 01150 MOVE +1 TO L205-FIELD-LENGTH (13). DTSBX418 01151 SET L205-TYPE-TEXT-88 (13) TO TRUE. DTSBX418 01152 DTSBX418 01153 P1100K-EXIT. DTSBX418 01154 EXIT. DTSBX418 01155 DTSBX418 01156 P1200-BUILD-SORT-REC. DTSBX418 01157 MOVE LOW-VALUES TO SORT-REC. DTSBX418 01158 MOVE WEB-IMP-EMP-NO TO SORT-EMP-NO. DTSBX418 01159 DTSBX418 01160 EVALUATE TRUE DTSBX418 01161 * WHEN WEB-IMP-TYPE-PRF-88 CL*45 01162 * PERFORM P1200A-PRF THRU P1200A-EXIT CL*45 01163 * MOVE +1 TO SORT-SEQ1 CL*45 01164 * MOVE X102-REC TO SORT-DATA CL*45 01165 CL*21 01166 * WHEN WEB-IMP-TYPE-DETERM-88 CL*45 01167 * PERFORM P1200B-DETERM THRU P1200B-EXIT CL*45 01168 * MOVE +2 TO SORT-SEQ1 CL*45 01169 * MOVE X104-REC TO SORT-DATA CL*45 01170 CL*21 01171 DTSBX418 01172 * WHEN WEB-IMP-TYPE-NAME-88 CL*45 01173 * PERFORM P1200C-NAME THRU P1200C-EXIT CL*42 01174 * MOVE WEB-IMP-REC TO X106-REC CL*45 01175 * MOVE +3 TO SORT-SEQ1 CL*45 01176 * MOVE X106-NAME-TYPE TO SORT-SEQ2 CL*45 01177 * MOVE X106-REC TO SORT-DATA CL*45 01178 CL*23 01179 * WHEN WEB-IMP-TYPE-RATE-88 CL*45 01180 * PERFORM P1200D-RATE THRU P1200D-EXIT CL*45 01181 * MOVE +4 TO SORT-SEQ1 CL*45 01182 * MOVE X108-REC TO SORT-DATA CL*45 01183 DTSBX418 01184 * WHEN WEB-IMP-TYPE-ADDR-88 CL*45 01185 * PERFORM P1200E-ADDR THRU P1200E-EXIT CL*27 01186 * MOVE WEB-IMP-REC TO X110-REC CL*45 01187 * MOVE +90 TO SORT-SEQ1 CL*45 01188 * MOVE X110-REC TO SORT-DATA CL*45 01189 DTSBX418 01190 * WHEN WEB-IMP-TYPE-OPO-88 CL*45 01191 * PERFORM P1200F-OPO THRU P1200F-EXIT CL*45 01192 * MOVE WEB-IMP-REC TO X120-REC CL*40 01193 * MOVE +91 TO SORT-SEQ1 CL*45 01194 * MOVE X120-REC TO SORT-DATA CL*45 01195 DTSBX418 01196 * WHEN WEB-IMP-TYPE-REL-88 CL*45 01197 * PERFORM P1200G-REL THRU P1200G-EXIT CL*45 01198 * MOVE +5 TO SORT-SEQ1 CL*45 01199 * MOVE X130-REC TO SORT-DATA CL*45 01200 DTSBX418 01201 *** WHEN WEB-IMP-TYPE-IND-88 DTSBX418 01202 * MOVE +6 TO SORT-SEQ1 DTSBX418 01203 *** MOVE X132-REC TO SORT-DATA DTSBX418 01204 DTSBX418 01205 WHEN WEB-IMP-TYPE-RPT-88 DTSBX418 01206 * IF X140-IN-HOUSE-88 DTSBX418 01207 * MOVE 999999 TO SORT-IN-HOUSE-SEQ DTSBX418 01208 ** MOVE X140-PSEUDO-BATCH-NO TO SORT-BATCH DTSBX418 01209 ** MOVE X140-PSEUDO-ITEM-NO TO SORT-ITEM DTSBX418 01210 * MOVE LOW-VALUES TO SORT-FILLER DTSBX418 01211 * ELSE DTSBX418 01212 * PERFORM P1200H-RPT THRU P1200H-EXIT CL*45 01213 MOVE WEB-IMP-REC TO X140-REC CL*45 01214 MOVE +20 TO SORT-SEQ1 CL*33 01215 MOVE X140-QUARTER TO SORT-SEQ2 CL*51 01216 STRING CL*34 01217 X140-QUARTER '0' DELIMITED BY SIZE CL*34 01218 INTO SORT-SEQ2 CL*34 01219 END-STRING CL*34 01220 * END-IF CL*35 01221 MOVE X140-REC TO SORT-DATA CL*36 01222 DTSBX418 01223 WHEN WEB-IMP-TYPE-WAGE-88 DTSBX418 01224 * PERFORM P1200I-WAGE THRU P1200I-EXIT CL*45 01225 MOVE WEB-IMP-REC TO X144-REC CL*45 01226 MOVE +20 TO SORT-SEQ1 CL*36 01227 MOVE X144-QUARTER TO SORT-SEQ2 CL*51 01228 STRING CL*34 01229 X140-QUARTER '1' CL*34 01230 DELIMITED BY SIZE CL*34 01231 INTO CL*34 01232 SORT-SEQ2 CL*34 01233 END-STRING CL*35 01234 MOVE X144-REC TO SORT-DATA CL*36 01235 DTSBX418 01236 ************************************************************ CL*23 01237 * CHANGED SORT SEQ FOR PAYMENT RECORDS FROM 30 TO 19 DUE TO ESSP CL*23 01238 * REPORTS X140 CANNOT BE PROCESSED WITHOUT A PAYMENT TRANSACTION CL*23 01239 * UNLESS IT IS A 0 WAGE REPORT = REMIT AMOUNT = 0 CL*23 01240 ************************************************************ CL*23 01241 CL*23 01242 WHEN WEB-IMP-TYPE-PAY-88 DTSBX418 01243 * PERFORM P1200J-PAY THRU P1200J-EXIT CL*45 01244 MOVE WEB-IMP-REC TO X145-REC CL*45 01245 MOVE +19 TO SORT-SEQ1 CL*23 01246 MOVE X145-QTR TO SORT-SEQ2 CL*51 01247 MOVE X145-REC TO SORT-DATA DTSBX418 01248 ** DISPLAY 'P2 PAY ' X145-REC DTSBX418 01249 DTSBX418 01250 DTSBX418 01251 ** WHEN WEB-IMP-TYPE-BHDR-88 DTSBX418 01252 * PERFORM P1200K-BATCH-HEADER THRU P1200K-EXIT DTSBX418 01253 * MOVE 999999 TO SORT-IN-HOUSE-SEQ DTSBX418 01254 * MOVE X149-PSEUDO-BATCH TO SORT-BATCH DTSBX418 01255 * MOVE X149-PSEUDO-ITEM TO SORT-ITEM DTSBX418 01256 * MOVE LOW-VALUES TO SORT-FILLER DTSBX418 01257 * MOVE X149-REC TO SORT-DATA DTSBX418 01258 DTSBX418 01259 END-EVALUATE. DTSBX418 01260 DTSBX418 01261 RELEASE SORT-REC. DTSBX418 01262 DTSBX418 01263 P1200-EXIT. DTSBX418 01264 EXIT. DTSBX418 01265 DTSBX418 01266 P1200A-PRF. DTSBX418 01267 MOVE L205-TEXT (1) (1:3) TO X102-REC-TYPE. DTSBX418 01268 ** DISPLAY X102-REC-TYPE DTSBX418 01269 MOVE L205-TEXT (2) (1:6) TO X102-EMP-NO. DTSBX418 01270 ** DISPLAY X102-EMP-NO DTSBX418 01271 DTSBX418 01272 MOVE L205-TEXT (3) (1:9) TO X102-EMP-FEIN. DTSBX418 01273 ** DISPLAY X102-EMP-FEIN DTSBX418 01274 DTSBX418 01275 MOVE L205-TEXT (4) (1:1) TO X102-EMP-CLASS. DTSBX418 01276 ** DISPLAY X102-EMP-CLASS DTSBX418 01277 DTSBX418 01278 MOVE L205-TEXT (5) (1:1) TO X102-EMP-STATUS. DTSBX418 01279 ** DISPLAY X102-EMP-STATUS DTSBX418 01280 DTSBX418 01281 MOVE L205-INTEGER (6) TO W-INT-9. DTSBX418 01282 MOVE W-INT-X (12:2) TO X102-SOURCE-CD. DTSBX418 01283 ** DISPLAY X102-SOURCE-CD DTSBX418 01284 DTSBX418 01285 ** DISPLAY X102-REC-TYPE DTSBX418 01286 MOVE L205-TEXT (7) (1:1) TO X102-ACTION-CD. DTSBX418 01287 ** DISPLAY X102-ACTION-CD. DTSBX418 01288 DTSBX418 01289 P1200A-EXIT. DTSBX418 01290 EXIT. DTSBX418 01291 DTSBX418 01292 P1200B-DETERM. DTSBX418 01293 MOVE L205-TEXT (1) (1:03) TO X104-REC-TYPE. DTSBX418 01294 DTSBX418 01295 MOVE L205-TEXT (2) (1:06) TO X104-EMP-NO. DTSBX418 01296 DTSBX418 01297 MOVE L205-TEXT (3) (1:01) TO X104-STAFF-REVIEW-IND. DTSBX418 01298 DTSBX418 01299 MOVE L205-INTEGER (4) TO W-INT-9. DTSBX418 01300 MOVE W-INT-X (12:2) TO X104-LIAB-CD. DTSBX418 01301 DTSBX418 01302 MOVE L205-INTEGER (5) TO W-INT-9. DTSBX418 01303 MOVE W-INT-X (12:2) TO X104-ELIG-CD. DTSBX418 01304 DTSBX418 01305 MOVE L205-TEXT (6) (1:06) TO X104-NAICS-CD. DTSBX418 01306 DTSBX418 01307 MOVE L205-TEXT (7) (1:03) TO X104-ORG-TYPE. DTSBX418 01308 DTSBX418 01309 MOVE L205-TEXT (8) (1:02) TO X104-INCORP-STATE. DTSBX418 01310 DTSBX418 01311 MOVE L205-DATE (9) TO X104-INCORP-DATE. DTSBX418 01312 DTSBX418 01313 MOVE L205-TEXT (10) (1:01) TO X104-HOUSEHOLD-FILING. DTSBX418 01314 DTSBX418 01315 MOVE L205-DATE (11) TO X104-FIRST-WAGE-DT. DTSBX418 01316 DTSBX418 01317 MOVE L205-TEXT (12) TO W-500-DATE. DTSBX418 01318 DTSBX418 01319 MOVE SPACES TO X104-FIRST-500-QTR DTSBX418 01320 IF W-500-DATE > SPACES DTSBX418 01321 MOVE W-500-DATE-YY TO W-500-FQTR-YY. DTSBX418 01322 IF W-500-DATE-MM < '04' DTSBX418 01323 MOVE '1' TO W-500-FQTR-NO. DTSBX418 01324 IF W-500-DATE-MM > '03' AND < '07' DTSBX418 01325 MOVE '2' TO W-500-FQTR-NO. DTSBX418 01326 IF W-500-DATE-MM > '06' AND < '10' DTSBX418 01327 MOVE '3' TO W-500-FQTR-NO. DTSBX418 01328 IF W-500-DATE-MM > '09' AND < '13' DTSBX418 01329 MOVE '4' TO W-500-FQTR-NO. DTSBX418 01330 MOVE W-500-FQTR TO X104-FIRST-500-QTR DTSBX418 01331 DTSBX418 01332 MOVE L205-TEXT (13) (1:01) TO X104-ACQUIRE-IND. DTSBX418 01333 DTSBX418 01334 MOVE L205-TEXT (14) (1:01) TO X104-MERGER-SPLIT-IND. DTSBX418 01335 DTSBX418 01336 MOVE L205-TEXT (15) (1:01) TO X104-REORG-IND. DTSBX418 01337 DTSBX418 01338 MOVE L205-TEXT (16) (1:01) TO X104-COMMON-OWN-IND. DTSBX418 01339 DTSBX418 01340 MOVE L205-TEXT (17) (1:01) TO X104-SALE-TRANSFER-IND. DTSBX418 01341 DTSBX418 01342 MOVE L205-TEXT (18) (1:01) TO X104-NOT-LIAB-REASON. DTSBX418 01343 ** DISPLAY X104-REC. DTSBX418 01344 P1200B-EXIT. DTSBX418 01345 EXIT. DTSBX418 01346 DTSBX418 01347 P1200C-NAME. DTSBX418 01348 MOVE L205-TEXT (1) (1:03) TO X106-REC-TYPE. DTSBX418 01349 DTSBX418 01350 MOVE L205-TEXT (2) (1:06) TO X106-EMP-NO. DTSBX418 01351 DTSBX418 01352 MOVE L205-TEXT (3) (1:01) TO X106-NAME-TYPE DTSBX418 01353 DTSBX418 01354 MOVE L205-TEXT (4) (1:40) TO X106-EMP-NAME. DTSBX418 01355 DTSBX418 01356 P1200C-EXIT. DTSBX418 01357 EXIT. DTSBX418 01358 DTSBX418 01359 P1200D-RATE. DTSBX418 01360 MOVE L205-TEXT (1) (1:03) TO X108-REC-TYPE. DTSBX418 01361 DTSBX418 01362 MOVE L205-TEXT (2) (1:06) TO X108-EMP-NO. DTSBX418 01363 DTSBX418 01364 MOVE L205-TEXT (3) (1:04) TO X108-RATE-YEAR(1:04). DTSBX418 01365 MOVE '/1' TO X108-RATE-YEAR(5:02). DTSBX418 01366 DTSBX418 01367 MOVE L205-INTEGER (4) TO W-INTEGER. DTSBX418 01368 MOVE L205-FRACTION (4) TO W-FRACTION. DTSBX418 01369 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX418 01370 MOVE W-NUMBER TO X108-RATE. DTSBX418 01371 ** DISPLAY 'BX418 RATE ' X108-RATE ' ' W-NUMBER. CL*49 01372 ** DISPLAY ' RATE YR ' X108-RATE-YEAR. DTSBX418 01373 DTSBX418 01374 P1200D-EXIT. DTSBX418 01375 EXIT. DTSBX418 01376 DTSBX418 01377 P1200E-ADDR. DTSBX418 01378 MOVE L205-TEXT (1) (1:03) TO X110-REC-TYPE. DTSBX418 01379 DTSBX418 01380 MOVE L205-TEXT (2) (1:06) TO X110-EMP-NO. DTSBX418 01381 DTSBX418 01382 MOVE L205-INTEGER (3) TO W-INT-9. DTSBX418 01383 MOVE W-INT-X (12:2) TO X110-ADDR-TYPE. DTSBX418 01384 DTSBX418 01385 MOVE L205-TEXT (4) (1:40) TO X110-ATTENTION. DTSBX418 01386 DTSBX418 01387 MOVE L205-TEXT (5) (1:40) TO X110-STREET-1. DTSBX418 01388 DTSBX418 01389 MOVE L205-TEXT (6) (1:40) TO X110-STREET-2. DTSBX418 01390 DTSBX418 01391 MOVE L205-TEXT (7) (1:25) TO X110-CITY. DTSBX418 01392 DTSBX418 01393 MOVE L205-TEXT (8) (1:02) TO X110-STATE. DTSBX418 01394 DTSBX418 01395 MOVE L205-TEXT (9) (1:10) TO X110-ZIP. DTSBX418 01396 DTSBX418 01397 MOVE L205-TEXT (10) (1:15) TO X110-PHONE. DTSBX418 01398 DTSBX418 01399 MOVE L205-TEXT (11) (1:15) TO X110-FAX. DTSBX418 01400 DTSBX418 01401 MOVE L205-TEXT(12) (1:40) TO X110-EMAIL. DTSBX418 01402 DTSBX418 01403 MOVE L205-TEXT (13) (1:40) TO X110-WEB-SITE. DTSBX418 01404 DTSBX418 01405 MOVE L205-TEXT (14) (1:40) TO X110-EMP-NAME. DTSBX418 01406 DTSBX418 01407 P1200E-EXIT. DTSBX418 01408 EXIT. DTSBX418 01409 DTSBX418 01410 P1200F-OPO. DTSBX418 01411 MOVE WEB-IMP-REC TO W120-REC. CL*40 01412 MOVE W120-REC-TYPE TO X120-REC-TYPE. CL*40 01413 DTSBX418 01414 MOVE W120-EMP-NO TO X120-EMP-NO. CL*40 01415 DTSBX418 01416 MOVE W120-TYPE-IND (1:02) TO X120-TYPE-IND. CL*40 01417 DTSBX418 01418 MOVE W120-OPO-FIRST-NAME (1:20) TO X120-OPO-FIRST-NAME. CL*40 01419 DTSBX418 01420 MOVE W120-OPO-MID-INIT (1:01) TO X120-OPO-MID-INIT. CL*40 01421 DTSBX418 01422 MOVE W120-OPO-LAST-NAME (1:20) TO X120-OPO-LAST-NAME. CL*40 01423 DTSBX418 01424 MOVE W120-OPO-MEMBER-NAME (1:40) TO X120-OPO-MEMBER-NAME. CL*40 01425 DTSBX418 01426 MOVE W120-OPO-SSN (1:09) TO X120-OPO-SSN. CL*40 01427 DTSBX418 01428 MOVE W120-OPO-TITLE (1:40) TO X120-OPO-TITLE. CL*40 01429 DTSBX418 01430 MOVE W120-OPO-ATTENTION (1:40) TO X120-OPO-ATTENTION. CL*40 01431 DTSBX418 01432 MOVE W120-OPO-STREET-1 (1:40) TO X120-OPO-STREET-1. CL*40 01433 DTSBX418 01434 MOVE W120-OPO-STREET-2 (1:40) TO X120-OPO-STREET-2. CL*40 01435 DTSBX418 01436 MOVE W120-OPO-CITY (1:20) TO X120-OPO-CITY. CL*40 01437 DTSBX418 01438 MOVE W120-OPO-STATE (1:02) TO X120-OPO-STATE. CL*40 01439 DTSBX418 01440 MOVE W120-OPO-ZIP (1:10) TO X120-OPO-ZIP. CL*40 01441 DTSBX418 01442 MOVE W120-OPO-PHONE (1:15) TO X120-OPO-PHONE. CL*40 01443 DTSBX418 01444 MOVE W120-OPO-FAX (1:15) TO X120-OPO-FAX. CL*40 01445 DTSBX418 01446 MOVE W120-OPO-EMAIL (1:40) TO X120-OPO-EMAIL. CL*43 01447 DTSBX418 01448 P1200F-EXIT. DTSBX418 01449 EXIT. DTSBX418 01450 DTSBX418 01451 P1200G-REL. DTSBX418 01452 P1200G-EXIT. DTSBX418 01453 EXIT. DTSBX418 01454 DTSBX418 01455 P1200H-RPT. DTSBX418 01456 * DISPLAY '01200H-RPT ' CL**9 01457 DTSBX418 01458 MOVE L205-TEXT (1) (1:03) TO X140-REC-TYPE. DTSBX418 01459 * DISPLAY 'X140-REC-TYPE' X140-REC-TYPE CL**9 01460 DTSBX418 01461 MOVE L205-TEXT (2) (1:06) TO X140-EMP-NO. DTSBX418 01462 ** DISPLAY 'X140-EMP-NO ' X140-EMP-NO DTSBX418 01463 DTSBX418 01464 MOVE L205-TEXT (3) (1:04) TO X140-QUARTER(1:04). DTSBX418 01465 MOVE '/' TO X140-QUARTER(5:01). DTSBX418 01466 MOVE L205-TEXT (4) (1:01) TO X140-QUARTER(6:01). DTSBX418 01467 DTSBX418 01468 MOVE '00' TO X140-SOURCE. DTSBX418 01469 ** DISPLAY 'X140-EMP-NO ' X140-EMP-NO DTSBX418 01470 DTSBX418 01471 MOVE L205-TEXT (5) (7:02) TO X140-REPORT-TYPE. CL**2 01472 IF X140-REPORT-TYPE = ZERO DTSBX418 01473 MOVE 'OR' TO X140-REPORT-TYPE DTSBX418 01474 ELSE DTSBX418 01475 MOVE 'EA' TO X140-REPORT-TYPE DTSBX418 01476 END-IF. DTSBX418 01477 DTSBX418 01478 ** DISPLAY 'L205-TEXT (6) (1:02) ' L205-TEXT (6) (1:02) DTSBX418 01479 ** DISPLAY 'X140-REPORT-TYPE ' X140-REPORT-TYPE DTSBX418 01480 DTSBX418 01481 MOVE ZEROS TO X140-PSEUDO-BATCH-NO. DTSBX418 01482 ** DISPLAY 'X140-PSEUDO-BATCH-NO ' X140-PSEUDO-BATCH-NO DTSBX418 01483 DTSBX418 01484 MOVE ZEROS TO X140-PSEUDO-ITEM-NO. DTSBX418 01485 ** DISPLAY 'X140-PSEUDO-ITEM-NO ' X140-PSEUDO-ITEM-NO DTSBX418 01486 DTSBX418 01487 MOVE L205-INTEGER (8) TO W-INTEGER. DTSBX418 01488 MOVE L205-FRACTION (8) TO W-FRACTION. DTSBX418 01489 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX418 01490 MOVE W-NUMBER TO X140-TAX-WAGES. DTSBX418 01491 * DISPLAY 'X140-TAX-WAGES ' X140-TAX-WAGES CL**9 01492 DTSBX418 01493 MOVE L205-INTEGER (9) TO W-INTEGER. DTSBX418 01494 MOVE L205-FRACTION (9) TO W-FRACTION. DTSBX418 01495 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX418 01496 MOVE W-NUMBER TO X140-TOTAL-WAGES. DTSBX418 01497 * DISPLAY 'X140-TOTAL-WAGES ' X140-TOTAL-WAGES CL**9 01498 DTSBX418 01499 MOVE ZERO TO X140-CONFIRMATION. DTSBX418 01500 DTSBX418 01501 MOVE L205-TEXT (11) TO X140-RCVD-DATE. DTSBX418 01502 * DISPLAY 'RECV DATE ' X140-RCVD-DATE. CL**9 01503 DTSBX418 01504 MOVE L205-TEXT (12) (2:07) TO X140-WRKR-CNT-1ST-MNTH. CL*47 01505 * DISPLAY 'X140-WRKR-CNT-1ST-MNTH ' X140-WRKR-CNT-1ST-MNTH CL**9 01506 DTSBX418 01507 MOVE L205-TEXT (13) (2:07) TO X140-WRKR-CNT-2ND-MNTH. CL*47 01508 * DISPLAY 'X140-WRKR-CNT-2ND-MNTH ' X140-WRKR-CNT-2ND-MNTH CL**9 01509 DTSBX418 01510 MOVE L205-TEXT (14) (2:07) TO X140-WRKR-CNT-3RD-MNTH. CL*47 01511 * DISPLAY 'X140-WRKR-CNT-3RD-MNTH ' X140-WRKR-CNT-3RD-MNTH CL**9 01512 DTSBX418 01513 CL*25 01514 MOVE L205-INTEGER (16) TO W-INTEGER. CL*25 01515 MOVE L205-FRACTION (16) TO W-FRACTION. CL*25 01516 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. CL*25 01517 MOVE W-NUMBER TO X140-REMITTANCE. CL*25 01518 * DISPLAY 'X140-REMITTANCE ' X140-REMITTANCE. CL*30 01519 CL*25 01520 MOVE SPACES TO X140-CHECK-SCAN-DT. DTSBX418 01521 * DISPLAY 'X140-CHECK SCANDATE ' X140-CHECK-SCAN-DT. CL**9 01522 DTSBX418 01523 MOVE ZEROS TO X140-CHECK-SEQ-NBR. DTSBX418 01524 * DISPLAY 'X140-CHECK-SEQ-NBR ' X140-CHECK-SEQ-NBR CL**9 01525 DTSBX418 01526 MOVE 'N' TO X140-WAIVE-INTEREST. DTSBX418 01527 * DISPLAY 'X140-WAIVE-INTEREST ' X140-WAIVE-INTEREST CL**9 01528 DTSBX418 01529 MOVE 'N' TO X140-WAIVE-PENALTY. DTSBX418 01530 * DISPLAY 'X140-WAIVE-PENALTY ' X140-WAIVE-PENALTY CL**9 01531 DTSBX418 01532 MOVE ' ' TO X140-RESP-ACTIVITY. DTSBX418 01533 * DISPLAY 'X140-RESP-ACTIVITY ' X140-RESP-ACTIVITY CL**9 01534 DTSBX418 01535 MOVE 'WEBESSP ' TO X140-RESP-OPID. DTSBX418 01536 * DISPLAY 'X140-RESP-OPID ' X140-RESP-OPID CL**9 01537 DTSBX418 01538 *& DTSBX418 01539 * DISPLAY 'BX418 P1200H: ' X140-REC. CL*49 01540 P1200H-EXIT. DTSBX418 01541 EXIT. DTSBX418 01542 DTSBX418 01543 P1200I-WAGE. DTSBX418 01544 MOVE L205-TEXT (1) (1:03) TO X144-REC-TYPE. DTSBX418 01545 DTSBX418 01546 MOVE L205-TEXT (2) (1:06) TO X144-EMP-NO. DTSBX418 01547 DTSBX418 01548 ** MOVE L205-TEXT (3) (1:06) TO X144-QUARTER. DTSBX418 01549 DTSBX418 01550 MOVE L205-TEXT (3) (1:04) TO X144-QUARTER(1:04). DTSBX418 01551 MOVE '/' TO X144-QUARTER(5:01). DTSBX418 01552 MOVE L205-TEXT (4) (1:01) TO X144-QUARTER(6:01). DTSBX418 01553 DTSBX418 01554 MOVE L205-TEXT (6) (1:09) TO X144-SSN. DTSBX418 01555 DTSBX418 01556 MOVE '5' TO X144-WAGE-STATUS. DTSBX418 01557 DTSBX418 01558 MOVE L205-TEXT (7) (1:20) TO X144-LAST-NAME. DTSBX418 01559 DTSBX418 01560 MOVE L205-TEXT (8) (1:15) TO X144-FIRST-NAME. DTSBX418 01561 DTSBX418 01562 MOVE L205-TEXT (9) (1:01) TO X144-MID-INIT. DTSBX418 01563 DTSBX418 01564 MOVE L205-INTEGER (10) TO W-INTEGER. DTSBX418 01565 MOVE L205-FRACTION (10) TO W-FRACTION. DTSBX418 01566 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX418 01567 MOVE W-NUMBER TO X144-EARNINGS. DTSBX418 01568 * DISPLAY 'WAGES ' X144-EARNINGS. CL**9 01569 DTSBX418 01570 P1200I-EXIT. DTSBX418 01571 EXIT. DTSBX418 01572 DTSBX418 01573 P1200J-PAY. DTSBX418 01574 MOVE L205-TEXT (1) (1:03) TO X145-REC-TYPE. DTSBX418 01575 DTSBX418 01576 MOVE L205-TEXT (2) (1:06) TO X145-EMP-NO. DTSBX418 01577 DTSBX418 01578 MOVE '0' TO X145-SOURCE. DTSBX418 01579 DTSBX418 01580 MOVE L205-TEXT (3) (1:06) TO X145-QTR. DTSBX418 01581 * DISPLAY 'X145 QTR ' X145-QTR. CL**9 01582 DTSBX418 01583 MOVE L205-TEXT (8) (1:02) TO X145-PAY-TYPE. DTSBX418 01584 * DISPLAY 'X145 PAY TYPE ' X145-PAY-TYPE. CL**9 01585 DTSBX418 01586 MOVE L205-INTEGER (9) TO W-INTEGER. DTSBX418 01587 MOVE L205-FRACTION (9) TO W-FRACTION. DTSBX418 01588 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX418 01589 MOVE W-NUMBER TO X145-REMITTANCE. DTSBX418 01590 * DISPLAY 'X145 PAY AMT ' X145-REMITTANCE. CL**9 01591 DTSBX418 01592 MOVE L205-TEXT (10) (1:10) TO X145-RCVD-DATE. DTSBX418 01593 * DISPLAY 'X145 PAY DATE ' X145-RCVD-DATE. CL**9 01594 DTSBX418 01595 MOVE L205-TEXT (12) TO W-TRACE-B. DTSBX418 01596 MOVE W-TRACE-9 TO X145-TRACE-NO. DTSBX418 01597 * DISPLAY 'X145 PAY NO ' X145-TRACE-NO. CL**9 01598 DTSBX418 01599 DTSBX418 01600 MOVE ZEROS TO X145-PSEUDO-BATCH. DTSBX418 01601 DTSBX418 01602 MOVE ZEROS TO X145-PSEUDO-ITEM. DTSBX418 01603 DTSBX418 01604 MOVE SPACES TO X145-APPLIC-ACCT. DTSBX418 01605 DTSBX418 01606 MOVE SPACES TO X145-CHECK-SCAN-DT. DTSBX418 01607 DTSBX418 01608 MOVE ZEROS TO X145-CHECK-SEQ-NBR. DTSBX418 01609 DTSBX418 01610 MOVE 'N' TO X145-WAIVE-INTEREST. DTSBX418 01611 DTSBX418 01612 MOVE 'N' TO X145-WAIVE-PENALTY. DTSBX418 01613 DTSBX418 01614 MOVE 'VOL' TO X145-RESP-ACTIVITY. DTSBX418 01615 DTSBX418 01616 MOVE 'WEBESSP ' TO X145-RESP-OPID. DTSBX418 01617 DTSBX418 01618 P1200J-EXIT. DTSBX418 01619 EXIT. DTSBX418 01620 DTSBX418 01621 P1200K-BATCH-HEADER. DTSBX418 01622 MOVE L205-TEXT (1) (1:03) TO X149-REC-TYPE. DTSBX418 01623 DTSBX418 01624 MOVE L205-TEXT (2) (1:5) TO X149-PSEUDO-BATCH. DTSBX418 01625 DTSBX418 01626 MOVE L205-TEXT (3) (1:3) TO X149-PSEUDO-ITEM. DTSBX418 01627 DTSBX418 01628 MOVE L205-TEXT (4) (1:08) TO X149-ESTB-OPID. DTSBX418 01629 DTSBX418 01630 MOVE L205-DATE (5) TO X149-ESTB-DATE. DTSBX418 01631 DTSBX418 01632 MOVE L205-DATE (6) TO X149-DEPOSIT-DATE. DTSBX418 01633 DTSBX418 01634 IF L205-VALID-NO-88 (7) DTSBX418 01635 MOVE SPACES TO X149-RCVD-DATE DTSBX418 01636 ELSE DTSBX418 01637 MOVE L205-DATE (7) TO X149-RCVD-DATE DTSBX418 01638 END-IF. DTSBX418 01639 DTSBX418 01640 MOVE L205-INTEGER (8) TO X149-LAST-ITEM-NBR. DTSBX418 01641 DTSBX418 01642 MOVE L205-INTEGER (9) TO X149-CONTROL-TRAN-CNT. DTSBX418 01643 DTSBX418 01644 MOVE L205-INTEGER (10) TO W-INTEGER. DTSBX418 01645 MOVE L205-FRACTION (10) TO W-FRACTION. DTSBX418 01646 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX418 01647 MOVE W-NUMBER TO X149-CONTROL-REMIT-AMT. DTSBX418 01648 MOVE W-INTEGER TO W-AMT-DISP1. DTSBX418 01649 MOVE W-FRACTION TO W-AMT-DISP4. DTSBX418 01650 MOVE W-NUMBER TO W-AMT-DISP2. DTSBX418 01651 ** DISPLAY 'BX418 P1200 HDR ' X149-PSEUDO-BATCH CL*49 01652 ** ' INT ' W-AMT-DISP1 ' FR ' W-AMT-DISP4 DTSBX418 01653 ** ' NBR ' W-AMT-DISP2 DTSBX418 01654 ** ' X149 ' X149-CONTROL-REMIT-AMT. DTSBX418 01655 DTSBX418 01656 MOVE L205-INTEGER (11) TO X149-CONTROL-CHECK-CNT. DTSBX418 01657 DTSBX418 01658 MOVE L205-DATE (12) TO X149-CHECK-SCAN-DATE. DTSBX418 01659 DTSBX418 01660 MOVE L205-TEXT (13) (1:08) TO X149-ANN-BATCH-IND. DTSBX418 01661 DTSBX418 01662 ** DISPLAY 'BX418 P1200 HDR ' X149-PSEUDO-BATCH CL*49 01663 ** ' ' X149-PSEUDO-ITEM ' ' X149-ESTB-OPID. DTSBX418 01664 P1200K-EXIT. DTSBX418 01665 EXIT. DTSBX418 01666 DTSBX418 01667 P2000-POST-SORT. DTSBX418 01668 SET SORT-OK-88 TO TRUE. DTSBX418 01669 DTSBX418 01670 DISPLAY 'P2000 BEG READING SORT-FILE ' SORT-EMP-NO. CL**7 01671 PERFORM P2100-PROCESS-SORT THRU P2100-EXIT DTSBX418 01672 UNTIL SORT-EOF-88. DTSBX418 01673 DTSBX418 01674 * SET LX42-TERMINATE-88 TO TRUE CL**9 01675 * DISPLAY 'BX418 P2000 END READING SORT-FILE ' SORT-EMP-NO. CL*49 01676 DISPLAY 'BX418 P2000 END READING SORT-FILE ' SORT-KEY ' ' CL*49 01677 SORT-DATA (1:14). CL**7 01678 P2000-EXIT. DTSBX418 01679 EXIT. DTSBX418 01680 DTSBX418 01681 P2100-PROCESS-SORT. DTSBX418 01682 * DISPLAY 'BX418 P2100 FIRST SORT-EMP-NO ' SORT-EMP-NO CL*49 01683 * ' ' SORT-DATA (1:14). CL*38 01684 RETURN SORT-FILE DTSBX418 01685 AT END DTSBX418 01686 SET SORT-EOF-88 TO TRUE DTSBX418 01687 GO TO P2100-EXIT DTSBX418 01688 END-RETURN. DTSBX418 01689 DTSBX418 01690 DISPLAY 'BX418 P2100 SORT-REC ' SORT-KEY ' ' CL*49 01691 SORT-DATA (1:14). CL*21 01692 DTSBX418 01693 MOVE SORT-DATA TO LX42-DATA-AREA. DTSBX418 01694 IF SORT-EMP-NO = 999999 DTSBX418 01695 IF SORT-BATCH = W-PSEUDO-BATCH-NO DTSBX418 01696 DISPLAY 'BX418 NEW BATCH 999999 PROCESS' CL*49 01697 SET LX42-PROCESS-88 TO TRUE DTSBX418 01698 PERFORM P3000-PROCESS THRU P3000-EXIT DTSBX418 01699 ELSE DTSBX418 01700 MOVE SORT-BATCH TO W-PSEUDO-BATCH-NO DTSBX418 01701 DISPLAY 'BX418 NEW BATCH ' CL*49 01702 ** PERFORM P2120-NEW-BATCH THRU P2120-EXIT DTSBX418 01703 SET LX42-PROCESS-88 TO TRUE DTSBX418 01704 SET LX42-ERROR-NO-88 TO TRUE DTSBX418 01705 SET LX42-RPT-ERROR-NO-88 TO TRUE CL*29 01706 ** DISPLAY 'BX418 NEW BATCH 888888 PROCESS' CL*49 01707 PERFORM P3000-PROCESS THRU P3000-EXIT DTSBX418 01708 END-IF DTSBX418 01709 ELSE CL*19 01710 IF SORT-EMP-NO = W-EMP-NO DTSBX418 01711 DISPLAY 'BX418 SORT-EMP-NO = W-EMP-NO ' CL*49 01712 SET LX42-PROCESS-88 TO TRUE DTSBX418 01713 PERFORM P3000-PROCESS THRU P3000-EXIT DTSBX418 01714 ELSE DTSBX418 01715 DISPLAY 'BX418 SORT-EMP-NO < W-EMP-NO ' CL*49 01716 MOVE SORT-EMP-NO TO W-EMP-NO DTSBX418 01717 PERFORM P2110-NEW-EMP THRU P2110-EXIT DTSBX418 01718 SET LX42-PROCESS-88 TO TRUE DTSBX418 01719 SET LX42-ERROR-NO-88 TO TRUE DTSBX418 01720 SET LX42-RPT-ERROR-NO-88 TO TRUE CL*29 01721 PERFORM P3000-PROCESS THRU P3000-EXIT DTSBX418 01722 END-IF DTSBX418 01723 END-IF. DTSBX418 01724 DTSBX418 01725 P2100-EXIT. DTSBX418 01726 EXIT. DTSBX418 01727 DTSBX418 01728 P2110-NEW-EMP. DTSBX418 01729 DTSBX418 01730 DISPLAY 'BX418 >>>>>>>> NEW-EMP ' LX42-DATA-AREA (1:20). CL*49 01731 DTSBX418 01732 SET LX42-NEW-EMPLOYER-88 TO TRUE. DTSBX418 01733 MOVE ZERO TO LX42-LAST-DETERM-EMP. DTSBX418 01734 DTSBX418 01735 * PERFORM S421-REGISTRATION THRU S421-EXIT. CL*45 01736 PERFORM S422-REPORT-PAYMT THRU S422-EXIT. CL*23 01737 * PERFORM S423-PAYMENT THRU S423-EXIT. CL*23 01738 * PERFORM S424-PROFILE THRU S424-EXIT. CL*45 01739 DTSBX418 01740 P2110-EXIT. DTSBX418 01741 EXIT. DTSBX418 01742 DTSBX418 01743 P2120-NEW-BATCH. DTSBX418 01744 *& DTSBX418 01745 * DISPLAY 'BX418 P2120 NEW BATCH ' LX42-PSEUDO-BATCH-NO CL*49 01746 * ' ' LX42-DATA-AREA (1:20). DTSBX418 01747 *& DTSBX418 01748 SET LX42-NEW-BATCH-88 TO TRUE. DTSBX418 01749 DTSBX418 01750 * PERFORM S426-HEADER THRU S426-EXIT. DTSBX418 01751 * IF LX42-BATCH-ERR-YES-88 DTSBX418 01752 * SET LX42-BATCH-ERROR-88 TO TRUE DTSBX418 01753 * END-IF. DTSBX418 01754 PERFORM S422-REPORT-PAYMT THRU S422-EXIT. CL*23 01755 * PERFORM S423-PAYMENT THRU S423-EXIT. CL*23 01756 DTSBX418 01757 MOVE W-PSEUDO-BATCH-NO TO LX42-PSEUDO-BATCH-NO. DTSBX418 01758 MOVE ZERO TO LX42-RPT-CNT DTSBX418 01759 LX42-RPT-REMIT-AMT DTSBX418 01760 LX42-PAY-CNT DTSBX418 01761 LX42-PAY-REMIT-AMT. DTSBX418 01762 SET LX42-BATCH-ERR-NO-88 TO TRUE. DTSBX418 01763 DTSBX418 01764 P2120-EXIT. DTSBX418 01765 EXIT. DTSBX418 01766 DTSBX418 01767 P3000-PROCESS. DTSBX418 01768 *& DTSBX418 01769 *& DTSBX418 01770 **************************************************************** DTSBX418 01771 * LX42-LAST-DETERM-EMP IS SET WHEN PROCESSING A DETERMINATION. DTSBX418 01772 * THE EMPLOYER ACCOUNT NUMBER IS PASSED THROUGH THIS FIELD DTSBX418 01773 * TO DTSBX422, WHICH PROCESSES REPORTS. IT IS USED DTSBX418 01774 * TO DETERMINE WHEN TO WAIVE P & I. THE WAIVER IS AUTOMATIC DTSBX418 01775 * FOR REPORTS WITHIN THE LAST 5 QUARTERS SUBMITTED ALONG DTSBX418 01776 * WITH A WEB REGISTRATION. DTSBX418 01777 **************************************************************** DTSBX418 01778 DTSBX418 01779 EVALUATE TRUE DTSBX418 01780 * WHEN LX42-REC-TYPE-PRF-88 CL*45 01781 * ADD +1 TO W-102-IMP-CNT CL*45 01782 * PERFORM S421-REGISTRATION THRU S421-EXIT CL*45 01783 CL**9 01784 * WHEN LX42-REC-TYPE-DETERM-88 CL*45 01785 * ADD +1 TO W-104-IMP-CNT CL*45 01786 * MOVE W-EMP-NO CL*45 01787 * TO LX42-LAST-DETERM-EMP CL*45 01788 * PERFORM S421-REGISTRATION THRU S421-EXIT CL*45 01789 CL**9 01790 * WHEN LX42-REC-TYPE-RATE-88 CL*45 01791 * ADD +1 TO W-108-IMP-CNT CL*45 01792 * PERFORM S421-REGISTRATION THRU S421-EXIT CL*45 01793 CL**9 01794 * WHEN LX42-REC-TYPE-NAME-88 CL*45 01795 * ADD +1 TO W-106-IMP-CNT CL*45 01796 * PERFORM S421-REGISTRATION THRU S421-EXIT CL*45 01797 CL**9 01798 * WHEN LX42-REC-TYPE-REL-88 CL**9 01799 * PERFORM S421-REGISTRATION THRU S421-EXIT CL**9 01800 DTSBX418 01801 WHEN LX42-REC-TYPE-RPT-88 DTSBX418 01802 ADD +1 TO W-140-IMP-CNT CL*38 01803 *** PERFORM P3100-BATCH-NO THRU P3100-EXIT DTSBX418 01804 PERFORM S422-REPORT-PAYMT THRU S422-EXIT CL*23 01805 CL**9 01806 WHEN LX42-REC-TYPE-WAGE-88 DTSBX418 01807 ADD +1 TO W-144-IMP-CNT CL*38 01808 PERFORM S422-REPORT-PAYMT THRU S422-EXIT CL*23 01809 DTSBX418 01810 * WHEN LX42-REC-TYPE-BHDR-88 CL**9 01811 * PERFORM S426-HEADER THRU S426-EXIT CL**9 01812 DTSBX418 01813 WHEN LX42-REC-TYPE-PAY-88 DTSBX418 01814 ADD +1 TO W-145-IMP-CNT CL*38 01815 PERFORM S422-REPORT-PAYMT THRU S422-EXIT CL*23 01816 DTSBX418 01817 * WHEN LX42-REC-TYPE-ADDR-88 CL*45 01818 * ADD +1 TO W-110-IMP-CNT CL*45 01819 * PERFORM S424-PROFILE THRU S424-EXIT CL*45 01820 CL**9 01821 * WHEN LX42-REC-TYPE-OPO-88 CL*45 01822 * ADD +1 TO W-120-IMP-CNT CL*45 01823 * PERFORM S424-PROFILE THRU S424-EXIT CL*45 01824 DTSBX418 01825 END-EVALUATE. DTSBX418 01826 DTSBX418 01827 P3000-EXIT. DTSBX418 01828 EXIT. DTSBX418 01829 DTSBX418 01830 P3100-BATCH-NO. DTSBX418 01831 *& IF W-PSEUDO-ITEM-NO < 999 DTSBX418 01832 * ADD 1 TO W-PSEUDO-ITEM-NO DTSBX418 01833 * ELSE DTSBX418 01834 * ADD 1 TO W-PSEUDO-BATCH-NO DTSBX418 01835 * MOVE 1 TO W-PSEUDO-ITEM-NO DTSBX418 01836 * END-IF. DTSBX418 01837 * DTSBX418 01838 * MOVE W-PSEUDO-BATCH-NO TO LX42-PSEUDO-BATCH-NO. DTSBX418 01839 *& MOVE W-PSEUDO-ITEM-NO TO LX42-PSEUDO-ITEM-NO. DTSBX418 01840 DTSBX418 01841 P3100-EXIT. DTSBX418 01842 EXIT. DTSBX418 01843 DTSBX418 01844 DTSBX418 01845 T0000-TERMINATE. DTSBX418 01846 PERFORM T1000-FINAL-CALLS THRU T1000-EXIT. DTSBX418 01847 DTSBX418 01848 *** PERFORM T1100-UPDATE-CURR-BATCH THRU T1100-EXIT. DTSBX418 01849 DTSBX418 01850 DISPLAY ' '. DTSBX418 01851 DTSBX418 01852 DISPLAY '*** DTSBX418 TERMINATION STATISTICS ***'. CL*48 01853 DTSBX418 01854 DISPLAY '***************************************'. CL*30 01855 DISPLAY '*** WEB/ESSP IMPORT DRIVER COUNTS ***'. CL*38 01856 DISPLAY '*** RELEASE RPT/PAY/WAGES TO DUTAS ***'. CL*50 01857 DISPLAY '***************************************'. CL*50 01858 DISPLAY 'TOTAL INPUT RECORDS READ: ' W-WEB-IMP-CNT. CL*38 01859 * DISPLAY ' X102 RECORDS READ: ' W-102-IMP-CNT. CL*48 01860 * DISPLAY ' X104 RECORDS READ: ' W-104-IMP-CNT. CL*48 01861 * DISPLAY ' X106 RECORDS READ: ' W-106-IMP-CNT. CL*48 01862 * DISPLAY ' X108 RECORDS READ: ' W-108-IMP-CNT. CL*48 01863 * DISPLAY ' X110 RECORDS READ: ' W-110-IMP-CNT. CL*48 01864 * DISPLAY ' X120 RECORDS READ: ' W-120-IMP-CNT. CL*48 01865 DISPLAY ' X140 RECORDS READ: ' W-140-IMP-CNT. CL*38 01866 DISPLAY ' X144 RECORDS READ: ' W-144-IMP-CNT. CL*38 01867 DISPLAY ' X145 RECORDS READ: ' W-145-IMP-CNT. CL*38 01868 DISPLAY ' ' CL*38 01869 DISPLAY '*** ***'. CL*30 01870 DISPLAY '*********** END OF RUN ****************'. CL*38 01871 DTSBX418 01872 CLOSE WEB-IMP-FILE. DTSBX418 01873 *** CURR-BATCH-NO. DTSBX418 01874 *** TEMP-BTC-FILE. DTSBX418 01875 DTSBX418 01876 PERFORM S910-CLOSE THRU S910-EXIT. DTSBX418 01877 PERFORM S921-CLOSE THRU S921-EXIT. DTSBX418 01878 PERFORM S923-CLOSE THRU S923-EXIT. DTSBX418 01879 PERFORM S931-CLOSE THRU S931-EXIT. DTSBX418 01880 * PERFORM S927C-CLOSE THRU S927C-EXIT. CL*44 01881 DTSBX418 01882 T0000-EXIT. DTSBX418 01883 EXIT. DTSBX418 01884 DTSBX418 01885 T1000-FINAL-CALLS. DTSBX418 01886 *& DTSBX418 01887 DISPLAY 'BX418 T1000 ' LX42-DATA-AREA (1:20). CL*49 01888 *& DTSBX418 01889 SET LX42-TERMINATE-88 TO TRUE. DTSBX418 01890 MOVE LOW-VALUES TO LX42-DATA-AREA. DTSBX418 01891 DTSBX418 01892 * PERFORM S421-REGISTRATION THRU S421-EXIT. CL*45 01893 ** PERFORM S426-HEADER THRU S426-EXIT. DTSBX418 01894 PERFORM S422-REPORT-PAYMT THRU S422-EXIT. CL*23 01895 ** PERFORM S423-PAYMENT THRU S423-EXIT. CL*23 01896 * PERFORM S424-PROFILE THRU S424-EXIT. CL*45 01897 DTSBX418 01898 T1000-EXIT. DTSBX418 01899 EXIT. DTSBX418 01900 DTSBX418 01901 *T1100-UPDATE-CURR-BATCH. DTSBX418 01902 * MOVE W-PSEUDO-BATCH-NO TO CURRENT-BATCH-NO DTSBX418 01903 * W-END-BATCH. DTSBX418 01904 * MOVE W-PSEUDO-ITEM-NO TO CURRENT-ITEM-NO. DTSBX418 01905 * DISPLAY 'REWRITING CURRENT BATCH ' DTSBX418 01906 * W-PSEUDO-BATCH-NO '/' W-PSEUDO-ITEM-NO DTSBX418 01907 * REWRITE CURR-BATCH-NO-REC. DTSBX418 01908 * IF BATCH-STATUS-OK-88 DTSBX418 01909 * NEXT SENTENCE DTSBX418 01910 * ELSE DTSBX418 01911 * DISPLAY 'T1100 - CANNOT REWRITE BATCH NUMBER FILE ' DTSBX418 01912 * BATCH-STATUS DTSBX418 01913 * END-IF. DTSBX418 01914 * DTSBX418 01915 *T1100-EXIT. DTSBX418 01916 * EXIT. DTSBX418 01917 DTSBX418 01918 S001-FROM-FED-8. DTSBX418 01919 SET L001-FROM-FED-8 TO TRUE. DTSBX418 01920 GO TO S001-DATE. DTSBX418 01921 DTSBX418 01922 S001-FROM-CAL-8. DTSBX418 01923 SET L001-FROM-CAL-8 TO TRUE. DTSBX418 01924 GO TO S001-DATE. DTSBX418 01925 DTSBX418 01926 S001-FROM-ABS-DAY. DTSBX418 01927 SET L001-FROM-ABS-DAY TO TRUE. DTSBX418 01928 GO TO S001-DATE. DTSBX418 01929 DTSBX418 01930 S001-DATE. DTSBX418 01931 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX418 01932 S001-EXIT. DTSBX418 01933 EXIT. DTSBX418 01934 DTSBX418 01935 S003-AGENCY-DAY. DTSBX418 01936 SET L003-AGENCY-DAY TO TRUE. DTSBX418 01937 GO TO S003-WORK-DAY. DTSBX418 01938 DTSBX418 01939 S003-WORK-DAY. DTSBX418 01940 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBX418 01941 S003-EXIT. DTSBX418 01942 EXIT. DTSBX418 01943 DTSBX418 01944 S004-FROM-5. DTSBX418 01945 SET L004-FROM-5 TO TRUE. DTSBX418 01946 GO TO S004-YRQ. DTSBX418 01947 DTSBX418 01948 S004-FROM-DATE. DTSBX418 01949 SET L004-FROM-DATE TO TRUE. DTSBX418 01950 GO TO S004-YRQ. DTSBX418 01951 DTSBX418 01952 S004-FROM-ABS. DTSBX418 01953 SET L004-FROM-ABS TO TRUE. DTSBX418 01954 GO TO S004-YRQ. DTSBX418 01955 DTSBX418 01956 S004-YRQ. DTSBX418 01957 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX418 01958 DTSBX418 01959 S004-EXIT. DTSBX418 01960 EXIT. DTSBX418 01961 DTSBX418 01962 S005-FROM-SYS. DTSBX418 01963 SET L005-FROM-SYS TO TRUE. DTSBX418 01964 GO TO S005-ABSTIME. DTSBX418 01965 DTSBX418 01966 S005-ABSTIME. DTSBX418 01967 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX418 01968 S005-EXIT. DTSBX418 01969 EXIT. DTSBX418 01970 DTSBX418 01971 S421-REGISTRATION. DTSBX418 01972 DISPLAY 'CALL S421-REGISTRATION'. CL**8 01973 CALL 'DTSBX421' USING LX42-LINK-AREA. DTSBX418 01974 S421-EXIT. DTSBX418 01975 EXIT. DTSBX418 01976 DTSBX418 01977 S422-REPORT-PAYMT. CL*23 01978 DISPLAY 'CALL S422-REPORTS- WAGES AND PAYMENTS-PENDING'. CL*45 01979 CALL 'DTSBX436' USING LX42-LINK-AREA. CL*48 01980 S422-EXIT. DTSBX418 01981 EXIT. DTSBX418 01982 DTSBX418 01983 *S423-PAYMENT. CL*23 01984 * DISPLAY 'CALL S423-PAYMENT'. CL*23 01985 * CALL 'DTSBX423' USING LX42-LINK-AREA. CL*23 01986 *S423-EXIT. CL*23 01987 * EXIT. CL*23 01988 DTSBX418 01989 S424-PROFILE. DTSBX418 01990 DISPLAY 'CALL S424-PROFILE' CL**8 01991 ** DISPLAY 'LINK AREA ' LX42-LINK-AREA DTSBX418 01992 CALL 'DTSBX424' USING LX42-LINK-AREA. DTSBX418 01993 S424-EXIT. DTSBX418 01994 EXIT. DTSBX418 01995 DTSBX418 01996 S426-HEADER. DTSBX418 01997 CALL 'DTSBX426' USING LX42-LINK-AREA. DTSBX418 01998 S426-EXIT. DTSBX418 01999 EXIT. DTSBX418 02000 DTSBX418 02001 DTSBX418 02002 S910-OPEN-READ. DTSBX418 02003 SET L910-OPEN-READ-88 TO TRUE. DTSBX418 02004 GO TO S910-MSTR-IO. DTSBX418 02005 DTSBX418 02006 S910-OPEN-UPDATE. DTSBX418 02007 SET L910-OPEN-UPDATE-88 TO TRUE. DTSBX418 02008 GO TO S910-MSTR-IO. DTSBX418 02009 DTSBX418 02010 S910-READ. DTSBX418 02011 SET L910-READ-88 TO TRUE. DTSBX418 02012 GO TO S910-MSTR-IO. DTSBX418 02013 DTSBX418 02014 S910-START-BROWSE. DTSBX418 02015 SET L910-START-BROWSE-88 TO TRUE. DTSBX418 02016 GO TO S910-MSTR-IO. DTSBX418 02017 DTSBX418 02018 S910-READ-NEXT. DTSBX418 02019 SET L910-READ-NEXT-88 TO TRUE. DTSBX418 02020 GO TO S910-MSTR-IO. DTSBX418 02021 DTSBX418 02022 S910-CLOSE. DTSBX418 02023 SET L910-CLOSE-88 TO TRUE. DTSBX418 02024 GO TO S910-MSTR-IO. DTSBX418 02025 DTSBX418 02026 S910-MSTR-IO. DTSBX418 02027 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX418 02028 MSKL-REC. DTSBX418 02029 S910-EXIT. DTSBX418 02030 EXIT. DTSBX418 02031 DTSBX418 02032 S921-OPEN-READ. DTSBX418 02033 SET L921-OPEN-READ-88 TO TRUE. DTSBX418 02034 GO TO S921-AIX-IO. DTSBX418 02035 DTSBX418 02036 S921-READ. DTSBX418 02037 SET L921-READ-88 TO TRUE. DTSBX418 02038 GO TO S921-AIX-IO. DTSBX418 02039 DTSBX418 02040 S921-START-BROWSE. DTSBX418 02041 SET L921-START-BROWSE-88 TO TRUE. DTSBX418 02042 GO TO S921-AIX-IO. DTSBX418 02043 DTSBX418 02044 S921-READ-NEXT. DTSBX418 02045 SET L921-READ-NEXT-88 TO TRUE. DTSBX418 02046 GO TO S921-AIX-IO. DTSBX418 02047 DTSBX418 02048 S921-CLOSE. DTSBX418 02049 SET L921-CLOSE-88 TO TRUE. DTSBX418 02050 GO TO S921-AIX-IO. DTSBX418 02051 DTSBX418 02052 S921-AIX-IO. DTSBX418 02053 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX418 02054 ISKL-REC. DTSBX418 02055 S921-EXIT. DTSBX418 02056 EXIT. DTSBX418 02057 DTSBX418 02058 S923-OPEN-UPDATE. DTSBX418 02059 SET L923-OPEN-UPDATE-88 TO TRUE. DTSBX418 02060 GO TO S923-ATC-CALL. DTSBX418 02061 DTSBX418 02062 S923-OPEN-READ. DTSBX418 02063 SET L923-OPEN-READ-88 TO TRUE. DTSBX418 02064 GO TO S923-ATC-CALL. DTSBX418 02065 DTSBX418 02066 S923-WRITE. DTSBX418 02067 SET L923-WRITE-88 TO TRUE. DTSBX418 02068 GO TO S923-ATC-CALL. DTSBX418 02069 DTSBX418 02070 S923-CLOSE. DTSBX418 02071 SET L923-CLOSE-88 TO TRUE. DTSBX418 02072 GO TO S923-ATC-CALL. DTSBX418 02073 DTSBX418 02074 S923-ATC-CALL. DTSBX418 02075 CALL 'DTSBU923' USING L923-LINK-AREA DTSBX418 02076 ASKL-REC. DTSBX418 02077 S923-EXIT. DTSBX418 02078 EXIT. DTSBX418 02079 DTSBX418 02080 S927A-OPEN. DTSBX418 02081 SET L927-OPEN-UPDATE-88 TO TRUE. DTSBX418 02082 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX418 02083 DTSBX418 02084 S927A-EXIT. DTSBX418 02085 EXIT. DTSBX418 02086 DTSBX418 02087 S927C-CLOSE. DTSBX418 02088 SET L927-CLOSE-88 TO TRUE. DTSBX418 02089 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX418 02090 DTSBX418 02091 S927C-EXIT. DTSBX418 02092 EXIT. DTSBX418 02093 DTSBX418 02094 S927Z-IO. DTSBX418 02095 CALL 'DTSBU927' USING L927-LINK-AREA DTSBX418 02096 TSKL-REC. DTSBX418 02097 S927Z-EXIT. DTSBX418 02098 EXIT. DTSBX418 02099 DTSBX418 02100 S931-OPEN-READ. DTSBX418 02101 SET L931-OPEN-READ-88 TO TRUE. DTSBX418 02102 GO TO S931-REF-IO. DTSBX418 02103 DTSBX418 02104 S931-CLOSE. DTSBX418 02105 SET L931-CLOSE-88 TO TRUE. DTSBX418 02106 GO TO S931-REF-IO. DTSBX418 02107 DTSBX418 02108 S931-REF-IO. DTSBX418 02109 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX418 02110 FSKL-REC. DTSBX418 02111 S931-EXIT. DTSBX418 02112 EXIT. DTSBX418 02113 DTSBX418 02114 S1000-READ-WEB-IMP. DTSBX418 02115 READ WEB-IMP-FILE. DTSBX418 02116 IF WEB-IMP-STATUS-OK-88 DTSBX418 02117 ADD +1 TO W-WEB-IMP-CNT DTSBX418 02118 ELSE DTSBX418 02119 IF WEB-IMP-STATUS-EOF-88 DTSBX418 02120 DISPLAY 'ENE OF WEB-IMP-FILE ' WEB-IMP-STATUS CL**3 02121 ELSE DTSBX418 02122 DISPLAY 'CANNOT READ WEB-IMP-FILE ' WEB-IMP-STATUS DTSBX418 02123 SET W-ERROR-YES-88 TO TRUE DTSBX418 02124 END-IF DTSBX418 02125 END-IF. DTSBX418 02126 DTSBX418 02127 * DISPLAY 'S1000-READ WEB ' WEB-IMP-TYPE ' ' WEB-IMP-EMP-NO. CL*12 02128 DTSBX418 02129 S1000-EXIT. DTSBX418 02130 EXIT. DTSBX418 02131 DTSBX418 02132 S999-ABEND. DTSBX418 02133 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX418 02134 S999-EXIT. DTSBX418 02135 EXIT. DTSBX418 02136 DTSBX418