BGPMUA11 ; IHS/MSC/MGH - MI measure NQF0074 ;13-Jul-2011 16:05;MGH
;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
;Code to collect meaningful use reports
ENTRY1 ;EP Entry point for NQA0074 for CAD and anti-lipid meds
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
..I +OUTENC!(+NFENC) 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) 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("BGPMU0074",$J,BGPMUTF,"TOT"))
S DENCT=+$G(^TMP("BGPMU0074",$J,BGPMUTF,"DEN"))
S NUMCT=+$G(^TMP("BGPMU0074",$J,BGPMUTF,"NUM"))
S EXCCT=+$G(^TMP("BGPMU0074",$J,BGPMUTF,"EXC"))
S NOTNUM=+$G(^TMP("BGPMU0074",$J,BGPMUTF,"NOT"))
S PTCNT=TOTALS
S PTCNT=PTCNT+1
S (DEN,DXTIME)=""
S DENCT=DENCT+1 S ^TMP("BGPMU0074",$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("BGPMU0074",$J,BGPMUTF,"EXC")=EXCCT
.I BGPMUTF="C" S ^TMP("BGPMU0074",$J,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DEN_U_"EXCLUDE"
I +NUM D
.S NUMCT=NUMCT+1 S ^TMP("BGPMU0074",$J,BGPMUTF,"NUM")=NUMCT
.I BGPMUTF="C" S ^TMP("BGPMU0074",$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("BGPMU0074",$J,BGPMUTF,"NOT")=NOTNUM
.I BGPMUTF="C" S ^TMP("BGPMU0074",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DEN_U_"NM:"_$P(NUM,U,2)
S ^TMP("BGPMU0074",$J,BGPMUTF,"TOT")=PTCNT
;Setup iCare array for patient
S BGPICARE("MU.EP.0074.1",BGPMUTF)=1_U_+NUM_U_+EXC_U_DEN_";"_$P(NUM,U,3)_";"_$P(NUM,U,2)
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,REF,ALLER,TAX,BGPR,VLABIEN,VALUE,LDL
S FOUND=0
;Check for LDL in 365 days before latest encounter date
S BGPYR=$$FMADD^XLFDT(CADDATE,-365)
S TAX="BGPMU LAB LOINC LDL"
S LDL=$$LOINC^BGPMUUT2(DFN,BGPYR,CADDATE,TAX)
I +LDL D
.S VLABIEN=$P(LDL,U,2)
.S VALUE=$P($G(^AUPNVLAB(VLABIEN,0)),U,4)
.I VALUE<130 S FOUND=1_U_VALUE_U_$P(LDL,U,1)
;Next check for allergy
S ALLER=$$ALLER^BGPMUA10("CV350","")
I +ALLER S FOUND=1_U_$P(ALLER,U,1)
;Check for refusals
S TAX="BGPMU LIPID LOWERING NDCS"
S REF=$$REF^BGPMUA10(.VIEN,TAX,BGPEDATE)
I +REF S FOUND=1_U_$P(REF,U,1)
Q FOUND
NUM1(DFN,BGPBDATE,BGPEDATE) ;check for meds in numerator
N FOUND,PMED
S FOUND=0
S PMED=$$FIND^BGPMUUT8(DFN,"BGPMU LIPID LOWERING NDCS",BGPBDATE,"",BGPEDATE)
I +PMED S FOUND=2_U_$P(PMED,U,2)_U_$P(PMED,U,3)
Q FOUND
BGPMUA11 ; IHS/MSC/MGH - MI measure NQF0074 ;13-Jul-2011 16:05;MGH
+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 NQA0074 for CAD and anti-lipid meds
+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 IF +OUTENC!(+NFENC)
Begin DoDot:3
+22 SET VDATE=$PIECE($GET(^AUPNVSIT(IEN,0)),U,1)
+23 SET CNT=CNT+1
+24 SET VIEN(CNT)=IEN_U_VDATE_U_$$DATE^BGPMUUTL(VDATE)
+25 SET STRING(CNT)=$$DATE^BGPMUUTL(VDATE)
End DoDot:3
End DoDot:2
End DoDot:1
+26 ;Next check to see if the patient is in the denominator
+27 ;Denominator is that the pt has DX of CAD or cardiac surgery before found visits
+28 IF OUTCT>1!(NFCT>1)
Begin DoDot:1
+29 SET CADDATE=$PIECE($PIECE($GET(VIEN(1)),U,2),".")
+30 SET CAD=$$CAD(DFN,CADDATE)
+31 IF +CAD
Begin DoDot:2
+32 ;If the patient had CAD, check to see if they are in the numerator
+33 SET NUM=$$NUM1(DFN,BGPBDATE,BGPEDATE)
+34 ;If not in the numerator,see if they are an exception
+35 IF +NUM=0
SET EXC=$$EXCEPT(.VIEN,DFN,CADDATE,BGPEDATE,CNT)
+36 DO TOTAL1(DFN,CAD,NUM,EXC)
End DoDot:2
End DoDot:1
+37 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("BGPMU0074",$JOB,BGPMUTF,"TOT"))
+3 SET DENCT=+$GET(^TMP("BGPMU0074",$JOB,BGPMUTF,"DEN"))
+4 SET NUMCT=+$GET(^TMP("BGPMU0074",$JOB,BGPMUTF,"NUM"))
+5 SET EXCCT=+$GET(^TMP("BGPMU0074",$JOB,BGPMUTF,"EXC"))
+6 SET NOTNUM=+$GET(^TMP("BGPMU0074",$JOB,BGPMUTF,"NOT"))
+7 SET PTCNT=TOTALS
+8 SET PTCNT=PTCNT+1
+9 SET (DEN,DXTIME)=""
+10 SET DENCT=DENCT+1
SET ^TMP("BGPMU0074",$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("BGPMU0074",$JOB,BGPMUTF,"EXC")=EXCCT
+16 IF BGPMUTF="C"
SET ^TMP("BGPMU0074",$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("BGPMU0074",$JOB,BGPMUTF,"NUM")=NUMCT
+19 IF BGPMUTF="C"
SET ^TMP("BGPMU0074",$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("BGPMU0074",$JOB,BGPMUTF,"NOT")=NOTNUM
+22 IF BGPMUTF="C"
SET ^TMP("BGPMU0074",$JOB,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DEN_U_"NM:"_$PIECE(NUM,U,2)
End DoDot:1
+23 SET ^TMP("BGPMU0074",$JOB,BGPMUTF,"TOT")=PTCNT
+24 ;Setup iCare array for patient
+25 SET BGPICARE("MU.EP.0074.1",BGPMUTF)=1_U_+NUM_U_+EXC_U_DEN_";"_$PIECE(NUM,U,3)_";"_$PIECE(NUM,U,2)
+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,REF,ALLER,TAX,BGPR,VLABIEN,VALUE,LDL
+2 SET FOUND=0
+3 ;Check for LDL in 365 days before latest encounter date
+4 SET BGPYR=$$FMADD^XLFDT(CADDATE,-365)
+5 SET TAX="BGPMU LAB LOINC LDL"
+6 SET LDL=$$LOINC^BGPMUUT2(DFN,BGPYR,CADDATE,TAX)
+7 IF +LDL
Begin DoDot:1
+8 SET VLABIEN=$PIECE(LDL,U,2)
+9 SET VALUE=$PIECE($GET(^AUPNVLAB(VLABIEN,0)),U,4)
+10 IF VALUE<130
SET FOUND=1_U_VALUE_U_$PIECE(LDL,U,1)
End DoDot:1
+11 ;Next check for allergy
+12 SET ALLER=$$ALLER^BGPMUA10("CV350","")
+13 IF +ALLER
SET FOUND=1_U_$PIECE(ALLER,U,1)
+14 ;Check for refusals
+15 SET TAX="BGPMU LIPID LOWERING NDCS"
+16 SET REF=$$REF^BGPMUA10(.VIEN,TAX,BGPEDATE)
+17 IF +REF
SET FOUND=1_U_$PIECE(REF,U,1)
+18 QUIT FOUND
NUM1(DFN,BGPBDATE,BGPEDATE) ;check for meds in numerator
+1 NEW FOUND,PMED
+2 SET FOUND=0
+3 SET PMED=$$FIND^BGPMUUT8(DFN,"BGPMU LIPID LOWERING NDCS",BGPBDATE,"",BGPEDATE)
+4 IF +PMED
SET FOUND=2_U_$PIECE(PMED,U,2)_U_$PIECE(PMED,U,3)
+5 QUIT FOUND
