Routine: BGPMUA05

BGPMUA05 ; IHS/MSC/MGH - MI measure NQF0013 ;22-Mar-2011 10:16;DU

 ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106

 ;Code to collect meaningful use report for hypertension and BP reading

ENTRY ;EP

 N START,END,BGPNUM,BGPDEN,AENC,BENC,STRING,STRING1,STRING2,BGPHYPER,BGPHYPL

 N IEN,INV,VISIT,WTIEN,DATA,VDATE,VALUE,EXCEPT,FIRST,REF,VIEN,EXCEPT,RESULT

 N BGPN1,BGPN3,RETVAL,BGPBII,BGPUNII,BGPMAS,AENC,BENC,CENC,CNT

 N BGPENC,ENSTRING,BGPBIRTH,BGPHYS2,BGPHYS1,BGPHYS3,BGPHYS4

 S (BGPDEN,NUM,RESULT)=0

 S START=9999999-BGPBDATE,END=9999999-BGPEDATE,VALUE=0

 S RETVAL=""     ;Return value

 S (STRING,STRING2)=""

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

 ..;If the right provider, check and see if an appropriate CPT code exists

 ..S AENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU BP EM")

 ..S BENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU NURSING FAC EM")

 ..I (+AENC=1)!(+BENC=1) D

 ...S CNT=CNT+1

 ...S VDATE=$P($G(^AUPNVSIT(IEN,0)),U,1)

 ...S VIEN(CNT)=IEN_U_VDATE

 I CNT>1 D

 .;Patient Must have active DX of hypertension, EVER

 .;Check POV codes

 .S (STRING1,STRING2,ENSTRING)=""

 .S BGPBIRTH=$P(^DPT(DFN,0),U,3)

 .S BGPHYPER=$$LASTDX^BGPMUUT2(DFN,BGPBIRTH,BGPBDATE,"BGPMU HYPERTENSION DX")

 .I +BGPHYPER S VALUE=1,STRING1=$P(BGPHYPER,U,2)_" "_$$DATE^BGPMUUTL($P(BGPHYPER,U,3))

 .;Check problem list

 .N PDATE

 .S BGPHYPL=$$PLTAX^BGPMUUT1(DFN,"BGPMU HYPERTENSION DX","C")

 .I +BGPHYPL D

 ..S PDATE=$P(BGPHYPL,U,3)

 ..I PDATE<BGPBDATE S VALUE=1,STRING2=$P(BGPHYPL,U,2)_" "_$$DATE^BGPMUUTL($P(BGPHYPL,U,3))

 .;Patient has hypertension and 2 or more visits, now check for BP

 .I +VALUE D

 ..I STRING2'="" S ENSTRING=STRING2

 ..I STRING1'="" S ENSTRING=STRING1

 ..D BP(DFN,CNT,.ENSTRING,.VIEN,.BGPNUM)

 ..D TOTAL(DFN,ENSTRING,BGPNUM)

