BGP2CP2 ; IHS/CMI/LAB - IHS gpra print 02 Nov 2009 10:40 AM ;
 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
 ;
 ;
AMI5W ;EP
 I $Y>(BGPIOSL-3) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
 D WDOD^BGP2CPU(DFN)
 Q:BGPQUIT
 D WDT^BGP2CPU(BGPVINP)
 Q:BGPQUIT
 I $$TRANS^BGP2CU(BGPVINP) D WTT^BGP2CPU(BGPVINP)
 Q:BGPQUIT
 I $$TRANS^BGP2CU(BGPVINP) D TRANSN Q:BGPQUIT
 D WPPDPOV^BGP2CPU(BGPVSIT)
 Q:BGPQUIT
 D OTHDPOVS^BGP2CPU(BGPVSIT)
 Q:BGPQUIT
 S X=$$COMFORT^BGP2CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
 D WCOMFORT^BGP2CPU(X)
 Q:BGPQUIT
 K Z
 S X=$$BETAALEG^BGP2CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP2CU(BGPVINP))
 I X S X=$P(X,U,2)
 D WBETAAL^BGP2CPU
 Q:BGPQUIT
 K BGPBRADY
 D ALLDXS^BGP2CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),.BGPBRADY,0,"BGP CMS BRADYCARDIA DXS")
 ;on active med for beta blocker?
 K BGPBETA
 D BETARX^BGP2CU2(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-180),$$DSCH^BGP2CU(BGPVINP),1,.BGPBETA)
 D WBRADY5^BGP2CPU2
 Q:BGPQUIT
 K BGPDATA
 K BGP23RD
 D ALLDXS^BGP2CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),.BGP23RD,0,"BGP CMS 2/3 HEART BLOCK DXS")
 S BGPPACE=$$PACE^BGP2CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP2CU(BGPVINP))
 D W23RD^BGP2CPU2
 K BGPY
 D NMIDRUG^BGP2CU1(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),.BGPDATA,"BGP CMS BETA BLOCKER MEDS",0)
 S E=+$$CODEN^ICPTCOD("G8011")
 S Z=$$CPTI^BGP2DU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),E) I Z]"" S Z=$$DATE^BGP2UTL($P(Z,U,2))_" [G8011]"
 D WNMIBETA^BGP2CPU
 Q:BGPQUIT
 S X=$$LASTMED^BGP2CU1(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($P($P(^AUPNVINP(BGPVINP,0),U),"."),30),"BGP CMS BETA BLOCKER MEDS","BGP CMS BETA BLOCKER NDC","BGP CMS BETA BLOCKER CLASS")
 S E=+$$CODEN^ICPTCOD("G8009")
 S Z=$$CPTI^BGP2DU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($P($P(^AUPNVINP(BGPVINP,0),U),"."),30),E) I Z]"" S Z=$$DATE^BGP2UTL($P(Z,U,2))_" [G8009]"
 D WLASTBB^BGP2CPU
 Q:BGPQUIT
 D ALLALG1^BGP2CU1(DFN,DT,$$DSCH^BGP2CU(BGPVINP),.BGPDATA)
 D WALLALG^BGP2CPU
 Q:BGPQUIT
 K BGPDATA
 D ALLALGA1^BGP2CU1(DFN,DT,.BGPDATA)
 D WALLALGT^BGP2CPU
 K BGPDATA
 D IVUD^BGP2CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP2CU(BGPVINP),,.BGPDATA)
 D WIVUD^BGP2CPU
 Q
 ;
AMI5 ;EP
 I $Y>(BGPIOSL-3) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
 D WDT^BGP2CPU(BGPVINP)
 Q:BGPQUIT
 I $$TRANS^BGP2CU(BGPVINP) D WTT^BGP2CPU(BGPVINP)
 Q:BGPQUIT
 I $$TRANS^BGP2CU(BGPVINP) D TRANSN Q:BGPQUIT
 D WPPDPOV^BGP2CPU(BGPVSIT)
 Q:BGPQUIT
 D OTHDPOVS^BGP2CPU(BGPVSIT)
 Q:BGPQUIT
 S X=$$COMFORT^BGP2CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
 D WCOMFORT^BGP2CPU(X)
 Q:BGPQUIT
 K BGPBRADY
 D ALLDXS^BGP2CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),.BGPBRADY,0,"BGP CMS BRADYCARDIA DXS")
 ;on active med for beta blocker?
 K BGPBETA
 D BETARX^BGP2CU2(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-180),$$DSCH^BGP2CU(BGPVINP),1,.BGPBETA)
 D WBRADY5^BGP2CPU2
 Q:BGPQUIT
 K BGPDATA
 K BGP23RD
 D ALLDXS^BGP2CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),.BGP23RD,0,"BGP CMS 2/3 HEART BLOCK DXS")
 S BGPPACE=$$PACE^BGP2CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP2CU(BGPVINP))
 D W23RD^BGP2CPU2
 K BGPY
 D NMIDRUG^BGP2CU1(DFN,$$VD^APCLV(BGPVSIT),$$DSCH^BGP2CU(BGPVINP),.BGPDATA,"BGP CMS BETA BLOCKER MEDS",0)
 S E=+$$CODEN^ICPTCOD("G8011")
 S Z=$$CPTI^BGP2DU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),E) I Z]"" S Z=$$DATE^BGP2UTL($P(Z,U,2))_" [G8011]"
 D WNMIBETA^BGP2CPU
 Q:BGPQUIT
 S X=$$LASTMED^BGP2CU1(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($P($P(^AUPNVINP(BGPVINP,0),U),"."),30),"BGP CMS BETA BLOCKER MEDS","BGP CMS BETA BLOCKER NDC","BGP CMS BETA BLOCKER CLASS")
 S E=+$$CODEN^ICPTCOD("G8009")
 S Z=$$CPTI^BGP2DU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($P($P(^AUPNVINP(BGPVINP,0),U),"."),30),E) I Z]"" S Z=$$DATE^BGP2UTL($P(Z,U,2))_" [G8009]"
 D WLASTBB^BGP2CPU
 Q:BGPQUIT
 D ALLALG1^BGP2CU1(DFN,DT,$$DSCH^BGP2CU(BGPVINP),.BGPDATA)
 D WALLALG^BGP2CPU
 Q:BGPQUIT
 K BGPDATA
 D ALLALGA1^BGP2CU1(DFN,DT,.BGPDATA)
 D WALLALGT^BGP2CPU
 K BGPDATA
 D IVUD^BGP2CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP2CU(BGPVINP),,.BGPDATA)
 D WIVUD^BGP2CPU
 Q
 ;
