BGPMUG01 ; IHS/MSC/MMT - MI measure NQF0086 ;10-Jan-2012 10:05;MMT
;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
;Code to collect meaningful use report for POAG optic nerve exam
ENTRY ;EP
N START,END,BGPNUM,BGPDEN,BGPBIRTH,STRING,STRING2
N IEN,INV,VISIT,DATA,VDATE,VALUE,EXCEPT,FIRST,VIEN,RESULT
N CNT,NUM,EXC,POAGENC,POAGDX,POAGPL,POAG
S (BGPDEN,BGPNUM,RESULT)=0
S START=9999999-BGPBDATE,END=9999999-BGPEDATE,VALUE=0
S START=START_".2359"
S (POAG,EXC,NUM)=0
;Pts must be 18+
;No need to check further if no age match
Q:BGPAGEE<18
S BGPBIRTH=$$DOB^AUPNPAT(DFN)
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 POAGENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENC POAG COMBINED")
..I +POAGENC D
...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:CNT<2 ;Pt only counts if they had at least 2 visits with the EP
S POAGDX=$$LASTDX^BGPMUUT2(DFN,BGPBIRTH,$P($P(VIEN(1),U,2),"."),"BGPMU POAG DX")
I +POAGDX S POAG=1_U_$P(POAGDX,U,3)
E D
.S POAGPL=$$PLTAX^BGPMUUT1(DFN,"BGPMU POAG DX","C",$P($P(VIEN(1),U,2),"."))
.S:+POAGPL POAG=1_U_$P(POAGPL,U,3)
I +POAG D
.;If the patient has POAG, 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)
.D TOTAL(DFN,POAG,NUM,EXC)
Q
TOTAL(DFN,POAG,NUM,EXC) ;See where this patient ends up
N PTCNT,EXCCT,DENCT,NUMCT,NOTNUM,TOTALS,DEN,DXTIME
S TOTALS=$G(^TMP("BGPMU0086",$J,BGPMUTF,"TOT"))
S DENCT=+$G(^TMP("BGPMU0086",$J,BGPMUTF,"DEN"))
S NUMCT=+$G(^TMP("BGPMU0086",$J,BGPMUTF,"NUM"))
S EXCCT=+$G(^TMP("BGPMU0086",$J,BGPMUTF,"EXC"))
S NOTNUM=+$G(^TMP("BGPMU0086",$J,BGPMUTF,"NOT"))
S PTCNT=TOTALS
S PTCNT=PTCNT+1
S (DEN,DXTIME)=""
S DENCT=DENCT+1 S ^TMP("BGPMU0086",$J,BGPMUTF,"DEN")=DENCT
I $P(POAG,U,2)'="" S DXTIME=$$DATE^BGPMUUTL($P(POAG,U,2))
S DEN="POAG:"_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("BGPMU0086",$J,BGPMUTF,"NUM")=NUMCT
.I BGPMUTF="C" S ^TMP("BGPMU0086",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DEN_U_"M:"_$P(NUM,U,2)_";"_$P(NUM,U,3)
I +EXC D
.S EXCCT=EXCCT+1 S ^TMP("BGPMU0086",$J,BGPMUTF,"EXC")=EXCCT
.I BGPMUTF="C" S ^TMP("BGPMU0086",$J,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DEN_U_"Excluded"
I +NUM=0&(EXC=0) D
.S NOTNUM=NOTNUM+1 S ^TMP("BGPMU0086",$J,BGPMUTF,"NOT")=NOTNUM
.I BGPMUTF="C" S ^TMP("BGPMU0086",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DEN_U_"NM:"
S ^TMP("BGPMU0086",$J,BGPMUTF,"TOT")=PTCNT
;Setup iCare array for patient
S BGPICARE("MU.EP.0086.1",BGPMUTF)=1_U_+NUM_U_+EXC_U_DEN_";"_$P(NUM,U,2)_";"_$P(NUM,U,3)
Q
NUM(DFN,BGPBDATE,BGPEDATE) ;Look for evidence of a optic nerve evaluation done by the EP
N FOUND,VCNT,EXMPRC,CLINPTR,CLINCODE
S FOUND=0
;Check to make sure procedure done during a CLINIC 17 or 18 visit with the EP
S VCNT=""
F S VCNT=$O(VIEN(VCNT)) Q:(VCNT="")!(+FOUND) D
.S EXMPRC=$$VSTCPT^BGPMUUT1(DFN,$P(VIEN(VCNT),U),"BGPMU POAG NERVE EVAL CPT")
.I +EXMPRC D
..S CLINPTR=$P($G(^AUPNVCPT($P(EXMPRC,U,4),12)),U,3)
..Q:CLINPTR=""
..S CLINCODE=$P(^DIC(40.7,CLINPTR,0),U,2)
..I (CLINCODE=17)!(CLINCODE=18) S FOUND=EXMPRC
.Q:+FOUND
.S EXMPRC=$$VSTICD0^BGPMUUT3(DFN,$P(VIEN(VCNT),U),"BGPMU POAG NERVE EVAL ICD0")
.I +EXMPRC D
..S CLINPTR=$P($G(^AUPNVPRC($P(EXMPRC,U,4),12)),U,3)
..Q:CLINPTR=""
..S CLINCODE=$P(^DIC(40.7,CLINPTR,0),U,2)
..I (CLINCODE=17)!(CLINCODE=18) S FOUND=EXMPRC
Q FOUND
EXCEPT(DFN,BGPBDATE,BGPEDATE) ;See if this patient has exceptions
N EFOUND,NMI
S EFOUND=0
S NMI=$$REFTAX^BGPMUUT2(DFN,81,"BGPMU POAG NERVE EVAL CPT",BGPBIRTH,BGPEDATE)
Q:+NMI&($P(NMI,U,3)="N") 1_U_$P(NMI,U,4)_U_$P(NMI,U,2)
S NMI=$$REFTAX^BGPMUUT2(DFN,80.1,"BGPMU POAG NERVE EVAL ICD0",BGPBIRTH,BGPEDATE)
Q:+NMI&($P(NMI,U,3)="N") 1_U_$P(NMI,U,4)_U_$P(NMI,U,2)
Q EFOUND
BGPMUG01 ; IHS/MSC/MMT - MI measure NQF0086 ;10-Jan-2012 10:05;MMT
+1 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
+2 ;Code to collect meaningful use report for POAG optic nerve exam
ENTRY ;EP
+1 NEW START,END,BGPNUM,BGPDEN,BGPBIRTH,STRING,STRING2
+2 NEW IEN,INV,VISIT,DATA,VDATE,VALUE,EXCEPT,FIRST,VIEN,RESULT
+3 NEW CNT,NUM,EXC,POAGENC,POAGDX,POAGPL,POAG
+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 (POAG,EXC,NUM)=0
+8 ;Pts must be 18+
+9 ;No need to check further if no age match
+10 IF BGPAGEE<18
QUIT
+11 SET BGPBIRTH=$$DOB^AUPNPAT(DFN)
+12 SET CNT=0
+13 SET FIRST=END-0.1
FOR
SET FIRST=$ORDER(^AUPNVSIT("AA",DFN,FIRST))
IF FIRST=""!($PIECE(FIRST,".",1)>START)
QUIT
Begin DoDot:1
+14 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVSIT("AA",DFN,FIRST,IEN))
IF '+IEN
QUIT
Begin DoDot:2
+15 ;Check provider, Only visits for chosen provider
+16 IF '$$PRV^BGPMUUT1(IEN,BGPPROV)
QUIT
+17 SET POAGENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENC POAG COMBINED")
+18 IF +POAGENC
Begin DoDot:3
+19 SET CNT=CNT+1
+20 SET VDATE=$PIECE($GET(^AUPNVSIT(IEN,0)),U,1)
+21 SET VIEN(CNT)=IEN_U_VDATE
+22 SET STRING(CNT)=$$DATE^BGPMUUTL(VDATE)
End DoDot:3
End DoDot:2
End DoDot:1
+23 ;Pt only counts if they had at least 2 visits with the EP
IF CNT<2
QUIT
+24 SET POAGDX=$$LASTDX^BGPMUUT2(DFN,BGPBIRTH,$PIECE($PIECE(VIEN(1),U,2),"."),"BGPMU POAG DX")
+25 IF +POAGDX
SET POAG=1_U_$PIECE(POAGDX,U,3)
+26 IF '$TEST
Begin DoDot:1
+27 SET POAGPL=$$PLTAX^BGPMUUT1(DFN,"BGPMU POAG DX","C",$PIECE($PIECE(VIEN(1),U,2),"."))
+28 IF +POAGPL
SET POAG=1_U_$PIECE(POAGPL,U,3)
End DoDot:1
+29 IF +POAG
Begin DoDot:1
+30 ;If the patient has POAG, check to see if they are in the numerator
+31 SET NUM=$$NUM(DFN,BGPBDATE,BGPEDATE)
+32 ;If not in the numerator,see if they are an exception
+33 IF +NUM=0
SET EXC=$$EXCEPT(DFN,BGPBDATE,BGPEDATE)
+34 DO TOTAL(DFN,POAG,NUM,EXC)
End DoDot:1
+35 QUIT
TOTAL(DFN,POAG,NUM,EXC) ;See where this patient ends up
+1 NEW PTCNT,EXCCT,DENCT,NUMCT,NOTNUM,TOTALS,DEN,DXTIME
+2 SET TOTALS=$GET(^TMP("BGPMU0086",$JOB,BGPMUTF,"TOT"))
+3 SET DENCT=+$GET(^TMP("BGPMU0086",$JOB,BGPMUTF,"DEN"))
+4 SET NUMCT=+$GET(^TMP("BGPMU0086",$JOB,BGPMUTF,"NUM"))
+5 SET EXCCT=+$GET(^TMP("BGPMU0086",$JOB,BGPMUTF,"EXC"))
+6 SET NOTNUM=+$GET(^TMP("BGPMU0086",$JOB,BGPMUTF,"NOT"))
+7 SET PTCNT=TOTALS
+8 SET PTCNT=PTCNT+1
+9 SET (DEN,DXTIME)=""
+10 SET DENCT=DENCT+1
SET ^TMP("BGPMU0086",$JOB,BGPMUTF,"DEN")=DENCT
+11 IF $PIECE(POAG,U,2)'=""
SET DXTIME=$$DATE^BGPMUUTL($PIECE(POAG,U,2))
+12 SET DEN="POAG:"_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("BGPMU0086",$JOB,BGPMUTF,"NUM")=NUMCT
+17 IF BGPMUTF="C"
SET ^TMP("BGPMU0086",$JOB,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DEN_U_"M:"_$PIECE(NUM,U,2)_";"_$PIECE(NUM,U,3)
End DoDot:1
+18 IF +EXC
Begin DoDot:1
+19 SET EXCCT=EXCCT+1
SET ^TMP("BGPMU0086",$JOB,BGPMUTF,"EXC")=EXCCT
+20 IF BGPMUTF="C"
SET ^TMP("BGPMU0086",$JOB,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DEN_U_"Excluded"
End DoDot:1
+21 IF +NUM=0&(EXC=0)
Begin DoDot:1
+22 SET NOTNUM=NOTNUM+1
SET ^TMP("BGPMU0086",$JOB,BGPMUTF,"NOT")=NOTNUM
+23 IF BGPMUTF="C"
SET ^TMP("BGPMU0086",$JOB,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DEN_U_"NM:"
End DoDot:1
+24 SET ^TMP("BGPMU0086",$JOB,BGPMUTF,"TOT")=PTCNT
+25 ;Setup iCare array for patient
+26 SET BGPICARE("MU.EP.0086.1",BGPMUTF)=1_U_+NUM_U_+EXC_U_DEN_";"_$PIECE(NUM,U,2)_";"_$PIECE(NUM,U,3)
+27 QUIT
NUM(DFN,BGPBDATE,BGPEDATE) ;Look for evidence of a optic nerve evaluation done by the EP
+1 NEW FOUND,VCNT,EXMPRC,CLINPTR,CLINCODE
+2 SET FOUND=0
+3 ;Check to make sure procedure done during a CLINIC 17 or 18 visit with the EP
+4 SET VCNT=""
+5 FOR
SET VCNT=$ORDER(VIEN(VCNT))
IF (VCNT="")!(+FOUND)
QUIT
Begin DoDot:1
+6 SET EXMPRC=$$VSTCPT^BGPMUUT1(DFN,$PIECE(VIEN(VCNT),U),"BGPMU POAG NERVE EVAL CPT")
+7 IF +EXMPRC
Begin DoDot:2
+8 SET CLINPTR=$PIECE($GET(^AUPNVCPT($PIECE(EXMPRC,U,4),12)),U,3)
+9 IF CLINPTR=""
QUIT
+10 SET CLINCODE=$PIECE(^DIC(40.7,CLINPTR,0),U,2)
+11 IF (CLINCODE=17)!(CLINCODE=18)
SET FOUND=EXMPRC
End DoDot:2
+12 IF +FOUND
QUIT
+13 SET EXMPRC=$$VSTICD0^BGPMUUT3(DFN,$PIECE(VIEN(VCNT),U),"BGPMU POAG NERVE EVAL ICD0")
+14 IF +EXMPRC
Begin DoDot:2
+15 SET CLINPTR=$PIECE($GET(^AUPNVPRC($PIECE(EXMPRC,U,4),12)),U,3)
+16 IF CLINPTR=""
QUIT
+17 SET CLINCODE=$PIECE(^DIC(40.7,CLINPTR,0),U,2)
+18 IF (CLINCODE=17)!(CLINCODE=18)
SET FOUND=EXMPRC
End DoDot:2
End DoDot:1
+19 QUIT FOUND
EXCEPT(DFN,BGPBDATE,BGPEDATE) ;See if this patient has exceptions
+1 NEW EFOUND,NMI
+2 SET EFOUND=0
+3 SET NMI=$$REFTAX^BGPMUUT2(DFN,81,"BGPMU POAG NERVE EVAL CPT",BGPBIRTH,BGPEDATE)
+4 IF +NMI&($PIECE(NMI,U,3)="N")
QUIT 1_U_$PIECE(NMI,U,4)_U_$PIECE(NMI,U,2)
+5 SET NMI=$$REFTAX^BGPMUUT2(DFN,80.1,"BGPMU POAG NERVE EVAL ICD0",BGPBIRTH,BGPEDATE)
+6 IF +NMI&($PIECE(NMI,U,3)="N")
QUIT 1_U_$PIECE(NMI,U,4)_U_$PIECE(NMI,U,2)
+7 QUIT EFOUND
