BEHOVMER ;MSC/IND/MGH - VITALS ENTERED IN ERROR REPORT ;07-Jun-2010 11:06;MGH
;;1.1;BEH COMPONENTS;**001004,001005**;Mar 20, 2007
;=================================================================
EN1 ; EP Entry point
D DEM^VADPT D NOW^%DTC S Y=% X ^DD("DD") S BEHPDT=$P(Y,"@")_" ("_$P($P(Y,"@",2),":",1,2)_")",(BEHOUT,BEHPG)=0,BEH1ST=1,$P(BEHDSH,"-",81)=""
F BEHVITY=0:0 S BEHVITY=$O(^AUPNVMSR("AE",DFN,BEHVITY)) Q:BEHVITY'>0 F BEHVDT=0:0 S BEHVDT=$O(^AUPNVMSR("AE",DFN,BEHVITY,BEHVDT)) Q:BEHVDT'>0 S BEHVDATE=9999999-BEHVDT I BEHVDATE'<BEHVSDT,BEHVDATE'>BEHVFDT D SORT
U IO D HDR I $O(^TMP("BEHOERR",$J,0))'>0 W !,"THERE IS NO DATA FOR THIS REPORT" G QT
F BEHDATE=0:0 S BEHDATE=$O(^TMP("BEHOERR",$J,BEHDATE)) Q:BEHDATE'>0!BEHOUT D
.F BEHVITY=0:0 S BEHVITY=$O(^TMP("BEHOERR",$J,BEHDATE,BEHVITY)) Q:BEHVITY'>0!BEHOUT D
..F BEHVDA=0:0 S BEHVDA=$O(^TMP("BEHOERR",$J,BEHDATE,BEHVITY,BEHVDA)) Q:BEHVDA'>0 D WRT Q:BEHOUT
QT ;
I IOSL'<($Y+8) F X=1:1 W ! Q:IOSL<($Y+8)
I 'BEHOUT,$E(IOST)'="P" W !!,"Press return to continue ""^"" to escape " R X:DTIME
Q ; KILL VARIBLES
K ^TMP("BEHOERR",$J),DFN,BEH1ST,BEHDAT,BEHDATE,BEHDSH,BEHOUT,BEHPDT,BEHPG,BEHPR,BEHSITE,BEHVDA,BEHVDATE,BEHVDT,BEHVERR
K BEHVFDT,BEHVITY,BEHVSDT,BEHVX,POP,DIPGM,BEHP,BEHTYPE,BEHOV,DIPGM,%T,%
D KVAR^VADPT K VA
K GREASON,BEHZZ,BEHTAKEN,BEHVARY,GX,BEHQUAL,BEHVPO D ^%ZISC Q
SORT ;
F BEHVDA=0:0 S BEHVDA=$O(^AUPNVMSR("AE",DFN,BEHVITY,BEHVDT,BEHVDA)) Q:BEHVDA'>0 D
.I $D(^AUPNVMSR(BEHVDA,2)) D
..S BEHVERR=$G(^AUPNVMSR(BEHVDA,0))
..;Get the time taken
..S BEHTAKEN=$P($G(^AUPNVMSR(BEHVDA,12)),U,1)
..S BEHTAKEN=9999999-BEHTAKEN
..I BEHTAKEN="" S BEHTAKEN=BEHVDT
..S ^TMP("BEHOERR",$J,BEHTAKEN,BEHVITY,BEHVDA)=BEHVERR
Q
WRT ;
D:IOSL<($Y+8) HDR Q:BEHOUT K BEHPR
S BEHVERR=^TMP("BEHOERR",$J,BEHDATE,BEHVITY,BEHVDA)
I $D(^AUPNVMSR(BEHVDA,0)) D
. S BEHDAT("BAD")=$S($D(^AUPNVMSR(+BEHVDA,0)):^(0),1:"")
. K BEHVX,BEHVX(0),BEHVX(1)
. S BEHVX=$P(^AUTTMSR(BEHVITY,0),"^",2)
. S BEHVX(0)=$P(BEHDAT("BAD"),"^",4) D
..I BEHVX(0)>0 S BEHVX(0)=$$VALUE(BEHVITY,BEHVX(0)) S BEHVX(1)=""
. S BEHZZ="" I +$D(^AUPNVMSR(BEHVDA,5)) K BEHVARY S BEHVARY="" D
..S BEHZZ=$$QUAL^BEHOVMC2(BEHVDA)
..S BEHVX(1)=" ("_BEHZZ_")"
. S BEHVPO=$P($G(^AUPNVSMR(BEHVDA,0)),"^",10)
. S $P(BEHDAT("BAD"),"^",4)=BEHVX(0)_BEHVX(1)_$S(BEHVPO'="":" with supplemental O2 "_$S(BEHVPO["l/min":$P(BEHVPO," l/min")_"L/min",1:"")_$S(BEHVPO["l/min":$P(BEHVPO," l/min",2),1:BEHVPO),1:"")_$S(BEHZZ'=""&(BEHVX="O2"):" via ",1:"")
. S GREASON="" D ERREASON
S Y=9999999-BEHDATE D D^DIQ S BEHPR("VSDT")=Y
S EIE=$P($G(^AUPNVMSR(BEHVDA,2)),U,2)
I EIE'="" S BEHPR("ENUS")=$P($G(^VA(200,EIE,0)),U,1)
E S BEHPR("ENUS")=""
S BEHPR("TYPE")=$S(BEHVITY="":"",$D(^AUTTMSR(BEHVITY,0)):$P(^(0),"^"),1:"")
W !,BEHPR("VSDT"),?23,BEHPR("TYPE"),?58,BEHPR("ENUS"),!,?3,"Reason: ",GREASON
I BEHVDA>0 W !,?3,"(Bad data) ",$P(BEHDAT("BAD"),"^",4)
W ! Q
HDR ;
I $E(IOST)'="P",'BEH1ST W !,"Press return to continue ""^"" to escape " R X:DTIME I X="^"!'$T S GMROUT=1 Q
W:'($E(IOST)'="C"&'BEHPG) @IOF S BEH1ST=0,BEHPG=BEHPG+1
W !,BEHPDT,?22,"ENTERED IN ERROR VITAL/MEASUREMENT REPORT",?70,"PAGE ",BEHPG
W !,"Patient: ",VADM(1),?$X+5,$P(VADM(2),"^",2),!!,"Date Vit./Meas. taken",?58,"User who made error",!,BEHDSH,!
Q
VALUE(TYPE,DATA) ;Get the value for this result
N TYP,VAL,AGE,BEH,DATAG,DEFAULT,DEFU,ALTU,VALUE
S TYP=$P(^AUPNVMSR(BEHVDA,0),U)
S VAL=$P($G(^AUPNVMSR(BEHVDA,0)),U,4)
S:'$G(DAT) DAT=DT
S AGE=$$PTAGE^BGOUTL(DFN,$S(X:X,1:DAT))
S TYP=$P($G(^BEHOVM(90460.01,TYP,0)),U,7)
S BEH="" S BEH=$O(^BEHOVM(90460.01,"B",TYP,BEH))
I TYP="" S VALUE=$$RND(VAL)
E D
.S DATAG=$G(^BEHOVM(90460.01,BEH,0))
.S DEFAULT=$P(DATAG,U,2)
.I DEFAULT=1 D
..S DEFU=$P(DATAG,U,4),ALTU=$P(DATAG,U,3)
..I ALTU=""!(DEFU=ALTU) S VALUE=$$RND(VAL)_" "_DEFU
..E S X=VAL I $D(^BEHOVM(90460.01,BEH,2)) X $G(^BEHOVM(90460.01,BEH,2)) D
...S VALUE=$$RND(VAL)_" "_DEFU_" ("_$$RND(X)_" "_ALTU_")"
.I DEFAULT=0 D
..S DEFU=$P(DATAG,U,3),ALTU=$P(DATAG,U,4)
..I ALTU=""!(DEFU=ALTU) S VALUE=$$RND(VAL)_" "_DEFU
..E S X=VAL I $D(^BEHOVM(90460.01,BEH,1)) X $G(^BEHOVM(90460.01,BEH,1)) D
...S VALUE=$$RND(VAL)_" "_DEFU_" ("_$$RND(X)_" "_ALTU_")"
.I DEFAULT="" S VALUE=$$RND(VAL)
Q VALUE
ERREASON ;Reason for entered in error
Q:'$D(^AUPNVMSR(+BEHVDA,2.1))
S GER=0 F S GER=$O(^AUPNVMSR(+BEHVDA,2.1,GER)) Q:GER'>0 S GER(1)=$G(^AUPNVMSR(+BEHVDA,2.1,GER,0)) D
. S GER(2)=$S(GER(1)=1:"incorrect date/time",GER(1)=2:"incorrect reading",GER(1)=3:"incorrect patient",GER(1)=4:"invalid record",1:GER(1))
. I GER(2)'="" S GREASON=GREASON_$S(GREASON'="":", ",1:"")_GER(2)
.Q
K GER Q
RND(X) Q $S(X=+X:+$J(X,0,2),1:X)
BEHOVMER ;MSC/IND/MGH - VITALS ENTERED IN ERROR REPORT ;07-Jun-2010 11:06;MGH
+1 ;;1.1;BEH COMPONENTS;**001004,001005**;Mar 20, 2007
+2 ;=================================================================
EN1 ; EP Entry point
+1 DO DEM^VADPT
DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET BEHPDT=$PIECE(Y,"@")_" ("_$PIECE($PIECE(Y,"@",2),":",1,2)_")"
SET (BEHOUT,BEHPG)=0
SET BEH1ST=1
SET $PIECE(BEHDSH,"-",81)=""
+2 FOR BEHVITY=0:0
SET BEHVITY=$ORDER(^AUPNVMSR("AE",DFN,BEHVITY))
IF BEHVITY'>0
QUIT
FOR BEHVDT=0:0
SET BEHVDT=$ORDER(^AUPNVMSR("AE",DFN,BEHVITY,BEHVDT))
IF BEHVDT'>0
QUIT
SET BEHVDATE=9999999-BEHVDT
IF BEHVDATE'<BEHVSDT
IF BEHVDATE'>BEHVFDT
DO SORT
+3 USE IO
DO HDR
IF $ORDER(^TMP("BEHOERR",$JOB,0))'>0
WRITE !,"THERE IS NO DATA FOR THIS REPORT"
GOTO QT
+4 FOR BEHDATE=0:0
SET BEHDATE=$ORDER(^TMP("BEHOERR",$JOB,BEHDATE))
IF BEHDATE'>0!BEHOUT
QUIT
Begin DoDot:1
+5 FOR BEHVITY=0:0
SET BEHVITY=$ORDER(^TMP("BEHOERR",$JOB,BEHDATE,BEHVITY))
IF BEHVITY'>0!BEHOUT
QUIT
Begin DoDot:2
+6 FOR BEHVDA=0:0
SET BEHVDA=$ORDER(^TMP("BEHOERR",$JOB,BEHDATE,BEHVITY,BEHVDA))
IF BEHVDA'>0
QUIT
DO WRT
IF BEHOUT
QUIT
End DoDot:2
End DoDot:1
QT ;
+1 IF IOSL'<($Y+8)
FOR X=1:1
WRITE !
IF IOSL<($Y+8)
QUIT
+2 IF 'BEHOUT
IF $EXTRACT(IOST)'="P"
WRITE !!,"Press return to continue ""^"" to escape "
READ X:DTIME
Q ; KILL VARIBLES
+1 KILL ^TMP("BEHOERR",$JOB),DFN,BEH1ST,BEHDAT,BEHDATE,BEHDSH,BEHOUT,BEHPDT,BEHPG,BEHPR,BEHSITE,BEHVDA,BEHVDATE,BEHVDT,BEHVERR
+2 KILL BEHVFDT,BEHVITY,BEHVSDT,BEHVX,POP,DIPGM,BEHP,BEHTYPE,BEHOV,DIPGM,%T,%
+3 DO KVAR^VADPT
KILL VA
+4 KILL GREASON,BEHZZ,BEHTAKEN,BEHVARY,GX,BEHQUAL,BEHVPO
DO ^%ZISC
QUIT
SORT ;
+1 FOR BEHVDA=0:0
SET BEHVDA=$ORDER(^AUPNVMSR("AE",DFN,BEHVITY,BEHVDT,BEHVDA))
IF BEHVDA'>0
QUIT
Begin DoDot:1
+2 IF $DATA(^AUPNVMSR(BEHVDA,2))
Begin DoDot:2
+3 SET BEHVERR=$GET(^AUPNVMSR(BEHVDA,0))
+4 ;Get the time taken
+5 SET BEHTAKEN=$PIECE($GET(^AUPNVMSR(BEHVDA,12)),U,1)
+6 SET BEHTAKEN=9999999-BEHTAKEN
+7 IF BEHTAKEN=""
SET BEHTAKEN=BEHVDT
+8 SET ^TMP("BEHOERR",$JOB,BEHTAKEN,BEHVITY,BEHVDA)=BEHVERR
End DoDot:2
End DoDot:1
+9 QUIT
WRT ;
+1 IF IOSL<($Y+8)
DO HDR
IF BEHOUT
QUIT
KILL BEHPR
+2 SET BEHVERR=^TMP("BEHOERR",$JOB,BEHDATE,BEHVITY,BEHVDA)
+3 IF $DATA(^AUPNVMSR(BEHVDA,0))
Begin DoDot:1
+4 SET BEHDAT("BAD")=$SELECT($DATA(^AUPNVMSR(+BEHVDA,0)):^(0),1:"")
+5 KILL BEHVX,BEHVX(0),BEHVX(1)
+6 SET BEHVX=$PIECE(^AUTTMSR(BEHVITY,0),"^",2)
+7 SET BEHVX(0)=$PIECE(BEHDAT("BAD"),"^",4)
Begin DoDot:2
+8 IF BEHVX(0)>0
SET BEHVX(0)=$$VALUE(BEHVITY,BEHVX(0))
SET BEHVX(1)=""
End DoDot:2
+9 SET BEHZZ=""
IF +$DATA(^AUPNVMSR(BEHVDA,5))
KILL BEHVARY
SET BEHVARY=""
Begin DoDot:2
+10 SET BEHZZ=$$QUAL^BEHOVMC2(BEHVDA)
+11 SET BEHVX(1)=" ("_BEHZZ_")"
End DoDot:2
+12 SET BEHVPO=$PIECE($GET(^AUPNVSMR(BEHVDA,0)),"^",10)
+13 SET $PIECE(BEHDAT("BAD"),"^",4)=BEHVX(0)_BEHVX(1)_$SELECT(BEHVPO'="":" with supplemental O2 "_$SELECT(BEHVPO["l/min":$PIECE(BEHVPO," l/min")_"L/min",1:"")_...
... $SELECT(BEHVPO["l/min":$PIECE(BEHVPO," l/min",2),1:BEHVPO),1:"")_$SELECT(BEHZZ'=""&(BEHVX="O2"):" via ",1:"")
+14 SET GREASON=""
DO ERREASON
End DoDot:1
+15 SET Y=9999999-BEHDATE
DO D^DIQ
SET BEHPR("VSDT")=Y
+16 SET EIE=$PIECE($GET(^AUPNVMSR(BEHVDA,2)),U,2)
+17 IF EIE'=""
SET BEHPR("ENUS")=$PIECE($GET(^VA(200,EIE,0)),U,1)
+18 IF '$TEST
SET BEHPR("ENUS")=""
+19 SET BEHPR("TYPE")=$SELECT(BEHVITY="":"",$DATA(^AUTTMSR(BEHVITY,0)):$PIECE(^(0),"^"),1:"")
+20 WRITE !,BEHPR("VSDT"),?23,BEHPR("TYPE"),?58,BEHPR("ENUS"),!,?3,"Reason: ",GREASON
+21 IF BEHVDA>0
WRITE !,?3,"(Bad data) ",$PIECE(BEHDAT("BAD"),"^",4)
+22 WRITE !
QUIT
HDR ;
+1 IF $EXTRACT(IOST)'="P"
IF 'BEH1ST
WRITE !,"Press return to continue ""^"" to escape "
READ X:DTIME
IF X="^"!'$TEST
SET GMROUT=1
QUIT
+2 IF '($EXTRACT(IOST)'="C"&'BEHPG)
WRITE @IOF
SET BEH1ST=0
SET BEHPG=BEHPG+1
+3 WRITE !,BEHPDT,?22,"ENTERED IN ERROR VITAL/MEASUREMENT REPORT",?70,"PAGE ",BEHPG
+4 WRITE !,"Patient: ",VADM(1),?$X+5,$PIECE(VADM(2),"^",2),!!,"Date Vit./Meas. taken",?58,"User who made error",!,BEHDSH,!
+5 QUIT
VALUE(TYPE,DATA) ;Get the value for this result
+1 NEW TYP,VAL,AGE,BEH,DATAG,DEFAULT,DEFU,ALTU,VALUE
+2 SET TYP=$PIECE(^AUPNVMSR(BEHVDA,0),U)
+3 SET VAL=$PIECE($GET(^AUPNVMSR(BEHVDA,0)),U,4)
+4 IF '$GET(DAT)
SET DAT=DT
+5 SET AGE=$$PTAGE^BGOUTL(DFN,$SELECT(X:X,1:DAT))
+6 SET TYP=$PIECE($GET(^BEHOVM(90460.01,TYP,0)),U,7)
+7 SET BEH=""
SET BEH=$ORDER(^BEHOVM(90460.01,"B",TYP,BEH))
+8 IF TYP=""
SET VALUE=$$RND(VAL)
+9 IF '$TEST
Begin DoDot:1
+10 SET DATAG=$GET(^BEHOVM(90460.01,BEH,0))
+11 SET DEFAULT=$PIECE(DATAG,U,2)
+12 IF DEFAULT=1
Begin DoDot:2
+13 SET DEFU=$PIECE(DATAG,U,4)
SET ALTU=$PIECE(DATAG,U,3)
+14 IF ALTU=""!(DEFU=ALTU)
SET VALUE=$$RND(VAL)_" "_DEFU
+15 IF '$TEST
SET X=VAL
IF $DATA(^BEHOVM(90460.01,BEH,2))
XECUTE $GET(^BEHOVM(90460.01,BEH,2))
Begin DoDot:3
+16 SET VALUE=$$RND(VAL)_" "_DEFU_" ("_$$RND(X)_" "_ALTU_")"
End DoDot:3
End DoDot:2
+17 IF DEFAULT=0
Begin DoDot:2
+18 SET DEFU=$PIECE(DATAG,U,3)
SET ALTU=$PIECE(DATAG,U,4)
+19 IF ALTU=""!(DEFU=ALTU)
SET VALUE=$$RND(VAL)_" "_DEFU
+20 IF '$TEST
SET X=VAL
IF $DATA(^BEHOVM(90460.01,BEH,1))
XECUTE $GET(^BEHOVM(90460.01,BEH,1))
Begin DoDot:3
+21 SET VALUE=$$RND(VAL)_" "_DEFU_" ("_$$RND(X)_" "_ALTU_")"
End DoDot:3
End DoDot:2
+22 IF DEFAULT=""
SET VALUE=$$RND(VAL)
End DoDot:1
+23 QUIT VALUE
ERREASON ;Reason for entered in error
+1 IF '$DATA(^AUPNVMSR(+BEHVDA,2.1))
QUIT
+2 SET GER=0
FOR
SET GER=$ORDER(^AUPNVMSR(+BEHVDA,2.1,GER))
IF GER'>0
QUIT
SET GER(1)=$GET(^AUPNVMSR(+BEHVDA,2.1,GER,0))
Begin DoDot:1
+3 SET GER(2)=$SELECT(GER(1)=1:"incorrect date/time",GER(1)=2:"incorrect reading",GER(1)=3:"incorrect patient",GER(1)=4:"invalid record",1:GER(1))
+4 IF GER(2)'=""
SET GREASON=GREASON_$SELECT(GREASON'="":", ",1:"")_GER(2)
+5 QUIT
End DoDot:1
+6 KILL GER
QUIT
RND(X) QUIT $SELECT(X=+X:+$JUSTIFY(X,0,2),1:X)