AMI6 ;EP
 I $Y>(BGPIOSL-3) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
 I $$TRANSIN^BGP2CU(BGPVINP) D TRANSIN Q:BGPQUIT
 D WDT^BGP2CPU(BGPVINP)
 Q:BGPQUIT
 I $$TRANS^BGP2CU(BGPVINP) D WTT^BGP2CPU(BGPVINP)
 Q:BGPQUIT
 I $$TRANS^BGP2CU(BGPVINP) D TRANSN Q:BGPQUIT
 D WPPDPOV^BGP2CPU(BGPVSIT)
 Q:BGPQUIT
 D OTHDPOVS^BGP2CPU(BGPVSIT)
 Q:BGPQUIT
 S X=$$COMFORT^BGP2CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
 D WCOMFORT^BGP2CPU(X)
 Q:BGPQUIT
 K BGPBRADY
 D ALLDXS^BGP2CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),.BGPBRADY,0,"BGP CMS BRADYCARDIA DXS")
 ;on active med for beta blocker?
 K BGPBETA
 D BETARX^BGP2CU2(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-180),$$DSCH^BGP2CU(BGPVINP),1,.BGPBETA)
 S BGPASTER=1 D WBRADY6^BGP2CPU2 S BGPASTER=0
 Q:BGPQUIT
 K BGPDATA
A6WHF1 ;
 D ALLDXS^BGP2CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),.BGPDATA,0,"BGP CMS HEART FAILURE DXS")
 D WHF^BGP2CPU2
 K BGPDATA
 Q:BGPQUIT
 K BGP23RD
 D ALLDXS^BGP2CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),.BGP23RD,0,"BGP CMS 2/3 HEART BLOCK DXS")
 S BGPPACE=$$PACE^BGP2CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP2CU(BGPVINP))
 D W23RD^BGP2CPU2
 K BGPY
 Q:BGPQUIT
 K BGPDATA
 D ALLDXS^BGP2CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),.BGPDATA,0,"BGP CMS CIRCULATORY SHOCK DXS")
 D WCS^BGP2CPU2
 K BGPDATA
 Q:BGPQUIT
 K BGPY
 D NMIDRUG^BGP2CU1(DFN,$$VD^APCLV(BGPVSIT),$$DSCH^BGP2CU(BGPVINP),.BGPDATA,"BGP CMS BETA BLOCKER MEDS",0)
 S E=+$$CODEN^ICPTCOD("G8011")
 S Z=$$CPTI^BGP2DU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),E) I Z]"" S Z=$$DATE^BGP2UTL($P(Z,U,2))_" [G8011]"
 D WNMIBETA^BGP2CPU
 Q:BGPQUIT
 S X=$$LASTMED^BGP2CU1(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($P($P(^AUPNVINP(BGPVINP,0),U),"."),30),"BGP CMS BETA BLOCKER MEDS","BGP CMS BETA BLOCKER NDC","BGP CMS BETA BLOCKER CLASS")
 S E=+$$CODEN^ICPTCOD("G8009")
 S Z=$$CPTI^BGP2DU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($P($P(^AUPNVINP(BGPVINP,0),U),"."),30),E) I Z]"" S Z=$$DATE^BGP2UTL($P(Z,U,2))_" [G8009]"
 D WLASTBB^BGP2CPU
 Q:BGPQUIT
 D ALLALG1^BGP2CU1(DFN,DT,$$DSCH^BGP2CU(BGPVINP),.BGPDATA)
 D WALLALG^BGP2CPU
 Q:BGPQUIT
 K BGPDATA
 D ALLALGA1^BGP2CU1(DFN,DT,.BGPDATA)
 D WALLALGT^BGP2CPU
 K BGPDATA
 D IVUD^BGP2CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP2CU(BGPVINP),,.BGPDATA)
 D WIVUD^BGP2CPU
 Q
 ;
