Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGP8EO11

BGP8EO11.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;
  1. ANTICOAG(P,BDATE,EDATE,BGPAD) ;EP - was there ANTICOAG
  1. NEW BGPD,X,N,E,Y,T,D,C,BGPLT,L,J,BGPG,S
  1. K BGPG S Y="BGPG(",X=P_"^ALL MED;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  1. S X=0,G="" F S X=$O(BGPG(X)) Q:X'=+X!(G]"") D
  1. .S N=+$P(BGPG(X),U,4) ;ien of v med
  1. .S C=$$ANTIDRUG(N) ;not one of the drugs
  1. .Q:'$P(C,U)
  1. .;c=1^category of drug
  1. .I $P(^AUPNVMED(N,0),U,8)]"",$P(^AUPNVMED(N,0),U,8)'>EDATE Q ;discontinued before discharge date
  1. .S S=$P(^AUPNVMED(N,0),U,7)
  1. .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
  1. .S V=$P(^AUPNVMED(N,0),U,3)
  1. .S V=$P($P(^AUPNVSIT(V,0),U),".")
  1. .I $$FMADD^XLFDT(V,S)<EDATE Q ;not valid through discharge date
  1. .S G=$$DATE^BGP8UTL(V)_" MET: "_$P(C,U,2)_"^1"
  1. I G]"" Q G
  1. ;now check for cpts
  1. S G=$$CPTI^BGP8DU(P,EDATE,EDATE,+$$CODEN^ICPTCOD("4073F"),,,"1P;2P;8P")
  1. I G Q $$DATE^BGP8UTL($P(G,U,2))_" MET: ANTI-PLT CPT [4073F]^1"
  1. S G=$$CPTI^BGP8DU(P,EDATE,EDATE,+$$CODEN^ICPTCOD("4075F"),,,"1P;2P;8P")
  1. I G Q $$DATE^BGP8UTL($P(G,U,2))_" MET: ANTI-PLT CPT [4075F]^1"
  1. S G=$$CPTI^BGP8DU(P,EDATE,EDATE,+$$CODEN^ICPTCOD("G8006"))
  1. I G Q $$DATE^BGP8UTL($P(G,U,2))_" MET: ANTI-PLT CPT [G8006]^1"
  1. S G=$$TRANI^BGP8DU(P,EDATE,EDATE,+$$CODEN^ICPTCOD("4073F"))
  1. I G Q $$DATE^BGP8UTL($P(G,U,2))_" MET: ANTI-PLT CPT/TRAN [4073F]^1"
  1. S G=$$TRANI^BGP8DU(P,EDATE,EDATE,+$$CODEN^ICPTCOD("4075F"))
  1. I G Q $$DATE^BGP8UTL($P(G,U,2))_" MET: ANTI-PLT CPT/TRAN [4075F]^1"
  1. S G=$$TRANI^BGP8DU(P,EDATE,EDATE,+$$CODEN^ICPTCOD("G8006"))
  1. I G Q $$DATE^BGP8UTL($P(G,U,2))_" MET: ANTI-PLT CPT/TRAN [G8006]^1"
  1. ;now go get refusals of any of the above
  1. ;
  1. ;refusal of MEDS
  1. S T=$O(^ATXAX("B","BGP CMS WARFARIN MEDS",0))
  1. S G=$$REFTAX^BGP8UTL1(P,50,T,EDATE,EDATE)
  1. I G Q $$DATE^BGP8UTL(EDATE)_" NOT MET: REFUSAL WARF^2"
  1. S T=$O(^ATXAX("B","DM AUDIT ANTI-PLATELET DRUGS",0))
  1. S G=$$REFTAX^BGP8UTL1(P,50,T,EDATE,EDATE)
  1. I G Q $$DATE^BGP8UTL(EDATE)_" NOT MET: REFUSAL ANTI-PLT^2"
  1. S T=$O(^ATXAX("B","D AUDIT ASPIRIN DRUGS",0))
  1. S G=$$REFTAX^BGP8UTL1(P,50,T,EDATE,EDATE)
  1. I G Q $$DATE^BGP8UTL(EDATE)_" NOT MET: REFUSAL ASA^2"
  1. ;CHECK BL700 CLASS REFUSALS
  1. S G=""
  1. S I=0 F S I=$O(^AUPNPREF("AA",P,50,I)) Q:I=""!($P(G,U)) D
  1. .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
  1. .Q:$P($G(^PSDRUG(I,0)),U,2)'="BL700"
  1. .S G=$$DATE^BGP8UTL(EDATE)_" NOT MET: REFUSAL ANTI-PLT^2"
  1. I G]"" Q G
  1. S G=$$REFUSAL^BGP8UTL1(P,81,+$$CODEN^ICPTCOD("4073F"),EDATE,EDATE)
  1. I G Q $$DATE^BGP8UTL(EDATE)_" NOT MET: REFUSAL ANTI-PLT [4073F]^2"
  1. S G=$$REFUSAL^BGP8UTL1(P,81,+$$CODEN^ICPTCOD("4075F"),EDATE,EDATE)
  1. I G Q $$DATE^BGP8UTL(EDATE)_" NOT MET: REFUSAL ANTI-PLT [4075F]^2"
  1. S G=$$REFUSAL^BGP8UTL1(P,81,+$$CODEN^ICPTCOD("G8006"),EDATE,EDATE)
  1. I G Q $$DATE^BGP8UTL(EDATE)_" NOT MET: REFUSAL ANTI-PLT [G8006]^2"
  1. Q $$DATE^BGP8UTL(EDATE)_" NOT MET: NO THERAPY^3"
  1. ;
  1. ANTIDRUG(N) ;
  1. NEW G,T,I
  1. S I=$P($G(^AUPNVMED(N,0)),U)
  1. I 'I Q 0
  1. S G=0
  1. S T=$O(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))
  1. I T,$D(^ATXAX(T,21,"B",I)) Q "1^ASA"
  1. S T=$O(^ATXAX("B","BGP CMS WARFARIN MEDS",0))
  1. I T,$D(^ATXAX(T,21,"B",I)) Q "1^WARF"
  1. S T=$O(^ATXAX("B","DM AUDIT ANTI-PLATELET DRUGS",0))
  1. I T,$D(^ATXAX(T,21,"B",I)) Q "1^ANTI-PLT"
  1. S G=$P(^PSDRUG(I,0),U,2)
  1. I G="BL700" Q "1^ANTI-PLT"
  1. I $P(^PSDRUG(I,0),U)["WARFARIN" Q "1^WARF"
  1. Q ""