BGPMUA07 ; IHS/MSC/MGH - MI measure NQF0056 & NQF0061 ;25-Jul-2011 08:35;DU
;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
;Code to collect meaningful use report for diabetic foot exam
ENTRY1 ;EP Entry point for NQA0056 Diabetic food exam
N START,END,BGPNUM,BGPDEN,BGPNUM,STRING,STRING2,BGPHYPER,BGPHYPL
N IEN,INV,VISIT,DATA,VDATE,VALUE,EXCEPT,FIRST,VIEN,EXCEPT,RESULT
N CNT,DIAB,NUM,EXC,DIAB,OUTENC,OPHENC,NONENC,VENC,DIABDX,ERENC,INENC
S (BGPDEN,BGPNUM,RESULT)=0
S START=9999999-BGPBDATE,END=9999999-BGPEDATE,VALUE=0
S START=START_".2359"
S (STRING,STRING2)="",DIABDX=0
;Pts must be >18 and <75
;No need to check further if no age match
S DIABDX=0
S (DIAB,EXC,NUM)=0
Q:BGPAGEE<18!(BGPAGEE>75)
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 OUTENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENCOUNTER OUTPT")
..I +OUTENC D VSTSTORE Q
..S OPHENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU OPTHAMOLOGY CPTS")
..I +OPHENC D VSTSTORE Q
..S NONENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU NON-ACUTE INPT CPT")
..I +NONENC D VSTSTORE Q
..S INENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ACUTE INPT ENC")
..I +INENC D VSTSTORE Q
..S VENC=$$VSTPOV^BGPMUUT3(DFN,IEN,"BGPMU ENC OUTPATIENT ICD")
..I +VENC D VSTSTORE Q
..S ERENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU DIAB ED ENCOUNTER CPT")
..I +ERENC D VSTSTORE Q
;Next check to see if the patient is in the denominator
;Denominator is that the pt had a diabetes medicine
;in the last 2 years or a DX of diabetes in the last 2 years along with
;one inpt visit or 2 or more outpt visits
S DIAB=$$DIAB^BGPMUA06(DFN,BGPBDATE,BGPEDATE,CNT,DIABDX)
I +DIAB D
.;If the patient is diabetetic, check to see if they are in the numerator
.S NUM=$$NUM1(DFN,BGPBDATE,BGPEDATE)
.;If not in the numerator,see if they are an exception
.I NUM=0&(+DIAB=2) S EXC=$$EXCEPT^BGPMUA06(DFN,BGPBDATE,BGPEDATE,DIABDX)
.D TOTAL1(DFN,DIAB,NUM,EXC)
Q
VSTSTORE ;Store a compliant visit into the 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
TOTAL1(DFN,DIAB,NUM,EXC) ;See where this patient ends up
N PTCNT,EXCCT,DENCT,NUMCT,NOTNUM,TOTALS,DXTIME,DEN
S TOTALS=$G(^TMP("BGPMU0056",$J,BGPMUTF,"TOT"))
S DENCT=+$G(^TMP("BGPMU0056",$J,BGPMUTF,"DEN"))
S NUMCT=+$G(^TMP("BGPMU0056",$J,BGPMUTF,"NUM"))
S EXCCT=+$G(^TMP("BGPMU0056",$J,BGPMUTF,"EXC"))
S NOTNUM=+$G(^TMP("BGPMU0056",$J,BGPMUTF,"NOT"))
S PTCNT=TOTALS
S PTCNT=PTCNT+1
S (DEN,DXTIME)=""
S DENCT=DENCT+1 S ^TMP("BGPMU0056",$J,BGPMUTF,"DEN")=DENCT
I $P(DIAB,U,3)'="" S DXTIME=$$DATE^BGPMUUTL($P(DIAB,U,3))
S DEN=$P(DIAB,U,2)_" "_DXTIME
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("BGPMU0056",$J,BGPMUTF,"NUM")=NUMCT
.I BGPMUTF="C" S ^TMP("BGPMU0056",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DEN_U_"M:"_$P(NUM,U,2)_";"_$P(NUM,U,3)_";"_$P(NUM,U,4)_";"_$P(NUM,U,5)
I +EXC D
.S EXCCT=EXCCT+1 S ^TMP("BGPMU0056",$J,BGPMUTF,"EXC")=EXCCT
.I BGPMUTF="C" S ^TMP("BGPMU0056",$J,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DEN_U_"EXCLUDE"
I NUM=0&(EXC=0) D
.S NOTNUM=NOTNUM+1 S ^TMP("BGPMU0056",$J,BGPMUTF,"NOT")=NOTNUM
.I BGPMUTF="C" S ^TMP("BGPMU0056",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DEN_U_"NM:"_$P(NUM,U,2)_";"_$P(NUM,U,3)
S ^TMP("BGPMU0056",$J,BGPMUTF,"TOT")=PTCNT
;Setup iCare array for patient
S BGPICARE("MU.EP.0056.1",BGPMUTF)=1_U_+NUM_U_+EXC_U_DEN_";"_$P(NUM,U,2)_";"_$P(NUM,U,3)
Q
NUM1(DFN,BGPBDATE,BGPEDATE) ;Look for evidence of a diabetic foot exam
N FOUND,YR1,EXM
S FOUND=0
;Search for CPT code during the reporting period
S EXM=$$CPT^BGPMUUT1(DFN,BGPBDATE,BGPEDATE,"BGPMU DIAB FOOT EXAM CPT")
I +EXM S FOUND=1_U_$P(EXM,U,2)_U_$P(EXM,U,3)
Q FOUND
ENTRY2 ;EP Entry point for NQA0061 Most recent BP<140/90
N START,END,BGPNUM,BGPDEN,BGPNUM,AENC,BENC,STRING,STRING2,BGPHYPER,BGPHYPL
N IEN,INV,VISIT,DATA,VDATE,VALUE,EXCEPT,FIRST,VIEN,EXCEPT,RESULT
N CNT,DIAB,NUM,EXC,DIAB,OUTENC,OPHENC,NONENC,VENC,DIABDX,ERENC,INENC
S (BGPDEN,BGPNUM,RESULT)=0
S START=9999999-BGPBDATE,END=9999999-BGPEDATE,VALUE=0
S START=START_".2359"
S (STRING,STRING2)=""
S DIABDX=0
S (DIAB,EXC,NUM)=0
;Pts must be >18 and <75
;No need to check further if no age match
Q:BGPAGEE<18!(BGPAGEE>75)
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 OUTENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENCOUNTER OUTPT")
..I +OUTENC D VSTSTORE Q
..S OPHENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU OPTHAMOLOGY CPTS")
..I +OPHENC D VSTSTORE Q
..S NONENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU NON-ACUTE INPT CPT")
..I +NONENC D VSTSTORE Q
..S INENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ACUTE INPT ENC")
..I +INENC D VSTSTORE Q
..S ERENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU DIAB ED ENCOUNTER CPT")
..I +ERENC D VSTSTORE Q
..S VENC=$$VSTPOV^BGPMUUT3(DFN,IEN,"BGPMU ENC OUTPATIENT ICD")
..I +VENC D VSTSTORE Q
;Next check to see if the patient is in the denominator
;Denominator is that the pt had a diabetes medicine
;in the last 2 years or a DX of diabetes in the last 2 years along with
;one inpt visit or 2 or more outpt visit
S DIAB=$$DIAB^BGPMUA06(DFN,BGPBDATE,BGPEDATE,CNT,DIABDX)
I +DIAB D
.;If the patient is diabetetic, check to see if they are in the numerator
.S NUM=$$NUM2(DFN,BGPBDATE,BGPEDATE)
.;If not in the numerator,see if they are an exception
.I NUM'=2&(+DIAB=2) S EXC=$$EXCEPT^BGPMUA06(DFN,BGPBDATE,BGPEDATE,DIABDX)
.D TOTAL2(DFN,DIAB,NUM,EXC)
Q
TOTAL2(DFN,DIAB,NUM,EXC) ;See where this patient ends up
N PTCNT,EXCCT,DENCT,NUMCT,NOTNUM,TOTALS,DXTIME,DEN
S TOTALS=$G(^TMP("BGPMU0061",$J,BGPMUTF,"TOT"))
S DENCT=+$G(^TMP("BGPMU0061",$J,BGPMUTF,"DEN"))
S NUMCT=+$G(^TMP("BGPMU0061",$J,BGPMUTF,"NUM"))
S EXCCT=+$G(^TMP("BGPMU0061",$J,BGPMUTF,"EXC"))
S NOTNUM=+$G(^TMP("BGPMU0061",$J,BGPMUTF,"NOT"))
S PTCNT=TOTALS
S PTCNT=PTCNT+1
S (DEN,DXTIME)=""
S DENCT=DENCT+1 S ^TMP("BGPMU0061",$J,BGPMUTF,"DEN")=DENCT
I $P(DIAB,U,3)'="" S DXTIME=$$DATE^BGPMUUTL($P(DIAB,U,3))
S DEN=$P(DIAB,U,2)_" "_DXTIME
I $D(STRING(1)) S DEN=DEN_";EN:"_STRING(1)
I $D(STRING(2)) S DEN=DEN_";EN:"_STRING(2)
I +NUM=2 D
.S NUMCT=NUMCT+1 S ^TMP("BGPMU0061",$J,BGPMUTF,"NUM")=NUMCT
.I BGPMUTF="C" S ^TMP("BGPMU0061",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DEN_U_"M:"_$P(NUM,U,2)_";"_$P(NUM,U,3)_";"_$P(NUM,U,4)_";"_$P(NUM,U,5)
I +EXC D
.S EXCCT=EXCCT+1 S ^TMP("BGPMU0061",$J,BGPMUTF,"EXC")=EXCCT
.I BGPMUTF="C" S ^TMP("BGPMU0061",$J,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DEN_U_"EXCLUDE"
I +NUM'=2&(EXC=0) D
.S NOTNUM=NOTNUM+1 S ^TMP("BGPMU0061",$J,BGPMUTF,"NOT")=NOTNUM
.I BGPMUTF="C" S ^TMP("BGPMU0061",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DEN_U_"NM:"_$P(NUM,U,2)_";"_$P(NUM,U,3)
S ^TMP("BGPMU0061",$J,BGPMUTF,"TOT")=PTCNT
;Setup iCare array for patient
S BGPICARE("MU.EP.0061.1",BGPMUTF)=1_U_(+NUM=2)_U_+EXC_U_DEN_";"_$P(NUM,U,2)_";"_$P(NUM,U,3)
Q
NUM2(DFN,BGPBDATE,BGPEDATE) ; Find the latest BP
;check blood pressure reading of most recent outpatient encounter
N LDIA,LSYS,BGPBP,BP,SYS,DIA,BGPI,BGPNUM,BGPCNT,RESULT,VSIEN
S (LDIA,LSYS)=""
;Find is pt has a BP on the chosen visits
N IEN,MSR,MTYP,BP,BPCNT,SAVE,ARRAY,VST,VCNT,INV,DTE,EIE
S BP=0,BPCNT=0,VCNT=0
S MTYP="" S MTYP=$O(^AUTTMSR("B","BP",MTYP))
Q:MTYP="" 0
Q:'$D(VIEN) 0
S VSIEN=$P($G(VIEN(1)),U,1)
S IEN=VSIEN,SAVE=0
S MSR="" F S MSR=$O(^AUPNVMSR("AD",VSIEN,MSR)) Q:MSR="" D
.S EIE=$$GET1^DIQ(9000010.01,MSR,2,"I")
.Q:EIE=1
.I $P($G(^AUPNVMSR(MSR,0)),U,1)=MTYP D
..S BPCNT=BPCNT+1
..S INV=9999999-$P($G(^AUPNVMSR(MSR,12)),U,1)
..S ARRAY(INV)=IEN_U_$P($G(^AUPNVMSR(MSR,0)),U,4)_U_$$DATE^BGPMUUTL($P($G(^AUPNVMSR(MSR,12)),U,1))
I BPCNT=1 D
.S DTE="" S DTE=$O(ARRAY(DTE))
.S RESULT=$P($G(ARRAY(DTE)),U,2)
.S SYS=$P(RESULT,"/",1),DIAS=$P(RESULT,"/",2)
.I SYS>139!(DIAS>89) S BP=1_U_RESULT_U_$P($G(ARRAY(DTE)),U,3)
.E S BP=2_U_RESULT_U_$P($G(ARRAY(DTE)),U,3)
;More than one BP on the visit
I BPCNT>1 D
.N DONE,SYSARRAY,DIAARRAY
.S DONE=0
.S DTE="" F S DTE=$O(ARRAY(DTE)) Q:DTE=""!(+DONE) D
..S RESULT=$P($G(ARRAY(DTE)),U,2)
..S SYS=$P(RESULT,"/",1),DIAS=$P(RESULT,"/",2)
..I SYS<140&(DIAS<90) D Q
...;If any BP is <140/90 we are done
...S DONE=1
...S BP=2_U_RESULT_U_$P($G(ARRAY(DTE)),U,3)
..;If Sys <140 save it
..I SYS<140 D Q
...S SYSARRAY(SYS)=RESULT_U_$P($G(ARRAY(DTE)),U,3)
..;If Dias <90 save it
..I DIAS<90 D Q
...S DIAARRAY(DIAS)=RESULT_U_$P($G(ARRAY(DTE)),U,3)
.;when done looping, see if there are any saved items
.I $D(SYSARRAY)&$D(DIAARRAY) D
..S RES1=$O(SYSARRAY(""))
..S RES2=$O(DIAARRAY(""))
..S BP=2_U_$G(SYSARRAY(RES1))_U_$G(DIAARRAY(RES2))
Q BP
BGPMUA07 ; IHS/MSC/MGH - MI measure NQF0056 & NQF0061 ;25-Jul-2011 08:35;DU
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
+2 ;Code to collect meaningful use report for diabetic foot exam
ENTRY1 ;EP Entry point for NQA0056 Diabetic food exam
+1 NEW START,END,BGPNUM,BGPDEN,BGPNUM,STRING,STRING2,BGPHYPER,BGPHYPL
+2 NEW IEN,INV,VISIT,DATA,VDATE,VALUE,EXCEPT,FIRST,VIEN,EXCEPT,RESULT
+3 NEW CNT,DIAB,NUM,EXC,DIAB,OUTENC,OPHENC,NONENC,VENC,DIABDX,ERENC,INENC
+4 SET (BGPDEN,BGPNUM,RESULT)=0
+5 SET START=9999999-BGPBDATE
SET END=9999999-BGPEDATE
SET VALUE=0
+6 SET START=START_".2359"
+7 SET (STRING,STRING2)=""
SET DIABDX=0
+8 ;Pts must be >18 and <75
+9 ;No need to check further if no age match
+10 SET DIABDX=0
+11 SET (DIAB,EXC,NUM)=0
+12 IF BGPAGEE<18!(BGPAGEE>75)
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 OUTENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENCOUNTER OUTPT")
+19 IF +OUTENC
DO VSTSTORE
QUIT
+20 SET OPHENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU OPTHAMOLOGY CPTS")
+21 IF +OPHENC
DO VSTSTORE
QUIT
+22 SET NONENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU NON-ACUTE INPT CPT")
+23 IF +NONENC
DO VSTSTORE
QUIT
+24 SET INENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ACUTE INPT ENC")
+25 IF +INENC
DO VSTSTORE
QUIT
+26 SET VENC=$$VSTPOV^BGPMUUT3(DFN,IEN,"BGPMU ENC OUTPATIENT ICD")
+27 IF +VENC
DO VSTSTORE
QUIT
+28 SET ERENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU DIAB ED ENCOUNTER CPT")
+29 IF +ERENC
DO VSTSTORE
QUIT
End DoDot:2
End DoDot:1
+30 ;Next check to see if the patient is in the denominator
+31 ;Denominator is that the pt had a diabetes medicine
+32 ;in the last 2 years or a DX of diabetes in the last 2 years along with
+33 ;one inpt visit or 2 or more outpt visits
+34 SET DIAB=$$DIAB^BGPMUA06(DFN,BGPBDATE,BGPEDATE,CNT,DIABDX)
+35 IF +DIAB
Begin DoDot:1
+36 ;If the patient is diabetetic, check to see if they are in the numerator
+37 SET NUM=$$NUM1(DFN,BGPBDATE,BGPEDATE)
+38 ;If not in the numerator,see if they are an exception
+39 IF NUM=0&(+DIAB=2)
SET EXC=$$EXCEPT^BGPMUA06(DFN,BGPBDATE,BGPEDATE,DIABDX)
+40 DO TOTAL1(DFN,DIAB,NUM,EXC)
End DoDot:1
+41 QUIT
VSTSTORE ;Store a compliant visit into the 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
TOTAL1(DFN,DIAB,NUM,EXC) ;See where this patient ends up
+1 NEW PTCNT,EXCCT,DENCT,NUMCT,NOTNUM,TOTALS,DXTIME,DEN
+2 SET TOTALS=$GET(^TMP("BGPMU0056",$JOB,BGPMUTF,"TOT"))
+3 SET DENCT=+$GET(^TMP("BGPMU0056",$JOB,BGPMUTF,"DEN"))
+4 SET NUMCT=+$GET(^TMP("BGPMU0056",$JOB,BGPMUTF,"NUM"))
+5 SET EXCCT=+$GET(^TMP("BGPMU0056",$JOB,BGPMUTF,"EXC"))
+6 SET NOTNUM=+$GET(^TMP("BGPMU0056",$JOB,BGPMUTF,"NOT"))
+7 SET PTCNT=TOTALS
+8 SET PTCNT=PTCNT+1
+9 SET (DEN,DXTIME)=""
+10 SET DENCT=DENCT+1
SET ^TMP("BGPMU0056",$JOB,BGPMUTF,"DEN")=DENCT
+11 IF $PIECE(DIAB,U,3)'=""
SET DXTIME=$$DATE^BGPMUUTL($PIECE(DIAB,U,3))
+12 SET DEN=$PIECE(DIAB,U,2)_" "_DXTIME
+13 IF $DATA(STRING(1))
SET DEN=DEN_";EN:"_STRING(1)
+14 IF $DATA(STRING(2))
SET DEN=DEN_";EN:"_STRING(2)
+15 IF +NUM
Begin DoDot:1
+16 SET NUMCT=NUMCT+1
SET ^TMP("BGPMU0056",$JOB,BGPMUTF,"NUM")=NUMCT
+17 IF BGPMUTF="C"
SET ^TMP("BGPMU0056",$JOB,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DEN_U_"M:"_$PIECE(NUM,U,2)_";"_$PIECE(NUM,U,3)_";"_$PIECE(NUM,U,4)_";"_$PIECE(NUM,U,5)
End DoDot:1
+18 IF +EXC
Begin DoDot:1
+19 SET EXCCT=EXCCT+1
SET ^TMP("BGPMU0056",$JOB,BGPMUTF,"EXC")=EXCCT
+20 IF BGPMUTF="C"
SET ^TMP("BGPMU0056",$JOB,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DEN_U_"EXCLUDE"
End DoDot:1
+21 IF NUM=0&(EXC=0)
Begin DoDot:1
+22 SET NOTNUM=NOTNUM+1
SET ^TMP("BGPMU0056",$JOB,BGPMUTF,"NOT")=NOTNUM
+23 IF BGPMUTF="C"
SET ^TMP("BGPMU0056",$JOB,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DEN_U_"NM:"_$PIECE(NUM,U,2)_";"_$PIECE(NUM,U,3)
End DoDot:1
+24 SET ^TMP("BGPMU0056",$JOB,BGPMUTF,"TOT")=PTCNT
+25 ;Setup iCare array for patient
+26 SET BGPICARE("MU.EP.0056.1",BGPMUTF)=1_U_+NUM_U_+EXC_U_DEN_";"_$PIECE(NUM,U,2)_";"_$PIECE(NUM,U,3)
+27 QUIT
NUM1(DFN,BGPBDATE,BGPEDATE) ;Look for evidence of a diabetic foot exam
+1 NEW FOUND,YR1,EXM
+2 SET FOUND=0
+3 ;Search for CPT code during the reporting period
+4 SET EXM=$$CPT^BGPMUUT1(DFN,BGPBDATE,BGPEDATE,"BGPMU DIAB FOOT EXAM CPT")
+5 IF +EXM
SET FOUND=1_U_$PIECE(EXM,U,2)_U_$PIECE(EXM,U,3)
+6 QUIT FOUND
ENTRY2 ;EP Entry point for NQA0061 Most recent BP<140/90
+1 NEW START,END,BGPNUM,BGPDEN,BGPNUM,AENC,BENC,STRING,STRING2,BGPHYPER,BGPHYPL
+2 NEW IEN,INV,VISIT,DATA,VDATE,VALUE,EXCEPT,FIRST,VIEN,EXCEPT,RESULT
+3 NEW CNT,DIAB,NUM,EXC,DIAB,OUTENC,OPHENC,NONENC,VENC,DIABDX,ERENC,INENC
+4 SET (BGPDEN,BGPNUM,RESULT)=0
+5 SET START=9999999-BGPBDATE
SET END=9999999-BGPEDATE
SET VALUE=0
+6 SET START=START_".2359"
+7 SET (STRING,STRING2)=""
+8 SET DIABDX=0
+9 SET (DIAB,EXC,NUM)=0
+10 ;Pts must be >18 and <75
+11 ;No need to check further if no age match
+12 IF BGPAGEE<18!(BGPAGEE>75)
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 OUTENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENCOUNTER OUTPT")
+19 IF +OUTENC
DO VSTSTORE
QUIT
+20 SET OPHENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU OPTHAMOLOGY CPTS")
+21 IF +OPHENC
DO VSTSTORE
QUIT
+22 SET NONENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU NON-ACUTE INPT CPT")
+23 IF +NONENC
DO VSTSTORE
QUIT
+24 SET INENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ACUTE INPT ENC")
+25 IF +INENC
DO VSTSTORE
QUIT
+26 SET ERENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU DIAB ED ENCOUNTER CPT")
+27 IF +ERENC
DO VSTSTORE
QUIT
+28 SET VENC=$$VSTPOV^BGPMUUT3(DFN,IEN,"BGPMU ENC OUTPATIENT ICD")
+29 IF +VENC
DO VSTSTORE
QUIT
End DoDot:2
End DoDot:1
+30 ;Next check to see if the patient is in the denominator
+31 ;Denominator is that the pt had a diabetes medicine
+32 ;in the last 2 years or a DX of diabetes in the last 2 years along with
+33 ;one inpt visit or 2 or more outpt visit
+34 SET DIAB=$$DIAB^BGPMUA06(DFN,BGPBDATE,BGPEDATE,CNT,DIABDX)
+35 IF +DIAB
Begin DoDot:1
+36 ;If the patient is diabetetic, check to see if they are in the numerator
+37 SET NUM=$$NUM2(DFN,BGPBDATE,BGPEDATE)
+38 ;If not in the numerator,see if they are an exception
+39 IF NUM'=2&(+DIAB=2)
SET EXC=$$EXCEPT^BGPMUA06(DFN,BGPBDATE,BGPEDATE,DIABDX)
+40 DO TOTAL2(DFN,DIAB,NUM,EXC)
End DoDot:1
+41 QUIT
TOTAL2(DFN,DIAB,NUM,EXC) ;See where this patient ends up
+1 NEW PTCNT,EXCCT,DENCT,NUMCT,NOTNUM,TOTALS,DXTIME,DEN
+2 SET TOTALS=$GET(^TMP("BGPMU0061",$JOB,BGPMUTF,"TOT"))
+3 SET DENCT=+$GET(^TMP("BGPMU0061",$JOB,BGPMUTF,"DEN"))
+4 SET NUMCT=+$GET(^TMP("BGPMU0061",$JOB,BGPMUTF,"NUM"))
+5 SET EXCCT=+$GET(^TMP("BGPMU0061",$JOB,BGPMUTF,"EXC"))
+6 SET NOTNUM=+$GET(^TMP("BGPMU0061",$JOB,BGPMUTF,"NOT"))
+7 SET PTCNT=TOTALS
+8 SET PTCNT=PTCNT+1
+9 SET (DEN,DXTIME)=""
+10 SET DENCT=DENCT+1
SET ^TMP("BGPMU0061",$JOB,BGPMUTF,"DEN")=DENCT
+11 IF $PIECE(DIAB,U,3)'=""
SET DXTIME=$$DATE^BGPMUUTL($PIECE(DIAB,U,3))
+12 SET DEN=$PIECE(DIAB,U,2)_" "_DXTIME
+13 IF $DATA(STRING(1))
SET DEN=DEN_";EN:"_STRING(1)
+14 IF $DATA(STRING(2))
SET DEN=DEN_";EN:"_STRING(2)
+15 IF +NUM=2
Begin DoDot:1
+16 SET NUMCT=NUMCT+1
SET ^TMP("BGPMU0061",$JOB,BGPMUTF,"NUM")=NUMCT
+17 IF BGPMUTF="C"
SET ^TMP("BGPMU0061",$JOB,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DEN_U_"M:"_$PIECE(NUM,U,2)_";"_$PIECE(NUM,U,3)_";"_$PIECE(NUM,U,4)_";"_$PIECE(NUM,U,5)
End DoDot:1
+18 IF +EXC
Begin DoDot:1
+19 SET EXCCT=EXCCT+1
SET ^TMP("BGPMU0061",$JOB,BGPMUTF,"EXC")=EXCCT
+20 IF BGPMUTF="C"
SET ^TMP("BGPMU0061",$JOB,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DEN_U_"EXCLUDE"
End DoDot:1
+21 IF +NUM'=2&(EXC=0)
Begin DoDot:1
+22 SET NOTNUM=NOTNUM+1
SET ^TMP("BGPMU0061",$JOB,BGPMUTF,"NOT")=NOTNUM
+23 IF BGPMUTF="C"
SET ^TMP("BGPMU0061",$JOB,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DEN_U_"NM:"_$PIECE(NUM,U,2)_";"_$PIECE(NUM,U,3)
End DoDot:1
+24 SET ^TMP("BGPMU0061",$JOB,BGPMUTF,"TOT")=PTCNT
+25 ;Setup iCare array for patient
+26 SET BGPICARE("MU.EP.0061.1",BGPMUTF)=1_U_(+NUM=2)_U_+EXC_U_DEN_";"_$PIECE(NUM,U,2)_";"_$PIECE(NUM,U,3)
+27 QUIT
NUM2(DFN,BGPBDATE,BGPEDATE) ; Find the latest BP
+1 ;check blood pressure reading of most recent outpatient encounter
+2 NEW LDIA,LSYS,BGPBP,BP,SYS,DIA,BGPI,BGPNUM,BGPCNT,RESULT,VSIEN
+3 SET (LDIA,LSYS)=""
+4 ;Find is pt has a BP on the chosen visits
+5 NEW IEN,MSR,MTYP,BP,BPCNT,SAVE,ARRAY,VST,VCNT,INV,DTE,EIE
+6 SET BP=0
SET BPCNT=0
SET VCNT=0
+7 SET MTYP=""
SET MTYP=$ORDER(^AUTTMSR("B","BP",MTYP))
+8 IF MTYP=""
QUIT 0
+9 IF '$DATA(VIEN)
QUIT 0
+10 SET VSIEN=$PIECE($GET(VIEN(1)),U,1)
+11 SET IEN=VSIEN
SET SAVE=0
+12 SET MSR=""
FOR
SET MSR=$ORDER(^AUPNVMSR("AD",VSIEN,MSR))
IF MSR=""
QUIT
Begin DoDot:1
+13 SET EIE=$$GET1^DIQ(9000010.01,MSR,2,"I")
+14 IF EIE=1
QUIT
+15 IF $PIECE($GET(^AUPNVMSR(MSR,0)),U,1)=MTYP
Begin DoDot:2
+16 SET BPCNT=BPCNT+1
+17 SET INV=9999999-$PIECE($GET(^AUPNVMSR(MSR,12)),U,1)
+18 SET ARRAY(INV)=IEN_U_$PIECE($GET(^AUPNVMSR(MSR,0)),U,4)_U_$$DATE^BGPMUUTL($PIECE($GET(^AUPNVMSR(MSR,12)),U,1))
End DoDot:2
End DoDot:1
+19 IF BPCNT=1
Begin DoDot:1
+20 SET DTE=""
SET DTE=$ORDER(ARRAY(DTE))
+21 SET RESULT=$PIECE($GET(ARRAY(DTE)),U,2)
+22 SET SYS=$PIECE(RESULT,"/",1)
SET DIAS=$PIECE(RESULT,"/",2)
+23 IF SYS>139!(DIAS>89)
SET BP=1_U_RESULT_U_$PIECE($GET(ARRAY(DTE)),U,3)
+24 IF '$TEST
SET BP=2_U_RESULT_U_$PIECE($GET(ARRAY(DTE)),U,3)
End DoDot:1
+25 ;More than one BP on the visit
+26 IF BPCNT>1
Begin DoDot:1
+27 NEW DONE,SYSARRAY,DIAARRAY
+28 SET DONE=0
+29 SET DTE=""
FOR
SET DTE=$ORDER(ARRAY(DTE))
IF DTE=""!(+DONE)
QUIT
Begin DoDot:2
+30 SET RESULT=$PIECE($GET(ARRAY(DTE)),U,2)
+31 SET SYS=$PIECE(RESULT,"/",1)
SET DIAS=$PIECE(RESULT,"/",2)
+32 IF SYS<140&(DIAS<90)
Begin DoDot:3
+33 ;If any BP is <140/90 we are done
+34 SET DONE=1
+35 SET BP=2_U_RESULT_U_$PIECE($GET(ARRAY(DTE)),U,3)
End DoDot:3
QUIT
+36 ;If Sys <140 save it
+37 IF SYS<140
Begin DoDot:3
+38 SET SYSARRAY(SYS)=RESULT_U_$PIECE($GET(ARRAY(DTE)),U,3)
End DoDot:3
QUIT
+39 ;If Dias <90 save it
+40 IF DIAS<90
Begin DoDot:3
+41 SET DIAARRAY(DIAS)=RESULT_U_$PIECE($GET(ARRAY(DTE)),U,3)
End DoDot:3
QUIT
End DoDot:2
+42 ;when done looping, see if there are any saved items
+43 IF $DATA(SYSARRAY)&$DATA(DIAARRAY)
Begin DoDot:2
+44 SET RES1=$ORDER(SYSARRAY(""))
+45 SET RES2=$ORDER(DIAARRAY(""))
+46 SET BP=2_U_$GET(SYSARRAY(RES1))_U_$GET(DIAARRAY(RES2))
End DoDot:2
End DoDot:1
+47 QUIT BP