AMI6W ;EP
 S BGPASTER=0
 I $Y>(BGPIOSL-3) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
 I $$TRANSIN^BGP2CU(BGPVINP) D TRANSIN Q:BGPQUIT
 D WDOD^BGP2CPU(DFN)
 Q:BGPQUIT
 D WDT^BGP2CPU(BGPVINP)
 Q:BGPQUIT
 I $$TRANS^BGP2CU(BGPVINP) D WTT^BGP2CPU(BGPVINP)
 Q:BGPQUIT
 I $$TRANS^BGP2CU(BGPVINP) D TRANSN Q:BGPQUIT
 D WPPDPOV^BGP2CPU(BGPVSIT)
 Q:BGPQUIT
 D OTHDPOVS^BGP2CPU(BGPVSIT)
 Q:BGPQUIT
 S X=$$COMFORT^BGP2CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
 D WCOMFORT^BGP2CPU(X)
 Q:BGPQUIT
 S X=$$BETAALEG^BGP2CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP2CU(BGPVINP))
 I X S X=$P(X,U,2)
 D WBETAAL^BGP2CPU
 Q:BGPQUIT
 K BGPBRADY
 D ALLDXS^BGP2CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),.BGPBRADY,0,"BGP CMS BRADYCARDIA DXS")
 ;on active med for beta blocker?
 K BGPBETA
 D BETARX^BGP2CU2(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-180),$$DSCH^BGP2CU(BGPVINP),1,.BGPBETA)
 S BGPASTER=1 D WBRADY6^BGP2CPU2 S BGPASTER=0
 Q:BGPQUIT
 K BGPDATA
A6WHF ;
 D ALLDXS^BGP2CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),.BGPDATA,0,"BGP CMS HEART FAILURE DXS")
 D WHF^BGP2CPU2
 K BGPDATA
 Q:BGPQUIT
 K BGP23RD
 D ALLDXS^BGP2CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),.BGP23RD,0,"BGP CMS 2/3 HEART BLOCK DXS")
 S BGPPACE=$$PACE^BGP2CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP2CU(BGPVINP))
 D W23RD^BGP2CPU2
 K BGPY
 Q:BGPQUIT
 K BGPDATA
 D ALLDXS^BGP2CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),.BGPDATA,0,"BGP CMS CIRCULATORY SHOCK DXS")
 D WCS^BGP2CPU2
 K BGPDATA
 Q:BGPQUIT
 D NMIDRUG^BGP2CU1(DFN,$$VD^APCLV(BGPVSIT),$$DSCH^BGP2CU(BGPVINP),.BGPDATA,"BGP CMS BETA BLOCKER MEDS",0)
 S E=+$$CODEN^ICPTCOD("G8011")
 S Z=$$CPTI^BGP2DU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),E) I Z]"" S Z=$$DATE^BGP2UTL($P(Z,U,2))_" [G8011]"
 D WNMIBETA^BGP2CPU
 Q:BGPQUIT
 S X=$$LASTMED^BGP2CU1(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($P($P(^AUPNVINP(BGPVINP,0),U),"."),30),"BGP CMS BETA BLOCKER MEDS","BGP CMS BETA BLOCKER NDC","BGP CMS BETA BLOCKER CLASS")
 S E=+$$CODEN^ICPTCOD("G8009")
 S Z=$$CPTI^BGP2DU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($P($P(^AUPNVINP(BGPVINP,0),U),"."),30),E) I Z]"" S Z=$$DATE^BGP2UTL($P(Z,U,2))_" [G8009]"
 D WLASTBB^BGP2CPU
 Q:BGPQUIT
 D ALLALG1^BGP2CU1(DFN,DT,$$DSCH^BGP2CU(BGPVINP),.BGPDATA)
 D WALLALG^BGP2CPU
 Q:BGPQUIT
 K BGPDATA
 D ALLALGA1^BGP2CU1(DFN,DT,.BGPDATA)
 D WALLALGT^BGP2CPU
 K BGPDATA
 D IVUD^BGP2CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP2CU(BGPVINP),,.BGPDATA)
 D WIVUD^BGP2CPU
 Q
 ;
