Peter

Nice one.. The only little problem is the portuguese words with accents.. But, I do believe that I can do some mod. to accept it.. If I understood correctly the string M_S1 has the source for M_S2.. IOW, m_S2 has how the m_S1 soudns like.. As the same M_S3 for M_S4.. Am I correctly?

Thanks
>
>

>* SOUNDEX() para fonética brasileira
>*********************************************************************
>* Parametro:Palavra   Retorno: String que representa o som da palavra
>* Rotina original: Newton em 03/1990
>* Metodo   :As letras ou sequencias que produzem som ambiguo, sao
>*           substituidos de modo a evitar a ambiguidade. Exemplo:
>*           Z pode ter som de S
>*           S pode ter som de C
>*           C pode ter som de K
>*           Z,S e C sao substiuidos por K
>*           Este metodo, empobrece o resultado, fazendo com q palavras
>*           diferentes possuam o mesmo resultado. Porem, na pratica,
>*           parece atender de forma simples.
>*           A rotina não trata caracteres acentuados e, pode não funcionar
>*           para palavras de língua inglesa. Sugere-se neste caso utilizar
>*           soundex(soundexbr(palavra))
>*====================================================================
>Procedure SoundexBr   && Char Palavra
>Parameter Palavra
>Local M_Char,M_CharPro,M_CharAnt,M_Pai,M_Aux,M_S1,M_S2,M_S3,M_S4,M_Saida
>*
>*M_Char                          && Caracter retirado da palavra
>*M_CharPro                       && Caracter posterior a M_CHAR
>M_CharAnt = Space(1)             && Caracter anterior a M_CHAR
>M_Pal     = Upper(Palavra)       && Palavra em UpCase
>M_Aux     = 0                    && Contador auxiliar
>M_S1      = "CSZNEYWVL"          && Cadeia de caracteres origem
>M_S2      = "KKKMIIUUU"          && Cadeia de caracteres destino
>M_S3      = "BCDFGJKMNPQRSTVWXZ" && Consoantes
>M_S4      = " BDFGHJQT"          && Cadeia Apos a letra H
>M_Saida   = Space(0)             && Cadeia auxiliar de saida
>*
>For M_Aux=1 to Len(M_pal)
>   M_Char    = Subs(M_Pal,M_Aux,1)
>   M_CharPro = Subs(M_Pal+" ",M_Aux+1,1)
>   If M_Char$M_S1
>      M_Char=Subs(M_S2,At(M_Char,M_S1),1)
>   Endif
>   If M_Char = Space(1)
>      Loop
>   Endif
>   If M_Char = "H" and M_CharAnt$M_S4
>      Loop
>   Endif
>   If M_Char = M_CharAnt
>      Loop
>   Endif
>   If M_Char $ "KG" and M_CharPro$M_S3
>      Loop
>   Endif
>   * Modificacoes do proximo caracter
>   If M_Char+M_CharPro = "IX"  && Trocar Por "IK"  && EX ->EZ
>      M_Pal = Trim(Left(M_Pal,M_Aux)+"K"+Subs(M_Pal+" ",M_Aux+2))
>   Endif
>   If M_Char+M_CharPro = "KH"  && Trocar por "X"   && CH ->X
>      M_Pal = Trim(Left(M_Pal,M_Aux)+Space(1)+Subs(M_Pal+" ",M_Aux+2))
>      M_Char = "X"
>   Endif
>   If M_Char+M_CharPro = "QU"  && Trocar por "K"  && QU ->K
>      M_Pal = Trim(Left(M_Pal,M_Aux)+Space(1)+Subs(M_Pal+" ",M_Aux+2))
>      M_Char = "K"
>   Endif
>   If M_Char+M_CharPro = "GI"  && Trocar por "JI"   && GE ->JE
>      M_Char = "J"
>   Endif
>   If M_Char+M_CharPro = "PH"  && Trocar por "F"
>      M_Pal = Trim(Left(M_Pal,M_Aux)+Space(1)+Subs(M_Pal+" ",M_Aux+2))
>      M_Char = "F"
>   Endif
>   If M_Aux = Len(M_Pal)     && Ultimo Caracter
>      If M_Char = "G" .and. M_CharAnt = "M"
>         Loop
>      Endif
>      If M_Char$"KD"
>         Loop
>      Endif
>   Endif
>   If M_Char = M_CharAnt
>      Loop
>   Endif
>   M_Saida    = M_Saida + M_Char
>   M_CharAnt  = M_Char
>Next
>*
>Return M_Saida
>