BGPMUG08 ; IHS/MSC/MMT - MI measure NQF0088 ;20-Jul-2011 14:56;DU
;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
;Code to collect meaningful use report for diabetic retinopathy - severity
ENTRY ;EP
N START,END,STRING
N IEN,VDATE,VALUE,EXCEPT,FIRST,VIEN,RESULT
N CNT,NUM,DIABDX,DRENC
S START=9999999-BGPBDATE,END=9999999-BGPEDATE,VALUE=0
S START=START_".2359"
S (DIABDX,EXC,NUM)=0
;Pts must be >=18
;No need to check further if no age match
Q:BGPAGEE<18
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 DRENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENC RETINOPATHY COMBINED")
..I +DRENC D VSTSTORE Q
Q:CNT<2
;Next check to see if the patient is in the denominator
S DIABDX=$$DIABRET(DFN,BGPBDATE,BGPEDATE)
Q:'+DIABDX
;If the patient is diabetetic retinopathy, check to see if they are in the numerator
S NUM=$$NUM(DFN,BGPBDATE,BGPEDATE)
;If not in the numerator,see if they are an exception
I +NUM=0 S EXC=$$EXCEPT(DFN,BGPBDATE,BGPEDATE,DIABDX)
D TOTAL(DFN,DIABDX,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,DIABDX,NUM,EXC) ;See where this patient ends up
N PTCNT,EXCCT,DENCT,NUMCT,NOTNUM,TOTALS,DENSTR,DXTIME
S TOTALS=$G(^TMP("BGPMU0088",$J,BGPMUTF,"TOT"))
S DENCT=+$G(^TMP("BGPMU0088",$J,BGPMUTF,"DEN"))
S NUMCT=+$G(^TMP("BGPMU0088",$J,BGPMUTF,"NUM"))
S EXCCT=+$G(^TMP("BGPMU0088",$J,BGPMUTF,"EXC"))
S NOTNUM=+$G(^TMP("BGPMU0088",$J,BGPMUTF,"NOT"))
S PTCNT=TOTALS
S PTCNT=PTCNT+1
S (DENSTR,DXTIME)=""
S DENCT=DENCT+1 S ^TMP("BGPMU0088",$J,BGPMUTF,"DEN")=DENCT
S DENSTR=$P(DIABDX,U,2)
I $D(STRING(1)) S DENSTR=DENSTR_";EN:"_STRING(1)
I $D(STRING(2)) S DENSTR=DENSTR_";EN:"_STRING(2)
I +NUM D
.S NUMCT=NUMCT+1 S ^TMP("BGPMU0088",$J,BGPMUTF,"NUM")=NUMCT
.I BGPMUTF="C" S ^TMP("BGPMU0088",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DENSTR_U_"M:"_$P(NUM,U,2)
I +EXC D
.S EXCCT=EXCCT+1 S ^TMP("BGPMU0088",$J,BGPMUTF,"EXC")=EXCCT
.I BGPMUTF="C" S ^TMP("BGPMU0088",$J,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DENSTR_U_"Excluded"
I +NUM=0&(EXC=0) D
.S NOTNUM=NOTNUM+1 S ^TMP("BGPMU0088",$J,BGPMUTF,"NOT")=NOTNUM
.I BGPMUTF="C" S ^TMP("BGPMU0088",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DENSTR_U_"NM:"
S ^TMP("BGPMU0088",$J,BGPMUTF,"TOT")=PTCNT
;Setup iCare array for patient
S BGPICARE("MU.EP.0088.1",BGPMUTF)=1_U_+NUM_U_+EXC_U_DENSTR_";"_$P(NUM,U,2)
Q
DIABRET(DFN,BGPBDATE,BGPEDATE) ;look for diabetes diagnosis
N FOUND,CHKDT,DX
S FOUND=0
;Check for the patient having a DX of diabetic retinopathy prior to last visit
S CHKDT=$P(VIEN(1),U,2),BGPBIRTH=$$DOB^AUPNPAT(DFN)
S DX=$$LASTDX^BGPMUUT2(DFN,BGPBIRTH,CHKDT,"BGPMU DIABETIC RETINOPATHY DX")
I +DX S FOUND=1_U_"RET:"_$$DATE^BGPMUUTL($P(DX,U,3)) Q FOUND
S DX=$$PLTAX^BGPMUUT1(DFN,"BGPMU DIABETIC RETINOPATHY DX","C",CHKDT)
I +DX S FOUND=1_U_"RET:"_$$DATE^BGPMUUTL($P(DX,U,3)) Q FOUND
Q FOUND
NUM(DFN,BGPBDATE,BGPEDATE) ;Look for evidence of a diabetic eye exam
N FOUND,VCNT,EXAM,EXMPRC,EXAMDT,EXAM14,EXAMSTR,MESTR,LOSSTR,CLINPTR,CLINCODE,DX
S FOUND=0
S (VCNT,EXAM,MESTR,LOSSTR)=""
F S VCNT=$O(VIEN(VCNT)) Q:(VCNT="")!(+EXAM) D
.;check the CLINIC on the VISIT for a match
.S CLINPTR=$P(^AUPNVSIT($P(VIEN(VCNT),U),0),U,8)
.S CLINCODE=$S(CLINPTR'="":$P(^DIC(40.7,CLINPTR,0),U,2),1:"")
.I CLINCODE="A2" S EXAM=1_U_U_$P(VIEN(VCNT),U,2) Q
.;now look for procedures on the visit
.S EXMPRC=$$VSTCPT^BGPMUUT1(DFN,$P(VIEN(VCNT),U),"BGPMU MACULAR FUNDUS EXAM CPT")
.I +EXMPRC S EXAM=EXMPRC Q
.S EXMPRC=$$VSTICD0^BGPMUUT3(DFN,$P(VIEN(VCNT),U),"BGPMU MACULAR FUNDUS EXAM ICD0")
.I +EXMPRC S EXAM=EXMPRC Q
Q:'+EXAM FOUND
S EXAMSTR="EXAM:"_$$DATE^BGPMUUTL($P(EXAM,U,3))
S EXAM14=$$FMADD^XLFDT($P($P(EXAM,U,3),"."),14)
S EXAMDT=$$FMADD^XLFDT($P($P(EXAM,U,3),"."),-1)
S DX=$$LASTDX^BGPMUUT2(DFN,EXAMDT,EXAM14,"BGPMU MACULAR EDEMA DX")
I +DX S MESTR="ME:"_$$DATE^BGPMUUTL($P(DX,U,3))
S DX=$$PLTAX^BGPMUUT1(DFN,"BGPMU MACULAR EDEMA DX","C",EXAM14)
I +DX I ($P($G(^AUPNPROB($P(DX,U,4),0)),U,13)>=$P(EXAM,U,3)) S MESTR="ME:"_$$DATE^BGPMUUTL($P(DX,U,3))
Q:MESTR="" FOUND
S DX=$$LASTDX^BGPMUUT2(DFN,EXAMDT,EXAM14,"BGPMU DIABETIC RETINOPATHY LOS")
I +DX S LOSSTR="LOS:"_$$DATE^BGPMUUTL($P(DX,U,3))
S DX=$$PLTAX^BGPMUUT1(DFN,"BGPMU DIABETIC RETINOPATHY LOS","C",EXAM14)
I +DX I ($P($G(^AUPNPROB($P(DX,U,4),0)),U,13)>=$P(EXAM,U,3)) S LOSSTR="LOS:"_$$DATE^BGPMUUTL($P(DX,U,3))
Q:LOSSTR="" FOUND
S FOUND=1_U_EXAMSTR_";"_MESTR_";"_LOSSTR
Q FOUND
EXCEPT(DFN,BGPBDATE,BGPEDATE,DIABDX) ;See if this patient has exceptions
N EFOUND,NMI
S EFOUND=0
S NMI=$$REFTAX^BGPMUUT2(DFN,81,"BGPMU MACULAR FUNDUS EXAM CPT",BGPBDATE,BGPEDATE)
Q:+NMI 1_U_$P(NMI,U,4)_U_$P(NMI,U,2)
S NMI=$$REFTAX^BGPMUUT2(DFN,80.1,"BGPMU MACULAR FUNDUS EXAM ICD0",BGPBDATE,BGPEDATE)
Q:+NMI 1_U_$P(NMI,U,4)_U_$P(NMI,U,2)
Q EFOUND
BGPMUG08 ; IHS/MSC/MMT - MI measure NQF0088 ;20-Jul-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 diabetic retinopathy - severity
ENTRY ;EP
+1 NEW START,END,STRING
+2 NEW IEN,VDATE,VALUE,EXCEPT,FIRST,VIEN,RESULT
+3 NEW CNT,NUM,DIABDX,DRENC
+4 SET START=9999999-BGPBDATE
SET END=9999999-BGPEDATE
SET VALUE=0
+5 SET START=START_".2359"
+6 SET (DIABDX,EXC,NUM)=0
+7 ;Pts must be >=18
+8 ;No need to check further if no age match
+9 IF BGPAGEE<18
QUIT
+10 SET CNT=0
+11 SET FIRST=END-0.1
FOR
SET FIRST=$ORDER(^AUPNVSIT("AA",DFN,FIRST))
IF FIRST=""!($PIECE(FIRST,".",1)>START)
QUIT
Begin DoDot:1
+12 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVSIT("AA",DFN,FIRST,IEN))
IF '+IEN
QUIT
Begin DoDot:2
+13 ;Check provider, Only visits for chosen provider
+14 IF '$$PRV^BGPMUUT1(IEN,BGPPROV)
QUIT
+15 SET DRENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENC RETINOPATHY COMBINED")
+16 IF +DRENC
DO VSTSTORE
QUIT
End DoDot:2
End DoDot:1
+17 IF CNT<2
QUIT
+18 ;Next check to see if the patient is in the denominator
+19 SET DIABDX=$$DIABRET(DFN,BGPBDATE,BGPEDATE)
+20 IF '+DIABDX
QUIT
+21 ;If the patient is diabetetic retinopathy, check to see if they are in the numerator
+22 SET NUM=$$NUM(DFN,BGPBDATE,BGPEDATE)
+23 ;If not in the numerator,see if they are an exception
+24 IF +NUM=0
SET EXC=$$EXCEPT(DFN,BGPBDATE,BGPEDATE,DIABDX)
+25 DO TOTAL(DFN,DIABDX,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,DIABDX,NUM,EXC) ;See where this patient ends up
+1 NEW PTCNT,EXCCT,DENCT,NUMCT,NOTNUM,TOTALS,DENSTR,DXTIME
+2 SET TOTALS=$GET(^TMP("BGPMU0088",$JOB,BGPMUTF,"TOT"))
+3 SET DENCT=+$GET(^TMP("BGPMU0088",$JOB,BGPMUTF,"DEN"))
+4 SET NUMCT=+$GET(^TMP("BGPMU0088",$JOB,BGPMUTF,"NUM"))
+5 SET EXCCT=+$GET(^TMP("BGPMU0088",$JOB,BGPMUTF,"EXC"))
+6 SET NOTNUM=+$GET(^TMP("BGPMU0088",$JOB,BGPMUTF,"NOT"))
+7 SET PTCNT=TOTALS
+8 SET PTCNT=PTCNT+1
+9 SET (DENSTR,DXTIME)=""
+10 SET DENCT=DENCT+1
SET ^TMP("BGPMU0088",$JOB,BGPMUTF,"DEN")=DENCT
+11 SET DENSTR=$PIECE(DIABDX,U,2)
+12 IF $DATA(STRING(1))
SET DENSTR=DENSTR_";EN:"_STRING(1)
+13 IF $DATA(STRING(2))
SET DENSTR=DENSTR_";EN:"_STRING(2)
+14 IF +NUM
Begin DoDot:1
+15 SET NUMCT=NUMCT+1
SET ^TMP("BGPMU0088",$JOB,BGPMUTF,"NUM")=NUMCT
+16 IF BGPMUTF="C"
SET ^TMP("BGPMU0088",$JOB,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DENSTR_U_"M:"_$PIECE(NUM,U,2)
End DoDot:1
+17 IF +EXC
Begin DoDot:1
+18 SET EXCCT=EXCCT+1
SET ^TMP("BGPMU0088",$JOB,BGPMUTF,"EXC")=EXCCT
+19 IF BGPMUTF="C"
SET ^TMP("BGPMU0088",$JOB,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DENSTR_U_"Excluded"
End DoDot:1
+20 IF +NUM=0&(EXC=0)
Begin DoDot:1
+21 SET NOTNUM=NOTNUM+1
SET ^TMP("BGPMU0088",$JOB,BGPMUTF,"NOT")=NOTNUM
+22 IF BGPMUTF="C"
SET ^TMP("BGPMU0088",$JOB,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DENSTR_U_"NM:"
End DoDot:1
+23 SET ^TMP("BGPMU0088",$JOB,BGPMUTF,"TOT")=PTCNT
+24 ;Setup iCare array for patient
+25 SET BGPICARE("MU.EP.0088.1",BGPMUTF)=1_U_+NUM_U_+EXC_U_DENSTR_";"_$PIECE(NUM,U,2)
+26 QUIT
DIABRET(DFN,BGPBDATE,BGPEDATE) ;look for diabetes diagnosis
+1 NEW FOUND,CHKDT,DX
+2 SET FOUND=0
+3 ;Check for the patient having a DX of diabetic retinopathy prior to last visit
+4 SET CHKDT=$PIECE(VIEN(1),U,2)
SET BGPBIRTH=$$DOB^AUPNPAT(DFN)
+5 SET DX=$$LASTDX^BGPMUUT2(DFN,BGPBIRTH,CHKDT,"BGPMU DIABETIC RETINOPATHY DX")
+6 IF +DX
SET FOUND=1_U_"RET:"_$$DATE^BGPMUUTL($PIECE(DX,U,3))
QUIT FOUND
+7 SET DX=$$PLTAX^BGPMUUT1(DFN,"BGPMU DIABETIC RETINOPATHY DX","C",CHKDT)
+8 IF +DX
SET FOUND=1_U_"RET:"_$$DATE^BGPMUUTL($PIECE(DX,U,3))
QUIT FOUND
+9 QUIT FOUND
NUM(DFN,BGPBDATE,BGPEDATE) ;Look for evidence of a diabetic eye exam
+1 NEW FOUND,VCNT,EXAM,EXMPRC,EXAMDT,EXAM14,EXAMSTR,MESTR,LOSSTR,CLINPTR,CLINCODE,DX
+2 SET FOUND=0
+3 SET (VCNT,EXAM,MESTR,LOSSTR)=""
+4 FOR
SET VCNT=$ORDER(VIEN(VCNT))
IF (VCNT="")!(+EXAM)
QUIT
Begin DoDot:1
+5 ;check the CLINIC on the VISIT for a match
+6 SET CLINPTR=$PIECE(^AUPNVSIT($PIECE(VIEN(VCNT),U),0),U,8)
+7 SET CLINCODE=$SELECT(CLINPTR'="":$PIECE(^DIC(40.7,CLINPTR,0),U,2),1:"")
+8 IF CLINCODE="A2"
SET EXAM=1_U_U_$PIECE(VIEN(VCNT),U,2)
QUIT
+9 ;now look for procedures on the visit
+10 SET EXMPRC=$$VSTCPT^BGPMUUT1(DFN,$PIECE(VIEN(VCNT),U),"BGPMU MACULAR FUNDUS EXAM CPT")
+11 IF +EXMPRC
SET EXAM=EXMPRC
QUIT
+12 SET EXMPRC=$$VSTICD0^BGPMUUT3(DFN,$PIECE(VIEN(VCNT),U),"BGPMU MACULAR FUNDUS EXAM ICD0")
+13 IF +EXMPRC
SET EXAM=EXMPRC
QUIT
End DoDot:1
+14 IF '+EXAM
QUIT FOUND
+15 SET EXAMSTR="EXAM:"_$$DATE^BGPMUUTL($PIECE(EXAM,U,3))
+16 SET EXAM14=$$FMADD^XLFDT($PIECE($PIECE(EXAM,U,3),"."),14)
+17 SET EXAMDT=$$FMADD^XLFDT($PIECE($PIECE(EXAM,U,3),"."),-1)
+18 SET DX=$$LASTDX^BGPMUUT2(DFN,EXAMDT,EXAM14,"BGPMU MACULAR EDEMA DX")
+19 IF +DX
SET MESTR="ME:"_$$DATE^BGPMUUTL($PIECE(DX,U,3))
+20 SET DX=$$PLTAX^BGPMUUT1(DFN,"BGPMU MACULAR EDEMA DX","C",EXAM14)
+21 IF +DX
IF ($PIECE($GET(^AUPNPROB($PIECE(DX,U,4),0)),U,13)>=$PIECE(EXAM,U,3))
SET MESTR="ME:"_$$DATE^BGPMUUTL($PIECE(DX,U,3))
+22 IF MESTR=""
QUIT FOUND
+23 SET DX=$$LASTDX^BGPMUUT2(DFN,EXAMDT,EXAM14,"BGPMU DIABETIC RETINOPATHY LOS")
+24 IF +DX
SET LOSSTR="LOS:"_$$DATE^BGPMUUTL($PIECE(DX,U,3))
+25 SET DX=$$PLTAX^BGPMUUT1(DFN,"BGPMU DIABETIC RETINOPATHY LOS","C",EXAM14)
+26 IF +DX
IF ($PIECE($GET(^AUPNPROB($PIECE(DX,U,4),0)),U,13)>=$PIECE(EXAM,U,3))
SET LOSSTR="LOS:"_$$DATE^BGPMUUTL($PIECE(DX,U,3))
+27 IF LOSSTR=""
QUIT FOUND
+28 SET FOUND=1_U_EXAMSTR_";"_MESTR_";"_LOSSTR
+29 QUIT FOUND
EXCEPT(DFN,BGPBDATE,BGPEDATE,DIABDX) ;See if this patient has exceptions
+1 NEW EFOUND,NMI
+2 SET EFOUND=0
+3 SET NMI=$$REFTAX^BGPMUUT2(DFN,81,"BGPMU MACULAR FUNDUS EXAM CPT",BGPBDATE,BGPEDATE)
+4 IF +NMI
QUIT 1_U_$PIECE(NMI,U,4)_U_$PIECE(NMI,U,2)
+5 SET NMI=$$REFTAX^BGPMUUT2(DFN,80.1,"BGPMU MACULAR FUNDUS EXAM ICD0",BGPBDATE,BGPEDATE)
+6 IF +NMI
QUIT 1_U_$PIECE(NMI,U,4)_U_$PIECE(NMI,U,2)
+7 QUIT EFOUND
