40 lines
1.3 KiB
Plaintext
40 lines
1.3 KiB
Plaintext
Soundex: procedure (pword) returns (character(4));
|
|
declare pword character (*) varying, value character (length(pword)) varying;
|
|
declare word character (length(pword));
|
|
declare (prevCode, currCode) character (1);
|
|
declare alphabet CHARACTER (26) STATIC INITIAL ('AEIOUHWYBFPVCGJKQSXZDTLMNR');
|
|
declare replace character (26) static initial ('00000000111122222222334556');
|
|
declare i fixed binary;
|
|
|
|
word = pword;
|
|
|
|
/* Buffer to build up with character codes */
|
|
value = '';
|
|
|
|
/* Make sure the word is at least two characters in length. */
|
|
if length(word) <= 1 then return (word);
|
|
|
|
word = uppercase(word); /* Convert to uppercase. */
|
|
|
|
/* The current and previous character codes */
|
|
prevCode = '0';
|
|
|
|
value = substr(word, 1, 1); /* The first character is unchanged. */
|
|
|
|
word = Translate (word, replace, alphabet);
|
|
|
|
/* Loop through the remaining characters ... */
|
|
do i = 2 to length(word);
|
|
currCode = substr(word, i, 1);
|
|
/* Check to see if the current code is the same as the last one */
|
|
if currCode ^= prevCode & currCode ^= '0' then
|
|
/* If the current code is a vowel, ignore it. */
|
|
value = value || currCode;
|
|
/* Set the new previous character code */
|
|
prevCode = currCode;
|
|
end; /* of do i = ... */
|
|
|
|
return ( left(value, 4, '0') ); /* Pad, if necessary. */
|
|
|
|
end Soundex;
|