AMI7AW ;EP
 S BGPASTER=0
 I $Y>(BGPIOSL-3) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
 I $$TRANSIN^BGP2CU(BGPVINP) D TRANSIN Q:BGPQUIT
 D WDT^BGP2CPU(BGPVINP)
 Q:BGPQUIT
 I $$TRANS^BGP2CU(BGPVINP) D WTT^BGP2CPU(BGPVINP)
 Q:BGPQUIT
 I $$TRANS^BGP2CU(BGPVINP) D TRANSN Q:BGPQUIT
 D WPPDPOV^BGP2CPU(BGPVSIT)
 Q:BGPQUIT
 D OTHDPOVS^BGP2CPU(BGPVSIT)
 Q:BGPQUIT
 S X=$$COMFORT^BGP2CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
 D WCOMFORT^BGP2CPU(X)
 Q:BGPQUIT
 K BGPST1
 S BGPST1=$$LASTDX^BGP2UTL1(DFN,"BGP ST ELEVATION DX",$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$$DSCH^BGP2CU(BGPVINP))
 I BGPST1 S BGPST1=$$DATE^BGP2UTL($P(BGPST1,U,3))_"  ["_$P(BGPST1,U,2)_"]  "_$$VAL^XBDIQ1(9000010.07,$P(BGPST1,U,5),.04)
 D WST^BGP2CPU2
 ;LBBB ON ECG
 K BGPLBPC,BGPLBDX
 S BGPLBDX=$$LBBBDX^BGP2CU2(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$$DSCH^BGP2CU(BGPVINP)) I BGPLBDX S BGPLBDX=$$DATE^BGP2UTL($P(BGPLBDX,U,3))_"  ["_$P(BGPLBDX,U,2)_"]  "_$$VAL^XBDIQ1(9000010.07,$P(BGPLBDX,U,5),.04)
 D LBBBPROC^BGP2CU2(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$$DSCH^BGP2CU(BGPVINP),.BGPLBPC)
 D WLBBB^BGP2CPU2
 ;FIB MEDS
 S BGPFIB=""
 K BGPDATA
 D TARX^BGP2CU2(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($$DSCH^BGP2CU(BGPVINP),30),0,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),.BGPDATA)
 K BGPUD
 D IVUD^BGP2CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP2CU(BGPVINP),$O(^ATXAX("B","BGP CMS THROMBOLYTIC MEDS",0)),.BGPUD,"",$O(^ATXAX("B","BGP THROMBOLYTIC AGENTS CLASS",0)))
 S BGPTAPRO=$$LASTPRCI^BGP2UTL1(DFN,"99.10",$P($P(BGPVSIT0,U),"."),$$DSCH^BGP2CU(BGPVINP)) I BGPTAPRO S BGPTAPRO=$$DATE^BGP2UTL($P(BGPTAPRO,U,3))_"  ["_$P(BGPTAPRO,U,2)_"]  "_$$VAL^XBDIQ1(9000010.08,$P(BGPTAPRO,U,5),.04)
 D WFIB^BGP2CPU2
 Q:BGPQUIT
 D ALLALG1^BGP2CU1(DFN,DT,$$DSCH^BGP2CU(BGPVINP),.BGPDATA)
 D WALLALG^BGP2CPU
 Q:BGPQUIT
 K BGPDATA
 D ALLALGA1^BGP2CU1(DFN,DT,.BGPDATA)
 D WALLALGT^BGP2CPU
 K BGPDATA
 D IVUD^BGP2CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP2CU(BGPVINP),,.BGPDATA)
 D WIVUD^BGP2CPU
 Q
 ;
TRANSIN ;
 I $Y>(BGPIOSL-4) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
 W !!?3,"NOTE:  Since Admission Type was ","""","Transferred,",""""," review patient's chart"
 W !,"to determine if patient should be excluded if transfer was from another"
 W !,"acute care hospital, including ER from another hospital.",!
 Q
 ;
TRANSN ;EP
 I $Y>(BGPIOSL-4) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
 W !!?3,"NOTE:  Since Discharge Type was ","""","Transferred,",""""," review patient's chart"
 W !,"to determine if patient should be excluded if transferred to another"
 W !,"acute care hospital or federal hospital."
 Q
 ;
BGP2CP2   ; IHS/CMI/LAB - IHS gpra print 02 Nov 2009 10:40 AM ;
 +1       ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
 +2       ;
 +3       ;
AMI5W     ;EP
 +1        IF $Y>(BGPIOSL-3)
               DO HDR^BGP2CP
               IF BGPQUIT
                   QUIT 
               DO L1H^BGP2CP
 +2        DO WDOD^BGP2CPU(DFN)
 +3        IF BGPQUIT
               QUIT 
 +4        DO WDT^BGP2CPU(BGPVINP)
 +5        IF BGPQUIT
               QUIT 
 +6        IF $$TRANS^BGP2CU(BGPVINP)
               DO WTT^BGP2CPU(BGPVINP)
 +7        IF BGPQUIT
               QUIT 
 +8        IF $$TRANS^BGP2CU(BGPVINP)
               DO TRANSN
               IF BGPQUIT
                   QUIT 
 +9        DO WPPDPOV^BGP2CPU(BGPVSIT)
 +10       IF BGPQUIT
               QUIT 
 +11       DO OTHDPOVS^BGP2CPU(BGPVSIT)
 +12       IF BGPQUIT
               QUIT 
 +13       SET X=$$COMFORT^BGP2CU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."))
 +14       DO WCOMFORT^BGP2CPU(X)
 +15       IF BGPQUIT
               QUIT 
 +16       KILL Z
 +17       SET X=$$BETAALEG^BGP2CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP2CU(BGPVINP))
 +18       IF X
               SET X=$PIECE(X,U,2)
 +19       DO WBETAAL^BGP2CPU
 +20       IF BGPQUIT
               QUIT 
 +21       KILL BGPBRADY
 +22       DO ALLDXS^BGP2CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),.BGPBRADY,0,"BGP CMS BRADYCARDIA DXS")
 +23      ;on active med for beta blocker?
 +24       KILL BGPBETA
 +25       DO BETARX^BGP2CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-180),$$DSCH^BGP2CU(BGPVINP),1,.BGPBETA)
 +26       DO WBRADY5^BGP2CPU2
 +27       IF BGPQUIT
               QUIT 
 +28       KILL BGPDATA
 +29       KILL BGP23RD
 +30       DO ALLDXS^BGP2CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),.BGP23RD,0,"BGP CMS 2/3 HEART BLOCK DXS")
 +31       SET BGPPACE=$$PACE^BGP2CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP2CU(BGPVINP))
 +32       DO W23RD^BGP2CPU2
 +33       KILL BGPY
 +34       DO NMIDRUG^BGP2CU1(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),.BGPDATA,"BGP CMS BETA BLOCKER MEDS",0)
 +35       SET E=+$$CODEN^ICPTCOD("G8011")
 +36       SET Z=$$CPTI^BGP2DU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),E)
           IF Z]""
               SET Z=$$DATE^BGP2UTL($PIECE(Z,U,2))_" [G8011]"
 +37       DO WNMIBETA^BGP2CPU
 +38       IF BGPQUIT
               QUIT 
 +39       SET X=$$LASTMED^BGP2CU1(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),30),"BGP CMS BETA BLOCKER MEDS","BGP CMS BETA BLOCKER NDC","BGP CMS BETA BLOCKER CLASS")
 +40       SET E=+$$CODEN^ICPTCOD("G8009")
 +41       SET Z=$$CPTI^BGP2DU(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),30),E)
           IF Z]""
               SET Z=$$DATE^BGP2UTL($PIECE(Z,U,2))_" [G8009]"
 +42       DO WLASTBB^BGP2CPU
 +43       IF BGPQUIT
               QUIT 
 +44       DO ALLALG1^BGP2CU1(DFN,DT,$$DSCH^BGP2CU(BGPVINP),.BGPDATA)
 +45       DO WALLALG^BGP2CPU
 +46       IF BGPQUIT
               QUIT 
 +47       KILL BGPDATA
 +48       DO ALLALGA1^BGP2CU1(DFN,DT,.BGPDATA)
 +49       DO WALLALGT^BGP2CPU
 +50       KILL BGPDATA
 +51       DO IVUD^BGP2CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP2CU(BGPVINP),,.BGPDATA)
 +52       DO WIVUD^BGP2CPU
 +53       QUIT 
 +54      ;
