Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGP2CP5

BGP2CP5.m

Go to the documentation of this file. 
  1. BGP2CP5 ; IHS/CMI/LAB - IHS gpra print ;
  1.  ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
  1.  ;
  1.  ;
  1. PNALL ;EP
  1.  I $Y>(BGPIOSL-3) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  S BGPNOBA=1
  1.  D WRACE^BGP2CPU(DFN)
  1.  Q:BGPQUIT
  1.  D WDOB^BGP2CPU(DFN)
  1.  Q:BGPQUIT
  1.  D WZIP^BGP2CPU(DFN)
  1.  Q:BGPQUIT
  1.  D WINS^BGP2CPU(BGPVSIT,DFN)
  1.  Q:BGPQUIT
  1.  D WADM^BGP2CPU(BGPVINP)
  1.  Q:BGPQUIT
  1.  D WADM92^BGP2CPU(BGPVINP)
  1.  Q:BGPQUIT
  1.  D WADMS92^BGP2CPU(BGPVINP)
  1.  Q:BGPQUIT
  1.  D WDT^BGP2CPU(BGPVINP)
  1.  Q:BGPQUIT
  1.  D WDSGS92^BGP2CPU(BGPVINP)
  1.  Q:BGPQUIT
  1.  I $$TRANS^BGP2CU(BGPVINP) D WTT^BGP2CPU(BGPVINP) Q:BGPQUIT
  1.  K BGPNOBA
  1.  D WPNEUPOV^BGP2CPU3(BGPVSIT)
  1.  Q:BGPQUIT
  1.  S BGPNOBA=1
  1.  D OTHDPOVS^BGP2CPU(BGPVSIT)
  1.  Q:BGPQUIT
  1.  D WPRINPRO^BGP2CPU2
  1.  Q:BGPQUIT
  1.  D WOTHPROS^BGP2CPU2
  1.  K BGPNOBA
  1.  Q
  1.  ;
  1. PN1 ;EP
  1.  I $Y>(BGPIOSL-3) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  I $$TRANSIN^BGP2CU(BGPVINP) D TRANSIN Q:BGPQUIT
  1.  D WDT^BGP2CPU3(BGPVINP)
  1.  Q:BGPQUIT
  1.  I $$TRANS^BGP2CU(BGPVINP) D WTT^BGP2CPU3(BGPVINP)
  1.  Q:BGPQUIT
  1.  I $$TRANS^BGP2CU(BGPVINP),$$DODA^BGP2CU(BGPVSIT,BGPVINP) D TRANSN Q:BGPQUIT
  1.  D WPPDPOV^BGP2CPU3(BGPVSIT)
  1.  Q:BGPQUIT
  1.  D OTHDPOVS^BGP2CPU3(BGPVSIT)
  1.  Q:BGPQUIT
  1.  I 'BGPEXCL D
  1.  .S X=$$ERPNEU^BGP2CU(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$P($P(BGPVSIT0,U),"."),"BGP CMS PNEUMONIA DXS")
  1.  .D WERPNEU^BGP2CPU3
  1.  .S X=$$ADMDX^BGP2CU(BGPVINP,"BGP CMS PNEUMONIA DXS")
  1.  .D WADMDX^BGP2CPU3
  1.  Q:BGPQUIT
  1.  S X=$$COMFORT^BGP2CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
  1.  D WCOMFORT^BGP2CPU3(X)
  1.  Q:BGPQUIT
  1.  K BGPDATA,BGPSCAN
  1.  D CHESTXRY^BGP2CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA)
  1.  D CTSCAN^BGP2CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPSCAN)
  1.  D WCHEST^BGP2CPU3
  1.  Q:BGPQUIT
  1.  I 'BGPEXCL D
  1.  .S X=$$LASTDX^BGP2UTL1(DFN,"BGP CMS CYSTIC FIBROSIS DXS",$$DOB^AUPNPAT(DFN),$$DSCH^BGP2CU(BGPVINP))
  1.  .D WCYSTIC^BGP2CPU3
  1.  K BGPDATA
  1.  D ABGPO^BGP2CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$$FMADD^XLFDT($$DSCH^BGP2CU(BGPVINP)),.BGPDATA)
  1.  D WABGPO^BGP2CPU3
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  D ALLALG1^BGP2CU1(DFN,DT,$$DSCH^BGP2CU(BGPVINP),.BGPDATA)
  1.  D WALLALG^BGP2CPU
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  D ALLALGA1^BGP2CU1(DFN,DT,.BGPDATA)
  1.  D WALLALGT^BGP2CPU
  1.  K BGPDATA
  1.  D IVUD^BGP2CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP2CU(BGPVINP),,.BGPDATA)
  1.  D WIVUD^BGP2CPU
  1.  Q
  1.  ;
  1. PN2 ;EP
  1.  I $Y>(BGPIOSL-3) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  D WDT9^BGP2CPU3(BGPVINP)
  1.  Q:BGPQUIT
  1.  I $$TRANS^BGP2CU(BGPVINP) D WTT^BGP2CPU3(BGPVINP)
  1.  Q:BGPQUIT
  1.  I $$TRANS^BGP2CU(BGPVINP) D TRANSN2 Q:BGPQUIT
  1.  D WPPDPOV^BGP2CPU3(BGPVSIT)
  1.  Q:BGPQUIT
  1.  D OTHDPOVS^BGP2CPU3(BGPVSIT)
  1.  Q:BGPQUIT
  1.  S X=$$COMFORT^BGP2CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
  1.  D WCOMFORT^BGP2CPU3(X)
  1.  Q:BGPQUIT
  1.  K BGPDATA,BGPSCAN
  1.  D CHESTXRY^BGP2CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA)
  1.  D CTSCAN^BGP2CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPSCAN)
  1.  D WCHEST^BGP2CPU3
  1.  Q:BGPQUIT
  1.  I 'BGPEXCL D
  1.  .S X=$$LASTDX^BGP2UTL1(DFN,"BGP CMS CYSTIC FIBROSIS DXS",$$DOB^AUPNPAT(DFN),$$DSCH^BGP2CU(BGPVINP))
  1.  .D WCYSTIC^BGP2CPU3
  1.  K BGPDATA
  1.  D PNEUVAX^BGP2CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP2CU(BGPVINP),$$DSCH^BGP2CU(BGPVINP),.BGPDATA)
  1.  D WPNEUMO^BGP2CPU3
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  D ALLALG1^BGP2CU1(DFN,DT,$$DSCH^BGP2CU(BGPVINP),.BGPDATA)
  1.  D WALLALG^BGP2CPU
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  D ALLALGA1^BGP2CU1(DFN,DT,.BGPDATA)
  1.  D WALLALGT^BGP2CPU
  1.  K BGPDATA
  1.  D IVUD^BGP2CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP2CU(BGPVINP),,.BGPDATA)
  1.  D WIVUD^BGP2CPU
  1.  Q
  1.  ; 
  1. PN3B ;EP
  1.  I $Y>(BGPIOSL-3) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  I $$TRANSIN^BGP2CU(BGPVINP) D TRANSIN3 Q:BGPQUIT
  1.  I 'BGPEXCL D WDOD^BGP2CPU3(DFN)
  1.  Q:BGPQUIT
  1.  D WDT^BGP2CPU3(BGPVINP)
  1.  Q:BGPQUIT
  1.  I $$TRANS^BGP2CU(BGPVINP) D WTT^BGP2CPU3(BGPVINP)
  1.  Q:BGPQUIT
  1.  I $$TRANS^BGP2CU(BGPVINP) D TRANSN3 Q:BGPQUIT
  1.  D WPPDPOV^BGP2CPU3(BGPVSIT)
  1.  Q:BGPQUIT
  1.  D OTHDPOVS^BGP2CPU3(BGPVSIT)
  1.  Q:BGPQUIT
  1.  I 'BGPEXCL D
  1.  .S X=$$ERPNEU^BGP2CU(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$P($P(BGPVSIT0,U),"."),"BGP CMS PNEUMONIA DXS")
  1.  .D WERPNEU^BGP2CPU3
  1.  .;S X=$$ADMDX^BGP2CU(BGPVINP,"BGP CMS PNEUMONIA DXS")
  1.  .D WADMDX^BGP2CPU3
  1.  Q:BGPQUIT
  1.  S X=$$COMFORT^BGP2CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
  1.  D WCOMFORT^BGP2CPU3(X)
  1.  Q:BGPQUIT
  1.  K BGPDATA,BGPSCAN
  1.  D CHESTXRY^BGP2CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA)
  1.  D CTSCAN^BGP2CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPSCAN)
  1.  D WCHEST^BGP2CPU3
  1.  Q:BGPQUIT
  1.  I 'BGPEXCL D
  1.  .S X=$$LASTDX^BGP2UTL1(DFN,"BGP CMS CYSTIC FIBROSIS DXS",$$DOB^AUPNPAT(DFN),$$DSCH^BGP2CU(BGPVINP))
  1.  .D WCYSTIC^BGP2CPU3
  1.  K BGPDATA
  1.  ;antibiotic rx status?
  1.  D ANTIRX^BGP2CU3(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($P($P(^AUPNVINP(BGPVINP,0),U),"."),30),.BGPDATA)
  1.  D WANTIRX^BGP2CPU3
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  D ERBCP^BGP2CU3(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$P($P(BGPVSIT0,U),"."),.BGPDATA)
  1.  D WERBC^BGP2CPU3
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  D ALLALG1^BGP2CU1(DFN,DT,$$DSCH^BGP2CU(BGPVINP),.BGPDATA)
  1.  D WALLALG^BGP2CPU
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  D ALLALGA1^BGP2CU1(DFN,DT,.BGPDATA)
  1.  D WALLALGT^BGP2CPU
  1.  K BGPDATA
  1.  D IVUD^BGP2CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP2CU(BGPVINP),,.BGPDATA)
  1.  D WIVUD^BGP2CPU
  1.  Q
  1.  ; 
  1. PN4 ;EP
  1.  I $Y>(BGPIOSL-3) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  I 'BGPEXCL D WDOD^BGP2CPU3(DFN)
  1.  Q:BGPQUIT
  1.  D WDT9^BGP2CPU3(BGPVINP)
  1.  Q:BGPQUIT
  1.  I $$TRANS^BGP2CU(BGPVINP) D WTT^BGP2CPU3(BGPVINP)
  1.  Q:BGPQUIT
  1.  I $$TRANS^BGP2CU(BGPVINP) D TRANSN2 Q:BGPQUIT
  1.  D WPPDPOV^BGP2CPU3(BGPVSIT)
  1.  Q:BGPQUIT
  1.  D OTHDPOVS^BGP2CPU3(BGPVSIT)
  1.  Q:BGPQUIT
  1.  S X=$$COMFORT^BGP2CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
  1.  D WCOMFORT^BGP2CPU3(X)
  1.  Q:BGPQUIT
  1.  K BGPDATA,BGPSCAN
  1.  D CHESTXRY^BGP2CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA)
  1.  D CTSCAN^BGP2CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPSCAN)
  1.  D WCHEST^BGP2CPU3
  1.  Q:BGPQUIT
  1.  I 'BGPEXCL D
  1.  .S X=$$LASTDX^BGP2UTL1(DFN,"BGP CMS CYSTIC FIBROSIS DXS",$$DOB^AUPNPAT(DFN),$$DSCH^BGP2CU(BGPVINP))
  1.  .D WCYSTIC^BGP2CPU3
  1.  K BGPDATA
  1.  ;antibiotic rx status?
  1.  K BGPDATA
  1.  S BGPC=0
  1.  D SMOKER^BGP2CU2(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$DSCH^BGP2CU(BGPVINP),.BGPDATA)
  1.  D WSMOKER^BGP2CPU
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  D CESS^BGP2CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),.BGPDATA)
  1.  D WCESS^BGP2CPU
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  D CESSMEDS^BGP2CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP2CU(BGPVINP),.BGPDATA)
  1.  D WCESSMED^BGP2CPU
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  D ALLALG1^BGP2CU1(DFN,DT,$$DSCH^BGP2CU(BGPVINP),.BGPDATA)
  1.  D WALLALG^BGP2CPU
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  D ALLALGA1^BGP2CU1(DFN,DT,.BGPDATA)
  1.  D WALLALGT^BGP2CPU
  1.  K BGPDATA
  1.  D IVUD^BGP2CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP2CU(BGPVINP),,.BGPDATA)
  1.  D WIVUD^BGP2CPU
  1.  Q
  1.  ; 
  1. PN5B ;EP
  1.  I $Y>(BGPIOSL-3) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  I $$TRANSIN^BGP2CU(BGPVINP) D TRANSIN Q:BGPQUIT
  1.  I 'BGPEXCL D WDOD^BGP2CPU3(DFN)
  1.  Q:BGPQUIT
  1.  D WDT^BGP2CPU3(BGPVINP)
  1.  Q:BGPQUIT
  1.  I $$TRANS^BGP2CU(BGPVINP) D WTT^BGP2CPU3(BGPVINP)
  1.  Q:BGPQUIT
  1.  I $$TRANS^BGP2CU(BGPVINP) D TRANSN Q:BGPQUIT
  1.  D WPPDPOV^BGP2CPU3(BGPVSIT)
  1.  Q:BGPQUIT
  1.  D OTHDPOVS^BGP2CPU3(BGPVSIT)
  1.  Q:BGPQUIT
  1.  I 'BGPEXCL D
  1.  .S X=$$ERPNEU^BGP2CU(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$P($P(BGPVSIT0,U),"."),"BGP CMS PNEUMONIA DXS")
  1.  .D WERPNEU^BGP2CPU3
  1.  .S X=$$ADMDX^BGP2CU(BGPVINP,"BGP CMS PNEUMONIA DXS")
  1.  .D WADMDX^BGP2CPU3
  1.  Q:BGPQUIT
  1.  S X=$$COMFORT^BGP2CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
  1.  D WCOMFORT^BGP2CPU3(X)
  1.  Q:BGPQUIT
  1.  K BGPDATA,BGPSCAN
  1.  D CHESTXRY^BGP2CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA)
  1.  D CTSCAN^BGP2CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPSCAN)
  1.  D WCHEST^BGP2CPU3
  1.  Q:BGPQUIT
  1.  ;antibiotic rx status?
  1.  K BGPDATA
  1.  D ANTIRX^BGP2CU3(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($P($P(^AUPNVINP(BGPVINP,0),U),"."),30),.BGPDATA)
  1.  D WANTIRX^BGP2CPU3
  1.  Q:BGPQUIT
  1.  I 'BGPEXCL D
  1.  .S X=$$LASTDX^BGP2UTL1(DFN,"BGP CMS CYSTIC FIBROSIS DXS",$$DOB^AUPNPAT(DFN),$$DSCH^BGP2CU(BGPVINP))
  1.  .D WCYSTIC^BGP2CPU3
  1.  K BGPDATA
  1.  ;D ERBCP^BGP2CU3(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$P($P(BGPVSIT0,U),"."),.BGPDATA)
  1.  ;D WERBC^BGP2CPU3
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  D ALLALG1^BGP2CU1(DFN,DT,$$DSCH^BGP2CU(BGPVINP),.BGPDATA)
  1.  D WALLALG^BGP2CPU
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  D ALLALGA1^BGP2CU1(DFN,DT,.BGPDATA)
  1.  D WALLALGT^BGP2CPU
  1.  K BGPDATA
  1.  D IVUD^BGP2CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP2CU(BGPVINP),,.BGPDATA)
  1.  D WIVUD^BGP2CPU
  1.  Q
  1.  ;
  1. PN6 ;EP
  1.  I $Y>(BGPIOSL-3) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  I $$TRANSIN^BGP2CU(BGPVINP) D TRANSIN Q:BGPQUIT
  1.  I 'BGPEXCL D WDOD^BGP2CPU3(DFN)
  1.  Q:BGPQUIT
  1.  D WDT^BGP2CPU3(BGPVINP)
  1.  Q:BGPQUIT
  1.  I $$TRANS^BGP2CU(BGPVINP) D WTT^BGP2CPU3(BGPVINP)
  1.  Q:BGPQUIT
  1.  I $$TRANS^BGP2CU(BGPVINP) D TRANSN Q:BGPQUIT
  1.  D WPPDPOV^BGP2CPU3(BGPVSIT)
  1.  Q:BGPQUIT
  1.  D OTHDPOVS^BGP2CPU3(BGPVSIT)
  1.  Q:BGPQUIT
  1.  I 'BGPEXCL D
  1.  .S X=$$ERPNEU^BGP2CU(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$P($P(BGPVSIT0,U),"."),"BGP CMS PNEUMONIA DXS")
  1.  .D WERPNEU^BGP2CPU3
  1.  .S X=$$ADMDX^BGP2CU(BGPVINP,"BGP CMS PNEUMONIA DXS")
  1.  .D WADMDX^BGP2CPU3
  1.  Q:BGPQUIT
  1.  S X=$$COMFORT^BGP2CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
  1.  D WCOMFORT^BGP2CPU3(X)
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  I 'BGPEXCL D  Q:BGPQUIT
  1.  .K BGPDATA
  1.  .D EXCLCOMP^BGP2CU4(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA)
  1.  .D WEXCL1^BGP2CPU3
  1.  .Q:BGPQUIT
  1.  .S X=$$PRIORHOS^BGP2CU4(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-14),$P($P(BGPVSIT0,U),"."),BGPVSIT)
  1.  .S Y=$$HOS2DAYS^BGP2CU4(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-90),$P($P(BGPVSIT0,U),"."))
  1.  .D WPRIORHO^BGP2CPU3
  1.  .Q:BGPQUIT
  1.  .S X=$$NURSHOME^BGP2CU4(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-90),$P($P(BGPVSIT0,U),"."))
  1.  .D WNURSHOM^BGP2CPU3
  1.  .Q:BGPQUIT
  1.  .S X=$$WOUNDCAR^BGP2CU4(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-30),$P($P(BGPVSIT0,U),"."))
  1.  .D WWOUND^BGP2CPU3
  1.  K BGPDATA,BGPSCAN
  1.  D CHESTXRY^BGP2CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA)
  1.  D CTSCAN^BGP2CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPSCAN)
  1.  D WCHEST^BGP2CPU3
  1.  Q:BGPQUIT
  1.  S X=$$ADMDX^BGP2CU(BGPVINP,"BGP CMS OTHER INFECTION DXS")
  1.  D WOTHINF^BGP2CPU3
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  I 'BGPEXCL D  Q:BGPQUIT
  1.  .S X=$$LASTDX^BGP2UTL1(DFN,"BGP CMS CYSTIC FIBROSIS DXS",$$DOB^AUPNPAT(DFN),$$DSCH^BGP2CU(BGPVINP))
  1.  .D WCYSTIC^BGP2CPU3
  1.  K BGPDATA
  1.  S BGPPSE=$$PSEUDO^BGP2CU4(BGPVINP)
  1.  S BGPCOPD=$$COPD^BGP2CU4(DFN,$$DSCH^BGP2CU(BGPVINP))
  1.  D WPSEUDO^BGP2CPU3
  1.  Q:BGPQUIT
  1.  ;antibiotic rx status?
  1.  K BGPDATA
  1.  D ANTIRX^BGP2CU3(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($P($P(^AUPNVINP(BGPVINP,0),U),"."),30),.BGPDATA)
  1.  D WANTIRX^BGP2CPU3
  1.  Q:BGPQUIT
  1.  ;D ERBCP^BGP2CU3(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$P($P(BGPVSIT0,U),"."),.BGPDATA)
  1.  ;D WERBC^BGP2CPU3
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  D ALLALG1^BGP2CU1(DFN,DT,$$DSCH^BGP2CU(BGPVINP),.BGPDATA)
  1.  D WALLALG^BGP2CPU
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  D ALLALGA1^BGP2CU1(DFN,DT,.BGPDATA)
  1.  D WALLALGT^BGP2CPU
  1.  K BGPDATA
  1.  D IVUD^BGP2CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP2CU(BGPVINP),,.BGPDATA)
  1.  D WIVUD^BGP2CPU
  1.  Q
  1.  ; 
  1. PN7 ;EP
  1.  I $Y>(BGPIOSL-3) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  D WDT9^BGP2CPU3(BGPVINP)
  1.  Q:BGPQUIT
  1.  I $$TRANS^BGP2CU(BGPVINP) D WTT^BGP2CPU3(BGPVINP)
  1.  Q:BGPQUIT
  1.  I $$TRANS^BGP2CU(BGPVINP) D TRANSN Q:BGPQUIT
  1.  D WPPDPOV^BGP2CPU3(BGPVSIT)
  1.  Q:BGPQUIT
  1.  D OTHDPOVS^BGP2CPU3(BGPVSIT)
  1.  Q:BGPQUIT
  1.  S X=$$COMFORT^BGP2CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
  1.  D WCOMFORT^BGP2CPU3(X)
  1.  Q:BGPQUIT
  1.  D EXCL487^BGP2CPU3
  1.  K BGPDATA,BGPSCAN
  1.  D CHESTXRY^BGP2CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA)
  1.  D CTSCAN^BGP2CU(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-1),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPSCAN)
  1.  D WCHEST^BGP2CPU3
  1.  Q:BGPQUIT
  1.  I 'BGPEXCL D
  1.  .S X=$$LASTDX^BGP2UTL1(DFN,"BGP CMS CYSTIC FIBROSIS DXS",$$DOB^AUPNPAT(DFN),$$DSCH^BGP2CU(BGPVINP))
  1.  .D WCYSTIC^BGP2CPU3
  1.  K BGPDATA
  1.  ;
  1.  D FLUVAX^BGP2CU4(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$DSCH^BGP2CU(BGPVINP),$$DSCH^BGP2CU(BGPVINP),.BGPDATA)
  1.  ;
  1.  D WFLU^BGP2CPU3
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  D ALLALG1^BGP2CU1(DFN,DT,$$DSCH^BGP2CU(BGPVINP),.BGPDATA)
  1.  D WALLALG^BGP2CPU
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  D ALLALGA1^BGP2CU1(DFN,DT,.BGPDATA)
  1.  D WALLALGT^BGP2CPU
  1.  K BGPDATA
  1.  D IVUD^BGP2CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP2CU(BGPVINP),,.BGPDATA)
  1.  D WIVUD^BGP2CPU
  1.  Q
  1.  ; 
  1. TRANSIN ;
  1.  I $Y>(BGPIOSL-4) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !!?3,"NOTE:  Since Admission Type was ","""","Transferred,",""""," review patient's chart"
  1.  W !,"to determine if patient should be excluded if transfer was from another"
  1.  W !,"acute care hospital, including ER from another hospital.",!
  1.  Q
  1.  ;
  1. TRANSN ;
  1.  I $Y>(BGPIOSL-4) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !!?3,"NOTE:  Since Discharge Type was ","""","Transferred,",""""," review patient's chart"
  1.  W !,"to determine if patient should be excluded if transferred to another"
  1.  W !,"acute care hospital or federal hospital.",!
  1.  Q
  1. TRANSN2 ;
  1.  I $Y>(BGPIOSL-4) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !!?3,"NOTE:  Since Discharge Type was ","""","Transferred,",""""," review patient's chart"
  1.  W !,"to determine if patient should be excluded if transferred to another"
  1.  W !,"short term hospital, federal hospital, or to hospice.",!
  1.  Q
  1. TRANSN3 ;
  1.  I $Y>(BGPIOSL-4) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !!?3,"NOTE:  Since Discharge Type was ","""","Transferred,",""""," review patient's chart"
  1.  W !,"to determine if patient should be excluded if transferred to another"
  1.  W !,"acute care hospital or federal hospital on day of or day after arrival.",!
  1.  Q
  1. TRANSIN3 ;
  1.  I $Y>(BGPIOSL-4) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !!?3,"NOTE:  Since Admission Type was ","""","Transferred,",""""," review patient's chart"
  1.  W !,"to determine if patient should be excluded if transfer was from another"
  1.  W !,"acute care or critical care access hospital, including ER from another hospital.",!
  1.  Q
  1.  ;