BGP7D87 ; IHS/CMI/LAB - measure calc 01 Nov 2014 2:35 PM ;
;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
;
IHFL ;EP - heart failure/LVS
S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9)=0
I 'BGPACTUP S BGPSTOP=1 Q
I 'BGPACTCL S BGPSTOP=1 Q ;must be active clinical
;I BGPAGEB<18 S BGPSTOP=1 Q ;18 and older
S BGPHHF=$$HFADM(DFN,BGPBDATE,BGPEDATE)
I 'BGPHHF S BGPSTOP=1 Q ;no hosp stay for heart failure
S BGPAD=$P(BGPHHF,U,2)
I $$AGE^AUPNPAT(DFN,BGPAD)<18 S BGPSTOP=1 Q ;less than 18 on admission date
S BGPD1=1
S BGPDD=$P(BGPHHF,U,4)
S BGPNV=$$LSV(DFN,$$FMADD^XLFDT(BGPDD,-365),BGPDD,BGPAD)
S BGPN1=+BGPNV
S BGPVALUE=$S(BGPD1:"AC",1:"")_"|||"_"Admission: "_$$DATE^BGP7UTL($P(BGPHHF,U,2))_" LVS: "_$S(BGPN1:$P(BGPNV,U,3)_" "_$P(BGPNV,U,4)_" "_$P(BGPNV,U,5),1:"NOT DOCUMENTED")
K X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,T,BGPAD,BGPDD,BGPNV,BGPHHF
Q
HFADM(P,BDATE,EDATE) ;
;look for any H with HF discharge dx
K ^TMP($J,"A"),G
S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
I '$D(^TMP($J,"A",1)) Q 0 ;no HOSP
S T=$O(^ATXAX("B","BGP HEART FAILURE DXS",0))
S (BGPX,G,M,D,E)=0 F S BGPX=$O(^TMP($J,"A",BGPX)) Q:BGPX'=+BGPX S V=$P(^TMP($J,"A",BGPX),U,5) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$P(^AUPNVSIT(V,0),U,9)
.Q:$P(^AUPNVSIT(V,0),U,11)
.Q:$P(^AUPNVSIT(V,0),U,7)'="H"
.;Q:$P(^AUPNVSIT(V,0),U,6)'=DUZ(2)
.;Q:"CV"[$P(^AUPNVSIT(V,0),U,3)
.S H=$O(^AUPNVINP("AD",V,0)) D Q:'B
..S B=0
..I 'H Q
..Q:$P($P(^AUPNVINP(H,0),U),".")>EDATE
..Q:$$AMA^BGP7D72(H) ;ama
..Q:$$TRANS^BGP7D72(H) ;transferred
..Q:$$EXPIRED^BGP7D72(H) ;died
..S B=1
.S (D,Y)=0 F S Y=$O(^AUPNVPOV("AD",V,Y)) Q:Y'=+Y!(D) I $D(^AUPNVPOV(Y,0)) S %=$P(^AUPNVPOV(Y,0),U) I $$ICD^BGP7UTL2(%,T,9) S D=1
.I D D
..;skip the hospital admission if there is a dx of PALLITATIVE
..S (A,Y)=0 F S Y=$O(^AUPNVPOV("AD",V,Y)) Q:Y'=+Y!(A) I $D(^AUPNVPOV(Y,0)) S %=$$VALI^XBDIQ1(9000010.07,Y,.01) I $$ICD^BGP7UTL2(%,$O(^ATXAX("B","BGP PALLIATIVE CARE DXS",0)),9) S A=1
..Q:A
..;skip if there was a LVAD/heart transplant procedure adm date to discharge date
..S A=$$LASTPRC^BGP7UTL1(P,"BGP CRS LVAD/HEART TRANS PROC",$P($P(^AUPNVSIT(V,0),U),"."),$P($P(^AUPNVINP(H,0),U),"."))
..I A Q ;has procedure type
..S G=G+1,G($P($P(^AUPNVSIT(V,0),U),"."))=V ;got one visit
I 'G Q G
S D=$O(G(0)),V=G(D),H=$O(^AUPNVINP("AD",V,0))
Q 1_U_$O(G(0))_U_V_U_$S(H:$P($P(^AUPNVINP(H,0),U),"."),1:"")_U_H
;
LSV(P,BDATE,EDATE,ADMDATE) ;
NEW BGPG
S BGPG=""
S BGPG=$$CEFMEAS(P,BDATE,EDATE)
I BGPG Q BGPG
S BGPG=$$LASTPRC^BGP7UTL1(P,"BGP CMS EJECTION FRACTION PROC",BDATE,EDATE)
I BGPG Q 1_"^"_$P(BGPG,U,3)_"^"_$$DATE^BGP7UTL($P(BGPG,U,3))_"^"_"Proc "_$P(BGPG,U,2)_"^^"_9000010.08_"^"_$P(BGPG,U,5)_"^"_$P(^AUPNVPRC($P(BGPG,U,5),0),U,3)
S BGPG=$$CPT^BGP7DU(P,BDATE,EDATE,$O(^ATXAX("B","BGP CMS EJECTION FRACTION CPTS",0)),6)
I BGPG Q 1_"^"_$P(BGPG,U,2)_"^"_$$DATE^BGP7UTL($P(BGPG,U,2))_"^"_"CPT "_$P(BGPG,U,3)_"^^"_9000010.18_"^"_$P(BGPG,U,4)_"^"_$P(^AUPNVCPT($P(BGPG,U,4),0),U,3)
S BGPG=$$RCIS^BGP7UTL2(P,ADMDATE,EDATE,"CARDIOVASCULAR DISORDERS","EVALUATION AND/OR MANAGEMENT;NON-SURGICAL PROCEDURES;DIAGNOSTIC IMAGING")
I BGPG Q BGPG
S BGPG=$$LASTPRC^BGP7UTL1(P,"BGP CMS ECHOCARDIOGRAM PROCS",BDATE,EDATE)
I BGPG Q 1_"^"_$P(BGPG,U,3)_"^"_$$DATE^BGP7UTL($P(BGPG,U,3))_"^"_"Proc "_$P(BGPG,U,2)_"^^"_9000010.08_"^"_$P(BGPG,U,5)_"^"_$P(^AUPNVPRC($P(BGPG,U,5),0),U,3)
S BGPG=$$LASTPRC^BGP7UTL1(P,"BGP CMS NUCLEAR MEDICINE PROCS",BDATE,EDATE)
I BGPG Q 1_"^"_$P(BGPG,U,3)_"^"_$$DATE^BGP7UTL($P(BGPG,U,3))_"^"_"Proc "_$P(BGPG,U,2)_"^^"_9000010.08_"^"_$P(BGPG,U,5)_"^"_$P(^AUPNVPRC($P(BGPG,U,5),0),U,3)
S BGPG=$$LASTPRC^BGP7UTL1(P,"BGP CMS CARDIAC CATH/LV PROCS",BDATE,EDATE)
I BGPG Q 1_"^"_$P(BGPG,U,3)_"^"_$$DATE^BGP7UTL($P(BGPG,U,3))_"^"_"Proc "_$P(BGPG,U,2)_"^^"_9000010.08_"^"_$P(BGPG,U,5)_"^"_$P(^AUPNVPRC($P(BGPG,U,5),0),U,3)
Q BGPG
;
CEFMEAS(P,BDATE,EDATE) ;
NEW %,X,Y,BGPX,E
K BGPX
S %="",Y="BGPX("
S X=P_"^LAST MEAS CEF;DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,Y)
I $D(BGPX(1)) Q 1_"^"_$P(BGPX(1),U)_"^"_$$DATE^BGP7UTL($P(BGPX(1),U))_"^"_"Meas CEF"_"^"_$P(BGPX(1),U,2)_"^"_9000010.01_"^"_+$P(BGPX(1),U,4)_"^"_$P(BGPX(1),U,5)
Q ""
BENZO ;EP
S (BGPD1,BGPD2,BGPN1)=0
I BGPAGEB<65 S BGPSTOP=1 Q
I 'BGPACTUP S BGPSTOP=1 Q
S BGPD1=1 ;user pop
I BGPACTCL S BGPD2=1 ;active clinical
;DID PATIENT HAVE 90 DAYS OF BENZO?
S BGPBENZO=$$BENZOMED(DFN,BGPBDATE,BGPEDATE)
I $P(BGPBENZO,U,1)>90,$P(BGPBENZO,U,3)>1 S BGPN1=1
S BGPVALUE="UP"_$S(BGPD2:",AC",1:"")_"|||"
S BGPVALUE=BGPVALUE_$S(BGPN1:$P(BGPBENZO,U,2),1:"")
Q
BENZOMED(P,BDATE,EDATE) ;EP
NEW BGPMEDS1
D GETMEDS^BGP7UTL2(P,BDATE,EDATE,"BGP PQA BENZODIAZ MEDS","BGP PQA BENZODIAZ NDC",,,.BGPMEDS1)
I '$O(BGPMEDS1(0)) Q "" ;no meds
;FOR THIS GROUP DAYS SUPPLY MUST BE AT LEAST 90 DAYS TOTAL
NEW Z,A,T,S,X,D,Y,E,Z,W,CNT
S X=0,T=0,W="",CNT=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X D
.S Y=$P(BGPMEDS1(X),U,4) ;vmed ien
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S D=$P(^AUPNVMED(Y,0),U,1) ;drug ien
.;DAYS SUPPLY MUST BE >0
.S E=$P(^AUPNVMED(Y,0),U,8) ;date discontinued
.S S=$P(^AUPNVMED(Y,0),U,7) ;DAYS SUPPLY
.Q:'S
.I E,E'>$P(BGPMEDS1(X),U,1) Q ;at least one day
.S Z=$P(BGPMEDS1(X),U,1)
.S A=$$FMADD^XLFDT(Z,S)
.I E,E<A S S=$$FMDIFF^XLFDT(E,Z)
.S T=T+S
.S CNT=CNT+1
.S:W]"" W=W_"; " S W=W_$$DATE^BGP7UTL($$VD^APCLV($P(^AUPNVMED(Y,0),U,3)))_" "_$$VAL^XBDIQ1(9000010.14,Y,.01)_" ("_S_")"
Q T_U_W_U_CNT
BGP7D87 ; IHS/CMI/LAB - measure calc 01 Nov 2014 2:35 PM ;
+1 ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
+2 ;
IHFL ;EP - heart failure/LVS
+1 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9)=0
+2 IF 'BGPACTUP
SET BGPSTOP=1
QUIT
+3 ;must be active clinical
IF 'BGPACTCL
SET BGPSTOP=1
QUIT
+4 ;I BGPAGEB<18 S BGPSTOP=1 Q ;18 and older
+5 SET BGPHHF=$$HFADM(DFN,BGPBDATE,BGPEDATE)
+6 ;no hosp stay for heart failure
IF 'BGPHHF
SET BGPSTOP=1
QUIT
+7 SET BGPAD=$PIECE(BGPHHF,U,2)
+8 ;less than 18 on admission date
IF $$AGE^AUPNPAT(DFN,BGPAD)<18
SET BGPSTOP=1
QUIT
+9 SET BGPD1=1
+10 SET BGPDD=$PIECE(BGPHHF,U,4)
+11 SET BGPNV=$$LSV(DFN,$$FMADD^XLFDT(BGPDD,-365),BGPDD,BGPAD)
+12 SET BGPN1=+BGPNV
+13 SET BGPVALUE=$SELECT(BGPD1:"AC",1:"")_"|||"_"Admission: "_$$DATE^BGP7UTL($PIECE(BGPHHF,U,2))_" LVS: "_$SELECT(BGPN1:$PIECE(BGPNV,U,3)_" "_$PIECE(BGPNV,U,4)_" "_$PIECE(BGPNV,U,5),1:"NOT DOCUMENTED")
+14 KILL X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,T,BGPAD,BGPDD,BGPNV,BGPHHF
+15 QUIT
HFADM(P,BDATE,EDATE) ;
+1 ;look for any H with HF discharge dx
+2 KILL ^TMP($JOB,"A"),G
+3 SET A="^TMP($J,""A"","
SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(B,A)
+4 ;no HOSP
IF '$DATA(^TMP($JOB,"A",1))
QUIT 0
+5 SET T=$ORDER(^ATXAX("B","BGP HEART FAILURE DXS",0))
+6 SET (BGPX,G,M,D,E)=0
FOR
SET BGPX=$ORDER(^TMP($JOB,"A",BGPX))
IF BGPX'=+BGPX
QUIT
SET V=$PIECE(^TMP($JOB,"A",BGPX),U,5)
Begin DoDot:1
+7 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+8 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+9 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+10 IF $PIECE(^AUPNVSIT(V,0),U,7)'="H"
QUIT
+11 ;Q:$P(^AUPNVSIT(V,0),U,6)'=DUZ(2)
+12 ;Q:"CV"[$P(^AUPNVSIT(V,0),U,3)
+13 SET H=$ORDER(^AUPNVINP("AD",V,0))
Begin DoDot:2
+14 SET B=0
+15 IF 'H
QUIT
+16 IF $PIECE($PIECE(^AUPNVINP(H,0),U),".")>EDATE
QUIT
+17 ;ama
IF $$AMA^BGP7D72(H)
QUIT
+18 ;transferred
IF $$TRANS^BGP7D72(H)
QUIT
+19 ;died
IF $$EXPIRED^BGP7D72(H)
QUIT
+20 SET B=1
End DoDot:2
IF 'B
QUIT
+21 SET (D,Y)=0
FOR
SET Y=$ORDER(^AUPNVPOV("AD",V,Y))
IF Y'=+Y!(D)
QUIT
IF $DATA(^AUPNVPOV(Y,0))
SET %=$PIECE(^AUPNVPOV(Y,0),U)
IF $$ICD^BGP7UTL2(%,T,9)
SET D=1
+22 IF D
Begin DoDot:2
+23 ;skip the hospital admission if there is a dx of PALLITATIVE
+24 SET (A,Y)=0
FOR
SET Y=$ORDER(^AUPNVPOV("AD",V,Y))
IF Y'=+Y!(A)
QUIT
IF $DATA(^AUPNVPOV(Y,0))
SET %=$$VALI^XBDIQ1(9000010.07,Y,.01)
IF $$ICD^BGP7UTL2(%,$ORDER(^ATXAX("B","BGP PALLIATIVE CARE DXS",0)),9)
SET A=1
+25 IF A
QUIT
+26 ;skip if there was a LVAD/heart transplant procedure adm date to discharge date
+27 SET A=$$LASTPRC^BGP7UTL1(P,"BGP CRS LVAD/HEART TRANS PROC",$PIECE($PIECE(^AUPNVSIT(V,0),U),"."),$PIECE($PIECE(^AUPNVINP(H,0),U),"."))
+28 ;has procedure type
IF A
QUIT
+29 ;got one visit
SET G=G+1
SET G($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))=V
End DoDot:2
End DoDot:1
+30 IF 'G
QUIT G
+31 SET D=$ORDER(G(0))
SET V=G(D)
SET H=$ORDER(^AUPNVINP("AD",V,0))
+32 QUIT 1_U_$ORDER(G(0))_U_V_U_$SELECT(H:$PIECE($PIECE(^AUPNVINP(H,0),U),"."),1:"")_U_H
+33 ;
LSV(P,BDATE,EDATE,ADMDATE) ;
+1 NEW BGPG
+2 SET BGPG=""
+3 SET BGPG=$$CEFMEAS(P,BDATE,EDATE)
+4 IF BGPG
QUIT BGPG
+5 SET BGPG=$$LASTPRC^BGP7UTL1(P,"BGP CMS EJECTION FRACTION PROC",BDATE,EDATE)
+6 IF BGPG
QUIT 1_"^"_$PIECE(BGPG,U,3)_"^"_$$DATE^BGP7UTL($PIECE(BGPG,U,3))_"^"_"Proc "_$PIECE(BGPG,U,2)_"^^"_9000010.08_"^"_$PIECE(BGPG,U,5)_"^"_$PIECE(^AUPNVPRC($PIECE(BGPG,U,5),0),U,3)
+7 SET BGPG=$$CPT^BGP7DU(P,BDATE,EDATE,$ORDER(^ATXAX("B","BGP CMS EJECTION FRACTION CPTS",0)),6)
+8 IF BGPG
QUIT 1_"^"_$PIECE(BGPG,U,2)_"^"_$$DATE^BGP7UTL($PIECE(BGPG,U,2))_"^"_"CPT "_$PIECE(BGPG,U,3)_"^^"_9000010.18_"^"_$PIECE(BGPG,U,4)_"^"_$PIECE(^AUPNVCPT($PIECE(BGPG,U,4),0),U,3)
+9 SET BGPG=$$RCIS^BGP7UTL2(P,ADMDATE,EDATE,"CARDIOVASCULAR DISORDERS","EVALUATION AND/OR MANAGEMENT;NON-SURGICAL PROCEDURES;DIAGNOSTIC IMAGING")
+10 IF BGPG
QUIT BGPG
+11 SET BGPG=$$LASTPRC^BGP7UTL1(P,"BGP CMS ECHOCARDIOGRAM PROCS",BDATE,EDATE)
+12 IF BGPG
QUIT 1_"^"_$PIECE(BGPG,U,3)_"^"_$$DATE^BGP7UTL($PIECE(BGPG,U,3))_"^"_"Proc "_$PIECE(BGPG,U,2)_"^^"_9000010.08_"^"_$PIECE(BGPG,U,5)_"^"_$PIECE(^AUPNVPRC($PIECE(BGPG,U,5),0),U,3)
+13 SET BGPG=$$LASTPRC^BGP7UTL1(P,"BGP CMS NUCLEAR MEDICINE PROCS",BDATE,EDATE)
+14 IF BGPG
QUIT 1_"^"_$PIECE(BGPG,U,3)_"^"_$$DATE^BGP7UTL($PIECE(BGPG,U,3))_"^"_"Proc "_$PIECE(BGPG,U,2)_"^^"_9000010.08_"^"_$PIECE(BGPG,U,5)_"^"_$PIECE(^AUPNVPRC($PIECE(BGPG,U,5),0),U,3)
+15 SET BGPG=$$LASTPRC^BGP7UTL1(P,"BGP CMS CARDIAC CATH/LV PROCS",BDATE,EDATE)
+16 IF BGPG
QUIT 1_"^"_$PIECE(BGPG,U,3)_"^"_$$DATE^BGP7UTL($PIECE(BGPG,U,3))_"^"_"Proc "_$PIECE(BGPG,U,2)_"^^"_9000010.08_"^"_$PIECE(BGPG,U,5)_"^"_$PIECE(^AUPNVPRC($PIECE(BGPG,U,5),0),U,3)
+17 QUIT BGPG
+18 ;
CEFMEAS(P,BDATE,EDATE) ;
+1 NEW %,X,Y,BGPX,E
+2 KILL BGPX
+3 SET %=""
SET Y="BGPX("
+4 SET X=P_"^LAST MEAS CEF;DURING "_BDATE_"-"_EDATE
SET E=$$START1^APCLDF(X,Y)
+5 IF $DATA(BGPX(1))
QUIT 1_"^"_$PIECE(BGPX(1),U)_"^"_$$DATE^BGP7UTL($PIECE(BGPX(1),U))_"^"_"Meas CEF"_"^"_$PIECE(BGPX(1),U,2)_"^"_9000010.01_"^"_+$PIECE(BGPX(1),U,4)_"^"_$PIECE(BGPX(1),U,5)
+6 QUIT ""
BENZO ;EP
+1 SET (BGPD1,BGPD2,BGPN1)=0
+2 IF BGPAGEB<65
SET BGPSTOP=1
QUIT
+3 IF 'BGPACTUP
SET BGPSTOP=1
QUIT
+4 ;user pop
SET BGPD1=1
+5 ;active clinical
IF BGPACTCL
SET BGPD2=1
+6 ;DID PATIENT HAVE 90 DAYS OF BENZO?
+7 SET BGPBENZO=$$BENZOMED(DFN,BGPBDATE,BGPEDATE)
+8 IF $PIECE(BGPBENZO,U,1)>90
IF $PIECE(BGPBENZO,U,3)>1
SET BGPN1=1
+9 SET BGPVALUE="UP"_$SELECT(BGPD2:",AC",1:"")_"|||"
+10 SET BGPVALUE=BGPVALUE_$SELECT(BGPN1:$PIECE(BGPBENZO,U,2),1:"")
+11 QUIT
BENZOMED(P,BDATE,EDATE) ;EP
+1 NEW BGPMEDS1
+2 DO GETMEDS^BGP7UTL2(P,BDATE,EDATE,"BGP PQA BENZODIAZ MEDS","BGP PQA BENZODIAZ NDC",,,.BGPMEDS1)
+3 ;no meds
IF '$ORDER(BGPMEDS1(0))
QUIT ""
+4 ;FOR THIS GROUP DAYS SUPPLY MUST BE AT LEAST 90 DAYS TOTAL
+5 NEW Z,A,T,S,X,D,Y,E,Z,W,CNT
+6 SET X=0
SET T=0
SET W=""
SET CNT=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
Begin DoDot:1
+7 ;vmed ien
SET Y=$PIECE(BGPMEDS1(X),U,4)
+8 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+9 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+10 ;drug ien
SET D=$PIECE(^AUPNVMED(Y,0),U,1)
+11 ;DAYS SUPPLY MUST BE >0
+12 ;date discontinued
SET E=$PIECE(^AUPNVMED(Y,0),U,8)
+13 ;DAYS SUPPLY
SET S=$PIECE(^AUPNVMED(Y,0),U,7)
+14 IF 'S
QUIT
+15 ;at least one day
IF E
IF E'>$PIECE(BGPMEDS1(X),U,1)
QUIT
+16 SET Z=$PIECE(BGPMEDS1(X),U,1)
+17 SET A=$$FMADD^XLFDT(Z,S)
+18 IF E
IF E<A
SET S=$$FMDIFF^XLFDT(E,Z)
+19 SET T=T+S
+20 SET CNT=CNT+1
+21 IF W]""
SET W=W_"; "
SET W=W_$$DATE^BGP7UTL($$VD^APCLV($PIECE(^AUPNVMED(Y,0),U,3)))_" "_$$VAL^XBDIQ1(9000010.14,Y,.01)_" ("_S_")"
End DoDot:1
+22 QUIT T_U_W_U_CNT
