!%SBTTL "External subprogram - str_soundex"
	!%IDENT "V1-003"

 sub str_soundex (string soundex_out, string text_in)

!+
! Version:	V1-003
!
! Facility:	String routines.
!
! Abstarct:	To return the soundex equivalent of an alpha string.
!
! Environment:	User mode.
!
! History:
!
!	17-Jun-1986, DBS; Version V1-001
! 001 -	Original version.
!	19-Jun-1992, DBS; Version V1-002
! 002 -	Modified for VAX basic.
!	29-Jun-1992, DBS; Version V1-003
! 003 -	Modified to not include trailing zeros.
!-

!++
! Functional Description:
!	This module will return the soundex code for an alpha string.
!
! Calling Sequence:
!	call str_soundex (soundex_value by desc, my_text by desc)
!
! Formal Arguments:
!	soundex_out.wt.ds	The soundex code for the word
!	text_in.rt.ds		The text to be converted.
!
! Implicit Inputs:
!	None.
!
! Implicit Outputs:
!	None.
!
! Completion Codes:
!	None.
!
! Side Effects:
!	None.
!--

	!%SBTTL "Declarations"

	declare long		i

	declare string text
	declare string soundex
	declare string char

	declare string function substitute

	!%SBTTL "Mainline"

Mainline:

	!+
	!   here we control the flow of logic
	!-

	text	= edit$(text_in, 255%)
	soundex	= left$(text, 1%)
	text	= right$(text, 2%)
	text	= substitute(text, 'A', '')
	text	= substitute(text, 'E', '')
	text	= substitute(text, 'I', '')
	text	= substitute(text, 'O', '')
	text	= substitute(text, 'U', '')
	text	= substitute(text, 'W', '')
	text	= substitute(text, 'H', '')
	text	= substitute(text, 'Y', '')
	text	= substitute(text, string$(2%, i), chr$(i)) &
				for i = 65% to 90%
!003	text	= text + '***'
	text	= left$(text, 3%) if (len(text) > 3%)

	for i = 1% to len(text)
		char = mid$(text, i, 1%)

		if (pos('BFPV', char, 1%))
			then
			soundex = soundex + '1'
		else
		if (pos('CGJKQSXZ', char, 1%))
			then
			soundex = soundex + '2'
		else
		if ((char = 'D') or (char = 'T'))
			then
			soundex = soundex + '3'
		else
		if (char = 'L')
			then
			soundex = soundex + '4'
		else
		if ((char = 'M') or (char = 'N'))
			then
			soundex = soundex + '5'
		else
		if (char = 'R')
			then
			soundex = soundex + '6'
		else
!003		soundex = soundex + '0'
		end if
		end if
		end if
		end if
		end if
		end if
	next i

	soundex_out = soundex

 subexit

def string substitute (string original, string old_bit, string new_bit)

	declare long len_old_bit
	declare long len_new_bit
	declare long found_it

	len_old_bit = len(old_bit)
	len_new_bit = len(new_bit)
	found_it    = pos(original, old_bit, 1%)

	while found_it
		original = left$(original, found_it - 1%) + new_bit	  &
				+ right$(original, found_it + len_old_bit)
		found_it = pos(original, old_bit, found_it + len_new_bit)
	next

	substitute	= original

end def

end sub