cobol2 pgm to convert number to words
Manny Juan
manny at wet.UUCP
Fri May 31 15:02:56 AEST 1991
i wrote this program when cobol2 was "new" so i could try many of the new
features of cobol2 (ie. inline performs, CASE-like Evaluate, END-IFs,etc)
and i thought i'd share it.
the program runs as a standalone pgm but any cobol programmer should be able
to apply surgery to it to extract its GET-NUMBER subroutine. i've used this
primitive numeric entry parser in various CICS data entry programs without
any problems. (in its current form, there is a limit to the size of the
result (GN-NUMBER-VALUE) because of its picture. however, it may be recoded
as floating point for more flexibility).
manny juan
manny at wet.UUCP (also manny at tcomeng.COM)
------------- CUT HERE -------------
000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. NUM2WDS.
000300*AUTHOR. MANNY.
000400 DATE-WRITTEN. 11/23/90.
000500 DATE-COMPILED. 07/30/90.
000600 ENVIRONMENT DIVISION.
000700 INPUT-OUTPUT SECTION.
000800 FILE-CONTROL.
001000 DATA DIVISION.
001100 FILE SECTION.
002000 WORKING-STORAGE SECTION.
002100 01 FILLER PIC 9 VALUE 0.
002200 88 NO-MORE-NUMBERS VALUE 1.
002300 01 NBR-RECORD.
002400 03 NBR-STRING PIC X(32).
002400 03 FILLER REDEFINES NBR-STRING.
002401 05 NBR-CH1 PIC X(01).
002402 05 FILLER PIC X(31).
002500 01 GN-WORK-AREA.
002600 03 GN-IX PIC S9(03) COMP.
002700 03 GN-SIGN PIC X(01).
002800 03 GN-WHOLE-NUMBER PIC S9(15) COMP-3.
002900 03 GN-DIVISOR PIC S9(13) COMP-3.
003000
003100 01 GN-CONVERT-AREA.
003200 03 GN-INPUT.
003300 05 GN-INPUT-CHARS.
003400 07 GN-CH PIC X(01) OCCURS 33 TIMES.
003500
003600 05 GN-INPUT-DIGITS REDEFINES GN-INPUT-CHARS.
003700 07 GN-DIGIT PIC 9(01) OCCURS 33 TIMES.
003800
003900 03 GN-NUMBER-VALUE PIC S9(13)V99.
004000 03 FILLER PIC X(01).
004100 88 GN-GOOD-NUMBER VALUE 'Y'.
004200 88 GN-BAD-NUMBER VALUE 'N'.
004300
004400 01 NW-WORK-AREA.
004500 03 NW-CHUNK-LIT-DEF.
004600 05 FILLER PIC X(09) VALUE SPACES.
004700 05 FILLER PIC X(09) VALUE 'THOUSAND'.
004800 05 FILLER PIC X(09) VALUE 'MILLION'.
004900 05 FILLER PIC X(09) VALUE 'BILLION'.
005000 05 FILLER PIC X(09) VALUE 'TRILLION'.
005100
005200 03 FILLER REDEFINES NW-CHUNK-LIT-DEF.
005300 05 NW-CHUNK-LIT PIC X(09) OCCURS 5 TIMES.
005400
005500 03 NW-TENS-LIT-DEF.
005600 05 FILLER PIC X(08) VALUE SPACES.
005700 05 FILLER PIC X(08) VALUE 'TWENTY'.
005800 05 FILLER PIC X(08) VALUE 'THIRTY'.
005900 05 FILLER PIC X(08) VALUE 'FORTY'.
006000 05 FILLER PIC X(08) VALUE 'FIFTY'.
006100 05 FILLER PIC X(08) VALUE 'SIXTY'.
006200 05 FILLER PIC X(08) VALUE 'SEVENTY'.
006300 05 FILLER PIC X(08) VALUE 'EIGHTY'.
006400 05 FILLER PIC X(08) VALUE 'NINETY'.
006500
006600 03 FILLER REDEFINES NW-TENS-LIT-DEF.
006700 05 NW-TENS-LIT PIC X(08) OCCURS 9 TIMES.
006800
006900 03 NW-UNITS-TO-20-LIT-DEF.
007000 05 FILLER PIC X(10) VALUE 'ONE'.
007100 05 FILLER PIC X(10) VALUE 'TWO'.
007200 05 FILLER PIC X(10) VALUE 'THREE'.
007300 05 FILLER PIC X(10) VALUE 'FOUR'.
007400 05 FILLER PIC X(10) VALUE 'FIVE'.
007500 05 FILLER PIC X(10) VALUE 'SIX'.
007600 05 FILLER PIC X(10) VALUE 'SEVEN'.
007700 05 FILLER PIC X(10) VALUE 'EIGHT'.
007800 05 FILLER PIC X(10) VALUE 'NINE'.
007900 05 FILLER PIC X(10) VALUE 'TEN'.
008000 05 FILLER PIC X(10) VALUE 'ELEVEN'.
008100 05 FILLER PIC X(10) VALUE 'TWELVE'.
008200 05 FILLER PIC X(10) VALUE 'THIRTEEN'.
008300 05 FILLER PIC X(10) VALUE 'FOURTEEN'.
008400 05 FILLER PIC X(10) VALUE 'FIFTEEN'.
008500 05 FILLER PIC X(10) VALUE 'SIXTEEN'.
008600 05 FILLER PIC X(10) VALUE 'SEVENTEEN'.
008700 05 FILLER PIC X(10) VALUE 'EIGHTEEN'.
008800 05 FILLER PIC X(10) VALUE 'NINETEEN'.
008900
009000 03 FILLER REDEFINES NW-UNITS-TO-20-LIT-DEF.
009100 05 NW-UNITS-TO-20-LIT PIC X(10) OCCURS 19 TIMES.
009200
009300 03 NW-COUNTER PIC 9.
009400 03 NW-CC PIC 9(03).
009500 03 NW-TO-20 PIC 9(02).
009600 03 NW-REM PIC 9(02).
009700 03 NW-WORK-STRING PIC X(200).
009800 03 NW-CHUNK-STRING PIC X(48).
009900 03 NW-CHUNK-CC PIC 9(02).
010000 03 NW-CHUNK PIC 9(03).
010100 03 FILLER REDEFINES NW-CHUNK.
010200 05 NW-HUNDREDS PIC 9.
010300 05 NW-TENS PIC 9.
010400 05 NW-UNITS PIC 9.
010500
010600 01 NW-CONVERT-AREA.
010700 03 NW-INPUT PIC 9(15).99-.
010800 03 FILLER REDEFINES NW-INPUT.
010900 05 NW-WHOLE-NUMBER PIC 9(15).
011000 05 NW-DECIMAL-PT PIC X(01).
011100 05 NW-CENTS PIC 9(02).
011200 05 NW-SIGN PIC X(01).
011300
011400 03 NW-OUTPUT PIC X(200).
011500
011600 PROCEDURE DIVISION.
011700 0100-NUM2WDS SECTION.
011900 PERFORM 0110-GET-NUMBERS
012000 PERFORM 0120-DO-CONVERT
012100 UNTIL NO-MORE-NUMBERS
012300 GOBACK.
012400 0110-GET-NUMBERS SECTION.
012401 DISPLAY "Enter a dollar amount (or / to quit)"
012500 ACCEPT NBR-RECORD
012600 IF NBR-CH1 = "/"
012700 SET NO-MORE-NUMBERS TO TRUE
012800 END-IF
012900 CONTINUE.
013000 0120-DO-CONVERT SECTION.
013100 MOVE NBR-STRING TO GN-INPUT
013200 PERFORM 0130-GET-NUMBER
013300 DISPLAY GN-INPUT ' ' GN-NUMBER-VALUE
013500 MOVE GN-NUMBER-VALUE TO NW-INPUT
013600 PERFORM 0140-CONVERT-TO-WORDS
013700 DISPLAY 'WORDS=' NW-OUTPUT
013400 PERFORM 0110-GET-NUMBERS
013800 CONTINUE.
013900
014000 0130-GET-NUMBER SECTION.
014100 MOVE 1 TO GN-IX
014200 MOVE SPACES TO GN-SIGN
014300 IF NOT (GN-INPUT = SPACES)
014400* --SKIP LEADING SPACES
014500 PERFORM VARYING GN-IX FROM GN-IX BY +1
014600 UNTIL GN-CH (GN-IX) NOT = SPACE
014700 END-PERFORM
014800 MOVE ZEROES TO GN-WHOLE-NUMBER
014900 MOVE 1 TO GN-DIVISOR
015000 IF (GN-CH (GN-IX) = '-') THEN
015100 MOVE '-' TO GN-SIGN
015200 COMPUTE GN-IX = GN-IX + 1
015300 END-IF
015400 PERFORM
015500 TEST BEFORE
015600 UNTIL GN-CH (GN-IX) NOT NUMERIC
015700 OR GN-CH (GN-IX) = SPACE
015800 OR GN-CH (GN-IX) = '.'
015900 COMPUTE GN-WHOLE-NUMBER
016000 = 10 * GN-WHOLE-NUMBER
016100 + GN-DIGIT (GN-IX)
016200 COMPUTE GN-IX = GN-IX + 1
016300 PERFORM VARYING GN-IX FROM GN-IX BY +1
016400 UNTIL NOT (GN-CH (GN-IX) = ',')
016500 END-PERFORM
016600 END-PERFORM
016700 IF GN-CH (GN-IX) = '.'
016800 COMPUTE GN-IX = GN-IX + 1
016900 PERFORM
017000 TEST BEFORE
017100 UNTIL GN-CH (GN-IX) NOT NUMERIC
017200 OR GN-CH (GN-IX) = SPACE
017300 COMPUTE GN-DIVISOR
017400 = 10 * GN-DIVISOR
017500 COMPUTE GN-WHOLE-NUMBER
017600 = 10 * GN-WHOLE-NUMBER
017700 + GN-DIGIT (GN-IX)
017800 COMPUTE GN-IX = GN-IX + 1
017900 END-PERFORM
018000 END-IF
018100 COMPUTE GN-NUMBER-VALUE
018200 = GN-WHOLE-NUMBER
018300 / GN-DIVISOR
018400 IF GN-SIGN = '-'
018500 COMPUTE GN-NUMBER-VALUE
018600 = 0 - GN-NUMBER-VALUE
018700 END-IF
018800 IF GN-CH (GN-IX) = SPACE
018900 SET GN-GOOD-NUMBER TO TRUE
019000 ELSE
019100 SET GN-BAD-NUMBER TO TRUE
019200 END-IF
019300 END-IF
019400 CONTINUE.
019500
019600 0140-CONVERT-TO-WORDS SECTION.
019700 MOVE 1 TO NW-CC
019800 MOVE SPACES TO NW-WORK-STRING
019900 MOVE SPACES TO NW-OUTPUT
020000 IF NW-WHOLE-NUMBER = ZEROES
020100 STRING 'ZERO #' DELIMITED BY SIZE
020200 INTO NW-OUTPUT POINTER NW-CC
020300 ELSE
020400 STRING '#' DELIMITED BY SIZE
020500 INTO NW-OUTPUT POINTER NW-CC
020600 END-IF
020700
020800 PERFORM
020900 VARYING NW-COUNTER FROM 1 BY +1
021000 UNTIL NW-COUNTER > 5
021100 OR NW-WHOLE-NUMBER = ZEROES
021200 MOVE SPACES TO NW-CHUNK-STRING
021300 MOVE 1 TO NW-CHUNK-CC
021400 DIVIDE NW-WHOLE-NUMBER BY 1000
021500 GIVING NW-WHOLE-NUMBER REMAINDER NW-CHUNK
021600
021700 IF NW-CHUNK > ZEROES
021800 IF (NW-HUNDREDS > 0)
021900 STRING NW-UNITS-TO-20-LIT (NW-HUNDREDS)
022000 DELIMITED BY SPACE
022100 ' HUNDRED' DELIMITED BY SIZE
022200 INTO NW-CHUNK-STRING POINTER NW-CHUNK-CC
022300 IF NOT (NW-TENS = 0 AND NW-UNITS = 0)
022400 STRING ' ' DELIMITED BY SIZE
022500 INTO NW-CHUNK-STRING POINTER NW-CHUNK-CC
022600 END-IF
022700 END-IF
022800
022900 IF (NW-TENS < '2')
023000 COMPUTE NW-TO-20
023100 = 10 * NW-TENS + NW-UNITS
023200 IF (NW-TO-20 > ZERO)
023300 STRING NW-UNITS-TO-20-LIT (NW-TO-20)
023400 DELIMITED BY SPACE
023500 INTO NW-CHUNK-STRING POINTER NW-CHUNK-CC
023600 END-IF
023700 ELSE
023800 STRING NW-TENS-LIT (NW-TENS)
023900 DELIMITED BY SPACE
024000 INTO NW-CHUNK-STRING POINTER NW-CHUNK-CC
024100 IF (NW-UNITS > 0)
024200 STRING '-' DELIMITED BY SIZE
024300 NW-UNITS-TO-20-LIT (NW-UNITS)
024400 DELIMITED BY SPACE
024500 INTO NW-CHUNK-STRING POINTER NW-CHUNK-CC
024600 END-IF
024700 END-IF
024800
024900 IF (NW-COUNTER = 1)
025000 STRING ' #' DELIMITED BY SIZE
025100 INTO NW-CHUNK-STRING POINTER NW-CHUNK-CC
025200 ELSE
025300 STRING ' ' DELIMITED BY SIZE
025400 NW-CHUNK-LIT (NW-COUNTER)
025500 DELIMITED BY SPACE
025600 ' #' DELIMITED BY SIZE
025700 INTO NW-CHUNK-STRING POINTER NW-CHUNK-CC
025800 END-IF
025900
026000 MOVE 1 TO NW-CC
026100 STRING NW-CHUNK-STRING DELIMITED BY '#'
026200 NW-OUTPUT DELIMITED BY '#'
026300 '#' DELIMITED BY SIZE
026400 INTO NW-WORK-STRING POINTER NW-CC
026500
026600 MOVE NW-WORK-STRING TO NW-OUTPUT
026700 END-IF
026800 END-PERFORM
026900
027000 COMPUTE NW-CC = NW-CC - 1
027100 IF (NW-CENTS = ZEROS)
027200 STRING 'DOLLARS AND NO CENTS#'
027300 DELIMITED BY SIZE
027400 INTO NW-OUTPUT POINTER NW-CC
027500 ELSE
027600 STRING 'DOLLARS AND ' NW-CENTS ' CENTS#'
027700 DELIMITED BY SIZE
027800 INTO NW-OUTPUT POINTER NW-CC
027900 END-IF
028000 IF NW-SIGN = '-'
028100 STRING 'MINUS ' DELIMITED BY SIZE
028200 NW-OUTPUT DELIMITED BY '#'
028300 INTO NW-WORK-STRING
028400 ELSE
028500 STRING NW-OUTPUT DELIMITED BY '#'
028600 INTO NW-WORK-STRING
028700 END-IF
028800 MOVE NW-WORK-STRING TO NW-OUTPUT
028900
029000 CONTINUE.
--
|-------------------------------------------------------------------------|
| Manny Juan (manny) {decwrl,pacbell}!tcomeng!manny |
|-------------------------------------------------------------------------|
More information about the Alt.sources
mailing list