Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGP8PC17

BGP8PC17.m

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