Routine: BGPMUF08

BGPMUF08 ; IHS/MSC/MGH - MI measure NQF0084 ;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 Heart Failure, Warfarin w/A-Fib

ENTRY ;EP

 N START,END,BGPNUM,BGPDEN,BGPNUM,STRING,STRING2,PTBIRTH

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

 N CNT,NUM,OUTENC,NFENC,HFDX

 S (BGPDEN,BGPNUM,RESULT)=0

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

 S START=START_".2359"

 S (HFDX,EXC,NUM)=0

 ;Pts must be >18

 ;No need to check further if no age match

 Q:BGPAGEE<18

 S CNT=0

 S PTBIRTH=$$DOB^AUPNPAT(DFN,"")

 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 BP EM")

 ..S NFENC=""

 ..S:'+OUTENC NFENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU NURSING FAC EM")

 ..I (+OUTENC)!(+NFENC) D

 ...S CNT=CNT+1

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

 ...S VIEN(CNT)=IEN_U_VDATE

 Q:CNT<2

 ;Next check to see if the patient is in the denominator

 S HFDX=$$HFAFIB(DFN,BGPBDATE,BGPEDATE,CNT)

 I +HFDX D

 .;If the patient has had heart failure w/A-Fib, 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,HFDX,NUM,EXC)

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

 N PTCNT,EXCCT,DENCT,NUMCT,NOTNUM,TOTALS,DEN

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

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

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

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

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

 S PTCNT=TOTALS

 S PTCNT=PTCNT+1

 S (DEN,DXTIME)=""

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

 S DEN="HF:"_$$DATE^BGPMUUTL($P(HFDX,U,2))

 S DEN=DEN_";AF:"_$$DATE^BGPMUUTL($P(HFDX,U,3))

 I $D(VIEN(1)) S DEN=DEN_";EN:"_$$DATE^BGPMUUTL($P(VIEN(1),U,2))

 I $D(VIEN(2)) S DEN=DEN_";EN:"_$$DATE^BGPMUUTL($P(VIEN(2),U,2))

 I +NUM D

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

 .I BGPMUTF="C" S ^TMP("BGPMU0084",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DEN_U_"M:MED "_$$DATE^BGPMUUTL($P(NUM,U,2))

 I +EXC D

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

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

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

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

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

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

 ;Setup iCare array for patient

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

HFAFIB(DFN,BGPBDATE,BGPEDATE,CNT) ;look for Heart Failure W/A-Fib diagnosis

 N FOUND,DXHF,PLHF,DXAF,PLAF,DX1,DX2

 S FOUND=0,DX1=0,DX2=0

 ;Check for the patient having a DX or Problem of Heart Failure (ever)

 S DXHF=$$LASTDX^BGPMUUT2(DFN,PTBIRTH,BGPEDATE,"BGPMU HEART FAILURE DX")

 I +DXHF S DX1=DXHF

 E  D

 .S PLHF=$$PLTAX^BGPMUUT1(DFN,"BGPMU HEART FAILURE DX","C",BGPEDATE)

 .I +PLHF S DX1=PLHF

 Q:DX1=0 0

 ;Now check for DX or Problem of Atrial Fibrillation

 S DXAF=$$LASTDX^BGPMUUT2(DFN,PTBIRTH,BGPEDATE,"BGPMU HF AFIB DX")

 I +DXAF S DX2=DXAF

 E  D

 .S PLAF=$$PLTAX^BGPMUUT1(DFN,"BGPMU HF AFIB DX","C",BGPEDATE)

 .I +PLAF S DX2=PLAF

 Q:DX2=0 0

 S FOUND=1_U_$P(DX1,U,3)_U_$P(DX2,U,3)

 Q FOUND

NUM(DFN,BGPBDATE,BGPEDATE) ;Look for Warfarin PRESCRIPTION

 N FOUND,WARFRX

 S FOUND=0

 S WARFRX=$$FIND^BGPMUUT8(DFN,"BGPMU WARFARIN NDCS",BGPBDATE,"",BGPEDATE)

 Q:'WARFRX FOUND

 S FOUND=1_U_$P(WARFRX,U,3)

 Q FOUND

EXCEPT(DFN,BGPBDATE,BGPEDATE) ;See if this patient has exceptions

 N EFOUND

 S EFOUND=0

 ;Next check for allergy

 S ALLER=$$ALLER^BGPMUA10("BL110","WARFARIN")

 I +ALLER S EFOUND=1_U_$P(ALLER,U,1) G EXCQ

 ;Check for refusals

 S TAX="BGPMU WARFARIN NDCS"

 S REF=$$REF^BGPMUA10(.VIEN,TAX,BGPEDATE)

 I +REF S EFOUND=1_U_$P(REF,U,1) G EXCQ

 S EXCDX=$$LASTDX^BGPMUUT2(DFN,PTBIRTH,BGPEDATE,"BGPMU HF ANEMIA DX")

 I +EXCDX S EFOUND=1_U_$P(EXCDX,U,3) G EXCQ

 S EXCPL=$$PLTAX^BGPMUUT1(DFN,"BGPMU HF ANEMIA DX","C",BGPEDATE)

 I +EXCPL S EFOUND=1_U_$P(EXCPL,U,3) G EXCQ

 S EXCDX=$$LASTDX^BGPMUUT2(DFN,PTBIRTH,BGPEDATE,"BGPMU HF GI BLEED DX")

 I +EXCDX S EFOUND=1_U_$P(EXCDX,U,3) G EXCQ

 S EXCPL=$$PLTAX^BGPMUUT1(DFN,"BGPMU HF GI BLEED DX","C",BGPEDATE)

 I +EXCPL S EFOUND=1_U_$P(EXCPL,U,3) G EXCQ

 S EXCDX=$$LASTDX^BGPMUUT2(DFN,PTBIRTH,BGPEDATE,"BGPMU HF IC HEMORRHAGE DX")

 I +EXCDX S EFOUND=1_U_$P(EXCDX,U,3) G EXCQ

 S EXCPL=$$PLTAX^BGPMUUT1(DFN,"BGPMU HF IC HEMORRHAGE DX","C",BGPEDATE)

 I +EXCPL S EFOUND=1_U_$P(EXCPL,U,3) G EXCQ

 S EXCDX=$$LASTDX^BGPMUUT2(DFN,PTBIRTH,BGPEDATE,"BGPMU HF LEUKEMIA DX")

 I +EXCDX S EFOUND=1_U_$P(EXCDX,U,3) G EXCQ

 S EXCPL=$$PLTAX^BGPMUUT1(DFN,"BGPMU HF LEUKEMIA DX","C",BGPEDATE)

 I +EXCPL S EFOUND=1_U_$P(EXCPL,U,3) G EXCQ

 S EXCDX=$$LASTDX^BGPMUUT2(DFN,PTBIRTH,BGPEDATE,"BGPMU HF HEMATURIA DX")

 I +EXCDX S EFOUND=1_U_$P(EXCDX,U,3) G EXCQ

 S EXCPL=$$PLTAX^BGPMUUT1(DFN,"BGPMU HF HEMATURIA DX","C",BGPEDATE)

 I +EXCPL S EFOUND=1_U_$P(EXCPL,U,3) G EXCQ

 S EXCDX=$$LASTDX^BGPMUUT2(DFN,PTBIRTH,BGPEDATE,"BGPMU HF HEMOPTYSIS DX")

 I +EXCDX S EFOUND=1_U_$P(EXCDX,U,3) G EXCQ

 S EXCPL=$$PLTAX^BGPMUUT1(DFN,"BGPMU HF HEMOPTYSIS DX","C",BGPEDATE)

 I +EXCPL S EFOUND=1_U_$P(EXCPL,U,3) G EXCQ

 S EXCDX=$$LASTDX^BGPMUUT2(DFN,PTBIRTH,BGPEDATE,"BGPMU HF HEMORRHAGE DX")

 I +EXCDX S EFOUND=1_U_$P(EXCDX,U,3) G EXCQ

 S EXCPL=$$PLTAX^BGPMUUT1(DFN,"BGPMU HF HEMORRHAGE DX","C",BGPEDATE)

 I +EXCPL S EFOUND=1_U_$P(EXCPL,U,3) G EXCQ

 S EXCDX=$$LASTDX^BGPMUUT2(DFN,PTBIRTH,BGPEDATE,"BGPMU HF LIVER DISORDER DX")

 I +EXCDX S EFOUND=1_U_$P(EXCDX,U,3) G EXCQ

 S EXCPL=$$PLTAX^BGPMUUT1(DFN,"BGPMU HF LIVER DISORDER DX","C",BGPEDATE)

 I +EXCPL S EFOUND=1_U_$P(EXCPL,U,3) G EXCQ

EXCQ Q EFOUND

BGPMUF08  ; IHS/MSC/MGH - MI measure NQF0084 ;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 Heart Failure, Warfarin w/A-Fib

ENTRY     ;EP

 +1        NEW START,END,BGPNUM,BGPDEN,BGPNUM,STRING,STRING2,PTBIRTH

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

 +3        NEW CNT,NUM,OUTENC,NFENC,HFDX

 +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 (HFDX,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 CNT=0

 +12       SET PTBIRTH=$$DOB^AUPNPAT(DFN,"")

 +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 OUTENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU BP EM")

 +18                       SET NFENC=""

 +19                       IF '+OUTENC

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

 +20                       IF (+OUTENC)!(+NFENC)

                               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<2

               QUIT

 +25      ;Next check to see if the patient is in the denominator

 +26       SET HFDX=$$HFAFIB(DFN,BGPBDATE,BGPEDATE,CNT)

 +27       IF +HFDX

               Begin DoDot:1

 +28      ;If the patient has had heart failure w/A-Fib, check to see if they are in the numerator

 +29               SET NUM=$$NUM(DFN,BGPBDATE,BGPEDATE)

 +30      ;If not in the numerator see if they are an exception

 +31               IF NUM=0

                       SET EXC=$$EXCEPT(DFN,BGPBDATE,BGPEDATE)

 +32               DO TOTAL(DFN,HFDX,NUM,EXC)

               End DoDot:1

 +33       QUIT

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

 +1        NEW PTCNT,EXCCT,DENCT,NUMCT,NOTNUM,TOTALS,DEN

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

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

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

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

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

 +7        SET PTCNT=TOTALS

 +8        SET PTCNT=PTCNT+1

 +9        SET (DEN,DXTIME)=""

 +10       SET DENCT=DENCT+1

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

 +11       SET DEN="HF:"_$$DATE^BGPMUUTL($PIECE(HFDX,U,2))

 +12       SET DEN=DEN_";AF:"_$$DATE^BGPMUUTL($PIECE(HFDX,U,3))

 +13       IF $DATA(VIEN(1))

               SET DEN=DEN_";EN:"_$$DATE^BGPMUUTL($PIECE(VIEN(1),U,2))

 +14       IF $DATA(VIEN(2))

               SET DEN=DEN_";EN:"_$$DATE^BGPMUUTL($PIECE(VIEN(2),U,2))

 +15       IF +NUM

               Begin DoDot:1

 +16               SET NUMCT=NUMCT+1

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

 +17               IF BGPMUTF="C"

                       SET ^TMP("BGPMU0084",$JOB,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DEN_U_"M:MED "_$$DATE^BGPMUUTL($PIECE(NUM,U,2))

               End DoDot:1

 +18       IF +EXC

               Begin DoDot:1

 +19               SET EXCCT=EXCCT+1

                   SET ^TMP("BGPMU0084",$JOB,BGPMUTF,"EXC")=EXCCT

 +20               IF BGPMUTF="C"

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

 +23               IF BGPMUTF="C"

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

               End DoDot:1

 +24       SET ^TMP("BGPMU0084",$JOB,BGPMUTF,"TOT")=PTCNT

 +25      ;Setup iCare array for patient

 +26       SET BGPICARE("MU.EP.0084.1",BGPMUTF)=1_U_+NUM_U_+EXC_U_DEN_";"_$PIECE(NUM,U,2)_";"_$PIECE(NUM,U,3)

 +27       QUIT

HFAFIB(DFN,BGPBDATE,BGPEDATE,CNT) ;look for Heart Failure W/A-Fib diagnosis

 +1        NEW FOUND,DXHF,PLHF,DXAF,PLAF,DX1,DX2

 +2        SET FOUND=0

           SET DX1=0

           SET DX2=0

 +3       ;Check for the patient having a DX or Problem of Heart Failure (ever)

 +4        SET DXHF=$$LASTDX^BGPMUUT2(DFN,PTBIRTH,BGPEDATE,"BGPMU HEART FAILURE DX")

 +5        IF +DXHF

               SET DX1=DXHF

 +6       IF '$TEST

               Begin DoDot:1

 +7                SET PLHF=$$PLTAX^BGPMUUT1(DFN,"BGPMU HEART FAILURE DX","C",BGPEDATE)

 +8                IF +PLHF

                       SET DX1=PLHF

               End DoDot:1

 +9        IF DX1=0

               QUIT 0

 +10      ;Now check for DX or Problem of Atrial Fibrillation

 +11       SET DXAF=$$LASTDX^BGPMUUT2(DFN,PTBIRTH,BGPEDATE,"BGPMU HF AFIB DX")

 +12       IF +DXAF

               SET DX2=DXAF

 +13      IF '$TEST

               Begin DoDot:1

 +14               SET PLAF=$$PLTAX^BGPMUUT1(DFN,"BGPMU HF AFIB DX","C",BGPEDATE)

 +15               IF +PLAF

                       SET DX2=PLAF

               End DoDot:1

 +16       IF DX2=0

               QUIT 0

 +17       SET FOUND=1_U_$PIECE(DX1,U,3)_U_$PIECE(DX2,U,3)

 +18       QUIT FOUND

NUM(DFN,BGPBDATE,BGPEDATE) ;Look for Warfarin PRESCRIPTION

 +1        NEW FOUND,WARFRX

 +2        SET FOUND=0

 +3        SET WARFRX=$$FIND^BGPMUUT8(DFN,"BGPMU WARFARIN NDCS",BGPBDATE,"",BGPEDATE)

 +4        IF 'WARFRX

               QUIT FOUND

 +5        SET FOUND=1_U_$PIECE(WARFRX,U,3)

 +6        QUIT FOUND

EXCEPT(DFN,BGPBDATE,BGPEDATE) ;See if this patient has exceptions

 +1        NEW EFOUND

 +2        SET EFOUND=0

 +3       ;Next check for allergy

 +4        SET ALLER=$$ALLER^BGPMUA10("BL110","WARFARIN")

 +5        IF +ALLER

               SET EFOUND=1_U_$PIECE(ALLER,U,1)

               GOTO EXCQ

 +6       ;Check for refusals

 +7        SET TAX="BGPMU WARFARIN NDCS"

 +8        SET REF=$$REF^BGPMUA10(.VIEN,TAX,BGPEDATE)

 +9        IF +REF

               SET EFOUND=1_U_$PIECE(REF,U,1)

               GOTO EXCQ

 +10       SET EXCDX=$$LASTDX^BGPMUUT2(DFN,PTBIRTH,BGPEDATE,"BGPMU HF ANEMIA DX")

 +11       IF +EXCDX

               SET EFOUND=1_U_$PIECE(EXCDX,U,3)

               GOTO EXCQ

 +12       SET EXCPL=$$PLTAX^BGPMUUT1(DFN,"BGPMU HF ANEMIA DX","C",BGPEDATE)

 +13       IF +EXCPL

               SET EFOUND=1_U_$PIECE(EXCPL,U,3)

               GOTO EXCQ

 +14       SET EXCDX=$$LASTDX^BGPMUUT2(DFN,PTBIRTH,BGPEDATE,"BGPMU HF GI BLEED DX")

 +15       IF +EXCDX

               SET EFOUND=1_U_$PIECE(EXCDX,U,3)

               GOTO EXCQ

 +16       SET EXCPL=$$PLTAX^BGPMUUT1(DFN,"BGPMU HF GI BLEED DX","C",BGPEDATE)

 +17       IF +EXCPL

               SET EFOUND=1_U_$PIECE(EXCPL,U,3)

               GOTO EXCQ

 +18       SET EXCDX=$$LASTDX^BGPMUUT2(DFN,PTBIRTH,BGPEDATE,"BGPMU HF IC HEMORRHAGE DX")

 +19       IF +EXCDX

               SET EFOUND=1_U_$PIECE(EXCDX,U,3)

               GOTO EXCQ

 +20       SET EXCPL=$$PLTAX^BGPMUUT1(DFN,"BGPMU HF IC HEMORRHAGE DX","C",BGPEDATE)

 +21       IF +EXCPL

               SET EFOUND=1_U_$PIECE(EXCPL,U,3)

               GOTO EXCQ

 +22       SET EXCDX=$$LASTDX^BGPMUUT2(DFN,PTBIRTH,BGPEDATE,"BGPMU HF LEUKEMIA DX")

 +23       IF +EXCDX

               SET EFOUND=1_U_$PIECE(EXCDX,U,3)

               GOTO EXCQ

 +24       SET EXCPL=$$PLTAX^BGPMUUT1(DFN,"BGPMU HF LEUKEMIA DX","C",BGPEDATE)

 +25       IF +EXCPL

               SET EFOUND=1_U_$PIECE(EXCPL,U,3)

               GOTO EXCQ

 +26       SET EXCDX=$$LASTDX^BGPMUUT2(DFN,PTBIRTH,BGPEDATE,"BGPMU HF HEMATURIA DX")

 +27       IF +EXCDX

               SET EFOUND=1_U_$PIECE(EXCDX,U,3)

               GOTO EXCQ

 +28       SET EXCPL=$$PLTAX^BGPMUUT1(DFN,"BGPMU HF HEMATURIA DX","C",BGPEDATE)

 +29       IF +EXCPL

               SET EFOUND=1_U_$PIECE(EXCPL,U,3)

               GOTO EXCQ

 +30       SET EXCDX=$$LASTDX^BGPMUUT2(DFN,PTBIRTH,BGPEDATE,"BGPMU HF HEMOPTYSIS DX")

 +31       IF +EXCDX

               SET EFOUND=1_U_$PIECE(EXCDX,U,3)

               GOTO EXCQ

 +32       SET EXCPL=$$PLTAX^BGPMUUT1(DFN,"BGPMU HF HEMOPTYSIS DX","C",BGPEDATE)

 +33       IF +EXCPL

               SET EFOUND=1_U_$PIECE(EXCPL,U,3)

               GOTO EXCQ

 +34       SET EXCDX=$$LASTDX^BGPMUUT2(DFN,PTBIRTH,BGPEDATE,"BGPMU HF HEMORRHAGE DX")

 +35       IF +EXCDX

               SET EFOUND=1_U_$PIECE(EXCDX,U,3)

               GOTO EXCQ

 +36       SET EXCPL=$$PLTAX^BGPMUUT1(DFN,"BGPMU HF HEMORRHAGE DX","C",BGPEDATE)

 +37       IF +EXCPL

               SET EFOUND=1_U_$PIECE(EXCPL,U,3)

               GOTO EXCQ

 +38       SET EXCDX=$$LASTDX^BGPMUUT2(DFN,PTBIRTH,BGPEDATE,"BGPMU HF LIVER DISORDER DX")

 +39       IF +EXCDX

               SET EFOUND=1_U_$PIECE(EXCDX,U,3)

               GOTO EXCQ

 +40       SET EXCPL=$$PLTAX^BGPMUUT1(DFN,"BGPMU HF LIVER DISORDER DX","C",BGPEDATE)

 +41       IF +EXCPL

               SET EFOUND=1_U_$PIECE(EXCPL,U,3)

               GOTO EXCQ

EXCQ       QUIT EFOUND

BGPMUF08.m