BGPMUA10 ; IHS/MSC/MGH - MI measure NQF0067 & NQF0070 ;11-Jul-2011 10:50;DU
;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
;Code to collect meaningful use reports
ENTRY1 ;EP Entry point for NQA0067 for CAD and antiplatelet therapy
N START,END,BGPNUM,BGPDEN,BGPNUM,STRING,OUTCT,NFCT,INCT
N IEN,INV,VISIT,DATA,VDATE,VALUE,EXCEPT,FIRST,VIEN,EXCEPT,RESULT
N CNT,DIAB,NUM,EXC,DIAB,OUTENC,NFENC,INENC,CADDX
S (BGPDEN,BGPNUM,RESULT)=0
S START=9999999-BGPBDATE,END=9999999-BGPEDATE,VALUE=0
S START=START_".2359"
S STRING="",CADDX=0
S (CAD,EXC,NUM)=0
;Pts must be >18
;No need to check further if no age match
Q:BGPAGEE<18
S (CNT,OUTCT,NFCT,INCT)=0
S FIRST=END-0.1 F S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START) D
.S IEN=0 F S IEN=$O(^AUPNVSIT("AA",DFN,FIRST,IEN)) Q:'+IEN D
..;Check provider, Only visits for chosen provider
..Q:'$$PRV^BGPMUUT1(IEN,BGPPROV)
..S OUTENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENCOUNTER OUTPT")
..I +OUTENC S OUTCT=OUTCT+1
..S NFENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU NURSING FAC EM")
..I +NFENC S NFCT=NFCT+1
..S INENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENC CAD INPATIENT CPT")
..I +INENC S INCT=INCT+1
..I +OUTENC!(+NFENC)!(+INENC) D
...S VDATE=$P($G(^AUPNVSIT(IEN,0)),U,1)
...S CNT=CNT+1
...S VIEN(CNT)=IEN_U_VDATE_U_$$DATE^BGPMUUTL(VDATE)
...S STRING(CNT)=$$DATE^BGPMUUTL(VDATE)
;Next check to see if the patient is in the denominator
;Denominator is that the pt has DX of CAD or cardiac surgery before found visits
I OUTCT>1!(NFCT>1)!(INCT>0) D
.S CADDATE=$P($P($G(VIEN(1)),U,2),".")
.S CAD=$$CAD(DFN,CADDATE)
.I +CAD D
..;If the patient had CAD, check to see if they are in the numerator
..S NUM=$$NUM1(DFN,BGPBDATE,BGPEDATE)
..;If not in the numerator,see if they are an exception
..I +NUM=0 S EXC=$$EXCEPT(.VIEN,DFN,CADDATE,BGPEDATE,CNT)
..D TOTAL1(DFN,CAD,NUM,EXC)
Q
TOTAL1(DFN,CAD,NUM,EXC) ;See where this patient ends up
N PTCNT,EXCCT,DENCT,NUMCT,NOTNUM,TOTALS,DXTIME,DEN
S TOTALS=$G(^TMP("BGPMU0067",$J,BGPMUTF,"TOT"))
S DENCT=+$G(^TMP("BGPMU0067",$J,BGPMUTF,"DEN"))
S NUMCT=+$G(^TMP("BGPMU0067",$J,BGPMUTF,"NUM"))
S EXCCT=+$G(^TMP("BGPMU0067",$J,BGPMUTF,"EXC"))
S NOTNUM=+$G(^TMP("BGPMU0067",$J,BGPMUTF,"NOT"))
S PTCNT=TOTALS
S PTCNT=PTCNT+1
S (DEN,DXTIME)=""
S DENCT=DENCT+1 S ^TMP("BGPMU0067",$J,BGPMUTF,"DEN")=DENCT
I $P(CAD,U,3)'="" S DXTIME=$$DATE^BGPMUUTL($P(CAD,U,3))
S DEN=$P(CAD,U,2)_DXTIME_";EN:"_STRING(1)
I $D(STRING(2)) S DEN=DEN_";EN:"_STRING(2)
I +EXC D
.S EXCCT=EXCCT+1 S ^TMP("BGPMU0067",$J,BGPMUTF,"EXC")=EXCCT
.I BGPMUTF="C" S ^TMP("BGPMU0067",$J,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DEN_U_"EXCLUDE"
I +NUM D
.S NUMCT=NUMCT+1 S ^TMP("BGPMU0067",$J,BGPMUTF,"NUM")=NUMCT
.I BGPMUTF="C" S ^TMP("BGPMU0067",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DEN_U_"M:MED;"_$P(NUM,U,3)
I +NUM=0&(EXC=0) D
.S NOTNUM=NOTNUM+1 S ^TMP("BGPMU0067",$J,BGPMUTF,"NOT")=NOTNUM
.I BGPMUTF="C" S ^TMP("BGPMU0067",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DEN_U_"NM:"_$P(NUM,U,2)_";"_$P(NUM,U,3)
S ^TMP("BGPMU0067",$J,BGPMUTF,"TOT")=PTCNT
;Setup iCare array for patient
S BGPICARE("MU.EP.0067.1",BGPMUTF)=1_U_+NUM_U_+EXC_U_DEN_";"_$P(NUM,U,2)_";"_$P(NUM,U,3)
Q
CAD(DFN,CADDATE) ; Get the denominator
N RESULT,CADA,CADB,CADDX,CADSUR,DOB
S RESULT=0
;Check for coronary artery disease
S DOB=$$GET1^DIQ(2,DFN,.03,"I")
S CADA=$$LASTDX^BGPMUUT2(DFN,"",CADDATE,"BGPMU CAD DX")
S CADB=$$PLTAX^BGPMUUT1(DFN,"BGPMU CAD DX","C",CADDATE)
I +CADA S CADDX=CADA
I +CADB S CADDX=CADB
I +CADA!(+CADB) S RESULT=1_U_"CAD:"_U_$P(CADDX,U,3) Q RESULT
;Check for cardiac surgery
S CADSUR=$$CPT^BGPMUUT1(DFN,DOB,CADDATE,"BGPMU CARDIAC SURGERY CPT")
I +CADSUR S RESULT=1_U_"CSP:"_U_$P(CADSUR,U,3)
Q RESULT
EXCEPT(VIEN,DFN,CADDATE,BGPEDATE,CNT) ;Find exceptions
N FOUND,BLEED,BLEED1,REF,ALLER
;Check for bleeding disorder
S (BLEED,BLEED1,ALLER,REF,FOUND)=0
S BLEED=$$LASTDX^BGPMUUT2(DFN,"",CADDATE,"BGPMU BLEEDING COAGULATION DX")
I +BLEED S FOUND=1_U_$P(BLEED,U,2)_U_$P(BLEED,U,3) Q FOUND
S BLEED1=$$PLTAX^BGPMUUT1(DFN,"BGPMU BLEEDING COAGULATION DX","A")
I +BLEED1 S FOUND=1_U_$P(BLEED1,U,2)_U_$P(BLEED1,U,3) Q FOUND
;Next check for allergy
S ALLER=$$ALLER("BL117","")
I +ALLER S FOUND=1_U_$P(ALLER,U,1)
;Check for refusals
S TAX="BGPMU ANTIPLATELET NDCS"
S REF=$$REF(.VIEN,TAX,BGPEDATE)
I +REF S FOUND=1_U_$P(REF,U,1)
Q FOUND
ALLER(CLASS,DRUG) ;Check for allergies
N AA,BB,X,Y,TEST,INAC
S (AA,TEST)=0
F S AA=$O(^GMR(120.8,"B",DFN,AA)) Q:AA'>0!(+TEST=1) D
.I $P(^GMR(120.8,AA,0),"^",16)'=1 Q ;Quit if not verified
.I $D(^GMR(120.8,AA,"ER")),$P(^GMR(120.8,AA,"ER"),"^",1)=1 Q
.S INAC=$$INACTIVE^GMRADSP6(AA)
.Q:+INAC ;Quit if inactive
.I DRUG'="" D
..S X=$P(^GMR(120.8,AA,0),"^",2) X ^%ZOSF("UPPERCASE")
..I (X[DRUG) S TEST="1^"_X
.S BB=0
.F S BB=$O(^GMR(120.8,AA,3,"B",BB)) Q:BB'>0 D
..I $P(^PS(50.605,BB,0),"^",1)=CLASS S TEST="1^"_CLASS
Q TEST
REF(VIEN,TAX,BGPEDATE) ;Look for refusals
N MED,VST,EVT,X
S MED=0
S X=999 F S X=$O(VIEN(X),-1) Q:X=""!(+MED=1) D
.S VST=$P(VIEN(X),U,1)
.S EVT=$P($P($G(^AUPNVSIT(VST,0)),U,1),".",1)
.S MED=$$MEDREF^BGPMUUT2(DFN,EVT,BGPEDATE,TAX)
Q MED
NUM1(DFN,BGPBDATE,BGPEDATE) ;check for meds in numerator
N FOUND,PMED
S FOUND=0
S PMED=$$FIND^BGPMUUT8(DFN,"BGPMU ANTIPLATELET NDCS",BGPBDATE,"",BGPEDATE)
I +PMED S FOUND=2_U_$P(PMED,U,2)_U_$P(PMED,U,3)
Q FOUND
ENTRY2 ;EP Entry point for NQA0070 for CAD and beta blockers
N START,END,BGPNUM,BGPDEN,BGPNUM,STRING,OUTCT,NFCT,INCT
N IEN,INV,VISIT,DATA,VDATE,VALUE,EXCEPT,FIRST,VIEN,EXCEPT,RESULT
N CNT,DIAB,NUM,EXC,DIAB,OUTENC,NFENC,INENC,CADDX
S (BGPDEN,BGPNUM,RESULT)=0
S START=9999999-BGPBDATE,END=9999999-BGPEDATE,VALUE=0
S START=START_".2359"
S STRING="",CADDX=0
S (CAD,EXC,NUM)=0
;Pts must be >18
;No need to check further if no age match
Q:BGPAGEE<18
S (CNT,OUTCT,NFCT,INCT)=0
S FIRST=END-0.1 F S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START) D
.S IEN=0 F S IEN=$O(^AUPNVSIT("AA",DFN,FIRST,IEN)) Q:'+IEN D
..;Check provider, Only visits for chosen provider
..Q:'$$PRV^BGPMUUT1(IEN,BGPPROV)
..S OUTENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENCOUNTER OUTPT")
..I +OUTENC S OUTCT=OUTCT+1
..S NFENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU NURSING FAC EM")
..I +NFENC S NFCT=NFCT+1
..S INENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENC CAD INPATIENT CPT")
..I +INENC S INCT=INCT+1
..I +OUTENC!(+NFENC)!(+INENC) D
...S VDATE=$P($G(^AUPNVSIT(IEN,0)),U,1)
...S CNT=CNT+1
...S VIEN(CNT)=IEN_U_VDATE_U_$$DATE^BGPMUUTL(VDATE)
...S STRING(CNT)=$$DATE^BGPMUUTL(VDATE)
;Next check to see if the patient is in the denominator
;Denominator is that the pt has DX of CAD or cardiac surgery before found visits
I OUTCT>1!(NFCT>1)!(INCT>0) D
.S CADDATE=$P($P($G(VIEN(1)),U,2),".")
.S CAD=$$CADMI(DFN,CADDATE,CNT)
.I +CAD D
..;If the patient had CAD, check to see if they are in the numerator
..S NUM=$$NUM2(DFN,BGPBDATE,BGPEDATE)
..;If not in the numerator,see if they are an exception
..I +NUM=0 S EXC=$$EXCEPT2(.VIEN,DFN,CADDATE,BGPEDATE,CNT)
..D TOTAL2(DFN,CAD,NUM,EXC)
Q
TOTAL2(DFN,CAD,NUM,EXC) ;See where this patient ends up
N PTCNT,EXCCT,DENCT,NUMCT,NOTNUM,TOTALS,DXTIME,DEN
S TOTALS=$G(^TMP("BGPMU0070",$J,BGPMUTF,"TOT"))
S DENCT=+$G(^TMP("BGPMU0070",$J,BGPMUTF,"DEN"))
S NUMCT=+$G(^TMP("BGPMU0070",$J,BGPMUTF,"NUM"))
S EXCCT=+$G(^TMP("BGPMU0070",$J,BGPMUTF,"EXC"))
S NOTNUM=+$G(^TMP("BGPMU0070",$J,BGPMUTF,"NOT"))
S PTCNT=TOTALS
S PTCNT=PTCNT+1
S (DEN,DXTIME)=""
S DENCT=DENCT+1 S ^TMP("BGPMU0070",$J,BGPMUTF,"DEN")=DENCT
I $P(CAD,U,3)'="" S DXTIME=$$DATE^BGPMUUTL($P(CAD,U,3))
S DEN=$P(CAD,U,2)_DXTIME_";EN:"_STRING(1)
I $D(STRING(2)) S DEN=DEN_";EN:"_STRING(2)
I +EXC D
.S EXCCT=EXCCT+1 S ^TMP("BGPMU0070",$J,BGPMUTF,"EXC")=EXCCT
.I BGPMUTF="C" S ^TMP("BGPMU0070",$J,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DEN_U_"EXCLUDE"
I +NUM D
.S NUMCT=NUMCT+1 S ^TMP("BGPMU0070",$J,BGPMUTF,"NUM")=NUMCT
.I BGPMUTF="C" S ^TMP("BGPMU0070",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DEN_U_"M:MED;"_$P(NUM,U,3)
I +NUM=0&(EXC=0) D
.S NOTNUM=NOTNUM+1 S ^TMP("BGPMU0070",$J,BGPMUTF,"NOT")=NOTNUM
.I BGPMUTF="C" S ^TMP("BGPMU0070",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DEN_U_"NM:"_$P(NUM,U,2)_";"_$P(NUM,U,3)
S ^TMP("BGPMU0070",$J,BGPMUTF,"TOT")=PTCNT
;Setup iCare array for patient
S BGPICARE("MU.EP.0070.1",BGPMUTF)=1_U_+NUM_U_+EXC_U_DEN_";"_$P(NUM,U,2)_";"_$P(NUM,U,3)
Q
CADMI(DFN,CADDATE,CNT) ; Get the denominator
N RESULT,CADA,CADB,CADDX,CADSUR,DOB,MIFND,I
S RESULT=0,MIFND=0,CADDX=0
S DOB=$$GET1^DIQ(2,DFN,.03,"I")
;Check for coronary artery disease
S I=CNT+1 F S I=$O(VIEN(I),-1) Q:I=""!(+RESULT) D
.S CADDATE=$P($G(VIEN(I)),U,2)
.S CADA=$$LASTDX^BGPMUUT2(DFN,"",CADDATE,"BGPMU CAD-NO MI DX")
.S CADB=$$PLTAX^BGPMUUT1(DFN,"BGPMU CAD-NO MI DX","C",CADDATE)
.I +CADA S CADDX=1_U_"CAD:"_U_$P(CADA,U,3)
.I +CADB S CADDX=1_U_"CAD:"_U_$P(CADB,U,3)
.;Check for cardiac surgery
.I +CADDX=0 D
..S CADSUR=$$CPT^BGPMUUT1(DFN,DOB,CADDATE,"BGPMU CARDIAC SURGERY CPT")
..I +CADSUR S CADDX=1_U_"CSP:"_U_$P(CADSUR,U,3)
.;If pt has CAD or cardiac surgery, find previous heart attack
.I +CADDX D
..S MIFND=$$MI(DFN,CADDATE)
..I +MIFND D
...I $P(MIFND,U,3)<CADDATE S RESULT=CADDX
Q RESULT
MI(DFN,CADDATE) ;Find MI diagnoses only inactive problem
N FOUND,MIA,MIB
S FOUND=0
; MIA=$$LASTDX^BGPMUUT2(DFN,"",CADDATE,"BGPMU MI DX")
S MIB=$$PLTAX^BGPMUUT1(DFN,"BGPMU MI DX","I",CADDATE)
;I +MIA S FOUND=1_U_$P(MIA,U,2)_U_$P(MIA,U,3)
I +MIB S FOUND=1_U_$P(MIB,U,2)_U_$P(MIB,U,3)
Q FOUND
EXCEPT2(VIEN,DFN,CADDATE,BGPEDATE,CNT) ;Find exceptions
N RESULT,ARRY,HYPO,ASTHMA,BRADY,ATRESIA,MONITOR,PACE,PACE1,AVBLOCK
;Check for arrythmia
S RESULT=0
S ARRY=$$DXCK(DFN,"BGPMU ARRHYTHMIA DX",CADDATE)
I +ARRY S RESULT=ARRY Q RESULT
;Check for hypotension
S HYPO=$$DXCK(DFN,"BGPMU HYPOTENSION DX",CADDATE)
I +HYPO S RESULT=HYPO Q RESULT
;Check for asthma
S ASTHMA=$$DXCK(DFN,"BGPMU ASTHMA DX ICD",CADDATE)
I +ASTHMA S RESULT=ASTHMA Q RESULT
;Check for bradycardia
S BRADY=$$DXCK(DFN,"BGPMU BRADYCARDIA DX",CADDATE)
I +BRADY S RESULT=BRADY Q RESULT
;Check for atresia and stenosis of the aorta
S ATRESIA=$$DXCK(DFN,"BGPMU ATRESIA STENOSIS DX",CADDATE)
I +ATRESIA S RESULT=ATRESIA Q RESULT
;Check for av block
S AVBLOCK=$$DXCK(DFN,"BGPMU AV BLOCK DX",CADDATE)
I +AVBLOCK D
.S PACE=$$LASTPRC^BGPMUUT2(DFN,"",BGPEDATE,"BGPMU CARDIAC PACER ICD0")
.S PACE1=$$DXCK(DFN,"BGPMU CARDIAC PACER IN SITU DX",BGPEDATE)
.I PACE=0&(PACE1=0) S RESULT=AVBLOCK
I +RESULT Q RESULT
;Check for monitoring
S MONITOR=$$LASTPRC^BGPMUUT2(DFN,BGPBDATE,BGPEDATE,"BGPMU CARDIAC MONITORING ICD0")
I +MONITOR S RESULT=MONITOR Q RESULT
S MONITOR=$$CPT^BGPMUUT1(DFN,BGPBDATE,BGPEDATE,"BGPMU CARDIAC MONITORING CPT")
I +MONITOR S RESULT=MONITOR Q RESULT
;Next check for allergy
S ALLER=$$ALLER("CV100","")
I +ALLER S RESULT=1_U_$P(ALLER,U,1) Q RESULT
;Check for refusals
S TAX="BGPMU BETABLOCKER NDCS"
S REF=$$REF(.VIEN,TAX,BGPEDATE)
I +REF S RESULT=1_U_$P(REF,U,1) Q RESULT
S RESULT=$$PULSE(DFN)
Q RESULT
DXCK(DFN,TAX,CKDATE) ;Find dx on problem list or POV
N A1,A2,FOUND
S FOUND=0
S A1=$$LASTDX^BGPMUUT2(DFN,"",CKDATE,TAX)
I +A1 S FOUND=1_U_$P(A1,U,2)_U_$P(A1,U,3) Q FOUND
S A2=$$PLTAX^BGPMUUT1(DFN,TAX,"C")
I +A2 S FOUND=1_U_$P(A2,U,2)_U_$P(A2,U,3)
Q FOUND
NUM2(DFN,BGPBDATE,BGPEDATE) ;check for meds in numerator
N FOUND,PMED
S FOUND=0
S PMED=$$FIND^BGPMUUT8(DFN,"BGPMU BETABLOCKER NDCS",BGPBDATE,"",BGPEDATE)
I +PMED S FOUND=2_U_$P(PMED,U,2)_U_$P(PMED,U,3)
Q FOUND
PULSE(DFN) ;Search for any 2 consecutive pulse measurements less than 50
N FOUND,X,PU,MTYP,IEN,SAVE,CNT,X,YR2
S FOUND=0,CNT=0,SAVE=0
S MTYP="" S MTYP=$O(^AUTTMSR("B","PU",MTYP))
N X1,X2,X S X1=BGPEDATE,X2=-672 D C^%DTC S YR2=X
S X=9999999-BGPEDATE,END=9999999-YR2
F S X=$O(^AUPNVMSR("AA",DFN,MTYP,X)) Q:X=""!(+FOUND)!(X>END) D
.S IEN="" F S IEN=$O(^AUPNVMSR("AA",DFN,MTYP,X,IEN)) Q:IEN=""!(+FOUND) D
..S VST=$P($G(^AUPNVMSR(IEN,0)),U,3)
..I $P($G(^AUPNVMSR(IEN,0)),U,4)<50 D
...I SAVE=0 S SAVE=VST
...I SAVE=VST Q
...I SAVE'=VST S FOUND=1_U_"PULSE"
..I $P($G(^AUPNVMSR(IEN,0)),U,4)>49 D
...I SAVE>0&(SAVE'=VST) S SAVE=0
Q FOUND
BGPMUA10 ; IHS/MSC/MGH - MI measure NQF0067 & NQF0070 ;11-Jul-2011 10:50;DU
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
+2 ;Code to collect meaningful use reports
ENTRY1 ;EP Entry point for NQA0067 for CAD and antiplatelet therapy
+1 NEW START,END,BGPNUM,BGPDEN,BGPNUM,STRING,OUTCT,NFCT,INCT
+2 NEW IEN,INV,VISIT,DATA,VDATE,VALUE,EXCEPT,FIRST,VIEN,EXCEPT,RESULT
+3 NEW CNT,DIAB,NUM,EXC,DIAB,OUTENC,NFENC,INENC,CADDX
+4 SET (BGPDEN,BGPNUM,RESULT)=0
+5 SET START=9999999-BGPBDATE
SET END=9999999-BGPEDATE
SET VALUE=0
+6 SET START=START_".2359"
+7 SET STRING=""
SET CADDX=0
+8 SET (CAD,EXC,NUM)=0
+9 ;Pts must be >18
+10 ;No need to check further if no age match
+11 IF BGPAGEE<18
QUIT
+12 SET (CNT,OUTCT,NFCT,INCT)=0
+13 SET FIRST=END-0.1
FOR
SET FIRST=$ORDER(^AUPNVSIT("AA",DFN,FIRST))
IF FIRST=""!($PIECE(FIRST,".",1)>START)
QUIT
Begin DoDot:1
+14 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVSIT("AA",DFN,FIRST,IEN))
IF '+IEN
QUIT
Begin DoDot:2
+15 ;Check provider, Only visits for chosen provider
+16 IF '$$PRV^BGPMUUT1(IEN,BGPPROV)
QUIT
+17 SET OUTENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENCOUNTER OUTPT")
+18 IF +OUTENC
SET OUTCT=OUTCT+1
+19 SET NFENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU NURSING FAC EM")
+20 IF +NFENC
SET NFCT=NFCT+1
+21 SET INENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENC CAD INPATIENT CPT")
+22 IF +INENC
SET INCT=INCT+1
+23 IF +OUTENC!(+NFENC)!(+INENC)
Begin DoDot:3
+24 SET VDATE=$PIECE($GET(^AUPNVSIT(IEN,0)),U,1)
+25 SET CNT=CNT+1
+26 SET VIEN(CNT)=IEN_U_VDATE_U_$$DATE^BGPMUUTL(VDATE)
+27 SET STRING(CNT)=$$DATE^BGPMUUTL(VDATE)
End DoDot:3
End DoDot:2
End DoDot:1
+28 ;Next check to see if the patient is in the denominator
+29 ;Denominator is that the pt has DX of CAD or cardiac surgery before found visits
+30 IF OUTCT>1!(NFCT>1)!(INCT>0)
Begin DoDot:1
+31 SET CADDATE=$PIECE($PIECE($GET(VIEN(1)),U,2),".")
+32 SET CAD=$$CAD(DFN,CADDATE)
+33 IF +CAD
Begin DoDot:2
+34 ;If the patient had CAD, check to see if they are in the numerator
+35 SET NUM=$$NUM1(DFN,BGPBDATE,BGPEDATE)
+36 ;If not in the numerator,see if they are an exception
+37 IF +NUM=0
SET EXC=$$EXCEPT(.VIEN,DFN,CADDATE,BGPEDATE,CNT)
+38 DO TOTAL1(DFN,CAD,NUM,EXC)
End DoDot:2
End DoDot:1
+39 QUIT
TOTAL1(DFN,CAD,NUM,EXC) ;See where this patient ends up
+1 NEW PTCNT,EXCCT,DENCT,NUMCT,NOTNUM,TOTALS,DXTIME,DEN
+2 SET TOTALS=$GET(^TMP("BGPMU0067",$JOB,BGPMUTF,"TOT"))
+3 SET DENCT=+$GET(^TMP("BGPMU0067",$JOB,BGPMUTF,"DEN"))
+4 SET NUMCT=+$GET(^TMP("BGPMU0067",$JOB,BGPMUTF,"NUM"))
+5 SET EXCCT=+$GET(^TMP("BGPMU0067",$JOB,BGPMUTF,"EXC"))
+6 SET NOTNUM=+$GET(^TMP("BGPMU0067",$JOB,BGPMUTF,"NOT"))
+7 SET PTCNT=TOTALS
+8 SET PTCNT=PTCNT+1
+9 SET (DEN,DXTIME)=""
+10 SET DENCT=DENCT+1
SET ^TMP("BGPMU0067",$JOB,BGPMUTF,"DEN")=DENCT
+11 IF $PIECE(CAD,U,3)'=""
SET DXTIME=$$DATE^BGPMUUTL($PIECE(CAD,U,3))
+12 SET DEN=$PIECE(CAD,U,2)_DXTIME_";EN:"_STRING(1)
+13 IF $DATA(STRING(2))
SET DEN=DEN_";EN:"_STRING(2)
+14 IF +EXC
Begin DoDot:1
+15 SET EXCCT=EXCCT+1
SET ^TMP("BGPMU0067",$JOB,BGPMUTF,"EXC")=EXCCT
+16 IF BGPMUTF="C"
SET ^TMP("BGPMU0067",$JOB,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DEN_U_"EXCLUDE"
End DoDot:1
+17 IF +NUM
Begin DoDot:1
+18 SET NUMCT=NUMCT+1
SET ^TMP("BGPMU0067",$JOB,BGPMUTF,"NUM")=NUMCT
+19 IF BGPMUTF="C"
SET ^TMP("BGPMU0067",$JOB,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DEN_U_"M:MED;"_$PIECE(NUM,U,3)
End DoDot:1
+20 IF +NUM=0&(EXC=0)
Begin DoDot:1
+21 SET NOTNUM=NOTNUM+1
SET ^TMP("BGPMU0067",$JOB,BGPMUTF,"NOT")=NOTNUM
+22 IF BGPMUTF="C"
SET ^TMP("BGPMU0067",$JOB,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DEN_U_"NM:"_$PIECE(NUM,U,2)_";"_$PIECE(NUM,U,3)
End DoDot:1
+23 SET ^TMP("BGPMU0067",$JOB,BGPMUTF,"TOT")=PTCNT
+24 ;Setup iCare array for patient
+25 SET BGPICARE("MU.EP.0067.1",BGPMUTF)=1_U_+NUM_U_+EXC_U_DEN_";"_$PIECE(NUM,U,2)_";"_$PIECE(NUM,U,3)
+26 QUIT
CAD(DFN,CADDATE) ; Get the denominator
+1 NEW RESULT,CADA,CADB,CADDX,CADSUR,DOB
+2 SET RESULT=0
+3 ;Check for coronary artery disease
+4 SET DOB=$$GET1^DIQ(2,DFN,.03,"I")
+5 SET CADA=$$LASTDX^BGPMUUT2(DFN,"",CADDATE,"BGPMU CAD DX")
+6 SET CADB=$$PLTAX^BGPMUUT1(DFN,"BGPMU CAD DX","C",CADDATE)
+7 IF +CADA
SET CADDX=CADA
+8 IF +CADB
SET CADDX=CADB
+9 IF +CADA!(+CADB)
SET RESULT=1_U_"CAD:"_U_$PIECE(CADDX,U,3)
QUIT RESULT
+10 ;Check for cardiac surgery
+11 SET CADSUR=$$CPT^BGPMUUT1(DFN,DOB,CADDATE,"BGPMU CARDIAC SURGERY CPT")
+12 IF +CADSUR
SET RESULT=1_U_"CSP:"_U_$PIECE(CADSUR,U,3)
+13 QUIT RESULT
EXCEPT(VIEN,DFN,CADDATE,BGPEDATE,CNT) ;Find exceptions
+1 NEW FOUND,BLEED,BLEED1,REF,ALLER
+2 ;Check for bleeding disorder
+3 SET (BLEED,BLEED1,ALLER,REF,FOUND)=0
+4 SET BLEED=$$LASTDX^BGPMUUT2(DFN,"",CADDATE,"BGPMU BLEEDING COAGULATION DX")
+5 IF +BLEED
SET FOUND=1_U_$PIECE(BLEED,U,2)_U_$PIECE(BLEED,U,3)
QUIT FOUND
+6 SET BLEED1=$$PLTAX^BGPMUUT1(DFN,"BGPMU BLEEDING COAGULATION DX","A")
+7 IF +BLEED1
SET FOUND=1_U_$PIECE(BLEED1,U,2)_U_$PIECE(BLEED1,U,3)
QUIT FOUND
+8 ;Next check for allergy
+9 SET ALLER=$$ALLER("BL117","")
+10 IF +ALLER
SET FOUND=1_U_$PIECE(ALLER,U,1)
+11 ;Check for refusals
+12 SET TAX="BGPMU ANTIPLATELET NDCS"
+13 SET REF=$$REF(.VIEN,TAX,BGPEDATE)
+14 IF +REF
SET FOUND=1_U_$PIECE(REF,U,1)
+15 QUIT FOUND
ALLER(CLASS,DRUG) ;Check for allergies
+1 NEW AA,BB,X,Y,TEST,INAC
+2 SET (AA,TEST)=0
+3 FOR
SET AA=$ORDER(^GMR(120.8,"B",DFN,AA))
IF AA'>0!(+TEST=1)
QUIT
Begin DoDot:1
+4 ;Quit if not verified
IF $PIECE(^GMR(120.8,AA,0),"^",16)'=1
QUIT
+5 IF $DATA(^GMR(120.8,AA,"ER"))
IF $PIECE(^GMR(120.8,AA,"ER"),"^",1)=1
QUIT
+6 SET INAC=$$INACTIVE^GMRADSP6(AA)
+7 ;Quit if inactive
IF +INAC
QUIT
+8 IF DRUG'=""
Begin DoDot:2
+9 SET X=$PIECE(^GMR(120.8,AA,0),"^",2)
XECUTE ^%ZOSF("UPPERCASE")
+10 IF (X[DRUG)
SET TEST="1^"_X
End DoDot:2
+11 SET BB=0
+12 FOR
SET BB=$ORDER(^GMR(120.8,AA,3,"B",BB))
IF BB'>0
QUIT
Begin DoDot:2
+13 IF $PIECE(^PS(50.605,BB,0),"^",1)=CLASS
SET TEST="1^"_CLASS
End DoDot:2
End DoDot:1
+14 QUIT TEST
REF(VIEN,TAX,BGPEDATE) ;Look for refusals
+1 NEW MED,VST,EVT,X
+2 SET MED=0
+3 SET X=999
FOR
SET X=$ORDER(VIEN(X),-1)
IF X=""!(+MED=1)
QUIT
Begin DoDot:1
+4 SET VST=$PIECE(VIEN(X),U,1)
+5 SET EVT=$PIECE($PIECE($GET(^AUPNVSIT(VST,0)),U,1),".",1)
+6 SET MED=$$MEDREF^BGPMUUT2(DFN,EVT,BGPEDATE,TAX)
End DoDot:1
+7 QUIT MED
NUM1(DFN,BGPBDATE,BGPEDATE) ;check for meds in numerator
+1 NEW FOUND,PMED
+2 SET FOUND=0
+3 SET PMED=$$FIND^BGPMUUT8(DFN,"BGPMU ANTIPLATELET NDCS",BGPBDATE,"",BGPEDATE)
+4 IF +PMED
SET FOUND=2_U_$PIECE(PMED,U,2)_U_$PIECE(PMED,U,3)
+5 QUIT FOUND
ENTRY2 ;EP Entry point for NQA0070 for CAD and beta blockers
+1 NEW START,END,BGPNUM,BGPDEN,BGPNUM,STRING,OUTCT,NFCT,INCT
+2 NEW IEN,INV,VISIT,DATA,VDATE,VALUE,EXCEPT,FIRST,VIEN,EXCEPT,RESULT
+3 NEW CNT,DIAB,NUM,EXC,DIAB,OUTENC,NFENC,INENC,CADDX
+4 SET (BGPDEN,BGPNUM,RESULT)=0
+5 SET START=9999999-BGPBDATE
SET END=9999999-BGPEDATE
SET VALUE=0
+6 SET START=START_".2359"
+7 SET STRING=""
SET CADDX=0
+8 SET (CAD,EXC,NUM)=0
+9 ;Pts must be >18
+10 ;No need to check further if no age match
+11 IF BGPAGEE<18
QUIT
+12 SET (CNT,OUTCT,NFCT,INCT)=0
+13 SET FIRST=END-0.1
FOR
SET FIRST=$ORDER(^AUPNVSIT("AA",DFN,FIRST))
IF FIRST=""!($PIECE(FIRST,".",1)>START)
QUIT
Begin DoDot:1
+14 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVSIT("AA",DFN,FIRST,IEN))
IF '+IEN
QUIT
Begin DoDot:2
+15 ;Check provider, Only visits for chosen provider
+16 IF '$$PRV^BGPMUUT1(IEN,BGPPROV)
QUIT
+17 SET OUTENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENCOUNTER OUTPT")
+18 IF +OUTENC
SET OUTCT=OUTCT+1
+19 SET NFENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU NURSING FAC EM")
+20 IF +NFENC
SET NFCT=NFCT+1
+21 SET INENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENC CAD INPATIENT CPT")
+22 IF +INENC
SET INCT=INCT+1
+23 IF +OUTENC!(+NFENC)!(+INENC)
Begin DoDot:3
+24 SET VDATE=$PIECE($GET(^AUPNVSIT(IEN,0)),U,1)
+25 SET CNT=CNT+1
+26 SET VIEN(CNT)=IEN_U_VDATE_U_$$DATE^BGPMUUTL(VDATE)
+27 SET STRING(CNT)=$$DATE^BGPMUUTL(VDATE)
End DoDot:3
End DoDot:2
End DoDot:1
+28 ;Next check to see if the patient is in the denominator
+29 ;Denominator is that the pt has DX of CAD or cardiac surgery before found visits
+30 IF OUTCT>1!(NFCT>1)!(INCT>0)
Begin DoDot:1
+31 SET CADDATE=$PIECE($PIECE($GET(VIEN(1)),U,2),".")
+32 SET CAD=$$CADMI(DFN,CADDATE,CNT)
+33 IF +CAD
Begin DoDot:2
+34 ;If the patient had CAD, check to see if they are in the numerator
+35 SET NUM=$$NUM2(DFN,BGPBDATE,BGPEDATE)
+36 ;If not in the numerator,see if they are an exception
+37 IF +NUM=0
SET EXC=$$EXCEPT2(.VIEN,DFN,CADDATE,BGPEDATE,CNT)
+38 DO TOTAL2(DFN,CAD,NUM,EXC)
End DoDot:2
End DoDot:1
+39 QUIT
TOTAL2(DFN,CAD,NUM,EXC) ;See where this patient ends up
+1 NEW PTCNT,EXCCT,DENCT,NUMCT,NOTNUM,TOTALS,DXTIME,DEN
+2 SET TOTALS=$GET(^TMP("BGPMU0070",$JOB,BGPMUTF,"TOT"))
+3 SET DENCT=+$GET(^TMP("BGPMU0070",$JOB,BGPMUTF,"DEN"))
+4 SET NUMCT=+$GET(^TMP("BGPMU0070",$JOB,BGPMUTF,"NUM"))
+5 SET EXCCT=+$GET(^TMP("BGPMU0070",$JOB,BGPMUTF,"EXC"))
+6 SET NOTNUM=+$GET(^TMP("BGPMU0070",$JOB,BGPMUTF,"NOT"))
+7 SET PTCNT=TOTALS
+8 SET PTCNT=PTCNT+1
+9 SET (DEN,DXTIME)=""
+10 SET DENCT=DENCT+1
SET ^TMP("BGPMU0070",$JOB,BGPMUTF,"DEN")=DENCT
+11 IF $PIECE(CAD,U,3)'=""
SET DXTIME=$$DATE^BGPMUUTL($PIECE(CAD,U,3))
+12 SET DEN=$PIECE(CAD,U,2)_DXTIME_";EN:"_STRING(1)
+13 IF $DATA(STRING(2))
SET DEN=DEN_";EN:"_STRING(2)
+14 IF +EXC
Begin DoDot:1
+15 SET EXCCT=EXCCT+1
SET ^TMP("BGPMU0070",$JOB,BGPMUTF,"EXC")=EXCCT
+16 IF BGPMUTF="C"
SET ^TMP("BGPMU0070",$JOB,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DEN_U_"EXCLUDE"
End DoDot:1
+17 IF +NUM
Begin DoDot:1
+18 SET NUMCT=NUMCT+1
SET ^TMP("BGPMU0070",$JOB,BGPMUTF,"NUM")=NUMCT
+19 IF BGPMUTF="C"
SET ^TMP("BGPMU0070",$JOB,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DEN_U_"M:MED;"_$PIECE(NUM,U,3)
End DoDot:1
+20 IF +NUM=0&(EXC=0)
Begin DoDot:1
+21 SET NOTNUM=NOTNUM+1
SET ^TMP("BGPMU0070",$JOB,BGPMUTF,"NOT")=NOTNUM
+22 IF BGPMUTF="C"
SET ^TMP("BGPMU0070",$JOB,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DEN_U_"NM:"_$PIECE(NUM,U,2)_";"_$PIECE(NUM,U,3)
End DoDot:1
+23 SET ^TMP("BGPMU0070",$JOB,BGPMUTF,"TOT")=PTCNT
+24 ;Setup iCare array for patient
+25 SET BGPICARE("MU.EP.0070.1",BGPMUTF)=1_U_+NUM_U_+EXC_U_DEN_";"_$PIECE(NUM,U,2)_";"_$PIECE(NUM,U,3)
+26 QUIT
CADMI(DFN,CADDATE,CNT) ; Get the denominator
+1 NEW RESULT,CADA,CADB,CADDX,CADSUR,DOB,MIFND,I
+2 SET RESULT=0
SET MIFND=0
SET CADDX=0
+3 SET DOB=$$GET1^DIQ(2,DFN,.03,"I")
+4 ;Check for coronary artery disease
+5 SET I=CNT+1
FOR
SET I=$ORDER(VIEN(I),-1)
IF I=""!(+RESULT)
QUIT
Begin DoDot:1
+6 SET CADDATE=$PIECE($GET(VIEN(I)),U,2)
+7 SET CADA=$$LASTDX^BGPMUUT2(DFN,"",CADDATE,"BGPMU CAD-NO MI DX")
+8 SET CADB=$$PLTAX^BGPMUUT1(DFN,"BGPMU CAD-NO MI DX","C",CADDATE)
+9 IF +CADA
SET CADDX=1_U_"CAD:"_U_$PIECE(CADA,U,3)
+10 IF +CADB
SET CADDX=1_U_"CAD:"_U_$PIECE(CADB,U,3)
+11 ;Check for cardiac surgery
+12 IF +CADDX=0
Begin DoDot:2
+13 SET CADSUR=$$CPT^BGPMUUT1(DFN,DOB,CADDATE,"BGPMU CARDIAC SURGERY CPT")
+14 IF +CADSUR
SET CADDX=1_U_"CSP:"_U_$PIECE(CADSUR,U,3)
End DoDot:2
+15 ;If pt has CAD or cardiac surgery, find previous heart attack
+16 IF +CADDX
Begin DoDot:2
+17 SET MIFND=$$MI(DFN,CADDATE)
+18 IF +MIFND
Begin DoDot:3
+19 IF $PIECE(MIFND,U,3)<CADDATE
SET RESULT=CADDX
End DoDot:3
End DoDot:2
End DoDot:1
+20 QUIT RESULT
MI(DFN,CADDATE) ;Find MI diagnoses only inactive problem
+1 NEW FOUND,MIA,MIB
+2 SET FOUND=0
+3 ; MIA=$$LASTDX^BGPMUUT2(DFN,"",CADDATE,"BGPMU MI DX")
+4 SET MIB=$$PLTAX^BGPMUUT1(DFN,"BGPMU MI DX","I",CADDATE)
+5 ;I +MIA S FOUND=1_U_$P(MIA,U,2)_U_$P(MIA,U,3)
+6 IF +MIB
SET FOUND=1_U_$PIECE(MIB,U,2)_U_$PIECE(MIB,U,3)
+7 QUIT FOUND
EXCEPT2(VIEN,DFN,CADDATE,BGPEDATE,CNT) ;Find exceptions
+1 NEW RESULT,ARRY,HYPO,ASTHMA,BRADY,ATRESIA,MONITOR,PACE,PACE1,AVBLOCK
+2 ;Check for arrythmia
+3 SET RESULT=0
+4 SET ARRY=$$DXCK(DFN,"BGPMU ARRHYTHMIA DX",CADDATE)
+5 IF +ARRY
SET RESULT=ARRY
QUIT RESULT
+6 ;Check for hypotension
+7 SET HYPO=$$DXCK(DFN,"BGPMU HYPOTENSION DX",CADDATE)
+8 IF +HYPO
SET RESULT=HYPO
QUIT RESULT
+9 ;Check for asthma
+10 SET ASTHMA=$$DXCK(DFN,"BGPMU ASTHMA DX ICD",CADDATE)
+11 IF +ASTHMA
SET RESULT=ASTHMA
QUIT RESULT
+12 ;Check for bradycardia
+13 SET BRADY=$$DXCK(DFN,"BGPMU BRADYCARDIA DX",CADDATE)
+14 IF +BRADY
SET RESULT=BRADY
QUIT RESULT
+15 ;Check for atresia and stenosis of the aorta
+16 SET ATRESIA=$$DXCK(DFN,"BGPMU ATRESIA STENOSIS DX",CADDATE)
+17 IF +ATRESIA
SET RESULT=ATRESIA
QUIT RESULT
+18 ;Check for av block
+19 SET AVBLOCK=$$DXCK(DFN,"BGPMU AV BLOCK DX",CADDATE)
+20 IF +AVBLOCK
Begin DoDot:1
+21 SET PACE=$$LASTPRC^BGPMUUT2(DFN,"",BGPEDATE,"BGPMU CARDIAC PACER ICD0")
+22 SET PACE1=$$DXCK(DFN,"BGPMU CARDIAC PACER IN SITU DX",BGPEDATE)
+23 IF PACE=0&(PACE1=0)
SET RESULT=AVBLOCK
End DoDot:1
+24 IF +RESULT
QUIT RESULT
+25 ;Check for monitoring
+26 SET MONITOR=$$LASTPRC^BGPMUUT2(DFN,BGPBDATE,BGPEDATE,"BGPMU CARDIAC MONITORING ICD0")
+27 IF +MONITOR
SET RESULT=MONITOR
QUIT RESULT
+28 SET MONITOR=$$CPT^BGPMUUT1(DFN,BGPBDATE,BGPEDATE,"BGPMU CARDIAC MONITORING CPT")
+29 IF +MONITOR
SET RESULT=MONITOR
QUIT RESULT
+30 ;Next check for allergy
+31 SET ALLER=$$ALLER("CV100","")
+32 IF +ALLER
SET RESULT=1_U_$PIECE(ALLER,U,1)
QUIT RESULT
+33 ;Check for refusals
+34 SET TAX="BGPMU BETABLOCKER NDCS"
+35 SET REF=$$REF(.VIEN,TAX,BGPEDATE)
+36 IF +REF
SET RESULT=1_U_$PIECE(REF,U,1)
QUIT RESULT
+37 SET RESULT=$$PULSE(DFN)
+38 QUIT RESULT
DXCK(DFN,TAX,CKDATE) ;Find dx on problem list or POV
+1 NEW A1,A2,FOUND
+2 SET FOUND=0
+3 SET A1=$$LASTDX^BGPMUUT2(DFN,"",CKDATE,TAX)
+4 IF +A1
SET FOUND=1_U_$PIECE(A1,U,2)_U_$PIECE(A1,U,3)
QUIT FOUND
+5 SET A2=$$PLTAX^BGPMUUT1(DFN,TAX,"C")
+6 IF +A2
SET FOUND=1_U_$PIECE(A2,U,2)_U_$PIECE(A2,U,3)
+7 QUIT FOUND
NUM2(DFN,BGPBDATE,BGPEDATE) ;check for meds in numerator
+1 NEW FOUND,PMED
+2 SET FOUND=0
+3 SET PMED=$$FIND^BGPMUUT8(DFN,"BGPMU BETABLOCKER NDCS",BGPBDATE,"",BGPEDATE)
+4 IF +PMED
SET FOUND=2_U_$PIECE(PMED,U,2)_U_$PIECE(PMED,U,3)
+5 QUIT FOUND
PULSE(DFN) ;Search for any 2 consecutive pulse measurements less than 50
+1 NEW FOUND,X,PU,MTYP,IEN,SAVE,CNT,X,YR2
+2 SET FOUND=0
SET CNT=0
SET SAVE=0
+3 SET MTYP=""
SET MTYP=$ORDER(^AUTTMSR("B","PU",MTYP))
+4 NEW X1,X2,X
SET X1=BGPEDATE
SET X2=-672
DO C^%DTC
SET YR2=X
+5 SET X=9999999-BGPEDATE
SET END=9999999-YR2
+6 FOR
SET X=$ORDER(^AUPNVMSR("AA",DFN,MTYP,X))
IF X=""!(+FOUND)!(X>END)
QUIT
Begin DoDot:1
+7 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVMSR("AA",DFN,MTYP,X,IEN))
IF IEN=""!(+FOUND)
QUIT
Begin DoDot:2
+8 SET VST=$PIECE($GET(^AUPNVMSR(IEN,0)),U,3)
+9 IF $PIECE($GET(^AUPNVMSR(IEN,0)),U,4)<50
Begin DoDot:3
+10 IF SAVE=0
SET SAVE=VST
+11 IF SAVE=VST
QUIT
+12 IF SAVE'=VST
SET FOUND=1_U_"PULSE"
End DoDot:3
+13 IF $PIECE($GET(^AUPNVMSR(IEN,0)),U,4)>49
Begin DoDot:3
+14 IF SAVE>0&(SAVE'=VST)
SET SAVE=0
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT FOUND