AMI5      ;EP
 +1        IF $Y>(BGPIOSL-3)
               DO HDR^BGP2CP
               IF BGPQUIT
                   QUIT 
               DO L1H^BGP2CP
 +2        DO WDT^BGP2CPU(BGPVINP)
 +3        IF BGPQUIT
               QUIT 
 +4        IF $$TRANS^BGP2CU(BGPVINP)
               DO WTT^BGP2CPU(BGPVINP)
 +5        IF BGPQUIT
               QUIT 
 +6        IF $$TRANS^BGP2CU(BGPVINP)
               DO TRANSN
               IF BGPQUIT
                   QUIT 
 +7        DO WPPDPOV^BGP2CPU(BGPVSIT)
 +8        IF BGPQUIT
               QUIT 
 +9        DO OTHDPOVS^BGP2CPU(BGPVSIT)
 +10       IF BGPQUIT
               QUIT 
 +11       SET X=$$COMFORT^BGP2CU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."))
 +12       DO WCOMFORT^BGP2CPU(X)
 +13       IF BGPQUIT
               QUIT 
 +14       KILL BGPBRADY
 +15       DO ALLDXS^BGP2CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),.BGPBRADY,0,"BGP CMS BRADYCARDIA DXS")
 +16      ;on active med for beta blocker?
 +17       KILL BGPBETA
 +18       DO BETARX^BGP2CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-180),$$DSCH^BGP2CU(BGPVINP),1,.BGPBETA)
 +19       DO WBRADY5^BGP2CPU2
 +20       IF BGPQUIT
               QUIT 
 +21       KILL BGPDATA
 +22       KILL BGP23RD
 +23       DO ALLDXS^BGP2CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),.BGP23RD,0,"BGP CMS 2/3 HEART BLOCK DXS")
 +24       SET BGPPACE=$$PACE^BGP2CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP2CU(BGPVINP))
 +25       DO W23RD^BGP2CPU2
 +26       KILL BGPY
 +27       DO NMIDRUG^BGP2CU1(DFN,$$VD^APCLV(BGPVSIT),$$DSCH^BGP2CU(BGPVINP),.BGPDATA,"BGP CMS BETA BLOCKER MEDS",0)
 +28       SET E=+$$CODEN^ICPTCOD("G8011")
 +29       SET Z=$$CPTI^BGP2DU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),E)
           IF Z]""
               SET Z=$$DATE^BGP2UTL($PIECE(Z,U,2))_" [G8011]"
 +30       DO WNMIBETA^BGP2CPU
 +31       IF BGPQUIT
               QUIT 
 +32       SET X=$$LASTMED^BGP2CU1(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),30),"BGP CMS BETA BLOCKER MEDS","BGP CMS BETA BLOCKER NDC","BGP CMS BETA BLOCKER CLASS")
 +33       SET E=+$$CODEN^ICPTCOD("G8009")
 +34       SET Z=$$CPTI^BGP2DU(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),30),E)
           IF Z]""
               SET Z=$$DATE^BGP2UTL($PIECE(Z,U,2))_" [G8009]"
 +35       DO WLASTBB^BGP2CPU
 +36       IF BGPQUIT
               QUIT 
 +37       DO ALLALG1^BGP2CU1(DFN,DT,$$DSCH^BGP2CU(BGPVINP),.BGPDATA)
 +38       DO WALLALG^BGP2CPU
 +39       IF BGPQUIT
               QUIT 
 +40       KILL BGPDATA
 +41       DO ALLALGA1^BGP2CU1(DFN,DT,.BGPDATA)
 +42       DO WALLALGT^BGP2CPU
 +43       KILL BGPDATA
 +44       DO IVUD^BGP2CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP2CU(BGPVINP),,.BGPDATA)
 +45       DO WIVUD^BGP2CPU
 +46       QUIT 
 +47      ;
