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