giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
main
DUTAS/Batch/DTSBX415.cob
Neeraj Kumar ca3572c5df DUTAS re-platformed to Raincode - Initial Source Code
2025-07-21 11:20:11 -04:00

2102 lines
166 KiB
COBOL
Raw Permalink Blame History

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
Reference in New Issue View Git Blame Copy Permalink