Routine: BGPMUG09

BGPMUG09 ; IHS/MSC/MMT - MI measure NQF0089 ;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 exam - communication w/provider

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=$$DEN(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,DIABDX)

 ;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)

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)

TOTAL(DFN,DIABDX,NUM,EXC) ;See where this patient ends up

 N PTCNT,EXCCT,DENCT,NUMCT,NOTNUM,TOTALS,DENSTR,DXTIME

 S TOTALS=$G(^TMP("BGPMU0089",$J,BGPMUTF,"TOT"))

 S DENCT=+$G(^TMP("BGPMU0089",$J,BGPMUTF,"DEN"))

 S NUMCT=+$G(^TMP("BGPMU0089",$J,BGPMUTF,"NUM"))

 S EXCCT=+$G(^TMP("BGPMU0089",$J,BGPMUTF,"EXC"))

 S NOTNUM=+$G(^TMP("BGPMU0089",$J,BGPMUTF,"NOT"))

 S PTCNT=TOTALS

 S PTCNT=PTCNT+1

 S (DENSTR,DXTIME)=""

 S DENCT=DENCT+1 S ^TMP("BGPMU0089",$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("BGPMU0089",$J,BGPMUTF,"NUM")=NUMCT

 .I BGPMUTF="C" S ^TMP("BGPMU0089",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DENSTR_U_"M:"_$P(NUM,U,2)

 I +EXC D

 .S EXCCT=EXCCT+1 S ^TMP("BGPMU0089",$J,BGPMUTF,"EXC")=EXCCT

 .I BGPMUTF="C" S ^TMP("BGPMU0089",$J,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DENSTR_U_"Excluded"

 I +NUM=0&(EXC=0) D

 .S NOTNUM=NOTNUM+1 S ^TMP("BGPMU0089",$J,BGPMUTF,"NOT")=NOTNUM

 .I BGPMUTF="C" S ^TMP("BGPMU0089",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DENSTR_U_"NM:"

 S ^TMP("BGPMU0089",$J,BGPMUTF,"TOT")=PTCNT

 ;Setup iCare array for patient

 S BGPICARE("MU.EP.0089.1",BGPMUTF)=1_U_+NUM_U_+EXC_U_DENSTR_";"_$P(NUM,U,2)_";"_$P(NUM,U,3)

DEN(DFN,BGPBDATE,BGPEDATE) ;look for diabetes diagnosis

 N CHKDT,DX,DXSTR,EXAM,EXMPRC,EXAMSTR,CLINPTR,CLINCODE

 S DXSTR=""

 ;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 DXSTR="RET:"_$$DATE^BGPMUUTL($P(DX,U,3))

 S DX=$$PLTAX^BGPMUUT1(DFN,"BGPMU DIABETIC RETINOPATHY DX","C",CHKDT)

 I +DX S DXSTR="RET:"_$$DATE^BGPMUUTL($P(DX,U,3))

 Q:DXSTR="" 0

 S (VCNT,EXAM)=""

 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 0

 S EXAMSTR="EXAM:"_$$DATE^BGPMUUTL($P(EXAM,U,3))

 Q 1_U_DXSTR_";"_EXAMSTR_U_$P(EXAM,U,3)

NUM(DFN,BGPBDATE,BGPEDATE,DIABDX) ;Look for evidence of a diabetic eye exam

 N FOUND,VCNT,EXAM,COMMCPT,EXAM14,EXAMSTR,CLINPTR,CLINCODE,DX

 S FOUND=0

 S EXAM14=$$FMADD^XLFDT($P(DIABDX,U,3),14)

 S COMMCPT=$$CPT^BGPMUUT1(DFN,BGPBDATE,EXAM14,"BGPMU MACULAR FUNDUS EXAM COMM")

 ; double check to ensure the finding code occurred after the exam date AND within 14 days

 I +COMMCPT&($P(COMMCPT,U,3)>=$P(DIABDX,U,3))&($P(COMMCPT,U,3)<=EXAM14) S FOUND=1_U_"COMM:"_$$DATE^BGPMUUTL($P(COMMCPT,U,3)) Q FOUND

 S (VCNT,EXAM)=""

 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 FOUND=1_U_"COMM:"_$$DATE^BGPMUUTL($P(VIEN(VCNT),U,2)) Q

 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 COMM",BGPBIRTH,BGPEDATE)

 Q:+NMI 1_U_$P(NMI,U,4)_U_$P(NMI,U,2)

 Q EFOUND

BGPMUG09  ; IHS/MSC/MMT - MI measure NQF0089 ;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 exam - communication w/provider

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=$$DEN(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,DIABDX)

 +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("BGPMU0089",$JOB,BGPMUTF,"TOT"))

 +3        SET DENCT=+$GET(^TMP("BGPMU0089",$JOB,BGPMUTF,"DEN"))

 +4        SET NUMCT=+$GET(^TMP("BGPMU0089",$JOB,BGPMUTF,"NUM"))

 +5        SET EXCCT=+$GET(^TMP("BGPMU0089",$JOB,BGPMUTF,"EXC"))

 +6        SET NOTNUM=+$GET(^TMP("BGPMU0089",$JOB,BGPMUTF,"NOT"))

 +7        SET PTCNT=TOTALS

 +8        SET PTCNT=PTCNT+1

 +9        SET (DENSTR,DXTIME)=""

 +10       SET DENCT=DENCT+1

           SET ^TMP("BGPMU0089",$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("BGPMU0089",$JOB,BGPMUTF,"NUM")=NUMCT

 +16               IF BGPMUTF="C"

                       SET ^TMP("BGPMU0089",$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("BGPMU0089",$JOB,BGPMUTF,"EXC")=EXCCT

 +19               IF BGPMUTF="C"

                       SET ^TMP("BGPMU0089",$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("BGPMU0089",$JOB,BGPMUTF,"NOT")=NOTNUM

 +22               IF BGPMUTF="C"

                       SET ^TMP("BGPMU0089",$JOB,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DENSTR_U_"NM:"

               End DoDot:1

 +23       SET ^TMP("BGPMU0089",$JOB,BGPMUTF,"TOT")=PTCNT

 +24      ;Setup iCare array for patient

 +25       SET BGPICARE("MU.EP.0089.1",BGPMUTF)=1_U_+NUM_U_+EXC_U_DENSTR_";"_$PIECE(NUM,U,2)_";"_$PIECE(NUM,U,3)

 +26       QUIT

DEN(DFN,BGPBDATE,BGPEDATE) ;look for diabetes diagnosis

 +1        NEW CHKDT,DX,DXSTR,EXAM,EXMPRC,EXAMSTR,CLINPTR,CLINCODE

 +2        SET DXSTR=""

 +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 DXSTR="RET:"_$$DATE^BGPMUUTL($PIECE(DX,U,3))

 +7        SET DX=$$PLTAX^BGPMUUT1(DFN,"BGPMU DIABETIC RETINOPATHY DX","C",CHKDT)

 +8        IF +DX

               SET DXSTR="RET:"_$$DATE^BGPMUUTL($PIECE(DX,U,3))

 +9        IF DXSTR=""

               QUIT 0

 +10       SET (VCNT,EXAM)=""

 +11       FOR

               SET VCNT=$ORDER(VIEN(VCNT))

               IF (VCNT="")!(+EXAM)

                   QUIT

               Begin DoDot:1

 +12      ;check the CLINIC on the VISIT for a match

 +13               SET CLINPTR=$PIECE(^AUPNVSIT($PIECE(VIEN(VCNT),U),0),U,8)

 +14               SET CLINCODE=$SELECT(CLINPTR'="":$PIECE(^DIC(40.7,CLINPTR,0),U,2),1:"")

 +15               IF CLINCODE="A2"

                       SET EXAM=1_U_U_$PIECE(VIEN(VCNT),U,2)

                       QUIT

 +16      ;now look for procedures on the visit

 +17               SET EXMPRC=$$VSTCPT^BGPMUUT1(DFN,$PIECE(VIEN(VCNT),U),"BGPMU MACULAR FUNDUS EXAM CPT")

 +18               IF +EXMPRC

                       SET EXAM=EXMPRC

                       QUIT

 +19               SET EXMPRC=$$VSTICD0^BGPMUUT3(DFN,$PIECE(VIEN(VCNT),U),"BGPMU MACULAR FUNDUS EXAM ICD0")

 +20               IF +EXMPRC

                       SET EXAM=EXMPRC

                       QUIT

               End DoDot:1

 +21       IF '+EXAM

               QUIT 0

 +22       SET EXAMSTR="EXAM:"_$$DATE^BGPMUUTL($PIECE(EXAM,U,3))

 +23       QUIT 1_U_DXSTR_";"_EXAMSTR_U_$PIECE(EXAM,U,3)

NUM(DFN,BGPBDATE,BGPEDATE,DIABDX) ;Look for evidence of a diabetic eye exam

 +1        NEW FOUND,VCNT,EXAM,COMMCPT,EXAM14,EXAMSTR,CLINPTR,CLINCODE,DX

 +2        SET FOUND=0

 +3        SET EXAM14=$$FMADD^XLFDT($PIECE(DIABDX,U,3),14)

 +4        SET COMMCPT=$$CPT^BGPMUUT1(DFN,BGPBDATE,EXAM14,"BGPMU MACULAR FUNDUS EXAM COMM")

 +5       ; double check to ensure the finding code occurred after the exam date AND within 14 days

 +6        IF +COMMCPT&($PIECE(COMMCPT,U,3)>=$PIECE(DIABDX,U,3))&($PIECE(COMMCPT,U,3)<=EXAM14)

               SET FOUND=1_U_"COMM:"_$$DATE^BGPMUUTL($PIECE(COMMCPT,U,3))

               QUIT FOUND

 +7        SET (VCNT,EXAM)=""

 +8        FOR

               SET VCNT=$ORDER(VIEN(VCNT))

               IF (VCNT="")!(+EXAM)

                   QUIT

               Begin DoDot:1

 +9       ;check the CLINIC on the VISIT for a match

 +10               SET CLINPTR=$PIECE(^AUPNVSIT($PIECE(VIEN(VCNT),U),0),U,8)

 +11               SET CLINCODE=$SELECT(CLINPTR'="":$PIECE(^DIC(40.7,CLINPTR,0),U,2),1:"")

 +12               IF CLINCODE="A2"

                       SET FOUND=1_U_"COMM:"_$$DATE^BGPMUUTL($PIECE(VIEN(VCNT),U,2))

                       QUIT

               End DoDot:1

 +13       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 COMM",BGPBIRTH,BGPEDATE)

 +4        IF +NMI

               QUIT 1_U_$PIECE(NMI,U,4)_U_$PIECE(NMI,U,2)

 +5        QUIT EFOUND

BGPMUG09.m