icd9p.ado

是一个经济学管理应用软件 很难找的 但是经济学学生又必须用到

*! version 1.0.7  13may2005
program define icd9p
	version 9
	gettoken cmd 0 : 0, parse(" ,")
	local l = length("`cmd'")
	if "`cmd'"=="check" { 
		Check `0'
	}
	else if "`cmd'"=="clean" { 
		Clean `0'
	}
	else if "`cmd'" == substr("generate",1,max(3,`l')) {
		Gen `0'
	}
	else if "`cmd'" == substr("lookup",1,max(1,`l')) { 
		Lookup `0'
	}
	else if "`cmd'" == substr("search",1,max(3,`l')) {
		Search `0'
	}
	else if "`cmd'" == substr("tabulate",1,max(3,`l')) { 
		Tabulate `0'
	}
	else if `"`cmd'"' == "table" { 
		Table `0'
	}
	else if `"`cmd'"' == substr("query",1,max(1,`l')) {
		Query `0'
	}
	else 	di in red "invalid icd9p subcommand"
end

* ---
* icd9p check
program define Check, rclass
	syntax varname [, ANY List SYStem(string) Generate(string) ]
	local typ : type `varlist'
	if substr("`typ'",1,3)!="str" {
		di in red "`varlist' does not contain ICD-9 procedure codes;" /*
		*/ _n "ICD-9 procedure codes must be stored as a string"
		exit 459
	}
	if "`generate'"!="" {
		confirm new var `generate'
	}

	if "`system'"=="" {
		tempvar c
	}
	else	local c "`system'"

	quietly { 
		local typ : type `varlist'
		quietly gen `typ' `c' = upper(trim(`varlist'))
		compress `c'

		tempvar prob l

				/* 0.  code may contain "", missing */
		gen byte `prob' = cond(`c'=="", 0, .)


				/* 1.  invalid placement of period 	*/
				/* 2.  too many periods 		*/
		capture assert index(`c', ".") == 0
		if _rc { 
			gen byte `l' = index(`c', ".")
			replace `c' = (trim( /*
			*/ substr(`c',1,`l'-1) + substr(`c',`l'+1,.) /* 
			*/ )) if `l'
			compress `c'
			replace `prob' = 1 if `l'>0 & `l' < 3
			replace `prob' = 2 if index(`c', ".")
			drop `l'
		}

				/* 3.  code too short			*/
				/* 4.  code too long			*/
		gen byte `l' = length(`c')
		replace `prob'=3 if `l'<2 & `prob'==.
		replace `prob'=4 if `l'>4 & `prob'==.
		drop `l'

				/* 5.  1st char must be 0-9 	*/
		gen str1 `l' = substr(`c',1,1)
		replace `prob'=5 /*
		*/ if (`l'<"0" | `l'>"9") & `prob'==.

				/* 6.  2nd char must be 0-9	*/
		replace `l' = substr(`c',2,1)
		replace `prob' = 6 if (`l'<"0" | `l'>"9") & `prob'==.
		
				/* 7.  3rd char must be 0-9 or "" */
		replace `l' = substr(`c',3,1)
		replace `prob' = 7 if (`l'<"0" | `l'>"9") & `l'!="" & `prob'==.
		
				/* 8.  4th char must be 0-9 or "" */
		replace `l' = substr(`c',4,1)
		replace `prob' = 8 if (`l'<"0" | `l'>"9") & `l'!="" & `prob'==.

		drop `l' 

				/* clean up prob			*/
		replace `prob' = 0 if `prob'==.
	}

				/* Early exit if system() option	*/
	if "`system'"!="" {
		capture assert `prob'==0
		if _rc==0 {
			exit
		}
		drop `c'
		di in red "`varlist' contains invalid ICD-9 procedure codes"
		exit 459
	}

				/* 10.  invalid code			*/
	qui count if `c'==""
	local miss = r(N)
	preserve
	if `miss' != _N & "`any'"=="" { 
		quietly {
			keep `varlist' `prob' `c'
			Merge `c'
			replace `prob' = 10 if _merge!=3 & `prob'==0 & `c'!=""
		}
	}
		

	qui count if `prob'
	local bad = r(N)
	ret scalar esum = r(N)
	if `bad'==0 {
		if `miss'==_N { 
			di in gr "(`varlist' contains all missing values)"
		}
		else if `miss'==0 { 
			di in gr /*
		*/ "(`varlist' contains valid ICD-9 procedure codes; " /*
			*/ "no missing values)"
		}
		else {
			local s = cond(`miss'==1, "", "s")
			di in gr /*
		*/ "(`varlist' contains valid ICD-9 procedure codes; " /*
			*/ "`miss' missing value`s')"
		}
		ret scalar e1 = 0
		ret scalar e2 = 0
		ret scalar e3 = 0
		ret scalar e4 = 0
		ret scalar e5 = 0
		ret scalar e6 = 0
		ret scalar e7 = 0
		ret scalar e8 = 0
		ret scalar e9 = 0
		ret scalar e10 = . /* sic */
	}
	else {

		di /* not in red, no extra line if output suppressed */
		di in red "`varlist' contains invalid codes:"
		di /* not in red, no extra line if output suppressed */

		qui count if `prob'==1
		di in gr "    1.  Invalid placement of period" /*
			*/ _col(49) in ye %11.0gc r(N)
		ret scalar e1 = r(N)

		qui count if `prob'==2
		di in gr "    2.  Too many periods" /*
			*/ _col(49) in ye %11.0gc r(N)
		ret scalar e2 = r(N)

		qui count if `prob'==3
		di in gr "    3.  Code too short" /*
			*/ _col(49) in ye %11.0gc r(N)
		ret scalar e3 = r(N)

		qui count if `prob'==4
		di in gr "    4.  Code too long" /*
			*/ _col(49) in ye %11.0gc r(N)
		ret scalar e4 = r(N)

		qui count if `prob'==5
		di in gr "    5.  Invalid 1st char (not 0-9)" /*
			*/ _col(49) in ye %11.0gc r(N)
		ret scalar e5 = r(N)

		qui count if `prob'==6
		di in gr "    6.  Invalid 2nd char (not 0-9)" /*
			*/ _col(49) in ye %11.0gc r(N)
		ret scalar e6 = r(N)

		qui count if `prob'==7
		di in gr "    7.  Invalid 3rd char (not 0-9)" /*
			*/ _col(49) in ye %11.0gc r(N)
		ret scalar e7 = r(N)

		qui count if `prob'==8
		di in gr "    8.  Invalid 4th char (not 0-9)" /*
			*/ _col(49) in ye %11.0gc r(N)
		ret scalar e8 = r(N)

/*
		qui count if `prob'==9
		di in gr "    9.  Invalid 5th char (not 0-9)" /*
			*/ _col(49) in ye %11.0gc r(N)
*/
		ret scalar e9 = 0 /* sic */

		if "`any'"=="" {
			qui count if `prob'==10
			di in gr "   10.  Code not defined" /*
				*/ _col(49) in ye %11.0gc r(N)
			ret scalar e10 = r(N)
		}
		else	ret scalar e10 = .

		di in smcl in gr _col(49) "{hline 11}"
		di in gr _col(9) "Total" /*
			*/ _col(49) in ye %11.0gc `bad'

		local s = cond(`bad'>1, "s", "")
		if "`list'" != "" { 
			quietly { 
				gen str27 __prob = "" 
				replace __prob = /*
					*/ "Invalid placement of period" /* 
					*/ if `prob'==1
				replace __prob = "Too many periods" /*
					*/ if `prob'==2
				replace __prob = "Code too short"   /*
					*/ if `prob'==3
				replace __prob = "Code too long"    /*
					*/ if `prob'==4
				replace __prob = "Invalid 1st char" /*
					*/ if `prob'==5
				replace __prob = "Invalid 2nd char" /*
					*/ if `prob'==6
				replace __prob = "Invalid 3rd char" /*
					*/ if `prob'==7
				replace __prob = "Invalid 4th char" /*
					*/ if `prob'==8
/*
				replace __prob = "Invalid 5th char" ///
					if `prob'==9
*/
				replace __prob = "Code not defined" /*
					*/ if `prob'==10
			}
			di _n in gr "Listing of invalid codes"
			format __prob %-27s
			list `varlist' __prob if `prob'!=0 & `prob'!=.
		}
	}
	if "`generate'" != "" {
		quietly {
			keep `prob'
			rename `prob' `generate' 
			tempfile one 
			save `"`one'"'
			restore, preserve
			tempvar x 
			merge using `"`one'"', _merge(`x')
			assert `x'==3
			restore, not
		}
	}
end

program define Merge 
	args c
	tempvar n 
	quietly { 
		gen long `n' = _n
		rename `c' __code9
	}
	FindFile
	local fn `"`r(fn)'"'
	quietly {
		sort __code9
		merge __code9 using `"`fn'"', nokeep
		drop __desc9
		sort `n'
		rename __code9 `c'
	}
end
		

* ---
* icd9p clean 

program define Clean 
	syntax varname [, Dots Pad]

	tempvar c l
	Check `varlist', system(`c')
	quietly { 
		if "`dots'" != "" { 
			replace `c' = /*
			*/ substr(`c',1,2) + "." + substr(`c',3,.) if `c'!=""
			gen byte `l' = length(`c')
			replace `c' = substr(`c',1,`l'-1) /*
				*/ if substr(`c',`l',1)=="."
			drop `l'
			local len 6
		}
		else	local len 5
		if "`pad'"!="" {
			replace `c' = substr(`c' + "       ",1,`len')
			replace `c' = trim(`c') if trim(`c')==""
		}
		gen byte `l' = length(`c')
		summ `l', meanonly 
		local len = max(8, /*
		*/ cond(length("`varlist'")>r(max), length("`varlist'"), /*
		*/ r(max)) + 1)
		count if `varlist' != `c'
		local ch = r(N)
		local s = cond(`ch'==1, "", "s")
		replace `varlist' = `c'
		compress `varlist'
		format `varlist' %-`len's
	}
	di in gr "(`ch' change`s' made)"
