- BGP1CP2 ; IHS/CMI/LAB - IHS gpra print 02 Nov 2009 10:40 AM ;
- ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
- ;
- ;
- AMI5W ;EP
- I $Y>(BGPIOSL-3) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
- D WDOD^BGP1CPU(DFN)
- Q:BGPQUIT
- D WDT^BGP1CPU(BGPVINP)
- Q:BGPQUIT
- I $$TRANS^BGP1CU(BGPVINP) D WTT^BGP1CPU(BGPVINP)
- Q:BGPQUIT
- I $$TRANS^BGP1CU(BGPVINP) D TRANSN Q:BGPQUIT
- D WPPDPOV^BGP1CPU(BGPVSIT)
- Q:BGPQUIT
- D OTHDPOVS^BGP1CPU(BGPVSIT)
- Q:BGPQUIT
- S X=$$COMFORT^BGP1CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
- D WCOMFORT^BGP1CPU(X)
- Q:BGPQUIT
- K Z
- S X=$$BETAALEG^BGP1CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
- I X S X=$P(X,U,2)
- D WBETAAL^BGP1CPU
- Q:BGPQUIT
- K BGPBRADY
- D ALLDXS^BGP1CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGPBRADY,0,"BGP CMS BRADYCARDIA DXS")
- ;on active med for beta blocker?
- K BGPBETA
- D BETARX^BGP1CU2(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-180),$$DSCH^BGP1CU(BGPVINP),1,.BGPBETA)
- D WBRADY5^BGP1CPU2
- Q:BGPQUIT
- K BGPDATA
- K BGP23RD
- D ALLDXS^BGP1CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGP23RD,0,"BGP CMS 2/3 HEART BLOCK DXS")
- S BGPPACE=$$PACE^BGP1CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
- D W23RD^BGP1CPU2
- K BGPY
- D NMIDRUG^BGP1CU1(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,"BGP CMS BETA BLOCKER MEDS",0)
- S E=+$$CODEN^ICPTCOD("G8011")
- S Z=$$CPTI^BGP1DU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),E) I Z]"" S Z=$$DATE^BGP1UTL($P(Z,U,2))_" [G8011]"
- D WNMIBETA^BGP1CPU
- Q:BGPQUIT
- S X=$$LASTMED^BGP1CU1(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^BGP1DU(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^BGP1UTL($P(Z,U,2))_" [G8009]"
- D WLASTBB^BGP1CPU
- Q:BGPQUIT
- D ALLALG1^BGP1CU1(DFN,DT,$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
- D WALLALG^BGP1CPU
- Q:BGPQUIT
- K BGPDATA
- D ALLALGA1^BGP1CU1(DFN,DT,.BGPDATA)
- D WALLALGT^BGP1CPU
- K BGPDATA
- D IVUD^BGP1CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP),,.BGPDATA)
- D WIVUD^BGP1CPU
- Q
- ;
- AMI5 ;EP
- I $Y>(BGPIOSL-3) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
- D WDT^BGP1CPU(BGPVINP)
- Q:BGPQUIT
- I $$TRANS^BGP1CU(BGPVINP) D WTT^BGP1CPU(BGPVINP)
- Q:BGPQUIT
- I $$TRANS^BGP1CU(BGPVINP) D TRANSN Q:BGPQUIT
- D WPPDPOV^BGP1CPU(BGPVSIT)
- Q:BGPQUIT
- D OTHDPOVS^BGP1CPU(BGPVSIT)
- Q:BGPQUIT
- S X=$$COMFORT^BGP1CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
- D WCOMFORT^BGP1CPU(X)
- Q:BGPQUIT
- K BGPBRADY
- D ALLDXS^BGP1CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGPBRADY,0,"BGP CMS BRADYCARDIA DXS")
- ;on active med for beta blocker?
- K BGPBETA
- D BETARX^BGP1CU2(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-180),$$DSCH^BGP1CU(BGPVINP),1,.BGPBETA)
- D WBRADY5^BGP1CPU2
- Q:BGPQUIT
- K BGPDATA
- K BGP23RD
- D ALLDXS^BGP1CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGP23RD,0,"BGP CMS 2/3 HEART BLOCK DXS")
- S BGPPACE=$$PACE^BGP1CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
- D W23RD^BGP1CPU2
- K BGPY
- D NMIDRUG^BGP1CU1(DFN,$$VD^APCLV(BGPVSIT),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,"BGP CMS BETA BLOCKER MEDS",0)
- S E=+$$CODEN^ICPTCOD("G8011")
- S Z=$$CPTI^BGP1DU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),E) I Z]"" S Z=$$DATE^BGP1UTL($P(Z,U,2))_" [G8011]"
- D WNMIBETA^BGP1CPU
- Q:BGPQUIT
- S X=$$LASTMED^BGP1CU1(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^BGP1DU(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^BGP1UTL($P(Z,U,2))_" [G8009]"
- D WLASTBB^BGP1CPU
- Q:BGPQUIT
- D ALLALG1^BGP1CU1(DFN,DT,$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
- D WALLALG^BGP1CPU
- Q:BGPQUIT
- K BGPDATA
- D ALLALGA1^BGP1CU1(DFN,DT,.BGPDATA)
- D WALLALGT^BGP1CPU
- K BGPDATA
- D IVUD^BGP1CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP),,.BGPDATA)
- D WIVUD^BGP1CPU
- Q
- ;
- AMI6 ;EP
- I $Y>(BGPIOSL-3) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
- I $$TRANSIN^BGP1CU(BGPVINP) D TRANSIN Q:BGPQUIT
- D WDT^BGP1CPU(BGPVINP)
- Q:BGPQUIT
- I $$TRANS^BGP1CU(BGPVINP) D WTT^BGP1CPU(BGPVINP)
- Q:BGPQUIT
- I $$TRANS^BGP1CU(BGPVINP) D TRANSN Q:BGPQUIT
- D WPPDPOV^BGP1CPU(BGPVSIT)
- Q:BGPQUIT
- D OTHDPOVS^BGP1CPU(BGPVSIT)
- Q:BGPQUIT
- S X=$$COMFORT^BGP1CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
- D WCOMFORT^BGP1CPU(X)
- Q:BGPQUIT
- K BGPBRADY
- D ALLDXS^BGP1CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGPBRADY,0,"BGP CMS BRADYCARDIA DXS")
- ;on active med for beta blocker?
- K BGPBETA
- D BETARX^BGP1CU2(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-180),$$DSCH^BGP1CU(BGPVINP),1,.BGPBETA)
- S BGPASTER=1 D WBRADY6^BGP1CPU2 S BGPASTER=0
- Q:BGPQUIT
- K BGPDATA
- A6WHF1 ;
- D ALLDXS^BGP1CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0,"BGP CMS HEART FAILURE DXS")
- D WHF^BGP1CPU2
- K BGPDATA
- Q:BGPQUIT
- K BGP23RD
- D ALLDXS^BGP1CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGP23RD,0,"BGP CMS 2/3 HEART BLOCK DXS")
- S BGPPACE=$$PACE^BGP1CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
- D W23RD^BGP1CPU2
- K BGPY
- Q:BGPQUIT
- K BGPDATA
- D ALLDXS^BGP1CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0,"BGP CMS CIRCULATORY SHOCK DXS")
- D WCS^BGP1CPU2
- K BGPDATA
- Q:BGPQUIT
- K BGPY
- D NMIDRUG^BGP1CU1(DFN,$$VD^APCLV(BGPVSIT),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,"BGP CMS BETA BLOCKER MEDS",0)
- S E=+$$CODEN^ICPTCOD("G8011")
- S Z=$$CPTI^BGP1DU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),E) I Z]"" S Z=$$DATE^BGP1UTL($P(Z,U,2))_" [G8011]"
- D WNMIBETA^BGP1CPU
- Q:BGPQUIT
- S X=$$LASTMED^BGP1CU1(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^BGP1DU(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^BGP1UTL($P(Z,U,2))_" [G8009]"
- D WLASTBB^BGP1CPU
- Q:BGPQUIT
- D ALLALG1^BGP1CU1(DFN,DT,$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
- D WALLALG^BGP1CPU
- Q:BGPQUIT
- K BGPDATA
- D ALLALGA1^BGP1CU1(DFN,DT,.BGPDATA)
- D WALLALGT^BGP1CPU
- K BGPDATA
- D IVUD^BGP1CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP),,.BGPDATA)
- D WIVUD^BGP1CPU
- Q
- ;
- AMI6W ;EP
- S BGPASTER=0
- I $Y>(BGPIOSL-3) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
- I $$TRANSIN^BGP1CU(BGPVINP) D TRANSIN Q:BGPQUIT
- D WDOD^BGP1CPU(DFN)
- Q:BGPQUIT
- D WDT^BGP1CPU(BGPVINP)
- Q:BGPQUIT
- I $$TRANS^BGP1CU(BGPVINP) D WTT^BGP1CPU(BGPVINP)
- Q:BGPQUIT
- I $$TRANS^BGP1CU(BGPVINP) D TRANSN Q:BGPQUIT
- D WPPDPOV^BGP1CPU(BGPVSIT)
- Q:BGPQUIT
- D OTHDPOVS^BGP1CPU(BGPVSIT)
- Q:BGPQUIT
- S X=$$COMFORT^BGP1CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
- D WCOMFORT^BGP1CPU(X)
- Q:BGPQUIT
- S X=$$BETAALEG^BGP1CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
- I X S X=$P(X,U,2)
- D WBETAAL^BGP1CPU
- Q:BGPQUIT
- K BGPBRADY
- D ALLDXS^BGP1CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGPBRADY,0,"BGP CMS BRADYCARDIA DXS")
- ;on active med for beta blocker?
- K BGPBETA
- D BETARX^BGP1CU2(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-180),$$DSCH^BGP1CU(BGPVINP),1,.BGPBETA)
- S BGPASTER=1 D WBRADY6^BGP1CPU2 S BGPASTER=0
- Q:BGPQUIT
- K BGPDATA
- A6WHF ;
- D ALLDXS^BGP1CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0,"BGP CMS HEART FAILURE DXS")
- D WHF^BGP1CPU2
- K BGPDATA
- Q:BGPQUIT
- K BGP23RD
- D ALLDXS^BGP1CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGP23RD,0,"BGP CMS 2/3 HEART BLOCK DXS")
- S BGPPACE=$$PACE^BGP1CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
- D W23RD^BGP1CPU2
- K BGPY
- Q:BGPQUIT
- K BGPDATA
- D ALLDXS^BGP1CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0,"BGP CMS CIRCULATORY SHOCK DXS")
- D WCS^BGP1CPU2
- K BGPDATA
- Q:BGPQUIT
- D NMIDRUG^BGP1CU1(DFN,$$VD^APCLV(BGPVSIT),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,"BGP CMS BETA BLOCKER MEDS",0)
- S E=+$$CODEN^ICPTCOD("G8011")
- S Z=$$CPTI^BGP1DU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),E) I Z]"" S Z=$$DATE^BGP1UTL($P(Z,U,2))_" [G8011]"
- D WNMIBETA^BGP1CPU
- Q:BGPQUIT
- S X=$$LASTMED^BGP1CU1(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^BGP1DU(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^BGP1UTL($P(Z,U,2))_" [G8009]"
- D WLASTBB^BGP1CPU
- Q:BGPQUIT
- D ALLALG1^BGP1CU1(DFN,DT,$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
- D WALLALG^BGP1CPU
- Q:BGPQUIT
- K BGPDATA
- D ALLALGA1^BGP1CU1(DFN,DT,.BGPDATA)
- D WALLALGT^BGP1CPU
- K BGPDATA
- D IVUD^BGP1CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP),,.BGPDATA)
- D WIVUD^BGP1CPU
- Q
- ;
- AMI7AW ;EP
- S BGPASTER=0
- I $Y>(BGPIOSL-3) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
- I $$TRANSIN^BGP1CU(BGPVINP) D TRANSIN Q:BGPQUIT
- D WDT^BGP1CPU(BGPVINP)
- Q:BGPQUIT
- I $$TRANS^BGP1CU(BGPVINP) D WTT^BGP1CPU(BGPVINP)
- Q:BGPQUIT
- I $$TRANS^BGP1CU(BGPVINP) D TRANSN Q:BGPQUIT
- D WPPDPOV^BGP1CPU(BGPVSIT)
- Q:BGPQUIT
- D OTHDPOVS^BGP1CPU(BGPVSIT)
- Q:BGPQUIT
- S X=$$COMFORT^BGP1CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
- D WCOMFORT^BGP1CPU(X)
- Q:BGPQUIT
- K BGPST1
- S BGPST1=$$LASTDX^BGP1UTL1(DFN,"BGP ST ELEVATION DX",$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$$DSCH^BGP1CU(BGPVINP))
- I BGPST1 S BGPST1=$$DATE^BGP1UTL($P(BGPST1,U,3))_" ["_$P(BGPST1,U,2)_"] "_$$VAL^XBDIQ1(9000010.07,$P(BGPST1,U,5),.04)
- D WST^BGP1CPU2
- ;LBBB ON ECG
- K BGPLBPC,BGPLBDX
- S BGPLBDX=$$LBBBDX^BGP1CU2(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$$DSCH^BGP1CU(BGPVINP)) I BGPLBDX S BGPLBDX=$$DATE^BGP1UTL($P(BGPLBDX,U,3))_" ["_$P(BGPLBDX,U,2)_"] "_$$VAL^XBDIQ1(9000010.07,$P(BGPLBDX,U,5),.04)
- D LBBBPROC^BGP1CU2(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$$DSCH^BGP1CU(BGPVINP),.BGPLBPC)
- D WLBBB^BGP1CPU2
- ;FIB MEDS
- S BGPFIB=""
- K BGPDATA
- D TARX^BGP1CU2(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($$DSCH^BGP1CU(BGPVINP),30),0,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),.BGPDATA)
- K BGPUD
- D IVUD^BGP1CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP),$O(^ATXAX("B","BGP CMS THROMBOLYTIC MEDS",0)),.BGPUD,"",$O(^ATXAX("B","BGP THROMBOLYTIC AGENTS CLASS",0)))
- S BGPTAPRO=$$LASTPRCI^BGP1UTL1(DFN,"99.10",$P($P(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP)) I BGPTAPRO S BGPTAPRO=$$DATE^BGP1UTL($P(BGPTAPRO,U,3))_" ["_$P(BGPTAPRO,U,2)_"] "_$$VAL^XBDIQ1(9000010.08,$P(BGPTAPRO,U,5),.04)
- D WFIB^BGP1CPU2
- Q:BGPQUIT
- D ALLALG1^BGP1CU1(DFN,DT,$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
- D WALLALG^BGP1CPU
- Q:BGPQUIT
- K BGPDATA
- D ALLALGA1^BGP1CU1(DFN,DT,.BGPDATA)
- D WALLALGT^BGP1CPU
- K BGPDATA
- D IVUD^BGP1CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP),,.BGPDATA)
- D WIVUD^BGP1CPU
- Q
- ;
- TRANSIN ;
- I $Y>(BGPIOSL-4) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
- 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^BGP1CP Q:BGPQUIT D L1H^BGP1CP
- 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
- ;
- BGP1CP2 ; IHS/CMI/LAB - IHS gpra print 02 Nov 2009 10:40 AM ;
- +1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
- +2 ;
- +3 ;
- AMI5W ;EP
- +1 IF $Y>(BGPIOSL-3)
- DO HDR^BGP1CP
- IF BGPQUIT
- QUIT
- DO L1H^BGP1CP
- +2 DO WDOD^BGP1CPU(DFN)
- +3 IF BGPQUIT
- QUIT
- +4 DO WDT^BGP1CPU(BGPVINP)
- +5 IF BGPQUIT
- QUIT
- +6 IF $$TRANS^BGP1CU(BGPVINP)
- DO WTT^BGP1CPU(BGPVINP)
- +7 IF BGPQUIT
- QUIT
- +8 IF $$TRANS^BGP1CU(BGPVINP)
- DO TRANSN
- IF BGPQUIT
- QUIT
- +9 DO WPPDPOV^BGP1CPU(BGPVSIT)
- +10 IF BGPQUIT
- QUIT
- +11 DO OTHDPOVS^BGP1CPU(BGPVSIT)
- +12 IF BGPQUIT
- QUIT
- +13 SET X=$$COMFORT^BGP1CU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."))
- +14 DO WCOMFORT^BGP1CPU(X)
- +15 IF BGPQUIT
- QUIT
- +16 KILL Z
- +17 SET X=$$BETAALEG^BGP1CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
- +18 IF X
- SET X=$PIECE(X,U,2)
- +19 DO WBETAAL^BGP1CPU
- +20 IF BGPQUIT
- QUIT
- +21 KILL BGPBRADY
- +22 DO ALLDXS^BGP1CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGPBRADY,0,"BGP CMS BRADYCARDIA DXS")
- +23 ;on active med for beta blocker?
- +24 KILL BGPBETA
- +25 DO BETARX^BGP1CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-180),$$DSCH^BGP1CU(BGPVINP),1,.BGPBETA)
- +26 DO WBRADY5^BGP1CPU2
- +27 IF BGPQUIT
- QUIT
- +28 KILL BGPDATA
- +29 KILL BGP23RD
- +30 DO ALLDXS^BGP1CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGP23RD,0,"BGP CMS 2/3 HEART BLOCK DXS")
- +31 SET BGPPACE=$$PACE^BGP1CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
- +32 DO W23RD^BGP1CPU2
- +33 KILL BGPY
- +34 DO NMIDRUG^BGP1CU1(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,"BGP CMS BETA BLOCKER MEDS",0)
- +35 SET E=+$$CODEN^ICPTCOD("G8011")
- +36 SET Z=$$CPTI^BGP1DU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),E)
- IF Z]""
- SET Z=$$DATE^BGP1UTL($PIECE(Z,U,2))_" [G8011]"
- +37 DO WNMIBETA^BGP1CPU
- +38 IF BGPQUIT
- QUIT
- +39 SET X=$$LASTMED^BGP1CU1(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^BGP1DU(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^BGP1UTL($PIECE(Z,U,2))_" [G8009]"
- +42 DO WLASTBB^BGP1CPU
- +43 IF BGPQUIT
- QUIT
- +44 DO ALLALG1^BGP1CU1(DFN,DT,$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
- +45 DO WALLALG^BGP1CPU
- +46 IF BGPQUIT
- QUIT
- +47 KILL BGPDATA
- +48 DO ALLALGA1^BGP1CU1(DFN,DT,.BGPDATA)
- +49 DO WALLALGT^BGP1CPU
- +50 KILL BGPDATA
- +51 DO IVUD^BGP1CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP),,.BGPDATA)
- +52 DO WIVUD^BGP1CPU
- +53 QUIT
- +54 ;
- AMI5 ;EP
- +1 IF $Y>(BGPIOSL-3)
- DO HDR^BGP1CP
- IF BGPQUIT
- QUIT
- DO L1H^BGP1CP
- +2 DO WDT^BGP1CPU(BGPVINP)
- +3 IF BGPQUIT
- QUIT
- +4 IF $$TRANS^BGP1CU(BGPVINP)
- DO WTT^BGP1CPU(BGPVINP)
- +5 IF BGPQUIT
- QUIT
- +6 IF $$TRANS^BGP1CU(BGPVINP)
- DO TRANSN
- IF BGPQUIT
- QUIT
- +7 DO WPPDPOV^BGP1CPU(BGPVSIT)
- +8 IF BGPQUIT
- QUIT
- +9 DO OTHDPOVS^BGP1CPU(BGPVSIT)
- +10 IF BGPQUIT
- QUIT
- +11 SET X=$$COMFORT^BGP1CU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."))
- +12 DO WCOMFORT^BGP1CPU(X)
- +13 IF BGPQUIT
- QUIT
- +14 KILL BGPBRADY
- +15 DO ALLDXS^BGP1CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGPBRADY,0,"BGP CMS BRADYCARDIA DXS")
- +16 ;on active med for beta blocker?
- +17 KILL BGPBETA
- +18 DO BETARX^BGP1CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-180),$$DSCH^BGP1CU(BGPVINP),1,.BGPBETA)
- +19 DO WBRADY5^BGP1CPU2
- +20 IF BGPQUIT
- QUIT
- +21 KILL BGPDATA
- +22 KILL BGP23RD
- +23 DO ALLDXS^BGP1CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGP23RD,0,"BGP CMS 2/3 HEART BLOCK DXS")
- +24 SET BGPPACE=$$PACE^BGP1CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
- +25 DO W23RD^BGP1CPU2
- +26 KILL BGPY
- +27 DO NMIDRUG^BGP1CU1(DFN,$$VD^APCLV(BGPVSIT),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,"BGP CMS BETA BLOCKER MEDS",0)
- +28 SET E=+$$CODEN^ICPTCOD("G8011")
- +29 SET Z=$$CPTI^BGP1DU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),E)
- IF Z]""
- SET Z=$$DATE^BGP1UTL($PIECE(Z,U,2))_" [G8011]"
- +30 DO WNMIBETA^BGP1CPU
- +31 IF BGPQUIT
- QUIT
- +32 SET X=$$LASTMED^BGP1CU1(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^BGP1DU(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^BGP1UTL($PIECE(Z,U,2))_" [G8009]"
- +35 DO WLASTBB^BGP1CPU
- +36 IF BGPQUIT
- QUIT
- +37 DO ALLALG1^BGP1CU1(DFN,DT,$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
- +38 DO WALLALG^BGP1CPU
- +39 IF BGPQUIT
- QUIT
- +40 KILL BGPDATA
- +41 DO ALLALGA1^BGP1CU1(DFN,DT,.BGPDATA)
- +42 DO WALLALGT^BGP1CPU
- +43 KILL BGPDATA
- +44 DO IVUD^BGP1CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP),,.BGPDATA)
- +45 DO WIVUD^BGP1CPU
- +46 QUIT
- +47 ;
- AMI6 ;EP
- +1 IF $Y>(BGPIOSL-3)
- DO HDR^BGP1CP
- IF BGPQUIT
- QUIT
- DO L1H^BGP1CP
- +2 IF $$TRANSIN^BGP1CU(BGPVINP)
- DO TRANSIN
- IF BGPQUIT
- QUIT
- +3 DO WDT^BGP1CPU(BGPVINP)
- +4 IF BGPQUIT
- QUIT
- +5 IF $$TRANS^BGP1CU(BGPVINP)
- DO WTT^BGP1CPU(BGPVINP)
- +6 IF BGPQUIT
- QUIT
- +7 IF $$TRANS^BGP1CU(BGPVINP)
- DO TRANSN
- IF BGPQUIT
- QUIT
- +8 DO WPPDPOV^BGP1CPU(BGPVSIT)
- +9 IF BGPQUIT
- QUIT
- +10 DO OTHDPOVS^BGP1CPU(BGPVSIT)
- +11 IF BGPQUIT
- QUIT
- +12 SET X=$$COMFORT^BGP1CU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."))
- +13 DO WCOMFORT^BGP1CPU(X)
- +14 IF BGPQUIT
- QUIT
- +15 KILL BGPBRADY
- +16 DO ALLDXS^BGP1CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGPBRADY,0,"BGP CMS BRADYCARDIA DXS")
- +17 ;on active med for beta blocker?
- +18 KILL BGPBETA
- +19 DO BETARX^BGP1CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-180),$$DSCH^BGP1CU(BGPVINP),1,.BGPBETA)
- +20 SET BGPASTER=1
- DO WBRADY6^BGP1CPU2
- SET BGPASTER=0
- +21 IF BGPQUIT
- QUIT
- +22 KILL BGPDATA
- A6WHF1 ;
- +1 DO ALLDXS^BGP1CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0,"BGP CMS HEART FAILURE DXS")
- +2 DO WHF^BGP1CPU2
- +3 KILL BGPDATA
- +4 IF BGPQUIT
- QUIT
- +5 KILL BGP23RD
- +6 DO ALLDXS^BGP1CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGP23RD,0,"BGP CMS 2/3 HEART BLOCK DXS")
- +7 SET BGPPACE=$$PACE^BGP1CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
- +8 DO W23RD^BGP1CPU2
- +9 KILL BGPY
- +10 IF BGPQUIT
- QUIT
- +11 KILL BGPDATA
- +12 DO ALLDXS^BGP1CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0,"BGP CMS CIRCULATORY SHOCK DXS")
- +13 DO WCS^BGP1CPU2
- +14 KILL BGPDATA
- +15 IF BGPQUIT
- QUIT
- +16 KILL BGPY
- +17 DO NMIDRUG^BGP1CU1(DFN,$$VD^APCLV(BGPVSIT),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,"BGP CMS BETA BLOCKER MEDS",0)
- +18 SET E=+$$CODEN^ICPTCOD("G8011")
- +19 SET Z=$$CPTI^BGP1DU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),E)
- IF Z]""
- SET Z=$$DATE^BGP1UTL($PIECE(Z,U,2))_" [G8011]"
- +20 DO WNMIBETA^BGP1CPU
- +21 IF BGPQUIT
- QUIT
- +22 SET X=$$LASTMED^BGP1CU1(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^BGP1DU(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^BGP1UTL($PIECE(Z,U,2))_" [G8009]"
- +25 DO WLASTBB^BGP1CPU
- +26 IF BGPQUIT
- QUIT
- +27 DO ALLALG1^BGP1CU1(DFN,DT,$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
- +28 DO WALLALG^BGP1CPU
- +29 IF BGPQUIT
- QUIT
- +30 KILL BGPDATA
- +31 DO ALLALGA1^BGP1CU1(DFN,DT,.BGPDATA)
- +32 DO WALLALGT^BGP1CPU
- +33 KILL BGPDATA
- +34 DO IVUD^BGP1CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP),,.BGPDATA)
- +35 DO WIVUD^BGP1CPU
- +36 QUIT
- +37 ;
- AMI6W ;EP
- +1 SET BGPASTER=0
- +2 IF $Y>(BGPIOSL-3)
- DO HDR^BGP1CP
- IF BGPQUIT
- QUIT
- DO L1H^BGP1CP
- +3 IF $$TRANSIN^BGP1CU(BGPVINP)
- DO TRANSIN
- IF BGPQUIT
- QUIT
- +4 DO WDOD^BGP1CPU(DFN)
- +5 IF BGPQUIT
- QUIT
- +6 DO WDT^BGP1CPU(BGPVINP)
- +7 IF BGPQUIT
- QUIT
- +8 IF $$TRANS^BGP1CU(BGPVINP)
- DO WTT^BGP1CPU(BGPVINP)
- +9 IF BGPQUIT
- QUIT
- +10 IF $$TRANS^BGP1CU(BGPVINP)
- DO TRANSN
- IF BGPQUIT
- QUIT
- +11 DO WPPDPOV^BGP1CPU(BGPVSIT)
- +12 IF BGPQUIT
- QUIT
- +13 DO OTHDPOVS^BGP1CPU(BGPVSIT)
- +14 IF BGPQUIT
- QUIT
- +15 SET X=$$COMFORT^BGP1CU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."))
- +16 DO WCOMFORT^BGP1CPU(X)
- +17 IF BGPQUIT
- QUIT
- +18 SET X=$$BETAALEG^BGP1CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
- +19 IF X
- SET X=$PIECE(X,U,2)
- +20 DO WBETAAL^BGP1CPU
- +21 IF BGPQUIT
- QUIT
- +22 KILL BGPBRADY
- +23 DO ALLDXS^BGP1CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGPBRADY,0,"BGP CMS BRADYCARDIA DXS")
- +24 ;on active med for beta blocker?
- +25 KILL BGPBETA
- +26 DO BETARX^BGP1CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-180),$$DSCH^BGP1CU(BGPVINP),1,.BGPBETA)
- +27 SET BGPASTER=1
- DO WBRADY6^BGP1CPU2
- SET BGPASTER=0
- +28 IF BGPQUIT
- QUIT
- +29 KILL BGPDATA
- A6WHF ;
- +1 DO ALLDXS^BGP1CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0,"BGP CMS HEART FAILURE DXS")
- +2 DO WHF^BGP1CPU2
- +3 KILL BGPDATA
- +4 IF BGPQUIT
- QUIT
- +5 KILL BGP23RD
- +6 DO ALLDXS^BGP1CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGP23RD,0,"BGP CMS 2/3 HEART BLOCK DXS")
- +7 SET BGPPACE=$$PACE^BGP1CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
- +8 DO W23RD^BGP1CPU2
- +9 KILL BGPY
- +10 IF BGPQUIT
- QUIT
- +11 KILL BGPDATA
- +12 DO ALLDXS^BGP1CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0,"BGP CMS CIRCULATORY SHOCK DXS")
- +13 DO WCS^BGP1CPU2
- +14 KILL BGPDATA
- +15 IF BGPQUIT
- QUIT
- +16 DO NMIDRUG^BGP1CU1(DFN,$$VD^APCLV(BGPVSIT),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,"BGP CMS BETA BLOCKER MEDS",0)
- +17 SET E=+$$CODEN^ICPTCOD("G8011")
- +18 SET Z=$$CPTI^BGP1DU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),E)
- IF Z]""
- SET Z=$$DATE^BGP1UTL($PIECE(Z,U,2))_" [G8011]"
- +19 DO WNMIBETA^BGP1CPU
- +20 IF BGPQUIT
- QUIT
- +21 SET X=$$LASTMED^BGP1CU1(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^BGP1DU(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^BGP1UTL($PIECE(Z,U,2))_" [G8009]"
- +24 DO WLASTBB^BGP1CPU
- +25 IF BGPQUIT
- QUIT
- +26 DO ALLALG1^BGP1CU1(DFN,DT,$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
- +27 DO WALLALG^BGP1CPU
- +28 IF BGPQUIT
- QUIT
- +29 KILL BGPDATA
- +30 DO ALLALGA1^BGP1CU1(DFN,DT,.BGPDATA)
- +31 DO WALLALGT^BGP1CPU
- +32 KILL BGPDATA
- +33 DO IVUD^BGP1CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP),,.BGPDATA)
- +34 DO WIVUD^BGP1CPU
- +35 QUIT
- +36 ;
- AMI7AW ;EP
- +1 SET BGPASTER=0
- +2 IF $Y>(BGPIOSL-3)
- DO HDR^BGP1CP
- IF BGPQUIT
- QUIT
- DO L1H^BGP1CP
- +3 IF $$TRANSIN^BGP1CU(BGPVINP)
- DO TRANSIN
- IF BGPQUIT
- QUIT
- +4 DO WDT^BGP1CPU(BGPVINP)
- +5 IF BGPQUIT
- QUIT
- +6 IF $$TRANS^BGP1CU(BGPVINP)
- DO WTT^BGP1CPU(BGPVINP)
- +7 IF BGPQUIT
- QUIT
- +8 IF $$TRANS^BGP1CU(BGPVINP)
- DO TRANSN
- IF BGPQUIT
- QUIT
- +9 DO WPPDPOV^BGP1CPU(BGPVSIT)
- +10 IF BGPQUIT
- QUIT
- +11 DO OTHDPOVS^BGP1CPU(BGPVSIT)
- +12 IF BGPQUIT
- QUIT
- +13 SET X=$$COMFORT^BGP1CU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."))
- +14 DO WCOMFORT^BGP1CPU(X)
- +15 IF BGPQUIT
- QUIT
- +16 KILL BGPST1
- +17 SET BGPST1=$$LASTDX^BGP1UTL1(DFN,"BGP ST ELEVATION DX",$$FMADD^XLFDT($PIECE($PIECE(BGPVSIT0,U),"."),-1),$$DSCH^BGP1CU(BGPVINP))
- +18 IF BGPST1
- SET BGPST1=$$DATE^BGP1UTL($PIECE(BGPST1,U,3))_" ["_$PIECE(BGPST1,U,2)_"] "_$$VAL^XBDIQ1(9000010.07,$PIECE(BGPST1,U,5),.04)
- +19 DO WST^BGP1CPU2
- +20 ;LBBB ON ECG
- +21 KILL BGPLBPC,BGPLBDX
- +22 SET BGPLBDX=$$LBBBDX^BGP1CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(BGPVSIT0,U),"."),-1),$$DSCH^BGP1CU(BGPVINP))
- IF BGPLBDX
- SET BGPLBDX=$$DATE^BGP1UTL($PIECE(BGPLBDX,U,3))_" ["_$PIECE(BGPLBDX,U,2)_"] "_$$VAL^XBDIQ1(9000010.07,$PIECE(BGPLBDX,U,5),.04)
- +23 DO LBBBPROC^BGP1CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(BGPVSIT0,U),"."),-1),$$DSCH^BGP1CU(BGPVINP),.BGPLBPC)
- +24 DO WLBBB^BGP1CPU2
- +25 ;FIB MEDS
- +26 SET BGPFIB=""
- +27 KILL BGPDATA
- +28 DO TARX^BGP1CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($$DSCH^BGP1CU(BGPVINP),30),0,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),.BGPDATA)
- +29 KILL BGPUD
- +30 DO IVUD^BGP1CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP),$ORDER(^ATXAX("B","BGP CMS THROMBOLYTIC MEDS",0)),.BGPUD,"",$ORDER(^ATXAX("B","BGP THROMBOLYTIC AGENTS CLASS",0)))
- +31 SET BGPTAPRO=$$LASTPRCI^BGP1UTL1(DFN,"99.10",$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP))
- IF BGPTAPRO
- SET BGPTAPRO=$$DATE^BGP1UTL($PIECE(BGPTAPRO,U,3))_" ["_$PIECE(BGPTAPRO,U,2)_"] "_$$VAL^XBDIQ1(9000010.08,$PIECE(BGPTAPRO,U,5),.04)
- +32 DO WFIB^BGP1CPU2
- +33 IF BGPQUIT
- QUIT
- +34 DO ALLALG1^BGP1CU1(DFN,DT,$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
- +35 DO WALLALG^BGP1CPU
- +36 IF BGPQUIT
- QUIT
- +37 KILL BGPDATA
- +38 DO ALLALGA1^BGP1CU1(DFN,DT,.BGPDATA)
- +39 DO WALLALGT^BGP1CPU
- +40 KILL BGPDATA
- +41 DO IVUD^BGP1CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP),,.BGPDATA)
- +42 DO WIVUD^BGP1CPU
- +43 QUIT
- +44 ;
- TRANSIN ;
- +1 IF $Y>(BGPIOSL-4)
- DO HDR^BGP1CP
- IF BGPQUIT
- QUIT
- DO L1H^BGP1CP
- +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^BGP1CP
- IF BGPQUIT
- QUIT
- DO L1H^BGP1CP
- +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 ;