GMRVORE0 ;HIRMFO/RM/YH-DRIVER TO ENTER VITAL/MEASUREMENTS ORDERS ;8/16/95
;;4.0;Vitals/Measurements;;Apr 25, 1997
EN1 ; ENTRY FROM ACTION FIELD OF ORDER ENTRY OPTION
;
; SET UP ORDER VARIABLES GMRVSTOP, GMRVSTRT, GMRVAS, GMRVCOM AND
; GMRVORD(
;
S GMROUT=0,X=+$G(ORIFN),GMRVORD=$G(^GMR(120.55,X,0)),GMRVORD("O")=$G(^GMR(120.55,X,"O")),(GMRVORD(1),GMRVORD(2),GMRVORD(3),GMRVORD(4),GMRVORD(5),GMRVORD(6))=""
I $D(ORIFN) D EN^ORX8(ORIFN) S GMRVORD(1)=ORIFN_"^^^^"_ORUPCHUK("ORPCL")_"^^^^"_ORUPCHUK("ORSTOP")_U_ORUPCHUK("ORL")_U_ORUPCHUK("ORTO"),GMRVORD(2)=U_U_+ORUPCHUK("ORSTS")_U_ORUPCHUK("ORPCL")_U_ORUPCHUK("ORTX",1)_U_ORUPCHUK("ORSTRT")
I $D(ORIFN) S GMRVORD(3)=$G(ORUPCHUK("ORPK")) K ORUPCHUK
I $D(GMRVKWIK) S GMRVSTRT=$P(GMRVANSR,"^"),GMRVSTOP=$P(GMRVANSR,"^",2),GMRVAS=$P(GMRVANSR,"^",3),GMRVCOM=$P(GMRVANSR,"^",4) G:'$D(ORIFN) PROC
I '$D(ORIFN) S (GMRVSTRT,GMRVSTOP,GMRVAS,GMRVCOM)="" G PROC
I $P(GMRVORD(2),U,3)=11 S GMRVSTRT=$P(GMRVORD(3),U),GMRVSTOP=$P(GMRVORD(3),U,2),GMRVAS=$P(GMRVORD(3),U,3),GMRVCOM=$P(GMRVORD(3),U,6)
E S GMRVAS=$P(GMRVORD,"^",2,4),GMRVCOM=$P(GMRVORD("O"),"^"),GMRVSTRT=$P(GMRVORD(2),"^",6),GMRVSTOP=$P(GMRVORD(1),"^",9)
PROC ;
; PROCESS ORDER DEPENDING ON $G(ORACTION)
;
I $G(ORACTION)=2,$G(ORSTS)=11 G NOP
I $G(ORACTION)=0 I $G(ORGY)=10!($G(ORGY)=0) S $P(GMRVORD(2),"^",5)=$S($P(GMRVORD(2),"^",5)="":$G(ORTX),1:$P(GMRVORD(2),"^",5)) D EN1^GMRVORE1 S:GMROUT&($G(ORGY)=10) OREND=1 G Q:GMROUT!($G(ORGY)=10)
S GMRVNEW=0 I $G(ORACTION)=1,$G(ORSTS)'=11 W !!,$C(7),"DO YOU WANT TO DISCONTINUE THIS ORDER AND ADD A NEW ONE" S %=1 D YN^DICN W:%=0 !,"Answer 'YES' or 'NO'" G PROC:%=0 G Q:%=2!(%=-1) S GMRVNEW=1,GMRVORD(4)=GMRVSTRT_GMRVAS_GMRVCOM_GMRVSTOP
I $G(ORACTION)=0!($G(ORACTION)=1)!($G(ORACTION)=2) I $G(ORGY)=0 D ASK^GMRVORE2 D:$G(ORACTION)=1 EDCHK G Q:GMROUT D UNREL^GMRVORE3
I $G(ORACTION)=0!($G(ORACTION)=1)!($G(ORACTION)=2) I $G(ORGY)=9 D REL^GMRVORE3
I $G(ORACTION)=3 G:$G(ORSTS)=11 NOP S ORSTS=$S($G(ORSTS)=4:6,1:4) D ST^ORX G Q
I $G(ORACTION)=4 G:$G(ORSTS)=11 NOP D:$G(ORGY)=0 HOLD^ORX5 I $G(ORGY)=9 S ORSTS=$S($G(ORSTS)=3:6,1:3) D ST^ORX
I $G(ORACTION)=5,($P($G(OREVENT),";",2)="C"!($P($G(OREVENT),";",2)="A")) S GMRVEV=OREVENT,ORETURN("ORSTS")=$S($P($G(OREVENT),";",2)="C":2,1:6) S:$P($G(OREVENT),";",2)="A" ORETURN("OREVENT")=GMRVSTOP_";C" D RETURN^ORX S OREVENT=GMRVEV
I $G(ORACTION)=6,+$G(ORSTS)=11 S ORSTS="K" D ST^ORX G Q
I $G(ORACTION)=6 D DC^ORX5:$G(ORGY)=0,EN1^GMRVORC0:$G(ORGY)=9
I $G(ORACTION)=7 D EN2^GMRVORC0
I $G(ORACTION)=8 D EN1^GMRVORD0
;
; CLEAN UP VARIABLES
;
Q ;
I GMROUT W !,?4,$C(7),$S($G(ORACTION):"No updating has occurred!!",1:"Order has been deleted!!")
D KVAR^VADPT K DIC,GMRTX,GMRPK,GMRX,GMRY,GMRRQ,GMRVSTOP,GMRVSTRT,GMRENT,GMRACT,GMRORD,GMRVORD,GMROUT,GMRVAS,GMRVCOM,GMRVDF,GMRVEV,GMRVOIFN,XQH,GMRVT,DIROUT,GMRSTOP,GMRSTRT,GMRVKWIK,GMRVNEW,GMRVOERR,GMRVORAN,DZ,GMRSTR,X1,X2
Q
NOP ;
W !!,$C(7),"This action is inappropriate for this order."
G Q
EDCHK ;
S GMRVORD(5)=GMRVSTRT_GMRVAS_GMRVCOM_GMRVSTOP F I=1:1:$L(GMRVORD(4)) S:'($E(GMRVORD(4),I)="~") GMRVORD(6)=GMRVORD(6)_$E(GMRVORD(4),I)
I GMRVORD(4)'="",GMRVORD(6)=GMRVORD(5) W $C(7),!?4,"No change to existing order!!" S GMROUT=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRVORE0 3237 printed Oct 16, 2024@17:57:58 Page 2
GMRVORE0 ;HIRMFO/RM/YH-DRIVER TO ENTER VITAL/MEASUREMENTS ORDERS ;8/16/95
+1 ;;4.0;Vitals/Measurements;;Apr 25, 1997
EN1 ; ENTRY FROM ACTION FIELD OF ORDER ENTRY OPTION
+1 ;
+2 ; SET UP ORDER VARIABLES GMRVSTOP, GMRVSTRT, GMRVAS, GMRVCOM AND
+3 ; GMRVORD(
+4 ;
+5 SET GMROUT=0
SET X=+$GET(ORIFN)
SET GMRVORD=$GET(^GMR(120.55,X,0))
SET GMRVORD("O")=$GET(^GMR(120.55,X,"O"))
SET (GMRVORD(1),GMRVORD(2),GMRVORD(3),GMRVORD(4),GMRVORD(5),GMRVORD(6))=""
+6 IF $DATA(ORIFN)
DO EN^ORX8(ORIFN)
SET GMRVORD(1)=ORIFN_"^^^^"_ORUPCHUK("ORPCL")_"^^^^"_ORUPCHUK("ORSTOP")_U_ORUPCHUK("ORL")_U_ORUPCHUK("ORTO")
SET GMRVORD(2)=U_U_+ORUPCHUK("ORSTS")_U_ORUPCHUK("ORPCL")_U_ORUPCHUK("ORTX",1)_U_ORUPCHUK("ORSTRT")
+7 IF $DATA(ORIFN)
SET GMRVORD(3)=$GET(ORUPCHUK("ORPK"))
KILL ORUPCHUK
+8 IF $DATA(GMRVKWIK)
SET GMRVSTRT=$PIECE(GMRVANSR,"^")
SET GMRVSTOP=$PIECE(GMRVANSR,"^",2)
SET GMRVAS=$PIECE(GMRVANSR,"^",3)
SET GMRVCOM=$PIECE(GMRVANSR,"^",4)
if '$DATA(ORIFN)
GOTO PROC
+9 IF '$DATA(ORIFN)
SET (GMRVSTRT,GMRVSTOP,GMRVAS,GMRVCOM)=""
GOTO PROC
+10 IF $PIECE(GMRVORD(2),U,3)=11
SET GMRVSTRT=$PIECE(GMRVORD(3),U)
SET GMRVSTOP=$PIECE(GMRVORD(3),U,2)
SET GMRVAS=$PIECE(GMRVORD(3),U,3)
SET GMRVCOM=$PIECE(GMRVORD(3),U,6)
+11 IF '$TEST
SET GMRVAS=$PIECE(GMRVORD,"^",2,4)
SET GMRVCOM=$PIECE(GMRVORD("O"),"^")
SET GMRVSTRT=$PIECE(GMRVORD(2),"^",6)
SET GMRVSTOP=$PIECE(GMRVORD(1),"^",9)
PROC ;
+1 ; PROCESS ORDER DEPENDING ON $G(ORACTION)
+2 ;
+3 IF $GET(ORACTION)=2
IF $GET(ORSTS)=11
GOTO NOP
+4 IF $GET(ORACTION)=0
IF $GET(ORGY)=10!($GET(ORGY)=0)
SET $PIECE(GMRVORD(2),"^",5)=$SELECT($PIECE(GMRVORD(2),"^",5)="":$GET(ORTX),1:$PIECE(GMRVORD(2),"^",5))
DO EN1^GMRVORE1
if GMROUT&($GET(ORGY)=10)
SET OREND=1
if GMROUT!($GET(ORGY)=10)
GOTO Q
+5 SET GMRVNEW=0
IF $GET(ORACTION)=1
IF $GET(ORSTS)'=11
WRITE !!,$CHAR(7),"DO YOU WANT TO DISCONTINUE THIS ORDER AND ADD A NEW ONE"
SET %=1
DO YN^DICN
if %=0
WRITE !,"Answer 'YES' or 'NO'"
if %=0
GOTO PROC
if %=2!(%=-1)
GOTO Q
SET GMRVNEW=1
SET GMRVORD(4)=GMRVSTRT_GMRVAS_GMRVCOM_GMRVSTOP
+6 IF $GET(ORACTION)=0!($GET(ORACTION)=1)!($GET(ORACTION)=2)
IF $GET(ORGY)=0
DO ASK^GMRVORE2
if $GET(ORACTION)=1
DO EDCHK
if GMROUT
GOTO Q
DO UNREL^GMRVORE3
+7 IF $GET(ORACTION)=0!($GET(ORACTION)=1)!($GET(ORACTION)=2)
IF $GET(ORGY)=9
DO REL^GMRVORE3
+8 IF $GET(ORACTION)=3
if $GET(ORSTS)=11
GOTO NOP
SET ORSTS=$SELECT($GET(ORSTS)=4:6,1:4)
DO ST^ORX
GOTO Q
+9 IF $GET(ORACTION)=4
if $GET(ORSTS)=11
GOTO NOP
if $GET(ORGY)=0
DO HOLD^ORX5
IF $GET(ORGY)=9
SET ORSTS=$SELECT($GET(ORSTS)=3:6,1:3)
DO ST^ORX
+10 IF $GET(ORACTION)=5
IF ($PIECE($GET(OREVENT),";",2)="C"!($PIECE($GET(OREVENT),";",2)="A"))
SET GMRVEV=OREVENT
SET ORETURN("ORSTS")=$SELECT($PIECE($GET(OREVENT),";",2)="C":2,1:6)
if $PIECE($GET(OREVENT),";",2)="A"
SET ORETURN("OREVENT")=GMRVSTOP_";C"
DO RETURN^ORX
SET OREVENT=GMRVEV
+11 IF $GET(ORACTION)=6
IF +$GET(ORSTS)=11
SET ORSTS="K"
DO ST^ORX
GOTO Q
+12 IF $GET(ORACTION)=6
if $GET(ORGY)=0
DO DC^ORX5
if $GET(ORGY)=9
DO EN1^GMRVORC0
+13 IF $GET(ORACTION)=7
DO EN2^GMRVORC0
+14 IF $GET(ORACTION)=8
DO EN1^GMRVORD0
+15 ;
+16 ; CLEAN UP VARIABLES
+17 ;
Q ;
+1 IF GMROUT
WRITE !,?4,$CHAR(7),$SELECT($GET(ORACTION):"No updating has occurred!!",1:"Order has been deleted!!")
+2 DO KVAR^VADPT
KILL DIC,GMRTX,GMRPK,GMRX,GMRY,GMRRQ,GMRVSTOP,GMRVSTRT,GMRENT,GMRACT,GMRORD,GMRVORD,GMROUT,GMRVAS,GMRVCOM,GMRVDF,GMRVEV,GMRVOIFN,XQH,GMRVT,DIROUT,GMRSTOP,GMRSTRT,GMRVKWIK,GMRVNEW,GMRVOERR,GMRVORAN,DZ,GMRSTR,X1,X2
+3 QUIT
NOP ;
+1 WRITE !!,$CHAR(7),"This action is inappropriate for this order."
+2 GOTO Q
EDCHK ;
+1 SET GMRVORD(5)=GMRVSTRT_GMRVAS_GMRVCOM_GMRVSTOP
FOR I=1:1:$LENGTH(GMRVORD(4))
if '($EXTRACT(GMRVORD(4),I)="~")
SET GMRVORD(6)=GMRVORD(6)_$EXTRACT(GMRVORD(4),I)
+2 IF GMRVORD(4)'=""
IF GMRVORD(6)=GMRVORD(5)
WRITE $CHAR(7),!?4,"No change to existing order!!"
SET GMROUT=1
+3 QUIT
