GMRVORE1 ;HIRMFO/RM-ORDER ENTRY ACTION (Cont.) ;11/20/95
;;4.0;Vitals/Measurements;;Apr 25, 1997
EN1 ; CHECK FOR ACTIVE VITALS ORDERS
S ORUPKG=$O(^ORD(100.98,"B","VITALS/MEASUREMENTS",0)) Q:ORUPKG'>0
F GMRX=0:0 S GMRX=$O(^OR(100,"AO",ORVP,GMRX)) Q:GMRX'>0 F GMRY=0:0 S GMRY=$O(^OR(100,"AO",ORVP,GMRX,ORUPKG,GMRY)) Q:GMRY'>0 D STACK
I $D(GMRACT) D PRNTACT
K ORUPCHUK
Q
STACK ; CHECK FOR ORDERS WITH ACTIVE STATUS
D EN^ORX8(GMRY) I +ORUPCHUK("ORSTS")=6 S GMRACT(GMRX,GMRY)=+$G(ORUPCHUK("ORPCL"))
K ORUPCHUK
Q
PRNTACT ; PRINT OUT ACTIVE ORDERS AND ASK TO DC
S GMRVT=$O(^ORD(101,"C",$P($P(GMRVORD(2),"^",5)," - "),0))
I GMRVT>0 F GMRX=0:0 S GMRX=$O(GMRACT(GMRX)) Q:GMRX'>0!GMROUT F GMRY=0:0 S GMRY=$O(GMRACT(GMRX,GMRY)) Q:GMRY'>0 S GMRVT(0)=GMRACT(GMRX,GMRY) D CHK K:'GMROUT GMRACT(GMRX,GMRY)
Q:'GMROUT I GMROUT S GMROUT=0
W !,"The following is a list of vitals/measurements orders already active",!,"for this patient:",!
D HDR1 F GMRX=0:0 S GMRX=$O(GMRACT(GMRX)) Q:GMRX'>0!OREND!GMROUT F GMRY=0:0 S GMRY=$O(GMRACT(GMRX,GMRY)) Q:GMRY'>0 D PRT Q:GMROUT!OREND
Q:GMROUT
YNCN S %=2 W !,"Do you still want to add "_$S($P(GMRVORD(2),"^",5)'="":$P(GMRVORD(2),"^",5)_" as a",1:"the")_" new order" D YN^DICN I %=-1!(%=2) S GMROUT=1 Q
I '% W !,$C(7),?3,"ANSWER YES OR NO" G YNCN
Q
CHK ;
I GMRVT=GMRVT(0) S GMROUT=1 Q
F X=0:0 S X=$O(^ORD(101,GMRVT,10,X)) Q:X'>0 I $P(^ORD(101,GMRVT,10,X,0),"^")=GMRVT(0) S GMROUT=1 Q
Q:GMROUT F X=0:0 S X=$O(^ORD(101,GMRVT(0),10,X)) Q:X'>0 I $P(^ORD(101,GMRVT(0),10,X,0),"^")=GMRVT S GMROUT=1 Q
Q:GMROUT F X=0:0 S X=$O(^ORD(101,GMRVT,10,X)) Q:X'>0!GMROUT F X(0)=0:0 S X(0)=$O(^ORD(101,GMRVT(0),10,X(0))) Q:X(0)'>0 I $P(^ORD(101,GMRVT,10,X,0),"^")=$P(^ORD(101,GMRVT(0),10,X(0),0),"^") S GMROUT=1 Q
Q
PRT ; PRINT LINE
I $Y>(IOSL-4) D PGBRK^ORUHDR S:$D(DIROUT) GMROUT=1 Q:OREND D HDR
D EN^ORX8(GMRY)
S GMRRQ=+$G(ORUPCHUK("ORPV")),GMRTX=ORUPCHUK("ORTX",1),GMRSTRT=+$G(ORUPCHUK("ORSTRT")),GMRSTOP=+$G(ORUPCHUK("ORSTOP")),GMRENT=+$G(ORUPCHUK("ORODT")) K ORUPCHUK
S GMRRQ=$S(GMRRQ:$S($D(^VA(200,GMRRQ,0)):$E($P(^(0),"^"),1,8),1:"UNKNOWN"),1:"UNKNOWN")
S X=42 I $L(GMRTX)>40 F Y=0:0 S Y=$F($E(GMRTX,1,40)," ",Y) Q:Y<1 S X=Y
S GMRTX(1)=$E(GMRTX,1,X-2),GMRTX(2)=$E(GMRTX,X,120)
S X=42 I $L(GMRTX(2))>40 F Y=0:0 S Y=$F($E(GMRTX(2),1,40)," ",Y) Q:Y<1 S X=Y
S GMRTX(3)=" "_$E(GMRTX(2),X,119),GMRTX(2)=$E(GMRTX(2),1,X-2)
S GMRENT(1)=$S($L(GMRENT):$E(GMRENT,4,5)_"/"_$E(GMRENT,6,7),1:""),X=GMRENT D MTIM S GMRENT(2)=X
S GMRSTRT(1)=$S($L(GMRSTRT):$E(GMRSTRT,4,5)_"/"_$E(GMRSTRT,6,7),1:""),X=GMRSTRT D MTIM S GMRSTRT(2)=X
S GMRSTOP(1)=$S($L(GMRSTOP):$E(GMRSTOP,4,5)_"/"_$E(GMRSTOP,6,7),1:""),X=GMRSTOP D MTIM S GMRSTOP(2)=X
W !,GMRTX(1),?42,GMRENT(1),?50,GMRRQ,?61,GMRSTRT(1),?68,GMRSTOP(1),!,GMRTX(2),?42,GMRENT(2),?61,GMRSTRT(2),?68,GMRSTOP(2) W ! W:$L(GMRTX(3)) GMRTX(3),!
Q
HDR W @IOF
HDR1 W !,"Item Ordered",?42,"Ord'd",?50,"Requestor",?61,"Start",?68,"Stop",!
Q
MTIM ; ENTRY TO CONVERT DATE IN X TO PRINTABLE FORMAT
S X=$P(X,".",2) Q:'$L(X)
S X=$E(X,1,2)_$E("00",0,2-$L($E(X,1,2)))_":"_$E(X,3,4)_$E("00",0,2-$L($E(X,3,4)))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRVORE1 3136 printed Oct 16, 2024@17:57:59 Page 2
GMRVORE1 ;HIRMFO/RM-ORDER ENTRY ACTION (Cont.) ;11/20/95
+1 ;;4.0;Vitals/Measurements;;Apr 25, 1997
EN1 ; CHECK FOR ACTIVE VITALS ORDERS
+1 SET ORUPKG=$ORDER(^ORD(100.98,"B","VITALS/MEASUREMENTS",0))
if ORUPKG'>0
QUIT
+2 FOR GMRX=0:0
SET GMRX=$ORDER(^OR(100,"AO",ORVP,GMRX))
if GMRX'>0
QUIT
FOR GMRY=0:0
SET GMRY=$ORDER(^OR(100,"AO",ORVP,GMRX,ORUPKG,GMRY))
if GMRY'>0
QUIT
DO STACK
+3 IF $DATA(GMRACT)
DO PRNTACT
+4 KILL ORUPCHUK
+5 QUIT
STACK ; CHECK FOR ORDERS WITH ACTIVE STATUS
+1 DO EN^ORX8(GMRY)
IF +ORUPCHUK("ORSTS")=6
SET GMRACT(GMRX,GMRY)=+$GET(ORUPCHUK("ORPCL"))
+2 KILL ORUPCHUK
+3 QUIT
PRNTACT ; PRINT OUT ACTIVE ORDERS AND ASK TO DC
+1 SET GMRVT=$ORDER(^ORD(101,"C",$PIECE($PIECE(GMRVORD(2),"^",5)," - "),0))
+2 IF GMRVT>0
FOR GMRX=0:0
SET GMRX=$ORDER(GMRACT(GMRX))
if GMRX'>0!GMROUT
QUIT
FOR GMRY=0:0
SET GMRY=$ORDER(GMRACT(GMRX,GMRY))
if GMRY'>0
QUIT
SET GMRVT(0)=GMRACT(GMRX,GMRY)
DO CHK
if 'GMROUT
KILL GMRACT(GMRX,GMRY)
+3 if 'GMROUT
QUIT
IF GMROUT
SET GMROUT=0
+4 WRITE !,"The following is a list of vitals/measurements orders already active",!,"for this patient:",!
+5 DO HDR1
FOR GMRX=0:0
SET GMRX=$ORDER(GMRACT(GMRX))
if GMRX'>0!OREND!GMROUT
QUIT
FOR GMRY=0:0
SET GMRY=$ORDER(GMRACT(GMRX,GMRY))
if GMRY'>0
QUIT
DO PRT
if GMROUT!OREND
QUIT
+6 if GMROUT
QUIT
YNCN SET %=2
WRITE !,"Do you still want to add "_$SELECT($PIECE(GMRVORD(2),"^",5)'="":$PIECE(GMRVORD(2),"^",5)_" as a",1:"the")_" new order"
DO YN^DICN
IF %=-1!(%=2)
SET GMROUT=1
QUIT
+1 IF '%
WRITE !,$CHAR(7),?3,"ANSWER YES OR NO"
GOTO YNCN
+2 QUIT
CHK ;
+1 IF GMRVT=GMRVT(0)
SET GMROUT=1
QUIT
+2 FOR X=0:0
SET X=$ORDER(^ORD(101,GMRVT,10,X))
if X'>0
QUIT
IF $PIECE(^ORD(101,GMRVT,10,X,0),"^")=GMRVT(0)
SET GMROUT=1
QUIT
+3 if GMROUT
QUIT
FOR X=0:0
SET X=$ORDER(^ORD(101,GMRVT(0),10,X))
if X'>0
QUIT
IF $PIECE(^ORD(101,GMRVT(0),10,X,0),"^")=GMRVT
SET GMROUT=1
QUIT
+4 if GMROUT
QUIT
FOR X=0:0
SET X=$ORDER(^ORD(101,GMRVT,10,X))
if X'>0!GMROUT
QUIT
FOR X(0)=0:0
SET X(0)=$ORDER(^ORD(101,GMRVT(0),10,X(0)))
if X(0)'>0
QUIT
IF $PIECE(^ORD(101,GMRVT,10,X,0),"^")=$PIECE(^ORD(101,GMRVT(0),10,X(0),0),"^")
SET GMROUT=1
QUIT
+5 QUIT
PRT ; PRINT LINE
+1 IF $Y>(IOSL-4)
DO PGBRK^ORUHDR
if $DATA(DIROUT)
SET GMROUT=1
if OREND
QUIT
DO HDR
+2 DO EN^ORX8(GMRY)
+3 SET GMRRQ=+$GET(ORUPCHUK("ORPV"))
SET GMRTX=ORUPCHUK("ORTX",1)
SET GMRSTRT=+$GET(ORUPCHUK("ORSTRT"))
SET GMRSTOP=+$GET(ORUPCHUK("ORSTOP"))
SET GMRENT=+$GET(ORUPCHUK("ORODT"))
KILL ORUPCHUK
+4 SET GMRRQ=$SELECT(GMRRQ:$SELECT($DATA(^VA(200,GMRRQ,0)):$EXTRACT($PIECE(^(0),"^"),1,8),1:"UNKNOWN"),1:"UNKNOWN")
+5 SET X=42
IF $LENGTH(GMRTX)>40
FOR Y=0:0
SET Y=$FIND($EXTRACT(GMRTX,1,40)," ",Y)
if Y<1
QUIT
SET X=Y
+6 SET GMRTX(1)=$EXTRACT(GMRTX,1,X-2)
SET GMRTX(2)=$EXTRACT(GMRTX,X,120)
+7 SET X=42
IF $LENGTH(GMRTX(2))>40
FOR Y=0:0
SET Y=$FIND($EXTRACT(GMRTX(2),1,40)," ",Y)
if Y<1
QUIT
SET X=Y
+8 SET GMRTX(3)=" "_$EXTRACT(GMRTX(2),X,119)
SET GMRTX(2)=$EXTRACT(GMRTX(2),1,X-2)
+9 SET GMRENT(1)=$SELECT($LENGTH(GMRENT):$EXTRACT(GMRENT,4,5)_"/"_$EXTRACT(GMRENT,6,7),1:"")
SET X=GMRENT
DO MTIM
SET GMRENT(2)=X
+10 SET GMRSTRT(1)=$SELECT($LENGTH(GMRSTRT):$EXTRACT(GMRSTRT,4,5)_"/"_$EXTRACT(GMRSTRT,6,7),1:"")
SET X=GMRSTRT
DO MTIM
SET GMRSTRT(2)=X
+11 SET GMRSTOP(1)=$SELECT($LENGTH(GMRSTOP):$EXTRACT(GMRSTOP,4,5)_"/"_$EXTRACT(GMRSTOP,6,7),1:"")
SET X=GMRSTOP
DO MTIM
SET GMRSTOP(2)=X
+12 WRITE !,GMRTX(1),?42,GMRENT(1),?50,GMRRQ,?61,GMRSTRT(1),?68,GMRSTOP(1),!,GMRTX(2),?42,GMRENT(2),?61,GMRSTRT(2),?68,GMRSTOP(2)
WRITE !
if $LENGTH(GMRTX(3))
WRITE GMRTX(3),!
+13 QUIT
HDR WRITE @IOF
HDR1 WRITE !,"Item Ordered",?42,"Ord'd",?50,"Requestor",?61,"Start",?68,"Stop",!
+1 QUIT
MTIM ; ENTRY TO CONVERT DATE IN X TO PRINTABLE FORMAT
+1 SET X=$PIECE(X,".",2)
if '$LENGTH(X)
QUIT
+2 SET X=$EXTRACT(X,1,2)_$EXTRACT("00",0,2-$LENGTH($EXTRACT(X,1,2)))_":"_$EXTRACT(X,3,4)_$EXTRACT("00",0,2-$LENGTH($EXTRACT(X,3,4)))
+3 QUIT
