BGPMUA05 ; IHS/MSC/MGH - MI measure NQF0013 ;22-Mar-2011 10:16;DU
;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
;Code to collect meaningful use report for hypertension and BP reading
ENTRY ;EP
N START,END,BGPNUM,BGPDEN,AENC,BENC,STRING,STRING1,STRING2,BGPHYPER,BGPHYPL
N IEN,INV,VISIT,WTIEN,DATA,VDATE,VALUE,EXCEPT,FIRST,REF,VIEN,EXCEPT,RESULT
N BGPN1,BGPN3,RETVAL,BGPBII,BGPUNII,BGPMAS,AENC,BENC,CENC,CNT
N BGPENC,ENSTRING,BGPBIRTH,BGPHYS2,BGPHYS1,BGPHYS3,BGPHYS4
S (BGPDEN,NUM,RESULT)=0
S START=9999999-BGPBDATE,END=9999999-BGPEDATE,VALUE=0
S RETVAL="" ;Return value
S (STRING,STRING2)=""
;Pts must be >18
;No need to check further if no age match
Q:BGPAGEE<18
S CNT=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)
..;If the right provider, check and see if an appropriate CPT code exists
..S AENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU BP EM")
..S BENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU NURSING FAC EM")
..I (+AENC=1)!(+BENC=1) D
...S CNT=CNT+1
...S VDATE=$P($G(^AUPNVSIT(IEN,0)),U,1)
...S VIEN(CNT)=IEN_U_VDATE
I CNT>1 D
.;Patient Must have active DX of hypertension, EVER
.;Check POV codes
.S (STRING1,STRING2,ENSTRING)=""
.S BGPBIRTH=$P(^DPT(DFN,0),U,3)
.S BGPHYPER=$$LASTDX^BGPMUUT2(DFN,BGPBIRTH,BGPBDATE,"BGPMU HYPERTENSION DX")
.I +BGPHYPER S VALUE=1,STRING1=$P(BGPHYPER,U,2)_" "_$$DATE^BGPMUUTL($P(BGPHYPER,U,3))
.;Check problem list
.N PDATE
.S BGPHYPL=$$PLTAX^BGPMUUT1(DFN,"BGPMU HYPERTENSION DX","C")
.I +BGPHYPL D
..S PDATE=$P(BGPHYPL,U,3)
..I PDATE<BGPBDATE S VALUE=1,STRING2=$P(BGPHYPL,U,2)_" "_$$DATE^BGPMUUTL($P(BGPHYPL,U,3))
.;Patient has hypertension and 2 or more visits, now check for BP
.I +VALUE D
..I STRING2'="" S ENSTRING=STRING2
..I STRING1'="" S ENSTRING=STRING1
..D BP(DFN,CNT,.ENSTRING,.VIEN,.BGPNUM)
..D TOTAL(DFN,ENSTRING,BGPNUM)
Q
BP(DFN,CNT,ENSTRING,VIEN,NUM) ;Find is pt has a BP on the chosen visits
N IEN,MSR,MTYP,BP,BPCNT,SAVE,ARRAY,VST,VCNT
S BP="",BPCNT=0,VCNT=0
S MTYP="" S MTYP=$O(^AUTTMSR("B","BP",MTYP))
Q:MTYP="" 0
S NUM=0 F S NUM=$O(VIEN(NUM)) Q:NUM=""!(BPCNT>1) D
.S IEN=$P(VIEN(NUM),U,1),SAVE=0
.S MSR="" F S MSR=$O(^AUPNVMSR("AD",IEN,MSR)) Q:MSR=""!(+SAVE) D
..I $P($G(^AUPNVMSR(MSR,0)),U,1)=MTYP D
...S BPCNT=BPCNT+1,SAVE=1
...S ARRAY(IEN)=""
...I BPCNT=1 S BP="BP:"_$P($G(^AUPNVMSR(MSR,0)),U,4)_" "_$$DATE^BGPMUUTL($P($G(^AUPNVMSR(MSR,12)),U,1))
...I BPCNT=2 S BP=BP_";BP:"_$P($G(^AUPNVMSR(MSR,0)),U,4)_" "_$$DATE^BGPMUUTL($P($G(^AUPNVMSR(MSR,12)),U,1))
...S ENSTRING=ENSTRING_";EN:"_$$DATE^BGPMUUTL($P(VIEN(NUM),U,2))
I BPCNT=2 S NUM=1_U_"M:"_BP
I BPCNT<2 D
.S NUM=0_U_"NM:"_BP
.N CNT
.I BPCNT=1 D
..S CNT=1
..S VST=0 F S VST=$O(VIEN(VST)) Q:VST=""!(CNT>1) D
...S IEN=$P(VIEN(VST),U,1)
...I '$D(ARRAY(IEN)) D
....S CNT=CNT+1
....S ENSTRING=ENSTRING_";EN:"_$$DATE^BGPMUUTL($P(VIEN(VST),U,2))
.I BPCNT=0 D
..S CNT=0
..S VST=0 F S VST=$O(VIEN(VST)) Q:VST=""!(CNT>1) D
...S IEN=$P(VIEN(VST),U,1)
...S CNT=CNT+1
...S ENSTRING=ENSTRING_";EN:"_$$DATE^BGPMUUTL($P(VIEN(VST),U,2))
Q
TOTAL(DFN,ENSTRING,BGPNUM) ;See where this patient ends up
N PTCNT,EXCCT,DENCT,NUMCT,TOTALS,NOTCT
S TOTALS=$G(^TMP("BGPMU0013",$J,BGPMUTF,"TOT"))
S DENCT=+$G(^TMP("BGPMU0013",$J,BGPMUTF,"DEN"))
S NUMCT=+$G(^TMP("BGPMU0013",$J,BGPMUTF,"NUM"))
S NOTCT=+$G(^TMP("BGPMU0013",$J,BGPMUTF,"NOT"))
S PTCNT=TOTALS
S PTCNT=PTCNT+1
S DENCT=DENCT+1 S ^TMP("BGPMU0013",$J,BGPMUTF,"DEN")=DENCT
I +BGPNUM D
.S NUMCT=NUMCT+1 S ^TMP("BGPMU0013",$J,BGPMUTF,"NUM")=NUMCT
.I BGPMUTF="C" S ^TMP("BGPMU0013",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_ENSTRING_U_$P(BGPNUM,U,2)
I '+BGPNUM D
.S NOTCT=NOTCT+1 S ^TMP("BGPMU0013",$J,BGPMUTF,"NOT")=NOTCT
.I BGPMUTF="C" S ^TMP("BGPMU0013",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_ENSTRING_U_$P(BGPNUM,U,2)
S ^TMP("BGPMU0013",$J,BGPMUTF,"TOT")=PTCNT
;Setup iCare array for patient
S BGPICARE("MU.EP.0013.1",BGPMUTF)=1_U_+BGPNUM_U_""_U_$G(ENSTRING)_";"_$P(BGPNUM,U,2)
Q
BGPMUA05 ; IHS/MSC/MGH - MI measure NQF0013 ;22-Mar-2011 10:16;DU
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
+2 ;Code to collect meaningful use report for hypertension and BP reading
ENTRY ;EP
+1 NEW START,END,BGPNUM,BGPDEN,AENC,BENC,STRING,STRING1,STRING2,BGPHYPER,BGPHYPL
+2 NEW IEN,INV,VISIT,WTIEN,DATA,VDATE,VALUE,EXCEPT,FIRST,REF,VIEN,EXCEPT,RESULT
+3 NEW BGPN1,BGPN3,RETVAL,BGPBII,BGPUNII,BGPMAS,AENC,BENC,CENC,CNT
+4 NEW BGPENC,ENSTRING,BGPBIRTH,BGPHYS2,BGPHYS1,BGPHYS3,BGPHYS4
+5 SET (BGPDEN,NUM,RESULT)=0
+6 SET START=9999999-BGPBDATE
SET END=9999999-BGPEDATE
SET VALUE=0
+7 ;Return value
SET RETVAL=""
+8 SET (STRING,STRING2)=""
+9 ;Pts must be >18
+10 ;No need to check further if no age match
+11 IF BGPAGEE<18
QUIT
+12 SET CNT=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 ;If the right provider, check and see if an appropriate CPT code exists
+18 SET AENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU BP EM")
+19 SET BENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU NURSING FAC EM")
+20 IF (+AENC=1)!(+BENC=1)
Begin DoDot:3
+21 SET CNT=CNT+1
+22 SET VDATE=$PIECE($GET(^AUPNVSIT(IEN,0)),U,1)
+23 SET VIEN(CNT)=IEN_U_VDATE
End DoDot:3
End DoDot:2
End DoDot:1
+24 IF CNT>1
Begin DoDot:1
+25 ;Patient Must have active DX of hypertension, EVER
+26 ;Check POV codes
+27 SET (STRING1,STRING2,ENSTRING)=""
+28 SET BGPBIRTH=$PIECE(^DPT(DFN,0),U,3)
+29 SET BGPHYPER=$$LASTDX^BGPMUUT2(DFN,BGPBIRTH,BGPBDATE,"BGPMU HYPERTENSION DX")
+30 IF +BGPHYPER
SET VALUE=1
SET STRING1=$PIECE(BGPHYPER,U,2)_" "_$$DATE^BGPMUUTL($PIECE(BGPHYPER,U,3))
+31 ;Check problem list
+32 NEW PDATE
+33 SET BGPHYPL=$$PLTAX^BGPMUUT1(DFN,"BGPMU HYPERTENSION DX","C")
+34 IF +BGPHYPL
Begin DoDot:2
+35 SET PDATE=$PIECE(BGPHYPL,U,3)
+36 IF PDATE<BGPBDATE
SET VALUE=1
SET STRING2=$PIECE(BGPHYPL,U,2)_" "_$$DATE^BGPMUUTL($PIECE(BGPHYPL,U,3))
End DoDot:2
+37 ;Patient has hypertension and 2 or more visits, now check for BP
+38 IF +VALUE
Begin DoDot:2
+39 IF STRING2'=""
SET ENSTRING=STRING2
+40 IF STRING1'=""
SET ENSTRING=STRING1
+41 DO BP(DFN,CNT,.ENSTRING,.VIEN,.BGPNUM)
+42 DO TOTAL(DFN,ENSTRING,BGPNUM)
End DoDot:2
End DoDot:1
+43 QUIT
BP(DFN,CNT,ENSTRING,VIEN,NUM) ;Find is pt has a BP on the chosen visits
+1 NEW IEN,MSR,MTYP,BP,BPCNT,SAVE,ARRAY,VST,VCNT
+2 SET BP=""
SET BPCNT=0
SET VCNT=0
+3 SET MTYP=""
SET MTYP=$ORDER(^AUTTMSR("B","BP",MTYP))
+4 IF MTYP=""
QUIT 0
+5 SET NUM=0
FOR
SET NUM=$ORDER(VIEN(NUM))
IF NUM=""!(BPCNT>1)
QUIT
Begin DoDot:1
+6 SET IEN=$PIECE(VIEN(NUM),U,1)
SET SAVE=0
+7 SET MSR=""
FOR
SET MSR=$ORDER(^AUPNVMSR("AD",IEN,MSR))
IF MSR=""!(+SAVE)
QUIT
Begin DoDot:2
+8 IF $PIECE($GET(^AUPNVMSR(MSR,0)),U,1)=MTYP
Begin DoDot:3
+9 SET BPCNT=BPCNT+1
SET SAVE=1
+10 SET ARRAY(IEN)=""
+11 IF BPCNT=1
SET BP="BP:"_$PIECE($GET(^AUPNVMSR(MSR,0)),U,4)_" "_$$DATE^BGPMUUTL($PIECE($GET(^AUPNVMSR(MSR,12)),U,1))
+12 IF BPCNT=2
SET BP=BP_";BP:"_$PIECE($GET(^AUPNVMSR(MSR,0)),U,4)_" "_$$DATE^BGPMUUTL($PIECE($GET(^AUPNVMSR(MSR,12)),U,1))
+13 SET ENSTRING=ENSTRING_";EN:"_$$DATE^BGPMUUTL($PIECE(VIEN(NUM),U,2))
End DoDot:3
End DoDot:2
End DoDot:1
+14 IF BPCNT=2
SET NUM=1_U_"M:"_BP
+15 IF BPCNT<2
Begin DoDot:1
+16 SET NUM=0_U_"NM:"_BP
+17 NEW CNT
+18 IF BPCNT=1
Begin DoDot:2
+19 SET CNT=1
+20 SET VST=0
FOR
SET VST=$ORDER(VIEN(VST))
IF VST=""!(CNT>1)
QUIT
Begin DoDot:3
+21 SET IEN=$PIECE(VIEN(VST),U,1)
+22 IF '$DATA(ARRAY(IEN))
Begin DoDot:4
+23 SET CNT=CNT+1
+24 SET ENSTRING=ENSTRING_";EN:"_$$DATE^BGPMUUTL($PIECE(VIEN(VST),U,2))
End DoDot:4
End DoDot:3
End DoDot:2
+25 IF BPCNT=0
Begin DoDot:2
+26 SET CNT=0
+27 SET VST=0
FOR
SET VST=$ORDER(VIEN(VST))
IF VST=""!(CNT>1)
QUIT
Begin DoDot:3
+28 SET IEN=$PIECE(VIEN(VST),U,1)
+29 SET CNT=CNT+1
+30 SET ENSTRING=ENSTRING_";EN:"_$$DATE^BGPMUUTL($PIECE(VIEN(VST),U,2))
End DoDot:3
End DoDot:2
End DoDot:1
+31 QUIT
TOTAL(DFN,ENSTRING,BGPNUM) ;See where this patient ends up
+1 NEW PTCNT,EXCCT,DENCT,NUMCT,TOTALS,NOTCT
+2 SET TOTALS=$GET(^TMP("BGPMU0013",$JOB,BGPMUTF,"TOT"))
+3 SET DENCT=+$GET(^TMP("BGPMU0013",$JOB,BGPMUTF,"DEN"))
+4 SET NUMCT=+$GET(^TMP("BGPMU0013",$JOB,BGPMUTF,"NUM"))
+5 SET NOTCT=+$GET(^TMP("BGPMU0013",$JOB,BGPMUTF,"NOT"))
+6 SET PTCNT=TOTALS
+7 SET PTCNT=PTCNT+1
+8 SET DENCT=DENCT+1
SET ^TMP("BGPMU0013",$JOB,BGPMUTF,"DEN")=DENCT
+9 IF +BGPNUM
Begin DoDot:1
+10 SET NUMCT=NUMCT+1
SET ^TMP("BGPMU0013",$JOB,BGPMUTF,"NUM")=NUMCT
+11 IF BGPMUTF="C"
SET ^TMP("BGPMU0013",$JOB,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_ENSTRING_U_$PIECE(BGPNUM,U,2)
End DoDot:1
+12 IF '+BGPNUM
Begin DoDot:1
+13 SET NOTCT=NOTCT+1
SET ^TMP("BGPMU0013",$JOB,BGPMUTF,"NOT")=NOTCT
+14 IF BGPMUTF="C"
SET ^TMP("BGPMU0013",$JOB,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_ENSTRING_U_$PIECE(BGPNUM,U,2)
End DoDot:1
+15 SET ^TMP("BGPMU0013",$JOB,BGPMUTF,"TOT")=PTCNT
+16 ;Setup iCare array for patient
+17 SET BGPICARE("MU.EP.0013.1",BGPMUTF)=1_U_+BGPNUM_U_""_U_$GET(ENSTRING)_";"_$PIECE(BGPNUM,U,2)
+18 QUIT
