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

BGP2D39.m

Go to the documentation of this file. 
  1. BGP2D39 ; IHS/CMI/LAB - measure C ;
  1.  ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
  1.  ;
  1. MEDCOV ;EP
  1.  S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11,BGPN12,BGPN13,BGPN14,BGPN15,BGPN16,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8)=0
  1.  NEW BGPBETA,BGPACEI,BGPCCB,BGPBIG,BGPSULF,BGPTHIA,BGPSTATI,BGPANTI
  1.  S BGPVALUE=""
  1.  I 'BGPACTUP S BGPSTOP=1 Q
  1.  I 'BGPACTCL S BGPSTOP=1 Q  ;must be active clinical
  1.  I BGPAGEB<18 S BGPSTOP=1 Q  ;no one under 18
  1.  S BGPBETA=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA BETA BLOCKER MEDS","BGP PQA BETA BLOCKER NDC","BB") ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
  1.  I $P(BGPBETA,U,1) D
  1.  .S BGPD1=1
  1.  .S %=$P(BGPBETA,U,2) I %>79 S BGPN1=1
  1.  .S BGPN2=$P(BGPBETA,U,3)
  1.  .S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPBETA,U,4)
  1.  S BGPACEI=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA RASA MEDS","BGP PQA RASA NDC","RASA") ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
  1.  I $P(BGPACEI,U,1) D
  1.  .S BGPD2=1
  1.  .S %=$P(BGPACEI,U,2) I %>79 S BGPN3=1
  1.  .S BGPN4=$P(BGPACEI,U,3)
  1.  .S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPACEI,U,4)
  1.  S BGPCCB=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA CCB MEDS","BGP PQA CCB NDC","CCB") ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
  1.  I $P(BGPCCB,U,1) D
  1.  .S BGPD3=1
  1.  .S %=$P(BGPCCB,U,2) I %>79 S BGPN5=1
  1.  .S BGPN6=$P(BGPCCB,U,3)
  1.  .S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPCCB,U,4)
  1.  S BGPBIG=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA BIGUANIDE MEDS","BGP PQA BIGUANIDE NDC","BIG") ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
  1.  I $P(BGPBIG,U,1) D
  1.  .S BGPD4=1
  1.  .S %=$P(BGPBIG,U,2) I %>79 S BGPN7=1
  1.  .S BGPN8=$P(BGPBIG,U,3)
  1.  .S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPBIG,U,4)
  1.  S BGPSULF=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA SULFONYLUREA MEDS","BGP PQA SULFONYLUREA NDC","SULF") ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
  1.  I $P(BGPSULF,U,1) D
  1.  .S BGPD5=1
  1.  .S %=$P(BGPSULF,U,2) I %>79 S BGPN9=1
  1.  .S BGPN10=$P(BGPSULF,U,3)
  1.  .S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPSULF,U,4)
  1.  S BGPTHIA=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA THIAZOLIDINEDIONE MEDS","BGP PQA THIAZOLIDINEDIONE NDC","THIAZ") ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
  1.  I $P(BGPTHIA,U,1) D
  1.  .S BGPD6=1
  1.  .S %=$P(BGPTHIA,U,2) I %>79 S BGPN11=1
  1.  .S BGPN12=$P(BGPTHIA,U,3)
  1.  .S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPTHIA,U,4)
  1.  S BGPSTATI=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA STATIN MEDS","BGP PQA STATIN NDC","STATIN") ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
  1.  I $P(BGPSTATI,U,1) D
  1.  .S BGPD7=1
  1.  .S %=$P(BGPSTATI,U,2) I %>79 S BGPN13=1
  1.  .S BGPN14=$P(BGPSTATI,U,3)
  1.  .S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPSTATI,U,4)
  1.  S BGPANTI=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA ANTIRETROVIRAL MEDS","BGP PQA ANTIRETROVIRAL NDC","ANTIRET") ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
  1.  I $P(BGPANTI,U,1) D
  1.  .S BGPD8=1
  1.  .S %=$P(BGPANTI,U,2) I %>89 S BGPN15=1
  1.  .;S BGPN14=$P(BGPSTATI,U,3)
  1.  .S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPANTI,U,4)
  1.  S BGPVALUE="AC"_"|||"_BGPVALUE
  1.  K A,B,C,D,E,F,G,H,I,J,K,M,N,O,P,Q,R,S,T,V,W,X,Y,Z,BDATE,EDATE,BGPDN,BGPN,BGPG,BGPC
  1.  K ^TMP($J,"A"),BGPMEDS1
  1.  Q
  1.  ;
  1. COVERAGE(P,BDATE,EDATE,MTAX,NTAX,TYPE) ;
  1.  K ^TMP($J,"A")
  1.  NEW A,B,E,Z,X,D,V,Y,G,M,T,T1,BGPMEDS1,C,BGPISD,BGPMP,DAYS,LEND,SD,DC,N,S,PER,GAP
  1.  K BGPMEDS1
  1.  D GETMEDS^BGP2UTL2(P,BDATE,EDATE,MTAX,NTAX,,,.BGPMEDS1)
  1.  I '$D(BGPMEDS1) Q ""  ; no beta blocker meds
  1.  S BGPISD=""
  1.  S (A,C)=0 F  S A=$O(BGPMEDS1(A)) Q:A'=+A  D
  1.  .S M=$P(BGPMEDS1(A),U,4)  ;IEN OF V MED
  1.  .Q:'$D(^AUPNVMED(M,0))
  1.  .I $$UP^XLFSTR($P($G(^AUPNVMED(M,11)),U))["RETURNED TO STOCK" K BGPMEDS1(A) Q
  1.  .I $P(^AUPNVMED(M,0),U,8)=$P(BGPMEDS1(A),U,1) K BGPMEDS1(A) Q  ;d/c'ed on same day as visit so no days suppply
  1.  .I '$P(^AUPNVMED(M,0),U,7) K BGPMEDS1(A) Q  ;no days supply
  1.  .I BGPISD="" S BGPISD=$P(BGPMEDS1(A),U,1)  ;first date
  1.  .S C=C+1
  1.  I C<2 Q ""  ;does not have 2 scripts
  1.  I BGPISD>$$FMADD^XLFDT(EDATE,-90) Q ""  ;INDEX START DATE AFTER EDATE-90
  1.  S BGPMP=$$FMDIFF^XLFDT(EDATE,BGPISD)
  1.  ;COVERAGE
  1.  S DAYS=0,LEND="",GAP=""
  1.  S X=0 F  S X=$O(BGPMEDS1(X)) Q:X'=+X  D
  1.  .S V=$P(BGPMEDS1(X),U,5)
  1.  .S SD=$$VD^APCLV(V)  ;start date of med
  1.  .I LEND="" S LEND=SD
  1.  .I LEND,LEND>SD S SD=LEND
  1.  .S G=$$FMDIFF^XLFDT(SD,LEND) I G>30,GAP="" S GAP=G
  1.  .S M=$P(BGPMEDS1(X),U,4)
  1.  .S DC=$P(^AUPNVMED(M,0),U,8)  ;date discontinued
  1.  .S N=$P(^AUPNVMED(M,0),U,7)  ;days supply
  1.  .I $$FMADD^XLFDT(SD,N)>EDATE S N=$$FMDIFF^XLFDT(EDATE,SD)
  1.  .S S=0 I DC]"",SD]"" S S=$$FMDIFF^XLFDT(DC,SD)
  1.  .I S>0,S<N S N=S
  1.  .;N IS DAYS SUPPLY
  1.  .S LEND=$$FMADD^XLFDT(SD,(N+1))  ;new end date
  1.  .S DAYS=DAYS+N
  1.  I LEND]"" S G=$$FMDIFF^XLFDT(EDATE,LEND) I G>30,GAP="" S GAP=G
  1.  S PER=$J(((DAYS/BGPMP)*100),3,0)
  1.  S PER=$$STRIP^XLFSTR(PER," ")
  1.  S C=1_U_PER_U_$S(GAP:1,1:"")_U_TYPE_": IXRD: "_$$DATE^BGP2UTL(BGPISD)_" ["_BGPMP_"] Days="_DAYS
  1.  I TYPE'="ANTIRET" S %=$S(PER>79:">80",1:"<80") S C=C_" "_%
  1.  I TYPE="ANTIRET" S %=$S(PER>89:">90",1:"<90") S C=C_" "_%
  1.  I TYPE'="ANTIRET" S C=C_$S(GAP:", GAP="_GAP,1:"")
  1.  ;CALULATE %COVERAGE AND GAP DAYS
  1.  Q C
  1.  ;
  1. TEST ;
  1.  F Y=44142 S X=$$COVERAGE(Y,3030101,3031231,"BGP PQA BETA BLOCKER MEDS","BGP PQA BETA BLOCKER NDC") I X]"" W !,Y," ",X
  1.  Q