BGPMUD03 ; IHS/MSC/SAT - MU measure NQF0081 ;03-Aug-2011 16:14;DU
;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
;code to collect meaningful use report Heart Failure w/ ACE Inhibitor or ARB
;NQF0081
;Print Output: HF^BGPMUP2
;Delimited Output: HF^BGPMUDD2
ENTRY ;EP
; expects:
; DFN = patient code from VA PATIENT file
; BGPBDATE = begin date of report
; BGPEDATE = end date of report
; BGPPROV = provider code from NEW PERSON file
; BGPMUTF = timeframe variable - "C"=current year; "P"=previous year; "B"=baseline year
N BGP4,BGPSEX,EXCEPT,PREG,RET
N BGPBIRTH,BGPDEN,BGPNUM,BGPDT,BGPAGEE,END,FIRST,IEN,START,VIEN
N BGPEXC,BGPNOT
; BGPLED = latest encounter date
; BGPEMF = EM code(s) found
; BGPC = display value of encounters
N BGPLED,BGPEMF,BGPC
; BGP*C = <COUNT> U CODE : DATE ; ...
N BGPIC,BGPNC,BGPOC
S BGPDEN=0
S BGPEXC=0
S BGPNUM=0
S BGPNOT=0
S BGPSEX=$$SEX^AUPNPAT(DFN)
;
;Pts must be 18 and older
S BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)
;No need to check further on children
Q:BGPAGEE<18
; check for encounters with the provider
S (BGPEMF,BGPIC,BGPNC,BGPOC)=0
S BGPLED=9999999
S BGPC=""
S START=9999999-BGPBDATE,END=9999999-BGPEDATE
S FIRST=END-0.1 F S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START) D Q:BGPC'=""
.S VIEN=0 F S VIEN=$O(^AUPNVSIT("AA",DFN,FIRST,VIEN)) Q:'+VIEN D Q:BGPC'=""
..S BGPDT=$P($P($G(^AUPNVSIT(VIEN,0)),U,1),".",1)
..;Check provider, determine if there are visits with E&M codes
..I $$PRV^BGPMUUT1(VIEN,BGPPROV) D
...S X=+$$VSTCPT^BGPMUUT1(DFN,VIEN,"BGPMU ENC INPATIENT DISCH CPT")
...I +X D
....S BGPIC=(+$P(BGPIC,U,1)+1)_U_$S(+BGPIC:$P(BGPIC,U,2)_";",1:"")_"EN:"_$$DATE^BGPMUUTL(BGPDT)
....S BGPLED=$S(BGPLED<$P(X,U,3):BGPLED,1:BGPLED)
....S:+BGPIC>0 BGPC=$P(BGPIC,U,2)
....;S BGPEND=$S(BGPEND'="":BGPEND_";",1:"")_"EN:"_$$DATE^BGPMUUTL($P(X,U,3))
...Q:BGPC'=""
...S X=+$$VSTCPT^BGPMUUT1(DFN,VIEN,"BGPMU ENC OUTPATIENT CPT")
...I +X D
....S BGPOC=(+$P(BGPOC,U,1)+1)_U_$S(+BGPOC:$P(BGPOC,U,2)_";",1:"")_"EN:"_$$DATE^BGPMUUTL(BGPDT)
....S BGPLED=$S(BGPLED<$P(X,U,3):BGPLED,1:BGPLED)
....S:+BGPOC>1 BGPC=$P(BGPOC,U,2)
....;S BGPEND=$S(BGPEND'="":BGPEND_";",1:"")_"EN:"_$$DATE^BGPMUUTL($P(X,U,3))
...Q:BGPC'=""
...S X=+$$VSTCPT^BGPMUUT1(DFN,VIEN,"BGPMU ENC NURSING FAC CPT")
...I +X D
....S BGPNC=(+$P(BGPNC,U,1)+1)_U_$S(+BGPNC:$P(BGPNC,U,2)_";",1:"")_"EN:"_$$DATE^BGPMUUTL(BGPDT)
....S BGPLED=$S(BGPLED<$P(X,U,3):BGPLED,1:BGPLED)
....S:+BGPNC>1 BGPC=$P(BGPNC,U,2)
....;S BGPEND=$S(BGPEND'="":BGPEND_";",1:"")_"EN:"_$$DATE^BGPMUUTL($P(X,U,3))
Q:BGPC=""
;
;Does patient have Heart Failure as an active diagnosis
; check POV
S BGPBIRTH=$P(^DPT(DFN,0),U,3)
I BGPBIRTH="" S BGPBIRTH=$$FMADD^XLFDT(BGPBDATE,-730) ;if no dob, use 2 years prior to report period
S BGPHF=$$LASTDX^BGPMUUT2(DFN,BGPBIRTH,BGPLED,"BGPMU HEART FAILURE DX")
; check problem list
S:'+BGPHF BGPHF=$$PLTAX^BGPMUUT1(DFN,"BGPMU HEART FAILURE DX","C") ; "C" for active (current) only
;quit if not active in problem list
Q:'+BGPHF
; check for ejection fraction result of < 40%
S BGP4=0
S BGP4=$$DEN1(DFN,BGPBIRTH,BGPLED)
Q:'+BGP4
;if we got here, patient is in the denominator
S BGPDEN=1_U_"HF:"_$$DATE^BGPMUUTL($P(BGPHF,U,3))_";"_"LVEF:"_$$DATE^BGPMUUTL($P(BGP4,U,3))_";"_BGPC
;
;check if patient is in numerator
;determine if patient has medications that are ACE Inhibitor or ARB
S BGPNUM=$$NUM(DFN,BGPBDATE,BGPEDATE)
I +BGPNUM S BGPNUM=1_U_"M:MED "_$$DATE^BGPMUUTL($P(BGPNUM,U,2))
E D
.S BGPNOT=1_U_"NM:"
.S BGPEXC=$$EXCLUDE(DFN)
;
D TOTAL(DFN)
;cleanup
K BGP4,BGPSEX,EXCEPT,PREG,RET
K BGPBIRTH,BGPDEN,BGPNUM,BGPDT,BGPAGEE,END,FIRST,IEN,START,VIEN
K BGPEXC,BGPNOT
K BGPLED,BGPEMF,BGPC
K BGPIC,BGPNC,BGPOC
Q
TOTAL(DFN) ;See where this patient ends up
N PTCNT,EXCCT,DENCT,NOT1CT,NUMCT,TOTALS
S TOTALS=$G(^TMP("BGPMU0081",$J,BGPMUTF,"TOT"))
S EXCCT=+$G(^TMP("BGPMU0081",$J,BGPMUTF,"EXC"))
S DENCT=+$G(^TMP("BGPMU0081",$J,BGPMUTF,"DEN"))
S NUMCT=+$G(^TMP("BGPMU0081",$J,BGPMUTF,"NUM"))
S NOT1CT=+$G(^TMP("BGPMU0081",$J,BGPMUTF,"NOT"))
S PTCNT=TOTALS
S PTCNT=PTCNT+1
;denominator
S DENCT=DENCT+1
S ^TMP("BGPMU0081",$J,BGPMUTF,"DEN")=DENCT
S ^TMP("BGPMU0081",$J,"PAT",BGPMUTF,"DEN",PTCNT)=DFN
;If excluded
I +BGPEXC D
.S EXCCT=EXCCT+1 S ^TMP("BGPMU0081",$J,BGPMUTF,"EXC")=EXCCT
.I BGPMUTF="C" S ^TMP("BGPMU0081",$J,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_$P(BGPDEN,U,2)
E D
.I +BGPNUM D ;numerator
..S NUMCT=NUMCT+1 S ^TMP("BGPMU0081",$J,BGPMUTF,"NUM")=NUMCT
..S ^TMP("BGPMU0081",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_$P(BGPDEN,U,2)_U_$P(BGPNUM,U,2)
.I +BGPNOT D
..S NOT1CT=NOT1CT+1 S ^TMP("BGPMU0081",$J,BGPMUTF,"NOT")=NOT1CT
..S ^TMP("BGPMU0081",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_$P(BGPDEN,U,2)_U_$P(BGPNOT,U,2)
S ^TMP("BGPMU0081",$J,BGPMUTF,"TOT")=PTCNT
Q
NUM(DFN,BGPBDATE,BGPEDATE) ;Look for ACE/ARB PRESCRIPTION
N FOUND,ACERX
S FOUND=0
S ACERX=$$FIND^BGPMUUT8(DFN,"BGPMU ACE ARBS NDCS",BGPBDATE,"",BGPEDATE)
Q:'ACERX FOUND
S FOUND=1_U_$P(ACERX,U,3)
Q FOUND
;
EXCLUDE(DFN) ;check for exclusions
S EXCEPT=0
;check for allergy or intolerance to ACE Inhibitors or ARBs (CV800 or CV805)
S BGPACE=$O(^PS(50.605,"B","CV800",""))
S BGPARB=$O(^PS(50.605,"B","CV805",""))
S BGPPA="" F S BGPPA=$O(^GMR(120.8,"B",DFN,BGPPA)) Q:BGPPA="" D
.S BGPDA=0 F S BGPDA=$O(^GMR(120.8,BGPPA,3,BGPDA)) Q:BGPDA'>0 D
..S BGPDC=$P($G(^GMR(120.8,BGPPA,3,BGPDA,0)),U,1)
..S:BGPDC=BGPACE EXCEPT=1_U_"ACE INHIBITORS"
..S:BGPDC=BGPARB EXCEPT=1_U_"ANGIOTENSIN II INHIBITOR"
Q:+EXCEPT EXCEPT
; Pregnant
S PREG=0
I BGPSEX="F" S PREG=$$LASTDX^BGPMUUT2(DFN,BGPBIRTH,BGPEDATE,"BGPMU PREGNANCY ALL ICD")
I +PREG=1 S EXCEPT=1_U_$P(PREG,U,2)_U_$P(PREG,U,3)
Q:+EXCEPT EXCEPT
S PREG=$$PLTAX^BGPMUUT1(DFN,"BGPMU PREGNANCY ALL ICD","C")
I +PREG=1 S EXCEPT=1_U_$P(PREG,U,2)_U_$P(PREG,U,3)
Q:+EXCEPT EXCEPT
; All other exclusions:
; Deficiencies of Circulating Enzymes
; Disease of Aortic and Mitral Valves
; Disease Non-Rheumatic Mitral (Valve)
; Chronic Kidney Disease with and without Hypertension
; Hypertensive Renal Disease with Renal Failure
; Atherosclerosis of Renal Artery
; Renal Failure and ESRD
; Acute Renal Failure
; Atresia and Stenosis of Aorta
S RET=0
S RET=$$LASTDX^BGPMUUT2(DFN,BGPBIRTH,BGPEDATE,"BGPMU HF0081 EXCLUSION DX")
I +RET=1 S EXCEPT=1_U_$P(RET,U,2)_U_$P(RET,U,3)
Q:+EXCEPT EXCEPT
S RET=$$PLTAX^BGPMUUT1(DFN,"BGPMU HF0081 EXCLUSION DX","C")
I +RET=1 S EXCEPT=1_U_$P(RET,U,2)_U_$P(RET,U,3)
Q:+EXCEPT EXCEPT
;Check for refusal of ACE or ARB med
S MED=$$MEDREF^BGPMUUT2(DFN,BGPBIRTH,BGPLED_".2359","BGPMU ACE ARBS NDCS")
I +MED S EXCEPT=MED
Q EXCEPT
;
DEN1(DFN,BGPBDATE,BGPLED) ; Find the latest CARDIAC EJECTION FRACTION (CEF) measurement
N CEF,FOUND,IEN,INV,MTYPE,RESULT,RDATE
S (CEF,FOUND)=0
;S CEF=+$$CPT^BGPMUUT1(DFN,BGPBDATE,BGPLED,"BGPMU LVEF UNDER 40% CPT")
;Q:CEF CEF
;S MTYP="" S MTYP=$O(^AUTTMSR("B","HT",MTYP)) ;ZSAT: for testing; delete this line, keep next line
S MTYP="" S MTYP=$O(^AUTTMSR("B","CEF",MTYP))
Q:MTYP="" 0
S INV=0 F S INV=$O(^AUPNVMSR("AA",DFN,MTYP,INV)) Q:'+INV!(+FOUND) D
.S RDATE=9999999-INV
.I RDATE>BGPBDATE&(RDATE<BGPLED) D
..S IEN=0 F S IEN=$O(^AUPNVMSR("AA",DFN,MTYP,INV,IEN)) Q:IEN=""!(+FOUND) D
...S FOUND=1
...S RESULT=$P($G(^AUPNVMSR(IEN,0)),U,4)
...;I RESULT<80 S CEF=1_U_U_RDATE ;ZSAT: testing; delete this line; keep next line
...I RESULT<40 S CEF=1_U_U_RDATE
Q CEF
;
TEST ;debug target
;S U="^"
;S DUZ=1
;S DT=3110310
;S DFN=184
;S DFN=158
;S BGPBDATE=3100101
;S BGPEDATE=3110401
;S BGPPROV=2
;S BGPMUTF="C"
;D ENTRY
Q
BGPMUD03 ; IHS/MSC/SAT - MU measure NQF0081 ;03-Aug-2011 16:14;DU
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
+2 ;code to collect meaningful use report Heart Failure w/ ACE Inhibitor or ARB
+3 ;NQF0081
+4 ;Print Output: HF^BGPMUP2
+5 ;Delimited Output: HF^BGPMUDD2
ENTRY ;EP
+1 ; expects:
+2 ; DFN = patient code from VA PATIENT file
+3 ; BGPBDATE = begin date of report
+4 ; BGPEDATE = end date of report
+5 ; BGPPROV = provider code from NEW PERSON file
+6 ; BGPMUTF = timeframe variable - "C"=current year; "P"=previous year; "B"=baseline year
+7 NEW BGP4,BGPSEX,EXCEPT,PREG,RET
+8 NEW BGPBIRTH,BGPDEN,BGPNUM,BGPDT,BGPAGEE,END,FIRST,IEN,START,VIEN
+9 NEW BGPEXC,BGPNOT
+10 ; BGPLED = latest encounter date
+11 ; BGPEMF = EM code(s) found
+12 ; BGPC = display value of encounters
+13 NEW BGPLED,BGPEMF,BGPC
+14 ; BGP*C = <COUNT> U CODE : DATE ; ...
+15 NEW BGPIC,BGPNC,BGPOC
+16 SET BGPDEN=0
+17 SET BGPEXC=0
+18 SET BGPNUM=0
+19 SET BGPNOT=0
+20 SET BGPSEX=$$SEX^AUPNPAT(DFN)
+21 ;
+22 ;Pts must be 18 and older
+23 SET BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)
+24 ;No need to check further on children
+25 IF BGPAGEE<18
QUIT
+26 ; check for encounters with the provider
+27 SET (BGPEMF,BGPIC,BGPNC,BGPOC)=0
+28 SET BGPLED=9999999
+29 SET BGPC=""
+30 SET START=9999999-BGPBDATE
SET END=9999999-BGPEDATE
+31 SET FIRST=END-0.1
FOR
SET FIRST=$ORDER(^AUPNVSIT("AA",DFN,FIRST))
IF FIRST=""!($PIECE(FIRST,".",1)>START)
QUIT
Begin DoDot:1
+32 SET VIEN=0
FOR
SET VIEN=$ORDER(^AUPNVSIT("AA",DFN,FIRST,VIEN))
IF '+VIEN
QUIT
Begin DoDot:2
+33 SET BGPDT=$PIECE($PIECE($GET(^AUPNVSIT(VIEN,0)),U,1),".",1)
+34 ;Check provider, determine if there are visits with E&M codes
+35 IF $$PRV^BGPMUUT1(VIEN,BGPPROV)
Begin DoDot:3
+36 SET X=+$$VSTCPT^BGPMUUT1(DFN,VIEN,"BGPMU ENC INPATIENT DISCH CPT")
+37 IF +X
Begin DoDot:4
+38 SET BGPIC=(+$PIECE(BGPIC,U,1)+1)_U_$SELECT(+BGPIC:$PIECE(BGPIC,U,2)_";",1:"")_"EN:"_$$DATE^BGPMUUTL(BGPDT)
+39 SET BGPLED=$SELECT(BGPLED<$PIECE(X,U,3):BGPLED,1:BGPLED)
+40 IF +BGPIC>0
SET BGPC=$PIECE(BGPIC,U,2)
+41 ;S BGPEND=$S(BGPEND'="":BGPEND_";",1:"")_"EN:"_$$DATE^BGPMUUTL($P(X,U,3))
End DoDot:4
+42 IF BGPC'=""
QUIT
+43 SET X=+$$VSTCPT^BGPMUUT1(DFN,VIEN,"BGPMU ENC OUTPATIENT CPT")
+44 IF +X
Begin DoDot:4
+45 SET BGPOC=(+$PIECE(BGPOC,U,1)+1)_U_$SELECT(+BGPOC:$PIECE(BGPOC,U,2)_";",1:"")_"EN:"_$$DATE^BGPMUUTL(BGPDT)
+46 SET BGPLED=$SELECT(BGPLED<$PIECE(X,U,3):BGPLED,1:BGPLED)
+47 IF +BGPOC>1
SET BGPC=$PIECE(BGPOC,U,2)
+48 ;S BGPEND=$S(BGPEND'="":BGPEND_";",1:"")_"EN:"_$$DATE^BGPMUUTL($P(X,U,3))
End DoDot:4
+49 IF BGPC'=""
QUIT
+50 SET X=+$$VSTCPT^BGPMUUT1(DFN,VIEN,"BGPMU ENC NURSING FAC CPT")
+51 IF +X
Begin DoDot:4
+52 SET BGPNC=(+$PIECE(BGPNC,U,1)+1)_U_$SELECT(+BGPNC:$PIECE(BGPNC,U,2)_";",1:"")_"EN:"_$$DATE^BGPMUUTL(BGPDT)
+53 SET BGPLED=$SELECT(BGPLED<$PIECE(X,U,3):BGPLED,1:BGPLED)
+54 IF +BGPNC>1
SET BGPC=$PIECE(BGPNC,U,2)
+55 ;S BGPEND=$S(BGPEND'="":BGPEND_";",1:"")_"EN:"_$$DATE^BGPMUUTL($P(X,U,3))
End DoDot:4
End DoDot:3
End DoDot:2
IF BGPC'=""
QUIT
End DoDot:1
IF BGPC'=""
QUIT
+56 IF BGPC=""
QUIT
+57 ;
+58 ;Does patient have Heart Failure as an active diagnosis
+59 ; check POV
+60 SET BGPBIRTH=$PIECE(^DPT(DFN,0),U,3)
+61 ;if no dob, use 2 years prior to report period
IF BGPBIRTH=""
SET BGPBIRTH=$$FMADD^XLFDT(BGPBDATE,-730)
+62 SET BGPHF=$$LASTDX^BGPMUUT2(DFN,BGPBIRTH,BGPLED,"BGPMU HEART FAILURE DX")
+63 ; check problem list
+64 ; "C" for active (current) only
IF '+BGPHF
SET BGPHF=$$PLTAX^BGPMUUT1(DFN,"BGPMU HEART FAILURE DX","C")
+65 ;quit if not active in problem list
+66 IF '+BGPHF
QUIT
+67 ; check for ejection fraction result of < 40%
+68 SET BGP4=0
+69 SET BGP4=$$DEN1(DFN,BGPBIRTH,BGPLED)
+70 IF '+BGP4
QUIT
+71 ;if we got here, patient is in the denominator
+72 SET BGPDEN=1_U_"HF:"_$$DATE^BGPMUUTL($PIECE(BGPHF,U,3))_";"_"LVEF:"_$$DATE^BGPMUUTL($PIECE(BGP4,U,3))_";"_BGPC
+73 ;
+74 ;check if patient is in numerator
+75 ;determine if patient has medications that are ACE Inhibitor or ARB
+76 SET BGPNUM=$$NUM(DFN,BGPBDATE,BGPEDATE)
+77 IF +BGPNUM
SET BGPNUM=1_U_"M:MED "_$$DATE^BGPMUUTL($PIECE(BGPNUM,U,2))
+78 IF '$TEST
Begin DoDot:1
+79 SET BGPNOT=1_U_"NM:"
+80 SET BGPEXC=$$EXCLUDE(DFN)
End DoDot:1
+81 ;
+82 DO TOTAL(DFN)
+83 ;cleanup
+84 KILL BGP4,BGPSEX,EXCEPT,PREG,RET
+85 KILL BGPBIRTH,BGPDEN,BGPNUM,BGPDT,BGPAGEE,END,FIRST,IEN,START,VIEN
+86 KILL BGPEXC,BGPNOT
+87 KILL BGPLED,BGPEMF,BGPC
+88 KILL BGPIC,BGPNC,BGPOC
+89 QUIT
TOTAL(DFN) ;See where this patient ends up
+1 NEW PTCNT,EXCCT,DENCT,NOT1CT,NUMCT,TOTALS
+2 SET TOTALS=$GET(^TMP("BGPMU0081",$JOB,BGPMUTF,"TOT"))
+3 SET EXCCT=+$GET(^TMP("BGPMU0081",$JOB,BGPMUTF,"EXC"))
+4 SET DENCT=+$GET(^TMP("BGPMU0081",$JOB,BGPMUTF,"DEN"))
+5 SET NUMCT=+$GET(^TMP("BGPMU0081",$JOB,BGPMUTF,"NUM"))
+6 SET NOT1CT=+$GET(^TMP("BGPMU0081",$JOB,BGPMUTF,"NOT"))
+7 SET PTCNT=TOTALS
+8 SET PTCNT=PTCNT+1
+9 ;denominator
+10 SET DENCT=DENCT+1
+11 SET ^TMP("BGPMU0081",$JOB,BGPMUTF,"DEN")=DENCT
+12 SET ^TMP("BGPMU0081",$JOB,"PAT",BGPMUTF,"DEN",PTCNT)=DFN
+13 ;If excluded
+14 IF +BGPEXC
Begin DoDot:1
+15 SET EXCCT=EXCCT+1
SET ^TMP("BGPMU0081",$JOB,BGPMUTF,"EXC")=EXCCT
+16 IF BGPMUTF="C"
SET ^TMP("BGPMU0081",$JOB,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_$PIECE(BGPDEN,U,2)
End DoDot:1
+17 IF '$TEST
Begin DoDot:1
+18 ;numerator
IF +BGPNUM
Begin DoDot:2
+19 SET NUMCT=NUMCT+1
SET ^TMP("BGPMU0081",$JOB,BGPMUTF,"NUM")=NUMCT
+20 SET ^TMP("BGPMU0081",$JOB,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_$PIECE(BGPDEN,U,2)_U_$PIECE(BGPNUM,U,2)
End DoDot:2
+21 IF +BGPNOT
Begin DoDot:2
+22 SET NOT1CT=NOT1CT+1
SET ^TMP("BGPMU0081",$JOB,BGPMUTF,"NOT")=NOT1CT
+23 SET ^TMP("BGPMU0081",$JOB,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_$PIECE(BGPDEN,U,2)_U_$PIECE(BGPNOT,U,2)
End DoDot:2
End DoDot:1
+24 SET ^TMP("BGPMU0081",$JOB,BGPMUTF,"TOT")=PTCNT
+25 QUIT
NUM(DFN,BGPBDATE,BGPEDATE) ;Look for ACE/ARB PRESCRIPTION
+1 NEW FOUND,ACERX
+2 SET FOUND=0
+3 SET ACERX=$$FIND^BGPMUUT8(DFN,"BGPMU ACE ARBS NDCS",BGPBDATE,"",BGPEDATE)
+4 IF 'ACERX
QUIT FOUND
+5 SET FOUND=1_U_$PIECE(ACERX,U,3)
+6 QUIT FOUND
+7 ;
EXCLUDE(DFN) ;check for exclusions
+1 SET EXCEPT=0
+2 ;check for allergy or intolerance to ACE Inhibitors or ARBs (CV800 or CV805)
+3 SET BGPACE=$ORDER(^PS(50.605,"B","CV800",""))
+4 SET BGPARB=$ORDER(^PS(50.605,"B","CV805",""))
+5 SET BGPPA=""
FOR
SET BGPPA=$ORDER(^GMR(120.8,"B",DFN,BGPPA))
IF BGPPA=""
QUIT
Begin DoDot:1
+6 SET BGPDA=0
FOR
SET BGPDA=$ORDER(^GMR(120.8,BGPPA,3,BGPDA))
IF BGPDA'>0
QUIT
Begin DoDot:2
+7 SET BGPDC=$PIECE($GET(^GMR(120.8,BGPPA,3,BGPDA,0)),U,1)
+8 IF BGPDC=BGPACE
SET EXCEPT=1_U_"ACE INHIBITORS"
+9 IF BGPDC=BGPARB
SET EXCEPT=1_U_"ANGIOTENSIN II INHIBITOR"
End DoDot:2
End DoDot:1
+10 IF +EXCEPT
QUIT EXCEPT
+11 ; Pregnant
+12 SET PREG=0
+13 IF BGPSEX="F"
SET PREG=$$LASTDX^BGPMUUT2(DFN,BGPBIRTH,BGPEDATE,"BGPMU PREGNANCY ALL ICD")
+14 IF +PREG=1
SET EXCEPT=1_U_$PIECE(PREG,U,2)_U_$PIECE(PREG,U,3)
+15 IF +EXCEPT
QUIT EXCEPT
+16 SET PREG=$$PLTAX^BGPMUUT1(DFN,"BGPMU PREGNANCY ALL ICD","C")
+17 IF +PREG=1
SET EXCEPT=1_U_$PIECE(PREG,U,2)_U_$PIECE(PREG,U,3)
+18 IF +EXCEPT
QUIT EXCEPT
+19 ; All other exclusions:
+20 ; Deficiencies of Circulating Enzymes
+21 ; Disease of Aortic and Mitral Valves
+22 ; Disease Non-Rheumatic Mitral (Valve)
+23 ; Chronic Kidney Disease with and without Hypertension
+24 ; Hypertensive Renal Disease with Renal Failure
+25 ; Atherosclerosis of Renal Artery
+26 ; Renal Failure and ESRD
+27 ; Acute Renal Failure
+28 ; Atresia and Stenosis of Aorta
+29 SET RET=0
+30 SET RET=$$LASTDX^BGPMUUT2(DFN,BGPBIRTH,BGPEDATE,"BGPMU HF0081 EXCLUSION DX")
+31 IF +RET=1
SET EXCEPT=1_U_$PIECE(RET,U,2)_U_$PIECE(RET,U,3)
+32 IF +EXCEPT
QUIT EXCEPT
+33 SET RET=$$PLTAX^BGPMUUT1(DFN,"BGPMU HF0081 EXCLUSION DX","C")
+34 IF +RET=1
SET EXCEPT=1_U_$PIECE(RET,U,2)_U_$PIECE(RET,U,3)
+35 IF +EXCEPT
QUIT EXCEPT
+36 ;Check for refusal of ACE or ARB med
+37 SET MED=$$MEDREF^BGPMUUT2(DFN,BGPBIRTH,BGPLED_".2359","BGPMU ACE ARBS NDCS")
+38 IF +MED
SET EXCEPT=MED
+39 QUIT EXCEPT
+40 ;
DEN1(DFN,BGPBDATE,BGPLED) ; Find the latest CARDIAC EJECTION FRACTION (CEF) measurement
+1 NEW CEF,FOUND,IEN,INV,MTYPE,RESULT,RDATE
+2 SET (CEF,FOUND)=0
+3 ;S CEF=+$$CPT^BGPMUUT1(DFN,BGPBDATE,BGPLED,"BGPMU LVEF UNDER 40% CPT")
+4 ;Q:CEF CEF
+5 ;S MTYP="" S MTYP=$O(^AUTTMSR("B","HT",MTYP)) ;ZSAT: for testing; delete this line, keep next line
+6 SET MTYP=""
SET MTYP=$ORDER(^AUTTMSR("B","CEF",MTYP))
+7 IF MTYP=""
QUIT 0
+8 SET INV=0
FOR
SET INV=$ORDER(^AUPNVMSR("AA",DFN,MTYP,INV))
IF '+INV!(+FOUND)
QUIT
Begin DoDot:1
+9 SET RDATE=9999999-INV
+10 IF RDATE>BGPBDATE&(RDATE<BGPLED)
Begin DoDot:2
+11 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVMSR("AA",DFN,MTYP,INV,IEN))
IF IEN=""!(+FOUND)
QUIT
Begin DoDot:3
+12 SET FOUND=1
+13 SET RESULT=$PIECE($GET(^AUPNVMSR(IEN,0)),U,4)
+14 ;I RESULT<80 S CEF=1_U_U_RDATE ;ZSAT: testing; delete this line; keep next line
+15 IF RESULT<40
SET CEF=1_U_U_RDATE
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT CEF
+17 ;
TEST ;debug target
+1 ;S U="^"
+2 ;S DUZ=1
+3 ;S DT=3110310
+4 ;S DFN=184
+5 ;S DFN=158
+6 ;S BGPBDATE=3100101
+7 ;S BGPEDATE=3110401
+8 ;S BGPPROV=2
+9 ;S BGPMUTF="C"
+10 ;D ENTRY
+11 QUIT
