- 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 ""
