BGPMUG05 ; IHS/MSC/MMT - MI measure NQF0036 ;20-Aug-2011 14:56;DU
;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
;Code to collect meaningful use report for Asthma Medications
ENTRY ;EP
N START,END,STRING,STRING2
N IEN,INV,VISIT,DATA,VDATE,VALUE,FIRST,VIEN
N CNT,DEN,NUM,EXC,ASTHENC,ASTHMA,ASTDT,ASTDX,ASTPL,LASTVDT
S (NUM,DEN,EXC)=0
;Pts must be between 5 and 50 years
;No need to check further if no age match
Q:BGPAGEE<5!(BGPAGEE>50)
S DEN=$$DEN(DFN,BGPBDATE,BGPEDATE)
Q:'+DEN
;check to see if they are in the numerator
S NUM=$$NUM(DFN,BGPBDATE,BGPEDATE)
;if not in NUM, check to see if excluded
I '+NUM S EXC=$$EXCLUDE(DFN,BGPBDATE,BGPEDATE)
D TOTAL(DFN,DEN,NUM,EXC)
Q
TOTAL(DFN,DEN,NUM,EXC) ;See where this patient ends up
D:BGPAGEE<12 TOTSUB(1) ;ages 5-11
D:BGPAGEE>11 TOTSUB(2) ;ages 12-50
D TOTSUB(3) ;all ages (5-50)
Q
TOTSUB(DENPOP) ;ADD Patient to a population's totals
N TOTAL,PTCNT,DENCT,NUMCT,NOTNUM,EXCCT
S TOTAL=$G(^TMP("BGPMU0036",$J,BGPMUTF,DENPOP,"TOT"))
S DENCT=+$G(^TMP("BGPMU0036",$J,BGPMUTF,DENPOP,"DEN"))
S NUMCT=+$G(^TMP("BGPMU0036",$J,BGPMUTF,DENPOP,"NUM"))
S EXCCT=+$G(^TMP("BGPMU0036",$J,BGPMUTF,DENPOP,"EXC"))
S NOTNUM=+$G(^TMP("BGPMU0036",$J,BGPMUTF,DENPOP,"NOT"))
S PTCNT=TOTAL
S PTCNT=PTCNT+1
S DENCT=DENCT+1 S ^TMP("BGPMU0036",$J,BGPMUTF,DENPOP,"DEN")=DENCT
I +NUM D
.S NUMCT=NUMCT+1 S ^TMP("BGPMU0036",$J,BGPMUTF,DENPOP,"NUM")=NUMCT
.I BGPMUTF="C" S ^TMP("BGPMU0036",$J,"PAT",BGPMUTF,DENPOP,"NUM",PTCNT)=DFN_U_$P(DEN,U,2)_U_"M:MED "_$$DATE^BGPMUUTL($P(NUM,U,3))
I +EXC D
.S EXCCT=EXCCT+1 S ^TMP("BGPMU0036",$J,BGPMUTF,DENPOP,"EXC")=EXCCT
.I BGPMUTF="C" S ^TMP("BGPMU0036",$J,"PAT",BGPMUTF,DENPOP,"EXC",PTCNT)=DFN_U_$P(DEN,U,2)_U_"Excluded"
I +NUM=0&(EXC=0) D
.S NOTNUM=NOTNUM+1 S ^TMP("BGPMU0036",$J,BGPMUTF,DENPOP,"NOT")=NOTNUM
.I BGPMUTF="C" S ^TMP("BGPMU0036",$J,"PAT",BGPMUTF,DENPOP,"NOT",PTCNT)=DFN_U_$P(DEN,U,2)_U_"NM:"
S ^TMP("BGPMU0036",$J,BGPMUTF,DENPOP,"TOT")=PTCNT
;Setup iCare array for patient only for the 3rd (all encompassing) population
S:DENPOP=3 BGPICARE("MU.EP.0036.1",BGPMUTF)=1_U_+NUM_U_+EXC_U_$P(DEN,U,2)_U_$P(NUM,U,2)_";"_$P(NUM,U,3)
Q
ASTHMA(DFN,EDATE) ;Find if patient had a PROBLEM of Asthma on or before the end date
N ASTHMA
S ASTHMA=0
S ASTPL=$$PLTAX^BGPMUUT1(DFN,"BGPMU ASTHMA DX ICD","C")
;check date of problem
I +ASTPL&($P($P(ASTPL,U,3),".")<=EDATE) S ASTHMA=ASTPL Q ASTHMA
S BGPBIRTH=$$DOB^AUPNPAT(DFN)
S ASTDX=$$LASTDX^BGPMUUT2(DFN,BGPBIRTH,EDATE,"BGPMU ASTHMA DX ICD")
I +ASTDX S ASTHMA=ASTDX Q ASTHMA
Q ASTHMA
NUM(DFN,BGPBDATE,BGPEDATE) ;Look for PRESCRIPTION
N FOUND
S FOUND=0
S FOUND=$$FIND^BGPMUUT8(DFN,"BGPMU ASTHMA GENERAL NDCS",BGPBDATE,"",BGPEDATE)
Q:+FOUND FOUND
S FOUND=$$FIND^BGPMUUT8(DFN,"BGPMU ASTHMA INHALED NDCS",BGPBDATE,"",BGPEDATE)
Q:+FOUND FOUND
S FOUND=$$FIND^BGPMUUT8(DFN,"BGPMU ASTHMA LEUK NDCS",BGPBDATE,"",BGPEDATE)
Q FOUND
DEN(DFN,BDATE,EDATE) ;CHECK IF PT IS IN DENOMINATOR
;Check for 1 IP or ED visit with a Dx of Asthma
S START=9999999-$$FMADD^XLFDT(BDATE,-365),END=9999999-EDATE,VALUE=0
S START=START_".2359"
;First check for Asthma Dx
S ASTHMA=$$ASTHMA(DFN,BGPEDATE)
G:'+ASTHMA DENMEDS ;SKIP TO MED CHECK IF NO ASTHMA DX
S CNT=0
S FIRST=END-0.1 F S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START) D
.S IEN=0 F S IEN=$O(^AUPNVSIT("AA",DFN,FIRST,IEN)) Q:'+IEN!(CNT>0) D
..;Check provider, Only visits for chosen provider
..Q:'$$PRV^BGPMUUT1(IEN,BGPPROV)
..S EDENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENCOUNTER ED CPT")
..I +EDENC D VSTSTORE Q
..S IPENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ACUTE INPT ENC")
..I +IPENC D VSTSTORE Q
I CNT>0 D
.S DEN=1_U_$$DENSTR1(ASTHMA,.STRING)
Q:+DEN DEN
DENMEDS ;
N MEDTAX,INHTAX,LEUKTAX,MEDS,LEUKS,MCNT,LCNT,MEVT
;now check for meds
S MEDTAX=$O(^ATXAX("B","BGPMU ASTHMA GENERAL NDCS",0))
S BETATAX=$O(^ATXAX("B","BGPMU ASTHMA BETA NDCS",0))
S INHTAX=$O(^ATXAX("B","BGPMU ASTHMA INHALED NDCS",0))
S LEUKTAX=$O(^ATXAX("B","BGPMU ASTHMA LEUK NDCS",0))
K VIEN,STRING,CNT
S (CNT,MCNT,LCNT,M,E)=0
S FIRST=END-0.1 F S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START) D
.S IEN=0 F S IEN=$O(^AUPNVSIT("AA",DFN,FIRST,IEN)) Q:'+IEN D
..;Check provider, Only visits for chosen provider
..I $$PRV^BGPMUUT1(IEN,BGPPROV) D
...S OPENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENCOUNTER OUTPT")
...I +OPENC D VSTSTORE ;count it
...E D
....S VENC=$$VSTPOV^BGPMUUT3(DFN,IEN,"BGPMU ENC OUTPATIENT ICD")
....I +VENC D VSTSTORE
..;look for meds
..S Y=0 F S Y=$O(^AUPNVMED("AD",IEN,Y)) Q:Y'=+Y D
...S S=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
...Q:$P($G(^AUPNVMED(Y,12)),U,2)'=BGPPROV ;don't check this med if not ordered by EP
...I ($$NDC(Z,INHTAX)!($$NDC(Z,BETATAX))),$P(^AUPNVMED(Y,0),U,8)="" D Q
....S M=M+1 ;it is an inhaled steroid that wasn't d/c'ed so 1 dispensing event
....S MEVT=$P($G(^AUPNVMED(Y,12)),U)
....S MCNT=MCNT+1,MEDS(MCNT)=Z_U_$S(MEVT'="":MEVT,1:$P($P(^AUPNVSIT(IEN,0),U),"."))
...I $$NDC(Z,MEDTAX) D
....Q:$$NDC(Z,LEUKTAX) ;don't count if it is a leukotriene
....S J=$P(^AUPNVMED(Y,0),U,8)
....I J]"" S S=$$FMDIFF^XLFDT($P($P(^AUPNVSIT(IEN,0),U),"."),J,1)
....I J="" S S=$P(^AUPNVMED(Y,0),U,7)
....S K=S\30 S:K<1 K=1
....S M=M+K
....S MEVT=$P($G(^AUPNVMED(Y,12)),U)
....S MCNT=MCNT+1,MEDS(MCNT)=Z_U_$S(MEVT'="":MEVT,1:$P($P(^AUPNVSIT(IEN,0),U),"."))
...I $$NDC(Z,LEUKTAX) D Q
....S J=$P(^AUPNVMED(Y,0),U,8)
....I J]"" S S=$$FMDIFF^XLFDT($P($P(^AUPNVSIT(IEN,0),U),"."),J,1)
....I J="" S S=$P(^AUPNVMED(Y,0),U,7)
....S K=S\30 S:K<1 K=1
....S M=M+K,E=E+K
....S MEVT=$P($G(^AUPNVMED(Y,12)),U)
....S MCNT=MCNT+1,MEDS(MCNT)=Z_U_$S(MEVT'="":MEVT,1:$P($P(^AUPNVSIT(IEN,0),U),"."))
....S LCNT=LCNT+1,LEUKS(LCNT)=Z_U_$S(MEVT'="":MEVT,1:$P($P(^AUPNVSIT(IEN,0),U),"."))
I +ASTHMA,CNT>3,M>1 Q 1_U_$$DENSTR2(.VIEN,.MEDS) ;had 4 povs and 2 dispensing events
I M>3,E<M Q 1_U_$$DENSTR3(.VIEN,.MEDS) ;had 4 meds, not all were leuko
I +ASTHMA,M>3,E>3 Q 1_U_$$DENSTR4(.VIEN,.LEUKS) ;had all leuk and 1 dx
Q ""
;
NDC(A,B) ;
;a is drug ien
;b is taxonomy ien
S BGPNDC=$P($G(^PSDRUG(A,2)),U,4)
Q:'BGPNDC 0
;Setup the NDC code for a proper lookup in the taxonomy
S NDCCODE=$$RJ^XLFSTR($P(BGPNDC,"-"),5,0)_$$RJ^XLFSTR($P(BGPNDC,"-",2),4,0)_$$RJ^XLFSTR($P(BGPNDC,"-",3),2,0)
I NDCCODE]"",B,$D(^ATXAX(B,21,"B",NDCCODE)) Q 1
Q 0
VSTSTORE ;Store compliant visit into array
S CNT=CNT+1
S VDATE=$P($G(^AUPNVSIT(IEN,0)),U,1)
S VIEN(CNT)=IEN_U_VDATE
S STRING(CNT)=$$DATE^BGPMUUTL(VDATE)
Q
DENSTR1(ASTHMA,STRING) ;generate display string for denom criteria 1 - Dx present with IP/ED visit
Q "AST:"_$$DATE^BGPMUUTL($P(ASTHMA,U,3))_";EN:"_STRING(1)
DENSTR2(VIEN,MEDS) ;generate display string for denom criteria 2 - 4 povs and 2 dispensing events
N DENSTR,VI
S DENSTR="AST:"_$$DATE^BGPMUUTL($P(ASTHMA,U,3))
S DENSTR=DENSTR_";MED:"_$$DATE^BGPMUUTL($P($G(MEDS(1)),U,2))_$S($G(MEDS(2))'="":";MED:"_$$DATE^BGPMUUTL($P(MEDS(2),U,2)),1:"")
F VI=1:1:4 D
.S:$G(STRING(VI))'="" DENSTR=DENSTR_";EN:"_STRING(VI)
Q DENSTR
DENSTR3(VIEN,MEDS) ;generate display string for denom criteria 3 - 4 meds, not all were leuko
N DENSTR,MI
S DENSTR=""
F MI=1:1:4 D
.S:$G(MEDS(MI))'="" DENSTR=DENSTR_$S(MI>1:";",1:"")_"MED:"_$$DATE^BGPMUUTL($P(MEDS(MI),U,2))
Q DENSTR
DENSTR4(VIEN,LEUKS) ;generate display string for denom criteria 4 - all leuk and 1 dx
N DENSTR
S DENSTR="AST:"_$$DATE^BGPMUUTL($P(ASTHMA,U,3))
F MI=1:1:4 D
.S:$G(MEDS(MI))'="" DENSTR=DENSTR_";MED:"_$$DATE^BGPMUUTL($P(MEDS(MI),U,2))
Q DENSTR
EXCLUDE(DFN,BGPBDATE,BGPEDATE) ;Look for exclusions
N EXDX,EXPL
S EXDX=$$LASTDX^BGPMUUT2(DFN,BGPBDATE,BGPEDATE,"BGPMU ASTHMA EXCLUDES DX ICD")
I +EXDX Q EXDX
S EXPL=$$PLTAX^BGPMUUT1(DFN,"BGPMU ASTHMA EXCLUDES DX ICD","C",BGPEDATE)
Q:+EXPL EXPL
Q 0
BGPMUG05 ; IHS/MSC/MMT - MI measure NQF0036 ;20-Aug-2011 14:56;DU
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
+2 ;Code to collect meaningful use report for Asthma Medications
ENTRY ;EP
+1 NEW START,END,STRING,STRING2
+2 NEW IEN,INV,VISIT,DATA,VDATE,VALUE,FIRST,VIEN
+3 NEW CNT,DEN,NUM,EXC,ASTHENC,ASTHMA,ASTDT,ASTDX,ASTPL,LASTVDT
+4 SET (NUM,DEN,EXC)=0
+5 ;Pts must be between 5 and 50 years
+6 ;No need to check further if no age match
+7 IF BGPAGEE<5!(BGPAGEE>50)
QUIT
+8 SET DEN=$$DEN(DFN,BGPBDATE,BGPEDATE)
+9 IF '+DEN
QUIT
+10 ;check to see if they are in the numerator
+11 SET NUM=$$NUM(DFN,BGPBDATE,BGPEDATE)
+12 ;if not in NUM, check to see if excluded
+13 IF '+NUM
SET EXC=$$EXCLUDE(DFN,BGPBDATE,BGPEDATE)
+14 DO TOTAL(DFN,DEN,NUM,EXC)
+15 QUIT
TOTAL(DFN,DEN,NUM,EXC) ;See where this patient ends up
+1 ;ages 5-11
IF BGPAGEE<12
DO TOTSUB(1)
+2 ;ages 12-50
IF BGPAGEE>11
DO TOTSUB(2)
+3 ;all ages (5-50)
DO TOTSUB(3)
+4 QUIT
TOTSUB(DENPOP) ;ADD Patient to a population's totals
+1 NEW TOTAL,PTCNT,DENCT,NUMCT,NOTNUM,EXCCT
+2 SET TOTAL=$GET(^TMP("BGPMU0036",$JOB,BGPMUTF,DENPOP,"TOT"))
+3 SET DENCT=+$GET(^TMP("BGPMU0036",$JOB,BGPMUTF,DENPOP,"DEN"))
+4 SET NUMCT=+$GET(^TMP("BGPMU0036",$JOB,BGPMUTF,DENPOP,"NUM"))
+5 SET EXCCT=+$GET(^TMP("BGPMU0036",$JOB,BGPMUTF,DENPOP,"EXC"))
+6 SET NOTNUM=+$GET(^TMP("BGPMU0036",$JOB,BGPMUTF,DENPOP,"NOT"))
+7 SET PTCNT=TOTAL
+8 SET PTCNT=PTCNT+1
+9 SET DENCT=DENCT+1
SET ^TMP("BGPMU0036",$JOB,BGPMUTF,DENPOP,"DEN")=DENCT
+10 IF +NUM
Begin DoDot:1
+11 SET NUMCT=NUMCT+1
SET ^TMP("BGPMU0036",$JOB,BGPMUTF,DENPOP,"NUM")=NUMCT
+12 IF BGPMUTF="C"
SET ^TMP("BGPMU0036",$JOB,"PAT",BGPMUTF,DENPOP,"NUM",PTCNT)=DFN_U_$PIECE(DEN,U,2)_U_"M:MED "_$$DATE^BGPMUUTL($PIECE(NUM,U,3))
End DoDot:1
+13 IF +EXC
Begin DoDot:1
+14 SET EXCCT=EXCCT+1
SET ^TMP("BGPMU0036",$JOB,BGPMUTF,DENPOP,"EXC")=EXCCT
+15 IF BGPMUTF="C"
SET ^TMP("BGPMU0036",$JOB,"PAT",BGPMUTF,DENPOP,"EXC",PTCNT)=DFN_U_$PIECE(DEN,U,2)_U_"Excluded"
End DoDot:1
+16 IF +NUM=0&(EXC=0)
Begin DoDot:1
+17 SET NOTNUM=NOTNUM+1
SET ^TMP("BGPMU0036",$JOB,BGPMUTF,DENPOP,"NOT")=NOTNUM
+18 IF BGPMUTF="C"
SET ^TMP("BGPMU0036",$JOB,"PAT",BGPMUTF,DENPOP,"NOT",PTCNT)=DFN_U_$PIECE(DEN,U,2)_U_"NM:"
End DoDot:1
+19 SET ^TMP("BGPMU0036",$JOB,BGPMUTF,DENPOP,"TOT")=PTCNT
+20 ;Setup iCare array for patient only for the 3rd (all encompassing) population
+21 IF DENPOP=3
SET BGPICARE("MU.EP.0036.1",BGPMUTF)=1_U_+NUM_U_+EXC_U_$PIECE(DEN,U,2)_U_$PIECE(NUM,U,2)_";"_$PIECE(NUM,U,3)
+22 QUIT
ASTHMA(DFN,EDATE) ;Find if patient had a PROBLEM of Asthma on or before the end date
+1 NEW ASTHMA
+2 SET ASTHMA=0
+3 SET ASTPL=$$PLTAX^BGPMUUT1(DFN,"BGPMU ASTHMA DX ICD","C")
+4 ;check date of problem
+5 IF +ASTPL&($PIECE($PIECE(ASTPL,U,3),".")<=EDATE)
SET ASTHMA=ASTPL
QUIT ASTHMA
+6 SET BGPBIRTH=$$DOB^AUPNPAT(DFN)
+7 SET ASTDX=$$LASTDX^BGPMUUT2(DFN,BGPBIRTH,EDATE,"BGPMU ASTHMA DX ICD")
+8 IF +ASTDX
SET ASTHMA=ASTDX
QUIT ASTHMA
+9 QUIT ASTHMA
NUM(DFN,BGPBDATE,BGPEDATE) ;Look for PRESCRIPTION
+1 NEW FOUND
+2 SET FOUND=0
+3 SET FOUND=$$FIND^BGPMUUT8(DFN,"BGPMU ASTHMA GENERAL NDCS",BGPBDATE,"",BGPEDATE)
+4 IF +FOUND
QUIT FOUND
+5 SET FOUND=$$FIND^BGPMUUT8(DFN,"BGPMU ASTHMA INHALED NDCS",BGPBDATE,"",BGPEDATE)
+6 IF +FOUND
QUIT FOUND
+7 SET FOUND=$$FIND^BGPMUUT8(DFN,"BGPMU ASTHMA LEUK NDCS",BGPBDATE,"",BGPEDATE)
+8 QUIT FOUND
DEN(DFN,BDATE,EDATE) ;CHECK IF PT IS IN DENOMINATOR
+1 ;Check for 1 IP or ED visit with a Dx of Asthma
+2 SET START=9999999-$$FMADD^XLFDT(BDATE,-365)
SET END=9999999-EDATE
SET VALUE=0
+3 SET START=START_".2359"
+4 ;First check for Asthma Dx
+5 SET ASTHMA=$$ASTHMA(DFN,BGPEDATE)
+6 ;SKIP TO MED CHECK IF NO ASTHMA DX
IF '+ASTHMA
GOTO DENMEDS
+7 SET CNT=0
+8 SET FIRST=END-0.1
FOR
SET FIRST=$ORDER(^AUPNVSIT("AA",DFN,FIRST))
IF FIRST=""!($PIECE(FIRST,".",1)>START)
QUIT
Begin DoDot:1
+9 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVSIT("AA",DFN,FIRST,IEN))
IF '+IEN!(CNT>0)
QUIT
Begin DoDot:2
+10 ;Check provider, Only visits for chosen provider
+11 IF '$$PRV^BGPMUUT1(IEN,BGPPROV)
QUIT
+12 SET EDENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENCOUNTER ED CPT")
+13 IF +EDENC
DO VSTSTORE
QUIT
+14 SET IPENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ACUTE INPT ENC")
+15 IF +IPENC
DO VSTSTORE
QUIT
End DoDot:2
End DoDot:1
+16 IF CNT>0
Begin DoDot:1
+17 SET DEN=1_U_$$DENSTR1(ASTHMA,.STRING)
End DoDot:1
+18 IF +DEN
QUIT DEN
DENMEDS ;
+1 NEW MEDTAX,INHTAX,LEUKTAX,MEDS,LEUKS,MCNT,LCNT,MEVT
+2 ;now check for meds
+3 SET MEDTAX=$ORDER(^ATXAX("B","BGPMU ASTHMA GENERAL NDCS",0))
+4 SET BETATAX=$ORDER(^ATXAX("B","BGPMU ASTHMA BETA NDCS",0))
+5 SET INHTAX=$ORDER(^ATXAX("B","BGPMU ASTHMA INHALED NDCS",0))
+6 SET LEUKTAX=$ORDER(^ATXAX("B","BGPMU ASTHMA LEUK NDCS",0))
+7 KILL VIEN,STRING,CNT
+8 SET (CNT,MCNT,LCNT,M,E)=0
+9 SET FIRST=END-0.1
FOR
SET FIRST=$ORDER(^AUPNVSIT("AA",DFN,FIRST))
IF FIRST=""!($PIECE(FIRST,".",1)>START)
QUIT
Begin DoDot:1
+10 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVSIT("AA",DFN,FIRST,IEN))
IF '+IEN
QUIT
Begin DoDot:2
+11 ;Check provider, Only visits for chosen provider
+12 IF $$PRV^BGPMUUT1(IEN,BGPPROV)
Begin DoDot:3
+13 SET OPENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENCOUNTER OUTPT")
+14 ;count it
IF +OPENC
DO VSTSTORE
+15 IF '$TEST
Begin DoDot:4
+16 SET VENC=$$VSTPOV^BGPMUUT3(DFN,IEN,"BGPMU ENC OUTPATIENT ICD")
+17 IF +VENC
DO VSTSTORE
End DoDot:4
End DoDot:3
+18 ;look for meds
+19 SET Y=0
FOR
SET Y=$ORDER(^AUPNVMED("AD",IEN,Y))
IF Y'=+Y
QUIT
Begin DoDot:3
+20 SET S=0
+21 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+22 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+23 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+24 ;don't check this med if not ordered by EP
IF $PIECE($GET(^AUPNVMED(Y,12)),U,2)'=BGPPROV
QUIT
+25 IF ($$NDC(Z,INHTAX)!($$NDC(Z,BETATAX)))
IF $PIECE(^AUPNVMED(Y,0),U,8)=""
Begin DoDot:4
+26 ;it is an inhaled steroid that wasn't d/c'ed so 1 dispensing event
SET M=M+1
+27 SET MEVT=$PIECE($GET(^AUPNVMED(Y,12)),U)
+28 SET MCNT=MCNT+1
SET MEDS(MCNT)=Z_U_$SELECT(MEVT'="":MEVT,1:$PIECE($PIECE(^AUPNVSIT(IEN,0),U),"."))
End DoDot:4
QUIT
+29 IF $$NDC(Z,MEDTAX)
Begin DoDot:4
+30 ;don't count if it is a leukotriene
IF $$NDC(Z,LEUKTAX)
QUIT
+31 SET J=$PIECE(^AUPNVMED(Y,0),U,8)
+32 IF J]""
SET S=$$FMDIFF^XLFDT($PIECE($PIECE(^AUPNVSIT(IEN,0),U),"."),J,1)
+33 IF J=""
SET S=$PIECE(^AUPNVMED(Y,0),U,7)
+34 SET K=S\30
IF K<1
SET K=1
+35 SET M=M+K
+36 SET MEVT=$PIECE($GET(^AUPNVMED(Y,12)),U)
+37 SET MCNT=MCNT+1
SET MEDS(MCNT)=Z_U_$SELECT(MEVT'="":MEVT,1:$PIECE($PIECE(^AUPNVSIT(IEN,0),U),"."))
End DoDot:4
+38 IF $$NDC(Z,LEUKTAX)
Begin DoDot:4
+39 SET J=$PIECE(^AUPNVMED(Y,0),U,8)
+40 IF J]""
SET S=$$FMDIFF^XLFDT($PIECE($PIECE(^AUPNVSIT(IEN,0),U),"."),J,1)
+41 IF J=""
SET S=$PIECE(^AUPNVMED(Y,0),U,7)
+42 SET K=S\30
IF K<1
SET K=1
+43 SET M=M+K
SET E=E+K
+44 SET MEVT=$PIECE($GET(^AUPNVMED(Y,12)),U)
+45 SET MCNT=MCNT+1
SET MEDS(MCNT)=Z_U_$SELECT(MEVT'="":MEVT,1:$PIECE($PIECE(^AUPNVSIT(IEN,0),U),"."))
+46 SET LCNT=LCNT+1
SET LEUKS(LCNT)=Z_U_$SELECT(MEVT'="":MEVT,1:$PIECE($PIECE(^AUPNVSIT(IEN,0),U),"."))
End DoDot:4
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+47 ;had 4 povs and 2 dispensing events
IF +ASTHMA
IF CNT>3
IF M>1
QUIT 1_U_$$DENSTR2(.VIEN,.MEDS)
+48 ;had 4 meds, not all were leuko
IF M>3
IF E<M
QUIT 1_U_$$DENSTR3(.VIEN,.MEDS)
+49 ;had all leuk and 1 dx
IF +ASTHMA
IF M>3
IF E>3
QUIT 1_U_$$DENSTR4(.VIEN,.LEUKS)
+50 QUIT ""
+51 ;
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
QUIT 0
+5 ;Setup the NDC code for a proper lookup in the taxonomy
+6 SET NDCCODE=$$RJ^XLFSTR($PIECE(BGPNDC,"-"),5,0)_$$RJ^XLFSTR($PIECE(BGPNDC,"-",2),4,0)_$$RJ^XLFSTR($PIECE(BGPNDC,"-",3),2,0)
+7 IF NDCCODE]""
IF B
IF $DATA(^ATXAX(B,21,"B",NDCCODE))
QUIT 1
+8 QUIT 0
VSTSTORE ;Store compliant visit into array
+1 SET CNT=CNT+1
+2 SET VDATE=$PIECE($GET(^AUPNVSIT(IEN,0)),U,1)
+3 SET VIEN(CNT)=IEN_U_VDATE
+4 SET STRING(CNT)=$$DATE^BGPMUUTL(VDATE)
+5 QUIT
DENSTR1(ASTHMA,STRING) ;generate display string for denom criteria 1 - Dx present with IP/ED visit
+1 QUIT "AST:"_$$DATE^BGPMUUTL($PIECE(ASTHMA,U,3))_";EN:"_STRING(1)
DENSTR2(VIEN,MEDS) ;generate display string for denom criteria 2 - 4 povs and 2 dispensing events
+1 NEW DENSTR,VI
+2 SET DENSTR="AST:"_$$DATE^BGPMUUTL($PIECE(ASTHMA,U,3))
+3 SET DENSTR=DENSTR_";MED:"_$$DATE^BGPMUUTL($PIECE($GET(MEDS(1)),U,2))_$SELECT($GET(MEDS(2))'="":";MED:"_$$DATE^BGPMUUTL($PIECE(MEDS(2),U,2)),1:"")
+4 FOR VI=1:1:4
Begin DoDot:1
+5 IF $GET(STRING(VI))'=""
SET DENSTR=DENSTR_";EN:"_STRING(VI)
End DoDot:1
+6 QUIT DENSTR
DENSTR3(VIEN,MEDS) ;generate display string for denom criteria 3 - 4 meds, not all were leuko
+1 NEW DENSTR,MI
+2 SET DENSTR=""
+3 FOR MI=1:1:4
Begin DoDot:1
+4 IF $GET(MEDS(MI))'=""
SET DENSTR=DENSTR_$SELECT(MI>1:";",1:"")_"MED:"_$$DATE^BGPMUUTL($PIECE(MEDS(MI),U,2))
End DoDot:1
+5 QUIT DENSTR
DENSTR4(VIEN,LEUKS) ;generate display string for denom criteria 4 - all leuk and 1 dx
+1 NEW DENSTR
+2 SET DENSTR="AST:"_$$DATE^BGPMUUTL($PIECE(ASTHMA,U,3))
+3 FOR MI=1:1:4
Begin DoDot:1
+4 IF $GET(MEDS(MI))'=""
SET DENSTR=DENSTR_";MED:"_$$DATE^BGPMUUTL($PIECE(MEDS(MI),U,2))
End DoDot:1
+5 QUIT DENSTR
EXCLUDE(DFN,BGPBDATE,BGPEDATE) ;Look for exclusions
+1 NEW EXDX,EXPL
+2 SET EXDX=$$LASTDX^BGPMUUT2(DFN,BGPBDATE,BGPEDATE,"BGPMU ASTHMA EXCLUDES DX ICD")
+3 IF +EXDX
QUIT EXDX
+4 SET EXPL=$$PLTAX^BGPMUUT1(DFN,"BGPMU ASTHMA EXCLUDES DX ICD","C",BGPEDATE)
+5 IF +EXPL
QUIT EXPL
+6 QUIT 0
