GMRVER1 ;HIRMFO/RM,YH-REPORT OF VITALS ENTERED IN ERROR FOR A PATIENT ;5/26/99 08:57
;;4.0;Vitals/Measurements;**1,7,11**;Apr 25, 1997
EN1 ; ENTRY TO REPORT FROM TASKMAN
D DEM^VADPT D NOW^%DTC S Y=% X ^DD("DD") S GMRPDT=$P(Y,"@")_" ("_$P($P(Y,"@",2),":",1,2)_")",(GMROUT,GMRPG)=0,GMR1ST=1,$P(GMRDSH,"-",81)=""
F GMRVITY=0:0 S GMRVITY=$O(^GMR(120.5,"AA",DFN,GMRVITY)) Q:GMRVITY'>0 F GMRVDT=0:0 S GMRVDT=$O(^GMR(120.5,"AA",DFN,GMRVITY,GMRVDT)) Q:GMRVDT'>0 S GMRVDATE=9999999-GMRVDT I GMRVDATE'<GMRVSDT,GMRVDATE'>GMRVFDT D SORT
U IO D HDR I $O(^TMP($J,0))'>0 W !,"THERE IS NO DATA FOR THIS REPORT" G QT
F GMRDATE=0:0 S GMRDATE=$O(^TMP($J,GMRDATE)) Q:GMRDATE'>0!GMROUT F GMRVITY=0:0 S GMRVITY=$O(^TMP($J,GMRDATE,GMRVITY)) Q:GMRVITY'>0!GMROUT F GMRVDA=0:0 S GMRVDA=$O(^TMP($J,GMRDATE,GMRVITY,GMRVDA)) Q:GMRVDA'>0 D WRT Q:GMROUT
QT ;
I IOSL'<($Y+8) F X=1:1 W ! Q:IOSL<($Y+8)
I 'GMROUT,$E(IOST)'="P" W !!,"Press return to continue ""^"" to escape " R X:DTIME
Q ; KILL VARIBLES
S:$D(ZTQUEUED) ZTREQ="@" K ^TMP($J),DFN,GMR1ST,GMRDAT,GMRDATE,GMRDSH,GMROUT,GMRPDT,GMRPG,GMRPR,GMRSITE,GMRVDA,GMRVDATE,GMRVDT,GMRVERR,GMRVFDT,GMRVITY,GMRVSDT,GMRVX,POP,DIPGM,GMRP,GMRTYPE,GMROV,DIPGM,%T D KVAR^VADPT K VA W:$E(IOST)'="C" @IOF
K GREASON,GMRZZ,GMRVARY,GX,GMRQUAL,GMRVPO D ^%ZISC Q
SORT ;
F GMRVERR=0:0 S GMRVERR=$O(^GMR(120.5,"AA",DFN,GMRVITY,GMRVDT,GMRVERR)) Q:GMRVERR'>0 I '$D(^GMR(120.5,GMRVERR,2)) Q
F GMRVDA=0:0 S GMRVDA=$O(^GMR(120.5,"AA",DFN,GMRVITY,GMRVDT,GMRVDA)) Q:GMRVDA'>0 I $D(^GMR(120.5,GMRVDA,2)) S ^TMP($J,GMRVDATE,GMRVITY,GMRVDA)=GMRVERR
Q
WRT ;
D:IOSL<($Y+8) HDR Q:GMROUT K GMRPR
S GMRVERR=^TMP($J,GMRDATE,GMRVITY,GMRVDA),GMRDAT("GOOD")=$S($D(^GMR(120.5,+GMRVERR,0)):^(0),1:"")
I $D(^GMR(120.5,+GMRVERR,0)) D
. K GMRVX S GMRVX=$P(^GMRD(120.51,GMRVITY,0),"^",2),GMRVX(0)=$P(GMRDAT("GOOD"),"^",8) D:GMRVX(0)>0!(GMRVX(0)=0) EN1^GMRVSAS0 S GMRVX(1)=$S('$D(GMRVX(1)):"",'GMRVX(1):"",1:"*")
. S GMRVX(0)=$$WRTDAT^GMRVER0(GMRVX,GMRVX(0))
. S GMRZZ="" I $P($G(^GMR(120.5,GMRVERR,5,0)),"^",4)>0 K GMRVARY S GMRVARY="" D CHAR^GMRVCHAR(GMRVERR,.GMRVARY,GMRVITY) S GMRZZ=$$WRITECH^GMRVCHAR(GMRVERR,.GMRVARY,9) S:GMRZZ'=""&(GMRVX'="PO2") GMRZZ=" ("_GMRZZ_")"
. I GMRVX="P" D
.. I GMRZZ'="",GMRVX(0)=1 S:$F(GMRZZ,"DORSALIS PEDIS")>0 GMRVX(1)=""
.. I GMRZZ'="",GMRVX(0)=0 S:$F(GMRZZ,"DORSALIS PEDIS")>0 GMRVX(1)="*"
.. Q
. S GMRVPO=$P(^GMR(120.5,GMRVERR,0),"^",10)
. S $P(GMRDAT("GOOD"),"^",8)=GMRVX(0)_GMRVX(1)_$S(GMRVPO'="":" with supplemental O2 "_$S(GMRVPO["l/min":$P(GMRVPO," l/min")_"L/min",1:"")_$S(GMRVPO["l/min":$P(GMRVPO," l/min",2),1:GMRVPO),1:"")_$S(GMRZZ'=""&(GMRVX="PO2"):" via ",1:"")_GMRZZ
. Q
I $D(^GMR(120.5,+GMRVDA,0)) D
. S GMRDAT("BAD")=$S($D(^GMR(120.5,+GMRVDA,0)):^(0),1:"")
. K GMRVX,GMRVX(0),GMRVX(1) S GMRVX=$P(^GMRD(120.51,GMRVITY,0),"^",2),GMRVX(0)=$P(GMRDAT("BAD"),"^",8) D:GMRVX(0)>0 EN1^GMRVSAS0 S GMRVX(1)=$S('$D(GMRVX(1)):"",'GMRVX(1):"",1:"*")
. S GMRVX(0)=$$WRTDAT^GMRVER0(GMRVX,GMRVX(0))
. S GMRZZ="" I $P($G(^GMR(120.5,GMRVDA,5,0)),"^",4)>0 K GMRVARY S GMRVARY="" D CHAR^GMRVCHAR(GMRVDA,.GMRVARY,GMRVITY) S GMRZZ=$$WRITECH^GMRVCHAR(GMRVDA,.GMRVARY,9) S:GMRZZ'=""&(GMRVX'="PO2") GMRZZ=" ("_GMRZZ_")"
. I GMRVX="P" D
.. I GMRZZ'="",GMRVX(0)=1 S:$F(GMRZZ,"DORSALIS PEDIS")>0 GMRVX(1)=""
.. I GMRZZ'="",GMRVX(0)=0 S:$F(GMRZZ,"DORSALIS PEDIS")>0 GMRVX(1)="*"
.. Q
. S GMRVPO=$P(^GMR(120.5,GMRVDA,0),"^",10)
. S $P(GMRDAT("BAD"),"^",8)=GMRVX(0)_GMRVX(1)_$S(GMRVPO'="":" with supplemental O2 "_$S(GMRVPO["l/min":$P(GMRVPO," l/min")_"L/min",1:"")_$S(GMRVPO["l/min":$P(GMRVPO," l/min",2),1:GMRVPO),1:"")_$S(GMRZZ'=""&(GMRVX="PO2"):" via ",1:"")_GMRZZ
. S GREASON="" D ERREASON^GMRVER0
S Y=GMRDATE D D^DIQ S GMRPR("VSDT")=Y
S GMRPR("ENUS")=$S($P(GMRDAT("BAD"),"^",6)="":"",$D(^VA(200,$P(GMRDAT("BAD"),"^",6),0)):$E($P(^(0),"^"),1,21),1:"")
S GMRPR("TYPE")=$S(GMRVITY="":"",$D(^GMRD(120.51,GMRVITY,0)):$P(^(0),"^"),1:"")
W !,GMRPR("VSDT"),?21,GMRPR("TYPE"),?58,GMRPR("ENUS"),!,?3,"Reason: ",GREASON
I $G(GMRVERR)>0 W !,?3,"(Revised) ",$P(GMRDAT("GOOD"),"^",8)
I GMRVX="PN" D
. I $P(GMRDAT("GOOD"),"^",8)=0 W " No pain" Q
. I $P(GMRDAT("GOOD"),"^",8)=99 W " Unable to respond" Q
. I $P(GMRDAT("GOOD"),"^",8)=10 W " Worst imaginable pain" Q
I GMRVDA>0 W !,?3,"(Bad data) ",$P(GMRDAT("BAD"),"^",8)
I GMRVX="PN" D
. I $P(GMRDAT("BAD"),"^",8)=0 W " No pain" Q
. I $P(GMRDAT("BAD"),"^",8)=99 W " Unable to respond" Q
. I $P(GMRDAT("BAD"),"^",8)=10 W " Worst imaginable pain" Q
W ! Q
HDR ;
I $E(IOST)'="P",'GMR1ST W !,"Press return to continue ""^"" to escape " R X:DTIME I X="^"!'$T S GMROUT=1 Q
W:'($E(IOST)'="C"&'GMRPG) @IOF S GMR1ST=0,GMRPG=GMRPG+1
W !,GMRPDT,?22,"ENTERED IN ERROR VITAL/MEASUREMENT REPORT",?70,"PAGE ",GMRPG
W !,"Patient: ",VADM(1),?$X+5,$P(VADM(2),"^",2),!!,"Date Vit./Meas. taken",?58,"User who made error",!,GMRDSH,!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRVER1 4881 printed Dec 13, 2024@01:56:23 Page 2
GMRVER1 ;HIRMFO/RM,YH-REPORT OF VITALS ENTERED IN ERROR FOR A PATIENT ;5/26/99 08:57
+1 ;;4.0;Vitals/Measurements;**1,7,11**;Apr 25, 1997
EN1 ; ENTRY TO REPORT FROM TASKMAN
+1 DO DEM^VADPT
DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET GMRPDT=$PIECE(Y,"@")_" ("_$PIECE($PIECE(Y,"@",2),":",1,2)_")"
SET (GMROUT,GMRPG)=0
SET GMR1ST=1
SET $PIECE(GMRDSH,"-",81)=""
+2 FOR GMRVITY=0:0
SET GMRVITY=$ORDER(^GMR(120.5,"AA",DFN,GMRVITY))
if GMRVITY'>0
QUIT
FOR GMRVDT=0:0
SET GMRVDT=$ORDER(^GMR(120.5,"AA",DFN,GMRVITY,GMRVDT))
if GMRVDT'>0
QUIT
SET GMRVDATE=9999999-GMRVDT
IF GMRVDATE'<GMRVSDT
IF GMRVDATE'>GMRVFDT
DO SORT
+3 USE IO
DO HDR
IF $ORDER(^TMP($JOB,0))'>0
WRITE !,"THERE IS NO DATA FOR THIS REPORT"
GOTO QT
+4 FOR GMRDATE=0:0
SET GMRDATE=$ORDER(^TMP($JOB,GMRDATE))
if GMRDATE'>0!GMROUT
QUIT
FOR GMRVITY=0:0
SET GMRVITY=$ORDER(^TMP($JOB,GMRDATE,GMRVITY))
if GMRVITY'>0!GMROUT
QUIT
FOR GMRVDA=0:0
SET GMRVDA=$ORDER(^TMP($JOB,GMRDATE,GMRVITY,GMRVDA))
if GMRVDA'>0
QUIT
DO WRT
if GMROUT
QUIT
QT ;
+1 IF IOSL'<($Y+8)
FOR X=1:1
WRITE !
if IOSL<($Y+8)
QUIT
+2 IF 'GMROUT
IF $EXTRACT(IOST)'="P"
WRITE !!,"Press return to continue ""^"" to escape "
READ X:DTIME
Q ; KILL VARIBLES
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
KILL ^TMP($JOB),DFN,GMR1ST,GMRDAT,GMRDATE,GMRDSH,GMROUT,GMRPDT,GMRPG,GMRPR,GMRSITE,GMRVDA,GMRVDATE,GMRVDT,GMRVERR,GMRVFDT,GMRVITY,GMRVSDT,GMRVX,POP,DIPGM,GMRP,GMRTYPE,GMROV,DIPGM,%T
DO KVAR^VADPT
KILL VA
if $EXTRACT(IOST)'="C"
WRITE @IOF
+2 KILL GREASON,GMRZZ,GMRVARY,GX,GMRQUAL,GMRVPO
DO ^%ZISC
QUIT
SORT ;
+1 FOR GMRVERR=0:0
SET GMRVERR=$ORDER(^GMR(120.5,"AA",DFN,GMRVITY,GMRVDT,GMRVERR))
if GMRVERR'>0
QUIT
IF '$DATA(^GMR(120.5,GMRVERR,2))
QUIT
+2 FOR GMRVDA=0:0
SET GMRVDA=$ORDER(^GMR(120.5,"AA",DFN,GMRVITY,GMRVDT,GMRVDA))
if GMRVDA'>0
QUIT
IF $DATA(^GMR(120.5,GMRVDA,2))
SET ^TMP($JOB,GMRVDATE,GMRVITY,GMRVDA)=GMRVERR
+3 QUIT
WRT ;
+1 if IOSL<($Y+8)
DO HDR
if GMROUT
QUIT
KILL GMRPR
+2 SET GMRVERR=^TMP($JOB,GMRDATE,GMRVITY,GMRVDA)
SET GMRDAT("GOOD")=$SELECT($DATA(^GMR(120.5,+GMRVERR,0)):^(0),1:"")
+3 IF $DATA(^GMR(120.5,+GMRVERR,0))
Begin DoDot:1
+4 KILL GMRVX
SET GMRVX=$PIECE(^GMRD(120.51,GMRVITY,0),"^",2)
SET GMRVX(0)=$PIECE(GMRDAT("GOOD"),"^",8)
if GMRVX(0)>0!(GMRVX(0)=0)
DO EN1^GMRVSAS0
SET GMRVX(1)=$SELECT('$DATA(GMRVX(1)):"",'GMRVX(1):"",1:"*")
+5 SET GMRVX(0)=$$WRTDAT^GMRVER0(GMRVX,GMRVX(0))
+6 SET GMRZZ=""
IF $PIECE($GET(^GMR(120.5,GMRVERR,5,0)),"^",4)>0
KILL GMRVARY
SET GMRVARY=""
DO CHAR^GMRVCHAR(GMRVERR,.GMRVARY,GMRVITY)
SET GMRZZ=$$WRITECH^GMRVCHAR(GMRVERR,.GMRVARY,9)
if GMRZZ'=""&(GMRVX'="PO2")
SET GMRZZ=" ("_GMRZZ_")"
+7 IF GMRVX="P"
Begin DoDot:2
+8 IF GMRZZ'=""
IF GMRVX(0)=1
if $FIND(GMRZZ,"DORSALIS PEDIS")>0
SET GMRVX(1)=""
+9 IF GMRZZ'=""
IF GMRVX(0)=0
if $FIND(GMRZZ,"DORSALIS PEDIS")>0
SET GMRVX(1)="*"
+10 QUIT
End DoDot:2
+11 SET GMRVPO=$PIECE(^GMR(120.5,GMRVERR,0),"^",10)
+12 SET $PIECE(GMRDAT("GOOD"),"^",8)=GMRVX(0)_GMRVX(1)_$SELECT(GMRVPO'="":" with supplemental O2 "_$SELECT(GMRVPO["l/min":...
... $PIECE(GMRVPO," l/min")_"L/min",1:"")_$SELECT(GMRVPO["l/min":$PIECE(GMRVPO," l/min",2),1:GMRVPO),1:"")_$SELECT(GMRZZ'=""&(GMRVX="PO2"):" via ",1:"")_GMRZZ
+13 QUIT
End DoDot:1
+14 IF $DATA(^GMR(120.5,+GMRVDA,0))
Begin DoDot:1
+15 SET GMRDAT("BAD")=$SELECT($DATA(^GMR(120.5,+GMRVDA,0)):^(0),1:"")
+16 KILL GMRVX,GMRVX(0),GMRVX(1)
SET GMRVX=$PIECE(^GMRD(120.51,GMRVITY,0),"^",2)
SET GMRVX(0)=$PIECE(GMRDAT("BAD"),"^",8)
if GMRVX(0)>0
DO EN1^GMRVSAS0
SET GMRVX(1)=$SELECT('$DATA(GMRVX(1)):"",'GMRVX(1):"",1:"*")
+17 SET GMRVX(0)=$$WRTDAT^GMRVER0(GMRVX,GMRVX(0))
+18 SET GMRZZ=""
IF $PIECE($GET(^GMR(120.5,GMRVDA,5,0)),"^",4)>0
KILL GMRVARY
SET GMRVARY=""
DO CHAR^GMRVCHAR(GMRVDA,.GMRVARY,GMRVITY)
SET GMRZZ=$$WRITECH^GMRVCHAR(GMRVDA,.GMRVARY,9)
if GMRZZ'=""&(GMRVX'="PO2")
SET GMRZZ=" ("_GMRZZ_")"
+19 IF GMRVX="P"
Begin DoDot:2
+20 IF GMRZZ'=""
IF GMRVX(0)=1
if $FIND(GMRZZ,"DORSALIS PEDIS")>0
SET GMRVX(1)=""
+21 IF GMRZZ'=""
IF GMRVX(0)=0
if $FIND(GMRZZ,"DORSALIS PEDIS")>0
SET GMRVX(1)="*"
+22 QUIT
End DoDot:2
+23 SET GMRVPO=$PIECE(^GMR(120.5,GMRVDA,0),"^",10)
+24 SET $PIECE(GMRDAT("BAD"),"^",8)=GMRVX(0)_GMRVX(1)_$SELECT(GMRVPO'="":" with supplemental O2 "_$SELECT(GMRVPO["l/min":...
... $PIECE(GMRVPO," l/min")_"L/min",1:"")_$SELECT(GMRVPO["l/min":$PIECE(GMRVPO," l/min",2),1:GMRVPO),1:"")_$SELECT(GMRZZ'=""&(GMRVX="PO2"):" via ",1:"")_GMRZZ
+25 SET GREASON=""
DO ERREASON^GMRVER0
End DoDot:1
+26 SET Y=GMRDATE
DO D^DIQ
SET GMRPR("VSDT")=Y
+27 SET GMRPR("ENUS")=$SELECT($PIECE(GMRDAT("BAD"),"^",6)="":"",$DATA(^VA(200,$PIECE(GMRDAT("BAD"),"^",6),0)):$EXTRACT($PIECE(^(0),"^"),1,21),1:"")
+28 SET GMRPR("TYPE")=$SELECT(GMRVITY="":"",$DATA(^GMRD(120.51,GMRVITY,0)):$PIECE(^(0),"^"),1:"")
+29 WRITE !,GMRPR("VSDT"),?21,GMRPR("TYPE"),?58,GMRPR("ENUS"),!,?3,"Reason: ",GREASON
+30 IF $GET(GMRVERR)>0
WRITE !,?3,"(Revised) ",$PIECE(GMRDAT("GOOD"),"^",8)
+31 IF GMRVX="PN"
Begin DoDot:1
+32 IF $PIECE(GMRDAT("GOOD"),"^",8)=0
WRITE " No pain"
QUIT
+33 IF $PIECE(GMRDAT("GOOD"),"^",8)=99
WRITE " Unable to respond"
QUIT
+34 IF $PIECE(GMRDAT("GOOD"),"^",8)=10
WRITE " Worst imaginable pain"
QUIT
End DoDot:1
+35 IF GMRVDA>0
WRITE !,?3,"(Bad data) ",$PIECE(GMRDAT("BAD"),"^",8)
+36 IF GMRVX="PN"
Begin DoDot:1
+37 IF $PIECE(GMRDAT("BAD"),"^",8)=0
WRITE " No pain"
QUIT
+38 IF $PIECE(GMRDAT("BAD"),"^",8)=99
WRITE " Unable to respond"
QUIT
+39 IF $PIECE(GMRDAT("BAD"),"^",8)=10
WRITE " Worst imaginable pain"
QUIT
End DoDot:1
+40 WRITE !
QUIT
HDR ;
+1 IF $EXTRACT(IOST)'="P"
IF 'GMR1ST
WRITE !,"Press return to continue ""^"" to escape "
READ X:DTIME
IF X="^"!'$TEST
SET GMROUT=1
QUIT
+2 if '($EXTRACT(IOST)'="C"&'GMRPG)
WRITE @IOF
SET GMR1ST=0
SET GMRPG=GMRPG+1
+3 WRITE !,GMRPDT,?22,"ENTERED IN ERROR VITAL/MEASUREMENT REPORT",?70,"PAGE ",GMRPG
+4 WRITE !,"Patient: ",VADM(1),?$X+5,$PIECE(VADM(2),"^",2),!!,"Date Vit./Meas. taken",?58,"User who made error",!,GMRDSH,!
+5 QUIT