AMI6      ;EP
 +1        IF $Y>(BGPIOSL-3)
               DO HDR^BGP2CP
               IF BGPQUIT
                   QUIT 
               DO L1H^BGP2CP
 +2        IF $$TRANSIN^BGP2CU(BGPVINP)
               DO TRANSIN
               IF BGPQUIT
                   QUIT 
 +3        DO WDT^BGP2CPU(BGPVINP)
 +4        IF BGPQUIT
               QUIT 
 +5        IF $$TRANS^BGP2CU(BGPVINP)
               DO WTT^BGP2CPU(BGPVINP)
 +6        IF BGPQUIT
               QUIT 
 +7        IF $$TRANS^BGP2CU(BGPVINP)
               DO TRANSN
               IF BGPQUIT
                   QUIT 
 +8        DO WPPDPOV^BGP2CPU(BGPVSIT)
 +9        IF BGPQUIT
               QUIT 
 +10       DO OTHDPOVS^BGP2CPU(BGPVSIT)
 +11       IF BGPQUIT
               QUIT 
 +12       SET X=$$COMFORT^BGP2CU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."))
 +13       DO WCOMFORT^BGP2CPU(X)
 +14       IF BGPQUIT
               QUIT 
 +15       KILL BGPBRADY
 +16       DO ALLDXS^BGP2CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),.BGPBRADY,0,"BGP CMS BRADYCARDIA DXS")
 +17      ;on active med for beta blocker?
 +18       KILL BGPBETA
 +19       DO BETARX^BGP2CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-180),$$DSCH^BGP2CU(BGPVINP),1,.BGPBETA)
 +20       SET BGPASTER=1
           DO WBRADY6^BGP2CPU2
           SET BGPASTER=0
 +21       IF BGPQUIT
               QUIT 
 +22       KILL BGPDATA
A6WHF1    ;
 +1        DO ALLDXS^BGP2CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),.BGPDATA,0,"BGP CMS HEART FAILURE DXS")
 +2        DO WHF^BGP2CPU2
 +3        KILL BGPDATA
 +4        IF BGPQUIT
               QUIT 
 +5        KILL BGP23RD
 +6        DO ALLDXS^BGP2CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),.BGP23RD,0,"BGP CMS 2/3 HEART BLOCK DXS")
 +7        SET BGPPACE=$$PACE^BGP2CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP2CU(BGPVINP))
 +8        DO W23RD^BGP2CPU2
 +9        KILL BGPY
 +10       IF BGPQUIT
               QUIT 
 +11       KILL BGPDATA
 +12       DO ALLDXS^BGP2CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),.BGPDATA,0,"BGP CMS CIRCULATORY SHOCK DXS")
 +13       DO WCS^BGP2CPU2
 +14       KILL BGPDATA
 +15       IF BGPQUIT
               QUIT 
 +16       KILL BGPY
 +17       DO NMIDRUG^BGP2CU1(DFN,$$VD^APCLV(BGPVSIT),$$DSCH^BGP2CU(BGPVINP),.BGPDATA,"BGP CMS BETA BLOCKER MEDS",0)
 +18       SET E=+$$CODEN^ICPTCOD("G8011")
 +19       SET Z=$$CPTI^BGP2DU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),E)
           IF Z]""
               SET Z=$$DATE^BGP2UTL($PIECE(Z,U,2))_" [G8011]"
 +20       DO WNMIBETA^BGP2CPU
 +21       IF BGPQUIT
               QUIT 
 +22       SET X=$$LASTMED^BGP2CU1(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),30),"BGP CMS BETA BLOCKER MEDS","BGP CMS BETA BLOCKER NDC","BGP CMS BETA BLOCKER CLASS")
 +23       SET E=+$$CODEN^ICPTCOD("G8009")
 +24       SET Z=$$CPTI^BGP2DU(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),30),E)
           IF Z]""
               SET Z=$$DATE^BGP2UTL($PIECE(Z,U,2))_" [G8009]"
 +25       DO WLASTBB^BGP2CPU
 +26       IF BGPQUIT
               QUIT 
 +27       DO ALLALG1^BGP2CU1(DFN,DT,$$DSCH^BGP2CU(BGPVINP),.BGPDATA)
 +28       DO WALLALG^BGP2CPU
 +29       IF BGPQUIT
               QUIT 
 +30       KILL BGPDATA
 +31       DO ALLALGA1^BGP2CU1(DFN,DT,.BGPDATA)
 +32       DO WALLALGT^BGP2CPU
 +33       KILL BGPDATA
 +34       DO IVUD^BGP2CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP2CU(BGPVINP),,.BGPDATA)
 +35       DO WIVUD^BGP2CPU
 +36       QUIT 
 +37      ;
