BGP4D89 ; IHS/CMI/LAB - measure C 03 Jul 2010 7:05 AM ;
;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
;
VS ;EP
S (BGPN1,BGPN2,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPD10,BGPD11)=0
I 'BGPACTCL S BGPSTOP=1 Q ;not active clinical pt
;SET UP DENOMINATORS
S BGPD1=1 ;all A/C
I BGPAGEB>1,BGPAGEB<19 S BGPD2=1
I BGPAGEB>4 S BGPD3=1
I BGPAGEB>11,BGPAGEB<19 S BGPD4=1
I BGPAGEB>11,BGPAGEB<76 S BGPD5=1
I BGPSEX="F",BGPAGEB>14,BGPAGEB<41 S BGPD6=1
I BGPSEX="F",BGPAGEB>14,BGPAGEB<45 S BGPD7=1
I BGPAGEB>17 S BGPD8=1
I BGPAGEB>64 S BGPD9=1
I $$TOBUSER(DFN,BGPBDATE) S BGPD10=1
S BGPQV=$$VISIT(DFN,BGPBDATE,BGPEDATE)
I 'BGPQV S BGPN1=1
S BGPURO=$$UCONLY(DFN,BGP3YE,BGPEDATE)
I 'BGPURO S BGPN2=1 ;urgent care only visit
S D="AC"
I BGPD2 S D=D_",AC 2-18"
I BGPD3 S D=D_",AC =>5"
I BGPD4 S D=D_",AC 12-18"
I BGPD5 S D=D_",AC 12-75"
I BGPD6 S D=D_",FEM AC 15-40"
I BGPD7 S D=D_",FEM AC 15-44"
I BGPD8 S D=D_",AC =>18"
I BGPD9 S D=D_",AC =>65"
I BGPD10 S D=D_",TOB"
S BGPVALUE="AC"_$S(BGPD10:",TOB",1:"")_"|||"_$S('BGPN1:"No visit in time period",1:"Visit in time period "_$$DATE^BGP4UTL(BGPQV))_" Urgent Care Only: "_$$DATE^BGP4UTL(BGPURO)
S BGPVALUD="AC"_$S(BGPD10:",TOB",1:"")_"|||"
K X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,T
K BGPEDUC,BGPHIV
Q
VISIT(P,BDATE,EDATE) ;
K ^TMP($J,"A")
NEW A,C,B,E,X,G,V
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 (X,G)=0 F S X=$O(^TMP($J,"A",X)) Q:X'=+X!(G) 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:"SAHOR"'[$P(^AUPNVSIT(V,0),U,7)
.Q:$P(^AUPNVSIT(V,0),U,6)=""
.S C=$$CLINIC^APCLV(V,"C")
.Q:C=42
.Q:C=51
.Q:C=52
.Q:C=53
.S G=$$VD^APCLV(V)
.Q
Q G
TOBUSER(P,BDATE) ;EP
NEW BGPTUSER,%,BGPTOBP,BGPSDX,BGPSCPT,F
S BGPTUSER=""
S BGPTOBP=$$TOBHF^BGP4D712(P,$$DOB^AUPNPAT(P),$$FMADD^XLFDT(BDATE,-1))
S BGPSDX=$$DXU^BGP4D7(P,$$DOB^AUPNPAT(P),$$FMADD^XLFDT(BDATE,-1))
S BGPSCPT=$$CPTSM^BGP4D7(P,$$DOB^AUPNPAT(P),$$FMADD^XLFDT(BDATE,-1))
S %=""
;I BGPSDX]"",$P(BGPSDX,U)="V15.82" S %=1
;I BGPSDX]"",$P(BGPSDX,U)="305.13" S %=1
S T=$O(^ATXAX("B","BGP TOBACCO PAST USE DXS",0))
I BGPSDX]"" S I=$P(BGPSDX,U,3) I $$ICD^BGP4UTL2(I,T,9) S %=1
S F=BGPTOBP
D
.I $P(F,U,1)["CURRENT"!($P(F,U,1)["CESSATION")!($P(F,U,1)="HEAVY TOBACCO SMOKER")!($P(F,U,1)="LIGHT TOBACCO SMOKER") S BGPTUSER=1 Q
.I $P(F,U,4)["CURRENT"!($P(F,U,4)["CESSATION") S BGPTUSER=1 Q
.I (BGPSDX]""&(%="")) S BGPTUSER=1 Q
.I ($P(BGPSCPT,U)="1034F")!($P(BGPSCPT,U)="1035F")!($P(BGPSCPT,U)="G0376")!($P(BGPSCPT,U)="G0375")!($P(BGPSCPT,U)=99407) S BGPTUSER=1 Q
.I $P(BGPSCPT,U)=99406!($P(BGPSCPT,U)="G8455")!($P(BGPSCPT,U)="G8456")!($P(BGPSCPT,U)="G8402")!($P(BGPSCPT,U)="G8453") S BGPTUSER=1 Q
;S F=$P(BGPTOBP,U,1)
;I $P(BGPTOBP,U,1)["CURRENT"!(BGPSDX]""&(%=""))!(F["CESSATION")!($P(BGPSCPT,U)="1034F")!($P(BGPSCPT,U)="1035F")!($P(BGPSCPT,U)="G0376")!($P(BGPSCPT,U)="G0375")!($P(BGPSCPT,U)=99407) S BGPTUSER=1
;I $P(BGPSCPT,U)=99406!($P(BGPSCPT,U)="G8455")!($P(BGPSCPT,U)="G8456")!($P(BGPSCPT,U)="G8402")!($P(BGPSCPT,U)="G8453") S BGPTUSER=1
Q BGPTUSER
UCONLY(P,BDATE,EDATE) ;EP - clinical user
K ^TMP($J,"A")
NEW A,C,B,E,X,G,V,UCC,ALV
S (UCC,ALV)=0
;UCC - urgent care clinic count
;ALV - all visit count
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 (X,G,F,S)=0 F S X=$O(^TMP($J,"A",X)) Q:X'=+X!(F) 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:'$D(^AUPNVPRV("AD",V))
.Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
.Q:"V"[$P(^AUPNVSIT(V,0),U,3)
.Q:$P(^AUPNVSIT(V,0),U,6)=""
.S B=$$CLINIC^APCLV(V,"C")
.Q:B=""
.I B=80 S UCC=UCC+1 Q
.I 'G,$D(^BGPCTRL($O(^BGPCTRL("B",2014,0)),11,"B",B)) S G=V ;must be a primary clinic S G=V
.I V'=G,$D(^BGPCTRL($O(^BGPCTRL("B",2014,0)),12,"B",B)) S S=1
.I G,S S F=1
.Q
Q $S(F:1,1:0)
PRIMMED ;
;
S (BGPD1,BGPN1)=0
I 'BGPACTCL S BGPSTOP=1 Q ;not active clinical pt
I BGPAGEB<18 S BGPSTOP=1 Q ;only 18 and older
;bgpd1 = TOTAL # OF PRESCRIPTIONS
;bgpn1 = # returned to stock
S (BGPD1,BGPN1)=0
NEW BGPP,IFN,D,FD,SD,FDS,R
S SD=$$FMADD^XLFDT(BGPBDATE,-180)
K ^TMP($J,"A")
NEW A,B,E,Z,X,D,V,Y,G,M,T,T1
K BGPMEDS1
D GETMEDS^BGP4UTL2(DFN,SD,BGPEDATE,,,,,.BGPMEDS1)
I '$D(BGPMEDS1) Q ;
S BGPVALUE="",BGPDX="",BGPNX=""
;loop through prescription file and get all chronic meds (defined by taxonomy), array by fill date
S BGPP=0
F S BGPP=$O(BGPMEDS1(BGPP)) Q:BGPP="" D
.S M=$P(BGPMEDS1(BGPP),U,4)
.S D=$P(^AUPNVMED(M,0),U,1)
.S P=$S($D(^PSRX("APCC",M)):$O(^(M,0)),1:0)
.I 'P K BGPMEDS1(BGPP) Q ;NO PRESCRIPTION
.I $P($G(^PSRX(P,"STA")),"^")=13 K BGPMEDS1(BGPP) Q ;deleted
.I $E($P(^PSRX(P,0),U,1))="X" K BGPMEDS1(BGPP) Q
.;get order number and skip if not electronic
.S O=$P($G(^PSRX(P,"OR1")),U,2) ;order number
.I 'O K BGPMEDS1(BGPP) Q
.S B=$P($G(^OR(100,O,8,1,0)),U,12)
.I B="" K BGPMEDS1(BGPP) Q ;Q:B=""
.I B'=8 K BGPMEDS1(BGPP) Q ;must be electronic
.S FD=$$VD^APCLV($P(BGPMEDS1(BGPP),U,5))
.I FD>BGPEDATE K BGPMEDS1(BGPP) Q
.I FD<BGPBDATE K BGPMEDS1(BGPP) Q
.I '$$CHRONIC(D) K BGPMEDS1(BGPP) Q ;must be from one of these taxonomies
.;was that another V MED in previous 180 days.
.K BGPG
.S %=DFN_"^LAST MED `"_D_";DURING "_$$FMADD^XLFDT(FD,-180)_"-"_$$FMADD^XLFDT(FD,-1),E=$$START1^APCLDF(%,"BGPG(")
.I $D(BGPG(1)) K BGPMEDS1(BGPP) Q ;had one 180 prior
.S BGPD1=BGPD1+1
.I BGPDX]"" S BGPDX=BGPDX_"; "
.S BGPDX=BGPDX_BGPD1_") "_$$DATE^BGP4UTL(FD)_" "_$$VAL^XBDIQ1(50,D,.01)
.I $$UP^XLFSTR($P($G(^AUPNVMED(M,11)),U))["RETURNED TO STOCK" S BGPN1=BGPN1+1 D Q
..I BGPNX]"" S BGPNX=BGPNX_"; "
..S BGPNX=BGPNX_BGPD1_") "_$$DATE^BGP4UTL(FD)_" "_$$VAL^XBDIQ1(50,D,.01)_"-RTS"
S BGPVALUE="AC "_BGPDX_"|||"_BGPNX
K BGPMEDS1
Q
NDC(A,B) ;
;a is drug ien
;b is taxonomy ien
NEW BGPNDC
S BGPNDC=$P($G(^PSDRUG(A,2)),U,4)
I BGPNDC]"",B,$D(^ATXAX(B,21,"B",BGPNDC)) Q 1
Q 0
CHRONIC(D) ;
I '$G(D) Q 0
NEW TM,TN
S TM=$O(^ATXAX("B","BGP PQA ASTHMA INHALE STER MED",0))
S TN=$O(^ATXAX("B","BGP PQA ASTHMA INHALE STER NDC",0))
I $D(^ATXAX(TM,21,"B",D))!($$NDC(D,TN)) Q 1
S TM=$O(^ATXAX("B","BGP PQA COPD MEDS",0))
S TN=$O(^ATXAX("B","BGP PQA COPD NDC",0))
I $D(^ATXAX(TM,21,"B",D))!($$NDC(D,TN)) Q 1
S TM=$O(^ATXAX("B","BGP PQA DIABETES ALL CLASS",0))
S TN=$O(^ATXAX("B","BGP PQA DIABETES ALL CLASS NDC",0))
I $D(^ATXAX(TM,21,"B",D))!($$NDC(D,TN)) Q 1
S TM=$O(^ATXAX("B","BGP PQA RASA MEDS",0))
S TN=$O(^ATXAX("B","BGP PQA RASA NDC",0))
I $D(^ATXAX(TM,21,"B",D))!($$NDC(D,TN)) Q 1
S TM=$O(^ATXAX("B","BGP PQA STATIN MEDS",0))
S TN=$O(^ATXAX("B","BGP PQA STATIN NDC",0))
I $D(^ATXAX(TM,21,"B",D))!($$NDC(D,TN)) Q 1
Q 0
BGP4D89 ; IHS/CMI/LAB - measure C 03 Jul 2010 7:05 AM ;
+1 ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
+2 ;
VS ;EP
+1 SET (BGPN1,BGPN2,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPD10,BGPD11)=0
+2 ;not active clinical pt
IF 'BGPACTCL
SET BGPSTOP=1
QUIT
+3 ;SET UP DENOMINATORS
+4 ;all A/C
SET BGPD1=1
+5 IF BGPAGEB>1
IF BGPAGEB<19
SET BGPD2=1
+6 IF BGPAGEB>4
SET BGPD3=1
+7 IF BGPAGEB>11
IF BGPAGEB<19
SET BGPD4=1
+8 IF BGPAGEB>11
IF BGPAGEB<76
SET BGPD5=1
+9 IF BGPSEX="F"
IF BGPAGEB>14
IF BGPAGEB<41
SET BGPD6=1
+10 IF BGPSEX="F"
IF BGPAGEB>14
IF BGPAGEB<45
SET BGPD7=1
+11 IF BGPAGEB>17
SET BGPD8=1
+12 IF BGPAGEB>64
SET BGPD9=1
+13 IF $$TOBUSER(DFN,BGPBDATE)
SET BGPD10=1
+14 SET BGPQV=$$VISIT(DFN,BGPBDATE,BGPEDATE)
+15 IF 'BGPQV
SET BGPN1=1
+16 SET BGPURO=$$UCONLY(DFN,BGP3YE,BGPEDATE)
+17 ;urgent care only visit
IF 'BGPURO
SET BGPN2=1
+18 SET D="AC"
+19 IF BGPD2
SET D=D_",AC 2-18"
+20 IF BGPD3
SET D=D_",AC =>5"
+21 IF BGPD4
SET D=D_",AC 12-18"
+22 IF BGPD5
SET D=D_",AC 12-75"
+23 IF BGPD6
SET D=D_",FEM AC 15-40"
+24 IF BGPD7
SET D=D_",FEM AC 15-44"
+25 IF BGPD8
SET D=D_",AC =>18"
+26 IF BGPD9
SET D=D_",AC =>65"
+27 IF BGPD10
SET D=D_",TOB"
+28 SET BGPVALUE="AC"_$SELECT(BGPD10:",TOB",1:"")_"|||"_$SELECT('BGPN1:"No visit in time period",1:"Visit in time period "_$$DATE^BGP4UTL(BGPQV))_" Urgent Care Only: "_$$DATE^BGP4UTL(BGPURO)
+29 SET BGPVALUD="AC"_$SELECT(BGPD10:",TOB",1:"")_"|||"
+30 KILL X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,T
+31 KILL BGPEDUC,BGPHIV
+32 QUIT
VISIT(P,BDATE,EDATE) ;
+1 KILL ^TMP($JOB,"A")
+2 NEW A,C,B,E,X,G,V
+3 SET A="^TMP($J,""A"","
SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(B,A)
+4 IF '$DATA(^TMP($JOB,"A",1))
QUIT ""
+5 SET (X,G)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(G)
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+6 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+7 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+8 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+9 IF "SAHOR"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+10 IF $PIECE(^AUPNVSIT(V,0),U,6)=""
QUIT
+11 SET C=$$CLINIC^APCLV(V,"C")
+12 IF C=42
QUIT
+13 IF C=51
QUIT
+14 IF C=52
QUIT
+15 IF C=53
QUIT
+16 SET G=$$VD^APCLV(V)
+17 QUIT
End DoDot:1
+18 QUIT G
TOBUSER(P,BDATE) ;EP
+1 NEW BGPTUSER,%,BGPTOBP,BGPSDX,BGPSCPT,F
+2 SET BGPTUSER=""
+3 SET BGPTOBP=$$TOBHF^BGP4D712(P,$$DOB^AUPNPAT(P),$$FMADD^XLFDT(BDATE,-1))
+4 SET BGPSDX=$$DXU^BGP4D7(P,$$DOB^AUPNPAT(P),$$FMADD^XLFDT(BDATE,-1))
+5 SET BGPSCPT=$$CPTSM^BGP4D7(P,$$DOB^AUPNPAT(P),$$FMADD^XLFDT(BDATE,-1))
+6 SET %=""
+7 ;I BGPSDX]"",$P(BGPSDX,U)="V15.82" S %=1
+8 ;I BGPSDX]"",$P(BGPSDX,U)="305.13" S %=1
+9 SET T=$ORDER(^ATXAX("B","BGP TOBACCO PAST USE DXS",0))
+10 IF BGPSDX]""
SET I=$PIECE(BGPSDX,U,3)
IF $$ICD^BGP4UTL2(I,T,9)
SET %=1
+11 SET F=BGPTOBP
+12 Begin DoDot:1
+13 IF $PIECE(F,U,1)["CURRENT"!($PIECE(F,U,1)["CESSATION")!($PIECE(F,U,1)="HEAVY TOBACCO SMOKER")!($PIECE(F,U,1)="LIGHT TOBACCO SMOKER")
SET BGPTUSER=1
QUIT
+14 IF $PIECE(F,U,4)["CURRENT"!($PIECE(F,U,4)["CESSATION")
SET BGPTUSER=1
QUIT
+15 IF (BGPSDX]""&(%=""))
SET BGPTUSER=1
QUIT
+16 IF ($PIECE(BGPSCPT,U)="1034F")!($PIECE(BGPSCPT,U)="1035F")!($PIECE(BGPSCPT,U)="G0376")!($PIECE(BGPSCPT,U)="G0375")!($PIECE(BGPSCPT,U)=99407)
SET BGPTUSER=1
QUIT
+17 IF $PIECE(BGPSCPT,U)=99406!($PIECE(BGPSCPT,U)="G8455")!($PIECE(BGPSCPT,U)="G8456")!($PIECE(BGPSCPT,U)="G8402")!($PIECE(BGPSCPT,U)="G8453")
SET BGPTUSER=1
QUIT
End DoDot:1
+18 ;S F=$P(BGPTOBP,U,1)
+19 ;I $P(BGPTOBP,U,1)["CURRENT"!(BGPSDX]""&(%=""))!(F["CESSATION")!($P(BGPSCPT,U)="1034F")!($P(BGPSCPT,U)="1035F")!($P(BGPSCPT,U)="G0376")!($P(BGPSCPT,U)="G0375")!($P(BGPSCPT,U)=99407) S BGPTUSER=1
+20 ;I $P(BGPSCPT,U)=99406!($P(BGPSCPT,U)="G8455")!($P(BGPSCPT,U)="G8456")!($P(BGPSCPT,U)="G8402")!($P(BGPSCPT,U)="G8453") S BGPTUSER=1
+21 QUIT BGPTUSER
UCONLY(P,BDATE,EDATE) ;EP - clinical user
+1 KILL ^TMP($JOB,"A")
+2 NEW A,C,B,E,X,G,V,UCC,ALV
+3 SET (UCC,ALV)=0
+4 ;UCC - urgent care clinic count
+5 ;ALV - all visit count
+6 SET A="^TMP($J,""A"","
SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(B,A)
+7 IF '$DATA(^TMP($JOB,"A",1))
QUIT ""
+8 SET (X,G,F,S)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(F)
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+9 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+10 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+11 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+12 IF '$DATA(^AUPNVPRV("AD",V))
QUIT
+13 IF "SAHO"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+14 IF "V"[$PIECE(^AUPNVSIT(V,0),U,3)
QUIT
+15 IF $PIECE(^AUPNVSIT(V,0),U,6)=""
QUIT
+16 SET B=$$CLINIC^APCLV(V,"C")
+17 IF B=""
QUIT
+18 IF B=80
SET UCC=UCC+1
QUIT
+19 ;must be a primary clinic S G=V
IF 'G
IF $DATA(^BGPCTRL($ORDER(^BGPCTRL("B",2014,0)),11,"B",B))
SET G=V
+20 IF V'=G
IF $DATA(^BGPCTRL($ORDER(^BGPCTRL("B",2014,0)),12,"B",B))
SET S=1
+21 IF G
IF S
SET F=1
+22 QUIT
End DoDot:1
+23 QUIT $SELECT(F:1,1:0)
PRIMMED ;
+1 ;
+2 SET (BGPD1,BGPN1)=0
+3 ;not active clinical pt
IF 'BGPACTCL
SET BGPSTOP=1
QUIT
+4 ;only 18 and older
IF BGPAGEB<18
SET BGPSTOP=1
QUIT
+5 ;bgpd1 = TOTAL # OF PRESCRIPTIONS
+6 ;bgpn1 = # returned to stock
+7 SET (BGPD1,BGPN1)=0
+8 NEW BGPP,IFN,D,FD,SD,FDS,R
+9 SET SD=$$FMADD^XLFDT(BGPBDATE,-180)
+10 KILL ^TMP($JOB,"A")
+11 NEW A,B,E,Z,X,D,V,Y,G,M,T,T1
+12 KILL BGPMEDS1
+13 DO GETMEDS^BGP4UTL2(DFN,SD,BGPEDATE,,,,,.BGPMEDS1)
+14 ;
IF '$DATA(BGPMEDS1)
QUIT
+15 SET BGPVALUE=""
SET BGPDX=""
SET BGPNX=""
+16 ;loop through prescription file and get all chronic meds (defined by taxonomy), array by fill date
+17 SET BGPP=0
+18 FOR
SET BGPP=$ORDER(BGPMEDS1(BGPP))
IF BGPP=""
QUIT
Begin DoDot:1
+19 SET M=$PIECE(BGPMEDS1(BGPP),U,4)
+20 SET D=$PIECE(^AUPNVMED(M,0),U,1)
+21 SET P=$SELECT($DATA(^PSRX("APCC",M)):$ORDER(^(M,0)),1:0)
+22 ;NO PRESCRIPTION
IF 'P
KILL BGPMEDS1(BGPP)
QUIT
+23 ;deleted
IF $PIECE($GET(^PSRX(P,"STA")),"^")=13
KILL BGPMEDS1(BGPP)
QUIT
+24 IF $EXTRACT($PIECE(^PSRX(P,0),U,1))="X"
KILL BGPMEDS1(BGPP)
QUIT
+25 ;get order number and skip if not electronic
+26 ;order number
SET O=$PIECE($GET(^PSRX(P,"OR1")),U,2)
+27 IF 'O
KILL BGPMEDS1(BGPP)
QUIT
+28 SET B=$PIECE($GET(^OR(100,O,8,1,0)),U,12)
+29 ;Q:B=""
IF B=""
KILL BGPMEDS1(BGPP)
QUIT
+30 ;must be electronic
IF B'=8
KILL BGPMEDS1(BGPP)
QUIT
+31 SET FD=$$VD^APCLV($PIECE(BGPMEDS1(BGPP),U,5))
+32 IF FD>BGPEDATE
KILL BGPMEDS1(BGPP)
QUIT
+33 IF FD<BGPBDATE
KILL BGPMEDS1(BGPP)
QUIT
+34 ;must be from one of these taxonomies
IF '$$CHRONIC(D)
KILL BGPMEDS1(BGPP)
QUIT
+35 ;was that another V MED in previous 180 days.
+36 KILL BGPG
+37 SET %=DFN_"^LAST MED `"_D_";DURING "_$$FMADD^XLFDT(FD,-180)_"-"_$$FMADD^XLFDT(FD,-1)
SET E=$$START1^APCLDF(%,"BGPG(")
+38 ;had one 180 prior
IF $DATA(BGPG(1))
KILL BGPMEDS1(BGPP)
QUIT
+39 SET BGPD1=BGPD1+1
+40 IF BGPDX]""
SET BGPDX=BGPDX_"; "
+41 SET BGPDX=BGPDX_BGPD1_") "_$$DATE^BGP4UTL(FD)_" "_$$VAL^XBDIQ1(50,D,.01)
+42 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(M,11)),U))["RETURNED TO STOCK"
SET BGPN1=BGPN1+1
Begin DoDot:2
+43 IF BGPNX]""
SET BGPNX=BGPNX_"; "
+44 SET BGPNX=BGPNX_BGPD1_") "_$$DATE^BGP4UTL(FD)_" "_$$VAL^XBDIQ1(50,D,.01)_"-RTS"
End DoDot:2
QUIT
End DoDot:1
+45 SET BGPVALUE="AC "_BGPDX_"|||"_BGPNX
+46 KILL BGPMEDS1
+47 QUIT
NDC(A,B) ;
+1 ;a is drug ien
+2 ;b is taxonomy ien
+3 NEW BGPNDC
+4 SET BGPNDC=$PIECE($GET(^PSDRUG(A,2)),U,4)
+5 IF BGPNDC]""
IF B
IF $DATA(^ATXAX(B,21,"B",BGPNDC))
QUIT 1
+6 QUIT 0
CHRONIC(D) ;
+1 IF '$GET(D)
QUIT 0
+2 NEW TM,TN
+3 SET TM=$ORDER(^ATXAX("B","BGP PQA ASTHMA INHALE STER MED",0))
+4 SET TN=$ORDER(^ATXAX("B","BGP PQA ASTHMA INHALE STER NDC",0))
+5 IF $DATA(^ATXAX(TM,21,"B",D))!($$NDC(D,TN))
QUIT 1
+6 SET TM=$ORDER(^ATXAX("B","BGP PQA COPD MEDS",0))
+7 SET TN=$ORDER(^ATXAX("B","BGP PQA COPD NDC",0))
+8 IF $DATA(^ATXAX(TM,21,"B",D))!($$NDC(D,TN))
QUIT 1
+9 SET TM=$ORDER(^ATXAX("B","BGP PQA DIABETES ALL CLASS",0))
+10 SET TN=$ORDER(^ATXAX("B","BGP PQA DIABETES ALL CLASS NDC",0))
+11 IF $DATA(^ATXAX(TM,21,"B",D))!($$NDC(D,TN))
QUIT 1
+12 SET TM=$ORDER(^ATXAX("B","BGP PQA RASA MEDS",0))
+13 SET TN=$ORDER(^ATXAX("B","BGP PQA RASA NDC",0))
+14 IF $DATA(^ATXAX(TM,21,"B",D))!($$NDC(D,TN))
QUIT 1
+15 SET TM=$ORDER(^ATXAX("B","BGP PQA STATIN MEDS",0))
+16 SET TN=$ORDER(^ATXAX("B","BGP PQA STATIN NDC",0))
+17 IF $DATA(^ATXAX(TM,21,"B",D))!($$NDC(D,TN))
QUIT 1
+18 QUIT 0
