- BGP8CP6 ; IHS/CMI/LAB - IHS gpra print ;
- ;;8.0;IHS CLINICAL REPORTING;**2**;MAR 12, 2008
- ;
- ;
- SCALL ;EP
- ;I $Y>(BGPIOSL-3) D HDR^BGP8CP Q:BGPQUIT D L1H^BGP8CP
- ;S BGPNOBA=1
- ;D WDT^BGP8CPU4(BGPVINP)
- ;Q:BGPQUIT
- ;I $$TRANS^BGP8CU(BGPVINP) D WTT^BGP8CPU4(BGPVINP) Q:BGPQUIT
- ;K BGPDATA
- ;D SCIP^BGP8CU5(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP8CU(BGPVINP),.BGPDATA)
- ;D WPP^BGP8CPU4
- ;D WPPDPOV^BGP8CPU4(BGPVSIT)
- ;K BGPNOBA
- ;Q
- I $Y>(BGPIOSL-3) D HDR^BGP8CP Q:BGPQUIT D L1H^BGP8CP
- S BGPNOBA=1
- D WRACE^BGP8CPU(DFN)
- Q:BGPQUIT
- D WDOB^BGP8CPU(DFN)
- Q:BGPQUIT
- D WZIP^BGP8CPU(DFN)
- Q:BGPQUIT
- D WINS^BGP8CPU(BGPVSIT,DFN)
- Q:BGPQUIT
- D WADM^BGP8CPU(BGPVINP)
- Q:BGPQUIT
- D WADM92^BGP8CPU(BGPVINP)
- Q:BGPQUIT
- D WADMS92^BGP8CPU(BGPVINP)
- Q:BGPQUIT
- D WDT^BGP8CPU(BGPVINP)
- Q:BGPQUIT
- D WDSGS92^BGP8CPU(BGPVINP)
- Q:BGPQUIT
- I $$TRANS^BGP8CU(BGPVINP) D WTT^BGP8CPU(BGPVINP) Q:BGPQUIT
- K BGPNOBA
- D WPPDPOV^BGP8CPU(BGPVSIT)
- Q:BGPQUIT
- S BGPNOBA=1
- D OTHDPOVS^BGP8CPU(BGPVSIT)
- Q:BGPQUIT
- K BGPDATA
- D SCIP^BGP8CU5(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP8CU(BGPVINP),.BGPDATA)
- D WPP^BGP8CPU4
- Q:BGPQUIT
- D WOTHPROS^BGP8CPU2
- K BGPNOBA
- Q
- ;
- SCIP1 ;EP
- I $Y>(BGPIOSL-3) D HDR^BGP8CP Q:BGPQUIT D L1H^BGP8CP
- D WDT^BGP8CPU4(BGPVINP)
- Q:BGPQUIT
- K BGPPROC
- D SCIP1^BGP8CU5(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP8CU(BGPVINP),.BGPPROC)
- S BGPPPD=$P(BGPPROC(1),U,3) ;principle procedure date
- D WPP1^BGP8CPU4
- Q:BGPQUIT
- D WOTHPROC^BGP8CPU4
- K BGPDATA
- Q:BGPQUIT
- D WPPDPOV^BGP8CPU4(BGPVSIT)
- Q:BGPQUIT
- D OTHDPOVS^BGP8CPU4(BGPVSIT)
- Q:BGPQUIT
- I 'BGPEXCL D PERI^BGP8CPU4
- Q:BGPQUIT
- D INF^BGP8CPU4
- Q:BGPQUIT
- D OTHSURG^BGP8CPU4
- Q:BGPQUIT
- K BGPDATA
- ;antibiotic rx status?
- D ANTIRX^BGP8CU3(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($P($P(^AUPNVINP(BGPVINP,0),U),"."),30),.BGPDATA)
- D WANTIRX^BGP8CPU3
- Q:BGPQUIT
- D ALLALG1^BGP8CU1(DFN,DT,$$DSCH^BGP8CU(BGPVINP),.BGPDATA)
- D WALLALG^BGP8CPU
- Q:BGPQUIT
- K BGPDATA
- D ALLALGA1^BGP8CU1(DFN,DT,.BGPDATA)
- D WALLALGT^BGP8CPU
- K BGPDATA
- D IVUD^BGP8CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP8CU(BGPVINP),,.BGPDATA)
- D WIVUD^BGP8CPU
- Q
- ;
- SCIP3 ;EP
- I $Y>(BGPIOSL-3) D HDR^BGP8CP Q:BGPQUIT D L1H^BGP8CP
- D WDT^BGP8CPU4(BGPVINP)
- Q:BGPQUIT
- K BGPPROC
- D SCIP1^BGP8CU5(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP8CU(BGPVINP),.BGPPROC)
- S BGPPPD=$P(BGPPROC(1),U,3) ;principle procedure date
- D WPP1^BGP8CPU4
- Q:BGPQUIT
- D WOTHPROC^BGP8CPU4
- K BGPDATA
- Q:BGPQUIT
- D WPPDPOV^BGP8CPU4(BGPVSIT)
- Q:BGPQUIT
- D OTHDPOVS^BGP8CPU4(BGPVSIT)
- Q:BGPQUIT
- I 'BGPEXCL D PERI^BGP8CPU4
- Q:BGPQUIT
- D INF^BGP8CPU4
- Q:BGPQUIT
- K BGPDATA
- S BGPPOSTI=$$POSTINF^BGP8CU5(DFN,$$DSCH^BGP8CU(BGPVINP),BGPPROC(1))
- D WPOSTINF^BGP8CPU4
- Q:BGPQUIT
- K BGPDATA
- D OTHSURG^BGP8CPU4
- Q:BGPQUIT
- K BGPDATA
- ;antibiotic rx status?
- D ANTIRX^BGP8CU3(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($P($P(^AUPNVINP(BGPVINP,0),U),"."),30),.BGPDATA)
- D WANTIRX^BGP8CPU3
- Q:BGPQUIT
- D ALLALG1^BGP8CU1(DFN,DT,$$DSCH^BGP8CU(BGPVINP),.BGPDATA)
- D WALLALG^BGP8CPU
- Q:BGPQUIT
- K BGPDATA
- D ALLALGA1^BGP8CU1(DFN,DT,.BGPDATA)
- D WALLALGT^BGP8CPU
- K BGPDATA
- D IVUD^BGP8CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP8CU(BGPVINP),,.BGPDATA)
- D WIVUD^BGP8CPU
- Q
- ;
- TRANSIN ;
- I $Y>(BGPIOSL-4) D HDR^BGP8CP Q:BGPQUIT D L1H^BGP8CP
- 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^BGP8CP Q:BGPQUIT D L1H^BGP8CP
- 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
- ;
- BGP8CP6 ; IHS/CMI/LAB - IHS gpra print ;
- +1 ;;8.0;IHS CLINICAL REPORTING;**2**;MAR 12, 2008
- +2 ;
- +3 ;
- SCALL ;EP
- +1 ;I $Y>(BGPIOSL-3) D HDR^BGP8CP Q:BGPQUIT D L1H^BGP8CP
- +2 ;S BGPNOBA=1
- +3 ;D WDT^BGP8CPU4(BGPVINP)
- +4 ;Q:BGPQUIT
- +5 ;I $$TRANS^BGP8CU(BGPVINP) D WTT^BGP8CPU4(BGPVINP) Q:BGPQUIT
- +6 ;K BGPDATA
- +7 ;D SCIP^BGP8CU5(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP8CU(BGPVINP),.BGPDATA)
- +8 ;D WPP^BGP8CPU4
- +9 ;D WPPDPOV^BGP8CPU4(BGPVSIT)
- +10 ;K BGPNOBA
- +11 ;Q
- +12 IF $Y>(BGPIOSL-3)
- DO HDR^BGP8CP
- IF BGPQUIT
- QUIT
- DO L1H^BGP8CP
- +13 SET BGPNOBA=1
- +14 DO WRACE^BGP8CPU(DFN)
- +15 IF BGPQUIT
- QUIT
- +16 DO WDOB^BGP8CPU(DFN)
- +17 IF BGPQUIT
- QUIT
- +18 DO WZIP^BGP8CPU(DFN)
- +19 IF BGPQUIT
- QUIT
- +20 DO WINS^BGP8CPU(BGPVSIT,DFN)
- +21 IF BGPQUIT
- QUIT
- +22 DO WADM^BGP8CPU(BGPVINP)
- +23 IF BGPQUIT
- QUIT
- +24 DO WADM92^BGP8CPU(BGPVINP)
- +25 IF BGPQUIT
- QUIT
- +26 DO WADMS92^BGP8CPU(BGPVINP)
- +27 IF BGPQUIT
- QUIT
- +28 DO WDT^BGP8CPU(BGPVINP)
- +29 IF BGPQUIT
- QUIT
- +30 DO WDSGS92^BGP8CPU(BGPVINP)
- +31 IF BGPQUIT
- QUIT
- +32 IF $$TRANS^BGP8CU(BGPVINP)
- DO WTT^BGP8CPU(BGPVINP)
- IF BGPQUIT
- QUIT
- +33 KILL BGPNOBA
- +34 DO WPPDPOV^BGP8CPU(BGPVSIT)
- +35 IF BGPQUIT
- QUIT
- +36 SET BGPNOBA=1
- +37 DO OTHDPOVS^BGP8CPU(BGPVSIT)
- +38 IF BGPQUIT
- QUIT
- +39 KILL BGPDATA
- +40 DO SCIP^BGP8CU5(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP8CU(BGPVINP),.BGPDATA)
- +41 DO WPP^BGP8CPU4
- +42 IF BGPQUIT
- QUIT
- +43 DO WOTHPROS^BGP8CPU2
- +44 KILL BGPNOBA
- +45 QUIT
- +46 ;
- SCIP1 ;EP
- +1 IF $Y>(BGPIOSL-3)
- DO HDR^BGP8CP
- IF BGPQUIT
- QUIT
- DO L1H^BGP8CP
- +2 DO WDT^BGP8CPU4(BGPVINP)
- +3 IF BGPQUIT
- QUIT
- +4 KILL BGPPROC
- +5 DO SCIP1^BGP8CU5(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP8CU(BGPVINP),.BGPPROC)
- +6 ;principle procedure date
- SET BGPPPD=$PIECE(BGPPROC(1),U,3)
- +7 DO WPP1^BGP8CPU4
- +8 IF BGPQUIT
- QUIT
- +9 DO WOTHPROC^BGP8CPU4
- +10 KILL BGPDATA
- +11 IF BGPQUIT
- QUIT
- +12 DO WPPDPOV^BGP8CPU4(BGPVSIT)
- +13 IF BGPQUIT
- QUIT
- +14 DO OTHDPOVS^BGP8CPU4(BGPVSIT)
- +15 IF BGPQUIT
- QUIT
- +16 IF 'BGPEXCL
- DO PERI^BGP8CPU4
- +17 IF BGPQUIT
- QUIT
- +18 DO INF^BGP8CPU4
- +19 IF BGPQUIT
- QUIT
- +20 DO OTHSURG^BGP8CPU4
- +21 IF BGPQUIT
- QUIT
- +22 KILL BGPDATA
- +23 ;antibiotic rx status?
- +24 DO ANTIRX^BGP8CU3(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),30),.BGPDATA)
- +25 DO WANTIRX^BGP8CPU3
- +26 IF BGPQUIT
- QUIT
- +27 DO ALLALG1^BGP8CU1(DFN,DT,$$DSCH^BGP8CU(BGPVINP),.BGPDATA)
- +28 DO WALLALG^BGP8CPU
- +29 IF BGPQUIT
- QUIT
- +30 KILL BGPDATA
- +31 DO ALLALGA1^BGP8CU1(DFN,DT,.BGPDATA)
- +32 DO WALLALGT^BGP8CPU
- +33 KILL BGPDATA
- +34 DO IVUD^BGP8CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP8CU(BGPVINP),,.BGPDATA)
- +35 DO WIVUD^BGP8CPU
- +36 QUIT
- +37 ;
- SCIP3 ;EP
- +1 IF $Y>(BGPIOSL-3)
- DO HDR^BGP8CP
- IF BGPQUIT
- QUIT
- DO L1H^BGP8CP
- +2 DO WDT^BGP8CPU4(BGPVINP)
- +3 IF BGPQUIT
- QUIT
- +4 KILL BGPPROC
- +5 DO SCIP1^BGP8CU5(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP8CU(BGPVINP),.BGPPROC)
- +6 ;principle procedure date
- SET BGPPPD=$PIECE(BGPPROC(1),U,3)
- +7 DO WPP1^BGP8CPU4
- +8 IF BGPQUIT
- QUIT
- +9 DO WOTHPROC^BGP8CPU4
- +10 KILL BGPDATA
- +11 IF BGPQUIT
- QUIT
- +12 DO WPPDPOV^BGP8CPU4(BGPVSIT)
- +13 IF BGPQUIT
- QUIT
- +14 DO OTHDPOVS^BGP8CPU4(BGPVSIT)
- +15 IF BGPQUIT
- QUIT
- +16 IF 'BGPEXCL
- DO PERI^BGP8CPU4
- +17 IF BGPQUIT
- QUIT
- +18 DO INF^BGP8CPU4
- +19 IF BGPQUIT
- QUIT
- +20 KILL BGPDATA
- +21 SET BGPPOSTI=$$POSTINF^BGP8CU5(DFN,$$DSCH^BGP8CU(BGPVINP),BGPPROC(1))
- +22 DO WPOSTINF^BGP8CPU4
- +23 IF BGPQUIT
- QUIT
- +24 KILL BGPDATA
- +25 DO OTHSURG^BGP8CPU4
- +26 IF BGPQUIT
- QUIT
- +27 KILL BGPDATA
- +28 ;antibiotic rx status?
- +29 DO ANTIRX^BGP8CU3(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),30),.BGPDATA)
- +30 DO WANTIRX^BGP8CPU3
- +31 IF BGPQUIT
- QUIT
- +32 DO ALLALG1^BGP8CU1(DFN,DT,$$DSCH^BGP8CU(BGPVINP),.BGPDATA)
- +33 DO WALLALG^BGP8CPU
- +34 IF BGPQUIT
- QUIT
- +35 KILL BGPDATA
- +36 DO ALLALGA1^BGP8CU1(DFN,DT,.BGPDATA)
- +37 DO WALLALGT^BGP8CPU
- +38 KILL BGPDATA
- +39 DO IVUD^BGP8CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP8CU(BGPVINP),,.BGPDATA)
- +40 DO WIVUD^BGP8CPU
- +41 QUIT
- +42 ;
- TRANSIN ;
- +1 IF $Y>(BGPIOSL-4)
- DO HDR^BGP8CP
- IF BGPQUIT
- QUIT
- DO L1H^BGP8CP
- +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^BGP8CP
- IF BGPQUIT
- QUIT
- DO L1H^BGP8CP
- +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 ;
