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