manny@wet.UUCP (Manny Juan) (05/31/91)
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@wet.UUCP (also manny@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 | |-------------------------------------------------------------------------|