BGP3D39 ; IHS/CMI/LAB - measure C ;
;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
;
MEDCOV ;EP
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
NEW BGPBETA,BGPACEI,BGPCCB,BGPBIG,BGPSULF,BGPTHIA,BGPSTATI,BGPANTI
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 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 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
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
K BGPMEDS1
D GETMEDS^BGP3UTL2(P,BDATE,EDATE,MTAX,NTAX,,,.BGPMEDS1)
I '$D(BGPMEDS1) Q "" ; no beta blocker 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
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 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^BGP3UTL(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,3030101,3031231,"BGP PQA BETA BLOCKER MEDS","BGP PQA BETA BLOCKER NDC") I X]"" W !,Y," ",X
Q
BGP3D39 ; IHS/CMI/LAB - measure C ;
+1 ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
+2 ;
MEDCOV ;EP
+1 SET (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
+2 NEW BGPBETA,BGPACEI,BGPCCB,BGPBIG,BGPSULF,BGPTHIA,BGPSTATI,BGPANTI
+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 BGPSTATI=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA STATIN MEDS","BGP PQA STATIN NDC","STATIN")
+44 IF $PIECE(BGPSTATI,U,1)
Begin DoDot:1
+45 SET BGPD7=1
+46 SET %=$PIECE(BGPSTATI,U,2)
IF %>79
SET BGPN13=1
+47 SET BGPN14=$PIECE(BGPSTATI,U,3)
+48 SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPSTATI,U,4)
End DoDot:1
+49 ; return 1 if meets denominator^%coverage^# gap days^# prescriptions
SET BGPANTI=$$COVERAGE(DFN,BGPBDATE,BGPEDATE,"BGP PQA ANTIRETROVIRAL MEDS","BGP PQA ANTIRETROVIRAL NDC","ANTIRET")
+50 IF $PIECE(BGPANTI,U,1)
Begin DoDot:1
+51 SET BGPD8=1
+52 SET %=$PIECE(BGPANTI,U,2)
IF %>89
SET BGPN15=1
+53 ;S BGPN14=$P(BGPSTATI,U,3)
+54 SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPANTI,U,4)
End DoDot:1
+55 SET BGPVALUE="AC"_"|||"_BGPVALUE
+56 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
+57 KILL ^TMP($JOB,"A"),BGPMEDS1
+58 QUIT
+59 ;
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 KILL BGPMEDS1
+4 DO GETMEDS^BGP3UTL2(P,BDATE,EDATE,MTAX,NTAX,,,.BGPMEDS1)
+5 ; no beta blocker meds
IF '$DATA(BGPMEDS1)
QUIT ""
+6 SET BGPISD=""
+7 SET (A,C)=0
FOR
SET A=$ORDER(BGPMEDS1(A))
IF A'=+A
QUIT
Begin DoDot:1
+8 ;IEN OF V MED
SET M=$PIECE(BGPMEDS1(A),U,4)
+9 IF '$DATA(^AUPNVMED(M,0))
QUIT
+10 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(M,11)),U))["RETURNED TO STOCK"
KILL BGPMEDS1(A)
QUIT
+11 ;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
+12 ;no days supply
IF '$PIECE(^AUPNVMED(M,0),U,7)
KILL BGPMEDS1(A)
QUIT
+13 ;first date
IF BGPISD=""
SET BGPISD=$PIECE(BGPMEDS1(A),U,1)
+14 SET C=C+1
End DoDot:1
+15 ;does not have 2 scripts
IF C<2
QUIT ""
+16 ;INDEX START DATE AFTER EDATE-90
IF BGPISD>$$FMADD^XLFDT(EDATE,-90)
QUIT ""
+17 SET BGPMP=$$FMDIFF^XLFDT(EDATE,BGPISD)
+18 ;COVERAGE
+19 SET DAYS=0
SET LEND=""
SET GAP=""
+20 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
Begin DoDot:1
+21 SET V=$PIECE(BGPMEDS1(X),U,5)
+22 ;start date of med
SET SD=$$VD^APCLV(V)
+23 IF LEND=""
SET LEND=SD
+24 IF LEND
IF LEND>SD
SET SD=LEND
+25 SET G=$$FMDIFF^XLFDT(SD,LEND)
IF G>30
IF GAP=""
SET GAP=G
+26 SET M=$PIECE(BGPMEDS1(X),U,4)
+27 ;date discontinued
SET DC=$PIECE(^AUPNVMED(M,0),U,8)
+28 ;days supply
SET N=$PIECE(^AUPNVMED(M,0),U,7)
+29 IF $$FMADD^XLFDT(SD,N)>EDATE
SET N=$$FMDIFF^XLFDT(EDATE,SD)
+30 SET S=0
IF DC]""
IF SD]""
SET S=$$FMDIFF^XLFDT(DC,SD)
+31 IF S>0
IF S<N
SET N=S
+32 ;N IS DAYS SUPPLY
+33 ;new end date
SET LEND=$$FMADD^XLFDT(SD,(N+1))
+34 SET DAYS=DAYS+N
End DoDot:1
+35 IF LEND]""
SET G=$$FMDIFF^XLFDT(EDATE,LEND)
IF G>30
IF GAP=""
SET GAP=G
+36 SET PER=$JUSTIFY(((DAYS/BGPMP)*100),3,0)
+37 SET PER=$$STRIP^XLFSTR(PER," ")
+38 SET C=1_U_PER_U_$SELECT(GAP:1,1:"")_U_TYPE_": IXRD: "_$$DATE^BGP3UTL(BGPISD)_" ["_BGPMP_"] Days="_DAYS
+39 IF TYPE'="ANTIRET"
SET %=$SELECT(PER>79:">80",1:"<80")
SET C=C_" "_%
+40 IF TYPE="ANTIRET"
SET %=$SELECT(PER>89:">90",1:"<90")
SET C=C_" "_%
+41 IF TYPE'="ANTIRET"
SET C=C_$SELECT(GAP:", GAP="_GAP,1:"")
+42 ;CALULATE %COVERAGE AND GAP DAYS
+43 QUIT C
+44 ;
TEST ;
+1 FOR Y=44142
SET X=$$COVERAGE(Y,3030101,3031231,"BGP PQA BETA BLOCKER MEDS","BGP PQA BETA BLOCKER NDC")
IF X]""
WRITE !,Y," ",X
+2 QUIT