BP(DFN,CNT,ENSTRING,VIEN,NUM) ;Find is pt has a BP on the chosen visits

 N IEN,MSR,MTYP,BP,BPCNT,SAVE,ARRAY,VST,VCNT

 S BP="",BPCNT=0,VCNT=0

 S MTYP="" S MTYP=$O(^AUTTMSR("B","BP",MTYP))

 Q:MTYP="" 0

 S NUM=0 F  S NUM=$O(VIEN(NUM)) Q:NUM=""!(BPCNT>1)  D

 .S IEN=$P(VIEN(NUM),U,1),SAVE=0

 .S MSR="" F  S MSR=$O(^AUPNVMSR("AD",IEN,MSR)) Q:MSR=""!(+SAVE)  D

 ..I $P($G(^AUPNVMSR(MSR,0)),U,1)=MTYP D

 ...S BPCNT=BPCNT+1,SAVE=1

 ...S ARRAY(IEN)=""

 ...I BPCNT=1 S BP="BP:"_$P($G(^AUPNVMSR(MSR,0)),U,4)_" "_$$DATE^BGPMUUTL($P($G(^AUPNVMSR(MSR,12)),U,1))

 ...I BPCNT=2 S BP=BP_";BP:"_$P($G(^AUPNVMSR(MSR,0)),U,4)_" "_$$DATE^BGPMUUTL($P($G(^AUPNVMSR(MSR,12)),U,1))

 ...S ENSTRING=ENSTRING_";EN:"_$$DATE^BGPMUUTL($P(VIEN(NUM),U,2))

 I BPCNT=2 S NUM=1_U_"M:"_BP

 I BPCNT<2 D

 .S NUM=0_U_"NM:"_BP

 .N CNT

 .I BPCNT=1 D

 ..S CNT=1

 ..S VST=0 F  S VST=$O(VIEN(VST)) Q:VST=""!(CNT>1)  D

 ...S IEN=$P(VIEN(VST),U,1)

 ...I '$D(ARRAY(IEN)) D

 ....S CNT=CNT+1

 ....S ENSTRING=ENSTRING_";EN:"_$$DATE^BGPMUUTL($P(VIEN(VST),U,2))

 .I BPCNT=0 D

 ..S CNT=0

 ..S VST=0 F  S VST=$O(VIEN(VST)) Q:VST=""!(CNT>1)  D

 ...S IEN=$P(VIEN(VST),U,1)

 ...S CNT=CNT+1

 ...S ENSTRING=ENSTRING_";EN:"_$$DATE^BGPMUUTL($P(VIEN(VST),U,2))

