BGP8D724 ; IHS/CMI/LAB - CONTRA (CONT) ;
;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
;
;
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^BGP8UTL(Y(1))_" "_$$DATE^BGP8UTL(Y(2))_" Contra 2 POV asthma"
S BGPG=$$LASTDX^BGP8UTL1(P,"BGP HYPOTENSION DXS",BDATE,EDATE)
I $P(BGPG,U)=1 Q 1_U_$$DATE^BGP8UTL($P(BGPG,U,3))_" Contra hypotension POV "_$P(BGPG,U,2) ;has hypotension dx
S X=$$PLTAXND^BGP8DU(P,"BGP HYPOTENSION DXS",EDATE) I X Q 1_U_$$DATE^BGP8UTL($P(X,U,3))_U_"Contra "_$P(X,U,2) ;V17
S X=$$IPLSNOND^BGP8DU(P,"PXRM BGP HYPOTENSION",EDATE) I X Q 1_U_$$DATE^BGP8UTL($P(X,U,3))_"Contra "_U_$P(X,U,2) ;V17
S BGPG=$$LASTDX^BGP8UTL1(P,"BGP CMS 2/3 HEART BLOCK DXS",BDATE,EDATE)
I $P(BGPG,U)=1 Q 1_U_$$DATE^BGP8UTL($P(BGPG,U,3))_" Contra 2/3 heart block POV "_$P(BGPG,U,2)
S X=$$PLTAXND^BGP8DU(P,"BGP CMS 2/3 HEART BLOCK DXS",EDATE) I X Q 1_U_$$DATE^BGP8UTL($P(X,U,3))_U_"Contra "_$P(X,U,2) ;V17
S X=$$IPLSNOND^BGP8DU(P,"PXRM BGP OVER 1 DEG HEART BLK",EDATE) I X Q 1_U_$$DATE^BGP8UTL($P(X,U,3))_U_"Contra "_$P(X,U,2) ;V17
S BGPG=$$LASTDX^BGP8UTL1(P,"BGP SINUS BRADYCARDIA DXS",BDATE,EDATE)
I $P(BGPG,U)=1 Q 1_U_$$DATE^BGP8UTL($P(BGPG,U,3))_" Contra sinus brady POV "_$P(BGPG,U,2) ;"sinus brady Contra"
S X=$$PLTAXND^BGP8DU(P,"BGP SINUS BRADYCARDIA DXS",EDATE) I X Q 1_U_$$DATE^BGP8UTL($P(X,U,3))_U_"Contra "_$P(X,U,2) ;V17
S X=$$IPLSNOND^BGP8DU(P,"PXRM BGP SINUS BRADYCARDIA",EDATE) I X Q 1_U_$$DATE^BGP8UTL($P(X,U,3))_U_"Contra "_$P(X,U,2) ;V17
K BGPG,BGPD
S Y="BGPG("
S X=P_"^ALL DX [BGP COPD DXS;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^BGP8UTL(Y(1))_" "_$$DATE^BGP8UTL(Y(2))_" Contra 2 POV 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^BGP8UTL(Y)_" Contra NMI "_$P(^PSDRUG(X,0),U,1)
..Q
.Q
I G Q G
;now cpt 8011 OR G9190 in past year
S X=$$CPTI^BGP8DU(P,NMIBD,NMIED,+$$CODEN^ICPTCOD("G8011"))
I X Q "1^"_$$DATE^BGP8UTL($P(X,U,2))_" Contra CPT G8011"
S X=$$TRANI^BGP8DU(P,NMIBD,NMIED,+$$CODEN^ICPTCOD("G8011"))
I X Q "1^"_$$DATE^BGP8UTL($P(X,U,2))_" Contra TRAN G8011"
S X=$$CPTI^BGP8DU(P,NMIBD,NMIED,+$$CODEN^ICPTCOD("G9190"))
I X Q "1^"_$$DATE^BGP8UTL($P(X,U,2))_" Contra CPT G9190"
S X=$$TRANI^BGP8DU(P,NMIBD,NMIED,+$$CODEN^ICPTCOD("G9190"))
I X Q "1^"_$$DATE^BGP8UTL($P(X,U,2))_" Contra TRAN G9190"
Q 0
BGP8D724 ; IHS/CMI/LAB - CONTRA (CONT) ;
+1 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
+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^BGP8UTL(Y(1))_" "_$$DATE^BGP8UTL(Y(2))_" Contra 2 POV asthma"
+10 SET BGPG=$$LASTDX^BGP8UTL1(P,"BGP HYPOTENSION DXS",BDATE,EDATE)
+11 ;has hypotension dx
IF $PIECE(BGPG,U)=1
QUIT 1_U_$$DATE^BGP8UTL($PIECE(BGPG,U,3))_" Contra hypotension POV "_$PIECE(BGPG,U,2)
+12 ;V17
SET X=$$PLTAXND^BGP8DU(P,"BGP HYPOTENSION DXS",EDATE)
IF X
QUIT 1_U_$$DATE^BGP8UTL($PIECE(X,U,3))_U_"Contra "_$PIECE(X,U,2)
+13 ;V17
SET X=$$IPLSNOND^BGP8DU(P,"PXRM BGP HYPOTENSION",EDATE)
IF X
QUIT 1_U_$$DATE^BGP8UTL($PIECE(X,U,3))_"Contra "_U_$PIECE(X,U,2)
+14 SET BGPG=$$LASTDX^BGP8UTL1(P,"BGP CMS 2/3 HEART BLOCK DXS",BDATE,EDATE)
+15 IF $PIECE(BGPG,U)=1
QUIT 1_U_$$DATE^BGP8UTL($PIECE(BGPG,U,3))_" Contra 2/3 heart block POV "_$PIECE(BGPG,U,2)
+16 ;V17
SET X=$$PLTAXND^BGP8DU(P,"BGP CMS 2/3 HEART BLOCK DXS",EDATE)
IF X
QUIT 1_U_$$DATE^BGP8UTL($PIECE(X,U,3))_U_"Contra "_$PIECE(X,U,2)
+17 ;V17
SET X=$$IPLSNOND^BGP8DU(P,"PXRM BGP OVER 1 DEG HEART BLK",EDATE)
IF X
QUIT 1_U_$$DATE^BGP8UTL($PIECE(X,U,3))_U_"Contra "_$PIECE(X,U,2)
+18 SET BGPG=$$LASTDX^BGP8UTL1(P,"BGP SINUS BRADYCARDIA DXS",BDATE,EDATE)
+19 ;"sinus brady Contra"
IF $PIECE(BGPG,U)=1
QUIT 1_U_$$DATE^BGP8UTL($PIECE(BGPG,U,3))_" Contra sinus brady POV "_$PIECE(BGPG,U,2)
+20 ;V17
SET X=$$PLTAXND^BGP8DU(P,"BGP SINUS BRADYCARDIA DXS",EDATE)
IF X
QUIT 1_U_$$DATE^BGP8UTL($PIECE(X,U,3))_U_"Contra "_$PIECE(X,U,2)
+21 ;V17
SET X=$$IPLSNOND^BGP8DU(P,"PXRM BGP SINUS BRADYCARDIA",EDATE)
IF X
QUIT 1_U_$$DATE^BGP8UTL($PIECE(X,U,3))_U_"Contra "_$PIECE(X,U,2)
+22 KILL BGPG,BGPD
+23 SET Y="BGPG("
+24 SET X=P_"^ALL DX [BGP COPD DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+25 SET (X,G)=0
FOR
SET X=$ORDER(BGPG(X))
IF X'=+X
QUIT
SET BGPD($PIECE(BGPG(X),U))=""
+26 SET (X,G)=0
KILL Y
FOR
SET X=$ORDER(BGPD(X))
IF X'=+X
QUIT
SET G=G+1
SET Y(G)=X
+27 IF G>1
QUIT 1_U_$$DATE^BGP8UTL(Y(1))_" "_$$DATE^BGP8UTL(Y(2))_" Contra 2 POV COPD"
+28 ;now check for NMI of beta blocker during RP
+29 ;
+30 SET T=$ORDER(^ATXAX("B","BGP HEDIS BETA BLOCKER MEDS",0))
+31 SET X=0
SET G=""
FOR
SET X=$ORDER(^AUPNPREF("AA",P,50,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+32 ;not a Beta Blocker
IF '$DATA(^ATXAX(T,21,"B",X))
QUIT
+33 SET D=0
FOR
SET D=$ORDER(^AUPNPREF("AA",P,50,X,D))
IF D'=+D!(G)
QUIT
Begin DoDot:2
+34 ;documented more than 1 year before edate
SET Y=9999999-D
IF Y<NMIBD
QUIT
+35 IF Y>NMIED
QUIT
+36 SET N=0
FOR
SET N=$ORDER(^AUPNPREF("AA",P,50,X,D,N))
IF N'=+N!(G)
QUIT
Begin DoDot:3
+37 IF $PIECE($GET(^AUPNPREF(N,0)),U,7)'="N"
QUIT
+38 SET G=1_U_$$DATE^BGP8UTL(Y)_" Contra NMI "_$PIECE(^PSDRUG(X,0),U,1)
End DoDot:3
+39 QUIT
End DoDot:2
+40 QUIT
End DoDot:1
+41 IF G
QUIT G
+42 ;now cpt 8011 OR G9190 in past year
+43 SET X=$$CPTI^BGP8DU(P,NMIBD,NMIED,+$$CODEN^ICPTCOD("G8011"))
+44 IF X
QUIT "1^"_$$DATE^BGP8UTL($PIECE(X,U,2))_" Contra CPT G8011"
+45 SET X=$$TRANI^BGP8DU(P,NMIBD,NMIED,+$$CODEN^ICPTCOD("G8011"))
+46 IF X
QUIT "1^"_$$DATE^BGP8UTL($PIECE(X,U,2))_" Contra TRAN G8011"
+47 SET X=$$CPTI^BGP8DU(P,NMIBD,NMIED,+$$CODEN^ICPTCOD("G9190"))
+48 IF X
QUIT "1^"_$$DATE^BGP8UTL($PIECE(X,U,2))_" Contra CPT G9190"
+49 SET X=$$TRANI^BGP8DU(P,NMIBD,NMIED,+$$CODEN^ICPTCOD("G9190"))
+50 IF X
QUIT "1^"_$$DATE^BGP8UTL($PIECE(X,U,2))_" Contra TRAN G9190"
+51 QUIT 0
