BGP8PC17 ; IHS/CMI/LAB - measure I2 ; 02 Feb 2018 11:25 AM
;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
;
TEST ;
S DFN=0 F S DFN=$O(^AUPNPAT(DFN)) Q:DFN'=+DFN S BGPIPCUP=1,BGPBDATE=3120101,BGPEDATE=DT,BGPAGEB=$$AGE^AUPNPAT(DFN,BGPBDATE) D MTA
Q
MTA ;EP
I 'BGPIPCUP S BGPSTOP=1 Q ;must be ipc up
I BGPAGEB<5 S BGPSTOP=1 Q ;must be 5 or older
;
S (BGPN1,BGPD1)=""
I '$$ASSEV^BGP8D22(DFN,BGPEDATE) S BGPSTOP=1 Q ;not persistent asthma
;EXCLUSIONS
;REFUSAL FOR MED IN PQA CONTROLLER MEDS
I $$REFMED(DFN,BGPBDATE,BGPEDATE) S BGPSTOP=1 Q ;refused controller med
I $$MEDALG(DFN,BGPEDATE) S BGPSTOP=1 Q
S BGPD1=1
S BGPVAL=$$CONT(DFN,BGPBDATE,BGPEDATE)
I $P(BGPVAL,U,1) S BGPN1=1
S BGPVALUE="IPCUP|||"
I BGPN1 S BGPVALUE=BGPVALUE_"*** "_$P(BGPVAL,U,2)_" "_$P(BGPVAL,U,3)
MTAX ;
K BGPVAL
Q
REFMED(P,BDATE,EDATE) ;
NEW F,D,I,X,Y,G,T,ID,D
S T=$O(^ATXAX("B","BGP PQA CONTROLLER MEDS",0))
S F=50,G=""
S I=0 F S I=$O(^AUPNPREF("AA",P,F,I)) Q:I'=+I!(G) D
.I '$D(^ATXAX(T,21,"B",I)) Q ;not a drug we are interested in
.S ID=0 F S ID=$O(^AUPNPREF("AA",P,F,I,ID)) Q:ID'=+ID!(G) D
..S D=9999999-ID
..Q:D<BDATE
..Q:D>EDATE
..S X=0 F S X=$O(^AUPNPREF("AA",P,F,I,ID,X)) Q:X'=+X!(G) D
...S R=$P($G(^AUPNPREF(X,0)),U,7)
...I R'="R",R'="N" Q
...S G=1
Q G
MEDALG(P,EDATE) ;
NEW BGPC,X,N,G,I,T,S
S BGPC=0,G=""
S T=$O(^ATXAX("B","BGP PQA CONTROLLER MEDS",0))
S S=$O(^BGPSNOMR("B","ASTHMA DRUGS",0))
S X=0 F S X=$O(^GMR(120.8,"B",P,X)) Q:X'=+X!(G) D
.Q:$P($P($G(^GMR(120.8,X,0)),U,4),".")>EDATE ;entered after discharge date
.S N=$P($G(^GMR(120.8,X,0)),U,3)
.I $P(N,";",2)="PSDRUG(" S I=+N I $D(^ATXAX(T,21,"B",I)) S G=1 Q ;MUST BE A DRUG
.S N=$P(^GMR(120.8,X,0),U,2)
.I N]"",$D(^BGPSNOMR(S,11,"B",N)) S G=1 Q
Q G
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 A=0,C="",T=0 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_""_$$DATE^BGP8UTL(V1D)_" "_$$VAL^XBDIQ1(9000010.14,M,.01)
Q C
BGP8PC17 ; IHS/CMI/LAB - measure I2 ; 02 Feb 2018 11:25 AM
+1 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
+2 ;
TEST ;
+1 SET DFN=0
FOR
SET DFN=$ORDER(^AUPNPAT(DFN))
IF DFN'=+DFN
QUIT
SET BGPIPCUP=1
SET BGPBDATE=3120101
SET BGPEDATE=DT
SET BGPAGEB=$$AGE^AUPNPAT(DFN,BGPBDATE)
DO MTA
+2 QUIT
MTA ;EP
+1 ;must be ipc up
IF 'BGPIPCUP
SET BGPSTOP=1
QUIT
+2 ;must be 5 or older
IF BGPAGEB<5
SET BGPSTOP=1
QUIT
+3 ;
+4 SET (BGPN1,BGPD1)=""
+5 ;not persistent asthma
IF '$$ASSEV^BGP8D22(DFN,BGPEDATE)
SET BGPSTOP=1
QUIT
+6 ;EXCLUSIONS
+7 ;REFUSAL FOR MED IN PQA CONTROLLER MEDS
+8 ;refused controller med
IF $$REFMED(DFN,BGPBDATE,BGPEDATE)
SET BGPSTOP=1
QUIT
+9 IF $$MEDALG(DFN,BGPEDATE)
SET BGPSTOP=1
QUIT
+10 SET BGPD1=1
+11 SET BGPVAL=$$CONT(DFN,BGPBDATE,BGPEDATE)
+12 IF $PIECE(BGPVAL,U,1)
SET BGPN1=1
+13 SET BGPVALUE="IPCUP|||"
+14 IF BGPN1
SET BGPVALUE=BGPVALUE_"*** "_$PIECE(BGPVAL,U,2)_" "_$PIECE(BGPVAL,U,3)
MTAX ;
+1 KILL BGPVAL
+2 QUIT
REFMED(P,BDATE,EDATE) ;
+1 NEW F,D,I,X,Y,G,T,ID,D
+2 SET T=$ORDER(^ATXAX("B","BGP PQA CONTROLLER MEDS",0))
+3 SET F=50
SET G=""
+4 SET I=0
FOR
SET I=$ORDER(^AUPNPREF("AA",P,F,I))
IF I'=+I!(G)
QUIT
Begin DoDot:1
+5 ;not a drug we are interested in
IF '$DATA(^ATXAX(T,21,"B",I))
QUIT
+6 SET ID=0
FOR
SET ID=$ORDER(^AUPNPREF("AA",P,F,I,ID))
IF ID'=+ID!(G)
QUIT
Begin DoDot:2
+7 SET D=9999999-ID
+8 IF D<BDATE
QUIT
+9 IF D>EDATE
QUIT
+10 SET X=0
FOR
SET X=$ORDER(^AUPNPREF("AA",P,F,I,ID,X))
IF X'=+X!(G)
QUIT
Begin DoDot:3
+11 SET R=$PIECE($GET(^AUPNPREF(X,0)),U,7)
+12 IF R'="R"
IF R'="N"
QUIT
+13 SET G=1
End DoDot:3
End DoDot:2
End DoDot:1
+14 QUIT G
MEDALG(P,EDATE) ;
+1 NEW BGPC,X,N,G,I,T,S
+2 SET BGPC=0
SET G=""
+3 SET T=$ORDER(^ATXAX("B","BGP PQA CONTROLLER MEDS",0))
+4 SET S=$ORDER(^BGPSNOMR("B","ASTHMA DRUGS",0))
+5 SET X=0
FOR
SET X=$ORDER(^GMR(120.8,"B",P,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+6 ;entered after discharge date
IF $PIECE($PIECE($GET(^GMR(120.8,X,0)),U,4),".")>EDATE
QUIT
+7 SET N=$PIECE($GET(^GMR(120.8,X,0)),U,3)
+8 ;MUST BE A DRUG
IF $PIECE(N,";",2)="PSDRUG("
SET I=+N
IF $DATA(^ATXAX(T,21,"B",I))
SET G=1
QUIT
+9 SET N=$PIECE(^GMR(120.8,X,0),U,2)
+10 IF N]""
IF $DATA(^BGPSNOMR(S,11,"B",N))
SET G=1
QUIT
End DoDot:1
+11 QUIT G
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 A=0
SET C=""
SET T=0
FOR
SET A=$ORDER(BGPMEDS1(A))
IF A'=+A!(C)
QUIT
Begin DoDot:1
+7 ;IEN OF V MED
SET M=$PIECE(BGPMEDS1(A),U,4)
+8 IF '$DATA(^AUPNVMED(M,0))
QUIT
+9 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(M,11)),U))["RETURNED TO STOCK"
KILL BGPMEDS1(A)
QUIT
+10 ;I $$STATDC(M) K BGPMEDS1(A) Q ;d/c'ed BY PROVIDER OR EDIT
+11 SET V=$PIECE(BGPMEDS1(A),U,5)
+12 SET V1D=$$VD^APCLV(V)
+13 SET C=1_U_""_$$DATE^BGP8UTL(V1D)_" "_$$VAL^XBDIQ1(9000010.14,M,.01)
End DoDot:1
+14 QUIT C
