BGP1D724 ;IHS/CMI/LAB - CONTRA (CONT);
;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
;
;
BETACONT ;EP
NEW X,Y,BGPG,BGPD,G,N
I $G(BDATE)="" S BDATE=$$DOB^AUPNPAT(P)
S NMIBD=$G(NMIBD),NMIED=$G(NMIED)
K BGPG,BGPD
S Y="BGPG("
S X=P_"^ALL DX [BGP ASTHMA DXS;DURING "_BDATE_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
S (X,G)=0 F S X=$O(BGPG(X)) Q:X'=+X S BGPD($P(BGPG(X),U))=""
S (X,G)=0 K Y F S X=$O(BGPD(X)) Q:X'=+X S G=G+1,Y(G)=X
I G>1 Q 1_U_$$DATE^BGP1UTL(Y(1))_" "_$$DATE^BGP1UTL(Y(2))_" Contra 2 dx asthma"
S BGPG=$$LASTDX^BGP1UTL1(P,"BGP HYPOTENSION DXS",BDATE,EDATE)
I $P(BGPG,U)=1 Q 1_U_$$DATE^BGP1UTL($P(BGPG,U,3))_" Contra hypotension dx "_$P(BGPG,U,2) ;has hypotension dx
S BGPG=$$LASTDX^BGP1UTL1(P,"BGP CMS 2/3 HEART BLOCK DXS",BDATE,EDATE)
I $P(BGPG,U)=1 Q 1_U_$$DATE^BGP1UTL($P(BGPG,U,3))_" Contra 2/3 heart block dx "_$P(BGPG,U,2)
S BGPG=$$LASTDXI^BGP1UTL1(P,"427.81",BDATE,EDATE)
I $P(BGPG,U)=1 Q 1_U_$$DATE^BGP1UTL($P(BGPG,U,3))_" Contra sinus brady dx "_$P(BGPG,U,2) ;"sinus brady contra"
K BGPG,BGPD
S Y="BGPG("
S X=P_"^ALL DX [BGP COPD DXS BB CONT;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
S (X,G)=0 F S X=$O(BGPG(X)) Q:X'=+X S BGPD($P(BGPG(X),U))=""
S (X,G)=0 K Y F S X=$O(BGPD(X)) Q:X'=+X S G=G+1,Y(G)=X
I G>1 Q 1_U_$$DATE^BGP1UTL(Y(1))_" "_$$DATE^BGP1UTL(Y(2))_" Contra 2 dx COPD"
;now check for NMI of beta blocker during RP
;
S T=$O(^ATXAX("B","BGP HEDIS BETA BLOCKER MEDS",0))
S X=0,G="" F S X=$O(^AUPNPREF("AA",P,50,X)) Q:X'=+X!(G) D
.Q:'$D(^ATXAX(T,21,"B",X)) ;not a Beta Blocker
.S D=0 F S D=$O(^AUPNPREF("AA",P,50,X,D)) Q:D'=+D!(G) D
..S Y=9999999-D I Y<NMIBD Q ;documented more than 1 year before edate
..I Y>NMIED Q
..S N=0 F S N=$O(^AUPNPREF("AA",P,50,X,D,N)) Q:N'=+N!(G) D
...Q:$P($G(^AUPNPREF(N,0)),U,7)'="N"
...S G=1_U_$$DATE^BGP1UTL(Y)_" Contra NMI "_$P(^PSDRUG(X,0),U,1)
..Q
.Q
I G Q G
;now cpt 8011 in past year
S X=$$CPTI^BGP1DU(P,NMIBD,NMIED,+$$CODEN^ICPTCOD("G8011"))
I X Q "1^"_$$DATE^BGP1UTL($P(X,U,2))_" Contra CPT code G8011"
S X=$$TRANI^BGP1DU(P,NMIBD,NMIED,+$$CODEN^ICPTCOD("G8011"))
I X Q "1^"_$$DATE^BGP1UTL($P(X,U,2))_" Contra TRAN code G8011"
Q 0
BGP1D724 ;IHS/CMI/LAB - CONTRA (CONT);
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
+2 ;
+3 ;
BETACONT ;EP
+1 NEW X,Y,BGPG,BGPD,G,N
+2 IF $GET(BDATE)=""
SET BDATE=$$DOB^AUPNPAT(P)
+3 SET NMIBD=$GET(NMIBD)
SET NMIED=$GET(NMIED)
+4 KILL BGPG,BGPD
+5 SET Y="BGPG("
+6 SET X=P_"^ALL DX [BGP ASTHMA DXS;DURING "_BDATE_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+7 SET (X,G)=0
FOR
SET X=$ORDER(BGPG(X))
IF X'=+X
QUIT
SET BGPD($PIECE(BGPG(X),U))=""
+8 SET (X,G)=0
KILL Y
FOR
SET X=$ORDER(BGPD(X))
IF X'=+X
QUIT
SET G=G+1
SET Y(G)=X
+9 IF G>1
QUIT 1_U_$$DATE^BGP1UTL(Y(1))_" "_$$DATE^BGP1UTL(Y(2))_" Contra 2 dx asthma"
+10 SET BGPG=$$LASTDX^BGP1UTL1(P,"BGP HYPOTENSION DXS",BDATE,EDATE)
+11 ;has hypotension dx
IF $PIECE(BGPG,U)=1
QUIT 1_U_$$DATE^BGP1UTL($PIECE(BGPG,U,3))_" Contra hypotension dx "_$PIECE(BGPG,U,2)
+12 SET BGPG=$$LASTDX^BGP1UTL1(P,"BGP CMS 2/3 HEART BLOCK DXS",BDATE,EDATE)
+13 IF $PIECE(BGPG,U)=1
QUIT 1_U_$$DATE^BGP1UTL($PIECE(BGPG,U,3))_" Contra 2/3 heart block dx "_$PIECE(BGPG,U,2)
+14 SET BGPG=$$LASTDXI^BGP1UTL1(P,"427.81",BDATE,EDATE)
+15 ;"sinus brady contra"
IF $PIECE(BGPG,U)=1
QUIT 1_U_$$DATE^BGP1UTL($PIECE(BGPG,U,3))_" Contra sinus brady dx "_$PIECE(BGPG,U,2)
+16 KILL BGPG,BGPD
+17 SET Y="BGPG("
+18 SET X=P_"^ALL DX [BGP COPD DXS BB CONT;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+19 SET (X,G)=0
FOR
SET X=$ORDER(BGPG(X))
IF X'=+X
QUIT
SET BGPD($PIECE(BGPG(X),U))=""
+20 SET (X,G)=0
KILL Y
FOR
SET X=$ORDER(BGPD(X))
IF X'=+X
QUIT
SET G=G+1
SET Y(G)=X
+21 IF G>1
QUIT 1_U_$$DATE^BGP1UTL(Y(1))_" "_$$DATE^BGP1UTL(Y(2))_" Contra 2 dx COPD"
+22 ;now check for NMI of beta blocker during RP
+23 ;
+24 SET T=$ORDER(^ATXAX("B","BGP HEDIS BETA BLOCKER MEDS",0))
+25 SET X=0
SET G=""
FOR
SET X=$ORDER(^AUPNPREF("AA",P,50,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+26 ;not a Beta Blocker
IF '$DATA(^ATXAX(T,21,"B",X))
QUIT
+27 SET D=0
FOR
SET D=$ORDER(^AUPNPREF("AA",P,50,X,D))
IF D'=+D!(G)
QUIT
Begin DoDot:2
+28 ;documented more than 1 year before edate
SET Y=9999999-D
IF Y<NMIBD
QUIT
+29 IF Y>NMIED
QUIT
+30 SET N=0
FOR
SET N=$ORDER(^AUPNPREF("AA",P,50,X,D,N))
IF N'=+N!(G)
QUIT
Begin DoDot:3
+31 IF $PIECE($GET(^AUPNPREF(N,0)),U,7)'="N"
QUIT
+32 SET G=1_U_$$DATE^BGP1UTL(Y)_" Contra NMI "_$PIECE(^PSDRUG(X,0),U,1)
End DoDot:3
+33 QUIT
End DoDot:2
+34 QUIT
End DoDot:1
+35 IF G
QUIT G
+36 ;now cpt 8011 in past year
+37 SET X=$$CPTI^BGP1DU(P,NMIBD,NMIED,+$$CODEN^ICPTCOD("G8011"))
+38 IF X
QUIT "1^"_$$DATE^BGP1UTL($PIECE(X,U,2))_" Contra CPT code G8011"
+39 SET X=$$TRANI^BGP1DU(P,NMIBD,NMIED,+$$CODEN^ICPTCOD("G8011"))
+40 IF X
QUIT "1^"_$$DATE^BGP1UTL($PIECE(X,U,2))_" Contra TRAN code G8011"
+41 QUIT 0
