00001 IDENTIFICATION DIVISION. 09/21/10 00002 PROGRAM-ID. DTSBU205. DTSBU205 00003 AUTHOR. NGC. LV001 00004 DATE-WRITTEN. APRIL 2010. DTSBU205 00005 DATE-COMPILED. DTSBU205 00006 SKIP3 DTSBU205 00007 ***** DTSBU205 00008 * DTSBU205 00009 * FUNCTION: PARSE COMMA DELIMITED DATA DTSBU205 00010 * SEPARATE EACH DATA FIELD, DTSBU205 00011 * AND RETURN IT TO THE CALLING PROGRAM. DTSBU205 00012 * DTSBU205 00013 ***** DTSBU205 00014 SKIP3 DTSBU205 00015 ENVIRONMENT DIVISION. DTSBU205 00016 DATA DIVISION. DTSBU205 00017 DTSBU205 00018 WORKING-STORAGE SECTION. DTSBU205 000185 77 PAN-VALET PICTURE X(24) VALUE '001DTSBU205 09/21/10'. DTSBU205 00019 01 WORK-AREA. DTSBU205 00020 05 W-ABEND-CD PIC S9(04) COMP VALUE +200.DTSBU205 00021 05 ABEND-MSG PIC X(60). DTSBU205 00022 DTSBU205 00023 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBU205 00024 88 W-ERROR-YES-88 VALUE 'Y'. DTSBU205 00025 88 W-ERROR-NO-88 VALUE 'N'. DTSBU205 00026 DTSBU205 00027 05 W-INTEGER PIC S9(11) COMP-3. DTSBU205 00028 05 W-INTEGER-X PIC X(11). DTSBU205 00029 05 W-INTEGER-9 REDEFINES W-INTEGER-X DTSBU205 00030 PIC 9(11). DTSBU205 00031 05 W-FRACTION-X PIC X(11). DTSBU205 00032 05 W-FRACTION-9 PIC SV9(11). DTSBU205 00033 DTSBU205 00034 05 W-FRACTION PIC SV9(11) COMP-3. DTSBU205 00035 DTSBU205 00036 DTSBU205 00037 05 W-MULTIPLIER PIC S9(11)V9(04) COMP-3 DTSBU205 00038 VALUE +0. DTSBU205 00039 05 W-DIGIT PIC 9. DTSBU205 00040 05 W-AMT-INT PIC S9(11) COMP-3 DTSBU205 00041 VALUE +0. DTSBU205 00042 05 W-AMT-FRACTION PIC SV9(11) COMP-3 DTSBU205 00043 VALUE +0. DTSBU205 00044 05 W-INT PIC S9(11) COMP-3 DTSBU205 00045 VALUE +0. DTSBU205 00046 05 SUB PIC S9(04) COMP. DTSBU205 00047 05 W-DECIMAL-NDX PIC S9(04) COMP. DTSBU205 00048 DTSBU205 00049 05 W-DATE PIC X(10). DTSBU205 00050 05 W-SLASH-DATE PIC X(10). DTSBU205 00051 05 FILLER REDEFINES W-SLASH-DATE. DTSBU205 00052 10 W-SLASH-DT-MM PIC X(02). DTSBU205 00053 10 FILLER PIC X(01). DTSBU205 00054 10 W-SLASH-DT-DD PIC X(02). DTSBU205 00055 10 FILLER PIC X(01). DTSBU205 00056 10 W-SLASH-DT-CCYY PIC X(04). DTSBU205 00057 DTSBU205 00058 05 W-SLASH-QTR PIC X(06). DTSBU205 00059 05 FILLER REDEFINES W-SLASH-QTR. DTSBU205 00060 10 W-SLASH-QTR-CCYY PIC X(04). DTSBU205 00061 10 FILLER PIC X(01). DTSBU205 00062 10 W-SLASH-QTR-Q PIC X(01). DTSBU205 00063 DTSBU205 00064 05 PSUB PIC S9(04) COMP. DTSBU205 00065 05 ISUB1 PIC S9(04) COMP. DTSBU205 00066 05 ISUB2 PIC S9(04) COMP. DTSBU205 00067 05 ISUB3 PIC S9(04) COMP. DTSBU205 00068 05 ISUB4 PIC S9(04) COMP. DTSBU205 00069 05 ISUB5 PIC S9(04) COMP. DTSBU205 00070 05 ISUB6 PIC S9(04) COMP. DTSBU205 00071 05 W-SLASH1 PIC S9(04) COMP. DTSBU205 00072 05 W-SLASH2 PIC S9(04) COMP. DTSBU205 00073 05 W-CURR-FIELD PIC S9(04) COMP. DTSBU205 00074 05 W-LAST-FIELD PIC S9(04) COMP. DTSBU205 00075 05 W-LAST-FIELD-LEN PIC S9(04) COMP. DTSBU205 00076 DTSBU205 00077 05 W-INPUT-LENGTH PIC S9(04) COMP DTSBU205 00078 VALUE +502. DTSBU205 00079 05 W-INPUT-LINE PIC X(500). DTSBU205 00080 05 W-PARSE-COMPLETE-IND PIC X(01). DTSBU205 00081 88 W-PARSE-COMPLETE-YES-88 VALUE 'Y'. DTSBU205 00082 88 W-PARSE-COMPLETE-NO-88 VALUE 'N'. DTSBU205 00083 05 W-NON-NUMERIC-IND PIC X(01). DTSBU205 00084 88 W-NON-NUMERIC-YES-88 VALUE 'Y'. DTSBU205 00085 88 W-NON-NUMERIC-NO-88 VALUE 'N'. DTSBU205 00086 05 W-FIELD-LENGTH PIC S9(04) COMP. DTSBU205 00087 05 W-CONV-LINE PIC X(32). DTSBU205 00088 DTSBU205 00089 05 W-MDY PIC X(04). DTSBU205 00090 05 FILLER REDEFINES W-MDY. DTSBU205 00091 10 FILLER PIC X(02). DTSBU205 00092 10 W-MDY-X-2 PIC X(02). DTSBU205 00093 10 FILLER REDEFINES W-MDY-X-2. DTSBU205 00094 15 FILLER PIC X(01). DTSBU205 00095 15 W-MDY-X-1 PIC X(01). DTSBU205 00096 DTSBU205 00097 DTSBU205 00098 05 AMT-DISP1 PIC --------9.99. DTSBU205 00099 05 AMT-DISP2 PIC --------9.99. DTSBU205 00100 05 AMT-DISP3 PIC --------9.99. DTSBU205 00101 05 AMT-DISP4 PIC --------9.99. DTSBU205 00102 05 AMT-DISP-FRACTION PIC .9(11). DTSBU205 00103 DTSBU205 00104 05 CNT-DISP1 PIC ------9. DTSBU205 00105 DTSBU205 00106 01 L001-LINK-AREA. DTSBU205 00107 ++INCLUDE DTSIL001 DTSBU205 00108 DTSBU205 00109 LINKAGE SECTION. DTSBU205 00110 DTSBU205 00111 01 L205-LINK-AREA. DTSBU205 00112 ++INCLUDE DTSIL205 DTSBU205 00113 DTSBU205 00114 PROCEDURE DIVISION USING L205-LINK-AREA. DTSBU205 00115 DTSBU205 00116 PERFORM I0000-INIT THRU I0000-EXIT. DTSBU205 00117 DTSBU205 00118 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBU205 00119 DTSBU205 00120 GOBACK. DTSBU205 00121 DTSBU205 00122 I0000-INIT. DTSBU205 00123 IF L205-LAST-FIELD = ZERO DTSBU205 00124 DISPLAY 'DTSBU205: LAST FIELD = ZERO' DTSBU205 00125 PERFORM S999-ABEND THRU S999-EXIT DTSBU205 00126 END-IF. DTSBU205 00127 DTSBU205 00128 IF L205-LAST-FIELD-LEN = ZERO DTSBU205 00129 DISPLAY 'DTSBU205: LAST FIELD LENGTH = ZERO' DTSBU205 00130 PERFORM S999-ABEND THRU S999-EXIT DTSBU205 00131 END-IF. DTSBU205 00132 DTSBU205 00133 PERFORM DTSBU205 00134 VARYING SUB FROM +1 BY +1 DTSBU205 00135 UNTIL SUB > L205-FIELDS-MAX-LEN DTSBU205 00136 MOVE SPACES TO L205-TEXT (SUB) DTSBU205 00137 MOVE +0 TO L205-INTEGER (SUB) DTSBU205 00138 L205-FRACTION (SUB) DTSBU205 00139 SET L205-VALID-YES-88 (SUB) TO TRUE DTSBU205 00140 END-PERFORM. DTSBU205 00141 DTSBU205 00142 I0000-EXIT. DTSBU205 00143 EXIT. DTSBU205 00144 DTSBU205 00145 P0000-PROCESS. DTSBU205 00146 *& DTSBU205 00147 * DISPLAY 'BU205 -1 ' L205-INPUT-DATA (1:32). DTSBU205 00148 *& DTSBU205 00149 DTSBU205 00150 PERFORM P1000-PARSE THRU P1000-EXIT. DTSBU205 00151 DTSBU205 00152 DTSBU205 00153 P0000-EXIT. DTSBU205 00154 EXIT. DTSBU205 00155 DTSBU205 00156 DTSBU205 00157 P1000-PARSE. DTSBU205 00158 MOVE L205-LAST-FIELD TO W-LAST-FIELD. DTSBU205 00159 MOVE L205-LAST-FIELD-LEN TO W-LAST-FIELD-LEN. DTSBU205 00160 DTSBU205 00161 SET W-PARSE-COMPLETE-NO-88 TO TRUE. DTSBU205 00162 MOVE +1 TO PSUB. DTSBU205 00163 MOVE +0 TO ISUB2. DTSBU205 00164 MOVE +1 TO W-CURR-FIELD. DTSBU205 00165 MOVE SPACES TO W-INPUT-LINE. DTSBU205 00166 DTSBU205 00167 PERFORM DTSBU205 00168 UNTIL W-PARSE-COMPLETE-YES-88 DTSBU205 00169 IF L205-INPUT-DATA (PSUB:1) NOT = ',' DTSBU205 00170 IF W-CURR-FIELD = W-LAST-FIELD DTSBU205 00171 PERFORM P1100-LAST-FIELD THRU P1100-EXIT DTSBU205 00172 ELSE DTSBU205 00173 PERFORM P1200-MOVE-CHAR THRU P1200-EXIT DTSBU205 00174 END-IF DTSBU205 00175 ELSE DTSBU205 00176 PERFORM P2000-MOVE-TO-REC THRU P2000-EXIT DTSBU205 00177 ADD +1 TO W-CURR-FIELD DTSBU205 00178 IF W-CURR-FIELD > 100 DTSBU205 00179 DISPLAY 'DTSBU205 TABLE LENGTH EXCEEDED ' DTSBU205 00180 PERFORM S999-ABEND THRU S999-EXIT DTSBU205 00181 END-IF DTSBU205 00182 MOVE +0 TO ISUB2 DTSBU205 00183 MOVE SPACES TO W-INPUT-LINE DTSBU205 00184 IF L205-INPUT-DATA ((PSUB + 1):1) = ',' DTSBU205 00185 ADD +1 TO PSUB DTSBU205 00186 PERFORM P2000-MOVE-TO-REC THRU P2000-EXIT DTSBU205 00187 ADD +1 TO W-CURR-FIELD DTSBU205 00188 END-IF DTSBU205 00189 END-IF DTSBU205 00190 ADD +1 TO PSUB DTSBU205 00191 IF PSUB > W-INPUT-LENGTH DTSBU205 00192 SET W-PARSE-COMPLETE-YES-88 TO TRUE DTSBU205 00193 END-IF DTSBU205 00194 END-PERFORM. DTSBU205 00195 DTSBU205 00196 PERFORM P2000-MOVE-TO-REC THRU P2000-EXIT. DTSBU205 00197 DTSBU205 00198 P1000-EXIT. DTSBU205 00199 EXIT. DTSBU205 00200 DTSBU205 00201 P1100-LAST-FIELD. DTSBU205 00202 ** DISPLAY 'LAST ' L205-INPUT-DATA (PSUB:1) DTSBU205 00203 ADD +1 TO ISUB2 DTSBU205 00204 IF ISUB2 > W-LAST-FIELD-LEN DTSBU205 00205 OR L205-INPUT-DATA (PSUB:1) = ',' DTSBU205 00206 SET W-PARSE-COMPLETE-YES-88 TO TRUE DTSBU205 00207 ELSE DTSBU205 00208 MOVE L205-INPUT-DATA (PSUB:1) DTSBU205 00209 TO W-INPUT-LINE (ISUB2:1) DTSBU205 00210 END-IF. DTSBU205 00211 DTSBU205 00212 ** DISPLAY 'LAST 2: ' ISUB2 ' ' W-INPUT-LINE (1:32). DTSBU205 00213 P1100-EXIT. DTSBU205 00214 EXIT. DTSBU205 00215 DTSBU205 00216 P1200-MOVE-CHAR. DTSBU205 00217 ADD +1 TO ISUB2. DTSBU205 00218 MOVE L205-INPUT-DATA (PSUB:1) DTSBU205 00219 TO W-INPUT-LINE (ISUB2:1). DTSBU205 00220 DTSBU205 00221 P1200-EXIT. DTSBU205 00222 EXIT. DTSBU205 00223 DTSBU205 00224 P2000-MOVE-TO-REC. DTSBU205 00225 *& DTSBU205 00226 * DISPLAY 'BU205 P2000 ' W-CURR-FIELD ' ' DTSBU205 00227 * W-INPUT-LINE (1:32). DTSBU205 00228 *& DTSBU205 00229 SET W-NON-NUMERIC-NO-88 TO TRUE. DTSBU205 00230 EVALUATE TRUE DTSBU205 00231 WHEN L205-TYPE-TEXT-88 (W-CURR-FIELD) DTSBU205 00232 MOVE W-INPUT-LINE (1:L205-FIELD-LENGTH (W-CURR-FIELD)) DTSBU205 00233 TO L205-TEXT (W-CURR-FIELD) DTSBU205 00234 DTSBU205 00235 WHEN L205-TYPE-NUMBER-88 (W-CURR-FIELD) DTSBU205 00236 PERFORM S2200-CONV-AMT THRU S2200-EXIT DTSBU205 00237 MOVE W-INTEGER TO L205-INTEGER (W-CURR-FIELD) DTSBU205 00238 MOVE W-FRACTION TO L205-FRACTION (W-CURR-FIELD) DTSBU205 00239 DTSBU205 00240 WHEN L205-TYPE-DATE-88 (W-CURR-FIELD) DTSBU205 00241 PERFORM S2300-CONV-DATE THRU S2300-EXIT DTSBU205 00242 MOVE W-DATE TO L205-DATE (W-CURR-FIELD) DTSBU205 00243 DTSBU205 00244 END-EVALUATE. DTSBU205 00245 DTSBU205 00246 P2000-EXIT. DTSBU205 00247 EXIT. DTSBU205 00248 DTSBU205 00249 S2200-CONV-AMT. DTSBU205 00250 MOVE ZEROS TO W-CONV-LINE DTSBU205 00251 W-INTEGER-9 DTSBU205 00252 W-INTEGER-X DTSBU205 00253 W-FRACTION-9 DTSBU205 00254 W-FRACTION-X DTSBU205 00255 W-INTEGER DTSBU205 00256 W-FRACTION. DTSBU205 00257 MOVE +32 TO ISUB4. DTSBU205 00258 MOVE +0 TO W-DECIMAL-NDX. DTSBU205 00259 DTSBU205 00260 ** DISPLAY 'BU205 S2200 INP ' W-INPUT-LINE(1:15) DTSBU205 00261 ** ' ' W-FRACTION-X. DTSBU205 00262 ******************************************************* DTSBU205 00263 * FIND LOCATION OF DECIMAL POINT, IF ANY DTSBU205 00264 ******************************************************* DTSBU205 00265 DTSBU205 00266 PERFORM DTSBU205 00267 VARYING ISUB3 FROM +32 BY -1 DTSBU205 00268 UNTIL ISUB3 < +1 DTSBU205 00269 OR W-DECIMAL-NDX > ZERO DTSBU205 00270 IF W-INPUT-LINE (ISUB3:1) = '.' DTSBU205 00271 MOVE ISUB3 TO W-DECIMAL-NDX DTSBU205 00272 END-IF DTSBU205 00273 END-PERFORM. DTSBU205 00274 DTSBU205 00275 *& DTSBU205 00276 * DISPLAY 'S2200 DEC NDX ' W-DECIMAL-NDX. DTSBU205 00277 *& DTSBU205 00278 IF W-DECIMAL-NDX NOT = ZERO DTSBU205 00279 PERFORM S2220-FRACTION THRU S2220-EXIT DTSBU205 00280 END-IF. DTSBU205 00281 PERFORM S2210-INTEGER THRU S2210-EXIT. DTSBU205 00282 DTSBU205 00283 IF W-NON-NUMERIC-YES-88 DTSBU205 00284 DISPLAY 'NON-NUMERIC DATA FOUND ' DTSBU205 00285 SET L205-VALID-NO-88 (W-CURR-FIELD) TO TRUE DTSBU205 00286 END-IF. DTSBU205 00287 DTSBU205 00288 S2200-EXIT. DTSBU205 00289 EXIT. DTSBU205 00290 DTSBU205 00291 S2210-INTEGER. DTSBU205 00292 MOVE +1 TO W-MULTIPLIER. DTSBU205 00293 DTSBU205 00294 IF W-DECIMAL-NDX = ZERO DTSBU205 00295 MOVE ISUB2 TO ISUB1 DTSBU205 00296 ELSE DTSBU205 00297 COMPUTE ISUB1 = W-DECIMAL-NDX - 1 DTSBU205 00298 END-IF. DTSBU205 00299 DTSBU205 00300 MOVE +11 TO ISUB3. DTSBU205 00301 DTSBU205 00302 PERFORM DTSBU205 00303 VARYING SUB FROM ISUB1 BY -1 DTSBU205 00304 UNTIL SUB < +1 DTSBU205 00305 IF W-INPUT-LINE (SUB:1) >= '0' AND <= '9' DTSBU205 00306 MOVE W-INPUT-LINE (SUB:1) TO W-INTEGER-X (ISUB3:1) DTSBU205 00307 SUBTRACT +1 FROM ISUB3 DTSBU205 00308 ELSE DTSBU205 00309 IF W-INPUT-LINE (SUB:1) NOT = '.' AND ' ' DTSBU205 00310 SET W-NON-NUMERIC-YES-88 TO TRUE DTSBU205 00311 DISPLAY 'NON-NUM I ' W-INPUT-LINE (SUB:1) ' ' DTSBU205 00312 SUB ' ' W-INPUT-LINE (1:32) DTSBU205 00313 END-IF DTSBU205 00314 END-IF DTSBU205 00315 END-PERFORM. DTSBU205 00316 DTSBU205 00317 *& DTSBU205 00318 ** DISPLAY 'S2210 INT-X ' W-INTEGER-X. DTSBU205 00319 *& DTSBU205 00320 DTSBU205 00321 PERFORM DTSBU205 00322 VARYING SUB FROM +11 BY -1 DTSBU205 00323 UNTIL SUB < +1 DTSBU205 00324 MOVE W-INTEGER-X (SUB:1) TO W-DIGIT DTSBU205 00325 COMPUTE W-AMT-INT = (W-DIGIT * W-MULTIPLIER) DTSBU205 00326 COMPUTE W-INTEGER = (W-INTEGER + W-AMT-INT) DTSBU205 00327 COMPUTE W-MULTIPLIER = (W-MULTIPLIER * 10) DTSBU205 00328 END-PERFORM. DTSBU205 00329 DTSBU205 00330 *& DTSBU205 00331 * MOVE W-INTEGER TO AMT-DISP1. DTSBU205 00332 * DISPLAY 'S2210 INTEGER ' AMT-DISP1. DTSBU205 00333 *& DTSBU205 00334 DTSBU205 00335 S2210-EXIT. DTSBU205 00336 EXIT. DTSBU205 00337 DTSBU205 00338 S2220-FRACTION. DTSBU205 00339 MOVE +0.1 TO W-MULTIPLIER. DTSBU205 00340 DTSBU205 00341 COMPUTE ISUB1 = W-DECIMAL-NDX DTSBU205 00342 MOVE +1 TO ISUB3. DTSBU205 00343 DTSBU205 00344 PERFORM DTSBU205 00345 VARYING SUB FROM ISUB1 BY +1 DTSBU205 00346 UNTIL SUB > ISUB2 DTSBU205 00347 IF W-INPUT-LINE (SUB:1) >= '0' AND <= '9' DTSBU205 00348 MOVE W-INPUT-LINE (SUB:1) DTSBU205 00349 TO W-FRACTION-X (ISUB3:1) DTSBU205 00350 ADD +1 TO ISUB3 DTSBU205 00351 ELSE DTSBU205 00352 IF W-INPUT-LINE (SUB:1) NOT = '.' AND ' ' DTSBU205 00353 SET W-NON-NUMERIC-YES-88 TO TRUE DTSBU205 00354 DISPLAY 'NON-NUM F ' W-INPUT-LINE (SUB:1) ' ' DTSBU205 00355 SUB ' ' W-INPUT-LINE (1:32) DTSBU205 00356 END-IF DTSBU205 00357 END-IF DTSBU205 00358 END-PERFORM. DTSBU205 00359 DTSBU205 00360 *& DTSBU205 00361 * DISPLAY 'S2220 FRA-X ' W-FRACTION-X. DTSBU205 00362 *& DTSBU205 00363 PERFORM DTSBU205 00364 VARYING SUB FROM +1 BY +1 DTSBU205 00365 UNTIL SUB > ISUB3 DTSBU205 00366 MOVE W-FRACTION-X (SUB:1) TO W-DIGIT DTSBU205 00367 *** DISPLAY 'W-DIGIT ' W-DIGIT DTSBU205 00368 COMPUTE W-AMT-FRACTION = (W-DIGIT * W-MULTIPLIER) DTSBU205 00369 COMPUTE W-FRACTION = (W-FRACTION + W-AMT-FRACTION) DTSBU205 00370 COMPUTE W-MULTIPLIER = (W-MULTIPLIER / 10) DTSBU205 00371 * MOVE W-FRACTION TO AMT-DISP2 DTSBU205 00372 END-PERFORM. DTSBU205 00373 DTSBU205 00374 *& DTSBU205 00375 * MOVE W-FRACTION TO AMT-DISP-FRACTION. DTSBU205 00376 * DISPLAY 'S2220 FRACTION ' W-FRACTION ' ' DTSBU205 00377 * AMT-DISP-FRACTION. DTSBU205 00378 *& DTSBU205 00379 S2220-EXIT. DTSBU205 00380 EXIT. DTSBU205 00381 DTSBU205 00382 S2300-CONV-DATE. DTSBU205 00383 IF W-INPUT-LINE = SPACES DTSBU205 00384 GO TO S2300-EXIT DTSBU205 00385 END-IF. DTSBU205 00386 DTSBU205 00387 MOVE W-INPUT-LINE (1:ISUB2) TO W-CONV-LINE. DTSBU205 00388 MOVE ZEROS TO L001-SLASH-8-MO DTSBU205 00389 L001-SLASH-8-DA DTSBU205 00390 L001-SLASH-8-YR. DTSBU205 00391 DTSBU205 00392 MOVE ZEROS TO W-MDY. DTSBU205 00393 **************************************************** DTSBU205 00394 * GET LOCATION OF SLASHES IN DATE DTSBU205 00395 **************************************************** DTSBU205 00396 MOVE +0 TO W-SLASH1 DTSBU205 00397 W-SLASH2. DTSBU205 00398 DTSBU205 00399 PERFORM DTSBU205 00400 VARYING ISUB3 FROM +1 BY +1 DTSBU205 00401 UNTIL ISUB3 > ISUB2 DTSBU205 00402 OR W-SLASH2 > ZERO DTSBU205 00403 IF W-CONV-LINE (ISUB3:1) = '/' DTSBU205 00404 IF W-SLASH1 = ZERO DTSBU205 00405 MOVE ISUB3 TO W-SLASH1 DTSBU205 00406 ELSE DTSBU205 00407 MOVE ISUB3 TO W-SLASH2 DTSBU205 00408 END-IF DTSBU205 00409 END-IF DTSBU205 00410 END-PERFORM. DTSBU205 00411 DTSBU205 00412 IF W-SLASH1 = ZERO DTSBU205 00413 OR W-SLASH2 = ZERO DTSBU205 00414 DISPLAY 'BU205 INVALID DATE ' W-CONV-LINE DTSBU205 00415 SET L205-VALID-NO-88 (W-CURR-FIELD) TO TRUE DTSBU205 00416 GO TO S2300-EXIT DTSBU205 00417 END-IF. DTSBU205 00418 DTSBU205 00419 **************************************************** DTSBU205 00420 * GET MONTH DTSBU205 00421 **************************************************** DTSBU205 00422 IF W-SLASH1 = 3 DTSBU205 00423 MOVE W-CONV-LINE (1:2) TO W-MDY-X-2 DTSBU205 00424 ELSE DTSBU205 00425 IF W-SLASH1 = 2 DTSBU205 00426 MOVE W-CONV-LINE (1:1) TO W-MDY-X-1 DTSBU205 00427 END-IF DTSBU205 00428 END-IF. DTSBU205 00429 DTSBU205 00430 IF (W-MDY-X-2 (1:1) >= '0' AND <= '9') DTSBU205 00431 AND (W-MDY-X-2 (2:1) >= '0' AND <= '9') DTSBU205 00432 MOVE W-MDY-X-2 TO L001-SLASH-8-MO DTSBU205 00433 ELSE DTSBU205 00434 MOVE ZEROS TO L001-SLASH-8-MO DTSBU205 00435 END-IF. DTSBU205 00436 DTSBU205 00437 **************************************************** DTSBU205 00438 * GET DAY DTSBU205 00439 **************************************************** DTSBU205 00440 MOVE ZEROS TO W-MDY. DTSBU205 00441 IF W-SLASH1 = 3 DTSBU205 00442 IF W-SLASH2 = 6 DTSBU205 00443 MOVE W-CONV-LINE (4:2) TO W-MDY-X-2 DTSBU205 00444 ELSE DTSBU205 00445 IF W-SLASH2 = 5 DTSBU205 00446 MOVE W-CONV-LINE (4:1) TO W-MDY-X-1 DTSBU205 00447 END-IF DTSBU205 00448 END-IF DTSBU205 00449 ELSE DTSBU205 00450 IF W-SLASH1 = 2 DTSBU205 00451 IF W-SLASH2 = 5 DTSBU205 00452 MOVE W-CONV-LINE (3:2) TO W-MDY-X-2 DTSBU205 00453 ELSE DTSBU205 00454 IF W-SLASH2 = 4 DTSBU205 00455 MOVE W-CONV-LINE (3:1) TO W-MDY-X-1 DTSBU205 00456 END-IF DTSBU205 00457 END-IF DTSBU205 00458 END-IF DTSBU205 00459 END-IF. DTSBU205 00460 DTSBU205 00461 IF (W-MDY-X-2 (1:1) >= '0' AND <= '9') DTSBU205 00462 AND (W-MDY-X-2 (2:1) >= '0' AND <= '9') DTSBU205 00463 MOVE W-MDY-X-2 TO L001-SLASH-8-DA DTSBU205 00464 ELSE DTSBU205 00465 MOVE ZEROS TO L001-SLASH-8-DA DTSBU205 00466 END-IF. DTSBU205 00467 DTSBU205 00468 **************************************************** DTSBU205 00469 * GET YEAR DTSBU205 00470 **************************************************** DTSBU205 00471 MOVE ZEROS TO W-MDY. DTSBU205 00472 MOVE +1 TO ISUB4. DTSBU205 00473 COMPUTE ISUB5 = (W-SLASH2 + 1). DTSBU205 00474 COMPUTE ISUB6 = (ISUB5 + 4). DTSBU205 00475 PERFORM DTSBU205 00476 VARYING ISUB3 FROM ISUB5 BY +1 DTSBU205 00477 UNTIL ISUB3 > ISUB6 DTSBU205 00478 IF (W-CONV-LINE (ISUB3:1) >= '0' AND <= '9') DTSBU205 00479 MOVE W-CONV-LINE (ISUB3:1) TO W-MDY (ISUB4:1) DTSBU205 00480 ADD +1 TO ISUB4 DTSBU205 00481 END-IF DTSBU205 00482 END-PERFORM. DTSBU205 00483 DTSBU205 00484 MOVE W-MDY TO L001-SLASH-8-YR. DTSBU205 00485 DTSBU205 00486 MOVE L001-SLASH-8-DATE TO W-DATE. DTSBU205 00487 DTSBU205 00488 S2300-EXIT. DTSBU205 00489 EXIT. DTSBU205 00490 DTSBU205 00491 DTSBU205 00492 S999-ABEND. DTSBU205 00493 CALL 'DTSBU999' USING W-ABEND-CD. DTSBU205 00494 S999-EXIT. DTSBU205 00495 EXIT. DTSBU205