TOTAL(DFN,ENSTRING,BGPNUM) ;See where this patient ends up

 N PTCNT,EXCCT,DENCT,NUMCT,TOTALS,NOTCT

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

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

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

 S NOTCT=+$G(^TMP("BGPMU0013",$J,BGPMUTF,"NOT"))

 S PTCNT=TOTALS

 S PTCNT=PTCNT+1

 S DENCT=DENCT+1 S ^TMP("BGPMU0013",$J,BGPMUTF,"DEN")=DENCT

 I +BGPNUM D

 .S NUMCT=NUMCT+1 S ^TMP("BGPMU0013",$J,BGPMUTF,"NUM")=NUMCT

 .I BGPMUTF="C" S ^TMP("BGPMU0013",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_ENSTRING_U_$P(BGPNUM,U,2)

 I '+BGPNUM D

 .S NOTCT=NOTCT+1 S ^TMP("BGPMU0013",$J,BGPMUTF,"NOT")=NOTCT

 .I BGPMUTF="C" S ^TMP("BGPMU0013",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_ENSTRING_U_$P(BGPNUM,U,2)

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

 ;Setup iCare array for patient

 S BGPICARE("MU.EP.0013.1",BGPMUTF)=1_U_+BGPNUM_U_""_U_$G(ENSTRING)_";"_$P(BGPNUM,U,2)

BGPMUA05  ; IHS/MSC/MGH - MI measure NQF0013 ;22-Mar-2011 10:16;DU

 +1       ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106

 +2       ;Code to collect meaningful use report for hypertension and BP reading

ENTRY     ;EP

 +1        NEW START,END,BGPNUM,BGPDEN,AENC,BENC,STRING,STRING1,STRING2,BGPHYPER,BGPHYPL

 +2        NEW IEN,INV,VISIT,WTIEN,DATA,VDATE,VALUE,EXCEPT,FIRST,REF,VIEN,EXCEPT,RESULT

 +3        NEW BGPN1,BGPN3,RETVAL,BGPBII,BGPUNII,BGPMAS,AENC,BENC,CENC,CNT

 +4        NEW BGPENC,ENSTRING,BGPBIRTH,BGPHYS2,BGPHYS1,BGPHYS3,BGPHYS4

 +5        SET (BGPDEN,NUM,RESULT)=0

 +6        SET START=9999999-BGPBDATE

           SET END=9999999-BGPEDATE

           SET VALUE=0

 +7       ;Return value

           SET RETVAL=""

 +8        SET (STRING,STRING2)=""

 +9       ;Pts must be >18

 +10      ;No need to check further if no age match

 +11       IF BGPAGEE<18

               QUIT

 +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      ;If the right provider, check and see if an appropriate CPT code exists

 +18                       SET AENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU BP EM")

 +19                       SET BENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU NURSING FAC EM")

 +20                       IF (+AENC=1)!(+BENC=1)

                               Begin DoDot:3

 +21                               SET CNT=CNT+1

 +22                               SET VDATE=$PIECE($GET(^AUPNVSIT(IEN,0)),U,1)

 +23                               SET VIEN(CNT)=IEN_U_VDATE

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +24       IF CNT>1

               Begin DoDot:1

 +25      ;Patient Must have active DX of hypertension, EVER

 +26      ;Check POV codes

 +27               SET (STRING1,STRING2,ENSTRING)=""

 +28               SET BGPBIRTH=$PIECE(^DPT(DFN,0),U,3)

 +29               SET BGPHYPER=$$LASTDX^BGPMUUT2(DFN,BGPBIRTH,BGPBDATE,"BGPMU HYPERTENSION DX")

 +30               IF +BGPHYPER

                       SET VALUE=1

                       SET STRING1=$PIECE(BGPHYPER,U,2)_" "_$$DATE^BGPMUUTL($PIECE(BGPHYPER,U,3))

 +31      ;Check problem list

 +32               NEW PDATE

 +33               SET BGPHYPL=$$PLTAX^BGPMUUT1(DFN,"BGPMU HYPERTENSION DX","C")

 +34               IF +BGPHYPL

                       Begin DoDot:2

 +35                       SET PDATE=$PIECE(BGPHYPL,U,3)

 +36                       IF PDATE<BGPBDATE

                               SET VALUE=1

                               SET STRING2=$PIECE(BGPHYPL,U,2)_" "_$$DATE^BGPMUUTL($PIECE(BGPHYPL,U,3))

                       End DoDot:2

 +37      ;Patient has hypertension and 2 or more visits, now check for BP

 +38               IF +VALUE

                       Begin DoDot:2

 +39                       IF STRING2'=""

                               SET ENSTRING=STRING2

 +40                       IF STRING1'=""

                               SET ENSTRING=STRING1

 +41                       DO BP(DFN,CNT,.ENSTRING,.VIEN,.BGPNUM)

 +42                       DO TOTAL(DFN,ENSTRING,BGPNUM)

                       End DoDot:2

               End DoDot:1

 +43       QUIT

BP(DFN,CNT,ENSTRING,VIEN,NUM) ;Find is pt has a BP on the chosen visits

 +1        NEW IEN,MSR,MTYP,BP,BPCNT,SAVE,ARRAY,VST,VCNT

 +2        SET BP=""

           SET BPCNT=0

           SET VCNT=0

 +3        SET MTYP=""

           SET MTYP=$ORDER(^AUTTMSR("B","BP",MTYP))

 +4        IF MTYP=""

               QUIT 0

 +5        SET NUM=0

FOR

               SET NUM=$ORDER(VIEN(NUM))

               IF NUM=""!(BPCNT>1)

                   QUIT

               Begin DoDot:1

 +6                SET IEN=$PIECE(VIEN(NUM),U,1)

                   SET SAVE=0

 +7                SET MSR=""

FOR

                       SET MSR=$ORDER(^AUPNVMSR("AD",IEN,MSR))

                       IF MSR=""!(+SAVE)

                           QUIT

                       Begin DoDot:2

 +8                        IF $PIECE($GET(^AUPNVMSR(MSR,0)),U,1)=MTYP

                               Begin DoDot:3

 +9                                SET BPCNT=BPCNT+1

                                   SET SAVE=1

 +10                               SET ARRAY(IEN)=""

 +11                               IF BPCNT=1

                                       SET BP="BP:"_$PIECE($GET(^AUPNVMSR(MSR,0)),U,4)_" "_$$DATE^BGPMUUTL($PIECE($GET(^AUPNVMSR(MSR,12)),U,1))

 +12                               IF BPCNT=2

                                       SET BP=BP_";BP:"_$PIECE($GET(^AUPNVMSR(MSR,0)),U,4)_" "_$$DATE^BGPMUUTL($PIECE($GET(^AUPNVMSR(MSR,12)),U,1))

 +13                               SET ENSTRING=ENSTRING_";EN:"_$$DATE^BGPMUUTL($PIECE(VIEN(NUM),U,2))

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +14       IF BPCNT=2

               SET NUM=1_U_"M:"_BP

 +15       IF BPCNT<2

               Begin DoDot:1

 +16               SET NUM=0_U_"NM:"_BP

 +17               NEW CNT

 +18               IF BPCNT=1

                       Begin DoDot:2

 +19                       SET CNT=1

 +20                       SET VST=0

FOR

                               SET VST=$ORDER(VIEN(VST))

                               IF VST=""!(CNT>1)

                                   QUIT

                               Begin DoDot:3

 +21                               SET IEN=$PIECE(VIEN(VST),U,1)

 +22                               IF '$DATA(ARRAY(IEN))

                                       Begin DoDot:4

 +23                                       SET CNT=CNT+1

 +24                                       SET ENSTRING=ENSTRING_";EN:"_$$DATE^BGPMUUTL($PIECE(VIEN(VST),U,2))

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

 +25               IF BPCNT=0

                       Begin DoDot:2

 +26                       SET CNT=0

 +27                       SET VST=0

FOR

                               SET VST=$ORDER(VIEN(VST))

                               IF VST=""!(CNT>1)

                                   QUIT

                               Begin DoDot:3

 +28                               SET IEN=$PIECE(VIEN(VST),U,1)

 +29                               SET CNT=CNT+1

 +30                               SET ENSTRING=ENSTRING_";EN:"_$$DATE^BGPMUUTL($PIECE(VIEN(VST),U,2))

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +31       QUIT

TOTAL(DFN,ENSTRING,BGPNUM) ;See where this patient ends up

 +1        NEW PTCNT,EXCCT,DENCT,NUMCT,TOTALS,NOTCT

 +2        SET TOTALS=$GET(^TMP("BGPMU0013",$JOB,BGPMUTF,"TOT"))

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

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

 +5        SET NOTCT=+$GET(^TMP("BGPMU0013",$JOB,BGPMUTF,"NOT"))

 +6        SET PTCNT=TOTALS

 +7        SET PTCNT=PTCNT+1

 +8        SET DENCT=DENCT+1

           SET ^TMP("BGPMU0013",$JOB,BGPMUTF,"DEN")=DENCT

 +9        IF +BGPNUM

               Begin DoDot:1

 +10               SET NUMCT=NUMCT+1

                   SET ^TMP("BGPMU0013",$JOB,BGPMUTF,"NUM")=NUMCT

 +11               IF BGPMUTF="C"

                       SET ^TMP("BGPMU0013",$JOB,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_ENSTRING_U_$PIECE(BGPNUM,U,2)

               End DoDot:1

 +12       IF '+BGPNUM

               Begin DoDot:1

 +13               SET NOTCT=NOTCT+1

                   SET ^TMP("BGPMU0013",$JOB,BGPMUTF,"NOT")=NOTCT

 +14               IF BGPMUTF="C"

                       SET ^TMP("BGPMU0013",$JOB,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_ENSTRING_U_$PIECE(BGPNUM,U,2)

               End DoDot:1

 +15       SET ^TMP("BGPMU0013",$JOB,BGPMUTF,"TOT")=PTCNT

 +16      ;Setup iCare array for patient

 +17       SET BGPICARE("MU.EP.0013.1",BGPMUTF)=1_U_+BGPNUM_U_""_U_$GET(ENSTRING)_";"_$PIECE(BGPNUM,U,2)

 +18       QUIT

BGPMUA05.m