BGP7D39 ; IHS/CMI/LAB - measure C ;
;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
;
MEDCOV ;EP
S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11,BGPN12,BGPN13,BGPN14,BGPN15,BGPN16,BGPN17,BGPN18,BGPN19,BGPN20,BGPN21,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPD10,BGPD11)=0
NEW BGPBETA,BGPACEI,BGPCCB,BGPBIG,BGPSULF,BGPTHIA,BGPSTATI,BGPANTI,BGPDPP,BGPDMALL,BGPNWARI
S BGPVALUE=""
I 'BGPACTUP S BGPSTOP=1 Q
I 'BGPACTCL S BGPSTOP=1 Q ;must be active clinical
I BGPAGEB<18 S BGPSTOP=1 Q ;no one under 18
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
I $P(BGPBETA,U,1) D
.S BGPD1=1
.S %=$P(BGPBETA,U,2) I %>79 S BGPN1=1
.S BGPN2=$P(BGPBETA,U,3)
.S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPBETA,U,4)
S BGPACEI=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA RASA MEDS","BGP PQA RASA NDC","RASA") ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
I $P(BGPACEI,U,1) D
.S BGPD2=1
.S %=$P(BGPACEI,U,2) I %>79 S BGPN3=1
.S BGPN4=$P(BGPACEI,U,3)
.S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPACEI,U,4)
S BGPCCB=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA CCB MEDS","BGP PQA CCB NDC","CCB") ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
I $P(BGPCCB,U,1) D
.S BGPD3=1
.S %=$P(BGPCCB,U,2) I %>79 S BGPN5=1
.S BGPN6=$P(BGPCCB,U,3)
.S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPCCB,U,4)
S BGPBIG=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA BIGUANIDE MEDS","BGP PQA BIGUANIDE NDC","BIG") ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
I $P(BGPBIG,U,1) D
.S BGPD4=1
.S %=$P(BGPBIG,U,2) I %>79 S BGPN7=1
.S BGPN8=$P(BGPBIG,U,3)
.S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPBIG,U,4)
S BGPSULF=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA SULFONYLUREA MEDS","BGP PQA SULFONYLUREA NDC","SULF") ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
I $P(BGPSULF,U,1) D
.S BGPD5=1
.S %=$P(BGPSULF,U,2) I %>79 S BGPN9=1
.S BGPN10=$P(BGPSULF,U,3)
.S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPSULF,U,4)
S BGPTHIA=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA THIAZOLIDINEDIONE MEDS","BGP PQA THIAZOLIDINEDIONE NDC","THIAZ") ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
I $P(BGPTHIA,U,1) D
.S BGPD6=1
.S %=$P(BGPTHIA,U,2) I %>79 S BGPN11=1
.S BGPN12=$P(BGPTHIA,U,3)
.S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPTHIA,U,4)
S BGPDPP=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA DPP IV MEDS","BGP PQA DPP IV NDC","DPP") ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
I $P(BGPDPP,U,1) D
.S BGPD9=1
.S %=$P(BGPDPP,U,2) I %>79 S BGPN16=1
.S BGPN17=$P(BGPDPP,U,3)
.S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPDPP,U,4)
S BGPDMALL=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA DIABETES ALL CLASS","BGP PQA DIABETES ALL CLASS NDC","DMALL") ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
I $P(BGPDMALL,U,1) D
.S BGPD10=1
.S %=$P(BGPDMALL,U,2) I %>79 S BGPN18=1
.S BGPN19=$P(BGPDMALL,U,3)
.S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPDMALL,U,4)
S BGPSTATI=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA STATIN MEDS","BGP PQA STATIN NDC","STATIN") ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
I $P(BGPSTATI,U,1) D
.S BGPD7=1
.S %=$P(BGPSTATI,U,2) I %>79 S BGPN13=1
.S BGPN14=$P(BGPSTATI,U,3)
.S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPSTATI,U,4)
S BGPNWARI=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA NON-WARF ANTICOAG MEDS","BGP PQA NON-WARF ANTICOAG NDC","ANTICOAG") ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
I $P(BGPNWARI,U,1) D
.S BGPD11=1
.S %=$P(BGPNWARI,U,2) I %>79 S BGPN20=1
.S BGPN21=$P(BGPNWARI,U,3)
.S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPNWARI,U,4)
S BGPANTI=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA ANTIRETROVIRAL MEDS","BGP PQA ANTIRETROVIRAL NDC","ANTIRET") ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
I $P(BGPANTI,U,1) D
.S BGPD8=1
.S %=$P(BGPANTI,U,2) I %>89 S BGPN15=1
.;S BGPN14=$P(BGPSTATI,U,3)
.S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPANTI,U,4)
S BGPVALUE="AC"_"|||"_BGPVALUE
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,BGPDMALL,BGPSTATI,BGPANTI,BGP
K ^TMP($J,"A"),BGPMEDS1
Q
;
COVERAGE(P,BDATE,EDATE,MTAX,NTAX,TYPE) ;
K ^TMP($J,"A")
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
S A="" I TYPE="RASA"!(TYPE="DMALL")!(TYPE="BIG")!(TYPE="SULF")!(TYPE="THIAZ")!(TYPE="DPP") S A=1
I A,$$ESRD^BGP7D211(P,$P(^DPT(P,0),U,3),BGPEDATE) Q ""
I TYPE="RASA",$$HASARB(P,BDATE,EDATE) Q ""
I TYPE="ANTICOAG" I $$HADWARF(P,BDATE,EDATE) Q "" ;HAD WARFARIN IN TIME PERIOD
K BGPMEDS1
D GETMEDS^BGP7UTL2(P,BDATE,EDATE,MTAX,NTAX,,,.BGPMEDS1)
I '$D(BGPMEDS1) Q "" ; no meds
S BGPISD=""
S (A,C)=0 F S A=$O(BGPMEDS1(A)) Q:A'=+A D
.S M=$P(BGPMEDS1(A),U,4) ;IEN OF V MED
.Q:'$D(^AUPNVMED(M,0))
.I $$UP^XLFSTR($P($G(^AUPNVMED(M,11)),U))["RETURNED TO STOCK" K BGPMEDS1(A) Q
.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
.I '$P(^AUPNVMED(M,0),U,7) K BGPMEDS1(A) Q ;no days supply
.I BGPISD="" S BGPISD=$P(BGPMEDS1(A),U,1) ;first date
.S C=C+1
I C<2 Q "" ;does not have 2 scripts
I BGPISD>$$FMADD^XLFDT(EDATE,-90) Q "" ;INDEX START DATE AFTER EDATE-90
I TYPE="ANTICOAG" S G=0 D NONW180 I G Q ""
S BGPMP=$$FMDIFF^XLFDT(EDATE,BGPISD)
;COVERAGE
S DAYS=0,LEND="",GAP=""
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X D
.S V=$P(BGPMEDS1(X),U,5)
.S SD=$$VD^APCLV(V) ;start date of med
.I LEND="" S LEND=SD
.I LEND,LEND>SD S SD=LEND
.S G=$$FMDIFF^XLFDT(SD,LEND) I G>30,GAP="" S GAP=G
.S M=$P(BGPMEDS1(X),U,4)
.S DC=$P(^AUPNVMED(M,0),U,8) ;date discontinued
.S N=$P(^AUPNVMED(M,0),U,7) ;days supply
.I $$FMADD^XLFDT(SD,N)>EDATE S N=$$FMDIFF^XLFDT(EDATE,SD)
.S S=0 I DC]"",SD]"" S S=$$FMDIFF^XLFDT(DC,SD)
.I S>0,S<N S N=S
.;N IS DAYS SUPPLY
.S LEND=$$FMADD^XLFDT(SD,(N+1)) ;new end date
.S DAYS=DAYS+N
I DAYS<61,TYPE="ANTICOAG" Q ""
I LEND]"" S G=$$FMDIFF^XLFDT(EDATE,LEND) I G>30,GAP="" S GAP=G
S PER=$J(((DAYS/BGPMP)*100),3,0)
S PER=$$STRIP^XLFSTR(PER," ")
S C=1_U_PER_U_$S(GAP:1,1:"")_U_TYPE_": IXRD: "_$$DATE^BGP7UTL(BGPISD)_" ["_BGPMP_"] Days="_DAYS
I TYPE'="ANTIRET" S %=$S(PER>79:">80",1:"<80") S C=C_" "_%
I TYPE="ANTIRET" S %=$S(PER>89:">90",1:"<90") S C=C_" "_%
I TYPE'="ANTIRET" S C=C_$S(GAP:", GAP="_GAP,1:"")
;CALULATE %COVERAGE AND GAP DAYS
Q C
;
TEST ;
F Y=44142 S X=$$COVERAGE(Y,3130101,3131231,"BGP PQA BETA BLOCKER MEDS","BGP PQA BETA BLOCKER NDC") I X]"" W !,Y," ",X
Q
HADWARF(P,BDATE,EDATE) ;
NEW BGPMEDS1,C,A,M
K BGPMEDS1
D GETMEDS^BGP7UTL2(P,BDATE,EDATE,"BGP PQA WARFARIN MEDS","BGP PQA WARFARIN NDC",,,.BGPMEDS1)
I '$D(BGPMEDS1) Q "" ; NO MEDS
S (A,C)=0 F S A=$O(BGPMEDS1(A)) Q:A'=+A D
.S M=$P(BGPMEDS1(A),U,4) ;IEN OF V MED
.Q:'$D(^AUPNVMED(M,0))
.I $$UP^XLFSTR($P($G(^AUPNVMED(M,11)),U))["RETURNED TO STOCK" K BGPMEDS1(A) Q
.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
.I '$P(^AUPNVMED(M,0),U,7) K BGPMEDS1(A) Q ;no days supply
.S C=C+1
.Q
Q C
HASARB(P,BDATE,EDATE) ;
NEW BGPMEDS1,C,A,M
K BGPMEDS1
D GETMEDS^BGP7UTL2(P,BDATE,EDATE,"BGP PQA ARB NEPRILYSIN MEDS","BGP PQA ARB NEPRILYSIN NDC",,,.BGPMEDS1)
I '$D(BGPMEDS1) Q "" ; NO MEDS
S (A,C)=0 F S A=$O(BGPMEDS1(A)) Q:A'=+A D
.S M=$P(BGPMEDS1(A),U,4) ;IEN OF V MED
.Q:'$D(^AUPNVMED(M,0))
.I $$UP^XLFSTR($P($G(^AUPNVMED(M,11)),U))["RETURNED TO STOCK" K BGPMEDS1(A) Q
.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
.I '$P(^AUPNVMED(M,0),U,7) K BGPMEDS1(A) Q ;no days supply
.S C=C+1
.Q
Q C
NONW180 ;
;is the index start greater that 180 from last fill date? if so set g=1
NEW A,B,C,D
S A=0 F S A=$O(BGPMEDS1(A)) Q:A'=+A S B=A
S D=$P(BGPMEDS1(B),U,1) ;LAST FILL
I $$FMDIFF^XLFDT(D,BGPISD)<180 S G=1
Q
BGP7D39 ; IHS/CMI/LAB - measure C ;
+1 ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
+2 ;
MEDCOV ;EP
+1 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11,BGPN12,BGPN13,BGPN14,BGPN15,BGPN16,BGPN17,BGPN18,BGPN19,BGPN20,BGPN21,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPD10,BGPD11)=0
+2 NEW BGPBETA,BGPACEI,BGPCCB,BGPBIG,BGPSULF,BGPTHIA,BGPSTATI,BGPANTI,BGPDPP,BGPDMALL,BGPNWARI
+3 SET BGPVALUE=""
+4 IF 'BGPACTUP
SET BGPSTOP=1
QUIT
+5 ;must be active clinical
IF 'BGPACTCL
SET BGPSTOP=1
QUIT
+6 ;no one under 18
IF BGPAGEB<18
SET BGPSTOP=1
QUIT
+7 ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
SET BGPBETA=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA BETA BLOCKER MEDS","BGP PQA BETA BLOCKER NDC","BB")
+8 IF $PIECE(BGPBETA,U,1)
Begin DoDot:1
+9 SET BGPD1=1
+10 SET %=$PIECE(BGPBETA,U,2)
IF %>79
SET BGPN1=1
+11 SET BGPN2=$PIECE(BGPBETA,U,3)
+12 SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPBETA,U,4)
End DoDot:1
+13 ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
SET BGPACEI=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA RASA MEDS","BGP PQA RASA NDC","RASA")
+14 IF $PIECE(BGPACEI,U,1)
Begin DoDot:1
+15 SET BGPD2=1
+16 SET %=$PIECE(BGPACEI,U,2)
IF %>79
SET BGPN3=1
+17 SET BGPN4=$PIECE(BGPACEI,U,3)
+18 SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPACEI,U,4)
End DoDot:1
+19 ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
SET BGPCCB=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA CCB MEDS","BGP PQA CCB NDC","CCB")
+20 IF $PIECE(BGPCCB,U,1)
Begin DoDot:1
+21 SET BGPD3=1
+22 SET %=$PIECE(BGPCCB,U,2)
IF %>79
SET BGPN5=1
+23 SET BGPN6=$PIECE(BGPCCB,U,3)
+24 SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPCCB,U,4)
End DoDot:1
+25 ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
SET BGPBIG=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA BIGUANIDE MEDS","BGP PQA BIGUANIDE NDC","BIG")
+26 IF $PIECE(BGPBIG,U,1)
Begin DoDot:1
+27 SET BGPD4=1
+28 SET %=$PIECE(BGPBIG,U,2)
IF %>79
SET BGPN7=1
+29 SET BGPN8=$PIECE(BGPBIG,U,3)
+30 SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPBIG,U,4)
End DoDot:1
+31 ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
SET BGPSULF=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA SULFONYLUREA MEDS","BGP PQA SULFONYLUREA NDC","SULF")
+32 IF $PIECE(BGPSULF,U,1)
Begin DoDot:1
+33 SET BGPD5=1
+34 SET %=$PIECE(BGPSULF,U,2)
IF %>79
SET BGPN9=1
+35 SET BGPN10=$PIECE(BGPSULF,U,3)
+36 SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPSULF,U,4)
End DoDot:1
+37 ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
SET BGPTHIA=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA THIAZOLIDINEDIONE MEDS","BGP PQA THIAZOLIDINEDIONE NDC","THIAZ")
+38 IF $PIECE(BGPTHIA,U,1)
Begin DoDot:1
+39 SET BGPD6=1
+40 SET %=$PIECE(BGPTHIA,U,2)
IF %>79
SET BGPN11=1
+41 SET BGPN12=$PIECE(BGPTHIA,U,3)
+42 SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPTHIA,U,4)
End DoDot:1
+43 ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
SET BGPDPP=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA DPP IV MEDS","BGP PQA DPP IV NDC","DPP")
+44 IF $PIECE(BGPDPP,U,1)
Begin DoDot:1
+45 SET BGPD9=1
+46 SET %=$PIECE(BGPDPP,U,2)
IF %>79
SET BGPN16=1
+47 SET BGPN17=$PIECE(BGPDPP,U,3)
+48 SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPDPP,U,4)
End DoDot:1
+49 ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
SET BGPDMALL=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA DIABETES ALL CLASS","BGP PQA DIABETES ALL CLASS NDC","DMALL")
+50 IF $PIECE(BGPDMALL,U,1)
Begin DoDot:1
+51 SET BGPD10=1
+52 SET %=$PIECE(BGPDMALL,U,2)
IF %>79
SET BGPN18=1
+53 SET BGPN19=$PIECE(BGPDMALL,U,3)
+54 SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPDMALL,U,4)
End DoDot:1
+55 ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
SET BGPSTATI=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA STATIN MEDS","BGP PQA STATIN NDC","STATIN")
+56 IF $PIECE(BGPSTATI,U,1)
Begin DoDot:1
+57 SET BGPD7=1
+58 SET %=$PIECE(BGPSTATI,U,2)
IF %>79
SET BGPN13=1
+59 SET BGPN14=$PIECE(BGPSTATI,U,3)
+60 SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPSTATI,U,4)
End DoDot:1
+61 ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
SET BGPNWARI=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA NON-WARF ANTICOAG MEDS","BGP PQA NON-WARF ANTICOAG NDC","ANTICOAG")
+62 IF $PIECE(BGPNWARI,U,1)
Begin DoDot:1
+63 SET BGPD11=1
+64 SET %=$PIECE(BGPNWARI,U,2)
IF %>79
SET BGPN20=1
+65 SET BGPN21=$PIECE(BGPNWARI,U,3)
+66 SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPNWARI,U,4)
End DoDot:1
+67 ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
SET BGPANTI=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA ANTIRETROVIRAL MEDS","BGP PQA ANTIRETROVIRAL NDC","ANTIRET")
+68 IF $PIECE(BGPANTI,U,1)
Begin DoDot:1
+69 SET BGPD8=1
+70 SET %=$PIECE(BGPANTI,U,2)
IF %>89
SET BGPN15=1
+71 ;S BGPN14=$P(BGPSTATI,U,3)
+72 SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPANTI,U,4)
End DoDot:1
+73 SET BGPVALUE="AC"_"|||"_BGPVALUE
+74 KILL 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,BGPDMALL,BGPSTATI,BGPANTI,BGP
+75 KILL ^TMP($JOB,"A"),BGPMEDS1
+76 QUIT
+77 ;
COVERAGE(P,BDATE,EDATE,MTAX,NTAX,TYPE) ;
+1 KILL ^TMP($JOB,"A")
+2 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
+3 SET A=""
IF TYPE="RASA"!(TYPE="DMALL")!(TYPE="BIG")!(TYPE="SULF")!(TYPE="THIAZ")!(TYPE="DPP")
SET A=1
+4 IF A
IF $$ESRD^BGP7D211(P,$PIECE(^DPT(P,0),U,3),BGPEDATE)
QUIT ""
+5 IF TYPE="RASA"
IF $$HASARB(P,BDATE,EDATE)
QUIT ""
+6 ;HAD WARFARIN IN TIME PERIOD
IF TYPE="ANTICOAG"
IF $$HADWARF(P,BDATE,EDATE)
QUIT ""
+7 KILL BGPMEDS1
+8 DO GETMEDS^BGP7UTL2(P,BDATE,EDATE,MTAX,NTAX,,,.BGPMEDS1)
+9 ; no meds
IF '$DATA(BGPMEDS1)
QUIT ""
+10 SET BGPISD=""
+11 SET (A,C)=0
FOR
SET A=$ORDER(BGPMEDS1(A))
IF A'=+A
QUIT
Begin DoDot:1
+12 ;IEN OF V MED
SET M=$PIECE(BGPMEDS1(A),U,4)
+13 IF '$DATA(^AUPNVMED(M,0))
QUIT
+14 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(M,11)),U))["RETURNED TO STOCK"
KILL BGPMEDS1(A)
QUIT
+15 ;d/c'ed on same day as visit so no days suppply
IF $PIECE(^AUPNVMED(M,0),U,8)=$PIECE(BGPMEDS1(A),U,1)
KILL BGPMEDS1(A)
QUIT
+16 ;no days supply
IF '$PIECE(^AUPNVMED(M,0),U,7)
KILL BGPMEDS1(A)
QUIT
+17 ;first date
IF BGPISD=""
SET BGPISD=$PIECE(BGPMEDS1(A),U,1)
+18 SET C=C+1
End DoDot:1
+19 ;does not have 2 scripts
IF C<2
QUIT ""
+20 ;INDEX START DATE AFTER EDATE-90
IF BGPISD>$$FMADD^XLFDT(EDATE,-90)
QUIT ""
+21 IF TYPE="ANTICOAG"
SET G=0
DO NONW180
IF G
QUIT ""
+22 SET BGPMP=$$FMDIFF^XLFDT(EDATE,BGPISD)
+23 ;COVERAGE
+24 SET DAYS=0
SET LEND=""
SET GAP=""
+25 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
Begin DoDot:1
+26 SET V=$PIECE(BGPMEDS1(X),U,5)
+27 ;start date of med
SET SD=$$VD^APCLV(V)
+28 IF LEND=""
SET LEND=SD
+29 IF LEND
IF LEND>SD
SET SD=LEND
+30 SET G=$$FMDIFF^XLFDT(SD,LEND)
IF G>30
IF GAP=""
SET GAP=G
+31 SET M=$PIECE(BGPMEDS1(X),U,4)
+32 ;date discontinued
SET DC=$PIECE(^AUPNVMED(M,0),U,8)
+33 ;days supply
SET N=$PIECE(^AUPNVMED(M,0),U,7)
+34 IF $$FMADD^XLFDT(SD,N)>EDATE
SET N=$$FMDIFF^XLFDT(EDATE,SD)
+35 SET S=0
IF DC]""
IF SD]""
SET S=$$FMDIFF^XLFDT(DC,SD)
+36 IF S>0
IF S<N
SET N=S
+37 ;N IS DAYS SUPPLY
+38 ;new end date
SET LEND=$$FMADD^XLFDT(SD,(N+1))
+39 SET DAYS=DAYS+N
End DoDot:1
+40 IF DAYS<61
IF TYPE="ANTICOAG"
QUIT ""
+41 IF LEND]""
SET G=$$FMDIFF^XLFDT(EDATE,LEND)
IF G>30
IF GAP=""
SET GAP=G
+42 SET PER=$JUSTIFY(((DAYS/BGPMP)*100),3,0)
+43 SET PER=$$STRIP^XLFSTR(PER," ")
+44 SET C=1_U_PER_U_$SELECT(GAP:1,1:"")_U_TYPE_": IXRD: "_$$DATE^BGP7UTL(BGPISD)_" ["_BGPMP_"] Days="_DAYS
+45 IF TYPE'="ANTIRET"
SET %=$SELECT(PER>79:">80",1:"<80")
SET C=C_" "_%
+46 IF TYPE="ANTIRET"
SET %=$SELECT(PER>89:">90",1:"<90")
SET C=C_" "_%
+47 IF TYPE'="ANTIRET"
SET C=C_$SELECT(GAP:", GAP="_GAP,1:"")
+48 ;CALULATE %COVERAGE AND GAP DAYS
+49 QUIT C
+50 ;
TEST ;
+1 FOR Y=44142
SET X=$$COVERAGE(Y,3130101,3131231,"BGP PQA BETA BLOCKER MEDS","BGP PQA BETA BLOCKER NDC")
IF X]""
WRITE !,Y," ",X
+2 QUIT
HADWARF(P,BDATE,EDATE) ;
+1 NEW BGPMEDS1,C,A,M
+2 KILL BGPMEDS1
+3 DO GETMEDS^BGP7UTL2(P,BDATE,EDATE,"BGP PQA WARFARIN MEDS","BGP PQA WARFARIN NDC",,,.BGPMEDS1)
+4 ; NO MEDS
IF '$DATA(BGPMEDS1)
QUIT ""
+5 SET (A,C)=0
FOR
SET A=$ORDER(BGPMEDS1(A))
IF A'=+A
QUIT
Begin DoDot:1
+6 ;IEN OF V MED
SET M=$PIECE(BGPMEDS1(A),U,4)
+7 IF '$DATA(^AUPNVMED(M,0))
QUIT
+8 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(M,11)),U))["RETURNED TO STOCK"
KILL BGPMEDS1(A)
QUIT
+9 ;d/c'ed on same day as visit so no days suppply
IF $PIECE(^AUPNVMED(M,0),U,8)=$PIECE(BGPMEDS1(A),U,1)
KILL BGPMEDS1(A)
QUIT
+10 ;no days supply
IF '$PIECE(^AUPNVMED(M,0),U,7)
KILL BGPMEDS1(A)
QUIT
+11 SET C=C+1
+12 QUIT
End DoDot:1
+13 QUIT C
HASARB(P,BDATE,EDATE) ;
+1 NEW BGPMEDS1,C,A,M
+2 KILL BGPMEDS1
+3 DO GETMEDS^BGP7UTL2(P,BDATE,EDATE,"BGP PQA ARB NEPRILYSIN MEDS","BGP PQA ARB NEPRILYSIN NDC",,,.BGPMEDS1)
+4 ; NO MEDS
IF '$DATA(BGPMEDS1)
QUIT ""
+5 SET (A,C)=0
FOR
SET A=$ORDER(BGPMEDS1(A))
IF A'=+A
QUIT
Begin DoDot:1
+6 ;IEN OF V MED
SET M=$PIECE(BGPMEDS1(A),U,4)
+7 IF '$DATA(^AUPNVMED(M,0))
QUIT
+8 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(M,11)),U))["RETURNED TO STOCK"
KILL BGPMEDS1(A)
QUIT
+9 ;d/c'ed on same day as visit so no days suppply
IF $PIECE(^AUPNVMED(M,0),U,8)=$PIECE(BGPMEDS1(A),U,1)
KILL BGPMEDS1(A)
QUIT
+10 ;no days supply
IF '$PIECE(^AUPNVMED(M,0),U,7)
KILL BGPMEDS1(A)
QUIT
+11 SET C=C+1
+12 QUIT
End DoDot:1
+13 QUIT C
NONW180 ;
+1 ;is the index start greater that 180 from last fill date? if so set g=1
+2 NEW A,B,C,D
+3 SET A=0
FOR
SET A=$ORDER(BGPMEDS1(A))
IF A'=+A
QUIT
SET B=A
+4 ;LAST FILL
SET D=$PIECE(BGPMEDS1(B),U,1)
+5 IF $$FMDIFF^XLFDT(D,BGPISD)<180
SET G=1
+6 QUIT
