GMRVEE2 ;HIRMFO/YH-ENTERED IN ERROR EDIT (cont.) ;2/6/99
;;4.0;Vitals/Measurements;**1,7,11**;Apr 25, 1997
EN1 ; ENTER NEW DATE/TIME VITALS TAKEN
S %DT(0)="-NOW",%DT("A")="Enter new date/time vitals were taken: ",%DT="AETRS" D ^%DT K %DT S:X?1"^".E!(+Y'>0) GMROUT=1 Q:GMROUT S GMRCHC(1)=+Y
Q
EN2 ; ENTER NEW READING
S GMRENTY=8,GLVL=8,GMRVIT=GMRX,(GMRVITY,GMRTY)=$S($D(^GMRD(120.51,GMRX,0)):$P(^(0),"^",2),1:""),GMRVIT(1)=$P(^(0),"^"),GMRAINP=$S($D(^(1)):^(1),1:""),GSAVE=GMRVITY,GMRO2(GMRVITY)=""
S GDT=GMRVIDT D EN1^GMRVADM G:GMROUT Q
ERRAT W !!,"NEW "_$S($P(GMRVIT(1),"^")'="":$P(GMRVIT(1),"^"),1:"VALUE")_": " R X:DTIME S:'$T X="^^" W ! I "^^"[X!(X="") W !,$C(7),?3,"NO UPDATING HAS OCCURRED!!" S GMROUT=1 G Q
I X?1"?".E S GOPT=GMRTY_"^GMRVUT1" D @GOPT K GOPT G ERRAT
I GMRTY="T"!(GMRTY="P")!(GMRTY="R") S X=$$RDSITE(X),GMRSITE=$P(X,U,2),X=$P(X,U) S GMRSITE=$$UP^XLFSTR(GMRSITE) D TPSITE^GMRVUT1
I GMRTY="T"!(GMRTY="P")!(GMRTY="R") S:'$D(GMRSITE(GMRVITY)) GMROUT=1 S:GMROUT=0 GMRSITE=GMRSITE(GMRVITY) I GMROUT W !,"NO UPDATING HAS OCCURRED",!
I GMRTY="CG" D G:$G(X)="" ERRAT
. X GMRAINP I $G(X)="" W !,?3,$C(7),"INVALID ENTRY??" Q
. K GMRSITE(GMRVITY),GMRINF(GMRVITY) D LISTQ^GMRVQUAL,OTHERQ^GMRVQUAL
G:GMROUT Q
I GMRTY="PO2" X GMRAINP W:'$D(X) !,?3,$C(7),"INVALID ENTRY??" G:'$D(X) ERRAT S (GMRSITE(GMRVITY),GMRINF("GMRVITY"))="" D O2^GMRVUT3 G Q:GMROUT,Q1
I GMRTY="PN" X GMRAINP W:'$D(X) !,?3,$C(7),"INVALID ENTRY??" G:'$D(X) ERRAT S (GMRSITE(GMRVITY),GMRINF("GMRVITY"))="" G Q:GMROUT,Q1
I GMRTY="BP" X GMRAINP W:'$D(X) !,?3,$C(7),"INVALID ENTRY??" G:'$D(X) ERRAT D LISTQ^GMRVQUAL,OTHERQ^GMRVQUAL,CLEAR^GMRVQUAL G Q:GMROUT,Q1
I GMRTY="WT" S GMRSITE=$P(X,+X,2) G:GMRSITE=""!("LlLk"'[$E(GMRSITE)) ERRAT D WTYPE^GMRVUT1 S:'$D(GMRSITE(GMRVITY)) GMROUT=1 S:GMROUT=0 GMRSITE=GMRSITE(GMRVITY) I GMROUT W !,"NO UPDATING HAS OCCURRED",!
I GMRVITY="HT" S GMRSITE=$P(X,",",2),X=$P(X,",") S:GMRSITE="" GMRSITE="A" X GMRAINP W:'$D(X) !,?3,$C(7),"INVALID ENTRY??" G:'$D(X) ERRAT D TPSITE^GMRVUT1 G Q:GMROUT,Q1
G:GMROUT Q X GMRAINP I '$D(X) W !,?3,$C(7),"INVALID ENTRY??" G ERRAT
Q1 G:GMROUT Q S GMRCHC(2)=X
Q S GMRVITY=GSAVE K GSAVE D CLEAR^GMRVQUAL Q
EN3 ; SELECT NEW PATIENT FOR VITALS
S DIC("A")="Select the NEW Patient's name: ",DIC(0)="AEQM",DIC="^DPT(" D ^DIC K DIC S:$D(DTOUT)!$D(DUOUT)!(+Y'>0) GMROUT=1 Q:GMROUT S GMRCHC(3)=+Y
Q
DUPREC ;PRINT WARNING MESSAGE IF THE DATE/TIME CHANGE WILL CAUSE DUPLICATE RECORD
W ! S GVIT=0 F GII=0:0 S GVIT=$O(GMRARTY(GVIT)) Q:GVIT'>0 I $D(^GMR(120.5,"AA",DFN,GVIT,GDATE)) D CHKER
K GDA,GVIT,GII Q
CHKER ;
S GDA=0 F GDA=0:0 S GDA=$O(^GMR(120.5,"AA",DFN,GVIT,GDATE,GDA)) Q:GDA'>0 I '$D(^GMR(120.5,GDA,2)) S GMROUT=1 W !,$P($S($D(^GMRD(120.51,GVIT,0)):^(0),1:0),"^")," already exists on ",Y," reading - ",$P(^GMR(120.5,GDA,0),"^",8)
Q
DUPDT ;SET EXISTING OLD VITAL AS ERROR RECORD
S GMRDA=0 F GMRDA=0:0 S GMRDA=$O(^GMR(120.5,"AA",DFN,GMRY,GDATE,GMRDA)) Q:GMRDA'>0 I '$D(^GMR(120.5,GMRDA,2)) D ERREN^GMRVEE1 Q
Q
PRTEED ; PRINT ERROR RECORD
S GMRDAT=^GMR(120.5,GMRDA,0)
S GMRTY=$S($D(^GMRD(120.51,GMRX,0)):^(0),1:""),GMRAINP=$S($D(^GMRD(120.51,$P(GMRDAT,"^",3),1))#2:^(1),1:""),GMRVX=$P(GMRTY,"^",2),GMRVX(0)=$P(GMRDAT,U,8),GMRVX(1)=0 D:GMRVX(0)>0 EN1^GMRVSAS0 S GMRVX(1)=$S(GMRVX(1)>0:" *",1:"")
S GMRZZ="",GMRZZ(1)="" I $P($G(^GMR(120.5,GMRDA,5,0)),"^",4)>0 K GMRVARY S GMRVARY="" D CHAR^GMRVCHAR(GMRDA,.GMRVARY,GMRX) S GMRZZ=$$WRITECH^GMRVCHAR(GMRDA,.GMRVARY,9) S:GMRZZ'="" GMRZZ(1)=" ("_GMRZZ_")"
I GMRVX="T",GMRVX(0)>0 S GMRVX(0)=GMRVX(0)_" F ("_$J(GMRVX(0)-32*5/9,0,1)_" C)"
I GMRVX="WT",GMRVX(0)>0 S GMRVX(0)=GMRVX(0)_" lb ("_$J(GMRVX(0)/2.2,0,2)_" kg)"
I GMRVX="HT",GMRVX(0)>0 S GMRVX(0)=$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 GMRVX="CG",GMRVX(0)>0 S GMRVX(0)=GMRVX(0)_" in ("_$J(+GMRVX(0)/.3937,0,2)_" cm)"
I GMRVX="CVP",GMRVX(0)>0 S GMRVX(0)=GMRVX(0)_" cmH2O ("_$J(GMRVX(0)/1.36,0,1)_" mmHg)"
I GMRVX="PO2",GMRVX(0)>0 D
.N GMRVPO S GMRVPO=$P(GMRDAT,"^",10)
.S GMRVX(0)="Pulse oximetry "_GMRVX(0)_"%"_$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:"")
.Q
I GMRX=$O(GMRARTY(0)) S Y=$P(GMRDAT,"^") W ! D DT^DIQ
W !,?2,$S($P(GMRTY,"^",2)="PN":"PN (pain)",1:$P(GMRTY,"^",2)),": ",$S($P(GMRDAT,U,8)'="":GMRVX(0)_GMRVX(1),1:"")
I GMRTY="PN" D
. I GMRVX(0)=0 W " No pain" Q
. I GMRVX(0)=99 W " Unable to respond" Q
. I GMRVX(0)=10 W " Worst imaginable to respond" Q
W:GMRVX="PO2"&(GMRZZ'="") !,?8,"via " W " ",GMRZZ
Q
RDSITE(X) ; THIS FUNCTION CONVERTS A VITAL DATA ENTRY IN X TO A SITE AND
; A READING. IT RETURNS SITE^READING.
N Y,Z,I,READ,SITE
S Y=$TR(X,"0123456789.","99999999999")
S Z=$L(X)+1,I=0 F S I=$F(Y,"9",I) Q:I'>0 S Z=I
S READ=$E(X,1,Z-1),SITE=$E(X,Z,$L(X))
Q READ_"^"_SITE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRVEE2 4920 printed Oct 16, 2024@17:57:02 Page 2
GMRVEE2 ;HIRMFO/YH-ENTERED IN ERROR EDIT (cont.) ;2/6/99
+1 ;;4.0;Vitals/Measurements;**1,7,11**;Apr 25, 1997
EN1 ; ENTER NEW DATE/TIME VITALS TAKEN
+1 SET %DT(0)="-NOW"
SET %DT("A")="Enter new date/time vitals were taken: "
SET %DT="AETRS"
DO ^%DT
KILL %DT
if X?1"^".E!(+Y'>0)
SET GMROUT=1
if GMROUT
QUIT
SET GMRCHC(1)=+Y
+2 QUIT
EN2 ; ENTER NEW READING
+1 SET GMRENTY=8
SET GLVL=8
SET GMRVIT=GMRX
SET (GMRVITY,GMRTY)=$SELECT($DATA(^GMRD(120.51,GMRX,0)):$PIECE(^(0),"^",2),1:"")
SET GMRVIT(1)=$PIECE(^(0),"^")
SET GMRAINP=$SELECT($DATA(^(1)):^(1),1:"")
SET GSAVE=GMRVITY
SET GMRO2(GMRVITY)=""
+2 SET GDT=GMRVIDT
DO EN1^GMRVADM
if GMROUT
GOTO Q
ERRAT WRITE !!,"NEW "_$SELECT($PIECE(GMRVIT(1),"^")'="":$PIECE(GMRVIT(1),"^"),1:"VALUE")_": "
READ X:DTIME
if '$TEST
SET X="^^"
WRITE !
IF "^^"[X!(X="")
WRITE !,$CHAR(7),?3,"NO UPDATING HAS OCCURRED!!"
SET GMROUT=1
GOTO Q
+1 IF X?1"?".E
SET GOPT=GMRTY_"^GMRVUT1"
DO @GOPT
KILL GOPT
GOTO ERRAT
+2 IF GMRTY="T"!(GMRTY="P")!(GMRTY="R")
SET X=$$RDSITE(X)
SET GMRSITE=$PIECE(X,U,2)
SET X=$PIECE(X,U)
SET GMRSITE=$$UP^XLFSTR(GMRSITE)
DO TPSITE^GMRVUT1
+3 IF GMRTY="T"!(GMRTY="P")!(GMRTY="R")
if '$DATA(GMRSITE(GMRVITY))
SET GMROUT=1
if GMROUT=0
SET GMRSITE=GMRSITE(GMRVITY)
IF GMROUT
WRITE !,"NO UPDATING HAS OCCURRED",!
+4 IF GMRTY="CG"
Begin DoDot:1
+5 XECUTE GMRAINP
IF $GET(X)=""
WRITE !,?3,$CHAR(7),"INVALID ENTRY??"
QUIT
+6 KILL GMRSITE(GMRVITY),GMRINF(GMRVITY)
DO LISTQ^GMRVQUAL
DO OTHERQ^GMRVQUAL
End DoDot:1
if $GET(X)=""
GOTO ERRAT
+7 if GMROUT
GOTO Q
+8 IF GMRTY="PO2"
XECUTE GMRAINP
if '$DATA(X)
WRITE !,?3,$CHAR(7),"INVALID ENTRY??"
if '$DATA(X)
GOTO ERRAT
SET (GMRSITE(GMRVITY),GMRINF("GMRVITY"))=""
DO O2^GMRVUT3
if GMROUT
GOTO Q
GOTO Q1
+9 IF GMRTY="PN"
XECUTE GMRAINP
if '$DATA(X)
WRITE !,?3,$CHAR(7),"INVALID ENTRY??"
if '$DATA(X)
GOTO ERRAT
SET (GMRSITE(GMRVITY),GMRINF("GMRVITY"))=""
if GMROUT
GOTO Q
GOTO Q1
+10 IF GMRTY="BP"
XECUTE GMRAINP
if '$DATA(X)
WRITE !,?3,$CHAR(7),"INVALID ENTRY??"
if '$DATA(X)
GOTO ERRAT
DO LISTQ^GMRVQUAL
DO OTHERQ^GMRVQUAL
DO CLEAR^GMRVQUAL
if GMROUT
GOTO Q
GOTO Q1
+11 IF GMRTY="WT"
SET GMRSITE=$PIECE(X,+X,2)
if GMRSITE=""!("LlLk"'[$EXTRACT(GMRSITE))
GOTO ERRAT
DO WTYPE^GMRVUT1
if '$DATA(GMRSITE(GMRVITY))
SET GMROUT=1
if GMROUT=0
SET GMRSITE=GMRSITE(GMRVITY)
IF GMROUT
WRITE !,"NO UPDATING HAS OCCURRED",!
+12 IF GMRVITY="HT"
SET GMRSITE=$PIECE(X,",",2)
SET X=$PIECE(X,",")
if GMRSITE=""
SET GMRSITE="A"
XECUTE GMRAINP
if '$DATA(X)
WRITE !,?3,$CHAR(7),"INVALID ENTRY??"
if '$DATA(X)
GOTO ERRAT
DO TPSITE^GMRVUT1
if GMROUT
GOTO Q
GOTO Q1
+13 if GMROUT
GOTO Q
XECUTE GMRAINP
IF '$DATA(X)
WRITE !,?3,$CHAR(7),"INVALID ENTRY??"
GOTO ERRAT
Q1 if GMROUT
GOTO Q
SET GMRCHC(2)=X
Q SET GMRVITY=GSAVE
KILL GSAVE
DO CLEAR^GMRVQUAL
QUIT
EN3 ; SELECT NEW PATIENT FOR VITALS
+1 SET DIC("A")="Select the NEW Patient's name: "
SET DIC(0)="AEQM"
SET DIC="^DPT("
DO ^DIC
KILL DIC
if $DATA(DTOUT)!$DATA(DUOUT)!(+Y'>0)
SET GMROUT=1
if GMROUT
QUIT
SET GMRCHC(3)=+Y
+2 QUIT
DUPREC ;PRINT WARNING MESSAGE IF THE DATE/TIME CHANGE WILL CAUSE DUPLICATE RECORD
+1 WRITE !
SET GVIT=0
FOR GII=0:0
SET GVIT=$ORDER(GMRARTY(GVIT))
if GVIT'>0
QUIT
IF $DATA(^GMR(120.5,"AA",DFN,GVIT,GDATE))
DO CHKER
+2 KILL GDA,GVIT,GII
QUIT
CHKER ;
+1 SET GDA=0
FOR GDA=0:0
SET GDA=$ORDER(^GMR(120.5,"AA",DFN,GVIT,GDATE,GDA))
if GDA'>0
QUIT
IF '$DATA(^GMR(120.5,GDA,2))
SET GMROUT=1
WRITE !,$PIECE($SELECT($DATA(^GMRD(120.51,GVIT,0)):^(0),1:0),"^")," already exists on ",Y," reading - ",$PIECE(^GMR(120.5,GDA,0),"^",8)
+2 QUIT
DUPDT ;SET EXISTING OLD VITAL AS ERROR RECORD
+1 SET GMRDA=0
FOR GMRDA=0:0
SET GMRDA=$ORDER(^GMR(120.5,"AA",DFN,GMRY,GDATE,GMRDA))
if GMRDA'>0
QUIT
IF '$DATA(^GMR(120.5,GMRDA,2))
DO ERREN^GMRVEE1
QUIT
+2 QUIT
PRTEED ; PRINT ERROR RECORD
+1 SET GMRDAT=^GMR(120.5,GMRDA,0)
+2 SET GMRTY=$SELECT($DATA(^GMRD(120.51,GMRX,0)):^(0),1:"")
SET GMRAINP=$SELECT($DATA(^GMRD(120.51,$PIECE(GMRDAT,"^",3),1))#2:^(1),1:"")
SET GMRVX=$PIECE(GMRTY,"^",2)
SET GMRVX(0)=$PIECE(GMRDAT,U,8)
SET GMRVX(1)=0
if GMRVX(0)>0
DO EN1^GMRVSAS0
SET GMRVX(1)=$SELECT(GMRVX(1)>0:" *",1:"")
+3 SET GMRZZ=""
SET GMRZZ(1)=""
IF $PIECE($GET(^GMR(120.5,GMRDA,5,0)),"^",4)>0
KILL GMRVARY
SET GMRVARY=""
DO CHAR^GMRVCHAR(GMRDA,.GMRVARY,GMRX)
SET GMRZZ=$$WRITECH^GMRVCHAR(GMRDA,.GMRVARY,9)
if GMRZZ'=""
SET GMRZZ(1)=" ("_GMRZZ_")"
+4 IF GMRVX="T"
IF GMRVX(0)>0
SET GMRVX(0)=GMRVX(0)_" F ("_$JUSTIFY(GMRVX(0)-32*5/9,0,1)_" C)"
+5 IF GMRVX="WT"
IF GMRVX(0)>0
SET GMRVX(0)=GMRVX(0)_" lb ("_$JUSTIFY(GMRVX(0)/2.2,0,2)_" kg)"
+6 IF GMRVX="HT"
IF GMRVX(0)>0
SET GMRVX(0)=$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)"
+7 IF GMRVX="CG"
IF GMRVX(0)>0
SET GMRVX(0)=GMRVX(0)_" in ("_$JUSTIFY(+GMRVX(0)/.3937,0,2)_" cm)"
+8 IF GMRVX="CVP"
IF GMRVX(0)>0
SET GMRVX(0)=GMRVX(0)_" cmH2O ("_$JUSTIFY(GMRVX(0)/1.36,0,1)_" mmHg)"
+9 IF GMRVX="PO2"
IF GMRVX(0)>0
Begin DoDot:1
+10 NEW GMRVPO
SET GMRVPO=$PIECE(GMRDAT,"^",10)
+11 SET GMRVX(0)="Pulse oximetry "_GMRVX(0)_"%"_$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:"")
+12 QUIT
End DoDot:1
+13 IF GMRX=$ORDER(GMRARTY(0))
SET Y=$PIECE(GMRDAT,"^")
WRITE !
DO DT^DIQ
+14 WRITE !,?2,$SELECT($PIECE(GMRTY,"^",2)="PN":"PN (pain)",1:$PIECE(GMRTY,"^",2)),": ",$SELECT($PIECE(GMRDAT,U,8)'="":GMRVX(0)_GMRVX(1),1:"")
+15 IF GMRTY="PN"
Begin DoDot:1
+16 IF GMRVX(0)=0
WRITE " No pain"
QUIT
+17 IF GMRVX(0)=99
WRITE " Unable to respond"
QUIT
+18 IF GMRVX(0)=10
WRITE " Worst imaginable to respond"
QUIT
End DoDot:1
+19 if GMRVX="PO2"&(GMRZZ'="")
WRITE !,?8,"via "
WRITE " ",GMRZZ
+20 QUIT
RDSITE(X) ; THIS FUNCTION CONVERTS A VITAL DATA ENTRY IN X TO A SITE AND
+1 ; A READING. IT RETURNS SITE^READING.
+2 NEW Y,Z,I,READ,SITE
+3 SET Y=$TRANSLATE(X,"0123456789.","99999999999")
+4 SET Z=$LENGTH(X)+1
SET I=0
FOR
SET I=$FIND(Y,"9",I)
if I'>0
QUIT
SET Z=I
+5 SET READ=$EXTRACT(X,1,Z-1)
SET SITE=$EXTRACT(X,Z,$LENGTH(X))
+6 QUIT READ_"^"_SITE
