BGPMUG01.m

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