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

BGP8D214.m

Go to the documentation of this file.
  1. BGP8D214 ; IHS/CMI/LAB - measure 6 19 Sep 2014 8:12 AM ;
  1. ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
  1. ;
  1. STATIN(P,BDATE,EDATE,BGPNDAYS) ;EP - GET STATIN MEDS
  1. NEW X,Y,Z,%,E
  1. NEW BGPMEDS1
  1. ;CHECK CPT CODE FIRST
  1. S %="",E=+$$CODEN^ICPTCOD("4013F"),%=$$CPTI^BGP8DU(P,BDATE,EDATE,E)
  1. I % Q 1_U_"Statin: "_$$DATE^BGP8UTL($P(%,U,2))_" CPT 4013F"
  1. K BGPMEDS1 S K=0,R=""
  1. D GETMEDS^BGP8UTL2(P,BDATE,EDATE,"BGP PQA STATIN MEDS","BGP PQA STATIN NDC",,,.BGPMEDS1)
  1. ;I '$D(BGPMEDS1) Q ""
  1. S T=$O(^ATXAX("B","BGP PQA STATIN MEDS",0))
  1. S T1=$O(^ATXAX("B","BGP PQA STATIN NDC",0))
  1. S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X!(R]"") S Y=+$P(BGPMEDS1(X),U,4) D
  1. .Q:'$D(^AUPNVMED(Y,0))
  1. .Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
  1. .S G=0
  1. .S D=$P(^AUPNVMED(Y,0),U)
  1. .I T,$D(^ATXAX(T,21,"B",D)) S G=1 G STAT1
  1. .S N=$P($G(^PSDRUG(D,2)),U,4)
  1. .I N]"",T1,$D(^ATXAX(T1,21,"B",N)) S G=1
  1. .Q:'G
  1. STAT1 .;
  1. .S J=$P(^AUPNVMED(Y,0),U,8)
  1. .S V=$P(^AUPNVMED(Y,0),U,3)
  1. .Q:'V
  1. .Q:'$D(^AUPNVSIT(V,0))
  1. .S S=$$DAYS^BGP8D82(Y,V,EDATE)
  1. .S K=S+K ;TOTAL DAYS SUPPLY
  1. .I K>BGPNDAYS D
  1. ..S R="Statin: "_$$DATE^BGP8UTL($P($P(^AUPNVSIT(V,0),U),"."))_" "_$$VAL^XBDIQ1(9000010.14,Y,.01)
  1. I K>BGPNDAYS Q 1_U_R
  1. STATPRIO ;now add in any before BEG DATE
  1. K BGPMEDS1
  1. S R=""
  1. D GETMEDS^BGP8UTL2(P,$$FMADD^XLFDT(BDATE,-380),$$FMADD^XLFDT(BDATE,-1),"BGP PQA STATIN MEDS","BGP PQA STATIN NDC",,,.BGPMEDS1)
  1. ;I '$D(BGPMEDS1) Q ""
  1. S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X!(R]"") S Y=+$P(BGPMEDS1(X),U,4) D
  1. .Q:'$D(^AUPNVMED(Y,0))
  1. .Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
  1. .S G=0
  1. .S D=$P(^AUPNVMED(Y,0),U)
  1. .I T,$D(^ATXAX(T,21,"B",D)) S G=1 G STAT2
  1. .S N=$P($G(^PSDRUG(D,2)),U,4)
  1. .I N]"",T1,$D(^ATXAX(T1,21,"B",N)) S G=1 G STAT2
  1. .Q:'G
  1. STAT2 .;
  1. .S J=$P(^AUPNVMED(Y,0),U,8)
  1. .S V=$P(^AUPNVMED(Y,0),U,3)
  1. .Q:'V
  1. .Q:'$D(^AUPNVSIT(V,0))
  1. .;S IS DAYS SUPPLY, J IS DATE DISCONTINUED
  1. .Q:J]"" ;don't use if discontinued
  1. .S D=$$FMDIFF^XLFDT($$FMADD^XLFDT(BDATE,-1),$P($P(^AUPNVSIT(V,0),U),".")) ;difference between dsch date and date prescribed
  1. .S S=$P(^AUPNVMED(Y,0),U,7)
  1. .S S=S-D ;subtract the number of days used
  1. .S:S<0 S=0
  1. .S K=S+K ;TOTAL DAYS SUPPLY
  1. .I K>BGPNDAYS D
  1. ..S R="Statin: "_$$DATE^BGP8UTL($P($P(^AUPNVSIT(V,0),U),"."))_" "_$$VAL^XBDIQ1(9000010.14,Y,.01)
  1. I K>BGPNDAYS Q 1_U_R
  1. EHROUT ;
  1. ;any EHR outside meds?
  1. K BGPMEDS1 S K=0,R=""
  1. D GETMEDS^BGP8UTL2(P,$$DOB^AUPNPAT(P),EDATE,"BGP PQA STATIN MEDS","BGP PQA STATIN NDC",,,.BGPMEDS1)
  1. I '$D(BGPMEDS1) Q ""
  1. S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X!(R]"") S Y=+$P(BGPMEDS1(X),U,4) D
  1. .Q:'$D(^AUPNVMED(Y,0))
  1. .Q:$P($G(^AUPNVMED(Y,11)),U,8)="" ;NOT AN EHR OUTSIDE MED
  1. .Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
  1. .S %=$P(^AUPNVMED(Y,0),U,8) ;discontinued date
  1. .I %]"",%<$$FMADD^XLFDT(BDATE,1) Q ;if discontinued before 2nd day of report period
  1. .S V=$P(^AUPNVMED(Y,0),U,3)
  1. .Q:'V
  1. .Q:'$D(^AUPNVSIT(V,0))
  1. .S R=1_U_"Statin: "_$$DATE^BGP8UTL($P($P(^AUPNVSIT(V,0),U),"."))_" "_$$VAL^XBDIQ1(9000010.14,Y,.01)_" (EHR OUTSIDE)"
  1. Q R