Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGPMUH03

BGPMUH03.m

Go to the documentation of this file.
BGPMUH03 ; IHS/MSC/MMT - MI measure NQF0435-STK-2 ;02-Mar-2011 16:17;DU
 ;;11.0;IHS CLINICAL REPORTING;**4**;JAN 06, 2011;Build 84
 ;ED meaningful use hospital measures
ENTRY ;PEP  Stroke Measure 2 - Stroke antithrombotic therapy
 N START,END,BGPIEN,DFN,BGPVST,BGPISDX,BGPHSDX,BGPAGEE,BGPIPROB,BGPHPROB,STROKE,FIB,EXC,NUM,BGPDIS
 N BGPFIBDX,BGPFIBPB,BGPFIBCP,BGPFIBPR
 N BGPADM,BGPDT,BGPDSTR,BGPNSTR,BGPVCNT
 ; BGPTDT=visit date; BGPDSTR='not in numerator' string; BGPNSTR='in numerater' string
 S (BGPDT,BGPDSTR,BGPNSTR)=""
 S BGPVCNT=0
 ;Start by finding all admissions during the reporting period
 S START=BGPBDATE
 S END=BGPEDATE_".2359"
 F  S START=$O(^DGPM("B",START)) Q:START=""!(START>END)  D
 .S BGPIEN="" F  S BGPIEN=$O(^DGPM("B",START,BGPIEN)) Q:BGPIEN=""  D
 ..Q:$P($G(^DGPM(BGPIEN,0)),U,2)'=1    ;Only include admissions
 ..S DFN=$P($G(^DGPM(BGPIEN,0)),U,3)
 ..Q:DFN=""
 ..S BGPACTUP=$$ACTUPAP^BGPMUEHD(DFN,BGPBDATE,BGPEDATE,BGPBEN)
 ..I 'BGPACTUP,'$G(BGPXPXPX),'$G(BGPIISO) Q
 ..S BGPVST=$P($G(^DGPM(BGPIEN,0)),U,27)  ;Get the visit
 ..Q:BGPVST=""
 ..S BGPADM=$P($$GET1^DIQ(9000010,BGPVST_",",.01,"I"),".",1) ;get admin date
 ..S BGPAGEE=$$AGE^AUPNPAT(DFN,BGPADM)
 ..S BGPDIS=$P($G(^DGPM(BGPIEN,0)),U,17)  ;Don't use if pt is still an inpt
 ..Q:BGPDIS=""
 ..S BGPVCNT=BGPVCNT+1
 ..;Check for a diagnosis of stroke
 ..S STROKE=0,EXC=0,NUM=0
 ..S BGPISDX=$$VSTPOVA^BGPMUUT3(DFN,BGPVST,"BGPMU ISCHEMIC STROKE DX")
 ..;S BGPIPROB=$$PLTAX^BGPMUUT1(DFN,"BGPMU ISCHEMIC STROKE DX","A")
 ..;Pt must have both a POV of stoke and it must be an active problem
 ..;I +BGPISDX&(+BGPIPROB) S STROKE=1
 ..I +BGPISDX S STROKE=1
 ..Q:'STROKE
 ..S BGPDSTR=BGPDT
 ..;Next check for denominator exclusions
 ..S EXC=$$EXCLUDE(DFN,BGPIEN,BGPVST,BGPDIS)
 ..;If no exclusions, set up denominator string and see if they had the drug ordered
 ..I 'EXC D
 ...S BGPNSTR=""
 ...S BGPDT=$P($P($G(^AUPNVSIT(BGPVST,0)),U,1),".",1)
 ...;see if they had the drug ordered
 ...S NUM=$$NUMER(DFN,BGPDIS)
 ...I NUM'=0 S BGPNSTR=BGPDT_":"_$P(NUM,U,3)
 ..;Now add it all up
 ..D TOTAL(DFN)
 Q
