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
