× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



Here is how we do it the code was written long ago but works...

We have a data area defined like below.
 New value  . . . . . . . . . . . > 'ONE      TWO      THREE    FOUR
FIVE
  SIX      SEVEN    EIGHT    NINE     TEN      ELEVEN   TWELVE   THIRTEEN
FOURTE
EN FIFTEEN  SIXTEEN  SEVENTEENEIGHTEEN NINETEEN TWENTY   THIRTY   FORTY
FIFTY
    SIXTY    SEVENTY  EIGHTY   NINETY'


‚    D*----------------------------------------------------------------
‚    D*  DATA STRUCTURE FOR NAMES TO MATCH NUMBERS
‚    D*       ON THE A/P CHECK
‚    D*----------------------------------------------------------------
     D                 DS                  INZ
     D  STEPS                  1    100
     D  BLNKS                  1      1
     D  MILLN                  2     15
     D  HTHOU                 16     29
     D  THOUS                 30     42
     D  THOUN                 43     51
     D  BLNK2                 52     52
     D  HUNDR                 53     66
     D  TEENS                 67     79
     D  CENTS                 80     86
     D  DOLAR                 87     99
     D  STOPQ                100    100



‚    C*****************************************************************
‚    C* SUBR04 - BUILD CHARACTER FIELDS FOR AMOUNT PAID
‚    C*****************************************************************
ˆ    C     SUBR04        BEGSR
‚    C*
     C                   MOVE      L3AMT         DCMLS             2
     C                   MOVEL     L3AMT         TEST7             7 0
š    C     TEST7         IFNE      *ZERO
     C                   MOVE      L3AMT         TEST1             4
     C                   MOVEL     TEST1         SAVES             2
     C                   MOVE      SAVES         SAVE1             2 0
‚    C*----------------------------------------------------------------

‚    C*----------------------------------------------------------------
‚    C*  CHECK FOR SINGLE DIGIT OR GREATER THAN 19
‚    C*----------------------------------------------------------------
š    C     SAVE1         IFLE      9
š    C     SAVE1         ORGT      19
     C                   MOVEL     '0'           SAVES
‚    C*----------------------------------------------------------------

‚    C*----------------------------------------------------------------
‚    C*DIGIT 1   SINGLE DOLLAR BUCKET
‚    C*----------------------------------------------------------------
š    C     SAVES         IFNE      '00'
     C                   MOVE      SAVES         SAVE1             2 0
     C                   MOVEL     NBR(SAVE1)    DIGT1             5
š    C                   ENDIF
‚    C*----------------------------------------------------------------

‚    C*----------------------------------------------------------------
‚    C*DIGIT 2  TEN DOLLAR BUCKET
‚    C*----------------------------------------------------------------
     C                   MOVEL     TEST1         SAVES
     C                   MOVE      '0'           SAVES
     C                   MOVE      SAVES         SAVE1             2 0
š    C     SAVES         IFNE      '00'
    C                   EXSR      SUBR07
     C                   MOVEL     NBR(SAVE1)    DIGT2             7
     C                   MOVEL     DIGT2         TEENS            13
š    C                   ENDIF
‚    C*
     C                   MOVE      DIGT1         TEENS
‚    C*----------------------------------------------------------------

‚    C*----------------------------------------------------------------
‚    C*  DIGIT 1 AND 2  ELEVEN TO TWENTY DOLLARS BUCKET(TOGETHER)
‚    C*----------------------------------------------------------------
š    C                   ELSE
š    C     SAVES         IFNE      '00'
     C                   MOVE      SAVES         SAVE1             2 0
     C                   MOVEL     NBR(SAVE1)    DGT12             9
     C                   MOVE      DGT12         TEENS
š    C                   ENDIF
š    C                   ENDIF
‚    C*----------------------------------------------------------------

‚    C*----------------------------------------------------------------
‚    C*DIGIT 3 HUNDRED DOLLAR BUCKET
‚    C*----------------------------------------------------------------
     C                   MOVEL     L3AMT         TEST3             5 0
     C                   MOVE      TEST3         SAVES
     C                   MOVEL     '0'           SAVES
     C                   MOVE      SAVES         SAVE1             2 0
š    C     SAVES         IFNE      '00'
     C                   MOVEL     NBR(SAVE1)    DIGT3             5
     C                   MOVEL     DIGT3         HUNDR            14
     C                   MOVE      'HUNDRED '    HUNDR
