*! version 1.3.3 April 9, 2001 @ 13:49:43
program define icd9x
version 6.0
/*  1.3.3 fixed bug in 'which' for proc codes                              */
/*  1.3.2 fixed the use of if or in                                        */
/*  1.3.1 fixed a bug in the which option                                  */
/*  1.3.0 upgraded to use version 6.0 of Stata                             */
/*  1.2.1 allows tagging with a given value... useful for making coded     */
/*    markers for multiple similar conditions                              */
/*  1.2.0 allows tagging by the first variable in which a code of interest */
/*    appears (the which option)                                           */
/*                                                                         */
	syntax [if] [in] [,Diagvar(str) Procvar(str) INDiag(str) EXDiag(str) INProc(str) EXProc(str) SUBset REPLACE Keep(str) Drop(str) NOCHECK UNSAFE WHICH KEEPVal(real 1) DROPVal(real 1)]
	if "`if'`in'"!="" {
		tempvar keeper
		mark `keeper' `if' `in'
		quietly count if `keeper'
		if r(N)==0 {
			display in red "Nothing to work with!"
			exit 2000
			}
		local if "if `keeper'"
		local andkeep "& `keeper'"
		local orkeep "| `keeper'"
		}
	if "`diagvar'`procvar'"=="" {
		disp in red "You must use some variables!!!"
		exit 198
		}
	if "`indiag'`exdiag'`inproc'`exproc'"=="" {
		disp in red "You must include or exclude some ICD-9 codes!"
		exit 198
		}
	if "`diagvar'"=="" {
		if "`indiag'`exdiag'"!="" {
			disp in red "You cannot include or exclude diagnosis codes without any diagnosis variables!"
			exit 198
			}
		}
	else {
		if "`indiag'`exdiag'"=="" {
			disp in red "You cannot specify diagnosis variables without any inclusions or exclusions!"
			exit 198
			}
		unab diagvar : `diagvar', name(diagvars)
		confirm str5 var `diagvar'
		local indiag = upper("`indiag'")
		local exdiag = upper("`exdiag'")
		}
	if "`procvar'"=="" {
		if "`inproc'`exproc'"!="" {
			disp in red "You cannot include or exclude procedure codes without any procedure variables!"
			exit 198
			}
		}
	else {
		if "`inproc'`exproc'"=="" {
			disp in red "You cannot specify procedure variables without any inclusions or exclusions!"
			exit 198
			}
		unab procvar : `procvar', name(procvars)
		confirm str4 var `procvar'
		}
	if "`subset'"!="" {
		quietly d,s
		local dirty = r(changed)
		if "`replace'"=="" {
			if `dirty' {
				display in red "Trying to subset a changed file!"
				exit 4
				}
			}
		if "`inproc'`indiag'"!="" {
			if "`keep'"=="" {
				tempvar keep
				gen byte `keep'=0
				local notemp = "`keep' "
				}
			}
		if "`exproc'`exdiag'"!="" {
			if "`drop'"=="" {
				tempvar drop
				gen byte `drop'=0
				local notemp = "`notemp' `drop'"
				}
			}
		}
	else {                              /* not subsetting data; just keeping marks */
		local dirty 0							 /* just don't care about it */
		if "`inproc'`indiag'"!="" {
			if "`keep'"=="" {
				disp in red "If you do not take a subset, but you include, then you need a keep variable!"
				exit 198
				}
			}
		if "`exproc'`exdiag'"!="" {
			if "`drop'"=="" {
				disp in red "If you do not take a subset, but you exclude, then you need a drop variable!"
				exit 198
				}
			}
		}
	if `keepval'!=1 | `dropval'!=1 {
		if "`which'"!="" {
			disp in red "Which cannot be used in conjunction with either keepval or dropval!"
			exit 198
			}
		if `keepval'==0 | `dropval'==0 {
			disp in red "Neither keepval nor dropval may be specified as 0!"
			exit 198
			}
		}
	/* the following is needed so that the xxvarlists can be reparsed */
	/* below.... they cannot be parsed and then assigned to a local */
	/* macro because of the possibility of the local macro then being */
	/* longer than 80 characters (damn the punch card!) */
	if "`nocheck'"=="" {
		if "`indiag'"!="" {
			_ckicd9, codes(`indiag') type(m)
			}
		if "`exdiag'"!="" {
			_ckicd9, codes(`exdiag') type(m)
			}
		if "`inproc'"!="" {
			_ckicd9, codes(`inproc') type(p)
			}
		if "`exproc'"!="" {
			_ckicd9, codes(`exproc') type(p)
			}
		}
	local dirty = `dirty' & ("`unsafe'"=="")
	if `dirty' {
		preserve
		}
	capture {
		tempvar chars spec nums		 /* needed to keep varible generation low */
		if "`diagvar'"!="" {
			tokenize "`diagvar'", parse(" ")
			local cnt 1
			while "``cnt''"!="" {            /* top of diag loop */
				if "`exdiag'"!="" {
					if "`which'"!="" {
						local dropval "`cnt'"
						}
					_lbicd9 ``cnt'' `if', codes(`exdiag') type(m) mark(`drop') value(`dropval') chars(`chars') spec(`spec') nums(`nums')
					}
				if "`indiag'"!="" {
					if "`which'"!="" {
						local keepval "`cnt'"
						}
					_lbicd9 ``cnt'' `if', codes(`indiag') type(m) mark(`keep') value(`keepval') chars(`chars') spec(`spec') nums(`nums')
					}
				local cnt = `cnt' + 1
				capture drop `chars'
				capture drop `spec'
				capture drop `nums'
				}                             /* end of diag loop */
			}                             /* end ck for diagvars */
		if "`procvar'"!="" {
			tokenize "`procvar'", parse(" ")
			local cnt 1
			while "``cnt''"!="" {            /* top of proc loop */
				if "`exproc'"!="" {
					if "`which'"!="" {
						local dropval = 100+`cnt'
						}
					_lbicd9 ``cnt'' `if', codes(`exproc') type(p) mark(`drop') value(`dropval') chars(`chars') spec(`spec') nums(`nums')
					}
				if "`inproc'"!="" {
					if "`which'"!="" {
						local keepval = 100+`cnt'
						}
					_lbicd9 ``cnt'' `if', codes(`inproc') type(p) mark(`keep') value(`keepval') chars(`chars') spec(`spec') nums(`nums')
					}
				local cnt = `cnt' + 1
				capture drop `chars'
				capture drop `spec'
				capture drop `nums'
				}                             /* end of proc loop */
			}                             /* end ck for procvars */
		}                                /* end capture block */
	local rc = _rc
	if `rc' {
		if "`unsafe'"!="" {
			disp in yellow "Warning:  data set not restored, since unsafe was specified!"
			display in yellow "Dataset name has been cleared..."
			global S_FN
			}
		}
	else {                              /* to hinder mistaken overwrites */
		if "`subset'"!="" {
			/* check to see if save was specified */
			mac def S_FN ""
			if "`keep'"!="" {
				keep if `keep' `andkeep'
				}
			if "`drop'"!="" {
				drop if `drop' `orkeep'
				}
			if _N==0 {
				disp in green "No cases fit your bill --- the data set will be cleared!"
				clear
				}
			}
		if `dirty' {
			restore, not
			}
		}
	error `rc'
end

/* version 1.0.0 February 12, 1993 */
/* version 1.1.0 Thursday, March 9, 2000 */
program define _ckicd9
	syntax , Codes(str) Type(str)
	tokenize "`codes'", parse(" -")
	local cnt 1
	while "``cnt''"!="" {
		_ck1icd9, code(``cnt'') type(`type')
		local next = `cnt' + 1
		if "``next''"=="-" {             /* have a range */
			local next = `next' + 1
			_ck1icd9, code(``next'') type(`type')
			/* now check the order */
			if "`type'"=="p" {
				local start = ``cnt''
				local end = ``next''
				}
			else {
				if substr("``cnt''",1,1)>"9" {  /* have an e- or v-code */
					if substr("``cnt''",1,1)!=substr("``next''",1,1) {
						disp in red "A range cannot go across e/v codes:  ``cnt'' - ``next''"
						exit 198
						}
					local start = real(substr("``cnt''",2,.))
					local end = real(substr("``next''",2,.))
					}
				else {
					local start = ``cnt''
					local end = ``next''
					}
				}                          /* done getting start and end */
			if `start'>=`end' {
				disp in red "Bad Range:  ``cnt'' - ``next''"
				exit 198
				}
			local cnt = `cnt' + 3
			}
		else {                           /* just a singleton */
			local cnt = `cnt' + 1
			}
		}                                /* end of while loop */
end

/* version 1.1.0 Thursday, March 9, 2000 */
/* version 1.0.0 February 12, 1993 */
program define _ck1icd9
	syntax , Code(str) Type(str)
	if "`type'"!="m" & "`type'"!="p" {
		disp in red "The type must be m or p!"
		exit 198
		}
	if substr("`code'",1,1)>"9" {       /* have a char */
		if "`type'"=="m" {               /* medicals can have e- and v-codes */
			if index("veVE",substr("`code'",1,1))==0 {
				disp in red "The only ICD-9 codes which start with letters are E- and V-codes!"
				disp in red "Bad Code:  `code'"
				exit 198
				}                          /* end v or e as starting char */
			else {
				local ev = substr("`code'",1,1)
				local num = substr("`code'",2,.)
				_icd9rng, num(`num') type(m) ev(`ev')
				}
			}                             /* end type m check for chars */
		else {                           /* have p type --- tsk tsk */
			disp in red "There are no ICD-9 codes with letters for procedures!"
			disp in red "Bad Code:  `code'"
			exit 198
			}
		}                                /* end leading char check */
	else {                              /* have leading number */
		_icd9rng, num(`code') type(`type')
		}
end

/* version 1.1.0 Thursday, March 9, 2000 */
/* version 1.0.0 February 12, 1993 */
program define _icd9rng
	syntax, num(str) type(str) [ev(str)]
	local ev = lower("`ev'")            /* just in case */
	capture confirm num `num'
	if _rc {
		disp in red "Bad Code (letters in bad places?):  `ev'`num'"
		exit 198
		}
	if "`type'"=="p" {                  /* the easy stuff */
		if `num'<0 | `num'>=100 {
			disp in red "ICD-9 Procedure Codes are between 0 and 99.99!"
			disp in red "Bad Code:  `num'"
			exit 198
			}
		}
	else {                              /* have an m code */
		if "`ev'"=="" {                  /* straight code */
			if `num'<0 | `num'>=1000 {
				disp in red "ICD-9 Medical Codes are between 0 and 999.9!"
				disp in red "Bad Code:  `num'"
				exit 198
				}
			}
		else {
			if "`ev'"=="e" {              /* e code */
				if `num'<0 | `num'>999 {
					disp in red "E-Codes are between 0 and 999!"
					disp in red "Bad Code:  e`num'"
					exit 198
					}
				}
			else {                        /* v code */
				if `num'<0 | `num'>=83 {
					disp in red "V-Codes are between 0 and 82.9!"
					disp in red "Bad Code:  v`num'"
					exit 198
					}
				}
			}
		}
end

/* version 1.1.0 Thursday, March 9, 2000 */
program define _lbicd9
	/* 1.1.0 switched to subprogram for version 6.0 of Stata */
	/* 1.0.4 fixed problem with overwriting a var whose name is an extention */
	/*       of the intended name (e.g. marking tci overwriting tciold      */
	/* 1.0.3 fixed round-off problems when using ranges                     */
	/* 1.0.2 fixed bug which tagged v and e codes for ranges of icd-9 codes */
	/*       which included codes of less than 100                          */
	syntax varname [if],  Mark(str) Codes(str) Type(str) CHars(str) Spec(str) Nums(str) [Value(real 1)]
	/* since this is a helper --- most error checking is assumed done! */
	if "`mark'"=="" {
		disp in red "_lbicd9 needs a variable for marking!"
		exit 198
		}
/*	tempname val
	scalar `val'=`value'
*/	capture confirm new var `mark'
	if _rc ==0 {
		gen byte `mark'=0 `if'
		}
	capture confirm var `chars'
	if _rc {
		if "`type'"=="m" {
			local len 5
			}
		else {
			local len 4
			}
		gen str`len' `chars' = upper(`varlist') + substr("00000",1,`len'-length(`varlist'))
		}
	parse "`codes'", parse(" -")
	local cnt 1
	while "``cnt''"!="" {
		local next = `cnt'+1
		if "``next''"=="-" {
			local next = `next' + 1
			if substr("``cnt''",1,1)>"9" {
				local code = substr("``cnt''",1,1)
				if "`code'"=="E" {
					local mult 10
					}
				else {
					local mult 100
					}
				local start = int(.5+`mult'*real(substr("``cnt''",2,.)))
				local end = int(.5+`mult'*real(substr("``next''",2,.)))
				}                          /* end fix for code */
			else {                        /* normal icd-9's */
				local start = int(.5+100*``cnt'')
				local end = int(.5+100*``next'')
				local code = ""
				}                          /* end start, end code assign */
			capture confirm var `nums'
			if _rc {
				gen long `nums' = real(substr(`chars',1+(substr(`chars',1,1)>"9"),.))
				}
			capture confirm var `spec'
			if _rc {
				gen str1 `spec' = upper(substr(`varlist',1,1)) 
				replace `spec' = "" if `spec'<="9"
				}
			replace `mark' = `value' if (`spec'=="`code'") & (`nums' >=`start') & (`nums' <= `end') & `mark'==0
			/* done, I think! */
			local cnt = `cnt' + 3
			}                             /* end of range stuff */
		else {                           /* start of atomic stuff */
			/* have to remove decimal point to make good char search */
			local lcnt = index("``cnt''",".")
			if `lcnt' {
				local `cnt' = substr("``cnt''",1,`lcnt'-1) + substr("``cnt''",`lcnt'+1,.)
				}
			local lcnt = length("``cnt''")
			replace `mark' = `value' if substr(`chars',1,`lcnt')=="``cnt''" & `mark'==0
			local cnt = `cnt' + 1
			}
		}
end