home *** CD-ROM | disk | FTP | other *** search
/ Software Du Jour / SoftwareDuJour.iso / BUSINESS / DBASE / DBAPG.ARC / AMT2WORD.PRG < prev    next >
Encoding:
Text File  |  1984-08-09  |  5.6 KB  |  166 lines
  1. * Program..: AMT2WORD.PRG
  2. * Author...: Tom Rettig
  3. * Date.....: August 26, 1983
  4. * Notice...: Copyright 1983 by Ashton-Tate.  All rights reserved.
  5. * Revised..: 1/11/84, 2/15/84
  6. * dBASE....: II, version 2.4x
  7. * Notes....: Converts a numeric dollar amount (to $999,999.99) 
  8. *            to words.
  9. *
  10. * Parameters passed:
  11. *   name       type   length    description
  12. *   ---------  ----   -------   ---------------------------
  13. * IN:
  14. *   amt:full    N     3 - 9     Including 2 decimal places.
  15. * OUT:
  16. *   amt:word    C     23 - 86   Depending on the amount.
  17. *   is:error    L     1         .T. if error in conversion.
  18. *
  19. * Expects: TALK (OFF)
  20. *    Sets: EXACT (OFF)
  21. *
  22. * Initialize memory variables...
  23. STORE "ONE  TWO  THREEFOUR FIVE SIX  SEVENEIGHTNINE TEN  ";
  24.       TO t:unit
  25. STORE "ELEVEN   TWELVE   THIRTEEN FOURTEEN FIFTEEN  " +;
  26.       "SIXTEEN  SEVENTEENEIGHTEEN NINETEEN " TO t:teen
  27. STORE "TEN    TWENTY THIRTY FORTY  FIFTY  SIXTY  SEVENTY" +;
  28.       "EIGHTY NINETY" TO t:decade
  29. STORE " " TO amt:word
  30. STORE F TO is:error
  31. *
  32. * Convert decimal numbers to a string containing 
  33. * the cents amount...
  34. STORE STR((amt:full-INT(amt:full))*100,2) TO t:cent:str
  35. IF t:cent:str = " "
  36.    STORE "0" + $(t:cent:str,2,1) TO t:cent:str
  37. ENDIF
  38. *
  39. * Change the environment for upcoming branches...
  40. SET EXACT ON
  41. *
  42. * Conditional branch...
  43. DO CASE
  44.    *
  45.    * Branch for amounts too high or too low...
  46.    CASE amt:full > 999999.99 .OR. amt:full < 0.00
  47.       STORE T TO is:error
  48.       RELEASE ALL LIKE t:*
  49.       SET EXACT OFF
  50.       RETURN
  51.    *
  52.    * Branch for zero dollars...
  53.    CASE amt:full < 1.00
  54.       STORE " NO " TO amt:word
  55.    *
  56.    * Branch for other conditions...
  57.    OTHERWISE
  58.       *
  59.       * Convert dollar amount to a character string...
  60.       STORE STR(INT(amt:full),6) TO t:amt:str
  61.       *
  62.       * Branch for hundred thousands...
  63.       IF $(t:amt:str,1,1) > "0"
  64.          STORE $(t:amt:str,1,1) TO t:hunthous
  65.          STORE amt:word +;
  66.                TRIM($(t:unit,(VAL(t:hunthous)-1)*5+1,5)) +;
  67.                " HUNDRED " TO amt:word
  68.       ENDIF
  69.       *
  70.       * Branch for ten-thousands and thousands...
  71.       IF $(t:amt:str,2,2) > "  "
  72.          STORE $(t:amt:str,2,1) TO t:tenthous
  73.          STORE $(t:amt:str,3,1) TO t:thousand
  74.          *
  75.          * Branch for combinations of ten-thousands
  76.          * and thousands...
  77.          DO CASE
  78.             CASE $(t:amt:str,1,1) > "0" .AND.;
  79.                  VAL($(t:amt:str,2,2)) = 0
  80.                STORE amt:word + "THOUSAND" TO amt:word
  81.             CASE t:tenthous=" " .OR. t:tenthous="0"
  82.                STORE amt:word +;
  83.                   TRIM($(t:unit,(VAL(t:thousand)-1)*5+1,5));
  84.                   + " THOUSAND" TO amt:word
  85.             CASE t:thousand="0"
  86.                STORE amt:word +;
  87.                   TRIM($(t:decade,(VAL(t:tenthous)-1)*7+1,7));
  88.                   + " THOUSAND" TO amt:word
  89.             CASE t:tenthous="1"
  90.                STORE amt:word +;
  91.                   TRIM($(t:teen,(VAL(t:thousand)-1)*9+1,9));
  92.                   + " THOUSAND" TO amt:word
  93.             CASE t:tenthous>"1"
  94.                STORE amt:word +;
  95.                   TRIM($(t:decade,(VAL(t:tenthous)-1)*7+1,7));
  96.             +"-"+ TRIM($(t:unit,(VAL(t:thousand)-1)*5+1,5));
  97.                   + " THOUSAND" TO amt:word
  98.          ENDCASE
  99.          *
  100.          * Branch for comma or space after thousands...
  101.          IF VAL($(t:amt:str,4,3)) > 0
  102.             STORE amt:word +", " TO amt:word
  103.          ELSE
  104.             STORE amt:word +" " TO amt:word
  105.          ENDIF
  106.       ENDIF
  107.       *
  108.       * Branch for hundreds...
  109.       IF $(t:amt:str,4,1) > "0"
  110.          STORE $(t:amt:str,4,1) TO t:hundred
  111.          STORE amt:word +;
  112.                TRIM($(t:unit,(VAL(t:hundred)-1)*5+1,5));
  113.                + " HUNDRED " TO amt:word
  114.       ENDIF
  115.       *
  116.       * Branch for tens and ones... 
  117.       IF VAL($(t:amt:str,5,2)) > 0
  118.          STORE $(t:amt:str,5,1) TO t:tens
  119.          STORE $(t:amt:str,6,1) TO t:ones
  120.          *
  121.          * Branch for combinations of tens and ones...
  122.          DO CASE
  123.             CASE t:tens=" " .OR. t:tens="0"
  124.                STORE amt:word +;
  125.                      TRIM($(t:unit,(VAL(t:ones)-1)*5+1,5));
  126.                      + " " TO amt:word
  127.             CASE t:ones="0"
  128.                STORE amt:word +;
  129.                      TRIM($(t:decade,(VAL(t:tens)-1)*7+1,7));
  130.                      + " " TO amt:word
  131.             CASE t:tens="1"
  132.                STORE amt:word +;
  133.                      TRIM($(t:teen,(VAL(t:ones)-1)*9+1,9));
  134.                      + " " TO amt:word
  135.             CASE t:tens>"1"
  136.                STORE amt:word +;
  137.                      TRIM($(t:decade,(VAL(t:tens)-1)*7+1,7));
  138.                +"-"+ TRIM($(t:unit,(VAL(t:ones)-1)*5+1,5));
  139.                      + " " TO amt:word
  140.          ENDCASE
  141.       ENDIF
  142. ENDCASE
  143. *
  144. * Branch for one dollar or more and one cent or more, 
  145. * and put the word string together...
  146. DO CASE
  147.    CASE amt:word=" ONE" .AND. t:cent:str="01"
  148.       STORE $(amt:word,2,LEN(TRIM(amt:word))+1) +;
  149.             "DOLLAR and " + t:cent:str + " CENT" TO amt:word
  150.    CASE amt:word=" ONE" .AND. (.NOT. t:cent:str="01")
  151.       STORE $(amt:word,2,LEN(TRIM(amt:word))+1) +;
  152.             "DOLLAR and " + t:cent:str + " CENTS" TO amt:word
  153.    CASE (.NOT. amt:word=" ONE") .AND. t:cent:str="01"
  154.       STORE $(amt:word,2,LEN(TRIM(amt:word))+1) +;
  155.             "DOLLARS and " + t:cent:str + " CENT" TO amt:word
  156.    OTHERWISE
  157.       STORE $(amt:word,2,LEN(TRIM(amt:word))+1) +;
  158.             "DOLLARS and " + t:cent:str + " CENTS" TO amt:word
  159. ENDCASE
  160. *
  161. * Restore the environment and return to the calling program...
  162. RELEASE ALL LIKE t:*
  163. SET EXACT OFF
  164. RETURN
  165. * EOF: Amt2word.prg
  166.