š    C                   ENDIF
‚    C*----------------------------------------------------------------

‚    C*----------------------------------------------------------------
‚    C* CHECK DIGIT 4 & 5 FOR SINGLE DIGIT OR GREATER THAN 19
‚    C*----------------------------------------------------------------
     C                   MOVEL     L3AMT         TEST1             4
     C                   MOVE      TEST1         SAVES
     C                   MOVE      SAVES         SAVE1
š    C     SAVE1         IFLE      09
š    C     SAVE1         ORGT      19
‚    C*----------------------------------------------------------------

‚    C*----------------------------------------------------------------
‚    C*DIGIT 4 SINGLE THOUSAND DOLLAR BUCKET
‚    C*----------------------------------------------------------------
     C                   MOVEL     '0'           SAVES
š    C     SAVES         IFNE      '00'
     C                   MOVE      SAVES         SAVE1             2 0
     C                   MOVEL     NBR(SAVE1)    DIGT4             5
š    C                   ENDIF
‚    C*----------------------------------------------------------------

‚    C*----------------------------------------------------------------
‚    C*DIGIT 5 TENS THOUSANDS DOLLAR BUCKET
‚    C*----------------------------------------------------------------
     C                   MOVE      TEST1         SAVES
     C                   MOVE      '0'           SAVES
š    C     SAVES         IFNE      '00'
     C                   MOVE      SAVES         SAVE1             2 0
    C                   EXSR      SUBR07
     C                   MOVEL     NBR(SAVE1)    DIGT5             7
     C                   MOVEL     DIGT5         THOUS            13
š    C                   ENDIF
‚    C*
     C                   MOVE      DIGT4         THOUS
‚    C*
š    C                   ELSE
‚    C*----------------------------------------------------------------

‚    C*----------------------------------------------------------------
‚    C*DIGIT 4 AND 5 ELEVEN TO TWENTY THOUSAND DOLLAR BUCKETS
‚    C*----------------------------------------------------------------
š    C     SAVES         IFNE      '00'
     C                   MOVE      SAVES         SAVE1             2 0
     C                   MOVEL     NBR(SAVE1)    DGT45             9
     C                   MOVE      DGT45         THOUS
š    C                   ENDIF
š    C                   ENDIF
‚    C*----------------------------------------------------------------

‚    C*----------------------------------------------------------------
‚    C*DIGIT 6   HUNDRED THOUSAND DOLLAR BUCKET
‚    C*----------------------------------------------------------------
     C                   MOVEL     L3AMT         TEST4             2
     C                   MOVE      TEST4         SAVES
     C                   MOVEL     '0'           SAVES
     C                   MOVE      SAVES         SAVE1             2 0
š    C     SAVES         IFNE      '00'
     C                   MOVEL     NBR(SAVE1)    DIGT6             5
     C                   MOVEL     DIGT6         HTHOU            14
     C                   MOVE      'HUNDRED '    HTHOU
š    C                   ENDIF
‚    C*
‚    C*----------------------------------------------------------------

‚    C*----------------------------------------------------------------
‚    C* MOVE THE WORD THOUSAND IF IF DOLLAR VALUE FOR THOUSAND *NE ZERO
‚    C*----------------------------------------------------------------
š    C     THOUS         IFNE      *BLANKS
     C                   MOVE      'THOUSAND'    THOUN             9
š    C                   ELSE
š    C     HTHOU         IFNE      *BLANKS
     C                   MOVE      'THOUSAND'    THOUN             9
š    C                   ENDIF
š    C                   ENDIF
‚    C*----------------------------------------------------------------

‚    C*----------------------------------------------------------------
‚    C*DIGIT 7 MILLION DOLLAR BUCKET
‚    C*----------------------------------------------------------------
     C                   MOVEL     L3AMT         TEST5             1
     C                   MOVE      '00'          SAVES
     C                   MOVE      TEST5         SAVES
     C                   MOVE      SAVES         SAVE1             2 0
š    C     SAVES         IFNE      '00'
     C                   MOVEL     NBR(SAVE1)    DIGT7             5
     C                   MOVEL     DIGT7         MILLN            14
     C                   MOVE      'MILLION'     MILLN
š    C                   ENDIF
‚    C*
š    C                   ENDIF
‚    C*----------------------------------------------*
‚    C* CENTS
‚    C*----------------------------------------------*
š    C     TEST7         IFNE      *ZEROS
     C                   MOVE      'DOLLARS '    DOLAR
     C                   MOVEL     ' &'          CENTS             7
     C                   MOVEL     '/100 '       DOLAR            13
