home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / dbadvan.zip / SOUNDEX.PRG < prev    next >
Text File  |  1987-02-14  |  2KB  |  60 lines
  1. ** start newstring with the first letter of the string
  2. &firstchar
  3. &startstr
  4.  
  5. * remember this character
  6. STORE &character TO lastchar
  7. &nextchar
  8.  
  9. *process the string until don or four characters are in newstring
  10. DO WHILE .not. &endstring .AND. len(newstring) < 4
  11.   DO CASE
  12.       * drop all duplicate letters
  13.       cas &character = lastchar
  14.  
  15.       * drop all occurrences of a,e,h,i,o,u,w,y
  16.     CASE &character $ "AEHIOUWY" 
  17.  
  18.       *convert b,f,p,v, to 1
  19.     CASE &character $ "BFPV" 
  20.       STORE newstring + "1" TO newstring
  21.  
  22.       *convert c,g,j,k,q,s,x,z to 2
  23.     CASE &character $ "CGJKQSXZ" 
  24.       STORE newstring + "2" TO newstring
  25.  
  26.       *convert d,t to 3
  27.     CASE &character $ "DT" 
  28.       STORE newstring + "3" TO newstring
  29.  
  30.       *convert 1 to 4
  31.     CASE &character $ "MN" 
  32.       STORE newstring + "5" TO newstring
  33.  
  34.       * CONVERT M,N TO 5
  35.       case &character $ "MN"
  36.       store newstring + "5" to newstring 
  37.  
  38.       *convert r to 6
  39.     CASE &character $ "R" 
  40.       STORE newstring + "6" TO newstring
  41.   ENDCASE 
  42.  
  43.   ***remember this character and move to the next one
  44.   STORE &character TO lastchar
  45.   &nextchar
  46. ENDDO WHILE .not. &endstring .AND. len(newstrin
  47.  
  48. *if newstring is less than 4 characters, add trailing zeros
  49. DO WHILE len(newstring) < 4
  50.   STORE newstring + "0" TO newstring
  51. ENDDO WHILE len(newstring) < 4 
  52.  
  53. **cleanup
  54. RELEASE lastchar
  55. ****************************************************************
  56. ****************************************************************
  57. ****************************************************************
  58. ****************************************************************
  59. ****************************************************************
  60.