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