Routine: BGP4D39

BGP4D39 ; IHS/CMI/LAB - measure C ;

 ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114

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,BDMNWARI

 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,BDMDMALL,BDMSTATI,BDMANTI,BDM

 K ^TMP($J,"A"),BGPMEDS1

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

 I TYPE="RASA"!(TYPE="DMALL"),$$ESRD^BGP4D211(DFN,$P(^DPT(DFN,0),U,3),BGPEDATE) Q ""

 I TYPE="ANTICOAG" I $$HADWARF(DFN,BDATE,EDATE) Q ""  ;HAD WARFARIN IN TIME PERIOD

 K BGPMEDS1

 D GETMEDS^BGP4UTL2(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

 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^BGP4UTL(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

HADWARF(P,BDATE,EDATE) ;

 NEW BGPMEDS1,C,A,M

 K BGPMEDS1

 D GETMEDS^BGP4UTL2(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

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

BGP4D39   ; IHS/CMI/LAB - measure C ;

 +1       ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114

 +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,BDMNWARI

 +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,BDMDMALL,BDMSTATI,BDMANTI,BDM

 +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        IF TYPE="RASA"!(TYPE="DMALL")

               IF $$ESRD^BGP4D211(DFN,$PIECE(^DPT(DFN,0),U,3),BGPEDATE)

                   QUIT ""

 +4       ;HAD WARFARIN IN TIME PERIOD

           IF TYPE="ANTICOAG"

               IF $$HADWARF(DFN,BDATE,EDATE)

                   QUIT ""

 +5        KILL BGPMEDS1

 +6        DO GETMEDS^BGP4UTL2(P,BDATE,EDATE,MTAX,NTAX,,,.BGPMEDS1)

 +7       ; no beta blocker meds

           IF '$DATA(BGPMEDS1)

               QUIT ""

 +8        SET BGPISD=""

 +9        SET (A,C)=0

FOR

               SET A=$ORDER(BGPMEDS1(A))

               IF A'=+A

                   QUIT

               Begin DoDot:1

 +10      ;IEN OF V MED

                   SET M=$PIECE(BGPMEDS1(A),U,4)

 +11               IF '$DATA(^AUPNVMED(M,0))

                       QUIT

 +12               IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(M,11)),U))["RETURNED TO STOCK"

                       KILL BGPMEDS1(A)

                       QUIT

 +13      ;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

 +14      ;no days supply

                   IF '$PIECE(^AUPNVMED(M,0),U,7)

                       KILL BGPMEDS1(A)

                       QUIT

 +15      ;first date

                   IF BGPISD=""

                       SET BGPISD=$PIECE(BGPMEDS1(A),U,1)

 +16               SET C=C+1

               End DoDot:1

 +17      ;does not have 2 scripts

           IF C<2

               QUIT ""

 +18      ;INDEX START DATE AFTER EDATE-90

           IF BGPISD>$$FMADD^XLFDT(EDATE,-90)

               QUIT ""

 +19       IF TYPE="ANTICOAG"

               SET G=0

               DO NONW180

               IF G

                   QUIT ""

 +20       SET BGPMP=$$FMDIFF^XLFDT(EDATE,BGPISD)

 +21      ;COVERAGE

 +22       SET DAYS=0

           SET LEND=""

           SET GAP=""

 +23       SET X=0

FOR

               SET X=$ORDER(BGPMEDS1(X))

               IF X'=+X

                   QUIT

               Begin DoDot:1

 +24               SET V=$PIECE(BGPMEDS1(X),U,5)

 +25      ;start date of med

                   SET SD=$$VD^APCLV(V)

 +26               IF LEND=""

                       SET LEND=SD

 +27               IF LEND

                       IF LEND>SD

                           SET SD=LEND

 +28               SET G=$$FMDIFF^XLFDT(SD,LEND)

                   IF G>30

                       IF GAP=""

                           SET GAP=G

 +29               SET M=$PIECE(BGPMEDS1(X),U,4)

 +30      ;date discontinued

                   SET DC=$PIECE(^AUPNVMED(M,0),U,8)

 +31      ;days supply

                   SET N=$PIECE(^AUPNVMED(M,0),U,7)

 +32               IF $$FMADD^XLFDT(SD,N)>EDATE

                       SET N=$$FMDIFF^XLFDT(EDATE,SD)

 +33               SET S=0

                   IF DC]""

                       IF SD]""

                           SET S=$$FMDIFF^XLFDT(DC,SD)

 +34               IF S>0

                       IF S<N

                           SET N=S

 +35      ;N IS DAYS SUPPLY

 +36      ;new end date

                   SET LEND=$$FMADD^XLFDT(SD,(N+1))

 +37               SET DAYS=DAYS+N

               End DoDot:1

 +38       IF DAYS<61

               IF TYPE="ANTICOAG"

                   QUIT ""

 +39       IF LEND]""

               SET G=$$FMDIFF^XLFDT(EDATE,LEND)

               IF G>30

                   IF GAP=""

                       SET GAP=G

 +40       SET PER=$JUSTIFY(((DAYS/BGPMP)*100),3,0)

 +41       SET PER=$$STRIP^XLFSTR(PER," ")

 +42       SET C=1_U_PER_U_$SELECT(GAP:1,1:"")_U_TYPE_": IXRD: "_$$DATE^BGP4UTL(BGPISD)_" ["_BGPMP_"] Days="_DAYS

 +43       IF TYPE'="ANTIRET"

               SET %=$SELECT(PER>79:">80",1:"<80")

               SET C=C_" "_%

 +44       IF TYPE="ANTIRET"

               SET %=$SELECT(PER>89:">90",1:"<90")

               SET C=C_" "_%

 +45       IF TYPE'="ANTIRET"

               SET C=C_$SELECT(GAP:", GAP="_GAP,1:"")

 +46      ;CALULATE %COVERAGE AND GAP DAYS

 +47       QUIT C

 +48      ;

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

HADWARF(P,BDATE,EDATE) ;

 +1        NEW BGPMEDS1,C,A,M

 +2        KILL BGPMEDS1

 +3        DO GETMEDS^BGP4UTL2(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

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

BGP4D39.m