×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

COBOL General discussion FAQ

Functions

Callable routine to convert a dollar amount to words by CliveC
Posted: 27 Mar 02 (Edited 2 Aug 02)

       IDENTIFICATION DIVISION.
       PROGRAM-ID.    CWAMTWRD.
       AUTHOR.        CLIVE CUMMINS.
       INSTALLATION.  http://tubularity.com
       DATE-WRITTEN.  JAN 15,1993.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  PROGRAM-DETAILS.
           05  PROGRAM-RELEASE.
               10  PROGRAM-NAME PIC X(08) VALUE "CWAMTWRD".
               10  PROGRAM-REL  PIC X(08) VALUE "  3.2.10".
       01 TABLE-AREAS.
           05  NUMBER-WORD-XREF-AREA.
               10  FILLER           PIC X(12) VALUE "01One#      ".
               10  FILLER           PIC X(12) VALUE "02Two#      ".
               10  FILLER           PIC X(12) VALUE "03Three#    ".
               10  FILLER           PIC X(12) VALUE "04Four#     ".
               10  FILLER           PIC X(12) VALUE "05Five#     ".
               10  FILLER           PIC X(12) VALUE "06Six#      ".
               10  FILLER           PIC X(12) VALUE "07Seven#    ".
               10  FILLER           PIC X(12) VALUE "08Eight#    ".
               10  FILLER           PIC X(12) VALUE "09Nine#     ".
               10  FILLER           PIC X(12) VALUE "10Ten#      ".
               10  FILLER           PIC X(12) VALUE "11Eleven#   ".
               10  FILLER           PIC X(12) VALUE "12Twelve#   ".
               10  FILLER           PIC X(12) VALUE "13Thirteen# ".
               10  FILLER           PIC X(12) VALUE "14Fourteen# ".
               10  FILLER           PIC X(12) VALUE "15Fifteen#  ".
               10  FILLER           PIC X(12) VALUE "16Sixteen#  ".
               10  FILLER           PIC X(12) VALUE "17Seventeen#".
               10  FILLER           PIC X(12) VALUE "18Eighteen# ".
               10  FILLER           PIC X(12) VALUE "19Nineteen# ".
               10  FILLER           PIC X(12) VALUE "20Twenty#   ".
               10  FILLER           PIC X(12) VALUE "30Thirty#   ".
               10  FILLER           PIC X(12) VALUE "40Forty#    ".
               10  FILLER           PIC X(12) VALUE "50Fifty#    ".
               10  FILLER           PIC X(12) VALUE "60Sixty#    ".
               10  FILLER           PIC X(12) VALUE "70Seventy#  ".
               10  FILLER           PIC X(12) VALUE "80Eighty#   ".
               10  FILLER           PIC X(12) VALUE "90Ninety#   ".
           05  NUMBER-WORD-XREF-TABLE REDEFINES NUMBER-WORD-XREF-AREA
                   OCCURS 28 TIMES INDEXED BY NWX-IDX.
               10  XREF-NUMBER      PIC X(02).
               10  XREF-WORD        PIC X(10).
           05  WORD-AREA-TABLE.
               10  WORD-AREA OCCURS 9 TIMES INDEXED BY WORD-IDX
                                    PIC X(10).
       01  CONSTANTS.
           05  C-HUNDRED            PIC  X(8) VALUE "Hundred#".
           05  C-THOUSAND           PIC  X(9) VALUE "Thousand#".
           05  C-20                 PIC  X(2) VALUE "20".
       01  WORK-AREAS.
           05  TESTNUM-VALUE-D          PIC  99999V99.
           05  TESTNUM-VALUE-X  REDEFINES TESTNUM-VALUE-D.
               10  TESTNUM-DOLLARS.
                   15  TESTNUM-DOLLAR-1 PIC X(1).
                   15  TESTNUM-DOLLAR-2 PIC X(1).
                   15  TESTNUM-DOLLAR-3 PIC X(1).
                   15  TESTNUM-DOLLAR-4 PIC X(1).
                   15  TESTNUM-DOLLAR-5 PIC X(1).
               10  TESTNUM-CENTS        PIC X(2).
           05  TESTNUM-SEARCH-SAVE      PIC X(2).
           05  TESTNUM-SEARCH-VALUE.
               10  TESTNUM-SEARCH-1     PIC X(1).
               10  TESTNUM-SEARCH-2     PIC X(1).
           05  STRING-AREA              PIC X(60).
           05  CENTS-AREA.
               10  FILLER               PIC X(2) VALUE "&#".
               10  CENTS-VALUE          PIC X(2).
               10  FILLER               PIC X(5) VALUE "/100#".
       LINKAGE SECTION.
       01  CWAMTWRD-VALUE         PIC S9(5)V99.
       01  CWAMTWRD-VALUE-EDITED  PIC ****9.99-.
       01  CWAMTWRD-WORDS         PIC X(60).
       PROCEDURE DIVISION USING CWAMTWRD-VALUE CWAMTWRD-VALUE-EDITED
                                               CWAMTWRD-WORDS.
       1000-CONTROL.
           SET WORD-IDX TO +1.
           MOVE CWAMTWRD-VALUE TO TESTNUM-VALUE-D.
           MOVE CWAMTWRD-VALUE TO CWAMTWRD-VALUE-EDITED.
           MOVE SPACES TO WORD-AREA-TABLE STRING-AREA.
           MOVE TESTNUM-DOLLAR-1 TO TESTNUM-SEARCH-1.
           MOVE TESTNUM-DOLLAR-2 TO TESTNUM-SEARCH-2.
           IF TESTNUM-SEARCH-VALUE GREATER THAN ZERO
               PERFORM 2000-GET-THOUSANDS.
           MOVE ZERO             TO TESTNUM-SEARCH-1.
           MOVE TESTNUM-DOLLAR-3 TO TESTNUM-SEARCH-2.
           IF TESTNUM-SEARCH-VALUE GREATER THAN ZERO
               PERFORM 3000-GET-HUNDREDS.
           MOVE TESTNUM-DOLLAR-4 TO TESTNUM-SEARCH-1.
           MOVE TESTNUM-DOLLAR-5 TO TESTNUM-SEARCH-2.
           IF TESTNUM-SEARCH-VALUE GREATER THAN ZERO
               PERFORM 4000-GET-TENS.
           PERFORM 9000-STRING-WORDS.
           GOBACK.
       2000-GET-THOUSANDS.
           PERFORM 4000-GET-TENS.
           MOVE C-THOUSAND TO WORD-AREA (WORD-IDX).
           SET WORD-IDX UP BY +1.
       3000-GET-HUNDREDS.
           PERFORM 8000-SEARCH-XREF.
           MOVE XREF-WORD (NWX-IDX) TO WORD-AREA (WORD-IDX).
           SET WORD-IDX UP BY +1.
           MOVE C-HUNDRED TO WORD-AREA (WORD-IDX).
           SET WORD-IDX UP BY +1.
       4000-GET-TENS.
           MOVE TESTNUM-SEARCH-VALUE TO TESTNUM-SEARCH-SAVE.
           IF TESTNUM-SEARCH-2 EQUAL ZERO
           OR TESTNUM-SEARCH-VALUE LESS THAN C-20
               PERFORM 8000-SEARCH-XREF
               MOVE XREF-WORD (NWX-IDX) TO WORD-AREA (WORD-IDX)
               SET WORD-IDX UP BY +1
           ELSE
               MOVE ZERO TO TESTNUM-SEARCH-2
               PERFORM 8000-SEARCH-XREF
               MOVE XREF-WORD (NWX-IDX) TO WORD-AREA (WORD-IDX)
               SET WORD-IDX UP BY +1
               MOVE TESTNUM-SEARCH-SAVE TO TESTNUM-SEARCH-VALUE
               MOVE ZERO TO TESTNUM-SEARCH-1
               PERFORM 8000-SEARCH-XREF
               MOVE XREF-WORD (NWX-IDX) TO WORD-AREA (WORD-IDX)
               SET WORD-IDX UP BY +1.
       8000-SEARCH-XREF.
           SET NWX-IDX TO +1.
           SEARCH NUMBER-WORD-XREF-TABLE
               WHEN TESTNUM-SEARCH-VALUE EQUAL XREF-NUMBER (NWX-IDX)
               NEXT SENTENCE.
       9000-STRING-WORDS.
           MOVE ALL "*" TO STRING-AREA.
           IF TESTNUM-CENTS NOT EQUAL ZERO
               MOVE TESTNUM-CENTS TO CENTS-VALUE
               MOVE CENTS-AREA TO WORD-AREA (WORD-IDX).
           STRING WORD-AREA (1) WORD-AREA (2) WORD-AREA (3)
                  WORD-AREA (4) WORD-AREA (5) WORD-AREA (6)
                  WORD-AREA (7) WORD-AREA (8) WORD-AREA (9)
                  DELIMITED BY " " INTO STRING-AREA.
           INSPECT STRING-AREA REPLACING ALL "#" BY " ".
           MOVE STRING-AREA TO CWAMTWRD-WORDS.

Back to COBOL General discussion FAQ Index
Back to COBOL General discussion Forum

My Archive

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close