home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / disk_20.zip / SOUNDEX2.ZIP / PROCSDX.PRG next >
Text File  |  1987-03-21  |  3KB  |  82 lines
  1. *:*********************************************************************
  2. *:
  3. *:      Program: PROCSDX.PRG
  4. *:
  5. *:       System: soundex
  6. *:       Author: Larry
  7. *:    Copyright (c) 1986, Larry
  8. *:
  9. *:    Called by: TEST.PRG
  10. *:
  11. *: Documented: 3/21/87       23:41                   SNAP! version 1.73
  12. *:*********************************************************************
  13. PROCEDURE cnvrt_sdx
  14. PARAMETERS sdxin , sdxout
  15.  
  16.  
  17. ** The original soundex a dbaseii program and was found on the
  18. ** Lakewood police bulletin board in Denver under the file name
  19. ** of pen-toll and apparently written by someone named Larry .
  20. ** Hats off to Larry.
  21. ** The original code was converted to dbaseiii+ had a few bugs taken
  22. ** out and some enhancements added by Hank Jones.
  23. **
  24. ** This SOUNDEX algorithm will convert any string into a phonetic code
  25. ** the resulting code will be the same for 'sound alike'  words
  26. ** (usually last names ).
  27. ** example : smith and smythe both convert to S53
  28. **
  29. ** this version of soundex does not strictly adhere to the Rand
  30. ** definition , the following exceptions are noted.
  31. ** 1) special characters are coded as 2
  32. **    oleary codes to O46 , o'leary codes to O246
  33. **    newton codes to N35 , newton-john codes to N3525
  34. ** 2) lower case input and the resulting code will be upshifted.
  35. ** 3) The resulting codes are variable length .
  36. **    in the rand soundex jones would code J520 or skywalker S242
  37. **    (first character of the string plus three digits right padded
  38. **    with zero).In this application jones would code J52
  39. **    or skywalker would code S2426.
  40. **
  41. **  parameters
  42. ** INPUT  IS SDXIN
  43. ** OUTPUT IS SDXOUT
  44. **
  45.  
  46. STORE TRIM(UPPER(sdxin))+ " " TO in_name
  47. STOR LEN(TRIM(in_name)) TO name_lgth
  48. STOR SUBSTR(in_name,1,1) TO sdx_code,dup_check
  49. STOR 2 TO indx
  50. STOR SUBSTR(in_name,indx,1) TO current
  51. DO WHILE indx <= name_lgth
  52.   DO CASE
  53.   CASE current='A'.or.current='E'.or.current='H'.or.current='I';
  54.     .OR. current='O'.or.current='U'.or.current='W'.or.current='Y'
  55.     STORE '0' TO current
  56.   CASE current='B'.or.current='F'.or.current='P'.or.current='V'
  57.     STORE '1' TO current
  58.   CASE current='D'.or.current='T'
  59.     STOR '3' TO current
  60.   CASE current='L'
  61.     STOR '4' TO current
  62.   CASE current='M'.or.current='N'
  63.     STOR '5' TO current
  64.   CASE current='R'
  65.     STOR '6' TO current
  66.   OTHERWISE
  67.     STOR '2' TO current
  68.   ENDCASE
  69.   IF (current<>'0'.AND. current<>dup_check)
  70.     STORE sdx_code+current TO sdx_code
  71.     STORE current TO dup_check
  72.   ENDIF
  73.   *SET STEP ON
  74.   *SET ECHO ON
  75.   indx = indx + 1
  76.   STORE SUBSTR(in_name,indx,1) TO current
  77. ENDDO
  78.  
  79. sdxout = sdx_code
  80. RETURN
  81. *: EOF: PROCSDX.PRG
  82.