source: FOIAVistA/trunk/r/GEN_MED_REC_VITALS-GMRV/GMRVORE1.m@ 1720

Last change on this file since 1720 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.0 KB
Line 
1GMRVORE1 ;HIRMFO/RM-ORDER ENTRY ACTION (Cont.) ;11/20/95
2 ;;4.0;Vitals/Measurements;;Apr 25, 1997
3EN1 ; CHECK FOR ACTIVE VITALS ORDERS
4 S ORUPKG=$O(^ORD(100.98,"B","VITALS/MEASUREMENTS",0)) Q:ORUPKG'>0
5 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
6 I $D(GMRACT) D PRNTACT
7 K ORUPCHUK
8 Q
9STACK ; CHECK FOR ORDERS WITH ACTIVE STATUS
10 D EN^ORX8(GMRY) I +ORUPCHUK("ORSTS")=6 S GMRACT(GMRX,GMRY)=+$G(ORUPCHUK("ORPCL"))
11 K ORUPCHUK
12 Q
13PRNTACT ; PRINT OUT ACTIVE ORDERS AND ASK TO DC
14 S GMRVT=$O(^ORD(101,"C",$P($P(GMRVORD(2),"^",5)," - "),0))
15 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)
16 Q:'GMROUT I GMROUT S GMROUT=0
17 W !,"The following is a list of vitals/measurements orders already active",!,"for this patient:",!
18 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
19 Q:GMROUT
20YNCN 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
21 I '% W !,$C(7),?3,"ANSWER YES OR NO" G YNCN
22 Q
23CHK ;
24 I GMRVT=GMRVT(0) S GMROUT=1 Q
25 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
26 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
27 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
28 Q
29PRT ; PRINT LINE
30 I $Y>(IOSL-4) D PGBRK^ORUHDR S:$D(DIROUT) GMROUT=1 Q:OREND D HDR
31 D EN^ORX8(GMRY)
32 S GMRRQ=+$G(ORUPCHUK("ORPV")),GMRTX=ORUPCHUK("ORTX",1),GMRSTRT=+$G(ORUPCHUK("ORSTRT")),GMRSTOP=+$G(ORUPCHUK("ORSTOP")),GMRENT=+$G(ORUPCHUK("ORODT")) K ORUPCHUK
33 S GMRRQ=$S(GMRRQ:$S($D(^VA(200,GMRRQ,0)):$E($P(^(0),"^"),1,8),1:"UNKNOWN"),1:"UNKNOWN")
34 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
35 S GMRTX(1)=$E(GMRTX,1,X-2),GMRTX(2)=$E(GMRTX,X,120)
36 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
37 S GMRTX(3)=" "_$E(GMRTX(2),X,119),GMRTX(2)=$E(GMRTX(2),1,X-2)
38 S GMRENT(1)=$S($L(GMRENT):$E(GMRENT,4,5)_"/"_$E(GMRENT,6,7),1:""),X=GMRENT D MTIM S GMRENT(2)=X
39 S GMRSTRT(1)=$S($L(GMRSTRT):$E(GMRSTRT,4,5)_"/"_$E(GMRSTRT,6,7),1:""),X=GMRSTRT D MTIM S GMRSTRT(2)=X
40 S GMRSTOP(1)=$S($L(GMRSTOP):$E(GMRSTOP,4,5)_"/"_$E(GMRSTOP,6,7),1:""),X=GMRSTOP D MTIM S GMRSTOP(2)=X
41 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),!
42 Q
43HDR W @IOF
44HDR1 W !,"Item Ordered",?42,"Ord'd",?50,"Requestor",?61,"Start",?68,"Stop",!
45 Q
46MTIM ; ENTRY TO CONVERT DATE IN X TO PRINTABLE FORMAT
47 S X=$P(X,".",2) Q:'$L(X)
48 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)))
49 Q
Note: See TracBrowser for help on using the repository browser.