BGP8EO11 ; IHS/CMI/LAB - calc measures 29 Apr 2008 7:38 PM 14 Nov 2006 5:02 PM 12 Nov 2007 11:03 AM ; 02 Jul 2008 9:26 AM
;;8.0;IHS CLINICAL REPORTING;**2**;MAR 12, 2008
;
;
ANTICOAG(P,BDATE,EDATE,BGPAD) ;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(V)_" MET: "_$P(C,U,2)_"^1"
I G]"" Q G
;now check for cpts
S G=$$CPTI^BGP8DU(P,EDATE,EDATE,+$$CODEN^ICPTCOD("4073F"),,,"1P;2P;8P")
I G Q $$DATE^BGP8UTL($P(G,U,2))_" MET: ANTI-PLT CPT [4073F]^1"
S G=$$CPTI^BGP8DU(P,EDATE,EDATE,+$$CODEN^ICPTCOD("4075F"),,,"1P;2P;8P")
I G Q $$DATE^BGP8UTL($P(G,U,2))_" MET: ANTI-PLT CPT [4075F]^1"
S G=$$CPTI^BGP8DU(P,EDATE,EDATE,+$$CODEN^ICPTCOD("G8006"))
I G Q $$DATE^BGP8UTL($P(G,U,2))_" MET: ANTI-PLT CPT [G8006]^1"
S G=$$TRANI^BGP8DU(P,EDATE,EDATE,+$$CODEN^ICPTCOD("4073F"))
I G Q $$DATE^BGP8UTL($P(G,U,2))_" MET: ANTI-PLT CPT/TRAN [4073F]^1"
S G=$$TRANI^BGP8DU(P,EDATE,EDATE,+$$CODEN^ICPTCOD("4075F"))
I G Q $$DATE^BGP8UTL($P(G,U,2))_" MET: ANTI-PLT CPT/TRAN [4075F]^1"
S G=$$TRANI^BGP8DU(P,EDATE,EDATE,+$$CODEN^ICPTCOD("G8006"))
I G Q $$DATE^BGP8UTL($P(G,U,2))_" MET: ANTI-PLT CPT/TRAN [G8006]^1"
;now go get refusals of any of the above
;
;refusal of MEDS
S T=$O(^ATXAX("B","BGP CMS WARFARIN MEDS",0))
S G=$$REFTAX^BGP8UTL1(P,50,T,EDATE,EDATE)
I G Q $$DATE^BGP8UTL(EDATE)_" NOT MET: REFUSAL WARF^2"
S T=$O(^ATXAX("B","DM AUDIT ANTI-PLATELET DRUGS",0))
S G=$$REFTAX^BGP8UTL1(P,50,T,EDATE,EDATE)
I G Q $$DATE^BGP8UTL(EDATE)_" NOT MET: REFUSAL ANTI-PLT^2"
S T=$O(^ATXAX("B","D AUDIT ASPIRIN DRUGS",0))
S G=$$REFTAX^BGP8UTL1(P,50,T,EDATE,EDATE)
I G Q $$DATE^BGP8UTL(EDATE)_" NOT MET: REFUSAL ASA^2"
;CHECK BL700 CLASS REFUSALS
S G=""
S I=0 F S I=$O(^AUPNPREF("AA",P,50,I)) Q:I=""!($P(G,U)) D
.S (X,G)=0 F S X=$O(^AUPNPREF("AA",P,50,I,X)) Q:X'=+X!($P(G,U)) S Y=0 F S Y=$O(^AUPNPREF("AA",P,50,I,X,Y)) Q:Y'=+Y S D=$P(^AUPNPREF(Y,0),U,3) I D=EDATE D
.Q:$P($G(^PSDRUG(I,0)),U,2)'="BL700"
.S G=$$DATE^BGP8UTL(EDATE)_" NOT MET: REFUSAL ANTI-PLT^2"
I G]"" Q G
S G=$$REFUSAL^BGP8UTL1(P,81,+$$CODEN^ICPTCOD("4073F"),EDATE,EDATE)
I G Q $$DATE^BGP8UTL(EDATE)_" NOT MET: REFUSAL ANTI-PLT [4073F]^2"
S G=$$REFUSAL^BGP8UTL1(P,81,+$$CODEN^ICPTCOD("4075F"),EDATE,EDATE)
I G Q $$DATE^BGP8UTL(EDATE)_" NOT MET: REFUSAL ANTI-PLT [4075F]^2"
S G=$$REFUSAL^BGP8UTL1(P,81,+$$CODEN^ICPTCOD("G8006"),EDATE,EDATE)
I G Q $$DATE^BGP8UTL(EDATE)_" NOT MET: REFUSAL ANTI-PLT [G8006]^2"
Q $$DATE^BGP8UTL(EDATE)_" NOT MET: NO THERAPY^3"
;
ANTIDRUG(N) ;
NEW G,T,I
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","DM AUDIT 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"
Q ""
BGP8EO11 ; IHS/CMI/LAB - calc measures 29 Apr 2008 7:38 PM 14 Nov 2006 5:02 PM 12 Nov 2007 11:03 AM ; 02 Jul 2008 9:26 AM
+1 ;;8.0;IHS CLINICAL REPORTING;**2**;MAR 12, 2008
+2 ;
+3 ;
ANTICOAG(P,BDATE,EDATE,BGPAD) ;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 ;discontinued before discharge date
IF $PIECE(^AUPNVMED(N,0),U,8)]""
IF $PIECE(^AUPNVMED(N,0),U,8)'>EDATE
QUIT
+9 SET S=$PIECE(^AUPNVMED(N,0),U,7)
+10 ;PRESCRIBED ON DISCHARGE DATE
IF $PIECE($PIECE(^AUPNVSIT($PIECE(^AUPNVMED(N,0),U,3),0),U),".")=EDATE
SET G=$$DATE^BGP8UTL(EDATE)_" MET: "_$PIECE(C,U,2)_"^1"
+11 SET V=$PIECE(^AUPNVMED(N,0),U,3)
+12 SET V=$PIECE($PIECE(^AUPNVSIT(V,0),U),".")
+13 ;not valid through discharge date
IF $$FMADD^XLFDT(V,S)<EDATE
QUIT
+14 SET G=$$DATE^BGP8UTL(V)_" MET: "_$PIECE(C,U,2)_"^1"
End DoDot:1
+15 IF G]""
QUIT G
+16 ;now check for cpts
+17 SET G=$$CPTI^BGP8DU(P,EDATE,EDATE,+$$CODEN^ICPTCOD("4073F"),,,"1P;2P;8P")
+18 IF G
QUIT $$DATE^BGP8UTL($PIECE(G,U,2))_" MET: ANTI-PLT CPT [4073F]^1"
+19 SET G=$$CPTI^BGP8DU(P,EDATE,EDATE,+$$CODEN^ICPTCOD("4075F"),,,"1P;2P;8P")
+20 IF G
QUIT $$DATE^BGP8UTL($PIECE(G,U,2))_" MET: ANTI-PLT CPT [4075F]^1"
+21 SET G=$$CPTI^BGP8DU(P,EDATE,EDATE,+$$CODEN^ICPTCOD("G8006"))
+22 IF G
QUIT $$DATE^BGP8UTL($PIECE(G,U,2))_" MET: ANTI-PLT CPT [G8006]^1"
+23 SET G=$$TRANI^BGP8DU(P,EDATE,EDATE,+$$CODEN^ICPTCOD("4073F"))
+24 IF G
QUIT $$DATE^BGP8UTL($PIECE(G,U,2))_" MET: ANTI-PLT CPT/TRAN [4073F]^1"
+25 SET G=$$TRANI^BGP8DU(P,EDATE,EDATE,+$$CODEN^ICPTCOD("4075F"))
+26 IF G
QUIT $$DATE^BGP8UTL($PIECE(G,U,2))_" MET: ANTI-PLT CPT/TRAN [4075F]^1"
+27 SET G=$$TRANI^BGP8DU(P,EDATE,EDATE,+$$CODEN^ICPTCOD("G8006"))
+28 IF G
QUIT $$DATE^BGP8UTL($PIECE(G,U,2))_" MET: ANTI-PLT CPT/TRAN [G8006]^1"
+29 ;now go get refusals of any of the above
+30 ;
+31 ;refusal of MEDS
+32 SET T=$ORDER(^ATXAX("B","BGP CMS WARFARIN MEDS",0))
+33 SET G=$$REFTAX^BGP8UTL1(P,50,T,EDATE,EDATE)
+34 IF G
QUIT $$DATE^BGP8UTL(EDATE)_" NOT MET: REFUSAL WARF^2"
+35 SET T=$ORDER(^ATXAX("B","DM AUDIT ANTI-PLATELET DRUGS",0))
+36 SET G=$$REFTAX^BGP8UTL1(P,50,T,EDATE,EDATE)
+37 IF G
QUIT $$DATE^BGP8UTL(EDATE)_" NOT MET: REFUSAL ANTI-PLT^2"
+38 SET T=$ORDER(^ATXAX("B","D AUDIT ASPIRIN DRUGS",0))
+39 SET G=$$REFTAX^BGP8UTL1(P,50,T,EDATE,EDATE)
+40 IF G
QUIT $$DATE^BGP8UTL(EDATE)_" NOT MET: REFUSAL ASA^2"
+41 ;CHECK BL700 CLASS REFUSALS
+42 SET G=""
+43 SET I=0
FOR
SET I=$ORDER(^AUPNPREF("AA",P,50,I))
IF I=""!($PIECE(G,U))
QUIT
Begin DoDot:1
+44 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNPREF("AA",P,50,I,X))
IF X'=+X!($PIECE(G,U))
QUIT
SET Y=0
FOR
SET Y=$ORDER(^AUPNPREF("AA",P,50,I,X,Y))
IF Y'=+Y
QUIT
SET D=$PIECE(^AUPNPREF(Y,0),U,3)
IF D=EDATE
Begin DoDot:2
End DoDot:2
+45 IF $PIECE($GET(^PSDRUG(I,0)),U,2)'="BL700"
QUIT
+46 SET G=$$DATE^BGP8UTL(EDATE)_" NOT MET: REFUSAL ANTI-PLT^2"
End DoDot:1
+47 IF G]""
QUIT G
+48 SET G=$$REFUSAL^BGP8UTL1(P,81,+$$CODEN^ICPTCOD("4073F"),EDATE,EDATE)
+49 IF G
QUIT $$DATE^BGP8UTL(EDATE)_" NOT MET: REFUSAL ANTI-PLT [4073F]^2"
+50 SET G=$$REFUSAL^BGP8UTL1(P,81,+$$CODEN^ICPTCOD("4075F"),EDATE,EDATE)
+51 IF G
QUIT $$DATE^BGP8UTL(EDATE)_" NOT MET: REFUSAL ANTI-PLT [4075F]^2"
+52 SET G=$$REFUSAL^BGP8UTL1(P,81,+$$CODEN^ICPTCOD("G8006"),EDATE,EDATE)
+53 IF G
QUIT $$DATE^BGP8UTL(EDATE)_" NOT MET: REFUSAL ANTI-PLT [G8006]^2"
+54 QUIT $$DATE^BGP8UTL(EDATE)_" NOT MET: NO THERAPY^3"
+55 ;
ANTIDRUG(N) ;
+1 NEW G,T,I
+2 SET I=$PIECE($GET(^AUPNVMED(N,0)),U)
+3 IF 'I
QUIT 0
+4 SET G=0
+5 SET T=$ORDER(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))
+6 IF T
IF $DATA(^ATXAX(T,21,"B",I))
QUIT "1^ASA"
+7 SET T=$ORDER(^ATXAX("B","BGP CMS WARFARIN MEDS",0))
+8 IF T
IF $DATA(^ATXAX(T,21,"B",I))
QUIT "1^WARF"
+9 SET T=$ORDER(^ATXAX("B","DM AUDIT ANTI-PLATELET DRUGS",0))
+10 IF T
IF $DATA(^ATXAX(T,21,"B",I))
QUIT "1^ANTI-PLT"
+11 SET G=$PIECE(^PSDRUG(I,0),U,2)
+12 IF G="BL700"
QUIT "1^ANTI-PLT"
+13 IF $PIECE(^PSDRUG(I,0),U)["WARFARIN"
QUIT "1^WARF"
+14 QUIT ""
