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