š    C     DCMLS         IFNE      *ZEROS
     C                   MLLZO     '1'           DCMLS
     C                   MOVE      DCMLS         CENTS
š    C                   ELSE
     C                   MOVE      '00'          CENTS
š    C                   ENDIF
š    C                   ELSE
š    C     DCMLS         IFGT      *ZERO
     C                   MOVEL     'ONLY'        CENTS
     C                   MLLZO     '1'           DCMLS
     C                   MOVE      DCMLS         CENTS
š    C                   ENDIF
š    C                   ENDIF
‚    C*------------------------------------------*
‚    C* EXTRACT EXTRA BLANKS IN DOLLAR VALUE NAME*
‚    C*------------------------------------------*
     C                   MOVE      STEPS         STEP1           148
     C                   MOVEL     ASTR          STEP1
     C                   MOVEL     STEP1         CHKDG             1
     C                   MOVE      STEP1         STEP2           147
     C                   MOVE      *ZEROS        BLANK             2 0
ˆ    C     CHKDG         DOUEQ     'Q'
š    C     CHKDG         IFEQ      ' '
     C                   ADD       1             BLANK
š    C                   ELSE
     C     BLANK         SUB       BLANK         BLANK
š    C                   ENDIF
š    C     BLANK         IFLT      2
     C                   MOVE      CHKDG         STEP3           148
     C                   MOVE      STEP3         STEP4           147
     C                   MOVEL     STEP4         STEP3
š    C                   ENDIF
     C                   MOVEL     STEP2         STEP1
     C                   MOVEL     STEP1         CHKDG
     C                   MOVE      STEP1         STEP2
ˆ    C                   ENDDO
‚    C*----------------------------------------------*
     C                   MOVE      *ZEROS        BLANK
     C                   MOVE      ' '           STEP4
     C                   MOVE      STEP4         STEP5            78
‚    C*
     C                   MOVE      *BLANKS       TEST1
     C                   MOVE      *BLANKS       TEST3
     C                   MOVE      *BLANKS       TEST4
     C                   MOVE      *BLANKS       TEST5
     C                   MOVE      *BLANKS       TEST7
     C                   MOVE      *BLANKS       SAVES
     C                   MOVE      *BLANKS       SAVE1
     C                   MOVE      *BLANKS       DCMLS
     C                   MOVE      *BLANKS       DIGT1
     C                   MOVE      *BLANKS       DIGT2
     C                   MOVE      *BLANKS       DIGT3
     C                   MOVE      *BLANKS       DIGT4
     C                   MOVE      *BLANKS       DIGT5
     C                   MOVE      *BLANKS       DIGT6
     C                   MOVE      *BLANKS       DGT12
     C                   MOVE      *BLANKS       DGT45
     C                   MOVE      *BLANKS       DOLAR
     C                   MOVE      *BLANKS       CENTS
     C                   MOVE      *BLANKS       TEENS
     C                   MOVE      *BLANKS       HUNDR
     C                   MOVE      *BLANKS       THOUN
     C                   MOVE      *BLANKS       THOUS
     C                   MOVE      *BLANKS       HTHOU
     C                   MOVE      *BLANKS       MILLN
     C                   MOVE      *BLANKS       STEP1
     C                   MOVE      *BLANKS       STEP2
     C                   MOVE      *BLANKS       STEP3
     C                   MOVE      *BLANKS       STEP4
‚    C*
ˆ    C                   ENDSR








Scott Carter
214-583-0348
RSR Corporation
2777 Stemmons Frwy.
Suite 1900
Dallas, TX. 75207
www.rsrcorporation.com


************************
CONFIDENTIALITY NOTICE:

This e-mail message, including any attachments, may contain legally
privileged and/or
confidential information.  If you are not the intended recipient(s), or the
employee
or agent responsible for delivery of this message to the intended
recipient(s), any
distribution, copying, or retention of this e-mail message or any
attachments,
is strictly prohibited.  If you have received this message in error, please
immediately
notify the sender and delete this e-mail message from your system.
This e-mail does not constitute a consent to the use of sender's contact
information
for direct marketing purposes or for transfers of personal data to third
parties.


As an Amazon Associate we earn from qualifying purchases.

This thread ...

Replies:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.