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