BGP8D91 ;IHS/CMI/LAB - MEASURE LOGIC;
;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
;
EOST ;
NEW BGPOXV,BGPD,BGPN
K BGPOXV
I 'BGPACTUP S BGPSTOP=1 Q ;no active user pop
I BGPAGEB<18 S BGPSTOP=1 Q ;don't process this measure, pt under 18
S BGPD1=0
S BGPN1=0,BGPVALUE=""
S BGPTIA=$$TIAFIB(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE) ;RETURN DATE OF DX
I 'BGPTIA Q ;no tia dx ever
;now evaluate result
S BGPD1=1
S BGPTHER=$$ANTICOAG(DFN,BGPBDATE,BGPEDATE) ;DATE DRUG
I BGPTHER]"" S BGPN1=1
;
S BGPVALUE="UP"_"|||"_"DX: "_$$DATE^BGP8UTL(BGPTIA)_" THERAPY: "_$S(BGPTHER]"":BGPTHER,1:"None")
Q
;
TIAFIB(P,BDATE,EDATE) ;EP
NEW A,X,V,BGPG,G,C,T,B,E,BGPX,BGPV,BGPD
K BGPR,BGPG,BGPX
S BGPR="",BGPR(0)=""
S X=P_"^ALL DX [BGP TIA DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,"BGPG(")
I '$D(BGPG(1)) Q "" ;NO TIA
;now go through and get rid of H and CHS
S X=0,G=0 F S X=$O(BGPG(X)) Q:X'=+X!(G) D
.S V=$P(BGPG(X),U,5) ;visit ien
.;is there a atrial fib on this visit
.S Y=0 F S Y=$O(^AUPNVPOV("AD",V,Y)) Q:Y'=+Y D
..S C=$P($G(^AUPNVPOV(Y,0)),U)
..Q:C=""
..I $$ICD^BGP8UTL2(C,$O(^ATXAX("B","BGP ATRIAL FIBRILLATION DXS",0)),9) S G=$$VD^APCLV(V)
I 'G Q "" ;;NO DX
Q G
ANTICOAG(P,BDATE,EDATE) ;EP - was there ANTICOAG
NEW BGPD,X,N,E,Y,T,D,C,BGPLT,L,J,BGPG,S
K BGPG S Y="BGPG(",X=P_"^ALL MED;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
S X=0,G="" F S X=$O(BGPG(X)) Q:X'=+X!(G]"") D
.S N=+$P(BGPG(X),U,4) ;ien of v med
.S C=$$ANTIDRUG(N) ;not one of the drugs
.Q:'$P(C,U)
.;c=1^category of drug
.;I $P(^AUPNVMED(N,0),U,8)]"",$P(^AUPNVMED(N,0),U,8)'>EDATE Q ;discontinued before discharge date
.;S S=$P(^AUPNVMED(N,0),U,7)
.;I $P($P(^AUPNVSIT($P(^AUPNVMED(N,0),U,3),0),U),".")=EDATE S G=$$DATE^BGP8UTL(EDATE)_" MET: "_$P(C,U,2)_"^1" ;PRESCRIBED ON DISCHARGE DATE
.;S V=$P(^AUPNVMED(N,0),U,3)
.;S V=$P($P(^AUPNVSIT(V,0),U),".")
.;I $$FMADD^XLFDT(V,S)<EDATE Q ;not valid through discharge date
.S G=$$DATE^BGP8UTL($P(BGPG(X),U,1))_" "_$P(C,U,2)
I G]"" Q G
Q ""
;
ANTIDRUG(N) ;
NEW G,T,I
I '$D(^AUPNVMED(N,0)) Q 0
I $$UP^XLFSTR($P($G(^AUPNVMED(N,11)),U))["RETURNED TO STOCK" Q 0
S I=$P($G(^AUPNVMED(N,0)),U)
I 'I Q 0
S G=0
S T=$O(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))
I T,$D(^ATXAX(T,21,"B",I)) Q "1^ASA"
S T=$O(^ATXAX("B","BGP CMS WARFARIN MEDS",0))
I T,$D(^ATXAX(T,21,"B",I)) Q "1^WARF"
S T=$O(^ATXAX("B","BGP ANTI-PLATELET DRUGS",0))
I T,$D(^ATXAX(T,21,"B",I)) Q "1^ANTI-PLT"
S G=$P(^PSDRUG(I,0),U,2)
I G="BL700" Q "1^ANTI-PLT"
I $P(^PSDRUG(I,0),U)["WARFARIN" Q "1^WARF"
I $$VAPI^BGP8D81(I,$O(^ATXAX("B","BGP CMS WARFARIN VAPI",0))) Q "1^WARF"
Q ""
BGP8D91 ;IHS/CMI/LAB - MEASURE LOGIC;
+1 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
+2 ;
EOST ;
+1 NEW BGPOXV,BGPD,BGPN
+2 KILL BGPOXV
+3 ;no active user pop
IF 'BGPACTUP
SET BGPSTOP=1
QUIT
+4 ;don't process this measure, pt under 18
IF BGPAGEB<18
SET BGPSTOP=1
QUIT
+5 SET BGPD1=0
+6 SET BGPN1=0
SET BGPVALUE=""
+7 ;RETURN DATE OF DX
SET BGPTIA=$$TIAFIB(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
+8 ;no tia dx ever
IF 'BGPTIA
QUIT
+9 ;now evaluate result
+10 SET BGPD1=1
+11 ;DATE DRUG
SET BGPTHER=$$ANTICOAG(DFN,BGPBDATE,BGPEDATE)
+12 IF BGPTHER]""
SET BGPN1=1
+13 ;
+14 SET BGPVALUE="UP"_"|||"_"DX: "_$$DATE^BGP8UTL(BGPTIA)_" THERAPY: "_$SELECT(BGPTHER]"":BGPTHER,1:"None")
+15 QUIT
+16 ;
TIAFIB(P,BDATE,EDATE) ;EP
+1 NEW A,X,V,BGPG,G,C,T,B,E,BGPX,BGPV,BGPD
+2 KILL BGPR,BGPG,BGPX
+3 SET BGPR=""
SET BGPR(0)=""
+4 SET X=P_"^ALL DX [BGP TIA DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,"BGPG(")
+5 ;NO TIA
IF '$DATA(BGPG(1))
QUIT ""
+6 ;now go through and get rid of H and CHS
+7 SET X=0
SET G=0
FOR
SET X=$ORDER(BGPG(X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+8 ;visit ien
SET V=$PIECE(BGPG(X),U,5)
+9 ;is there a atrial fib on this visit
+10 SET Y=0
FOR
SET Y=$ORDER(^AUPNVPOV("AD",V,Y))
IF Y'=+Y
QUIT
Begin DoDot:2
+11 SET C=$PIECE($GET(^AUPNVPOV(Y,0)),U)
+12 IF C=""
QUIT
+13 IF $$ICD^BGP8UTL2(C,$ORDER(^ATXAX("B","BGP ATRIAL FIBRILLATION DXS",0)),9)
SET G=$$VD^APCLV(V)
End DoDot:2
End DoDot:1
+14 ;;NO DX
IF 'G
QUIT ""
+15 QUIT G
ANTICOAG(P,BDATE,EDATE) ;EP - was there ANTICOAG
+1 NEW BGPD,X,N,E,Y,T,D,C,BGPLT,L,J,BGPG,S
+2 KILL BGPG
SET Y="BGPG("
SET X=P_"^ALL MED;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+3 SET X=0
SET G=""
FOR
SET X=$ORDER(BGPG(X))
IF X'=+X!(G]"")
QUIT
Begin DoDot:1
+4 ;ien of v med
SET N=+$PIECE(BGPG(X),U,4)
+5 ;not one of the drugs
SET C=$$ANTIDRUG(N)
+6 IF '$PIECE(C,U)
QUIT
+7 ;c=1^category of drug
+8 ;I $P(^AUPNVMED(N,0),U,8)]"",$P(^AUPNVMED(N,0),U,8)'>EDATE Q ;discontinued before discharge date
+9 ;S S=$P(^AUPNVMED(N,0),U,7)
+10 ;I $P($P(^AUPNVSIT($P(^AUPNVMED(N,0),U,3),0),U),".")=EDATE S G=$$DATE^BGP8UTL(EDATE)_" MET: "_$P(C,U,2)_"^1" ;PRESCRIBED ON DISCHARGE DATE
+11 ;S V=$P(^AUPNVMED(N,0),U,3)
+12 ;S V=$P($P(^AUPNVSIT(V,0),U),".")
+13 ;I $$FMADD^XLFDT(V,S)<EDATE Q ;not valid through discharge date
+14 SET G=$$DATE^BGP8UTL($PIECE(BGPG(X),U,1))_" "_$PIECE(C,U,2)
End DoDot:1
+15 IF G]""
QUIT G
+16 QUIT ""
+17 ;
ANTIDRUG(N) ;
+1 NEW G,T,I
+2 IF '$DATA(^AUPNVMED(N,0))
QUIT 0
+3 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(N,11)),U))["RETURNED TO STOCK"
QUIT 0
+4 SET I=$PIECE($GET(^AUPNVMED(N,0)),U)
+5 IF 'I
QUIT 0
+6 SET G=0
+7 SET T=$ORDER(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))
+8 IF T
IF $DATA(^ATXAX(T,21,"B",I))
QUIT "1^ASA"
+9 SET T=$ORDER(^ATXAX("B","BGP CMS WARFARIN MEDS",0))
+10 IF T
IF $DATA(^ATXAX(T,21,"B",I))
QUIT "1^WARF"
+11 SET T=$ORDER(^ATXAX("B","BGP ANTI-PLATELET DRUGS",0))
+12 IF T
IF $DATA(^ATXAX(T,21,"B",I))
QUIT "1^ANTI-PLT"
+13 SET G=$PIECE(^PSDRUG(I,0),U,2)
+14 IF G="BL700"
QUIT "1^ANTI-PLT"
+15 IF $PIECE(^PSDRUG(I,0),U)["WARFARIN"
QUIT "1^WARF"
+16 IF $$VAPI^BGP8D81(I,$ORDER(^ATXAX("B","BGP CMS WARFARIN VAPI",0)))
QUIT "1^WARF"
+17 QUIT ""
