BGP1CP4 ; IHS/CMI/LAB - IHS gpra print 01 Nov 2009 4:08 PM ;
;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
;
;
HFALL ;EP
;I $Y>(BGPIOSL-3) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
;S BGPNOBA=1
;D WDT^BGP1CPU2(BGPVINP)
;Q:BGPQUIT
;I $$TRANS^BGP1CU(BGPVINP) D WTT^BGP1CPU2(BGPVINP) Q:BGPQUIT
;D WPPDPOV^BGP1CPU(BGPVSIT)
;K BGPNOBA
I $Y>(BGPIOSL-3) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
S BGPNOBA=1
D WRACE^BGP1CPU(DFN)
Q:BGPQUIT
D WDOB^BGP1CPU(DFN)
Q:BGPQUIT
D WZIP^BGP1CPU(DFN)
Q:BGPQUIT
D WINS^BGP1CPU(BGPVSIT,DFN)
Q:BGPQUIT
D WADM^BGP1CPU(BGPVINP)
Q:BGPQUIT
D WADM92^BGP1CPU(BGPVINP)
Q:BGPQUIT
D WADMS92^BGP1CPU(BGPVINP)
Q:BGPQUIT
D WDT^BGP1CPU(BGPVINP)
Q:BGPQUIT
D WDSGS92^BGP1CPU(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP1CU(BGPVINP) D WTT^BGP1CPU(BGPVINP) Q:BGPQUIT
K BGPNOBA
D WPPDPOV^BGP1CPU(BGPVSIT)
Q:BGPQUIT
S BGPNOBA=1
D OTHDPOVS^BGP1CPU(BGPVSIT)
Q:BGPQUIT
D WPRINPRO^BGP1CPU2
Q:BGPQUIT
D WOTHPROS^BGP1CPU2
K BGPNOBA
Q
;
HF1 ;EP
I $Y>(BGPIOSL-3) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
D WDT^BGP1CPU2(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP1CU(BGPVINP) D WTT^BGP1CPU2(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP1CU(BGPVINP) D TRANSN Q:BGPQUIT
D WPPDPOV^BGP1CPU2(BGPVSIT)
Q:BGPQUIT
D OTHDPOVS^BGP1CPU2(BGPVSIT)
Q:BGPQUIT
S X=$$COMFORT^BGP1CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
D WCOMFORT^BGP1CPU2(X)
Q:BGPQUIT
S BGPPED=$$DSCHINST^BGP1CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP))
D WDSCHINT^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
;
HF1W ;EP
I $Y>(BGPIOSL-3) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
D WDT^BGP1CPU2(BGPVINP)
Q:BGPQUIT
D WPPDPOV^BGP1CPU2(BGPVSIT)
Q:BGPQUIT
D OTHDPOVS^BGP1CPU2(BGPVSIT)
Q:BGPQUIT
S X=$$COMFORT^BGP1CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
D WCOMFORT^BGP1CPU2(X)
Q:BGPQUIT
S BGPLVAD=$$LVADEX^BGP1CU(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP)) I BGPLVAD S BGPLVAD=$$DATE^BGP1UTL($P(BGPLVAD,U,3))_" ["_$P(BGPLVAD,U,2)_"] "_$$VAL^XBDIQ1(9000010.08,$P(BGPLVAD,U,5),.04)
D WLVAD^BGP1CPU2
Q:BGPQUIT
S BGPPED=$$DSCHINST^BGP1CU(DFN,$$DSCH^BGP1CU(BGPVINP),$$DSCH^BGP1CU(BGPVINP))
D WDSCHINT^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
;
HF2 ;EP
I $Y>(BGPIOSL-3) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
D WDT^BGP1CPU2(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP1CU(BGPVINP) D WTT^BGP1CPU2(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP1CU(BGPVINP) D TRANSN Q:BGPQUIT
D WPPDPOV^BGP1CPU2(BGPVSIT)
Q:BGPQUIT
D OTHDPOVS^BGP1CPU2(BGPVSIT)
Q:BGPQUIT
S X=$$COMFORT^BGP1CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
D WCOMFORT^BGP1CPU2(X)
Q:BGPQUIT
K BGPDATA
I 'BGPEXCL D
.S BGPLVAD=$$LVADEX^BGP1CU(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP)) I BGPLVAD S BGPLVAD=$$DATE^BGP1UTL($P(BGPLVAD,U,3))_" ["_$P(BGPLVAD,U,2)_"] "_$$VAL^XBDIQ1(9000010.08,$P(BGPLVAD,U,5),.04)
.D WLVAD^BGP1CPU2
Q:BGPQUIT
D LVS^BGP1CU3(DFN,$$DSCH^BGP1CU(BGPVINP),.BGPDATA,$P($P(BGPVSIT0,U),"."))
D WLVS^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
;
HF3 ;EP
I $Y>(BGPIOSL-3) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
D WDT^BGP1CPU2(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP1CU(BGPVINP) D WTT^BGP1CPU2(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP1CU(BGPVINP) D TRANSN Q:BGPQUIT
D WPPDPOV^BGP1CPU2(BGPVSIT)
Q:BGPQUIT
D OTHDPOVS^BGP1CPU2(BGPVSIT)
Q:BGPQUIT
K BGPDATA
S BGPC=0
D LVSD^BGP1CU1(DFN,$$FMADD^XLFDT($$DSCH^BGP1CU(BGPVINP),-365),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0)
D EJECFRAC^BGP1CU1(DFN,$$FMADD^XLFDT($$DSCH^BGP1CU(BGPVINP),-365),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,BGPC)
D WLVSD^BGP1CPU
Q:BGPQUIT
K BGPDATA
S X=$$COMFORT^BGP1CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
D WCOMFORT^BGP1CPU2(X)
Q:BGPQUIT
K BGPY,BGPDATA
Q:BGPQUIT
S BGPC=0
D ALLDXS^BGP1CU2(DFN,$$FMADD^XLFDT($$DSCH^BGP1CU(BGPVINP),-365),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,BGPC,"BGP CMS AORTIC STENOSIS DXS")
I 'BGPEXCL D WAORTIC^BGP1CPU
Q:BGPQUIT
K BGPDATA,BGPDX,BGPC
S BGPXX=0
D ANGIOED^BGP1CU6(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0)
S X=0 F S X=$O(BGPDATA(X)) Q:X'=+X S BGPXX=BGPXX+1,BGPDX(BGPXX)=BGPDATA(X)
K BGPDATA D HYPERKAL^BGP1CU6(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0)
S X=0 F S X=$O(BGPDATA(X)) Q:X'=+X S BGPXX=BGPXX+1,BGPDX(BGPXX)=BGPDATA(X)
K BGPDATA D HYPOTEN^BGP1CU6(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0)
S X=0 F S X=$O(BGPDATA(X)) Q:X'=+X S BGPXX=BGPXX+1,BGPDX(BGPXX)=BGPDATA(X)
K BGPDATA D RENART^BGP1CU6(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0)
S X=0 F S X=$O(BGPDATA(X)) Q:X'=+X S BGPXX=BGPXX+1,BGPDX(BGPXX)=BGPDATA(X)
K BGPDATA D RENAL^BGP1CU6(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0)
S X=0 F S X=$O(BGPDATA(X)) Q:X'=+X S BGPXX=BGPXX+1,BGPDX(BGPXX)=BGPDATA(X)
D WDXS^BGP1CPU
K BGPDATA,BGPY
Q:BGPQUIT
S X=$$ACEALLEG^BGP1CU1(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
S Z=$$ARBALLEG^BGP1CU1(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
D WACEALEG^BGP1CPU
Q:BGPQUIT
K BGPDATA,BGPDX
S BGPC=0
D NMIDRUG^BGP1CU1(DFN,$$VD^APCLV(BGPVSIT),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,"BGP CMS ACEI MEDS",0)
D NMIDRUG^BGP1CU1(DFN,$$VD^APCLV(BGPVSIT),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,"BGP CMS ARB MEDS",BGPC)
S E=+$$CODEN^ICPTCOD("G8029")
S BGPACPT=$$CPTI^BGP1DU(DFN,$$DSCH^BGP1CU(BGPVINP),$$DSCH^BGP1CU(BGPVINP),E) I Z]"" S Z=$$DATE^BGP1UTL($P(Z,U,2))_" [G8029]"
D WNMIACE^BGP1CPU2
Q:BGPQUIT
I 'BGPEXCL D
.S BGPLVAD=$$LVADEX^BGP1CU(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP)) I BGPLVAD S BGPLVAD=$$DATE^BGP1UTL($P(BGPLVAD,U,3))_" ["_$P(BGPLVAD,U,2)_"] "_$$VAL^XBDIQ1(9000010.08,$P(BGPLVAD,U,5),.04)
.D WLVAD^BGP1CPU2
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 ACEI MEDS","","BGP CMS ACEI MEDS CLASS")
S Z=$$LASTMED^BGP1CU1(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($P($P(^AUPNVINP(BGPVINP,0),U),"."),30),"BGP CMS ARB MEDS","","BGP CMS ARB MEDS CLASS")
D WLASTACE^BGP1CPU
Q:BGPQUIT
K BGPDATA
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
;
HF4 ;
I $Y>(BGPIOSL-3) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
D WDT^BGP1CPU2(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP1CU(BGPVINP) D WTT^BGP1CPU2(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP1CU(BGPVINP) D TRANSN Q:BGPQUIT
D WPPDPOV^BGP1CPU2(BGPVSIT)
Q:BGPQUIT
D OTHDPOVS^BGP1CPU2(BGPVSIT)
Q:BGPQUIT
S X=$$COMFORT^BGP1CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
D WCOMFORT^BGP1CPU2(X)
Q:BGPQUIT
I 'BGPEXCL D
.S BGPLVAD=$$LVADEX^BGP1CU(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP)) I BGPLVAD S BGPLVAD=$$DATE^BGP1UTL($P(BGPLVAD,U,3))_" ["_$P(BGPLVAD,U,2)_"] "_$$VAL^XBDIQ1(9000010.08,$P(BGPLVAD,U,5),.04)
.D WLVAD^BGP1CPU2
Q:BGPQUIT
K BGPDATA
S BGPC=0
D SMOKER^BGP1CU2(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
D WSMOKER^BGP1CPU
Q:BGPQUIT
K BGPDATA
D CESS^BGP1CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
D WCESS^BGP1CPU
Q:BGPQUIT
K BGPDATA
D CESSMEDS^BGP1CU2(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($$DSCH^BGP1CU(BGPVINP),30),.BGPDATA)
D WCESSMED^BGP1CPU
K BGPDATA
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
Q:BGPQUIT
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 ;
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
;
BGP1CP4 ; IHS/CMI/LAB - IHS gpra print 01 Nov 2009 4:08 PM ;
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
+2 ;
+3 ;
HFALL ;EP
+1 ;I $Y>(BGPIOSL-3) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
+2 ;S BGPNOBA=1
+3 ;D WDT^BGP1CPU2(BGPVINP)
+4 ;Q:BGPQUIT
+5 ;I $$TRANS^BGP1CU(BGPVINP) D WTT^BGP1CPU2(BGPVINP) Q:BGPQUIT
+6 ;D WPPDPOV^BGP1CPU(BGPVSIT)
+7 ;K BGPNOBA
+8 IF $Y>(BGPIOSL-3)
DO HDR^BGP1CP
IF BGPQUIT
QUIT
DO L1H^BGP1CP
+9 SET BGPNOBA=1
+10 DO WRACE^BGP1CPU(DFN)
+11 IF BGPQUIT
QUIT
+12 DO WDOB^BGP1CPU(DFN)
+13 IF BGPQUIT
QUIT
+14 DO WZIP^BGP1CPU(DFN)
+15 IF BGPQUIT
QUIT
+16 DO WINS^BGP1CPU(BGPVSIT,DFN)
+17 IF BGPQUIT
QUIT
+18 DO WADM^BGP1CPU(BGPVINP)
+19 IF BGPQUIT
QUIT
+20 DO WADM92^BGP1CPU(BGPVINP)
+21 IF BGPQUIT
QUIT
+22 DO WADMS92^BGP1CPU(BGPVINP)
+23 IF BGPQUIT
QUIT
+24 DO WDT^BGP1CPU(BGPVINP)
+25 IF BGPQUIT
QUIT
+26 DO WDSGS92^BGP1CPU(BGPVINP)
+27 IF BGPQUIT
QUIT
+28 IF $$TRANS^BGP1CU(BGPVINP)
DO WTT^BGP1CPU(BGPVINP)
IF BGPQUIT
QUIT
+29 KILL BGPNOBA
+30 DO WPPDPOV^BGP1CPU(BGPVSIT)
+31 IF BGPQUIT
QUIT
+32 SET BGPNOBA=1
+33 DO OTHDPOVS^BGP1CPU(BGPVSIT)
+34 IF BGPQUIT
QUIT
+35 DO WPRINPRO^BGP1CPU2
+36 IF BGPQUIT
QUIT
+37 DO WOTHPROS^BGP1CPU2
+38 KILL BGPNOBA
+39 QUIT
+40 ;
HF1 ;EP
+1 IF $Y>(BGPIOSL-3)
DO HDR^BGP1CP
IF BGPQUIT
QUIT
DO L1H^BGP1CP
+2 DO WDT^BGP1CPU2(BGPVINP)
+3 IF BGPQUIT
QUIT
+4 IF $$TRANS^BGP1CU(BGPVINP)
DO WTT^BGP1CPU2(BGPVINP)
+5 IF BGPQUIT
QUIT
+6 IF $$TRANS^BGP1CU(BGPVINP)
DO TRANSN
IF BGPQUIT
QUIT
+7 DO WPPDPOV^BGP1CPU2(BGPVSIT)
+8 IF BGPQUIT
QUIT
+9 DO OTHDPOVS^BGP1CPU2(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^BGP1CPU2(X)
+13 IF BGPQUIT
QUIT
+14 SET BGPPED=$$DSCHINST^BGP1CU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP))
+15 DO WDSCHINT^BGP1CPU2
+16 IF BGPQUIT
QUIT
+17 DO ALLALG1^BGP1CU1(DFN,DT,$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
+18 DO WALLALG^BGP1CPU
+19 IF BGPQUIT
QUIT
+20 KILL BGPDATA
+21 DO ALLALGA1^BGP1CU1(DFN,DT,.BGPDATA)
+22 DO WALLALGT^BGP1CPU
+23 KILL BGPDATA
+24 DO IVUD^BGP1CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP),,.BGPDATA)
+25 DO WIVUD^BGP1CPU
+26 QUIT
+27 ;
HF1W ;EP
+1 IF $Y>(BGPIOSL-3)
DO HDR^BGP1CP
IF BGPQUIT
QUIT
DO L1H^BGP1CP
+2 DO WDT^BGP1CPU2(BGPVINP)
+3 IF BGPQUIT
QUIT
+4 DO WPPDPOV^BGP1CPU2(BGPVSIT)
+5 IF BGPQUIT
QUIT
+6 DO OTHDPOVS^BGP1CPU2(BGPVSIT)
+7 IF BGPQUIT
QUIT
+8 SET X=$$COMFORT^BGP1CU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."))
+9 DO WCOMFORT^BGP1CPU2(X)
+10 IF BGPQUIT
QUIT
+11 SET BGPLVAD=$$LVADEX^BGP1CU(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP))
IF BGPLVAD
SET BGPLVAD=$$DATE^BGP1UTL($PIECE(BGPLVAD,U,3))_" ["_$PIECE(BGPLVAD,U,2)_"] "_$$VAL^XBDIQ1(9000010.08,$PIECE(BGPLVAD,U,5),.04)
+12 DO WLVAD^BGP1CPU2
+13 IF BGPQUIT
QUIT
+14 SET BGPPED=$$DSCHINST^BGP1CU(DFN,$$DSCH^BGP1CU(BGPVINP),$$DSCH^BGP1CU(BGPVINP))
+15 DO WDSCHINT^BGP1CPU2
+16 IF BGPQUIT
QUIT
+17 DO ALLALG1^BGP1CU1(DFN,DT,$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
+18 DO WALLALG^BGP1CPU
+19 IF BGPQUIT
QUIT
+20 KILL BGPDATA
+21 DO ALLALGA1^BGP1CU1(DFN,DT,.BGPDATA)
+22 DO WALLALGT^BGP1CPU
+23 KILL BGPDATA
+24 DO IVUD^BGP1CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP),,.BGPDATA)
+25 DO WIVUD^BGP1CPU
+26 QUIT
+27 ;
HF2 ;EP
+1 IF $Y>(BGPIOSL-3)
DO HDR^BGP1CP
IF BGPQUIT
QUIT
DO L1H^BGP1CP
+2 DO WDT^BGP1CPU2(BGPVINP)
+3 IF BGPQUIT
QUIT
+4 IF $$TRANS^BGP1CU(BGPVINP)
DO WTT^BGP1CPU2(BGPVINP)
+5 IF BGPQUIT
QUIT
+6 IF $$TRANS^BGP1CU(BGPVINP)
DO TRANSN
IF BGPQUIT
QUIT
+7 DO WPPDPOV^BGP1CPU2(BGPVSIT)
+8 IF BGPQUIT
QUIT
+9 DO OTHDPOVS^BGP1CPU2(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^BGP1CPU2(X)
+13 IF BGPQUIT
QUIT
+14 KILL BGPDATA
+15 IF 'BGPEXCL
Begin DoDot:1
+16 SET BGPLVAD=$$LVADEX^BGP1CU(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP))
IF BGPLVAD
SET BGPLVAD=$$DATE^BGP1UTL($PIECE(BGPLVAD,U,3))_" ["_$PIECE(BGPLVAD,U,2)_"] "_$$VAL^XBDIQ1(9000010.08,$PIECE(BGPLVAD,U,5),.04)
+17 DO WLVAD^BGP1CPU2
End DoDot:1
+18 IF BGPQUIT
QUIT
+19 DO LVS^BGP1CU3(DFN,$$DSCH^BGP1CU(BGPVINP),.BGPDATA,$PIECE($PIECE(BGPVSIT0,U),"."))
+20 DO WLVS^BGP1CPU2
+21 IF BGPQUIT
QUIT
+22 DO ALLALG1^BGP1CU1(DFN,DT,$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
+23 DO WALLALG^BGP1CPU
+24 IF BGPQUIT
QUIT
+25 KILL BGPDATA
+26 DO ALLALGA1^BGP1CU1(DFN,DT,.BGPDATA)
+27 DO WALLALGT^BGP1CPU
+28 KILL BGPDATA
+29 DO IVUD^BGP1CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP),,.BGPDATA)
+30 DO WIVUD^BGP1CPU
+31 QUIT
+32 ;
HF3 ;EP
+1 IF $Y>(BGPIOSL-3)
DO HDR^BGP1CP
IF BGPQUIT
QUIT
DO L1H^BGP1CP
+2 DO WDT^BGP1CPU2(BGPVINP)
+3 IF BGPQUIT
QUIT
+4 IF $$TRANS^BGP1CU(BGPVINP)
DO WTT^BGP1CPU2(BGPVINP)
+5 IF BGPQUIT
QUIT
+6 IF $$TRANS^BGP1CU(BGPVINP)
DO TRANSN
IF BGPQUIT
QUIT
+7 DO WPPDPOV^BGP1CPU2(BGPVSIT)
+8 IF BGPQUIT
QUIT
+9 DO OTHDPOVS^BGP1CPU2(BGPVSIT)
+10 IF BGPQUIT
QUIT
+11 KILL BGPDATA
+12 SET BGPC=0
+13 DO LVSD^BGP1CU1(DFN,$$FMADD^XLFDT($$DSCH^BGP1CU(BGPVINP),-365),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0)
+14 DO EJECFRAC^BGP1CU1(DFN,$$FMADD^XLFDT($$DSCH^BGP1CU(BGPVINP),-365),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,BGPC)
+15 DO WLVSD^BGP1CPU
+16 IF BGPQUIT
QUIT
+17 KILL BGPDATA
+18 SET X=$$COMFORT^BGP1CU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."))
+19 DO WCOMFORT^BGP1CPU2(X)
+20 IF BGPQUIT
QUIT
+21 KILL BGPY,BGPDATA
+22 IF BGPQUIT
QUIT
+23 SET BGPC=0
+24 DO ALLDXS^BGP1CU2(DFN,$$FMADD^XLFDT($$DSCH^BGP1CU(BGPVINP),-365),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,BGPC,"BGP CMS AORTIC STENOSIS DXS")
+25 IF 'BGPEXCL
DO WAORTIC^BGP1CPU
+26 IF BGPQUIT
QUIT
+27 KILL BGPDATA,BGPDX,BGPC
+28 SET BGPXX=0
+29 DO ANGIOED^BGP1CU6(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0)
+30 SET X=0
FOR
SET X=$ORDER(BGPDATA(X))
IF X'=+X
QUIT
SET BGPXX=BGPXX+1
SET BGPDX(BGPXX)=BGPDATA(X)
+31 KILL BGPDATA
DO HYPERKAL^BGP1CU6(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0)
+32 SET X=0
FOR
SET X=$ORDER(BGPDATA(X))
IF X'=+X
QUIT
SET BGPXX=BGPXX+1
SET BGPDX(BGPXX)=BGPDATA(X)
+33 KILL BGPDATA
DO HYPOTEN^BGP1CU6(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0)
+34 SET X=0
FOR
SET X=$ORDER(BGPDATA(X))
IF X'=+X
QUIT
SET BGPXX=BGPXX+1
SET BGPDX(BGPXX)=BGPDATA(X)
+35 KILL BGPDATA
DO RENART^BGP1CU6(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0)
+36 SET X=0
FOR
SET X=$ORDER(BGPDATA(X))
IF X'=+X
QUIT
SET BGPXX=BGPXX+1
SET BGPDX(BGPXX)=BGPDATA(X)
+37 KILL BGPDATA
DO RENAL^BGP1CU6(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0)
+38 SET X=0
FOR
SET X=$ORDER(BGPDATA(X))
IF X'=+X
QUIT
SET BGPXX=BGPXX+1
SET BGPDX(BGPXX)=BGPDATA(X)
+39 DO WDXS^BGP1CPU
+40 KILL BGPDATA,BGPY
+41 IF BGPQUIT
QUIT
+42 SET X=$$ACEALLEG^BGP1CU1(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
+43 SET Z=$$ARBALLEG^BGP1CU1(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
+44 DO WACEALEG^BGP1CPU
+45 IF BGPQUIT
QUIT
+46 KILL BGPDATA,BGPDX
+47 SET BGPC=0
+48 DO NMIDRUG^BGP1CU1(DFN,$$VD^APCLV(BGPVSIT),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,"BGP CMS ACEI MEDS",0)
+49 DO NMIDRUG^BGP1CU1(DFN,$$VD^APCLV(BGPVSIT),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,"BGP CMS ARB MEDS",BGPC)
+50 SET E=+$$CODEN^ICPTCOD("G8029")
+51 SET BGPACPT=$$CPTI^BGP1DU(DFN,$$DSCH^BGP1CU(BGPVINP),$$DSCH^BGP1CU(BGPVINP),E)
IF Z]""
SET Z=$$DATE^BGP1UTL($PIECE(Z,U,2))_" [G8029]"
+52 DO WNMIACE^BGP1CPU2
+53 IF BGPQUIT
QUIT
+54 IF 'BGPEXCL
Begin DoDot:1
+55 SET BGPLVAD=$$LVADEX^BGP1CU(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP))
IF BGPLVAD
SET BGPLVAD=$$DATE^BGP1UTL($PIECE(BGPLVAD,U,3))_" ["_$PIECE(BGPLVAD,U,2)_"] "_$$VAL^XBDIQ1(9000010.08,$PIECE(BGPLVAD,U,5),.04)
+56 DO WLVAD^BGP1CPU2
End DoDot:1
+57 IF BGPQUIT
QUIT
+58 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 ACEI MEDS","","BGP CMS ACEI MEDS CLASS")
+59 SET Z=$$LASTMED^BGP1CU1(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),30),"BGP CMS ARB MEDS","","BGP CMS ARB MEDS CLASS")
+60 DO WLASTACE^BGP1CPU
+61 IF BGPQUIT
QUIT
+62 KILL BGPDATA
+63 DO ALLALG1^BGP1CU1(DFN,DT,$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
+64 DO WALLALG^BGP1CPU
+65 IF BGPQUIT
QUIT
+66 KILL BGPDATA
+67 DO ALLALGA1^BGP1CU1(DFN,DT,.BGPDATA)
+68 DO WALLALGT^BGP1CPU
+69 KILL BGPDATA
+70 DO IVUD^BGP1CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP),,.BGPDATA)
+71 DO WIVUD^BGP1CPU
+72 QUIT
+73 ;
HF4 ;
+1 IF $Y>(BGPIOSL-3)
DO HDR^BGP1CP
IF BGPQUIT
QUIT
DO L1H^BGP1CP
+2 DO WDT^BGP1CPU2(BGPVINP)
+3 IF BGPQUIT
QUIT
+4 IF $$TRANS^BGP1CU(BGPVINP)
DO WTT^BGP1CPU2(BGPVINP)
+5 IF BGPQUIT
QUIT
+6 IF $$TRANS^BGP1CU(BGPVINP)
DO TRANSN
IF BGPQUIT
QUIT
+7 DO WPPDPOV^BGP1CPU2(BGPVSIT)
+8 IF BGPQUIT
QUIT
+9 DO OTHDPOVS^BGP1CPU2(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^BGP1CPU2(X)
+13 IF BGPQUIT
QUIT
+14 IF 'BGPEXCL
Begin DoDot:1
+15 SET BGPLVAD=$$LVADEX^BGP1CU(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP))
IF BGPLVAD
SET BGPLVAD=$$DATE^BGP1UTL($PIECE(BGPLVAD,U,3))_" ["_$PIECE(BGPLVAD,U,2)_"] "_$$VAL^XBDIQ1(9000010.08,$PIECE(BGPLVAD,U,5),.04)
+16 DO WLVAD^BGP1CPU2
End DoDot:1
+17 IF BGPQUIT
QUIT
+18 KILL BGPDATA
+19 SET BGPC=0
+20 DO SMOKER^BGP1CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
+21 DO WSMOKER^BGP1CPU
+22 IF BGPQUIT
QUIT
+23 KILL BGPDATA
+24 DO CESS^BGP1CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
+25 DO WCESS^BGP1CPU
+26 IF BGPQUIT
QUIT
+27 KILL BGPDATA
+28 DO CESSMEDS^BGP1CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($$DSCH^BGP1CU(BGPVINP),30),.BGPDATA)
+29 DO WCESSMED^BGP1CPU
+30 KILL BGPDATA
+31 IF BGPQUIT
QUIT
+32 DO ALLALG1^BGP1CU1(DFN,DT,$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
+33 DO WALLALG^BGP1CPU
+34 IF BGPQUIT
QUIT
+35 KILL BGPDATA
+36 DO ALLALGA1^BGP1CU1(DFN,DT,.BGPDATA)
+37 DO WALLALGT^BGP1CPU
+38 IF BGPQUIT
QUIT
+39 KILL BGPDATA
+40 DO IVUD^BGP1CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP),,.BGPDATA)
+41 DO WIVUD^BGP1CPU
+42 QUIT
+43 ;
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 ;
+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 ;
