BGPMUG04 ; IHS/MSC/MMT - MI measure NQF0047 ;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 Pharm Therapy
ENTRY ;EP
N START,END,BGPNUM,BGPDEN,STRING,STRING2
N IEN,INV,VISIT,DATA,VDATE,VALUE,EXC,FIRST,VIEN,RESULT
N CNT,NUM,ASTHENC,ASTHMA,ASTDT,ASTPL
S (BGPDEN,BGPNUM,NUM,EXC,RESULT)=0
S START=9999999-BGPBDATE,END=9999999-BGPEDATE,VALUE=0
S START=START_".2359"
;Pts must be between 5 and 40 years
;No need to check further if no age match
Q:BGPAGEE<5!(BGPAGEE>40)
;First check for Asthma Dx since this will eliminate many pts
S ASTHMA=$$ASTHMA(DFN,BGPEDATE)
Q:'ASTHMA
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 D
..;Check provider, Only visits for chosen provider
..Q:'$$PRV^BGPMUUT1(IEN,BGPPROV)
..S ASTENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ASTHMA ENCOUNT EM")
..I +ASTENC D VSTSTORE Q
Q:CNT<2
;check to see if they are in the numerator
S NUM=$$NUM(DFN,BGPBDATE,BGPEDATE)
I '+NUM D
.S EXC=$$EXCLUDE(DFN,BGPBDATE,BGPEDATE)
D TOTAL(DFN,ASTHMA,NUM,EXC)
Q
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
TOTAL(DFN,ASTHMA,NUM,EXC) ;See where this patient ends up
N PTCNT,EXCCT,DENCT,NUMCT,NOTNUM,TOTALS,DEN,DXTIME
S TOTALS=$G(^TMP("BGPMU0047",$J,BGPMUTF,"TOT"))
S DENCT=+$G(^TMP("BGPMU0047",$J,BGPMUTF,"DEN"))
S NUMCT=+$G(^TMP("BGPMU0047",$J,BGPMUTF,"NUM"))
S EXCCT=+$G(^TMP("BGPMU0047",$J,BGPMUTF,"EXC"))
S NOTNUM=+$G(^TMP("BGPMU0047",$J,BGPMUTF,"NOT"))
S PTCNT=TOTALS
S PTCNT=PTCNT+1
S DENCT=DENCT+1 S ^TMP("BGPMU0047",$J,BGPMUTF,"DEN")=DENCT
S DEN="AST:"_$$DATE^BGPMUUTL($P(ASTHMA,U,3))
I $D(STRING(1)) S DEN=DEN_";EN:"_STRING(1)
I $D(STRING(2)) S DEN=DEN_";EN:"_STRING(2)
I +NUM D
.S NUMCT=NUMCT+1 S ^TMP("BGPMU0047",$J,BGPMUTF,"NUM")=NUMCT
.I BGPMUTF="C" S ^TMP("BGPMU0047",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DEN_U_"M:MED "_$$DATE^BGPMUUTL($P(NUM,U,3))
I +EXC D
.S EXCCT=EXCCT+1 S ^TMP("BGPMU0047",$J,BGPMUTF,"EXC")=EXCCT
.I BGPMUTF="C" S ^TMP("BGPMU0047",$J,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DEN_U_"Excluded"
I +NUM=0&(EXC=0) D
.S NOTNUM=NOTNUM+1 S ^TMP("BGPMU0047",$J,BGPMUTF,"NOT")=NOTNUM
.I BGPMUTF="C" S ^TMP("BGPMU0047",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DEN_U_"NM:"
S ^TMP("BGPMU0047",$J,BGPMUTF,"TOT")=PTCNT
;Setup iCare array for patient
S BGPICARE("MU.EP.0047.1",BGPMUTF)=1_U_+NUM_U_+EXC_U_DEN_";"_$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")
Q:'ASTPL ASTHMA
;check date of problem
Q:$P($P(ASTPL,U,3),".")>EDATE ASTHMA
;check problem classification
S CLASS=$P($G(^AUPNPROB($P(ASTPL,U,4),0)),U,15)
;I (CLASS="MILD PERSISTENT")!(CLASS="MODERATE PERSISTENT")!(CLASS="SEVERE PERSISTENT") D
I CLASS=2!(CLASS=3)!(CLASS=4) D
.S ASTHMA=ASTPL
Q ASTHMA
NUM(DFN,BGPBDATE,BGPEDATE) ;Look for PRESCRIPTION
N FOUND
S FOUND=$$FIND^BGPMUUT8(DFN,"BGPMU ASTHMA MEDS NDCS",BGPBDATE,"",BGPEDATE)
Q FOUND
EXCLUDE(DFN,BGPBDATE,BGPEDATE) ;Look for exclusions
N EFOUND
S EFOUND=0
;Next check for allergy
S ALLER=$$ALLER^BGPMUA10("NT200","")
I +ALLER S EFOUND=1_U_$P(ALLER,U,1) G EXCQ
S ALLER=$$ALLER^BGPMUA10("RE100","")
I +ALLER S EFOUND=1_U_$P(ALLER,U,1) G EXCQ
S ALLER=$$ALLER^BGPMUA10("RE101","")
I +ALLER S EFOUND=1_U_$P(ALLER,U,1) G EXCQ
S ALLER=$$ALLER^BGPMUA10("RE102","")
I +ALLER S EFOUND=1_U_$P(ALLER,U,1) G EXCQ
S ALLER=$$ALLER^BGPMUA10("RE103","")
I +ALLER S EFOUND=1_U_$P(ALLER,U,1) G EXCQ
S ALLER=$$ALLER^BGPMUA10("RE104","")
I +ALLER S EFOUND=1_U_$P(ALLER,U,1) G EXCQ
S ALLER=$$ALLER^BGPMUA10("RE105","")
I +ALLER S EFOUND=1_U_$P(ALLER,U,1) G EXCQ
S ALLER=$$ALLER^BGPMUA10("RE108","")
I +ALLER S EFOUND=1_U_$P(ALLER,U,1) G EXCQ
S ALLER=$$ALLER^BGPMUA10("RE109","")
I +ALLER S EFOUND=1_U_$P(ALLER,U,1) G EXCQ
;Check for refusals
S TAX="BGPMU ASTHMA MEDS NDCS"
S BGPBIRTH=$$DOB^AUPNPAT(DFN)
S REF=$$MEDREF^BGPMUUT2(DFN,BGPBIRTH,BGPEDATE,TAX)
I +REF S EFOUND=1_U_$P(REF,U,1) G EXCQ
EXCQ Q EFOUND
BGPMUG04 ; IHS/MSC/MMT - MI measure NQF0047 ;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 Pharm Therapy
ENTRY ;EP
+1 NEW START,END,BGPNUM,BGPDEN,STRING,STRING2
+2 NEW IEN,INV,VISIT,DATA,VDATE,VALUE,EXC,FIRST,VIEN,RESULT
+3 NEW CNT,NUM,ASTHENC,ASTHMA,ASTDT,ASTPL
+4 SET (BGPDEN,BGPNUM,NUM,EXC,RESULT)=0
+5 SET START=9999999-BGPBDATE
SET END=9999999-BGPEDATE
SET VALUE=0
+6 SET START=START_".2359"
+7 ;Pts must be between 5 and 40 years
+8 ;No need to check further if no age match
+9 IF BGPAGEE<5!(BGPAGEE>40)
QUIT
+10 ;First check for Asthma Dx since this will eliminate many pts
+11 SET ASTHMA=$$ASTHMA(DFN,BGPEDATE)
+12 IF 'ASTHMA
QUIT
+13 SET CNT=0
+14 SET FIRST=END-0.1
FOR
SET FIRST=$ORDER(^AUPNVSIT("AA",DFN,FIRST))
IF FIRST=""!($PIECE(FIRST,".",1)>START)
QUIT
Begin DoDot:1
+15 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVSIT("AA",DFN,FIRST,IEN))
IF '+IEN
QUIT
Begin DoDot:2
+16 ;Check provider, Only visits for chosen provider
+17 IF '$$PRV^BGPMUUT1(IEN,BGPPROV)
QUIT
+18 SET ASTENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ASTHMA ENCOUNT EM")
+19 IF +ASTENC
DO VSTSTORE
QUIT
End DoDot:2
End DoDot:1
+20 IF CNT<2
QUIT
+21 ;check to see if they are in the numerator
+22 SET NUM=$$NUM(DFN,BGPBDATE,BGPEDATE)
+23 IF '+NUM
Begin DoDot:1
+24 SET EXC=$$EXCLUDE(DFN,BGPBDATE,BGPEDATE)
End DoDot:1
+25 DO TOTAL(DFN,ASTHMA,NUM,EXC)
+26 QUIT
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
TOTAL(DFN,ASTHMA,NUM,EXC) ;See where this patient ends up
+1 NEW PTCNT,EXCCT,DENCT,NUMCT,NOTNUM,TOTALS,DEN,DXTIME
+2 SET TOTALS=$GET(^TMP("BGPMU0047",$JOB,BGPMUTF,"TOT"))
+3 SET DENCT=+$GET(^TMP("BGPMU0047",$JOB,BGPMUTF,"DEN"))
+4 SET NUMCT=+$GET(^TMP("BGPMU0047",$JOB,BGPMUTF,"NUM"))
+5 SET EXCCT=+$GET(^TMP("BGPMU0047",$JOB,BGPMUTF,"EXC"))
+6 SET NOTNUM=+$GET(^TMP("BGPMU0047",$JOB,BGPMUTF,"NOT"))
+7 SET PTCNT=TOTALS
+8 SET PTCNT=PTCNT+1
+9 SET DENCT=DENCT+1
SET ^TMP("BGPMU0047",$JOB,BGPMUTF,"DEN")=DENCT
+10 SET DEN="AST:"_$$DATE^BGPMUUTL($PIECE(ASTHMA,U,3))
+11 IF $DATA(STRING(1))
SET DEN=DEN_";EN:"_STRING(1)
+12 IF $DATA(STRING(2))
SET DEN=DEN_";EN:"_STRING(2)
+13 IF +NUM
Begin DoDot:1
+14 SET NUMCT=NUMCT+1
SET ^TMP("BGPMU0047",$JOB,BGPMUTF,"NUM")=NUMCT
+15 IF BGPMUTF="C"
SET ^TMP("BGPMU0047",$JOB,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DEN_U_"M:MED "_$$DATE^BGPMUUTL($PIECE(NUM,U,3))
End DoDot:1
+16 IF +EXC
Begin DoDot:1
+17 SET EXCCT=EXCCT+1
SET ^TMP("BGPMU0047",$JOB,BGPMUTF,"EXC")=EXCCT
+18 IF BGPMUTF="C"
SET ^TMP("BGPMU0047",$JOB,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DEN_U_"Excluded"
End DoDot:1
+19 IF +NUM=0&(EXC=0)
Begin DoDot:1
+20 SET NOTNUM=NOTNUM+1
SET ^TMP("BGPMU0047",$JOB,BGPMUTF,"NOT")=NOTNUM
+21 IF BGPMUTF="C"
SET ^TMP("BGPMU0047",$JOB,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DEN_U_"NM:"
End DoDot:1
+22 SET ^TMP("BGPMU0047",$JOB,BGPMUTF,"TOT")=PTCNT
+23 ;Setup iCare array for patient
+24 SET BGPICARE("MU.EP.0047.1",BGPMUTF)=1_U_+NUM_U_+EXC_U_DEN_";"_$PIECE(NUM,U,2)_";"_$PIECE(NUM,U,3)
+25 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 IF 'ASTPL
QUIT ASTHMA
+5 ;check date of problem
+6 IF $PIECE($PIECE(ASTPL,U,3),".")>EDATE
QUIT ASTHMA
+7 ;check problem classification
+8 SET CLASS=$PIECE($GET(^AUPNPROB($PIECE(ASTPL,U,4),0)),U,15)
+9 ;I (CLASS="MILD PERSISTENT")!(CLASS="MODERATE PERSISTENT")!(CLASS="SEVERE PERSISTENT") D
+10 IF CLASS=2!(CLASS=3)!(CLASS=4)
Begin DoDot:1
+11 SET ASTHMA=ASTPL
End DoDot:1
+12 QUIT ASTHMA
NUM(DFN,BGPBDATE,BGPEDATE) ;Look for PRESCRIPTION
+1 NEW FOUND
+2 SET FOUND=$$FIND^BGPMUUT8(DFN,"BGPMU ASTHMA MEDS NDCS",BGPBDATE,"",BGPEDATE)
+3 QUIT FOUND
EXCLUDE(DFN,BGPBDATE,BGPEDATE) ;Look for exclusions
+1 NEW EFOUND
+2 SET EFOUND=0
+3 ;Next check for allergy
+4 SET ALLER=$$ALLER^BGPMUA10("NT200","")
+5 IF +ALLER
SET EFOUND=1_U_$PIECE(ALLER,U,1)
GOTO EXCQ
+6 SET ALLER=$$ALLER^BGPMUA10("RE100","")
+7 IF +ALLER
SET EFOUND=1_U_$PIECE(ALLER,U,1)
GOTO EXCQ
+8 SET ALLER=$$ALLER^BGPMUA10("RE101","")
+9 IF +ALLER
SET EFOUND=1_U_$PIECE(ALLER,U,1)
GOTO EXCQ
+10 SET ALLER=$$ALLER^BGPMUA10("RE102","")
+11 IF +ALLER
SET EFOUND=1_U_$PIECE(ALLER,U,1)
GOTO EXCQ
+12 SET ALLER=$$ALLER^BGPMUA10("RE103","")
+13 IF +ALLER
SET EFOUND=1_U_$PIECE(ALLER,U,1)
GOTO EXCQ
+14 SET ALLER=$$ALLER^BGPMUA10("RE104","")
+15 IF +ALLER
SET EFOUND=1_U_$PIECE(ALLER,U,1)
GOTO EXCQ
+16 SET ALLER=$$ALLER^BGPMUA10("RE105","")
+17 IF +ALLER
SET EFOUND=1_U_$PIECE(ALLER,U,1)
GOTO EXCQ
+18 SET ALLER=$$ALLER^BGPMUA10("RE108","")
+19 IF +ALLER
SET EFOUND=1_U_$PIECE(ALLER,U,1)
GOTO EXCQ
+20 SET ALLER=$$ALLER^BGPMUA10("RE109","")
+21 IF +ALLER
SET EFOUND=1_U_$PIECE(ALLER,U,1)
GOTO EXCQ
+22 ;Check for refusals
+23 SET TAX="BGPMU ASTHMA MEDS NDCS"
+24 SET BGPBIRTH=$$DOB^AUPNPAT(DFN)
+25 SET REF=$$MEDREF^BGPMUUT2(DFN,BGPBIRTH,BGPEDATE,TAX)
+26 IF +REF
SET EFOUND=1_U_$PIECE(REF,U,1)
GOTO EXCQ
EXCQ QUIT EFOUND
