|
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 mailing list archive is Copyright 1997-2025 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.
