- BGP2D724 ;IHS/CMI/LAB - CONTRA (CONT);
- ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;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^BGP2UTL(Y(1))_" "_$$DATE^BGP2UTL(Y(2))_" Contra 2 POV asthma"
- S BGPG=$$LASTDX^BGP2UTL1(P,"BGP HYPOTENSION DXS",BDATE,EDATE)
- I $P(BGPG,U)=1 Q 1_U_$$DATE^BGP2UTL($P(BGPG,U,3))_" Contra hypotension POV "_$P(BGPG,U,2) ;has hypotension dx
- S BGPG=$$LASTDX^BGP2UTL1(P,"BGP CMS 2/3 HEART BLOCK DXS",BDATE,EDATE)
- I $P(BGPG,U)=1 Q 1_U_$$DATE^BGP2UTL($P(BGPG,U,3))_" Contra 2/3 heart block POV "_$P(BGPG,U,2)
- S BGPG=$$LASTDX^BGP2UTL1(P,"BGP SINUS BRADYCARDIA DXS",BDATE,EDATE)
- I $P(BGPG,U)=1 Q 1_U_$$DATE^BGP2UTL($P(BGPG,U,3))_" Contra sinus brady POV "_$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^BGP2UTL(Y(1))_" "_$$DATE^BGP2UTL(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^BGP2UTL(Y)_" Contra NMI "_$P(^PSDRUG(X,0),U,1)
- ..Q
- .Q
- I G Q G
- ;now cpt 8011 in past year
- S X=$$CPTI^BGP2DU(P,NMIBD,NMIED,+$$CODEN^ICPTCOD("G8011"))
- I X Q "1^"_$$DATE^BGP2UTL($P(X,U,2))_" Contra CPT G8011"
- S X=$$TRANI^BGP2DU(P,NMIBD,NMIED,+$$CODEN^ICPTCOD("G8011"))
- I X Q "1^"_$$DATE^BGP2UTL($P(X,U,2))_" Contra TRAN G8011"
- Q 0
- BGP2D724 ;IHS/CMI/LAB - CONTRA (CONT);
- +1 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;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^BGP2UTL(Y(1))_" "_$$DATE^BGP2UTL(Y(2))_" Contra 2 POV asthma"
- +10 SET BGPG=$$LASTDX^BGP2UTL1(P,"BGP HYPOTENSION DXS",BDATE,EDATE)
- +11 ;has hypotension dx
- IF $PIECE(BGPG,U)=1
- QUIT 1_U_$$DATE^BGP2UTL($PIECE(BGPG,U,3))_" Contra hypotension POV "_$PIECE(BGPG,U,2)
- +12 SET BGPG=$$LASTDX^BGP2UTL1(P,"BGP CMS 2/3 HEART BLOCK DXS",BDATE,EDATE)
- +13 IF $PIECE(BGPG,U)=1
- QUIT 1_U_$$DATE^BGP2UTL($PIECE(BGPG,U,3))_" Contra 2/3 heart block POV "_$PIECE(BGPG,U,2)
- +14 SET BGPG=$$LASTDX^BGP2UTL1(P,"BGP SINUS BRADYCARDIA DXS",BDATE,EDATE)
- +15 ;"sinus brady Contra"
- IF $PIECE(BGPG,U)=1
- QUIT 1_U_$$DATE^BGP2UTL($PIECE(BGPG,U,3))_" Contra sinus brady POV "_$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^BGP2UTL(Y(1))_" "_$$DATE^BGP2UTL(Y(2))_" Contra 2 POV 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^BGP2UTL(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^BGP2DU(P,NMIBD,NMIED,+$$CODEN^ICPTCOD("G8011"))
- +38 IF X
- QUIT "1^"_$$DATE^BGP2UTL($PIECE(X,U,2))_" Contra CPT G8011"
- +39 SET X=$$TRANI^BGP2DU(P,NMIBD,NMIED,+$$CODEN^ICPTCOD("G8011"))
- +40 IF X
- QUIT "1^"_$$DATE^BGP2UTL($PIECE(X,U,2))_" Contra TRAN G8011"
- +41 QUIT 0
