Detect presence of ambulatory care sensitive conditions (ACSCs) by AHRQ criteria in R script

acsc.R

# this script finds ambulatory sensitive conditions (ACSCs) in ICD-9 codes
# the data are based on the appendices from
# http://www.ahrq.gov/downloads/pub/ahrqqi/pqiguide.pdf (Appendix A)
# usage: acsc(list_of_icd9_dx_codes, list_of_drgcodes, list_of_icd9_proc_codes) 
# returns: TRUE or FALSE
# or set getlist = TRUE to get the list of which ACSCs were found

# NB. that some of the definitions for these PQIs exclude hospital transfers
# paripartum admissions, or certain age groups, etc. 
# This script ***only*** assess ACSC status by ICD-9 code.

# NB. The first code in the list of 'codes' passed to this function will be considered 
# the "principal" diagnosis code

# NB. DRG codes are optional, but are necessary for determing eligibility
# for low birth weight measure

# NB. Procedure codes are optional, but are necessary for determining eligibility
# for angina without surgical procedure and congestive heart failure

acsc <- function(icd9.codes, drg.codes, proc.codes, getlist = FALSE) {

	codes <- unlist(icd9.codes)
	drgs <- unlist(drg.codes)
	procs <- unlist(proc.codes)

	# First define the inclusion and exclusion codes for each quality indicator

	# 1. Bacterial Pneumonia (principal diagnosis code)
	bpna.include.principal <- c('481','4822','4829','4830','4831',
		'4838','48230','48231','48232','48239','485','486')
	bpna.exclude.any <- c('28260','28261','28262','28263','28269')
	has.bpna <- (any(codes[1] %in% bpna.include.principal) && ! any(codes %in% bpna.exclude.any))

	# 2. Dehydration (principal diagnosis code)
	dehydr.include <- c('2765')
	has.dehydr <- any(codes[1] %in% dehydr.include)

	# 3. Pediatric gastroenteritis
	pedgastro.include <- c('00861','00862','00863','00864','00865',
		'00866','00867','00869','0088','0090','0091','0092','0093',
		'5589')
	has.pedgastro <- any(codes[1] %in% pedgastro.include)

	# 4. Urinary Tract Infection (principal diagnosis code)
	uti.include <- c('59000','59001','59010','59011','5902','5903',
		'59080','59081','5909','5950','5959','5990')
	has.uti <- any(codes[1] %in% uti.include)

	# 5. Perforated Appendix (any field)
	perfapp.include <- c('5400','5401')
	perfapp.denom <- c(perfapp.include, '5409','541')
	has.perfapp <- (any(codes %in% perfapp.include) && any(codes %in% perfapp.denom))

	#6. Low Birth Weight (any field)
	lowbirthw.include <- c('76400','76401','76402','76403','76404',
		'76405','76406','76407','76408','76410','76411','76412',
		'76413','76414','76415','76416','76417','76418','76420',
		'76422','76423','76424','76425','76426','76427','76428',
		'76490','76491','76492','76493','76494','76495','76496',
		'76497','76498','76500','76501','76502','76503','76504',
		'76505','76506','76507','76508','76510','76511','76512',
		'76513','76514','76515','76516','76517','76518')
	lowbirthw.drgs <- c('370','371','372','373','374','375')
	has.lowbirthw <- (any(codes %in% lowbirthw.include) && any(drgs %in% lowbirthw.drgs))

	#7. Angina Without Procedure (principal diagnosis code)
	angina.include <- c('4111','41181','41189','4130','4131','4139')
	angina.exclude.procs <- 10:8699
	has.angina <- (any(codes[1] %in% angina.include) && ! any(as.numeric(procs) %in% angina.exclude.procs))

	#8. Congestive Heart Failure (principal diagnosis codes)
	chf.include <- c('39891','40201','40211','40291','40401','40403','40411',
		'40413','40491','40493','4280','4281','4289')
	chf.exclude.procs <- c('3601','3602','3605','3606','3610','3611','3612','3613',
		'3614','3615','3616','3617','3619','375','3770','3771','3772','3773','3774',
		'3775','3776','3777','3778','3779')
	has.chf <- any(codes[1] %in% chf.include) &&  ! any(procs %in% chf.exclude.procs)

	#9. Hypertension (principal diagnosis code)
	htn.include <- c('4010','4019','40200','40210','40290','40300','40310','40390',
		'40400','40410','40490')
	htn.exclude.procs <- c('3601','3602','3605','3606','3610','3611','3612','3613',
		'3614','3615','3616','3617','3619','375','3770','3771','3772','3773','3774',
		'3775','3776','3777','3778','3779') # same as CHF above
	has.htn <- any(codes[1] %in% htn.include) && ! any(procs %in% htn.exclude.procs)

	#10. Adult Asthma (principal diagnosis code)
	asthmaadult.include <- c('49300','49301','49302','49310','49311','49312','49320',
		'49321','49322','49322','49390','49391','49392')
	has.asthmaadult <- any(codes[1] %in% asthmaadult.include)

	#11. Pediatric Asthma (principal diagnosis code)
	asthmaped.include <- c('49300','49301','49302','49310','49311','49312','49320',
		'49321','49322','49322','49390','49391','49392') # same as adult above
	has.asthmaped <- any(codes[1] %in% asthmaped.include)

	#12. Chronic Obstructive Pulmonary Disease (principal diagnosis code)
	copd.include <- c('4660','490','4910','4911','49120','49121','4918','4919',
		'4920','4928','494','4940','4941','496')
	copd.secondarydx <- any(grepl('^491[:digit:]*',codes),
							grepl('^492[:digit:]*',codes),
							copd.include %in% codes)
	has.copd <- any(codes[1] %in% copd.include) && copd.secondarydx 

	#14. Diabetes Short-Term Complications (principal diagnosis code)
	dmshort.include <- c('25010','25011','25012','25013','25020','25021','25022',
		'25023','25030','25031','25032','25033')
	has.dmshort <- any(codes[1] %in% dmshort.include)

	#15. Diabetes Long-Term Complications (principal diagnosis code)
	dmlong.include <- c('25040','25041','25042','25043','25050','25051','25052',
		'25053','25060','25061','25062','25063','25070','25071','25072','25073',
		'25080','25081','25082','25083','25090','25091','25092','25093')
	has.dmlong <- any(codes[1] %in% dmlongl.include)

	#13. Uncontrolled Diabetes (principal diagnosis code)
	# last because depends on 14 and 15
	dmuncontrol.include <- c('25002','25003')
	has.dmuncontrol <- any(codes[1] %in% dmuncontrol.include) && ! any(has.dmshort,has.dmlong)

	#16. Lower-Extremity Amputation Among Patients with Diabetes (any)
	ampdm.include.procs <- c('8410','8411','8412','8413','8414','8415','8416',
		'8417','8418','8419')
	ampdm.include.dxs <- c('25000','25001','25002','25003','25010','25011','25012',
		'25013','25020','25021','25022','25023','25030','25031','25032','25033',
		'25040','25041','25042','25043','25050','25051','25052','25053','25060',
		'25061','25062','25063','25070','25071','25072','25073','25080','25081',
		'25082','25083','25090','25091','25092','25093')
	ampdm.exclude.dxs <- c('8950','8951','8960','8961','8962','8963','8970','8971','8972',
		'8973','8974','8975','8976','8977')
	has.dmamp <- any(codes %in% ampdm.include.dxs) &&
				 ! any (codes %in% ampdm.exclude.dxs) &&
				 any(procs %in% ampdm.include.procs)

	# return final results
	dxlist <- list(bpna = has.bpna, dehydr = has.dehydr, pedgastro = has.pedgastro,
		uti = has.uti, perfapp = has.perfapp, lowbirthw = has.lowbirthw, 
		angina = has.angina, chf = has.chf, htn = has.htn, asthmaadult = has.asthmaadult,
		asthmaped = has.asthmaped, copd = has.copd, dmuncontrol = has.dmuncontrol,
		dmshort = has.dmshort, dmlong = has.dmlong, dmamp = has.dmamp)
	if (getlist) return (dxlist)
	else return (any(unlist(dxlist)))

}