GMRVED1 ;HIRMFO/RM,YH-VITAL SIGNS EDIT SHORT FORM (cont.) ;3/14/99 15:11
;;4.0;Vitals/Measurements;**1,6,7,11**;Apr 25, 1997
EN2 ; ENTRY FROM GMRVED0 TO ENTER THE DATA FOR A PATIENT DEFINED BY DFN
D DSPOV^GMRVED4 I GMRSTR(0)=";" W:GMRENTY<5 !,$C(7) Q
CHANGE S (GMRHELP,GMRPRMT,GMRHELP(1),GREASON)="" F GMRX=2:1:$L(GMRSTR(0),";")-1 D SETPRMT^GMRVED2
S GMRPRMT=GMRPRMT_": ",GMRSTAR=0
ASK ;
Q:GMROUT S GLINE=0 W:$L(GMRSTR,";")>2 !,"To omit entering a vital/measurement reading:",!,"Enter 'N' or 'n' for the value when NOT documenting a reason for omission." S GLINE=$G(GLINE)+1 D CHECK^GMRVUT1
W !,"Enter an * for the specific value when documenting the reason for omission.",! S GLINE=GLINE+1 D CHECK^GMRVUT1
W "Enter a single * to document that all measurements were omitted and the",!,"reason for omission." S GLINE=GLINE+2 D CHECK^GMRVUT1 W !!,GMRPRMT S GLINE=GLINE+1 R GMRDAT:DTIME
S:'$T GMRTO=1 I GMRDAT="^"!'$T S GMROUT=1 Q
K GMRSITE
I GMRDAT="" W !!,$C(7),"NO DATA ENTERED",! S GMROUT=1 Q
I GMRDAT["*" S GREASON=$$EN2^GMRVED6(GREASON)
Q:GMROUT I GMRDAT="*" G STAR
I GMRENTY'=21,($E(GMRDAT,1)["-")!(GMRDAT?.E1"--") W !!,$C(7),"ERRONEOUS ENTRY",! G ASK
F GMRX=2:1:$L(GMRSTR(0),";")-1 D CHKSTR Q:GMROUT
I GMROUT S GMROUT=0 G ASK
F GMRX=2:1:$L(GMRSTR(0),";")-1 D CHKDAT Q:GMROUT
STAR Q:GMROUT!(+$G(GMROUT(1)))
W ! S GMRDAT(0)=0 F GMRY=2:1:$L(GMRSTR(0),";")-1 S GMRX=$P(GMRSTR(0),";",GMRY) D
. I GMRDAT="*" S GMRDAT(GMRX)=GREASON
. I $D(GMRDAT(GMRX)),GMRDAT(GMRX)'="" S GMRDAT(0)=1 D WOK
ASK1 ;
I 'GMRDAT(0) W !,$C(7),"NO DATA ENTERED",! S GMROUT=1 Q
W !,"Is this correct? YES// " R GMRX:DTIME
S:'$T GMRTO=1 I GMRX="^"!'$T S GMROUT=1 W !,$C(7),"DATA DELETED",! Q
I GMRX?1"N".E!(GMRX?1"n".E) K:$D(GMRSITE("BP"))&($D(GMRQUAL("BP"))) GBP(GMRSITE("BP")_"/"_GMRQUAL("BP")) W ! G ASK
I GMRX=""!(GMRX?1"Y".E)!(GMRX?1"y".E) G AR1
W !,"ANSWER YES OR NO",*7 G ASK1
AR1 W !
Q
CHKSTR ; CHECK THE INPUT STRING TO SEE IF IT IS VALID
S GMRY=$P(GMRSTR(0),";",GMRX)
S GMRY(1)=$S(GMRY="T":1,GMRY="P"!(GMRY="R"):2,GMRY="BP":3,GMRY="HT":4,GMRY="WT":5,GMRY="CG":6,GMRY="CVP":7,GMRY="PO2":8,GMRY="PN":9,1:0) Q:GMRY(1)'>0
I GMRENTY=21,GMRDAT="*" S GMRDAT=GREASON Q
I $P(GMRDAT,"-",GMRX-1)="*" S $P(GMRDAT,"-",GMRX-1)=GREASON Q
I GMRENTY=21,GMRDAT="" Q
I $P(GMRDAT,"-",GMRX-1)="" Q
S GMRSCR=$S(GMRENTY=21:"GMRDAT'?",1:"$P(GMRDAT,""-"",GMRX-1)'?")
N GMRVOK S GMRVOK=$S(GMRENTY=21:$E(GMRDAT,1),1:$E($P(GMRDAT,"-",GMRX-1),1)) I GMRVOK'="N",(GMRVOK'="n"),(GMRVOK'?1N),(GMRVOK'="?"),(GMRVOK'="*") D WRT S GMROUT=1 Q
I GMRY="PN" D Q
. S GMRSCR=GMRSCR_"0.2N0.1A!(GMRDAT?1""?"".E)"
. I @GMRSCR D WRT S GMROUT=1
S GMRSCR=GMRSCR_$P("0.3N0.1"".""0.2N0.NA^0.3N0.NA^0.3N0.1""/""0.3N0.1""/""0.3N0.1A^0.3N0.3AP0.3N0.1"".""0.2N0.3AP0.1"";""0.NA^0.3N0.1"".""0.2N1.NA^0.3N0.1"".""0.2N0.1A^0.1""-""0.3N0.1"".""0.1N0.1A^0.3N0.1A","^",GMRY(1))_"!(GMRDAT?1""?"".E)"
I @GMRSCR D WRT S GMROUT=1 Q
Q
WRT ;
W @IOF D @GMRHELP(1) W !,$C(7),$S(GMRDAT'?1"?".E:"Invalid data format, t",1:"T")_"he entry should be in the following format:",!,?5,GMRHELP
Q
WOK ;
I (GMRX'="CVP"&(GMRX'="PN")&(GMRDAT(GMRX)'>0)) D Q
. W !,?2,$S(GMRX="BP":"B/P",GMRX="P":"Pulse",GMRX="R":"Resp.",GMRX="T":"Temp.",GMRX="HT":"Ht.",GMRX="CG":"Circumference/Girth",GMRX="WT":"Wt.",GMRX="PO2":"Pulse Ox.",GMRX="PN":"Pain",1:GMRX)_": "_GMRDAT(GMRX)
. I $G(GMRSITE(GMRX))["DORSALIS PEDIS",(GMRDAT(GMRX)'>0) W "*"
. W $S($G(GMRSITE(GMRX))'="":" "_$P($G(GMRSITE(GMRX)),"^"),1:"")
. I $D(GMRINF(GMRX)) S I=0 F S I=$O(GMRINF(GMRX,I)) Q:I'>0 S I(1)="" F S I(1)=$O(GMRINF(GMRX,I,I(1))) Q:I(1)="" W " "_I(1)
. Q
I GMRX="CVP",'(GMRDAT(GMRX)>0!(GMRDAT(GMRX)<0)!($E(GMRDAT(GMRX))="0")) W !,?2,GMRX_": "_GMRDAT(GMRX) Q
S GMRVX=GMRX S GMRVX(0)=$S(GMRX="B"!(GMRX="BP"):$P(GMRDAT(GMRX),"^"),1:+$P(GMRDAT(GMRX),"^")) D EN1^GMRVSAS0
I GMRX="P",$G(GMRSITE(GMRX))["DORSALIS PEDIS",GMRDAT(GMRX)=1 S GMRVX(1)=""
W !,?2,$S(GMRX="BP":"B/P",GMRX="P":"Pulse",GMRX="R":"Resp.",GMRX="T":"Temp.",GMRX="HT":"Ht.",GMRX="CG":"Circumference/Girth",GMRX="WT":"Wt.",GMRX="PO2":"Pulse Ox.",GMRX="PN":"Pain",1:GMRX)_": "
W $S(GMRX="BP"!(GMRX="P")!(GMRX="R"):GMRDAT(GMRX),1:"")
I GMRX="PN" D
. I "UNAVAILABLEPASSREFUSED"[$$UP^XLFSTR(GMRDAT(GMRX)) W GMRDAT(GMRX) Q
. I GMRDAT(GMRX)=0 W GMRDAT(GMRX)_" No pain" Q
. I GMRDAT(GMRX)=99 W GMRDAT(GMRX)_" Unable to respond" Q
. I GMRDAT(GMRX)=10 W GMRDAT(GMRX)_" - Worst imaginable pain" Q
. W GMRDAT(GMRX) Q
I GMRX="T" W GMRVX(0)_" F ("_$J(+GMRVX(0)-32*5/9,0,1)_" C)"
I GMRX="WT" W GMRVX(0)_" LB ("_$J(GMRVX(0)/2.2,0,2)_" KG)"
I GMRX="HT" W $S(GMRVX(0)\12:GMRVX(0)\12_" FT ",1:"")_$S(GMRVX(0)#12:GMRVX(0)#12_" IN",1:"")_" ("_$J(GMRVX(0)*2.54,0,2)_" CM)"
I GMRX="CG" W GMRVX(0)_" IN ("_$J(+GMRVX(0)/.3937,0,2)_" CM)"
I GMRX="CVP" W GMRVX(0)_" cmH2O ("_$J(GMRVX(0)/1.36,0,1)_" mmHg)"
I GMRX="PO2" W GMRVX(0)_"%"_$S(GMRO2(GMRX)'="":" with supplemental O2 "_$S(GMRO2(GMRX)["l/min":$P(GMRO2(GMRX)," l/min")_"L/min",1:"")_$S(GMRO2(GMRX)["l/min":$P(GMRO2(GMRX)," l/min",2),1:GMRO2(GMRX)),1:"")
W $S('$D(GMRVX(1)):"",'GMRVX(1):"",1:"*") K GMRVX S GTXT=""
W:$G(GMRSITE(GMRX))'=""&(GMRX="PO2") !,?20," via" W " "_$P($G(GMRSITE(GMRX)),"^")
I $D(GMRINF(GMRX)) S I=0 F S I=$O(GMRINF(GMRX,I)) Q:I'>0 S I(1)="" F S I(1)=$O(GMRINF(GMRX,I,I(1))) Q:I(1)="" W " "_I(1)
Q
CHKDAT ;
D CHKDAT^GMRVED3
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRVED1 5372 printed Dec 13, 2024@01:56:13 Page 2
GMRVED1 ;HIRMFO/RM,YH-VITAL SIGNS EDIT SHORT FORM (cont.) ;3/14/99 15:11
+1 ;;4.0;Vitals/Measurements;**1,6,7,11**;Apr 25, 1997
EN2 ; ENTRY FROM GMRVED0 TO ENTER THE DATA FOR A PATIENT DEFINED BY DFN
+1 DO DSPOV^GMRVED4
IF GMRSTR(0)=";"
if GMRENTY<5
WRITE !,$CHAR(7)
QUIT
CHANGE SET (GMRHELP,GMRPRMT,GMRHELP(1),GREASON)=""
FOR GMRX=2:1:$LENGTH(GMRSTR(0),";")-1
DO SETPRMT^GMRVED2
+1 SET GMRPRMT=GMRPRMT_": "
SET GMRSTAR=0
ASK ;
+1 if GMROUT
QUIT
SET GLINE=0
if $LENGTH(GMRSTR,";")>2
WRITE !,"To omit entering a vital/measurement reading:",!,"Enter 'N' or 'n' for the value when NOT documenting a reason for omission."
SET GLINE=$GET(GLINE)+1
DO CHECK^GMRVUT1
+2 WRITE !,"Enter an * for the specific value when documenting the reason for omission.",!
SET GLINE=GLINE+1
DO CHECK^GMRVUT1
+3 WRITE "Enter a single * to document that all measurements were omitted and the",!,"reason for omission."
SET GLINE=GLINE+2
DO CHECK^GMRVUT1
WRITE !!,GMRPRMT
SET GLINE=GLINE+1
READ GMRDAT:DTIME
+4 if '$TEST
SET GMRTO=1
IF GMRDAT="^"!'$TEST
SET GMROUT=1
QUIT
+5 KILL GMRSITE
+6 IF GMRDAT=""
WRITE !!,$CHAR(7),"NO DATA ENTERED",!
SET GMROUT=1
QUIT
+7 IF GMRDAT["*"
SET GREASON=$$EN2^GMRVED6(GREASON)
+8 if GMROUT
QUIT
IF GMRDAT="*"
GOTO STAR
+9 IF GMRENTY'=21
IF ($EXTRACT(GMRDAT,1)["-")!(GMRDAT?.E1"--")
WRITE !!,$CHAR(7),"ERRONEOUS ENTRY",!
GOTO ASK
+10 FOR GMRX=2:1:$LENGTH(GMRSTR(0),";")-1
DO CHKSTR
if GMROUT
QUIT
+11 IF GMROUT
SET GMROUT=0
GOTO ASK
+12 FOR GMRX=2:1:$LENGTH(GMRSTR(0),";")-1
DO CHKDAT
if GMROUT
QUIT
STAR if GMROUT!(+$GET(GMROUT(1)))
QUIT
+1 WRITE !
SET GMRDAT(0)=0
FOR GMRY=2:1:$LENGTH(GMRSTR(0),";")-1
SET GMRX=$PIECE(GMRSTR(0),";",GMRY)
Begin DoDot:1
+2 IF GMRDAT="*"
SET GMRDAT(GMRX)=GREASON
+3 IF $DATA(GMRDAT(GMRX))
IF GMRDAT(GMRX)'=""
SET GMRDAT(0)=1
DO WOK
End DoDot:1
ASK1 ;
+1 IF 'GMRDAT(0)
WRITE !,$CHAR(7),"NO DATA ENTERED",!
SET GMROUT=1
QUIT
+2 WRITE !,"Is this correct? YES// "
READ GMRX:DTIME
+3 if '$TEST
SET GMRTO=1
IF GMRX="^"!'$TEST
SET GMROUT=1
WRITE !,$CHAR(7),"DATA DELETED",!
QUIT
+4 IF GMRX?1"N".E!(GMRX?1"n".E)
if $DATA(GMRSITE("BP"))&($DATA(GMRQUAL("BP")))
KILL GBP(GMRSITE("BP")_"/"_GMRQUAL("BP"))
WRITE !
GOTO ASK
+5 IF GMRX=""!(GMRX?1"Y".E)!(GMRX?1"y".E)
GOTO AR1
+6 WRITE !,"ANSWER YES OR NO",*7
GOTO ASK1
AR1 WRITE !
+1 QUIT
CHKSTR ; CHECK THE INPUT STRING TO SEE IF IT IS VALID
+1 SET GMRY=$PIECE(GMRSTR(0),";",GMRX)
+2 SET GMRY(1)=$SELECT(GMRY="T":1,GMRY="P"!(GMRY="R"):2,GMRY="BP":3,GMRY="HT":4,GMRY="WT":5,GMRY="CG":6,GMRY="CVP":7,GMRY="PO2":8,GMRY="PN":9,1:0)
if GMRY(1)'>0
QUIT
+3 IF GMRENTY=21
IF GMRDAT="*"
SET GMRDAT=GREASON
QUIT
+4 IF $PIECE(GMRDAT,"-",GMRX-1)="*"
SET $PIECE(GMRDAT,"-",GMRX-1)=GREASON
QUIT
+5 IF GMRENTY=21
IF GMRDAT=""
QUIT
+6 IF $PIECE(GMRDAT,"-",GMRX-1)=""
QUIT
+7 SET GMRSCR=$SELECT(GMRENTY=21:"GMRDAT'?",1:"$P(GMRDAT,""-"",GMRX-1)'?")
+8 NEW GMRVOK
SET GMRVOK=$SELECT(GMRENTY=21:$EXTRACT(GMRDAT,1),1:$EXTRACT($PIECE(GMRDAT,"-",GMRX-1),1))
IF GMRVOK'="N"
IF (GMRVOK'="n")
IF (GMRVOK'?1N)
IF (GMRVOK'="?")
IF (GMRVOK'="*")
DO WRT
SET GMROUT=1
QUIT
+9 IF GMRY="PN"
Begin DoDot:1
+10 SET GMRSCR=GMRSCR_"0.2N0.1A!(GMRDAT?1""?"".E)"
+11 IF @GMRSCR
DO WRT
SET GMROUT=1
End DoDot:1
QUIT
+12 SET GMRSCR=GMRSCR_$PIECE("0.3N0.1"".""0.2N0.NA^0.3N0.NA^0.3N0.1""/""0.3N0.1""/""0.3N0.1A^0.3N0.3AP0.3N0.1"".""0.2N0.3AP0.1"";""0.NA^0.3N0.1"".""0.2N1.NA^0.3N0.1"".""0.2N0.1A^0.1""-""0.3N0.1"".""0.1N0.1A^0.3N0.1A","^",GMRY(1))_"!(GMRDAT?1""?"".E
)"
+13 IF @GMRSCR
DO WRT
SET GMROUT=1
QUIT
+14 QUIT
WRT ;
+1 WRITE @IOF
DO @GMRHELP(1)
WRITE !,$CHAR(7),$SELECT(GMRDAT'?1"?".E:"Invalid data format, t",1:"T")_"he entry should be in the following format:",!,?5,GMRHELP
+2 QUIT
WOK ;
+1 IF (GMRX'="CVP"&(GMRX'="PN")&(GMRDAT(GMRX)'>0))
Begin DoDot:1
+2 WRITE !,?2,$SELECT(GMRX="BP":"B/P",GMRX="P":"Pulse",GMRX="R":"Resp.",GMRX="T":"Temp.",GMRX="HT":"Ht.",GMRX="CG":"Circumference/Girth",GMRX="WT":"Wt.",GMRX="PO2":"Pulse Ox.",GMRX="PN":"Pain",1:GMRX)_": "_GMRDAT(GMRX)
+3 IF $GET(GMRSITE(GMRX))["DORSALIS PEDIS"
IF (GMRDAT(GMRX)'>0)
WRITE "*"
+4 WRITE $SELECT($GET(GMRSITE(GMRX))'="":" "_$PIECE($GET(GMRSITE(GMRX)),"^"),1:"")
+5 IF $DATA(GMRINF(GMRX))
SET I=0
FOR
SET I=$ORDER(GMRINF(GMRX,I))
if I'>0
QUIT
SET I(1)=""
FOR
SET I(1)=$ORDER(GMRINF(GMRX,I,I(1)))
if I(1)=""
QUIT
WRITE " "_I(1)
+6 QUIT
End DoDot:1
QUIT
+7 IF GMRX="CVP"
IF '(GMRDAT(GMRX)>0!(GMRDAT(GMRX)<0)!($EXTRACT(GMRDAT(GMRX))="0"))
WRITE !,?2,GMRX_": "_GMRDAT(GMRX)
QUIT
+8 SET GMRVX=GMRX
SET GMRVX(0)=$SELECT(GMRX="B"!(GMRX="BP"):$PIECE(GMRDAT(GMRX),"^"),1:+$PIECE(GMRDAT(GMRX),"^"))
DO EN1^GMRVSAS0
+9 IF GMRX="P"
IF $GET(GMRSITE(GMRX))["DORSALIS PEDIS"
IF GMRDAT(GMRX)=1
SET GMRVX(1)=""
+10 WRITE !,?2,$SELECT(GMRX="BP":"B/P",GMRX="P":"Pulse",GMRX="R":"Resp.",GMRX="T":"Temp.",GMRX="HT":"Ht.",GMRX="CG":"Circumference/Girth",GMRX="WT":"Wt.",GMRX="PO2":"Pulse Ox.",GMRX="PN":"Pain",1:GMRX)_": "
+11 WRITE $SELECT(GMRX="BP"!(GMRX="P")!(GMRX="R"):GMRDAT(GMRX),1:"")
+12 IF GMRX="PN"
Begin DoDot:1
+13 IF "UNAVAILABLEPASSREFUSED"[$$UP^XLFSTR(GMRDAT(GMRX))
WRITE GMRDAT(GMRX)
QUIT
+14 IF GMRDAT(GMRX)=0
WRITE GMRDAT(GMRX)_" No pain"
QUIT
+15 IF GMRDAT(GMRX)=99
WRITE GMRDAT(GMRX)_" Unable to respond"
QUIT
+16 IF GMRDAT(GMRX)=10
WRITE GMRDAT(GMRX)_" - Worst imaginable pain"
QUIT
+17 WRITE GMRDAT(GMRX)
QUIT
End DoDot:1
+18 IF GMRX="T"
WRITE GMRVX(0)_" F ("_$JUSTIFY(+GMRVX(0)-32*5/9,0,1)_" C)"
+19 IF GMRX="WT"
WRITE GMRVX(0)_" LB ("_$JUSTIFY(GMRVX(0)/2.2,0,2)_" KG)"
+20 IF GMRX="HT"
WRITE $SELECT(GMRVX(0)\12:GMRVX(0)\12_" FT ",1:"")_$SELECT(GMRVX(0)#12:GMRVX(0)#12_" IN",1:"")_" ("_$JUSTIFY(GMRVX(0)*2.54,0,2)_" CM)"
+21 IF GMRX="CG"
WRITE GMRVX(0)_" IN ("_$JUSTIFY(+GMRVX(0)/.3937,0,2)_" CM)"
+22 IF GMRX="CVP"
WRITE GMRVX(0)_" cmH2O ("_$JUSTIFY(GMRVX(0)/1.36,0,1)_" mmHg)"
+23 IF GMRX="PO2"
WRITE GMRVX(0)_"%"_$SELECT(GMRO2(GMRX)'="":" with supplemental O2 "_$SELECT(GMRO2(GMRX)["l/min":$PIECE(GMRO2(GMRX)," l/min")_"L/min",1:"")_$SELECT(GMRO2(GMRX)["l/min":$PIECE(GMRO2(GMRX)," l/min",2),1:GMRO2(GMRX)),1:"")
+24 WRITE $SELECT('$DATA(GMRVX(1)):"",'GMRVX(1):"",1:"*")
KILL GMRVX
SET GTXT=""
+25 if $GET(GMRSITE(GMRX))'=""&(GMRX="PO2")
WRITE !,?20," via"
WRITE " "_$PIECE($GET(GMRSITE(GMRX)),"^")
+26 IF $DATA(GMRINF(GMRX))
SET I=0
FOR
SET I=$ORDER(GMRINF(GMRX,I))
if I'>0
QUIT
SET I(1)=""
FOR
SET I(1)=$ORDER(GMRINF(GMRX,I,I(1)))
if I(1)=""
QUIT
WRITE " "_I(1)
+27 QUIT
CHKDAT ;
+1 DO CHKDAT^GMRVED3
+2 QUIT