- 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