AMI6W     ;EP
 +1        SET BGPASTER=0
 +2        IF $Y>(BGPIOSL-3)
               DO HDR^BGP2CP
               IF BGPQUIT
                   QUIT 
               DO L1H^BGP2CP
 +3        IF $$TRANSIN^BGP2CU(BGPVINP)
               DO TRANSIN
               IF BGPQUIT
                   QUIT 
 +4        DO WDOD^BGP2CPU(DFN)
 +5        IF BGPQUIT
               QUIT 
 +6        DO WDT^BGP2CPU(BGPVINP)
 +7        IF BGPQUIT
               QUIT 
 +8        IF $$TRANS^BGP2CU(BGPVINP)
               DO WTT^BGP2CPU(BGPVINP)
 +9        IF BGPQUIT
               QUIT 
 +10       IF $$TRANS^BGP2CU(BGPVINP)
               DO TRANSN
               IF BGPQUIT
                   QUIT 
 +11       DO WPPDPOV^BGP2CPU(BGPVSIT)
 +12       IF BGPQUIT
               QUIT 
 +13       DO OTHDPOVS^BGP2CPU(BGPVSIT)
 +14       IF BGPQUIT
               QUIT 
 +15       SET X=$$COMFORT^BGP2CU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."))
 +16       DO WCOMFORT^BGP2CPU(X)
 +17       IF BGPQUIT
               QUIT 
 +18       SET X=$$BETAALEG^BGP2CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP2CU(BGPVINP))
 +19       IF X
               SET X=$PIECE(X,U,2)
 +20       DO WBETAAL^BGP2CPU
 +21       IF BGPQUIT
               QUIT 
 +22       KILL BGPBRADY
 +23       DO ALLDXS^BGP2CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),.BGPBRADY,0,"BGP CMS BRADYCARDIA DXS")
 +24      ;on active med for beta blocker?
 +25       KILL BGPBETA
 +26       DO BETARX^BGP2CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-180),$$DSCH^BGP2CU(BGPVINP),1,.BGPBETA)
 +27       SET BGPASTER=1
           DO WBRADY6^BGP2CPU2
           SET BGPASTER=0
 +28       IF BGPQUIT
               QUIT 
 +29       KILL BGPDATA
A6WHF     ;
 +1        DO ALLDXS^BGP2CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),.BGPDATA,0,"BGP CMS HEART FAILURE DXS")
 +2        DO WHF^BGP2CPU2
 +3        KILL BGPDATA
 +4        IF BGPQUIT
               QUIT 
 +5        KILL BGP23RD
 +6        DO ALLDXS^BGP2CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),.BGP23RD,0,"BGP CMS 2/3 HEART BLOCK DXS")
 +7        SET BGPPACE=$$PACE^BGP2CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP2CU(BGPVINP))
 +8        DO W23RD^BGP2CPU2
 +9        KILL BGPY
 +10       IF BGPQUIT
               QUIT 
 +11       KILL BGPDATA
 +12       DO ALLDXS^BGP2CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),.BGPDATA,0,"BGP CMS CIRCULATORY SHOCK DXS")
 +13       DO WCS^BGP2CPU2
 +14       KILL BGPDATA
 +15       IF BGPQUIT
               QUIT 
 +16       DO NMIDRUG^BGP2CU1(DFN,$$VD^APCLV(BGPVSIT),$$DSCH^BGP2CU(BGPVINP),.BGPDATA,"BGP CMS BETA BLOCKER MEDS",0)
 +17       SET E=+$$CODEN^ICPTCOD("G8011")
 +18       SET Z=$$CPTI^BGP2DU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),E)
           IF Z]""
               SET Z=$$DATE^BGP2UTL($PIECE(Z,U,2))_" [G8011]"
 +19       DO WNMIBETA^BGP2CPU
 +20       IF BGPQUIT
               QUIT 
 +21       SET X=$$LASTMED^BGP2CU1(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),30),"BGP CMS BETA BLOCKER MEDS","BGP CMS BETA BLOCKER NDC","BGP CMS BETA BLOCKER CLASS")
 +22       SET E=+$$CODEN^ICPTCOD("G8009")
 +23       SET Z=$$CPTI^BGP2DU(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),30),E)
           IF Z]""
               SET Z=$$DATE^BGP2UTL($PIECE(Z,U,2))_" [G8009]"
 +24       DO WLASTBB^BGP2CPU
 +25       IF BGPQUIT
               QUIT 
 +26       DO ALLALG1^BGP2CU1(DFN,DT,$$DSCH^BGP2CU(BGPVINP),.BGPDATA)
 +27       DO WALLALG^BGP2CPU
 +28       IF BGPQUIT
               QUIT 
 +29       KILL BGPDATA
 +30       DO ALLALGA1^BGP2CU1(DFN,DT,.BGPDATA)
 +31       DO WALLALGT^BGP2CPU
 +32       KILL BGPDATA
 +33       DO IVUD^BGP2CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP2CU(BGPVINP),,.BGPDATA)
 +34       DO WIVUD^BGP2CPU
 +35       QUIT 
 +36      ;