end

* ---

* icd9p generate
program define Gen
	gettoken newvar 0 : 0, parse(" =")
	gettoken eqsign 0 : 0, parse(" =") 
	if `"`eqsign'"' != "=" { 
		error 198 
	}
	syntax varname [, Main Description Range(string) Long End ]
	confirm new var `newvar'

	local nopt = ("`main'"!="") + ("`description'"!="") + (`"`range'"'!="")

	if `nopt'!=1 { 
		di in red /*
	*/ "must specify one of options -main-, -description-, or -range()-"
		exit 198
	}

	if "`description'" == "" { 
		if "`long'"!="" { 
			di in red "option -long- not allowed"
			exit 198
		}
		if "`end'"!="" { 
			di in red "option -end- not allowed"
			exit 198
		}
	}


	tempvar new c
	Check `varlist', system(`c')
	if "`main'"!="" {
		GenMain `new' `c' `varlist'
	}
	else if "`description'" != "" {
		GenDesc `new' `c' `varlist' "`long'" "`end'"
	}
	else	GenRange `new' `c' `varlist' `"`range'"'

	rename `new' `newvar'
end

program define GenMain
	args new c userv

	quietly {
		gen str2 `new' = substr(`c',1,2)
		label var `new' "main ICD9/proc. from `userv'"
	}