home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
soundex2.zip
/
SOUNDEX2.PRG
Wrap
Text File
|
1987-04-05
|
5KB
|
141 lines
* Purpose of this program:
* 1. Store the soundex code for every entry in a database file with a
* character field containing the last name.
* 2. Enter a last name. This program generates a soundex code for it,
* and retrieves all records matching the code.
* (The codes are case insensitive)
*
* Original program from the Data Based Advisor, Aug., 1984 page 46
* By John Gillen, Lexicon Publishing, 725 J Street,
* Sacramento, CA 95814
*
* Adapted to dBASE III and modified June 14, 1985 by
* Michael Shunfenthal,
* 2602 West 235 Street, Torrance CA 90505
*
* Modified to run faster on September 10, 1985 by
* Kenneth E. Madl
* 9995 E. Harvard, #M-186, Denver CO 80231
*
*
* To use this program:
* 1. Modify the structure of your database to add a 4-character field
* to hold the soundex code for each last name. Then enter:
* set procedure to soundex
*
* 2. Set the code into this field for the entire database:
* (the program requires approx. 3 seconds for each record)
* do sreplace with '<dbfname>', '<lastname field>', '<soundex field>'
*
* 3. Retrieve records having the same code for the entered last name:
* do sdisplay with '<dbfname>', '<last name>', '<soundex field>'
*
* Notes on above commands:
* 1. The apostrophes (or double quotes, or brackets) are required
* per the dBASE III manual, to delimit character values.
* 2. Omit the angle brackets: <>.
* 3. The last name field or entry may have an embedded apostrophe
* ("O'Brian"), space, or hyphen.
*
*************************************************************************
* Program operation: (procedure sndxcalc)
* Create a Soundex code for the last name parameter
* (either a field or variable) and save in public variable sndxcode
* 1. Assign the first letter of the last name to the first digit of
* the code
* 2. Check for and remove double consonants
* 3. Assign a value to the remaining letters
* 4. Adjust the code length to four characters
* 5. Store this value in the soundex field
*
* Modifications to the original article listing:
* 1. Added multiple functions:
* a. Store the soundex code for a given last name field (input)
* and a given soundex-code field (output) in a given database
* b. Retrieve names given a last name, last-name field,
* and soundex field
* 2. Made more generalized: replaced the hard coded database file name
* and field names with user-entered parameters
* 3. Fix bugs: ignore apostrophe, hyphen, or space within the last name.
* 4. Fix bugs: ignore second key letter or equivalent when consecutive
*
procedure sreplace
parameter dbfname, lastnmfld, sndxfld
public sndxcode
set talk off
use &dbfname
clear
? ' Rec #' + space(8) + 'NAME' + space(13) + 'SOUNDEX'
?
do while .not. eof()
mlastnm = &lastnmfld
do sndxcalc with "&mlastnm"
? space(2)+str(recno(),4)+space(7)+&lastnmfld+space(7)+sndxcode
replace &sndxfld with sndxcode
skip
enddo
?
wait
set talk on
clear
return
procedure sdisplay
parameter dbfname, lastnam, sndxfld
public sndxcode
set talk off
use &dbfname
do sndxcalc with "&lastnam"
?
?
? ' The soundex code for ' + '&lastnam' + ' is ' + sndxcode
?
display all off for &sndxfld='&sndxcode'
?
set talk on
return
procedure sndxcalc
parameter charname
name = upper(trim("&charname"))
if name = ' '
return
endif
length = len(name)
lettr = "ABCDEFGHIJKLMNOPQRSTUVWXYZ'-, "
numbr = "012301200224550126230102020000"
sndxcode = ' '
* assign the first letter of the name to the first digit of the code
sndxcode = substr(name,1,1)
pos = 2
cnt = 2
prior = '0'
* ignore double consanants at beginning of name
if sndxcode = substr(name,2,1)
pos = 3
endif
do while pos <= length
* substitute code number for letter of name
cnum = substr(numbr,at(substr(name,pos,1),lettr),1)
* ignore vowels and non-letter characters
if cnum <> '0'
* ignore second letter of double letters
if cnum <> prior
* code only the first 4 letters of the name
if cnt <= 4
sndxcode = sndxcode + cnum
prior = cnum
cnt = cnt + 1
endif pos <= 4
endif cnum <> prior
else
prior = '0'
endif cnum <> 0
pos = pos + 1
enddo
* check for soundex code length less than 4
do while len(sndxcode) < 4
sndxcode = sndxcode + '0'
enddo
return