AMI7AW    ;EP
 +1        SET BGPASTER=0
 +2        IF $Y>(BGPIOSL-3)
               DO HDR^BGP2CP
               IF BGPQUIT
                   QUIT 
               DO L1H^BGP2CP
 +3        IF $$TRANSIN^BGP2CU(BGPVINP)
               DO TRANSIN
               IF BGPQUIT
                   QUIT 
 +4        DO WDT^BGP2CPU(BGPVINP)
 +5        IF BGPQUIT
               QUIT 
 +6        IF $$TRANS^BGP2CU(BGPVINP)
               DO WTT^BGP2CPU(BGPVINP)
 +7        IF BGPQUIT
               QUIT 
 +8        IF $$TRANS^BGP2CU(BGPVINP)
               DO TRANSN
               IF BGPQUIT
                   QUIT 
 +9        DO WPPDPOV^BGP2CPU(BGPVSIT)
 +10       IF BGPQUIT
               QUIT 
 +11       DO OTHDPOVS^BGP2CPU(BGPVSIT)
 +12       IF BGPQUIT
               QUIT 
 +13       SET X=$$COMFORT^BGP2CU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."))
 +14       DO WCOMFORT^BGP2CPU(X)
 +15       IF BGPQUIT
               QUIT 
 +16       KILL BGPST1
 +17       SET BGPST1=$$LASTDX^BGP2UTL1(DFN,"BGP ST ELEVATION DX",$$FMADD^XLFDT($PIECE($PIECE(BGPVSIT0,U),"."),-1),$$DSCH^BGP2CU(BGPVINP))
 +18       IF BGPST1
               SET BGPST1=$$DATE^BGP2UTL($PIECE(BGPST1,U,3))_"  ["_$PIECE(BGPST1,U,2)_"]  "_$$VAL^XBDIQ1(9000010.07,$PIECE(BGPST1,U,5),.04)
 +19       DO WST^BGP2CPU2
 +20      ;LBBB ON ECG
 +21       KILL BGPLBPC,BGPLBDX
 +22       SET BGPLBDX=$$LBBBDX^BGP2CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(BGPVSIT0,U),"."),-1),$$DSCH^BGP2CU(BGPVINP))
           IF BGPLBDX
               SET BGPLBDX=$$DATE^BGP2UTL($PIECE(BGPLBDX,U,3))_"  ["_$PIECE(BGPLBDX,U,2)_"]  "_$$VAL^XBDIQ1(9000010.07,$PIECE(BGPLBDX,U,5),.04)
 +23       DO LBBBPROC^BGP2CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(BGPVSIT0,U),"."),-1),$$DSCH^BGP2CU(BGPVINP),.BGPLBPC)
 +24       DO WLBBB^BGP2CPU2
 +25      ;FIB MEDS
 +26       SET BGPFIB=""
 +27       KILL BGPDATA
 +28       DO TARX^BGP2CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($$DSCH^BGP2CU(BGPVINP),30),0,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),.BGPDATA)
 +29       KILL BGPUD
 +30       DO IVUD^BGP2CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP2CU(BGPVINP),$ORDER(^ATXAX("B","BGP CMS THROMBOLYTIC MEDS",0)),.BGPUD,"",$ORDER(^ATXAX("B","BGP THROMBOLYTIC AGENTS CLASS",0)))
 +31       SET BGPTAPRO=$$LASTPRCI^BGP2UTL1(DFN,"99.10",$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP2CU(BGPVINP))
           IF BGPTAPRO
               SET BGPTAPRO=$$DATE^BGP2UTL($PIECE(BGPTAPRO,U,3))_"  ["_$PIECE(BGPTAPRO,U,2)_"]  "_$$VAL^XBDIQ1(9000010.08,$PIECE(BGPTAPRO,U,5),.04)
 +32       DO WFIB^BGP2CPU2
 +33       IF BGPQUIT
               QUIT 
 +34       DO ALLALG1^BGP2CU1(DFN,DT,$$DSCH^BGP2CU(BGPVINP),.BGPDATA)
 +35       DO WALLALG^BGP2CPU
 +36       IF BGPQUIT
               QUIT 
 +37       KILL BGPDATA
 +38       DO ALLALGA1^BGP2CU1(DFN,DT,.BGPDATA)
 +39       DO WALLALGT^BGP2CPU
 +40       KILL BGPDATA
 +41       DO IVUD^BGP2CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP2CU(BGPVINP),,.BGPDATA)
 +42       DO WIVUD^BGP2CPU
 +43       QUIT 
 +44      ;
TRANSIN   ;
 +1        IF $Y>(BGPIOSL-4)
               DO HDR^BGP2CP
               IF BGPQUIT
                   QUIT 
               DO L1H^BGP2CP
 +2        WRITE !!?3,"NOTE:  Since Admission Type was ","""","Transferred,",""""," review patient's chart"
 +3        WRITE !,"to determine if patient should be excluded if transfer was from another"
 +4        WRITE !,"acute care hospital, including ER from another hospital.",!
 +5        QUIT 
 +6       ;
TRANSN    ;EP
 +1        IF $Y>(BGPIOSL-4)
               DO HDR^BGP2CP
               IF BGPQUIT
                   QUIT 
               DO L1H^BGP2CP
 +2        WRITE !!?3,"NOTE:  Since Discharge Type was ","""","Transferred,",""""," review patient's chart"
 +3        WRITE !,"to determine if patient should be excluded if transferred to another"
 +4        WRITE !,"acute care hospital or federal hospital."
 +5        QUIT 
 +6       ;