BGPMUG02 ; IHS/MSC/MMT - MI measure NQF0083 ;20-Aug-2011 14:56;DU
;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
;Code to collect meaningful use report Heart Failure Beta-Blockers
ENTRY ;EP
N START,END,STRING,STRING2
N IEN,INV,VISIT,DATA,VDATE,VALUE,EXCEPT,FIRST
N OUTCNT,NFCNT,DEN,NUM,EXC,OUTENC,NFENC,VIENO,VIENNF,LASTVDT
S START=9999999-BGPBDATE,END=9999999-BGPEDATE,VALUE=0
S START=START_".2359"
S (HFDX,DEN,EXC,NUM)=0
S (OUTCNT,NFCNT)=0
;Pts must be >=18
;No need to check further if no age match
Q:BGPAGEE<18
S BGPBIRTH=$$DOB^AUPNPAT(DFN)
S FIRST=END-0.1 F S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START)!(OUTCNT>1)!(NFCNT>1) D
.S IEN=0 F S IEN=$O(^AUPNVSIT("AA",DFN,FIRST,IEN)) Q:'+IEN!(OUTCNT>1)!(NFCNT>1) D
..;Check provider, Only visits for chosen provider
..Q:'$$PRV^BGPMUUT1(IEN,BGPPROV)
..S OUTENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU BP EM")
..I +OUTENC D
...S OUTCNT=OUTCNT+1
...S VDATE=$P($G(^AUPNVSIT(IEN,0)),U,1)
...S VIENO(OUTCNT)=IEN_U_VDATE
..S NFENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU NURSING FAC EM")
..I +NFENC D
...S NFCNT=NFCNT+1
...S VDATE=$P($G(^AUPNVSIT(IEN,0)),U,1)
...S VIENNF(NFCNT)=IEN_U_VDATE
..I (+OUTENC!(+NFENC))&($G(LASTVDT)="") S LASTVDT=VDATE
I OUTCNT>1 S DEN=1,STRING=";EN:"_$$DATE^BGPMUUTL($P(VIENO(1),U,2))_";EN:"_$$DATE^BGPMUUTL($P(VIENO(2),U,2))
E I NFCNT>1 S DEN=1,STRING=";EN:"_$$DATE^BGPMUUTL($P(VIENNF(1),U,2))_";EN:"_$$DATE^BGPMUUTL($P(VIENNF(2),U,2))
Q:'DEN
;Next check to see if the patient is in the denominator
S HFDX=$$HFDX(DFN,BGPBIRTH,LASTVDT)
I +HFDX D
.S DENSTR="HF:"_$$DATE^BGPMUUTL($P(HFDX,U,3))_";LVEF:"_$$DATE^BGPMUUTL($P(HFDX,U,5))_STRING
.;If the patient has Heart Failure, check to see if they are in the numerator
.S NUM=$$NUM(DFN,BGPBDATE,BGPEDATE)
.;If not in the numerator,see if they are an exception
.I +NUM=0 S EXC=$$EXCEPT^BGPMUA06(DFN,BGPBDATE,BGPEDATE)
.D TOTAL(DFN,HFDX,NUM,EXC)
Q
TOTAL(DFN,HFDX,NUM,EXC) ;See where this patient ends up
N PTCNT,EXCCT,DENCT,NUMCT,NOTNUM,TOTALS,DEN,DXTIME
S TOTALS=$G(^TMP("BGPMU0083",$J,BGPMUTF,"TOT"))
S DENCT=+$G(^TMP("BGPMU0083",$J,BGPMUTF,"DEN"))
S NUMCT=+$G(^TMP("BGPMU0083",$J,BGPMUTF,"NUM"))
S EXCCT=+$G(^TMP("BGPMU0083",$J,BGPMUTF,"EXC"))
S NOTNUM=+$G(^TMP("BGPMU0083",$J,BGPMUTF,"NOT"))
S PTCNT=TOTALS
S PTCNT=PTCNT+1
S DENCT=DENCT+1 S ^TMP("BGPMU0083",$J,BGPMUTF,"DEN")=DENCT
I +NUM D
.S NUMCT=NUMCT+1 S ^TMP("BGPMU0083",$J,BGPMUTF,"NUM")=NUMCT
.I BGPMUTF="C" S ^TMP("BGPMU0083",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DENSTR_U_"M:MED "_$$DATE^BGPMUUTL($P(NUM,U,3))
I +EXC D
.S EXCCT=EXCCT+1 S ^TMP("BGPMU0083",$J,BGPMUTF,"EXC")=EXCCT
.I BGPMUTF="C" S ^TMP("BGPMU0083",$J,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DENSTR_U_"Excluded"
I +NUM=0&(EXC=0) D
.S NOTNUM=NOTNUM+1 S ^TMP("BGPMU0083",$J,BGPMUTF,"NOT")=NOTNUM
.I BGPMUTF="C" S ^TMP("BGPMU0083",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DENSTR_U_"NM:"
S ^TMP("BGPMU0083",$J,BGPMUTF,"TOT")=PTCNT
;Setup iCare array for patient",BGPMUTF)=1_U_+NUM_U_""
S BGPICARE("MU.EP.0083.1",BGPMUTF)=1_U_+NUM_U_+EXC_U_DENSTR_";"_$P(NUM,U,2)_";"_$P(NUM,U,3)
Q
HFDX(DFN,BDATE,EDATE) ;look for Heart Failure Dx AND LVEF < 40%
N FOUND,DXHF,PLHF,DX1,DX2,CEF,IEN,INV,MTYPE,RESULT,RDATE
S FOUND=0,DX1=0,DX2=0,CEF=0
;Check for the patient having a DX or Problem of Heart Failure (ever)
S DXHF=$$LASTDX^BGPMUUT2(DFN,BGPBIRTH,EDATE,"BGPMU HEART FAILURE DX")
I +DXHF S DX1=DXHF
E D
.S PLHF=$$PLTAX^BGPMUUT1(DFN,"BGPMU HEART FAILURE DX","C",EDATE)
.I +PLHF S DX1=PLHF
Q:DX1=0 0
;Now check for LVEF < 40%
;S MTYP="" S MTYP=$O(^AUTTMSR("B","HT",MTYP)) ;ZSAT: for testing; delete this line, keep next line
S MTYP="" S MTYP=$O(^AUTTMSR("B","CEF",MTYP))
Q:MTYP="" 0
S INV=9999999-EDATE
F S INV=$O(^AUPNVMSR("AA",DFN,MTYP,INV)) Q:'+INV!(+FOUND) D
.S RDATE=9999999-INV
.S IEN=0 F S IEN=$O(^AUPNVMSR("AA",DFN,MTYP,INV,IEN)) Q:IEN=""!(+FOUND) D
..S FOUND=1
..S RESULT=$P($G(^AUPNVMSR(IEN,0)),U,4)
..;I RESULT<80 S CEF=1_U_U_RDATE ;ZSAT: testing; delete this line; keep next line
..I RESULT<40 S CEF=1_U_RESULT_U_RDATE
I +CEF D
.S FOUND=1_U_$P(DX1,U,2)_U_$P(DX1,U,3)_U_$P(CEF,U,2)_U_$P(CEF,U,3)
Q FOUND
NUM(DFN,BGPBDATE,BGPEDATE) ;Look for Beta-blocker MED
N FOUND,PMED
S FOUND=0
S PMED=$$FIND^BGPMUUT8(DFN,"BGPMU BETABLOCKER NDCS",BGPBDATE,"",BGPEDATE)
I +PMED S FOUND=1_U_$P(PMED,U,2)_U_$P(PMED,U,3)
Q FOUND
EXCEPT(DFN,BDATE,EDATE) ;See if this patient has exceptions
N RESULT,ARRY,HYPO,ASTHMA,BRADY,PACE,PACE2,AVBLOCK,MED
S RESULT=0
;Check for arrythmia
S ARRY=$$DXCK(DFN,"BGPMU ARRHYTHMIA DX",EDATE)
I +ARRY S RESULT=ARRY Q RESULT
;Check for hypotension
S HYPO=$$DXCK(DFN,"BGPMU HYPOTENSION DX",EDATE)
I +HYPO S RESULT=HYPO Q RESULT
;Check for asthma
S ASTHMA=$$DXCK(DFN,"BGPMU ASTHMA DX ICD",EDATE)
I +ASTHMA S RESULT=ASTHMA Q RESULT
;Check for bradycardia
S BRADY=$$DXCK(DFN,"BGPMU BRADYCARDIA DX",EDATE)
I +BRADY S RESULT=BRADY Q RESULT
;Check for av block and NOT on cardiac pacemaker
S AVBLOCK=$$DXCK(DFN,"BGPMU AV BLOCK DX",EDATE)
I +AVBLOCK D Q:+RESULT RESULT
.S PACE=$$LASTPRC^BGPMUUT2(DFN,"",BGPEDATE,"BGPMU CARDIAC PACER ICD0")
.S PACE2=$$DXCK(DFN,"BGPMU CARDIAC PACER IN SITU DX",EDATE)
.I +PACE=0&(+PACE2=0) S RESULT=AVBLOCK
;Next check for allergy
S ALLER=$$ALLER^BGPMUA10("CV100","")
I +ALLER S RESULT=1_U_$P(ALLER,U,1) Q RESULT
;Check for refusal of Betablockers
S MED=$$MEDREF^BGPMUUT2(DFN,BDATE,EDATE_".2359","BGPMU BETABLOCKER NDCS")
I +MED S RESULT=MED Q RESULT
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
BGPMUG02 ; IHS/MSC/MMT - MI measure NQF0083 ;20-Aug-2011 14:56;DU
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
+2 ;Code to collect meaningful use report Heart Failure Beta-Blockers
ENTRY ;EP
+1 NEW START,END,STRING,STRING2
+2 NEW IEN,INV,VISIT,DATA,VDATE,VALUE,EXCEPT,FIRST
+3 NEW OUTCNT,NFCNT,DEN,NUM,EXC,OUTENC,NFENC,VIENO,VIENNF,LASTVDT
+4 SET START=9999999-BGPBDATE
SET END=9999999-BGPEDATE
SET VALUE=0
+5 SET START=START_".2359"
+6 SET (HFDX,DEN,EXC,NUM)=0
+7 SET (OUTCNT,NFCNT)=0
+8 ;Pts must be >=18
+9 ;No need to check further if no age match
+10 IF BGPAGEE<18
QUIT
+11 SET BGPBIRTH=$$DOB^AUPNPAT(DFN)
+12 SET FIRST=END-0.1
FOR
SET FIRST=$ORDER(^AUPNVSIT("AA",DFN,FIRST))
IF FIRST=""!($PIECE(FIRST,".",1)>START)!(OUTCNT>1)!(NFCNT>1)
QUIT
Begin DoDot:1
+13 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVSIT("AA",DFN,FIRST,IEN))
IF '+IEN!(OUTCNT>1)!(NFCNT>1)
QUIT
Begin DoDot:2
+14 ;Check provider, Only visits for chosen provider
+15 IF '$$PRV^BGPMUUT1(IEN,BGPPROV)
QUIT
+16 SET OUTENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU BP EM")
+17 IF +OUTENC
Begin DoDot:3
+18 SET OUTCNT=OUTCNT+1
+19 SET VDATE=$PIECE($GET(^AUPNVSIT(IEN,0)),U,1)
+20 SET VIENO(OUTCNT)=IEN_U_VDATE
End DoDot:3
+21 SET NFENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU NURSING FAC EM")
+22 IF +NFENC
Begin DoDot:3
+23 SET NFCNT=NFCNT+1
+24 SET VDATE=$PIECE($GET(^AUPNVSIT(IEN,0)),U,1)
+25 SET VIENNF(NFCNT)=IEN_U_VDATE
End DoDot:3
+26 IF (+OUTENC!(+NFENC))&($GET(LASTVDT)="")
SET LASTVDT=VDATE
End DoDot:2
End DoDot:1
+27 IF OUTCNT>1
SET DEN=1
SET STRING=";EN:"_$$DATE^BGPMUUTL($PIECE(VIENO(1),U,2))_";EN:"_$$DATE^BGPMUUTL($PIECE(VIENO(2),U,2))
+28 IF '$TEST
IF NFCNT>1
SET DEN=1
SET STRING=";EN:"_$$DATE^BGPMUUTL($PIECE(VIENNF(1),U,2))_";EN:"_$$DATE^BGPMUUTL($PIECE(VIENNF(2),U,2))
+29 IF 'DEN
QUIT
+30 ;Next check to see if the patient is in the denominator
+31 SET HFDX=$$HFDX(DFN,BGPBIRTH,LASTVDT)
+32 IF +HFDX
Begin DoDot:1
+33 SET DENSTR="HF:"_$$DATE^BGPMUUTL($PIECE(HFDX,U,3))_";LVEF:"_$$DATE^BGPMUUTL($PIECE(HFDX,U,5))_STRING
+34 ;If the patient has Heart Failure, check to see if they are in the numerator
+35 SET NUM=$$NUM(DFN,BGPBDATE,BGPEDATE)
+36 ;If not in the numerator,see if they are an exception
+37 IF +NUM=0
SET EXC=$$EXCEPT^BGPMUA06(DFN,BGPBDATE,BGPEDATE)
+38 DO TOTAL(DFN,HFDX,NUM,EXC)
End DoDot:1
+39 QUIT
TOTAL(DFN,HFDX,NUM,EXC) ;See where this patient ends up
+1 NEW PTCNT,EXCCT,DENCT,NUMCT,NOTNUM,TOTALS,DEN,DXTIME
+2 SET TOTALS=$GET(^TMP("BGPMU0083",$JOB,BGPMUTF,"TOT"))
+3 SET DENCT=+$GET(^TMP("BGPMU0083",$JOB,BGPMUTF,"DEN"))
+4 SET NUMCT=+$GET(^TMP("BGPMU0083",$JOB,BGPMUTF,"NUM"))
+5 SET EXCCT=+$GET(^TMP("BGPMU0083",$JOB,BGPMUTF,"EXC"))
+6 SET NOTNUM=+$GET(^TMP("BGPMU0083",$JOB,BGPMUTF,"NOT"))
+7 SET PTCNT=TOTALS
+8 SET PTCNT=PTCNT+1
+9 SET DENCT=DENCT+1
SET ^TMP("BGPMU0083",$JOB,BGPMUTF,"DEN")=DENCT
+10 IF +NUM
Begin DoDot:1
+11 SET NUMCT=NUMCT+1
SET ^TMP("BGPMU0083",$JOB,BGPMUTF,"NUM")=NUMCT
+12 IF BGPMUTF="C"
SET ^TMP("BGPMU0083",$JOB,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DENSTR_U_"M:MED "_$$DATE^BGPMUUTL($PIECE(NUM,U,3))
End DoDot:1
+13 IF +EXC
Begin DoDot:1
+14 SET EXCCT=EXCCT+1
SET ^TMP("BGPMU0083",$JOB,BGPMUTF,"EXC")=EXCCT
+15 IF BGPMUTF="C"
SET ^TMP("BGPMU0083",$JOB,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DENSTR_U_"Excluded"
End DoDot:1
+16 IF +NUM=0&(EXC=0)
Begin DoDot:1
+17 SET NOTNUM=NOTNUM+1
SET ^TMP("BGPMU0083",$JOB,BGPMUTF,"NOT")=NOTNUM
+18 IF BGPMUTF="C"
SET ^TMP("BGPMU0083",$JOB,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DENSTR_U_"NM:"
End DoDot:1
+19 SET ^TMP("BGPMU0083",$JOB,BGPMUTF,"TOT")=PTCNT
+20 ;Setup iCare array for patient",BGPMUTF)=1_U_+NUM_U_""
+21 SET BGPICARE("MU.EP.0083.1",BGPMUTF)=1_U_+NUM_U_+EXC_U_DENSTR_";"_$PIECE(NUM,U,2)_";"_$PIECE(NUM,U,3)
+22 QUIT
HFDX(DFN,BDATE,EDATE) ;look for Heart Failure Dx AND LVEF < 40%
+1 NEW FOUND,DXHF,PLHF,DX1,DX2,CEF,IEN,INV,MTYPE,RESULT,RDATE
+2 SET FOUND=0
SET DX1=0
SET DX2=0
SET CEF=0
+3 ;Check for the patient having a DX or Problem of Heart Failure (ever)
+4 SET DXHF=$$LASTDX^BGPMUUT2(DFN,BGPBIRTH,EDATE,"BGPMU HEART FAILURE DX")
+5 IF +DXHF
SET DX1=DXHF
+6 IF '$TEST
Begin DoDot:1
+7 SET PLHF=$$PLTAX^BGPMUUT1(DFN,"BGPMU HEART FAILURE DX","C",EDATE)
+8 IF +PLHF
SET DX1=PLHF
End DoDot:1
+9 IF DX1=0
QUIT 0
+10 ;Now check for LVEF < 40%
+11 ;S MTYP="" S MTYP=$O(^AUTTMSR("B","HT",MTYP)) ;ZSAT: for testing; delete this line, keep next line
+12 SET MTYP=""
SET MTYP=$ORDER(^AUTTMSR("B","CEF",MTYP))
+13 IF MTYP=""
QUIT 0
+14 SET INV=9999999-EDATE
+15 FOR
SET INV=$ORDER(^AUPNVMSR("AA",DFN,MTYP,INV))
IF '+INV!(+FOUND)
QUIT
Begin DoDot:1
+16 SET RDATE=9999999-INV
+17 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVMSR("AA",DFN,MTYP,INV,IEN))
IF IEN=""!(+FOUND)
QUIT
Begin DoDot:2
+18 SET FOUND=1
+19 SET RESULT=$PIECE($GET(^AUPNVMSR(IEN,0)),U,4)
+20 ;I RESULT<80 S CEF=1_U_U_RDATE ;ZSAT: testing; delete this line; keep next line
+21 IF RESULT<40
SET CEF=1_U_RESULT_U_RDATE
End DoDot:2
End DoDot:1
+22 IF +CEF
Begin DoDot:1
+23 SET FOUND=1_U_$PIECE(DX1,U,2)_U_$PIECE(DX1,U,3)_U_$PIECE(CEF,U,2)_U_$PIECE(CEF,U,3)
End DoDot:1
+24 QUIT FOUND
NUM(DFN,BGPBDATE,BGPEDATE) ;Look for Beta-blocker MED
+1 NEW FOUND,PMED
+2 SET FOUND=0
+3 SET PMED=$$FIND^BGPMUUT8(DFN,"BGPMU BETABLOCKER NDCS",BGPBDATE,"",BGPEDATE)
+4 IF +PMED
SET FOUND=1_U_$PIECE(PMED,U,2)_U_$PIECE(PMED,U,3)
+5 QUIT FOUND
EXCEPT(DFN,BDATE,EDATE) ;See if this patient has exceptions
+1 NEW RESULT,ARRY,HYPO,ASTHMA,BRADY,PACE,PACE2,AVBLOCK,MED
+2 SET RESULT=0
+3 ;Check for arrythmia
+4 SET ARRY=$$DXCK(DFN,"BGPMU ARRHYTHMIA DX",EDATE)
+5 IF +ARRY
SET RESULT=ARRY
QUIT RESULT
+6 ;Check for hypotension
+7 SET HYPO=$$DXCK(DFN,"BGPMU HYPOTENSION DX",EDATE)
+8 IF +HYPO
SET RESULT=HYPO
QUIT RESULT
+9 ;Check for asthma
+10 SET ASTHMA=$$DXCK(DFN,"BGPMU ASTHMA DX ICD",EDATE)
+11 IF +ASTHMA
SET RESULT=ASTHMA
QUIT RESULT
+12 ;Check for bradycardia
+13 SET BRADY=$$DXCK(DFN,"BGPMU BRADYCARDIA DX",EDATE)
+14 IF +BRADY
SET RESULT=BRADY
QUIT RESULT
+15 ;Check for av block and NOT on cardiac pacemaker
+16 SET AVBLOCK=$$DXCK(DFN,"BGPMU AV BLOCK DX",EDATE)
+17 IF +AVBLOCK
Begin DoDot:1
+18 SET PACE=$$LASTPRC^BGPMUUT2(DFN,"",BGPEDATE,"BGPMU CARDIAC PACER ICD0")
+19 SET PACE2=$$DXCK(DFN,"BGPMU CARDIAC PACER IN SITU DX",EDATE)
+20 IF +PACE=0&(+PACE2=0)
SET RESULT=AVBLOCK
End DoDot:1
IF +RESULT
QUIT RESULT
+21 ;Next check for allergy
+22 SET ALLER=$$ALLER^BGPMUA10("CV100","")
+23 IF +ALLER
SET RESULT=1_U_$PIECE(ALLER,U,1)
QUIT RESULT
+24 ;Check for refusal of Betablockers
+25 SET MED=$$MEDREF^BGPMUUT2(DFN,BDATE,EDATE_".2359","BGPMU BETABLOCKER NDCS")
+26 IF +MED
SET RESULT=MED
QUIT RESULT
+27 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