TOTAL(DFN) ;add up the totals
 N PTCNT,EXCCT,DENCT,NUMCT,TOTALS,DATE,NOTCT
 S TOTALS=$G(^TMP("BGPMU0435",$J,BGPMUTF,"TOT"))
 S DENCT=+$G(^TMP("BGPMU0435",$J,BGPMUTF,"DEN"))
 S NUMCT=+$G(^TMP("BGPMU0435",$J,BGPMUTF,"NUM"))
 S EXCCT=+$G(^TMP("BGPMU0435",$J,BGPMUTF,"EXC"))
 S NOTCT=+$G(^TMP("BGPMU0435",$J,BGPMUTF,"NOT"))
 S PTCNT=TOTALS
 S PTCNT=PTCNT+1
 S DATE=$$DATE^BGPMUUTL($P($G(^DGPM(BGPIEN,0)),U,1))
 S DENCT=DENCT+1
 S ^TMP("BGPMU0435",$J,BGPMUTF,"DEN")=DENCT
 I EXC="" D
 .I +NUM D
 ..S NUMCT=NUMCT+1 S ^TMP("BGPMU0435",$J,BGPMUTF,"NUM")=NUMCT
 ..S ^TMP("BGPMU0435",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DATE_U_$P(NUM,U,3)_U_$P(NUM,U,2)
 .I +NUM=0 D
 ..S NOTCT=NOTCT+1 S ^TMP("BGPMU0435",$J,BGPMUTF,"NOT")=NOTCT
 ..S ^TMP("BGPMU0435",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DATE_U_$P(NUM,U,3)_U_$P(NUM,U,2)
 I EXC'="" D
 .S EXCCT=EXCCT+1 S ^TMP("BGPMU0435",$J,BGPMUTF,"EXC")=EXCCT
 .I BGPMUTF="C" S ^TMP("BGPMU0435",$J,"PAT",BGPMUTF,"EXC",PTCNT)=DFN  ;_U_DATE_U_$P(EXC,U,2)
 S ^TMP("BGPMU0435",$J,BGPMUTF,"TOT")=PTCNT
 S BGPICARE("MU.STK.0435.1",BGPMUTF,DFN)=1_U_+$G(NUM)_U_+EXC_U_DATE_";"_$P($G(NUM),U,3)_";"_$P(EXC,U,2)
 Q
EXCLUDE(DFN,BGPIEN,BGPVST,BGPDIS) ;See if there are exclusions
 N REASON,BGPLOS,BGPHOS,BGPCLIN,BGPECI,DTYPE1,DTYPE2,BGPREF,NOXTHROM
 N BGPDISDT
 S REASON=""
 I BGPAGEE<18 S REASON="1^AGE"
 ;Check for LOS
 S BGPLOS=$$LOS^BGPMUH08(BGPIEN,BGPDIS)
 I BGPLOS>120 S REASON="1^LOS"
 ;Check for discharge reasons
 ;S DTYPE1=$P($G(^DGPM(BGPDIS,0)),U,4)
 S DTYPE2=$P($G(^DGPM(BGPDIS,"IHS")),U,7)
 ;I DTYPE1'=12 S REASON="1^"_DTYPE1 Q REASON
 I (DTYPE2="2")!(DTYPE2="3")!(DTYPE2="4")!(DTYPE2="5")!(DTYPE2="7")!(DTYPE2="43")!(DTYPE2="50")!(DTYPE2="51") S REASON="1^"_DTYPE2 Q REASON
 ;Check for expired
 S DTYPE2=$P($G(^DGPM(BGPDIS,"IHS")),U,7)
 I (DTYPE2="20")!(DTYPE2="40")!(DTYPE2="41")!(DTYPE2="42") S REASON="1^"_DTYPE2 Q REASON
 ;Check for hospice care
 S BGPHOS=$$HOSPICE^BGPMUH08(DFN,BGPVST)
 I +BGPHOS S REASON=BGPHOS Q REASON
 ;Check for clinical trial
 S BGPCLIN=$$TRIAL^BGPMUH08(DFN,BGPVST)
 I +BGPCLIN S REASON=BGPCLIN Q REASON
 ;Check for elective carotid intervention procedure
 S BGPECI=$$ELECTIVE^BGPMUH08(DFN,BGPVST,BGPIEN)
 I +BGPECI S REASON=BGPECI Q REASON
 ;Check for refusals
 S BGPREF=$$REF(DFN,BGPVST,BGPDIS)
 I +BGPREF S REASON=BGPREF Q REASON
 S BGPDISDT=$P($P($G(^DGPM(BGPDIS,0)),U,1),".",1)
 S NOXTHROM=$$CPT^BGPMUUT1(DFN,$$FMADD^XLFDT(BGPDISDT,-180),BGPDISDT,"BGPMU WARFARIN THERAPY CPT")  ;(DFN,BDATE,EDATE,TAX)
 I +NOXTHROM S REASON=NOXTHROM Q REASON
 Q REASON
REF(DFN,BGPVST,BGPDIS) ;Find refusals for this medication
 N ENDDT,X1,X2,X,MED,BGPEVT,DISDT
 S MED=0
 S BGPEVT=$P($G(^AUPNVSIT(BGPVST,0)),U,1)
 S DISDT=$P($G(^DGPM(BGPDIS,0)),U,1)
 S ENDDT=$$FMADD^XLFDT(DISDT,+1)
 S TAX="BGPMU ANTITHROMBOTIC NDCS"
 S MED=$$MEDREF^BGPMUUT2(DFN,BGPEVT,ENDDT,TAX)
 Q MED
NUMER(DFN,BGPDIS) ;Check to see if pt is in the numerator
 N DRUG,TAX,MEDTYPE,DDATE
 S MEDTYPE="OP",TAX="BGPMU ANTITHROMBOTIC NDCS"
 S DDATE=$P($G(^DGPM(BGPDIS,0)),U,1)
 S DDATE=$$FMADD^XLFDT(DDATE,1)
 S DRUG=$$FIND^BGPMUUT4(DFN,TAX,DDATE,MEDTYPE)     ; DRUG = 1_U_NDC
 Q DRUG_U_DDATE