BGP0CP3 ; IHS/CMI/LAB - IHS gpra print 02 Jul 2009 9:07 AM ;
;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
;
;
;
AMI4 ;EP
I $Y>(BGPIOSL-3) D HDR^BGP0CP Q:BGPQUIT D L1H^BGP0CP
D WDT^BGP0CPU(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP0CU(BGPVINP) D WTT^BGP0CPU(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP0CU(BGPVINP) D TRANSN Q:BGPQUIT
D WPPDPOV^BGP0CPU(BGPVSIT)
Q:BGPQUIT
D OTHDPOVS^BGP0CPU(BGPVSIT)
Q:BGPQUIT
K BGPDATA
S X=$$COMFORT^BGP0CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
D WCOMFORT^BGP0CPU(X)
Q:BGPQUIT
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,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($$DSCH^BGP0CU(BGPVINP),30),.BGPDATA)
D WCESSMED^BGP0CPU
K BGPDATA
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
;
AMI4W ;EP
I $Y>(BGPIOSL-3) D HDR^BGP0CP Q:BGPQUIT D L1H^BGP0CP
D WDOD^BGP0CPU(DFN)
D WDT^BGP0CPU(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP0CU(BGPVINP) D WTT^BGP0CPU(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP0CU(BGPVINP) D TRANSN Q:BGPQUIT
D WPPDPOV^BGP0CPU(BGPVSIT)
Q:BGPQUIT
D OTHDPOVS^BGP0CPU(BGPVSIT)
Q:BGPQUIT
K BGPDATA
S X=$$COMFORT^BGP0CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
D WCOMFORT^BGP0CPU(X)
Q:BGPQUIT
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
K BGPDATA
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
;
AMI8AW ;EP
S BGPASTER=0
I $Y>(BGPIOSL-3) D HDR^BGP0CP Q:BGPQUIT D L1H^BGP0CP
I $$TRANSIN^BGP0CU(BGPVINP) D TRANSIN Q:BGPQUIT
D WDT^BGP0CPU(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP0CU(BGPVINP) D WTT^BGP0CPU(BGPVINP)
Q:BGPQUIT
I $$TRANS^BGP0CU(BGPVINP) D TRANSN Q:BGPQUIT
D WPPDPOV^BGP0CPU(BGPVSIT)
Q:BGPQUIT
D OTHDPOVS^BGP0CPU(BGPVSIT)
Q:BGPQUIT
S X=$$COMFORT^BGP0CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
D WCOMFORT^BGP0CPU(X)
Q:BGPQUIT
;FIB MEDS
S BGPFIB=""
K BGPDATA
D TARX^BGP0CU2(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($$DSCH^BGP0CU(BGPVINP),30),0,$$DSCH^BGP0CU(BGPVINP),.BGPDATA)
K BGPUD
D IVUD^BGP0CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP0CU(BGPVINP),$O(^ATXAX("B","BGP CMS THROMBOLYTIC MEDS",0)),.BGPUD,"",$O(^ATXAX("B","BGP THROMBOLYTIC AGENTS CLASS",0)))
S BGPTAPRO=$$LASTPRCI^BGP0UTL1(DFN,"99.10",$P($P(BGPVSIT0,U),"."),$$DSCH^BGP0CU(BGPVINP)) I BGPTAPRO S BGPTAPRO=$$DATE^BGP0UTL($P(BGPTAPRO,U,3))_" ["_$P(BGPTAPRO,U,2)_"] "_$$VAL^XBDIQ1(9000010.08,$P(BGPTAPRO,U,5),.04)
D WFIB^BGP0CPU2
Q:BGPQUIT
K BGPST1
S BGPST1=$$LASTDX^BGP0UTL1(DFN,"BGP ST ELEVATION DX",$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$$DSCH^BGP0CU(BGPVINP))
I BGPST1 S BGPST1=$$DATE^BGP0UTL($P(BGPST1,U,3))_" ["_$P(BGPST1,U,2)_"] "_$$VAL^XBDIQ1(9000010.07,$P(BGPST1,U,5),.04)
D WST^BGP0CPU2
;LBBB ON ECG
K BGPLBPC,BGPLBDX
S BGPLBDX=$$LBBBDX^BGP0CU2(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$$DSCH^BGP0CU(BGPVINP)) I BGPLBDX S BGPLBDX=$$DATE^BGP0UTL($P(BGPLBDX,U,3))_" ["_$P(BGPLBDX,U,2)_"] "_$$VAL^XBDIQ1(9000010.07,$P(BGPLBDX,U,5),.04)
D LBBBPROC^BGP0CU2(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$$DSCH^BGP0CU(BGPVINP),.BGPLBPC)
D WLBBB^BGP0CPU2
Q:BGPQUIT
S BGPPCI=$$LASTPRCI^BGP0UTL1(DFN,"00.66",$P($P(BGPVSIT0,U),"."),$$DSCH^BGP0CU(BGPVINP)) I BGPPCI S BGPPCI=$$DATE^BGP0UTL($P(BGPPCI,U,3))_" ["_$P(BGPPCI,U,2)_"] "_$$VAL^XBDIQ1(9000010.08,$P(BGPPCI,U,5),.04)
D WPCI^BGP0CPU2
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 ;EP
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
;
BGP0CP3 ; IHS/CMI/LAB - IHS gpra print 02 Jul 2009 9:07 AM ;
+1 ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
+2 ;
+3 ;
+4 ;
AMI4 ;EP
+1 IF $Y>(BGPIOSL-3)
DO HDR^BGP0CP
IF BGPQUIT
QUIT
DO L1H^BGP0CP
+2 DO WDT^BGP0CPU(BGPVINP)
+3 IF BGPQUIT
QUIT
+4 IF $$TRANS^BGP0CU(BGPVINP)
DO WTT^BGP0CPU(BGPVINP)
+5 IF BGPQUIT
QUIT
+6 IF $$TRANS^BGP0CU(BGPVINP)
DO TRANSN
IF BGPQUIT
QUIT
+7 DO WPPDPOV^BGP0CPU(BGPVSIT)
+8 IF BGPQUIT
QUIT
+9 DO OTHDPOVS^BGP0CPU(BGPVSIT)
+10 IF BGPQUIT
QUIT
+11 KILL BGPDATA
+12 SET X=$$COMFORT^BGP0CU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."))
+13 DO WCOMFORT^BGP0CPU(X)
+14 IF BGPQUIT
QUIT
+15 KILL BGPDATA
+16 SET BGPC=0
+17 DO SMOKER^BGP0CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$DSCH^BGP0CU(BGPVINP),.BGPDATA)
+18 DO WSMOKER^BGP0CPU
+19 IF BGPQUIT
QUIT
+20 KILL BGPDATA
+21 DO CESS^BGP0CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP0CU(BGPVINP),.BGPDATA)
+22 DO WCESS^BGP0CPU
+23 IF BGPQUIT
QUIT
+24 KILL BGPDATA
+25 DO CESSMEDS^BGP0CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($$DSCH^BGP0CU(BGPVINP),30),.BGPDATA)
+26 DO WCESSMED^BGP0CPU
+27 KILL BGPDATA
+28 IF BGPQUIT
QUIT
+29 DO ALLALG1^BGP0CU1(DFN,DT,$$DSCH^BGP0CU(BGPVINP),.BGPDATA)
+30 DO WALLALG^BGP0CPU
+31 IF BGPQUIT
QUIT
+32 KILL BGPDATA
+33 DO ALLALGA1^BGP0CU1(DFN,DT,.BGPDATA)
+34 DO WALLALGT^BGP0CPU
+35 KILL BGPDATA
+36 DO IVUD^BGP0CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP0CU(BGPVINP),,.BGPDATA)
+37 DO WIVUD^BGP0CPU
+38 QUIT
+39 ;
AMI4W ;EP
+1 IF $Y>(BGPIOSL-3)
DO HDR^BGP0CP
IF BGPQUIT
QUIT
DO L1H^BGP0CP
+2 DO WDOD^BGP0CPU(DFN)
+3 DO WDT^BGP0CPU(BGPVINP)
+4 IF BGPQUIT
QUIT
+5 IF $$TRANS^BGP0CU(BGPVINP)
DO WTT^BGP0CPU(BGPVINP)
+6 IF BGPQUIT
QUIT
+7 IF $$TRANS^BGP0CU(BGPVINP)
DO TRANSN
IF BGPQUIT
QUIT
+8 DO WPPDPOV^BGP0CPU(BGPVSIT)
+9 IF BGPQUIT
QUIT
+10 DO OTHDPOVS^BGP0CPU(BGPVSIT)
+11 IF BGPQUIT
QUIT
+12 KILL BGPDATA
+13 SET X=$$COMFORT^BGP0CU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."))
+14 DO WCOMFORT^BGP0CPU(X)
+15 IF BGPQUIT
QUIT
+16 KILL BGPDATA
+17 SET BGPC=0
+18 DO SMOKER^BGP0CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$DSCH^BGP0CU(BGPVINP),.BGPDATA)
+19 DO WSMOKER^BGP0CPU
+20 IF BGPQUIT
QUIT
+21 KILL BGPDATA
+22 DO CESS^BGP0CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP0CU(BGPVINP),.BGPDATA)
+23 DO WCESS^BGP0CPU
+24 IF BGPQUIT
QUIT
+25 KILL BGPDATA
+26 DO CESSMEDS^BGP0CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP0CU(BGPVINP),.BGPDATA)
+27 DO WCESSMED^BGP0CPU
+28 KILL BGPDATA
+29 IF BGPQUIT
QUIT
+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 ;
AMI8AW ;EP
+1 SET BGPASTER=0
+2 IF $Y>(BGPIOSL-3)
DO HDR^BGP0CP
IF BGPQUIT
QUIT
DO L1H^BGP0CP
+3 IF $$TRANSIN^BGP0CU(BGPVINP)
DO TRANSIN
IF BGPQUIT
QUIT
+4 DO WDT^BGP0CPU(BGPVINP)
+5 IF BGPQUIT
QUIT
+6 IF $$TRANS^BGP0CU(BGPVINP)
DO WTT^BGP0CPU(BGPVINP)
+7 IF BGPQUIT
QUIT
+8 IF $$TRANS^BGP0CU(BGPVINP)
DO TRANSN
IF BGPQUIT
QUIT
+9 DO WPPDPOV^BGP0CPU(BGPVSIT)
+10 IF BGPQUIT
QUIT
+11 DO OTHDPOVS^BGP0CPU(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^BGP0CPU(X)
+15 IF BGPQUIT
QUIT
+16 ;FIB MEDS
+17 SET BGPFIB=""
+18 KILL BGPDATA
+19 DO TARX^BGP0CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($$DSCH^BGP0CU(BGPVINP),30),0,$$DSCH^BGP0CU(BGPVINP),.BGPDATA)
+20 KILL BGPUD
+21 DO IVUD^BGP0CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP0CU(BGPVINP),$ORDER(^ATXAX("B","BGP CMS THROMBOLYTIC MEDS",0)),.BGPUD,"",$ORDER(^ATXAX("B","BGP THROMBOLYTIC AGENTS CLASS",0)))
+22 SET BGPTAPRO=$$LASTPRCI^BGP0UTL1(DFN,"99.10",$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP0CU(BGPVINP))
IF BGPTAPRO
SET BGPTAPRO=$$DATE^BGP0UTL($PIECE(BGPTAPRO,U,3))_" ["_$PIECE(BGPTAPRO,U,2)_"] "_$$VAL^XBDIQ1(9000010.08,$PIECE(BGPTAPRO,U,5),.04)
+23 DO WFIB^BGP0CPU2
+24 IF BGPQUIT
QUIT
+25 KILL BGPST1
+26 SET BGPST1=$$LASTDX^BGP0UTL1(DFN,"BGP ST ELEVATION DX",$$FMADD^XLFDT($PIECE($PIECE(BGPVSIT0,U),"."),-1),$$DSCH^BGP0CU(BGPVINP))
+27 IF BGPST1
SET BGPST1=$$DATE^BGP0UTL($PIECE(BGPST1,U,3))_" ["_$PIECE(BGPST1,U,2)_"] "_$$VAL^XBDIQ1(9000010.07,$PIECE(BGPST1,U,5),.04)
+28 DO WST^BGP0CPU2
+29 ;LBBB ON ECG
+30 KILL BGPLBPC,BGPLBDX
+31 SET BGPLBDX=$$LBBBDX^BGP0CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(BGPVSIT0,U),"."),-1),$$DSCH^BGP0CU(BGPVINP))
IF BGPLBDX
SET BGPLBDX=$$DATE^BGP0UTL($PIECE(BGPLBDX,U,3))_" ["_$PIECE(BGPLBDX,U,2)_"] "_$$VAL^XBDIQ1(9000010.07,$PIECE(BGPLBDX,U,5),.04)
+32 DO LBBBPROC^BGP0CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(BGPVSIT0,U),"."),-1),$$DSCH^BGP0CU(BGPVINP),.BGPLBPC)
+33 DO WLBBB^BGP0CPU2
+34 IF BGPQUIT
QUIT
+35 SET BGPPCI=$$LASTPRCI^BGP0UTL1(DFN,"00.66",$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP0CU(BGPVINP))
IF BGPPCI
SET BGPPCI=$$DATE^BGP0UTL($PIECE(BGPPCI,U,3))_" ["_$PIECE(BGPPCI,U,2)_"] "_$$VAL^XBDIQ1(9000010.08,$PIECE(BGPPCI,U,5),.04)
+36 DO WPCI^BGP0CPU2
+37 IF BGPQUIT
QUIT
+38 DO ALLALG1^BGP0CU1(DFN,DT,$$DSCH^BGP0CU(BGPVINP),.BGPDATA)
+39 DO WALLALG^BGP0CPU
+40 IF BGPQUIT
QUIT
+41 KILL BGPDATA
+42 DO ALLALGA1^BGP0CU1(DFN,DT,.BGPDATA)
+43 DO WALLALGT^BGP0CPU
+44 KILL BGPDATA
+45 DO IVUD^BGP0CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP0CU(BGPVINP),,.BGPDATA)
+46 DO WIVUD^BGP0CPU
+47 QUIT
+48 ;
TRANSIN ;EP
+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 ;
