BGP8D81 ; IHS/CMI/LAB - measure C 17 Oct 2014 8:51 AM ;
;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
;
IAST1 ;EP
S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPD10,BGPD11,BGPD12)=0
I 'BGPACTUP S BGPSTOP=1 Q
I BGPAGEB<1 S BGPSTOP=1 Q ;not 1 or older
S BGPVAL=$$V2ASTH(DFN,BGPBDATE,BGPEDATE) I 'BGPVAL S BGPSTOP=1 Q ;no asthma visits or persistent in ats
I BGPACTCL S BGPD1=1
I BGPACTCL,BGPAGEB>0,BGPAGEB<5 S BGPD2=1
I BGPACTCL,BGPAGEB>4,BGPAGEB<20 S BGPD3=1
I BGPACTCL,BGPAGEB>19,BGPAGEB<45 S BGPD4=1
I BGPACTCL,BGPAGEB>44,BGPAGEB<65 S BGPD5=1
I BGPACTCL,BGPAGEB>64 S BGPD6=1
I BGPACTUP S BGPD7=1
I BGPACTUP,BGPAGEB>0,BGPAGEB<5 S BGPD8=1
I BGPACTUP,BGPAGEB>4,BGPAGEB<20 S BGPD9=1
I BGPACTUP,BGPAGEB>19,BGPAGEB<45 S BGPD10=1
I BGPACTUP,BGPAGEB>44,BGPAGEB<65 S BGPD11=1
I BGPACTUP,BGPAGEB>64 S BGPD12=1
S BGPV=$$INHALED(DFN,BGPBDATE,BGPEDATE)
S BGPN1=+BGPV
S BGPVALUE="UP"_$S(BGPD1:";AC",1:"")_" "_$P(BGPVAL,U,2)_"|||"_$S($P(BGPV,U)=1:"NUM: "_$P(BGPV,U,3)_" "_$P(BGPV,U,2),1:"")
K X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,T
Q
V2ASTH(P,BDATE,EDATE) ;EP
I '$G(P) Q ""
I $$ASEX(P,EDATE) Q "" ;exclusion
;find problem list active for asthma with 2, 3 or 4 in 15th piece
NEW S,A,B,T,X,G,V,Y,EDATE1
S G=""
S T=$O(^ATXAX("B","BGP ASTHMA DXS",0))
S (X,G)=0 F S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X!(G) D
.I $P(^AUPNPROB(X,0),U,13)="" Q:$P(^AUPNPROB(X,0),U,8)>EDATE
.Q:$P(^AUPNPROB(X,0),U,13)>EDATE
.S Y=$P(^AUPNPROB(X,0),U)
.Q:$P(^AUPNPROB(X,0),U,12)="D"
.Q:$P(^AUPNPROB(X,0),U,12)="I"
.S S=$$VAL^XBDIQ1(9000011,X,80001)
.I S]"",$D(^XTMP("BGPSNOMEDSUBSET",$J,SNPA,S)) S Z="PL Snomed "_S G ASSEVNS
.I $$ICD^BGP8UTL2(Y,T,9),$P(^AUPNPROB(X,0),U,15)]"",$P(^AUPNPROB(X,0),U,15)>1 S Z=$P(^AUPNPROB(X,0),U,15) G ASSEVNS
.I $$ICD^BGP8UTL2(Y,T,9) S G=$$SEVPER^BGP8D22(X) I G S Z=G G ASSEVNS
.I S]"",$D(^XTMP("BGPSNOMEDSUBSET",$J,SNA,S)),$P(^AUPNPROB(X,0),U,15)]"",$P(^AUPNPROB(X,0),U,15)>1 S Z=$P(^AUPNPROB(X,0),U,15) G ASSEVNS
.I S]"",$D(^XTMP("BGPSNOMEDSUBSET",$J,SNA,S)) S G=$$SEVPER^BGP8D22(X) I G S Z=G G ASSEVNS
.Q
ASSEVNS .;
.S G=1_U_"PL "_$P(^ICD9(Y,0),U)_"=Pers: "_Z ;$P(^AUPNPROB(X,0),U,15)
.Q
I G Q G
;I $P($G(^BATREG(P,0)),U,2)'="A" G DXS ;not active on asthma register
S S=""
S EDATE1=9999999-EDATE-1
S D=$O(^AUPNVAST("AS",P,EDATE1))
I 'D G DXS
S LAST="",E=0 F S E=$O(^AUPNVAST("AS",P,D,E)) Q:E'=+E S LAST=E
I 'LAST G DXS
S S=^AUPNVAST("AS",P,D,LAST)
I S>1 Q 1_U_"V Asthma=Pers"
DXS I '$D(^AUPNVSIT("AC",P)) Q ""
K ^TMP($J,"A")
S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
I '$D(^TMP($J,"A",1)) Q ""
S T=$O(^ATXAX("B","BGP ASTHMA DXS",0))
I 'T Q ""
S (X,G)=0 F S X=$O(^TMP($J,"A",X)) Q:X'=+X!(G>1) S V=$P(^TMP($J,"A",X),U,5) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$P(^AUPNVSIT(V,0),U,9)
.Q:$P(^AUPNVSIT(V,0),U,11)
.Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
.S (D,Y)=0 F S Y=$O(^AUPNVPOV("AD",V,Y)) Q:Y'=+Y!(D) I $D(^AUPNVPOV(Y,0)) S %=$P(^AUPNVPOV(Y,0),U) I $$ICD^BGP8UTL2(%,T,9) S D=1
.Q:'D
.S G=G+1
.Q
I G>1 Q 1_U_"2 DXs"
Q ""
ASEX(P,EDATE) ;
;2014 - exclusion changed to be active problem with intermittent asthma
;now check problem list
NEW T,G,X,Y
S T=$O(^ATXAX("B","BGP ASTHMA DXS",0))
S (X,G)=0 F S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X!(G) D
.Q:$P(^AUPNPROB(X,0),U,8)>EDATE ;if added to pl after end of time period
.S Y=$P(^AUPNPROB(X,0),U)
.Q:$P(^AUPNPROB(X,0),U,12)="D"
.Q:$P(^AUPNPROB(X,0),U,12)="I"
.Q:'$$ICD^BGP8UTL2(Y,T,9)
.Q:$P(^AUPNPROB(X,0),U,15)'=1
.S G=1
.Q
I G Q G
;I $P($G(^BATREG(P,0)),U,2)'="A" Q "" ;not active on asthma register
NEW EDATE1,D
S EDATE1=9999999-EDATE-1
S D=$O(^AUPNVAST("AS",P,EDATE1))
I 'D Q ""
;I D>(9999999-BDATE) Q ""
S LAST="",E=0 F S E=$O(^AUPNVAST("AS",P,D,E)) Q:E'=+E S LAST=E
I 'LAST Q ""
S S=^AUPNVAST("AS",P,D,LAST)
I S=1 Q 1
Q ""
LAST(P,BDATE,EDATE) ;EP last asthma dx
K BGPG
S Y="BGPG("
S X=P_"^LAST DX [BGP ASTHMA DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
I $D(BGPG(1)) Q $$DATE^BGP8UTL($P(BGPG(1),U))_" "_$P(BGPG(1),U,2)
Q ""
NDC(A,B) ;
;a is drug ien
;b is taxonomy ien
S BGPNDC=$P($G(^PSDRUG(A,2)),U,4)
I BGPNDC]"",B,$D(^ATXAX(B,21,"B",BGPNDC)) Q 1
Q 0
LEUK(A,B,C) ;
;a drug ien
;b tax ien
;c tax ien for ndc
I $D(^ATXAX(B,21,"B",A)) Q 1
I $$NDC(A,C) Q 1
Q ""
INHALED(P,BDATE,EDATE) ;EP - any inhaled steroid?
NEW BGPMEDS1,T1,T4,X,G,M,E,T,Y,V,Z
D GETMEDS^BGP8UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
I '$D(BGPMEDS1) Q ""
S T1=$O(^ATXAX("B","BGP PQA ASTHMA INHALE STER MED",0))
S T4=$O(^ATXAX("B","BGP PQA ASTHMA INHALE STER NDC",0))
S (X,G,M,E,T)=0,D="" F S X=$O(BGPMEDS1(X)) Q:X'=+X!(T>1) S V=$P(BGPMEDS1(X),U,5),Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
.I $D(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4)),'$$STATDC(Y) D
..S T=T+1
..I D="" S D=1_U_$$DATE^BGP8UTL($P($P(^AUPNVSIT(V,0),U),"."))_$P(^PSDRUG(Z,0),U) Q ;it is an inhaled steroid that wasn't d/c'ed so 1 dispensing event
..S D=D_", "_$$DATE^BGP8UTL($P($P(^AUPNVSIT(V,0),U),"."))_" "_$P(^PSDRUG(Z,0),U)
I T<2 Q ""
Q D
VAPI(A,B) ;EP
;a is drug ien
;b is taxonomy ien
NEW Z,Y
S Z=$$GET1^DIQ(50,A,22,"I") ;INTERNAL
I 'Z Q 0
S Y=$$GET1^DIQ(50.68,Z,6)
I Y="" Q 0
I $D(^ATXAX(B,21,"B",Y)) Q 1
Q 0
STATDC(V) ;EP - is the prescription associated with this V MED discontinued?
I '$G(V) Q ""
I '$D(^AUPNVMED(V,0)) Q 0
NEW P,S,X
S P=$S($D(^PSRX("APCC",V)):$O(^(V,0)),1:0)
I 'P Q 0
S X=$P($G(^PSRX(P,0)),U,15)
I X=12 Q 1
I X=13 Q 1
I X=14 Q 1
I X=15 Q 1
S X=$P($G(^PSRX(P,"STA")),U,1)
I X=12 Q 1
I X=13 Q 1
I X=14 Q 1
I X=15 Q 1
Q 0
;
ASTHTHER ;EP
S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPD10,BGPD11,BGPCON3,BGPD1)=0
NEW BGPSABA,BGPCON3,BGPASTH1,BGPASTH2,BGPCORT,BGPCICS
I 'BGPACTCL S BGPSTOP=1 Q
I BGPAGEB<5 S BGPSTOP=1 Q ;not 5 or older
;I BGPAGEB>50 S BGPSTOP=1 Q ;over 50
;S BGPVAL=$$V2ASTH(DFN,BGPBDATE,BGPEDATE) I 'BGPVAL S BGPSTOP=1 Q ;no asthma visits or persistent in ats
I $$EMP^BGP8D213(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE) S BGPSTOP=1 Q ;has dx of emphysema
I $$COPD^BGP8D22(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE) S BGPSTOP=1 Q ;has copd
S (BGPASTH1,BGPASTH2)=$$ASSEV^BGP8D22(DFN,BGPEDATE)
I BGPASTH1="" S BGPASTH1=$$PERASTH^BGP8D22(DFN,$$FMADD^XLFDT(BGPBDATE,-365),BGPBDATE)
I BGPASTH2="" S BGPASTH2=$$PERASTH^BGP8D22(DFN,BGPBDATE,BGPEDATE)
I 'BGPASTH1!('BGPASTH2) K ^TMP($J,"A") S BGPSTOP=1 Q ;not asthma in both time periods
K ^TMP($J,"A")
I BGPAGEB<51 S BGPD1=1
S BGPD2=1 ;ALL 5-50
I BGPAGEB>4,BGPAGEB<15 S BGPD3=1
I BGPAGEB>15,BGPAGEB<35 S BGPD4=1
I BGPAGEB>34,BGPAGEB<65 S BGPD5=1
I BGPAGEB>64 S BGPD6=1
S BGPVALUE="AC,"_$P(BGPASTH1,U,2)_" "_$S(BGPASTH1'=BGPASTH2:$P(BGPASTH2,U,2),1:"")_"|||"
S BGPSABA=$$SABA(DFN,BGPBDATE,BGPEDATE) ;1 (HAD 4 CANISTERS)^1 (HAD CONTROLLER)^LIST DISPLAY
K ^TMP($J,"A"),BGPMEDS1
S BGPVALUE=BGPVALUE_$P(BGPSABA,U,3) I $P(BGPSABA,U,2) S BGPVALUE=BGPVALUE_"; "_$P(BGPSABA,U,4)
I $P(BGPSABA,U,1) S BGPN1=1
I $P(BGPSABA,U,1),'$P(BGPSABA,U,2) S BGPN2=1 ;HAD SABA BUT NO CONTROLLER
;numerator 3 had 2 OR MORE CONTROLLER THERAPIES
S BGPCON3=$$CONT(DFN,BGPBDATE,BGPEDATE)
I $P(BGPCON3,U,1) S BGPN3=1 S:$P(BGPVALUE,"|||",2)]"" BGPVALUE=BGPVALUE_"; " S BGPVALUE=BGPVALUE_"2+ CONT: "_$P(BGPCON3,U,2)
S BGPCICS=$$INHALED(DFN,BGPBDATE,BGPEDATE)
I $P(BGPCICS,U,1) S BGPN4=1 S:$P(BGPVALUE,"|||",2)]"" BGPVALUE=BGPVALUE_"; " S BGPVALUE=BGPVALUE_"2+ STEROID: "_$P(BGPCICS,U,2)
;denominator 7 had 2 or more laba meds during report period
S BGPLABA=$$LABA(DFN,BGPBDATE,BGPEDATE)
I $P(BGPLABA,U,1) D
.S BGPD7=1 S $P(BGPVALUE,"|||",1)=$P(BGPVALUE,"|||",1)_", LABA"
.I BGPAGEB>5,BGPAGEB<15 S BGPD8=1
.I BGPAGEB>15,BGPAGEB<35 S BGPD9=1
.I BGPAGEB>34,BGPAGEB<65 S BGPD10=1
.I BGPAGEB>64 S BGPD11=1
K BGPSABA,BGPVAL
Q
SABA(P,BDATE,EDATE) ;EP - any SABA?
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,Q,V1,V1D,M1,TQ,QG
K BGPMEDS1
D GETMEDS^BGP8UTL2(P,BDATE,EDATE,"BGP PQA SABA MEDS","BGP PQA SABA NDC",,,.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 $$STATDC(M) K BGPMEDS1(A) Q ;d/c'ed BY PROVIDER OR EDIT
.S Q=$P(^AUPNVMED(M,0),U,6) I 'Q K BGPMEDS1(A) Q ;no quantity
;now go through and see if there are a quantity of 4 in any 90 day period
S Q=0,G=""
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X!(G) D CHK90
I 'G Q G
;CHECK FOR CONTROLLER BETWEEN SD AND E
K BGPMEDS1,^TMP($J,"A")
D GETMEDS^BGP8UTL2(P,SD,E,"BGP PQA CONTROLLER MEDS","BGP PQA CONTROLLER NDC",,,.BGPMEDS1)
I '$D(BGPMEDS1) Q G ; no CONTROLLER meds
S BGPISD=""
S A=0,C="" F S A=$O(BGPMEDS1(A)) Q:A'=+A!(C) 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 $$STATDC(M) K BGPMEDS1(A) Q ;d/c'ed BY PROVIDER OR EDIT
.S V=$P(BGPMEDS1(A),U,5)
.S V1D=$$VD^APCLV(V)
.S C=1_U_"CONT THPY: "_$$DATE^BGP8UTL(V1D)_" "_$$VAL^XBDIQ1(9000010.14,M,.01)
I 'C Q G
S $P(G,U,2)=1,$P(G,U,4)=$P(C,U,2)
K BGPMEDS1,^TMP($J,"A")
Q G
CANI(D,Q) ;get order unit from drug entry and divide by quantity.
NEW O
;GET ORDER UNITS
S O=$P($G(^PSDRUG(D,660)),U,5)
I O="" Q Q
Q Q/O
CHK90 ;
;get date of med and add 90 days
S G=""
K T
S C=0
S V=$P(BGPMEDS1(X),U,5)
S SD=$$VD^APCLV(V) ;start date of med
S E=$$FMADD^XLFDT(SD,90) ;add 90 days
S M=$P(BGPMEDS1(X),U,4)
S QG=$P(^AUPNVMED(M,0),U,6) ;# of canisters
S (TQ,Q)=$$CANI($P(^AUPNVMED(M,0),U,1),QG)
S C=C+1,T(C)=$$DATE^BGP8UTL(SD)_U_$$VAL^XBDIQ1(9000010.14,M,.01)_U_"("_Q_")"
S Y=X F S Y=$O(BGPMEDS1(Y)) Q:Y'=+Y D
.S V1=$P(BGPMEDS1(Y),U,5)
.S V1D=$$VD^APCLV(V1)
.Q:V1D>E ;after the 90 days
.S M1=$P(BGPMEDS1(Y),U,4)
.S QG=$P(^AUPNVMED(M1,0),U,6) ;# of canisters
.S Q=$$CANI($P(^AUPNVMED(M1,0),U,1),QG)
.S C=C+1,T(C)=$$DATE^BGP8UTL(V1D)_U_$$VAL^XBDIQ1(9000010.14,M1,.01)_U_" ("_Q_")"
.S TQ=TQ+Q
Q:TQ<4
S D=0,Z="" F S D=$O(T(D)) Q:D'=+D S Z=Z_$S(Z]"":" ",1:""),Z=Z_$P(T(D),U,1)_" "_$P(T(D),U,2)_$P(T(D),U,3)
S G=1_U_0_U_"SABA: "_Z_U
Q
CONT(P,BDATE,EDATE) ;controller meds (at least 2)
NEW A,C,G,V1D,BGPMEDS1,T
K BGPMEDS1,^TMP($J,"A")
D GETMEDS^BGP8UTL2(P,BDATE,EDATE,"BGP PQA CONTROLLER MEDS","BGP PQA CONTROLLER NDC",,,.BGPMEDS1)
S G=""
I '$D(BGPMEDS1) Q G ; no CONTROLLER meds
S BGPISD=""
S A=0,C="",T=0 F S A=$O(BGPMEDS1(A)) Q:A'=+A!(T>1) 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 $$STATDC(M) K BGPMEDS1(A) Q ;d/c'ed BY PROVIDER OR EDIT
.S V=$P(BGPMEDS1(A),U,5)
.S V1D=$$VD^APCLV(V)
.S T=T+1
.I C="" S C=1_U_""_$$DATE^BGP8UTL(V1D)_" "_$$VAL^XBDIQ1(9000010.14,M,.01) I 1
.E S C=C_", "_$$DATE^BGP8UTL(V1D)_" "_$$VAL^XBDIQ1(9000010.14,M,.01)
I T>1 Q C
Q ""
;
LABA(P,BDATE,EDATE) ;EP - any inhaled steroid?
NEW BGPMEDS1,T1,T4,X,G,M,E,T,Y,V,Z
D GETMEDS^BGP8UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
I '$D(BGPMEDS1) Q ""
S T1=$O(^ATXAX("B","BGP ASTHMA LABA MEDS",0))
S T4=$O(^ATXAX("B","BGP ASTHMA LABA NDC",0))
S (X,G,M,E,T)=0,D="" F S X=$O(BGPMEDS1(X)) Q:X'=+X!(T>1) S V=$P(BGPMEDS1(X),U,5),Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
.I $D(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4)),'$$STATDC(Y) D
..S T=T+1
..I D="" S D=1_U_"LABA: "_$P(^PSDRUG(Z,0),U)_U_$$DATE^BGP8UTL($P($P(^AUPNVSIT(V,0),U),".")) Q ;it is an inhaled steroid that wasn't d/c'ed so 1 dispensing event
..S D=D_", "_$P(^PSDRUG(Z,0),U)_U_$$DATE^BGP8UTL($P($P(^AUPNVSIT(V,0),U),"."))
I T<2 Q ""
Q D
BGP8D81 ; IHS/CMI/LAB - measure C 17 Oct 2014 8:51 AM ;
+1 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
+2 ;
IAST1 ;EP
+1 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPD10,BGPD11,BGPD12)=0
+2 IF 'BGPACTUP
SET BGPSTOP=1
QUIT
+3 ;not 1 or older
IF BGPAGEB<1
SET BGPSTOP=1
QUIT
+4 ;no asthma visits or persistent in ats
SET BGPVAL=$$V2ASTH(DFN,BGPBDATE,BGPEDATE)
IF 'BGPVAL
SET BGPSTOP=1
QUIT
+5 IF BGPACTCL
SET BGPD1=1
+6 IF BGPACTCL
IF BGPAGEB>0
IF BGPAGEB<5
SET BGPD2=1
+7 IF BGPACTCL
IF BGPAGEB>4
IF BGPAGEB<20
SET BGPD3=1
+8 IF BGPACTCL
IF BGPAGEB>19
IF BGPAGEB<45
SET BGPD4=1
+9 IF BGPACTCL
IF BGPAGEB>44
IF BGPAGEB<65
SET BGPD5=1
+10 IF BGPACTCL
IF BGPAGEB>64
SET BGPD6=1
+11 IF BGPACTUP
SET BGPD7=1
+12 IF BGPACTUP
IF BGPAGEB>0
IF BGPAGEB<5
SET BGPD8=1
+13 IF BGPACTUP
IF BGPAGEB>4
IF BGPAGEB<20
SET BGPD9=1
+14 IF BGPACTUP
IF BGPAGEB>19
IF BGPAGEB<45
SET BGPD10=1
+15 IF BGPACTUP
IF BGPAGEB>44
IF BGPAGEB<65
SET BGPD11=1
+16 IF BGPACTUP
IF BGPAGEB>64
SET BGPD12=1
+17 SET BGPV=$$INHALED(DFN,BGPBDATE,BGPEDATE)
+18 SET BGPN1=+BGPV
+19 SET BGPVALUE="UP"_$SELECT(BGPD1:";AC",1:"")_" "_$PIECE(BGPVAL,U,2)_"|||"_$SELECT($PIECE(BGPV,U)=1:"NUM: "_$PIECE(BGPV,U,3)_" "_$PIECE(BGPV,U,2),1:"")
+20 KILL X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,T
+21 QUIT
V2ASTH(P,BDATE,EDATE) ;EP
+1 IF '$GET(P)
QUIT ""
+2 ;exclusion
IF $$ASEX(P,EDATE)
QUIT ""
+3 ;find problem list active for asthma with 2, 3 or 4 in 15th piece
+4 NEW S,A,B,T,X,G,V,Y,EDATE1
+5 SET G=""
+6 SET T=$ORDER(^ATXAX("B","BGP ASTHMA DXS",0))
+7 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNPROB("AC",P,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+8 IF $PIECE(^AUPNPROB(X,0),U,13)=""
IF $PIECE(^AUPNPROB(X,0),U,8)>EDATE
QUIT
+9 IF $PIECE(^AUPNPROB(X,0),U,13)>EDATE
QUIT
+10 SET Y=$PIECE(^AUPNPROB(X,0),U)
+11 IF $PIECE(^AUPNPROB(X,0),U,12)="D"
QUIT
+12 IF $PIECE(^AUPNPROB(X,0),U,12)="I"
QUIT
+13 SET S=$$VAL^XBDIQ1(9000011,X,80001)
+14 IF S]""
IF $DATA(^XTMP("BGPSNOMEDSUBSET",$JOB,SNPA,S))
SET Z="PL Snomed "_S
GOTO ASSEVNS
+15 IF $$ICD^BGP8UTL2(Y,T,9)
IF $PIECE(^AUPNPROB(X,0),U,15)]""
IF $PIECE(^AUPNPROB(X,0),U,15)>1
SET Z=$PIECE(^AUPNPROB(X,0),U,15)
GOTO ASSEVNS
+16 IF $$ICD^BGP8UTL2(Y,T,9)
SET G=$$SEVPER^BGP8D22(X)
IF G
SET Z=G
GOTO ASSEVNS
+17 IF S]""
IF $DATA(^XTMP("BGPSNOMEDSUBSET",$JOB,SNA,S))
IF $PIECE(^AUPNPROB(X,0),U,15)]""
IF $PIECE(^AUPNPROB(X,0),U,15)>1
SET Z=$PIECE(^AUPNPROB(X,0),U,15)
GOTO ASSEVNS
+18 IF S]""
IF $DATA(^XTMP("BGPSNOMEDSUBSET",$JOB,SNA,S))
SET G=$$SEVPER^BGP8D22(X)
IF G
SET Z=G
GOTO ASSEVNS
+19 QUIT
ASSEVNS ;
+1 ;$P(^AUPNPROB(X,0),U,15)
SET G=1_U_"PL "_$PIECE(^ICD9(Y,0),U)_"=Pers: "_Z
+2 QUIT
End DoDot:1
+3 IF G
QUIT G
+4 ;I $P($G(^BATREG(P,0)),U,2)'="A" G DXS ;not active on asthma register
+5 SET S=""
+6 SET EDATE1=9999999-EDATE-1
+7 SET D=$ORDER(^AUPNVAST("AS",P,EDATE1))
+8 IF 'D
GOTO DXS
+9 SET LAST=""
SET E=0
FOR
SET E=$ORDER(^AUPNVAST("AS",P,D,E))
IF E'=+E
QUIT
SET LAST=E
+10 IF 'LAST
GOTO DXS
+11 SET S=^AUPNVAST("AS",P,D,LAST)
+12 IF S>1
QUIT 1_U_"V Asthma=Pers"
DXS IF '$DATA(^AUPNVSIT("AC",P))
QUIT ""
+1 KILL ^TMP($JOB,"A")
+2 SET A="^TMP($J,""A"","
SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(B,A)
+3 IF '$DATA(^TMP($JOB,"A",1))
QUIT ""
+4 SET T=$ORDER(^ATXAX("B","BGP ASTHMA DXS",0))
+5 IF 'T
QUIT ""
+6 SET (X,G)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(G>1)
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+7 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+8 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+9 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+10 IF "SAHO"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+11 SET (D,Y)=0
FOR
SET Y=$ORDER(^AUPNVPOV("AD",V,Y))
IF Y'=+Y!(D)
QUIT
IF $DATA(^AUPNVPOV(Y,0))
SET %=$PIECE(^AUPNVPOV(Y,0),U)
IF $$ICD^BGP8UTL2(%,T,9)
SET D=1
+12 IF 'D
QUIT
+13 SET G=G+1
+14 QUIT
End DoDot:1
+15 IF G>1
QUIT 1_U_"2 DXs"
+16 QUIT ""
ASEX(P,EDATE) ;
+1 ;2014 - exclusion changed to be active problem with intermittent asthma
+2 ;now check problem list
+3 NEW T,G,X,Y
+4 SET T=$ORDER(^ATXAX("B","BGP ASTHMA DXS",0))
+5 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNPROB("AC",P,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+6 ;if added to pl after end of time period
IF $PIECE(^AUPNPROB(X,0),U,8)>EDATE
QUIT
+7 SET Y=$PIECE(^AUPNPROB(X,0),U)
+8 IF $PIECE(^AUPNPROB(X,0),U,12)="D"
QUIT
+9 IF $PIECE(^AUPNPROB(X,0),U,12)="I"
QUIT
+10 IF '$$ICD^BGP8UTL2(Y,T,9)
QUIT
+11 IF $PIECE(^AUPNPROB(X,0),U,15)'=1
QUIT
+12 SET G=1
+13 QUIT
End DoDot:1
+14 IF G
QUIT G
+15 ;I $P($G(^BATREG(P,0)),U,2)'="A" Q "" ;not active on asthma register
+16 NEW EDATE1,D
+17 SET EDATE1=9999999-EDATE-1
+18 SET D=$ORDER(^AUPNVAST("AS",P,EDATE1))
+19 IF 'D
QUIT ""
+20 ;I D>(9999999-BDATE) Q ""
+21 SET LAST=""
SET E=0
FOR
SET E=$ORDER(^AUPNVAST("AS",P,D,E))
IF E'=+E
QUIT
SET LAST=E
+22 IF 'LAST
QUIT ""
+23 SET S=^AUPNVAST("AS",P,D,LAST)
+24 IF S=1
QUIT 1
+25 QUIT ""
LAST(P,BDATE,EDATE) ;EP last asthma dx
+1 KILL BGPG
+2 SET Y="BGPG("
+3 SET X=P_"^LAST DX [BGP ASTHMA DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+4 IF $DATA(BGPG(1))
QUIT $$DATE^BGP8UTL($PIECE(BGPG(1),U))_" "_$PIECE(BGPG(1),U,2)
+5 QUIT ""
NDC(A,B) ;
+1 ;a is drug ien
+2 ;b is taxonomy ien
+3 SET BGPNDC=$PIECE($GET(^PSDRUG(A,2)),U,4)
+4 IF BGPNDC]""
IF B
IF $DATA(^ATXAX(B,21,"B",BGPNDC))
QUIT 1
+5 QUIT 0
LEUK(A,B,C) ;
+1 ;a drug ien
+2 ;b tax ien
+3 ;c tax ien for ndc
+4 IF $DATA(^ATXAX(B,21,"B",A))
QUIT 1
+5 IF $$NDC(A,C)
QUIT 1
+6 QUIT ""
INHALED(P,BDATE,EDATE) ;EP - any inhaled steroid?
+1 NEW BGPMEDS1,T1,T4,X,G,M,E,T,Y,V,Z
+2 DO GETMEDS^BGP8UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
+3 IF '$DATA(BGPMEDS1)
QUIT ""
+4 SET T1=$ORDER(^ATXAX("B","BGP PQA ASTHMA INHALE STER MED",0))
+5 SET T4=$ORDER(^ATXAX("B","BGP PQA ASTHMA INHALE STER NDC",0))
+6 SET (X,G,M,E,T)=0
SET D=""
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X!(T>1)
QUIT
SET V=$PIECE(BGPMEDS1(X),U,5)
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+7 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+8 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+9 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+10 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+11 IF $DATA(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4))
IF '$$STATDC(Y)
Begin DoDot:2
+12 SET T=T+1
+13 ;it is an inhaled steroid that wasn't d/c'ed so 1 dispensing event
IF D=""
SET D=1_U_$$DATE^BGP8UTL($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))_$PIECE(^PSDRUG(Z,0),U)
QUIT
+14 SET D=D_", "_$$DATE^BGP8UTL($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))_" "_$PIECE(^PSDRUG(Z,0),U)
End DoDot:2
End DoDot:1
+15 IF T<2
QUIT ""
+16 QUIT D
VAPI(A,B) ;EP
+1 ;a is drug ien
+2 ;b is taxonomy ien
+3 NEW Z,Y
+4 ;INTERNAL
SET Z=$$GET1^DIQ(50,A,22,"I")
+5 IF 'Z
QUIT 0
+6 SET Y=$$GET1^DIQ(50.68,Z,6)
+7 IF Y=""
QUIT 0
+8 IF $DATA(^ATXAX(B,21,"B",Y))
QUIT 1
+9 QUIT 0
STATDC(V) ;EP - is the prescription associated with this V MED discontinued?
+1 IF '$GET(V)
QUIT ""
+2 IF '$DATA(^AUPNVMED(V,0))
QUIT 0
+3 NEW P,S,X
+4 SET P=$SELECT($DATA(^PSRX("APCC",V)):$ORDER(^(V,0)),1:0)
+5 IF 'P
QUIT 0
+6 SET X=$PIECE($GET(^PSRX(P,0)),U,15)
+7 IF X=12
QUIT 1
+8 IF X=13
QUIT 1
+9 IF X=14
QUIT 1
+10 IF X=15
QUIT 1
+11 SET X=$PIECE($GET(^PSRX(P,"STA")),U,1)
+12 IF X=12
QUIT 1
+13 IF X=13
QUIT 1
+14 IF X=14
QUIT 1
+15 IF X=15
QUIT 1
+16 QUIT 0
+17 ;
ASTHTHER ;EP
+1 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPD10,BGPD11,BGPCON3,BGPD1)=0
+2 NEW BGPSABA,BGPCON3,BGPASTH1,BGPASTH2,BGPCORT,BGPCICS
+3 IF 'BGPACTCL
SET BGPSTOP=1
QUIT
+4 ;not 5 or older
IF BGPAGEB<5
SET BGPSTOP=1
QUIT
+5 ;I BGPAGEB>50 S BGPSTOP=1 Q ;over 50
+6 ;S BGPVAL=$$V2ASTH(DFN,BGPBDATE,BGPEDATE) I 'BGPVAL S BGPSTOP=1 Q ;no asthma visits or persistent in ats
+7 ;has dx of emphysema
IF $$EMP^BGP8D213(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
SET BGPSTOP=1
QUIT
+8 ;has copd
IF $$COPD^BGP8D22(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
SET BGPSTOP=1
QUIT
+9 SET (BGPASTH1,BGPASTH2)=$$ASSEV^BGP8D22(DFN,BGPEDATE)
+10 IF BGPASTH1=""
SET BGPASTH1=$$PERASTH^BGP8D22(DFN,$$FMADD^XLFDT(BGPBDATE,-365),BGPBDATE)
+11 IF BGPASTH2=""
SET BGPASTH2=$$PERASTH^BGP8D22(DFN,BGPBDATE,BGPEDATE)
+12 ;not asthma in both time periods
IF 'BGPASTH1!('BGPASTH2)
KILL ^TMP($JOB,"A")
SET BGPSTOP=1
QUIT
+13 KILL ^TMP($JOB,"A")
+14 IF BGPAGEB<51
SET BGPD1=1
+15 ;ALL 5-50
SET BGPD2=1
+16 IF BGPAGEB>4
IF BGPAGEB<15
SET BGPD3=1
+17 IF BGPAGEB>15
IF BGPAGEB<35
SET BGPD4=1
+18 IF BGPAGEB>34
IF BGPAGEB<65
SET BGPD5=1
+19 IF BGPAGEB>64
SET BGPD6=1
+20 SET BGPVALUE="AC,"_$PIECE(BGPASTH1,U,2)_" "_$SELECT(BGPASTH1'=BGPASTH2:$PIECE(BGPASTH2,U,2),1:"")_"|||"
+21 ;1 (HAD 4 CANISTERS)^1 (HAD CONTROLLER)^LIST DISPLAY
SET BGPSABA=$$SABA(DFN,BGPBDATE,BGPEDATE)
+22 KILL ^TMP($JOB,"A"),BGPMEDS1
+23 SET BGPVALUE=BGPVALUE_$PIECE(BGPSABA,U,3)
IF $PIECE(BGPSABA,U,2)
SET BGPVALUE=BGPVALUE_"; "_$PIECE(BGPSABA,U,4)
+24 IF $PIECE(BGPSABA,U,1)
SET BGPN1=1
+25 ;HAD SABA BUT NO CONTROLLER
IF $PIECE(BGPSABA,U,1)
IF '$PIECE(BGPSABA,U,2)
SET BGPN2=1
+26 ;numerator 3 had 2 OR MORE CONTROLLER THERAPIES
+27 SET BGPCON3=$$CONT(DFN,BGPBDATE,BGPEDATE)
+28 IF $PIECE(BGPCON3,U,1)
SET BGPN3=1
IF $PIECE(BGPVALUE,"|||",2)]""
SET BGPVALUE=BGPVALUE_"; "
SET BGPVALUE=BGPVALUE_"2+ CONT: "_$PIECE(BGPCON3,U,2)
+29 SET BGPCICS=$$INHALED(DFN,BGPBDATE,BGPEDATE)
+30 IF $PIECE(BGPCICS,U,1)
SET BGPN4=1
IF $PIECE(BGPVALUE,"|||",2)]""
SET BGPVALUE=BGPVALUE_"; "
SET BGPVALUE=BGPVALUE_"2+ STEROID: "_$PIECE(BGPCICS,U,2)
+31 ;denominator 7 had 2 or more laba meds during report period
+32 SET BGPLABA=$$LABA(DFN,BGPBDATE,BGPEDATE)
+33 IF $PIECE(BGPLABA,U,1)
Begin DoDot:1
+34 SET BGPD7=1
SET $PIECE(BGPVALUE,"|||",1)=$PIECE(BGPVALUE,"|||",1)_", LABA"
+35 IF BGPAGEB>5
IF BGPAGEB<15
SET BGPD8=1
+36 IF BGPAGEB>15
IF BGPAGEB<35
SET BGPD9=1
+37 IF BGPAGEB>34
IF BGPAGEB<65
SET BGPD10=1
+38 IF BGPAGEB>64
SET BGPD11=1
End DoDot:1
+39 KILL BGPSABA,BGPVAL
+40 QUIT
SABA(P,BDATE,EDATE) ;EP - any SABA?
+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,Q,V1,V1D,M1,TQ,QG
+3 KILL BGPMEDS1
+4 DO GETMEDS^BGP8UTL2(P,BDATE,EDATE,"BGP PQA SABA MEDS","BGP PQA SABA NDC",,,.BGPMEDS1)
+5 ; no 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 BY PROVIDER OR EDIT
IF $$STATDC(M)
KILL BGPMEDS1(A)
QUIT
+12 ;no quantity
SET Q=$PIECE(^AUPNVMED(M,0),U,6)
IF 'Q
KILL BGPMEDS1(A)
QUIT
End DoDot:1
+13 ;now go through and see if there are a quantity of 4 in any 90 day period
+14 SET Q=0
SET G=""
+15 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X!(G)
QUIT
DO CHK90
+16 IF 'G
QUIT G
+17 ;CHECK FOR CONTROLLER BETWEEN SD AND E
+18 KILL BGPMEDS1,^TMP($JOB,"A")
+19 DO GETMEDS^BGP8UTL2(P,SD,E,"BGP PQA CONTROLLER MEDS","BGP PQA CONTROLLER NDC",,,.BGPMEDS1)
+20 ; no CONTROLLER meds
IF '$DATA(BGPMEDS1)
QUIT G
+21 SET BGPISD=""
+22 SET A=0
SET C=""
FOR
SET A=$ORDER(BGPMEDS1(A))
IF A'=+A!(C)
QUIT
Begin DoDot:1
+23 ;IEN OF V MED
SET M=$PIECE(BGPMEDS1(A),U,4)
+24 IF '$DATA(^AUPNVMED(M,0))
QUIT
+25 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(M,11)),U))["RETURNED TO STOCK"
KILL BGPMEDS1(A)
QUIT
+26 ;d/c'ed BY PROVIDER OR EDIT
IF $$STATDC(M)
KILL BGPMEDS1(A)
QUIT
+27 SET V=$PIECE(BGPMEDS1(A),U,5)
+28 SET V1D=$$VD^APCLV(V)
+29 SET C=1_U_"CONT THPY: "_$$DATE^BGP8UTL(V1D)_" "_$$VAL^XBDIQ1(9000010.14,M,.01)
End DoDot:1
+30 IF 'C
QUIT G
+31 SET $PIECE(G,U,2)=1
SET $PIECE(G,U,4)=$PIECE(C,U,2)
+32 KILL BGPMEDS1,^TMP($JOB,"A")
+33 QUIT G
CANI(D,Q) ;get order unit from drug entry and divide by quantity.
+1 NEW O
+2 ;GET ORDER UNITS
+3 SET O=$PIECE($GET(^PSDRUG(D,660)),U,5)
+4 IF O=""
QUIT Q
+5 QUIT Q/O
CHK90 ;
+1 ;get date of med and add 90 days
+2 SET G=""
+3 KILL T
+4 SET C=0
+5 SET V=$PIECE(BGPMEDS1(X),U,5)
+6 ;start date of med
SET SD=$$VD^APCLV(V)
+7 ;add 90 days
SET E=$$FMADD^XLFDT(SD,90)
+8 SET M=$PIECE(BGPMEDS1(X),U,4)
+9 ;# of canisters
SET QG=$PIECE(^AUPNVMED(M,0),U,6)
+10 SET (TQ,Q)=$$CANI($PIECE(^AUPNVMED(M,0),U,1),QG)
+11 SET C=C+1
SET T(C)=$$DATE^BGP8UTL(SD)_U_$$VAL^XBDIQ1(9000010.14,M,.01)_U_"("_Q_")"
+12 SET Y=X
FOR
SET Y=$ORDER(BGPMEDS1(Y))
IF Y'=+Y
QUIT
Begin DoDot:1
+13 SET V1=$PIECE(BGPMEDS1(Y),U,5)
+14 SET V1D=$$VD^APCLV(V1)
+15 ;after the 90 days
IF V1D>E
QUIT
+16 SET M1=$PIECE(BGPMEDS1(Y),U,4)
+17 ;# of canisters
SET QG=$PIECE(^AUPNVMED(M1,0),U,6)
+18 SET Q=$$CANI($PIECE(^AUPNVMED(M1,0),U,1),QG)
+19 SET C=C+1
SET T(C)=$$DATE^BGP8UTL(V1D)_U_$$VAL^XBDIQ1(9000010.14,M1,.01)_U_" ("_Q_")"
+20 SET TQ=TQ+Q
End DoDot:1
+21 IF TQ<4
QUIT
+22 SET D=0
SET Z=""
FOR
SET D=$ORDER(T(D))
IF D'=+D
QUIT
SET Z=Z_$SELECT(Z]"":" ",1:"")
SET Z=Z_$PIECE(T(D),U,1)_" "_$PIECE(T(D),U,2)_$PIECE(T(D),U,3)
+23 SET G=1_U_0_U_"SABA: "_Z_U
+24 QUIT
CONT(P,BDATE,EDATE) ;controller meds (at least 2)
+1 NEW A,C,G,V1D,BGPMEDS1,T
+2 KILL BGPMEDS1,^TMP($JOB,"A")
+3 DO GETMEDS^BGP8UTL2(P,BDATE,EDATE,"BGP PQA CONTROLLER MEDS","BGP PQA CONTROLLER NDC",,,.BGPMEDS1)
+4 SET G=""
+5 ; no CONTROLLER meds
IF '$DATA(BGPMEDS1)
QUIT G
+6 SET BGPISD=""
+7 SET A=0
SET C=""
SET T=0
FOR
SET A=$ORDER(BGPMEDS1(A))
IF A'=+A!(T>1)
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 BY PROVIDER OR EDIT
IF $$STATDC(M)
KILL BGPMEDS1(A)
QUIT
+12 SET V=$PIECE(BGPMEDS1(A),U,5)
+13 SET V1D=$$VD^APCLV(V)
+14 SET T=T+1
+15 IF C=""
SET C=1_U_""_$$DATE^BGP8UTL(V1D)_" "_$$VAL^XBDIQ1(9000010.14,M,.01)
IF 1
+16 IF '$TEST
SET C=C_", "_$$DATE^BGP8UTL(V1D)_" "_$$VAL^XBDIQ1(9000010.14,M,.01)
End DoDot:1
+17 IF T>1
QUIT C
+18 QUIT ""
+19 ;
LABA(P,BDATE,EDATE) ;EP - any inhaled steroid?
+1 NEW BGPMEDS1,T1,T4,X,G,M,E,T,Y,V,Z
+2 DO GETMEDS^BGP8UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
+3 IF '$DATA(BGPMEDS1)
QUIT ""
+4 SET T1=$ORDER(^ATXAX("B","BGP ASTHMA LABA MEDS",0))
+5 SET T4=$ORDER(^ATXAX("B","BGP ASTHMA LABA NDC",0))
+6 SET (X,G,M,E,T)=0
SET D=""
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X!(T>1)
QUIT
SET V=$PIECE(BGPMEDS1(X),U,5)
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+7 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+8 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+9 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+10 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+11 IF $DATA(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4))
IF '$$STATDC(Y)
Begin DoDot:2
+12 SET T=T+1
+13 ;it is an inhaled steroid that wasn't d/c'ed so 1 dispensing event
IF D=""
SET D=1_U_"LABA: "_$PIECE(^PSDRUG(Z,0),U)_U_$$DATE^BGP8UTL($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))
QUIT
+14 SET D=D_", "_$PIECE(^PSDRUG(Z,0),U)_U_$$DATE^BGP8UTL($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))
End DoDot:2
End DoDot:1
+15 IF T<2
QUIT ""
+16 QUIT D
