FUNCTION Soundex(cWord)

 /*

 This is a Clipper/XBase++ implementation of the standard American Soundex procedure.

 */
LOCAL cSoundex, i, nLast, cChar, nCode

cWord:=ALLTRIM(UPPER(cWord))
cSoundex:=LEFT(cWord, 1)        // first letter is first char
nLast:=-1
FOR i:=2 TO LEN(cWord)
   cChar:=SUBSTR(cWord, i, 1)   // get char
   nCode:=SoundexCode(cChar)    // get soundex code for char
   IF nCode=0                   // if 0, ignore
      LOOP
   ENDIF
   IF nCode#nLast               // if not same code, add to soundex
      nLast:=nCode              // and replace the last one
      cSoundex+=STR(nCode, 1)
   ENDIF
NEXT
cSoundex:=PADR(cSoundex, 4, "0")

RETURN(cSoundex)

*******************************************************************************
STATIC FUNCTION SoundexCode(cLetter)
LOCAL aCodes:={"BFPV", "CGJKQSXZ", "DT", "L", "MN", "R"}, i, nRet:=0

FOR i:=1 TO LEN(aCodes)
   IF cLetter $ aCodes[i]
      nRet:=i
      EXIT
   ENDIF
NEXT

RETURN(nRet)

*******************************************************************************
FUNCTION SoundexDifference(cSound1, cSound2)
LOCAL nMatch:=0, nLen1, nLen2, i

nLen1:=LEN(cSound1)
nLen2:=LEN(cSound2)

// make the two words the same length.  This is a safety.  They both should be 4 characters long.
IF nLen1 > nLen2
   cSound2:=PADR(cSound2, nLen1-nLen2, "0")
ELSEIF nLen1 < nLen2
   cSound1:=PADR(cSound1, nLen2-nLen1, "0")
ENDIF

// compare the corresponding characters between the two words
FOR i:=1 TO LEN(cSound1)
   IF SUBSTR(cSound1, i, 1) == SUBSTR(cSound2, i, 1)
      ++nMatch
   ENDIF
NEXT

RETURN(nMatch)

*******************************************************************************