Back in March 2019 I posted a WinBatch routine that translates extremely large numeric values into it's literal English form. WinBatch - Hyper-Extreme Numeric to Literal Translation Overkill
The extremely nonsensical routine produces literal translations into the VIGINTILLIONS (I also have a more practical SQR version that is limited to Billions). Since I recently downloaded & installed OpenCobolIDE I've been having fun writing code - so why not replicate this practically useless but interesting function.
The COBOL version will be kept much simpler - no need for a repeat of a GUI Check Interface. Just the function and a test module to produce the results.
Components:
TDFNLW.CPY - Numeric-To-Literal Working Storage CopyBook.
TDFNLP.CPY - Numeric-To-Literal Procedure CopyBook.
TDTESTNL.CBL - Test Module (Calls Function - Display Results)
TDFNLP.CPY - TDF-NL Function (Procedure)
* *
* MODULE: TDFNLP.CPY *
* AUTHOR: TONY DELIA. *
* DATE: 11/23/2024. *
* SYSTEM: WINDOWS 11/OpenCobolIDE 4.7.6 *
* DESC: COBOL USER FUNCTION - NUMERIC TO LITERAL. *
* *
*****************************************************************
* NOTE: REQUIRES TDFNLW.CPY COPYBOOK (W-S SECTION). *
* ALSO TDPROC.CPY/TDWORK.CPY FOR ADDL FUNCTIONS. *
*****************************************************************
* *
* ROUTINE DESCRIPTION *
* -------------- -------------------------------------------- *
* TDF-NL CONVERT NUMERIC VALUE TO LITERAL TEXT *
* *
*****************************************************************
*****************************************************************
* REVISIONS: *
*****************************************************************
* *
* DATE PROGRAMMER DESCRIPTION *
* ---------- --------------- ---------------------------------- *
* *
* 11/23/2024 DELIA,TONY ORIGINAL CODING. *
* *
*****************************************************************
*****************************************************************
* TDF NL - CONVERT NUMERIC VALUE TO LITERAL TEXT *
*****************************************************************
* *
* FIELD I/O DESCRIPTION *
* ----------------- --- ---------------------------------- *
* TDX-NL-AMT I INPUT NUMERIC STRING *
* TDX-NL-TEXT O RETURNS LITERAL TEXT CONVERSION *
* *
*****************************************************************
* *
* EXAMPLE: *
* ---------------------------------------------------------- *
* MOVE 789000000000093 TO TDX-NL-AMT *
* PERFORM TDF-NL *
* DISPLAY 'TEXT: ' TDX-NL-TEXT *
* ---------------------------------------------------------- *
* RESULTS: *
* ---------------------------------------------------------- *
* IN: 789000000000093 *
* OUT: Seven Hundred Eighty-Nine Trillion Ninety-Three *
* ---------------------------------------------------------- *
* IN: 72000009004000000000000 *
* OUT: Seventy-Two Sextillion Nine Quadrillion Four Trillion *
* ---------------------------------------------------------- *
* IN: 123056 *
* OUT: One Hundred Twenty-Three Thousand Fifty-Six *
* *
*****************************************************************
TDF-NL.
MOVE ZEROES TO TDX-NL-WRK
MOVE SPACES TO TDX-NL-TEXT
MOVE TDX-NL-AMT TO TDX-LEN-FLD
MOVE LENGTH OF TDX-NL-AMT TO TDX-LEN-VAL
PERFORM TDF-LENGTH
MOVE TDX-LEN-VAL TO TDX-NL-LEN
IF TDX-NL-LEN > LENGTH OF TDX-NL-WRK
MOVE '***MAXIMUM LENGTH EXCEEDED***' TO TDX-NL-TEXT
ELSE
COMPUTE TDX-NL-X = 67 - TDX-NL-LEN
MOVE TDX-NL-AMT(1:TDX-NL-LEN)
TO TDX-NL-WRK(TDX-NL-X:TDX-NL-LEN)
IF TDX-NL-WRK IS NOT NUMERIC
MOVE '***INPUT NOT NUMERIC VALUE***' TO TDX-NL-TEXT
ELSE
MOVE 1 TO TDX-NL-POS
MOVE 1 TO TDX-NL-LEV
MOVE 1 TO TDX-NL-PTR
PERFORM UNTIL TDX-NL-LEV > TDX-NL-MAX-B
MOVE TDX-NL-WRK(TDX-NL-POS:3) TO TDX-NL-SEG
IF TDX-NL-SEG <> '000'
IF TDX-NL-SEG-HI > 0
MOVE TDX-NL-LIT-A(TDX-NL-SEG-HI) TO TDX-NL-TMP
MOVE TDX-NL-TMP TO TDX-LEN-FLD
MOVE LENGTH OF TDX-NL-LIT-A TO TDX-LEN-VAL
PERFORM TDF-LENGTH
ADD 1 TO TDX-LEN-VAL
MOVE ' Hundred' TO TDX-NL-TMP(TDX-LEN-VAL:8)
ADD 8 TO TDX-LEN-VAL
MOVE TDX-NL-TMP(1:TDX-LEN-VAL)
TO TDX-NL-TEXT(TDX-NL-PTR:TDX-LEN-VAL)
ADD TDX-LEN-VAL TO TDX-NL-PTR
IF TDX-NL-SEG-LO > 0
MOVE SPACE TO TDX-NL-TEXT(TDX-NL-PTR:1)
END-IF
END-IF
IF TDX-NL-SEG-LO > 20
DIVIDE TDX-NL-SEG-LO BY 10
GIVING TDX-NL-X REMAINDER TDX-NL-MOD
ADD 18 TO TDX-NL-X
MOVE TDX-NL-MOD TO TDX-NL-SEG-LO
MOVE TDX-NL-LIT-A(TDX-NL-X) TO TDX-NL-TMP
MOVE TDX-NL-TMP TO TDX-LEN-FLD
MOVE LENGTH OF TDX-NL-LIT-A TO TDX-LEN-VAL
PERFORM TDF-LENGTH
MOVE TDX-NL-TMP(1:TDX-LEN-VAL)
TO TDX-NL-TEXT(TDX-NL-PTR:TDX-LEN-VAL)
ADD TDX-LEN-VAL TO TDX-NL-PTR
IF TDX-NL-SEG-LO > 0
MOVE '-' TO TDX-NL-TEXT(TDX-NL-PTR:1)
ADD 1 TO TDX-NL-PTR
END-IF
END-IF
IF TDX-NL-SEG-LO > 0
MOVE TDX-NL-LIT-A(TDX-NL-SEG-LO) TO TDX-NL-TMP
MOVE TDX-NL-TMP TO TDX-LEN-FLD
MOVE LENGTH OF TDX-NL-LIT-A TO TDX-LEN-VAL
PERFORM TDF-LENGTH
MOVE TDX-NL-TMP(1:TDX-LEN-VAL)
TO TDX-NL-TEXT(TDX-NL-PTR:TDX-LEN-VAL)
ADD TDX-LEN-VAL TO TDX-NL-PTR
MOVE SPACE TO TDX-NL-TEXT(TDX-NL-PTR:1)
END-IF
MOVE TDX-NL-LIT-B(TDX-NL-LEV) TO TDX-NL-TMP
MOVE TDX-NL-TMP TO TDX-LEN-FLD
MOVE LENGTH OF TDX-NL-LIT-B TO TDX-LEN-VAL
PERFORM TDF-LENGTH
IF TDX-LEN-VAL > 0
MOVE TDX-NL-TMP(1:TDX-LEN-VAL)
TO TDX-NL-TEXT(TDX-NL-PTR:TDX-LEN-VAL)
ADD TDX-LEN-VAL TO TDX-NL-PTR
MOVE SPACE TO TDX-NL-TEXT(TDX-NL-PTR:1)
ADD 1 TO TDX-NL-PTR
END-IF
END-IF
ADD 1 TO TDX-NL-LEV
ADD 3 TO TDX-NL-POS
END-PERFORM
IF TDX-NL-TEXT EQUAL SPACES
MOVE 'Zero' TO TDX-NL-TEXT
END-IF
END-IF
END-IF
.
TDF-NL-EXIT.
EXIT.
*****************************************************************
* END OF COPYBOOK *
*****************************************************************
TDFNLW.CPY - TDF-NL Working Storage/Variables
*****************************************************************
* *
* MODULE: TDFNLW.CPY *
* AUTHOR: TONY DELIA. *
* DATE: 11/23/2024. *
* SYSTEM: WINDOWS 11/OpenCobolIDE 4.7.6 *
* DESC: COBOL USER FUNCTION - NUMERIC TO LITERAL. *
* *
*****************************************************************
* NOTE: REQUIRES TDFNLP.CPY COPYBOOK (PROCEDURE SECTION). *
* ALSO TDPROC.CPY/TDWORK.CPY FOR ADDL FUNCTIONS. *
*****************************************************************
* *
* ROUTINE DESCRIPTION *
* -------------- -------------------------------------------- *
* TDF-NL CONVERT NUMERIC VALUE TO LITERAL TEXT *
* *
*****************************************************************
*****************************************************************
* REVISIONS: *
*****************************************************************
* *
* DATE PROGRAMMER DESCRIPTION *
* ---------- --------------- ---------------------------------- *
* *
* 11/23/2024 DELIA,TONY ORIGINAL CODING. *
* *
*****************************************************************
01 TDF-NL-PARMS.
05 TDX-NL-AMT PIC X(70).
05 TDX-NL-WRK PIC X(66) VALUE ZEROES.
05 TDX-NL-LEN PIC 99.
05 TDX-NL-X PIC 99.
05 TDX-NL-IDX PIC 999.
05 TDX-NL-MAX-A PIC 999 VALUE 27.
05 TDX-NL-MAX-B PIC 999 VALUE 22.
05 TDX-NL-POS PIC 9(4).
05 TDX-NL-LEV PIC 99.
05 TDX-NL-PTR PIC 9(4).
05 TDX-NL-MOD PIC 99.
05 TDX-NL-SEG.
10 TDX-NL-SEG-HI PIC 9.
10 TDX-NL-SEG-LO PIC 99.
05 TDX-NL-TMP PIC X(20).
05 TDX-NL-MTX-A.
* Direct Indexing Literals
10 FILLER PIC X(10) VALUE 'One'.
10 FILLER PIC X(10) VALUE 'Two'.
10 FILLER PIC X(10) VALUE 'Three'.
10 FILLER PIC X(10) VALUE 'Four'.
10 FILLER PIC X(10) VALUE 'Five'.
10 FILLER PIC X(10) VALUE 'Six'.
10 FILLER PIC X(10) VALUE 'Seven'.
10 FILLER PIC X(10) VALUE 'Eight'.
10 FILLER PIC X(10) VALUE 'Nine'.
10 FILLER PIC X(10) VALUE 'Ten'.
10 FILLER PIC X(10) VALUE 'Eleven'.
10 FILLER PIC X(10) VALUE 'Twelve'.
10 FILLER PIC X(10) VALUE 'Thirteen'.
10 FILLER PIC X(10) VALUE 'Fourteen'.
10 FILLER PIC X(10) VALUE 'Fifteen'.
10 FILLER PIC X(10) VALUE 'Sixteen'.
10 FILLER PIC X(10) VALUE 'Seventeen'.
10 FILLER PIC X(10) VALUE 'Eighteen'.
10 FILLER PIC X(10) VALUE 'Nineteen'.
10 FILLER PIC X(10) VALUE 'Twenty'.
* Combination Indexing Literals
10 FILLER PIC X(10) VALUE 'Thirty'.
10 FILLER PIC X(10) VALUE 'Forty'.
10 FILLER PIC X(10) VALUE 'Fifty'.
10 FILLER PIC X(10) VALUE 'Sixty'.
10 FILLER PIC X(10) VALUE 'Seventy'.
10 FILLER PIC X(10) VALUE 'Eighty'.
10 FILLER PIC X(10) VALUE 'Ninety'.
05 TDX-NL-MTX-X REDEFINES TDX-NL-MTX-A.
10 TDX-NL-LIT-A PIC X(10) OCCURS 27 TIMES.
05 TDX-NL-MTX-B.
10 FILLER PIC X(20) VALUE ' Vigintillion'.
10 FILLER PIC X(20) VALUE ' Novemdecillion'.
10 FILLER PIC X(20) VALUE ' Octodecillion'.
10 FILLER PIC X(20) VALUE ' Septendecillion'.
10 FILLER PIC X(20) VALUE ' Sexdecillion'.
10 FILLER PIC X(20) VALUE ' Quindecillion'.
10 FILLER PIC X(20) VALUE ' Quatuordecillion'.
10 FILLER PIC X(20) VALUE ' Tredecillion'.
10 FILLER PIC X(20) VALUE ' Duodecillion'.
10 FILLER PIC X(20) VALUE ' Undecillion'.
10 FILLER PIC X(20) VALUE ' Decillion'.
10 FILLER PIC X(20) VALUE ' Nonillion'.
10 FILLER PIC X(20) VALUE ' Octillion'.
10 FILLER PIC X(20) VALUE ' Septillion'.
10 FILLER PIC X(20) VALUE ' Sextillion'.
10 FILLER PIC X(20) VALUE ' Quintillion'.
10 FILLER PIC X(20) VALUE ' Quadrillion'.
10 FILLER PIC X(20) VALUE ' Trillion'.
10 FILLER PIC X(20) VALUE ' Billion'.
10 FILLER PIC X(20) VALUE ' Million'.
10 FILLER PIC X(20) VALUE ' Thousand'.
10 FILLER PIC X(20) VALUE ' '.
05 TDX-NL-MTX-Y REDEFINES TDX-NL-MTX-B.
10 TDX-NL-LIT-B PIC X(20) OCCURS 22 TIMES.
05 TDX-NL-TEXT PIC X(1000).
*****************************************************************
* END OF COPYBOOK *
*****************************************************************
* *
* MODULE: TDFNLW.CPY *
* AUTHOR: TONY DELIA. *
* DATE: 11/23/2024. *
* SYSTEM: WINDOWS 11/OpenCobolIDE 4.7.6 *
* DESC: COBOL USER FUNCTION - NUMERIC TO LITERAL. *
* *
*****************************************************************
* NOTE: REQUIRES TDFNLP.CPY COPYBOOK (PROCEDURE SECTION). *
* ALSO TDPROC.CPY/TDWORK.CPY FOR ADDL FUNCTIONS. *
*****************************************************************
* *
* ROUTINE DESCRIPTION *
* -------------- -------------------------------------------- *
* TDF-NL CONVERT NUMERIC VALUE TO LITERAL TEXT *
* *
*****************************************************************
*****************************************************************
* REVISIONS: *
*****************************************************************
* *
* DATE PROGRAMMER DESCRIPTION *
* ---------- --------------- ---------------------------------- *
* *
* 11/23/2024 DELIA,TONY ORIGINAL CODING. *
* *
*****************************************************************
01 TDF-NL-PARMS.
05 TDX-NL-AMT PIC X(70).
05 TDX-NL-WRK PIC X(66) VALUE ZEROES.
05 TDX-NL-LEN PIC 99.
05 TDX-NL-X PIC 99.
05 TDX-NL-IDX PIC 999.
05 TDX-NL-MAX-A PIC 999 VALUE 27.
05 TDX-NL-MAX-B PIC 999 VALUE 22.
05 TDX-NL-POS PIC 9(4).
05 TDX-NL-LEV PIC 99.
05 TDX-NL-PTR PIC 9(4).
05 TDX-NL-MOD PIC 99.
05 TDX-NL-SEG.
10 TDX-NL-SEG-HI PIC 9.
10 TDX-NL-SEG-LO PIC 99.
05 TDX-NL-TMP PIC X(20).
05 TDX-NL-MTX-A.
* Direct Indexing Literals
10 FILLER PIC X(10) VALUE 'One'.
10 FILLER PIC X(10) VALUE 'Two'.
10 FILLER PIC X(10) VALUE 'Three'.
10 FILLER PIC X(10) VALUE 'Four'.
10 FILLER PIC X(10) VALUE 'Five'.
10 FILLER PIC X(10) VALUE 'Six'.
10 FILLER PIC X(10) VALUE 'Seven'.
10 FILLER PIC X(10) VALUE 'Eight'.
10 FILLER PIC X(10) VALUE 'Nine'.
10 FILLER PIC X(10) VALUE 'Ten'.
10 FILLER PIC X(10) VALUE 'Eleven'.
10 FILLER PIC X(10) VALUE 'Twelve'.
10 FILLER PIC X(10) VALUE 'Thirteen'.
10 FILLER PIC X(10) VALUE 'Fourteen'.
10 FILLER PIC X(10) VALUE 'Fifteen'.
10 FILLER PIC X(10) VALUE 'Sixteen'.
10 FILLER PIC X(10) VALUE 'Seventeen'.
10 FILLER PIC X(10) VALUE 'Eighteen'.
10 FILLER PIC X(10) VALUE 'Nineteen'.
10 FILLER PIC X(10) VALUE 'Twenty'.
* Combination Indexing Literals
10 FILLER PIC X(10) VALUE 'Thirty'.
10 FILLER PIC X(10) VALUE 'Forty'.
10 FILLER PIC X(10) VALUE 'Fifty'.
10 FILLER PIC X(10) VALUE 'Sixty'.
10 FILLER PIC X(10) VALUE 'Seventy'.
10 FILLER PIC X(10) VALUE 'Eighty'.
10 FILLER PIC X(10) VALUE 'Ninety'.
05 TDX-NL-MTX-X REDEFINES TDX-NL-MTX-A.
10 TDX-NL-LIT-A PIC X(10) OCCURS 27 TIMES.
05 TDX-NL-MTX-B.
10 FILLER PIC X(20) VALUE ' Vigintillion'.
10 FILLER PIC X(20) VALUE ' Novemdecillion'.
10 FILLER PIC X(20) VALUE ' Octodecillion'.
10 FILLER PIC X(20) VALUE ' Septendecillion'.
10 FILLER PIC X(20) VALUE ' Sexdecillion'.
10 FILLER PIC X(20) VALUE ' Quindecillion'.
10 FILLER PIC X(20) VALUE ' Quatuordecillion'.
10 FILLER PIC X(20) VALUE ' Tredecillion'.
10 FILLER PIC X(20) VALUE ' Duodecillion'.
10 FILLER PIC X(20) VALUE ' Undecillion'.
10 FILLER PIC X(20) VALUE ' Decillion'.
10 FILLER PIC X(20) VALUE ' Nonillion'.
10 FILLER PIC X(20) VALUE ' Octillion'.
10 FILLER PIC X(20) VALUE ' Septillion'.
10 FILLER PIC X(20) VALUE ' Sextillion'.
10 FILLER PIC X(20) VALUE ' Quintillion'.
10 FILLER PIC X(20) VALUE ' Quadrillion'.
10 FILLER PIC X(20) VALUE ' Trillion'.
10 FILLER PIC X(20) VALUE ' Billion'.
10 FILLER PIC X(20) VALUE ' Million'.
10 FILLER PIC X(20) VALUE ' Thousand'.
10 FILLER PIC X(20) VALUE ' '.
05 TDX-NL-MTX-Y REDEFINES TDX-NL-MTX-B.
10 TDX-NL-LIT-B PIC X(20) OCCURS 22 TIMES.
05 TDX-NL-TEXT PIC X(1000).
*****************************************************************
* END OF COPYBOOK *
*****************************************************************
TDTESTNL.CBL - Test Module
Snippet of Working Storage - WS-TEXT will hold the initial numeric value. WS-SCALE will be displayed to illustrate the length of the numeric field and WS-BIG-NUM is a big number - the maximum accepted by the TDF-NL function.
*****************************************************************
* WORKING STORAGE *
*****************************************************************
WORKING-STORAGE SECTION.
01 WS-TEXT PIC X(66).
01 WS-SCALE.
05 FILLER PIC X(10) VALUE '1...5...10'.
05 FILLER PIC X(10) VALUE '...15...20'.
05 FILLER PIC X(10) VALUE '...25...30'.
05 FILLER PIC X(10) VALUE '...35...40'.
05 FILLER PIC X(10) VALUE '...45...50'.
05 FILLER PIC X(10) VALUE '...55...60'.
05 FILLER PIC X(10) VALUE '...65...70'.
01 WS-BIG-NUM.
05 FILLER PIC X(15) VALUE '999999999999999'.
05 FILLER PIC X(15) VALUE '999999999999999'.
05 FILLER PIC X(15) VALUE '999999999999999'.
05 FILLER PIC X(15) VALUE '999999999999999'.
05 FILLER PIC X(6) VALUE '999999'.
COPY TDFNLW.
COPY TDFWORK.
*****************************************************************
* WORKING STORAGE *
*****************************************************************
WORKING-STORAGE SECTION.
01 WS-TEXT PIC X(66).
01 WS-SCALE.
05 FILLER PIC X(10) VALUE '1...5...10'.
05 FILLER PIC X(10) VALUE '...15...20'.
05 FILLER PIC X(10) VALUE '...25...30'.
05 FILLER PIC X(10) VALUE '...35...40'.
05 FILLER PIC X(10) VALUE '...45...50'.
05 FILLER PIC X(10) VALUE '...55...60'.
05 FILLER PIC X(10) VALUE '...65...70'.
01 WS-BIG-NUM.
05 FILLER PIC X(15) VALUE '999999999999999'.
05 FILLER PIC X(15) VALUE '999999999999999'.
05 FILLER PIC X(15) VALUE '999999999999999'.
05 FILLER PIC X(15) VALUE '999999999999999'.
05 FILLER PIC X(6) VALUE '999999'.
COPY TDFNLW.
COPY TDFWORK.
*****************************************************************
Testing logic - some static samples are built into the TEST-NL procedure followed by an optional user entered loop. Enter any number or <ENTER> to break out.
*****************************************************************
* PROCEDURE DIVISION *
*****************************************************************
PROCEDURE DIVISION.
MAIN-PROCEDURE.
DISPLAY '*** STATIC TEST CASES ***'
PERFORM TEST-NL
DISPLAY '*** ENTER NUMBER OR <ENTER> ***'
ACCEPT WS-TEXT
PERFORM UNTIL WS-TEXT EQUALS SPACES
MOVE WS-TEXT TO TDX-NL-AMT
PERFORM TDF-NL
DISPLAY ' '
DISPLAY '---: ' WS-SCALE
DISPLAY ' IN: ' TDX-NL-AMT
DISPLAY 'OUT: ' TDX-NL-TEXT
DISPLAY '*** ENTER NUMBER OR <ENTER> ***'
ACCEPT WS-TEXT
END-PERFORM
STOP RUN.
*****************************************************************
* PROCEDURE DIVISION *
*****************************************************************
PROCEDURE DIVISION.
MAIN-PROCEDURE.
DISPLAY '*** STATIC TEST CASES ***'
PERFORM TEST-NL
DISPLAY '*** ENTER NUMBER OR <ENTER> ***'
ACCEPT WS-TEXT
PERFORM UNTIL WS-TEXT EQUALS SPACES
MOVE WS-TEXT TO TDX-NL-AMT
PERFORM TDF-NL
DISPLAY ' '
DISPLAY '---: ' WS-SCALE
DISPLAY ' IN: ' TDX-NL-AMT
DISPLAY 'OUT: ' TDX-NL-TEXT
DISPLAY '*** ENTER NUMBER OR <ENTER> ***'
ACCEPT WS-TEXT
END-PERFORM
STOP RUN.
*****************************************************************
OUTPUT:
Maximum Output:
---: 1...5...10...15...20...25...30...35...40...45...50...55...60...65...70
IN: 999999999999999999999999999999999999999999999999999999999999999999
OUT: Nine Hundred Ninety-Nine Vigintillion Nine Hundred Ninety-Nine Novemdecillion Nine Hundred Ninety-Nine Octodecillion Nine Hundred Ninety-Nine Septendecillion Nine Hundred Ninety-Nine Sexdecillion Nine Hundred Ninety-Nine Quindecillion Nine Hundred Ninety-Nine Quatuordecillion Nine Hundred Ninety-Nine Tredecillion Nine Hundred Ninety-Nine Duodecillion Nine Hundred Ninety-Nine Undecillion Nine Hundred Ninety-Nine Decillion Nine Hundred Ninety-Nine Nonillion Nine Hundred Ninety-Nine Octillion Nine Hundred Ninety-Nine Septillion Nine Hundred Ninety-Nine Sextillion Nine Hundred Ninety-Nine Quintillion Nine Hundred Ninety-Nine Quadrillion Nine Hundred Ninety-Nine Trillion Nine Hundred Ninety-Nine Billion Nine Hundred Ninety-Nine Million Nine Hundred Ninety-Nine Thousand Nine Hundred Ninety-Nine
There's not much else to say about this - except to repeat it's ridiculous but also interesting & fun.
