*! version 1.0.0  02/02/93 extrname <main driver> utility; STB-13: dm13
program define _crcexn1 /* var px f m l sx af odd */
	local v      "`1'"
	local px     "`2'"
	local fname  "`3'"
	local mname  "`4'"
	local lname  "`5'"
	local sx     "`6'"
	local af     "`7'"
	local odd    "`8'"
				/* linkages */
	local exword  _crcexn2		/* extract word	*/
	local exword2 _crcexn9		/* extract word, add */
	local mknext  _crcexn4
	local stripp  _crcexnd		/* strip periods, begin edit */
	local chklna1 _crcexn5		/* check last name #1 	*/
	local chklna2 _crcexn6		/* check last name #2	*/
	local chkttl  _crcexn7		/* check fname for title */
	local rmttl   _crcexnc		/* remove suffix from name	*/
	local fixmid  _crcexn8		/* fix middle and last	*/
	local fixitl  _crcexnb		/* fix initials		*/
	local fixitl2 _crcexne		/* fix initials in last name */
	local recase  _crcexnf		/* upper case and period edits */
	local chkres  _crcexna		/* check results	*/

	tempvar bad fword

			/*
				PROGRAM BEGINS
			*/

	trimblnk `v'		/* remove multiple blanks	*/

			/*
				make commas have a space before and after
				make period have space after
			*/

	replstr "," " , " . `v'
	replstr "." ". " . `v'
	trimblnk `v'

			/*
				while mixed case, look for missing periods and 
				fix
			*/

	replword Mr Mr. 1 `v'
	replword Dr Dr. 1 `v'
	replword Ms Ms. 1 `v'
	replword Mrs Mrs. 1 `v'
	replword Prof Prof. 1 `v'
	replword Drs Drs. 1 `v'
	replword Lt Lt. 1 `v'
	replword Col Col. 1 `v'
	replword Gen Gen. 1 `v'
	replword Cmdr Cmdr. 1 `v'
	replword Sgt Sgt. 1 `v'

	replword Jr Jr. 1 `v'
	replword Sr Sr. 1 `v'

	replword Esq Esq. 1 `v'

		/*
			go to lower case
		*/

	replace `v'=lower(`v')
	replword professor prof. 1 `v'
	replword esquire esq. 1 `v'

		/*
			extract common prefixes and suffixes
		*/
	`exword'  `v' mr. Mr. `px'
	`exword'  `v' prof. Prof. `px'
	`exword2' `v' dr. Dr. `px'
	`exword'  `v' ms. Ms. `px'
	`exword'  `v' mrs. Mrs. `px'
	`exword'  `v' miss Miss `px'
	`exword'  `v' drs. drs. `px'		/* sic */
	`exword'  `v' lt. Lt. `px'
	`exword2' `v' col. Col. `px'
	`exword2' `v' cmdr. Cmdr. `px'
	`exword'  `v' cap. Cap. `px'
	`exword'  `v' ltcol. "Lt. Col." `px'
	`exword'  `v' ltcol "Lt. Col." `px'
	`exword'  `v' gen. Gen. `px'
	`exword'  `v' sgt. Sgt. `px'

	`exword'  `v' jr. Jr. `sx'
	`exword'  `v' sr. Sr. `sx'
	`exword'  `v' ", jr" Jr. `sx'
	`exword'  `v' ", sr" Sr. `sx'
	`exword'  `v' ", ii" II `sx'
	`exword'  `v' ", iii" III `sx'
	`exword'  `v' ", iv" IV `sx'

	`exword2' `v' ", md" M.D. `af'
	`exword2' `v' "m.d." M.D. `af'
	`exword2' `v' "ph. d." Ph.D. `af'		/* sic */
	`exword2' `v' "phd." Ph.D. `af'
	`exword2' `v' "phd" Ph.D. `af'
	`exword2' `v' "esq." Esq. `af'
	`exword2' `v' "esq" Esq. `af'

		/* 
			eliminate double commas, hanging commans, and 
			leading commas
		*/

	replstr ", ," "," . `v'

		/*
			eliminate hanging and leading commas
		*/

	replace `v'=trim(`v')
	replace `v'=trim(substr(`v',1,length(`v')-1)) /*
		*/ if substr(`v',length(`v'),1)==","
	replace `v'=trim(substr(`v',2,.)) if substr(`v',1,1)==","
	compress `v'

		/*
			assume "abc, ..." -> last name is abc
		*/

	drop `lname'			/* empty right now */
	splitstr `fword' `v' ","
	gen byte `bad'=`v'==""
	local type : type `fword'
	minlen `type' `v'
	replace `v'=`fword' if `bad'
	replace `fword'="" if `bad'
	drop `bad'
	rename `fword' `lname'
	compress `v' `lname'

		/* 
			try the next token as first name 
		*/

	drop `fname'			/* empty right now */
	`mknext' `v' `fname' `lname'



		/*
			try the next token as middle name 
		*/

	drop `mname'
	`mknext' `v' `mname' `lname'


		/*
			take the rest as last name if last name is still
			missing
		*/
	compress
	gen byte `bad' = `lname'==""
	local type : type `v'
	minlen `type' `lname'
	replace `lname'=trim(`v') if `bad'
	replace `v'="" if `bad'
	compress `lname' `v'


		/*
			we are now split; edit the result 
		*/
	`stripp' `fname' `mname' `lname'

		/* 
			The last name may now be jr, sr, or some such.
			If so, move 
				lname -> sx
			and find a new last name from either the 
			first or middle name 
		*/

	`chklna1' `lname' `fname' `mname' `sx' jr Jr.
	`chklna1' `lname' `fname' `mname' `sx' sr Sr.
	`chklna1' `lname' `fname' `mname' `sx' i I
	`chklna1' `lname' `fname' `mname' `sx' ii II
	`chklna1' `lname' `fname' `mname' `sx' iii III
	`chklna1' `lname' `fname' `mname' `sx' iv IV
	`chklna1' `lname' `fname' `mname' `sx' MD M.D.

		/*
			The last name might contain an initial, e.g., 

			starting with "Smith Bob F" or "Smith B" that would
			happen.  Interchange as necessary.
		*/

	`chklna2' `lname' `fname' `mname'

		/*
			The first name might be a title
		*/
	`chkttl' `px' `lname' `fname' `mname' mr Mr.
	`chkttl' `px' `lname' `fname' `mname' dr Dr.
	`chkttl' `px' `lname' `fname' `mname' ms Ms.
	`chkttl' `px' `lname' `fname' `mname' mrs Mrs.
	`chkttl' `px' `lname' `fname' `mname' miss Miss
	`chkttl' `px' `lname' `fname' `mname' prof Prof.
	`chkttl' `px' `lname' `fname' `mname' drs Drs.

		/*
			The last name might contain a suffix
		*/
	`rmttl' `lname' `sx' 0 jr Jr.
	`rmttl' `lname' `sx' 0 sr Sr.
	`rmttl' `lname' `sx' 0 i I
	`rmttl' `lname' `sx' 0 ii II
	`rmttl' `lname' `sx' 0 iii III
	`rmttl' `lname' `sx' 0 iv IV
	`rmttl' `lname' `af' 1 md M.D.
	`rmttl' `lname' `af' 1 phd Ph.D.
	`rmttl' `lname' `af' 1 esq Esq.
	

		/*
			the middle (first if middle missing) name might
			be von or de etc.  Put back together
		*/
	`fixmid' `lname' `fname' `mname' von "von "
	`fixmid' `lname' `fname' `mname' van "van "
	`fixmid' `lname' `fname' `mname' de "de "
	`fixmid' `lname' `fname' `mname' mc "mc"
	`fixmid' `lname' `fname' `mname' mac "mac"
	`fixmid' `lname' `fname' `mname' la "la "
	`fixmid' `lname' `fname' `mname' st. "st. "
	`fixmid' `lname' `fname' `mname' st  "st. "

		/*
			fix two-letter initials with missing middle name
		*/
	`fixitl' `fname' `mname' `lname' `odd'


		/* 
			Final cleaning (periods and capitalization)
		*/

	`recase' `fname' `mname' `lname'

	compress

	`fixitl2' `fname' `mname' `lname'

	`chkres' `px' `fname' `mname' `lname' `sx' af' `odd'
	
end