- 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