BGP1CP5 ; IHS/CMI/LAB - IHS gpra print ;
;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
;
;
PNALL ;EP
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 WPNEUPOV^BGP1CPU3(BGPVSIT)
Q:BGPQUIT
S BGPNOBA=1
D OTHDPOVS^BGP1CPU(BGPVSIT)
Q:BGPQUIT
D WPRINPRO^BGP1CPU2
Q:BGPQUIT
D WOTHPROS^BGP1CPU2
K BGPNOBA
Q
;
PN1 ;EP
I $Y>(BGPIOSL-3) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
I $$TRANSIN^BGP1CU(BGPVINP) D TRANSIN Q:BGPQUIT
D WDT^BGP1CPU3(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP1CU(BGPVINP) D WTT^BGP1CPU3(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP1CU(BGPVINP),$$DODA^BGP1CU(BGPVSIT,BGPVINP) D TRANSN Q:BGPQUIT
D WPPDPOV^BGP1CPU3(BGPVSIT)
Q:BGPQUIT
D OTHDPOVS^BGP1CPU3(BGPVSIT)
Q:BGPQUIT
I 'BGPEXCL D
.S X=$$ERPNEU^BGP1CU(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$P($P(BGPVSIT0,U),"."),"BGP CMS PNEUMONIA DXS")
.D WERPNEU^BGP1CPU3
.S X=$$ADMDX^BGP1CU(BGPVINP,"BGP CMS PNEUMONIA DXS")
.D WADMDX^BGP1CPU3
Q:BGPQUIT
S X=$$COMFORT^BGP1CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
D WCOMFORT^BGP1CPU3(X)
Q:BGPQUIT
K BGPDATA,BGPSCAN
D CHESTXRY^BGP1CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA)
D CTSCAN^BGP1CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPSCAN)
D WCHEST^BGP1CPU3
Q:BGPQUIT
I 'BGPEXCL D
.S X=$$LASTDX^BGP1UTL1(DFN,"BGP CMS CYSTIC FIBROSIS DXS",$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
.D WCYSTIC^BGP1CPU3
K BGPDATA
D ABGPO^BGP1CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$$FMADD^XLFDT($$DSCH^BGP1CU(BGPVINP)),.BGPDATA)
D WABGPO^BGP1CPU3
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
;
PN2 ;EP
I $Y>(BGPIOSL-3) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
D WDT9^BGP1CPU3(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP1CU(BGPVINP) D WTT^BGP1CPU3(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP1CU(BGPVINP) D TRANSN2 Q:BGPQUIT
D WPPDPOV^BGP1CPU3(BGPVSIT)
Q:BGPQUIT
D OTHDPOVS^BGP1CPU3(BGPVSIT)
Q:BGPQUIT
S X=$$COMFORT^BGP1CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
D WCOMFORT^BGP1CPU3(X)
Q:BGPQUIT
K BGPDATA,BGPSCAN
D CHESTXRY^BGP1CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA)
D CTSCAN^BGP1CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPSCAN)
D WCHEST^BGP1CPU3
Q:BGPQUIT
I 'BGPEXCL D
.S X=$$LASTDX^BGP1UTL1(DFN,"BGP CMS CYSTIC FIBROSIS DXS",$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
.D WCYSTIC^BGP1CPU3
K BGPDATA
D PNEUVAX^BGP1CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP),$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
D WPNEUMO^BGP1CPU3
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
;
PN3B ;EP
I $Y>(BGPIOSL-3) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
I $$TRANSIN^BGP1CU(BGPVINP) D TRANSIN3 Q:BGPQUIT
I 'BGPEXCL D WDOD^BGP1CPU3(DFN)
Q:BGPQUIT
D WDT^BGP1CPU3(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP1CU(BGPVINP) D WTT^BGP1CPU3(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP1CU(BGPVINP) D TRANSN3 Q:BGPQUIT
D WPPDPOV^BGP1CPU3(BGPVSIT)
Q:BGPQUIT
D OTHDPOVS^BGP1CPU3(BGPVSIT)
Q:BGPQUIT
I 'BGPEXCL D
.S X=$$ERPNEU^BGP1CU(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$P($P(BGPVSIT0,U),"."),"BGP CMS PNEUMONIA DXS")
.D WERPNEU^BGP1CPU3
.;S X=$$ADMDX^BGP1CU(BGPVINP,"BGP CMS PNEUMONIA DXS")
.D WADMDX^BGP1CPU3
Q:BGPQUIT
S X=$$COMFORT^BGP1CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
D WCOMFORT^BGP1CPU3(X)
Q:BGPQUIT
K BGPDATA,BGPSCAN
D CHESTXRY^BGP1CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA)
D CTSCAN^BGP1CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPSCAN)
D WCHEST^BGP1CPU3
Q:BGPQUIT
I 'BGPEXCL D
.S X=$$LASTDX^BGP1UTL1(DFN,"BGP CMS CYSTIC FIBROSIS DXS",$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
.D WCYSTIC^BGP1CPU3
K BGPDATA
;antibiotic rx status?
D ANTIRX^BGP1CU3(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($P($P(^AUPNVINP(BGPVINP,0),U),"."),30),.BGPDATA)
D WANTIRX^BGP1CPU3
Q:BGPQUIT
K BGPDATA
D ERBCP^BGP1CU3(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$P($P(BGPVSIT0,U),"."),.BGPDATA)
D WERBC^BGP1CPU3
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
;
PN4 ;EP
I $Y>(BGPIOSL-3) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
I 'BGPEXCL D WDOD^BGP1CPU3(DFN)
Q:BGPQUIT
D WDT9^BGP1CPU3(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP1CU(BGPVINP) D WTT^BGP1CPU3(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP1CU(BGPVINP) D TRANSN2 Q:BGPQUIT
D WPPDPOV^BGP1CPU3(BGPVSIT)
Q:BGPQUIT
D OTHDPOVS^BGP1CPU3(BGPVSIT)
Q:BGPQUIT
S X=$$COMFORT^BGP1CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
D WCOMFORT^BGP1CPU3(X)
Q:BGPQUIT
K BGPDATA,BGPSCAN
D CHESTXRY^BGP1CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA)
D CTSCAN^BGP1CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPSCAN)
D WCHEST^BGP1CPU3
Q:BGPQUIT
I 'BGPEXCL D
.S X=$$LASTDX^BGP1UTL1(DFN,"BGP CMS CYSTIC FIBROSIS DXS",$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
.D WCYSTIC^BGP1CPU3
K BGPDATA
;antibiotic rx status?
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,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
D WCESSMED^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
;
PN5B ;EP
I $Y>(BGPIOSL-3) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
I $$TRANSIN^BGP1CU(BGPVINP) D TRANSIN Q:BGPQUIT
I 'BGPEXCL D WDOD^BGP1CPU3(DFN)
Q:BGPQUIT
D WDT^BGP1CPU3(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP1CU(BGPVINP) D WTT^BGP1CPU3(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP1CU(BGPVINP) D TRANSN Q:BGPQUIT
D WPPDPOV^BGP1CPU3(BGPVSIT)
Q:BGPQUIT
D OTHDPOVS^BGP1CPU3(BGPVSIT)
Q:BGPQUIT
I 'BGPEXCL D
.S X=$$ERPNEU^BGP1CU(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$P($P(BGPVSIT0,U),"."),"BGP CMS PNEUMONIA DXS")
.D WERPNEU^BGP1CPU3
.S X=$$ADMDX^BGP1CU(BGPVINP,"BGP CMS PNEUMONIA DXS")
.D WADMDX^BGP1CPU3
Q:BGPQUIT
S X=$$COMFORT^BGP1CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
D WCOMFORT^BGP1CPU3(X)
Q:BGPQUIT
K BGPDATA,BGPSCAN
D CHESTXRY^BGP1CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA)
D CTSCAN^BGP1CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPSCAN)
D WCHEST^BGP1CPU3
Q:BGPQUIT
;antibiotic rx status?
K BGPDATA
D ANTIRX^BGP1CU3(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($P($P(^AUPNVINP(BGPVINP,0),U),"."),30),.BGPDATA)
D WANTIRX^BGP1CPU3
Q:BGPQUIT
I 'BGPEXCL D
.S X=$$LASTDX^BGP1UTL1(DFN,"BGP CMS CYSTIC FIBROSIS DXS",$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
.D WCYSTIC^BGP1CPU3
K BGPDATA
;D ERBCP^BGP1CU3(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$P($P(BGPVSIT0,U),"."),.BGPDATA)
;D WERBC^BGP1CPU3
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
;
PN6 ;EP
I $Y>(BGPIOSL-3) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
I $$TRANSIN^BGP1CU(BGPVINP) D TRANSIN Q:BGPQUIT
I 'BGPEXCL D WDOD^BGP1CPU3(DFN)
Q:BGPQUIT
D WDT^BGP1CPU3(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP1CU(BGPVINP) D WTT^BGP1CPU3(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP1CU(BGPVINP) D TRANSN Q:BGPQUIT
D WPPDPOV^BGP1CPU3(BGPVSIT)
Q:BGPQUIT
D OTHDPOVS^BGP1CPU3(BGPVSIT)
Q:BGPQUIT
I 'BGPEXCL D
.S X=$$ERPNEU^BGP1CU(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$P($P(BGPVSIT0,U),"."),"BGP CMS PNEUMONIA DXS")
.D WERPNEU^BGP1CPU3
.S X=$$ADMDX^BGP1CU(BGPVINP,"BGP CMS PNEUMONIA DXS")
.D WADMDX^BGP1CPU3
Q:BGPQUIT
S X=$$COMFORT^BGP1CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
D WCOMFORT^BGP1CPU3(X)
Q:BGPQUIT
K BGPDATA
I 'BGPEXCL D Q:BGPQUIT
.K BGPDATA
.D EXCLCOMP^BGP1CU4(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA)
.D WEXCL1^BGP1CPU3
.Q:BGPQUIT
.S X=$$PRIORHOS^BGP1CU4(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-14),$P($P(BGPVSIT0,U),"."),BGPVSIT)
.S Y=$$HOS2DAYS^BGP1CU4(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-90),$P($P(BGPVSIT0,U),"."))
.D WPRIORHO^BGP1CPU3
.Q:BGPQUIT
.S X=$$NURSHOME^BGP1CU4(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-90),$P($P(BGPVSIT0,U),"."))
.D WNURSHOM^BGP1CPU3
.Q:BGPQUIT
.S X=$$WOUNDCAR^BGP1CU4(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-30),$P($P(BGPVSIT0,U),"."))
.D WWOUND^BGP1CPU3
K BGPDATA,BGPSCAN
D CHESTXRY^BGP1CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA)
D CTSCAN^BGP1CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPSCAN)
D WCHEST^BGP1CPU3
Q:BGPQUIT
S X=$$ADMDX^BGP1CU(BGPVINP,"BGP CMS OTHER INFECTION DXS")
D WOTHINF^BGP1CPU3
Q:BGPQUIT
K BGPDATA
I 'BGPEXCL D Q:BGPQUIT
.S X=$$LASTDX^BGP1UTL1(DFN,"BGP CMS CYSTIC FIBROSIS DXS",$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
.D WCYSTIC^BGP1CPU3
K BGPDATA
S BGPPSE=$$PSEUDO^BGP1CU4(BGPVINP)
S BGPCOPD=$$COPD^BGP1CU4(DFN,$$DSCH^BGP1CU(BGPVINP))
D WPSEUDO^BGP1CPU3
Q:BGPQUIT
;antibiotic rx status?
K BGPDATA
D ANTIRX^BGP1CU3(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($P($P(^AUPNVINP(BGPVINP,0),U),"."),30),.BGPDATA)
D WANTIRX^BGP1CPU3
Q:BGPQUIT
;D ERBCP^BGP1CU3(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$P($P(BGPVSIT0,U),"."),.BGPDATA)
;D WERBC^BGP1CPU3
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
;
PN7 ;EP
I $Y>(BGPIOSL-3) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
D WDT9^BGP1CPU3(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP1CU(BGPVINP) D WTT^BGP1CPU3(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP1CU(BGPVINP) D TRANSN Q:BGPQUIT
D WPPDPOV^BGP1CPU3(BGPVSIT)
Q:BGPQUIT
D OTHDPOVS^BGP1CPU3(BGPVSIT)
Q:BGPQUIT
S X=$$COMFORT^BGP1CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
D WCOMFORT^BGP1CPU3(X)
Q:BGPQUIT
D EXCL487^BGP1CPU3
K BGPDATA,BGPSCAN
D CHESTXRY^BGP1CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA)
D CTSCAN^BGP1CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPSCAN)
D WCHEST^BGP1CPU3
Q:BGPQUIT
I 'BGPEXCL D
.S X=$$LASTDX^BGP1UTL1(DFN,"BGP CMS CYSTIC FIBROSIS DXS",$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
.D WCYSTIC^BGP1CPU3
K BGPDATA
;
D FLUVAX^BGP1CU4(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$DSCH^BGP1CU(BGPVINP),$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
;
D WFLU^BGP1CPU3
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
;
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
TRANSN2 ;
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 !,"short term hospital, federal hospital, or to hospice.",!
Q
TRANSN3 ;
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 on day of or day after arrival.",!
Q
TRANSIN3 ;
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 or critical care access hospital, including ER from another hospital.",!
Q
;
BGP1CP5 ; IHS/CMI/LAB - IHS gpra print ;
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
+2 ;
+3 ;
PNALL ;EP
+1 IF $Y>(BGPIOSL-3)
DO HDR^BGP1CP
IF BGPQUIT
QUIT
DO L1H^BGP1CP
+2 SET BGPNOBA=1
+3 DO WRACE^BGP1CPU(DFN)
+4 IF BGPQUIT
QUIT
+5 DO WDOB^BGP1CPU(DFN)
+6 IF BGPQUIT
QUIT
+7 DO WZIP^BGP1CPU(DFN)
+8 IF BGPQUIT
QUIT
+9 DO WINS^BGP1CPU(BGPVSIT,DFN)
+10 IF BGPQUIT
QUIT
+11 DO WADM^BGP1CPU(BGPVINP)
+12 IF BGPQUIT
QUIT
+13 DO WADM92^BGP1CPU(BGPVINP)
+14 IF BGPQUIT
QUIT
+15 DO WADMS92^BGP1CPU(BGPVINP)
+16 IF BGPQUIT
QUIT
+17 DO WDT^BGP1CPU(BGPVINP)
+18 IF BGPQUIT
QUIT
+19 DO WDSGS92^BGP1CPU(BGPVINP)
+20 IF BGPQUIT
QUIT
+21 IF $$TRANS^BGP1CU(BGPVINP)
DO WTT^BGP1CPU(BGPVINP)
IF BGPQUIT
QUIT
+22 KILL BGPNOBA
+23 DO WPNEUPOV^BGP1CPU3(BGPVSIT)
+24 IF BGPQUIT
QUIT
+25 SET BGPNOBA=1
+26 DO OTHDPOVS^BGP1CPU(BGPVSIT)
+27 IF BGPQUIT
QUIT
+28 DO WPRINPRO^BGP1CPU2
+29 IF BGPQUIT
QUIT
+30 DO WOTHPROS^BGP1CPU2
+31 KILL BGPNOBA
+32 QUIT
+33 ;
PN1 ;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^BGP1CPU3(BGPVINP)
+4 IF BGPQUIT
QUIT
+5 IF $$TRANS^BGP1CU(BGPVINP)
DO WTT^BGP1CPU3(BGPVINP)
+6 IF BGPQUIT
QUIT
+7 IF $$TRANS^BGP1CU(BGPVINP)
IF $$DODA^BGP1CU(BGPVSIT,BGPVINP)
DO TRANSN
IF BGPQUIT
QUIT
+8 DO WPPDPOV^BGP1CPU3(BGPVSIT)
+9 IF BGPQUIT
QUIT
+10 DO OTHDPOVS^BGP1CPU3(BGPVSIT)
+11 IF BGPQUIT
QUIT
+12 IF 'BGPEXCL
Begin DoDot:1
+13 SET X=$$ERPNEU^BGP1CU(DFN,$$FMADD^XLFDT($PIECE($PIECE(BGPVSIT0,U),"."),-1),$PIECE($PIECE(BGPVSIT0,U),"."),"BGP CMS PNEUMONIA DXS")
+14 DO WERPNEU^BGP1CPU3
+15 SET X=$$ADMDX^BGP1CU(BGPVINP,"BGP CMS PNEUMONIA DXS")
+16 DO WADMDX^BGP1CPU3
End DoDot:1
+17 IF BGPQUIT
QUIT
+18 SET X=$$COMFORT^BGP1CU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."))
+19 DO WCOMFORT^BGP1CPU3(X)
+20 IF BGPQUIT
QUIT
+21 KILL BGPDATA,BGPSCAN
+22 DO CHESTXRY^BGP1CU(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA)
+23 DO CTSCAN^BGP1CU(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),.BGPSCAN)
+24 DO WCHEST^BGP1CPU3
+25 IF BGPQUIT
QUIT
+26 IF 'BGPEXCL
Begin DoDot:1
+27 SET X=$$LASTDX^BGP1UTL1(DFN,"BGP CMS CYSTIC FIBROSIS DXS",$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
+28 DO WCYSTIC^BGP1CPU3
End DoDot:1
+29 KILL BGPDATA
+30 DO ABGPO^BGP1CU(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$$FMADD^XLFDT($$DSCH^BGP1CU(BGPVINP)),.BGPDATA)
+31 DO WABGPO^BGP1CPU3
+32 IF BGPQUIT
QUIT
+33 KILL BGPDATA
+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 ;
PN2 ;EP
+1 IF $Y>(BGPIOSL-3)
DO HDR^BGP1CP
IF BGPQUIT
QUIT
DO L1H^BGP1CP
+2 DO WDT9^BGP1CPU3(BGPVINP)
+3 IF BGPQUIT
QUIT
+4 IF $$TRANS^BGP1CU(BGPVINP)
DO WTT^BGP1CPU3(BGPVINP)
+5 IF BGPQUIT
QUIT
+6 IF $$TRANS^BGP1CU(BGPVINP)
DO TRANSN2
IF BGPQUIT
QUIT
+7 DO WPPDPOV^BGP1CPU3(BGPVSIT)
+8 IF BGPQUIT
QUIT
+9 DO OTHDPOVS^BGP1CPU3(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^BGP1CPU3(X)
+13 IF BGPQUIT
QUIT
+14 KILL BGPDATA,BGPSCAN
+15 DO CHESTXRY^BGP1CU(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA)
+16 DO CTSCAN^BGP1CU(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),.BGPSCAN)
+17 DO WCHEST^BGP1CPU3
+18 IF BGPQUIT
QUIT
+19 IF 'BGPEXCL
Begin DoDot:1
+20 SET X=$$LASTDX^BGP1UTL1(DFN,"BGP CMS CYSTIC FIBROSIS DXS",$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
+21 DO WCYSTIC^BGP1CPU3
End DoDot:1
+22 KILL BGPDATA
+23 DO PNEUVAX^BGP1CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP),$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
+24 DO WPNEUMO^BGP1CPU3
+25 IF BGPQUIT
QUIT
+26 KILL BGPDATA
+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 ;
PN3B ;EP
+1 IF $Y>(BGPIOSL-3)
DO HDR^BGP1CP
IF BGPQUIT
QUIT
DO L1H^BGP1CP
+2 IF $$TRANSIN^BGP1CU(BGPVINP)
DO TRANSIN3
IF BGPQUIT
QUIT
+3 IF 'BGPEXCL
DO WDOD^BGP1CPU3(DFN)
+4 IF BGPQUIT
QUIT
+5 DO WDT^BGP1CPU3(BGPVINP)
+6 IF BGPQUIT
QUIT
+7 IF $$TRANS^BGP1CU(BGPVINP)
DO WTT^BGP1CPU3(BGPVINP)
+8 IF BGPQUIT
QUIT
+9 IF $$TRANS^BGP1CU(BGPVINP)
DO TRANSN3
IF BGPQUIT
QUIT
+10 DO WPPDPOV^BGP1CPU3(BGPVSIT)
+11 IF BGPQUIT
QUIT
+12 DO OTHDPOVS^BGP1CPU3(BGPVSIT)
+13 IF BGPQUIT
QUIT
+14 IF 'BGPEXCL
Begin DoDot:1
+15 SET X=$$ERPNEU^BGP1CU(DFN,$$FMADD^XLFDT($PIECE($PIECE(BGPVSIT0,U),"."),-1),$PIECE($PIECE(BGPVSIT0,U),"."),"BGP CMS PNEUMONIA DXS")
+16 DO WERPNEU^BGP1CPU3
+17 ;S X=$$ADMDX^BGP1CU(BGPVINP,"BGP CMS PNEUMONIA DXS")
+18 DO WADMDX^BGP1CPU3
End DoDot:1
+19 IF BGPQUIT
QUIT
+20 SET X=$$COMFORT^BGP1CU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."))
+21 DO WCOMFORT^BGP1CPU3(X)
+22 IF BGPQUIT
QUIT
+23 KILL BGPDATA,BGPSCAN
+24 DO CHESTXRY^BGP1CU(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA)
+25 DO CTSCAN^BGP1CU(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),.BGPSCAN)
+26 DO WCHEST^BGP1CPU3
+27 IF BGPQUIT
QUIT
+28 IF 'BGPEXCL
Begin DoDot:1
+29 SET X=$$LASTDX^BGP1UTL1(DFN,"BGP CMS CYSTIC FIBROSIS DXS",$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
+30 DO WCYSTIC^BGP1CPU3
End DoDot:1
+31 KILL BGPDATA
+32 ;antibiotic rx status?
+33 DO ANTIRX^BGP1CU3(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),30),.BGPDATA)
+34 DO WANTIRX^BGP1CPU3
+35 IF BGPQUIT
QUIT
+36 KILL BGPDATA
+37 DO ERBCP^BGP1CU3(DFN,$$FMADD^XLFDT($PIECE($PIECE(BGPVSIT0,U),"."),-1),$PIECE($PIECE(BGPVSIT0,U),"."),.BGPDATA)
+38 DO WERBC^BGP1CPU3
+39 IF BGPQUIT
QUIT
+40 KILL BGPDATA
+41 DO ALLALG1^BGP1CU1(DFN,DT,$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
+42 DO WALLALG^BGP1CPU
+43 IF BGPQUIT
QUIT
+44 KILL BGPDATA
+45 DO ALLALGA1^BGP1CU1(DFN,DT,.BGPDATA)
+46 DO WALLALGT^BGP1CPU
+47 KILL BGPDATA
+48 DO IVUD^BGP1CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP),,.BGPDATA)
+49 DO WIVUD^BGP1CPU
+50 QUIT
+51 ;
PN4 ;EP
+1 IF $Y>(BGPIOSL-3)
DO HDR^BGP1CP
IF BGPQUIT
QUIT
DO L1H^BGP1CP
+2 IF 'BGPEXCL
DO WDOD^BGP1CPU3(DFN)
+3 IF BGPQUIT
QUIT
+4 DO WDT9^BGP1CPU3(BGPVINP)
+5 IF BGPQUIT
QUIT
+6 IF $$TRANS^BGP1CU(BGPVINP)
DO WTT^BGP1CPU3(BGPVINP)
+7 IF BGPQUIT
QUIT
+8 IF $$TRANS^BGP1CU(BGPVINP)
DO TRANSN2
IF BGPQUIT
QUIT
+9 DO WPPDPOV^BGP1CPU3(BGPVSIT)
+10 IF BGPQUIT
QUIT
+11 DO OTHDPOVS^BGP1CPU3(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^BGP1CPU3(X)
+15 IF BGPQUIT
QUIT
+16 KILL BGPDATA,BGPSCAN
+17 DO CHESTXRY^BGP1CU(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA)
+18 DO CTSCAN^BGP1CU(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),.BGPSCAN)
+19 DO WCHEST^BGP1CPU3
+20 IF BGPQUIT
QUIT
+21 IF 'BGPEXCL
Begin DoDot:1
+22 SET X=$$LASTDX^BGP1UTL1(DFN,"BGP CMS CYSTIC FIBROSIS DXS",$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
+23 DO WCYSTIC^BGP1CPU3
End DoDot:1
+24 KILL BGPDATA
+25 ;antibiotic rx status?
+26 KILL BGPDATA
+27 SET BGPC=0
+28 DO SMOKER^BGP1CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
+29 DO WSMOKER^BGP1CPU
+30 IF BGPQUIT
QUIT
+31 KILL BGPDATA
+32 DO CESS^BGP1CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
+33 DO WCESS^BGP1CPU
+34 IF BGPQUIT
QUIT
+35 KILL BGPDATA
+36 DO CESSMEDS^BGP1CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
+37 DO WCESSMED^BGP1CPU
+38 IF BGPQUIT
QUIT
+39 KILL BGPDATA
+40 DO ALLALG1^BGP1CU1(DFN,DT,$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
+41 DO WALLALG^BGP1CPU
+42 IF BGPQUIT
QUIT
+43 KILL BGPDATA
+44 DO ALLALGA1^BGP1CU1(DFN,DT,.BGPDATA)
+45 DO WALLALGT^BGP1CPU
+46 KILL BGPDATA
+47 DO IVUD^BGP1CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP),,.BGPDATA)
+48 DO WIVUD^BGP1CPU
+49 QUIT
+50 ;
PN5B ;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 IF 'BGPEXCL
DO WDOD^BGP1CPU3(DFN)
+4 IF BGPQUIT
QUIT
+5 DO WDT^BGP1CPU3(BGPVINP)
+6 IF BGPQUIT
QUIT
+7 IF $$TRANS^BGP1CU(BGPVINP)
DO WTT^BGP1CPU3(BGPVINP)
+8 IF BGPQUIT
QUIT
+9 IF $$TRANS^BGP1CU(BGPVINP)
DO TRANSN
IF BGPQUIT
QUIT
+10 DO WPPDPOV^BGP1CPU3(BGPVSIT)
+11 IF BGPQUIT
QUIT
+12 DO OTHDPOVS^BGP1CPU3(BGPVSIT)
+13 IF BGPQUIT
QUIT
+14 IF 'BGPEXCL
Begin DoDot:1
+15 SET X=$$ERPNEU^BGP1CU(DFN,$$FMADD^XLFDT($PIECE($PIECE(BGPVSIT0,U),"."),-1),$PIECE($PIECE(BGPVSIT0,U),"."),"BGP CMS PNEUMONIA DXS")
+16 DO WERPNEU^BGP1CPU3
+17 SET X=$$ADMDX^BGP1CU(BGPVINP,"BGP CMS PNEUMONIA DXS")
+18 DO WADMDX^BGP1CPU3
End DoDot:1
+19 IF BGPQUIT
QUIT
+20 SET X=$$COMFORT^BGP1CU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."))
+21 DO WCOMFORT^BGP1CPU3(X)
+22 IF BGPQUIT
QUIT
+23 KILL BGPDATA,BGPSCAN
+24 DO CHESTXRY^BGP1CU(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA)
+25 DO CTSCAN^BGP1CU(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),.BGPSCAN)
+26 DO WCHEST^BGP1CPU3
+27 IF BGPQUIT
QUIT
+28 ;antibiotic rx status?
+29 KILL BGPDATA
+30 DO ANTIRX^BGP1CU3(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),30),.BGPDATA)
+31 DO WANTIRX^BGP1CPU3
+32 IF BGPQUIT
QUIT
+33 IF 'BGPEXCL
Begin DoDot:1
+34 SET X=$$LASTDX^BGP1UTL1(DFN,"BGP CMS CYSTIC FIBROSIS DXS",$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
+35 DO WCYSTIC^BGP1CPU3
End DoDot:1
+36 KILL BGPDATA
+37 ;D ERBCP^BGP1CU3(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$P($P(BGPVSIT0,U),"."),.BGPDATA)
+38 ;D WERBC^BGP1CPU3
+39 IF BGPQUIT
QUIT
+40 KILL BGPDATA
+41 DO ALLALG1^BGP1CU1(DFN,DT,$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
+42 DO WALLALG^BGP1CPU
+43 IF BGPQUIT
QUIT
+44 KILL BGPDATA
+45 DO ALLALGA1^BGP1CU1(DFN,DT,.BGPDATA)
+46 DO WALLALGT^BGP1CPU
+47 KILL BGPDATA
+48 DO IVUD^BGP1CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP),,.BGPDATA)
+49 DO WIVUD^BGP1CPU
+50 QUIT
+51 ;
PN6 ;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 IF 'BGPEXCL
DO WDOD^BGP1CPU3(DFN)
+4 IF BGPQUIT
QUIT
+5 DO WDT^BGP1CPU3(BGPVINP)
+6 IF BGPQUIT
QUIT
+7 IF $$TRANS^BGP1CU(BGPVINP)
DO WTT^BGP1CPU3(BGPVINP)
+8 IF BGPQUIT
QUIT
+9 IF $$TRANS^BGP1CU(BGPVINP)
DO TRANSN
IF BGPQUIT
QUIT
+10 DO WPPDPOV^BGP1CPU3(BGPVSIT)
+11 IF BGPQUIT
QUIT
+12 DO OTHDPOVS^BGP1CPU3(BGPVSIT)
+13 IF BGPQUIT
QUIT
+14 IF 'BGPEXCL
Begin DoDot:1
+15 SET X=$$ERPNEU^BGP1CU(DFN,$$FMADD^XLFDT($PIECE($PIECE(BGPVSIT0,U),"."),-1),$PIECE($PIECE(BGPVSIT0,U),"."),"BGP CMS PNEUMONIA DXS")
+16 DO WERPNEU^BGP1CPU3
+17 SET X=$$ADMDX^BGP1CU(BGPVINP,"BGP CMS PNEUMONIA DXS")
+18 DO WADMDX^BGP1CPU3
End DoDot:1
+19 IF BGPQUIT
QUIT
+20 SET X=$$COMFORT^BGP1CU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."))
+21 DO WCOMFORT^BGP1CPU3(X)
+22 IF BGPQUIT
QUIT
+23 KILL BGPDATA
+24 IF 'BGPEXCL
Begin DoDot:1
+25 KILL BGPDATA
+26 DO EXCLCOMP^BGP1CU4(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA)
+27 DO WEXCL1^BGP1CPU3
+28 IF BGPQUIT
QUIT
+29 SET X=$$PRIORHOS^BGP1CU4(DFN,$$FMADD^XLFDT($PIECE($PIECE(BGPVSIT0,U),"."),-14),$PIECE($PIECE(BGPVSIT0,U),"."),BGPVSIT)
+30 SET Y=$$HOS2DAYS^BGP1CU4(DFN,$$FMADD^XLFDT($PIECE($PIECE(BGPVSIT0,U),"."),-90),$PIECE($PIECE(BGPVSIT0,U),"."))
+31 DO WPRIORHO^BGP1CPU3
+32 IF BGPQUIT
QUIT
+33 SET X=$$NURSHOME^BGP1CU4(DFN,$$FMADD^XLFDT($PIECE($PIECE(BGPVSIT0,U),"."),-90),$PIECE($PIECE(BGPVSIT0,U),"."))
+34 DO WNURSHOM^BGP1CPU3
+35 IF BGPQUIT
QUIT
+36 SET X=$$WOUNDCAR^BGP1CU4(DFN,$$FMADD^XLFDT($PIECE($PIECE(BGPVSIT0,U),"."),-30),$PIECE($PIECE(BGPVSIT0,U),"."))
+37 DO WWOUND^BGP1CPU3
End DoDot:1
IF BGPQUIT
QUIT
+38 KILL BGPDATA,BGPSCAN
+39 DO CHESTXRY^BGP1CU(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA)
+40 DO CTSCAN^BGP1CU(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),.BGPSCAN)
+41 DO WCHEST^BGP1CPU3
+42 IF BGPQUIT
QUIT
+43 SET X=$$ADMDX^BGP1CU(BGPVINP,"BGP CMS OTHER INFECTION DXS")
+44 DO WOTHINF^BGP1CPU3
+45 IF BGPQUIT
QUIT
+46 KILL BGPDATA
+47 IF 'BGPEXCL
Begin DoDot:1
+48 SET X=$$LASTDX^BGP1UTL1(DFN,"BGP CMS CYSTIC FIBROSIS DXS",$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
+49 DO WCYSTIC^BGP1CPU3
End DoDot:1
IF BGPQUIT
QUIT
+50 KILL BGPDATA
+51 SET BGPPSE=$$PSEUDO^BGP1CU4(BGPVINP)
+52 SET BGPCOPD=$$COPD^BGP1CU4(DFN,$$DSCH^BGP1CU(BGPVINP))
+53 DO WPSEUDO^BGP1CPU3
+54 IF BGPQUIT
QUIT
+55 ;antibiotic rx status?
+56 KILL BGPDATA
+57 DO ANTIRX^BGP1CU3(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),30),.BGPDATA)
+58 DO WANTIRX^BGP1CPU3
+59 IF BGPQUIT
QUIT
+60 ;D ERBCP^BGP1CU3(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$P($P(BGPVSIT0,U),"."),.BGPDATA)
+61 ;D WERBC^BGP1CPU3
+62 IF BGPQUIT
QUIT
+63 KILL BGPDATA
+64 DO ALLALG1^BGP1CU1(DFN,DT,$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
+65 DO WALLALG^BGP1CPU
+66 IF BGPQUIT
QUIT
+67 KILL BGPDATA
+68 DO ALLALGA1^BGP1CU1(DFN,DT,.BGPDATA)
+69 DO WALLALGT^BGP1CPU
+70 KILL BGPDATA
+71 DO IVUD^BGP1CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP),,.BGPDATA)
+72 DO WIVUD^BGP1CPU
+73 QUIT
+74 ;
PN7 ;EP
+1 IF $Y>(BGPIOSL-3)
DO HDR^BGP1CP
IF BGPQUIT
QUIT
DO L1H^BGP1CP
+2 DO WDT9^BGP1CPU3(BGPVINP)
+3 IF BGPQUIT
QUIT
+4 IF $$TRANS^BGP1CU(BGPVINP)
DO WTT^BGP1CPU3(BGPVINP)
+5 IF BGPQUIT
QUIT
+6 IF $$TRANS^BGP1CU(BGPVINP)
DO TRANSN
IF BGPQUIT
QUIT
+7 DO WPPDPOV^BGP1CPU3(BGPVSIT)
+8 IF BGPQUIT
QUIT
+9 DO OTHDPOVS^BGP1CPU3(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^BGP1CPU3(X)
+13 IF BGPQUIT
QUIT
+14 DO EXCL487^BGP1CPU3
+15 KILL BGPDATA,BGPSCAN
+16 DO CHESTXRY^BGP1CU(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA)
+17 DO CTSCAN^BGP1CU(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),.BGPSCAN)
+18 DO WCHEST^BGP1CPU3
+19 IF BGPQUIT
QUIT
+20 IF 'BGPEXCL
Begin DoDot:1
+21 SET X=$$LASTDX^BGP1UTL1(DFN,"BGP CMS CYSTIC FIBROSIS DXS",$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
+22 DO WCYSTIC^BGP1CPU3
End DoDot:1
+23 KILL BGPDATA
+24 ;
+25 DO FLUVAX^BGP1CU4(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$DSCH^BGP1CU(BGPVINP),$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
+26 ;
+27 DO WFLU^BGP1CPU3
+28 IF BGPQUIT
QUIT
+29 KILL BGPDATA
+30 DO ALLALG1^BGP1CU1(DFN,DT,$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
+31 DO WALLALG^BGP1CPU
+32 IF BGPQUIT
QUIT
+33 KILL BGPDATA
+34 DO ALLALGA1^BGP1CU1(DFN,DT,.BGPDATA)
+35 DO WALLALGT^BGP1CPU
+36 KILL BGPDATA
+37 DO IVUD^BGP1CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP),,.BGPDATA)
+38 DO WIVUD^BGP1CPU
+39 QUIT
+40 ;
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
TRANSN2 ;
+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 !,"short term hospital, federal hospital, or to hospice.",!
+5 QUIT
TRANSN3 ;
+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 on day of or day after arrival.",!
+5 QUIT
TRANSIN3 ;
+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 or critical care access hospital, including ER from another hospital.",!
+5 QUIT
+6 ;
