1 | RAORR ;HISC/CAH,FPT,GJC AISC/DMK-OE/RR driver ;2/2/98 14:43
|
---|
2 | ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
|
---|
3 | ;OE/RR Utility routine for Rad/Nuc Med
|
---|
4 | Q:'$D(ORACTION)
|
---|
5 | I $$ORVR^RAORDU()'=2.5!(ORACTION="")!("012345678"'[ORACTION) Q
|
---|
6 | D @ORACTION
|
---|
7 | Q
|
---|
8 | 0 ;Adding new order
|
---|
9 | I '$D(ORGY) K RAPKG D ENADD^RAORD1 K RADR1 Q
|
---|
10 | I ORGY=0 K RAPKG D ENADD^RAORD1 K RADR1 Q ;new order
|
---|
11 | I ORGY=9 S ORETURN("ORSTS")=5 D ^RAORR1 Q ;If released & pending
|
---|
12 | I ORGY=10 D ^RAORR2 ;verify a signed order
|
---|
13 | Q
|
---|
14 | 1 ;Edit order
|
---|
15 | I $D(ORPRES),+ORPRES=6 G ^RAORR1
|
---|
16 | I $D(ORSTS),ORSTS=11 G ^RAORR1 ;If unreleased
|
---|
17 | D NO
|
---|
18 | W !,"Cannot edit a Radiology/Nuclear Medicine order once released."
|
---|
19 | W !,"To change the order, discontinue the current order and add a"
|
---|
20 | W !,"new one.",!
|
---|
21 | Q
|
---|
22 | 2 ;RENEW ORDERS
|
---|
23 | D NO
|
---|
24 | Q
|
---|
25 | 3 ;Flag orders
|
---|
26 | D NO
|
---|
27 | Q
|
---|
28 | 4 ;Hold orders
|
---|
29 | D NO
|
---|
30 | W !,"Holding requests is reserved for Radiology/Nuclear Medicine personnel.",!
|
---|
31 | Q ;not used
|
---|
32 | 5 ;Event processor
|
---|
33 | D NO
|
---|
34 | Q
|
---|
35 | 6 ;Discontinue order
|
---|
36 | ; if new order and unreleased, delete entries from Rad/Nuc Med & OE/RR
|
---|
37 | ; Orders files.
|
---|
38 | N RAXIT S RAXIT=0
|
---|
39 | I ORGY=0,ORSTS=11 D CHECK^RAORD Q:OREND S RAORDS(1)=+ORPK D ENCAN^RAORD Q
|
---|
40 | I ORGY=0 D CHECK^RAORD Q:OREND D REASON^RAORD Q:RAXIT!(+$G(OREND)) D DC^ORX5 Q
|
---|
41 | I ORGY=10 D CHECK^RAORD Q
|
---|
42 | I ORGY=9 S RAORDS(1)=+ORPK D ENCAN^RAORD Q
|
---|
43 | Q
|
---|
44 | 7 ;Purge order
|
---|
45 | K RAPKG D ENPUR^RAPURGE1
|
---|
46 | Q
|
---|
47 | 8 ;Print order
|
---|
48 | K RAPKG D ENDIS^RAORD2 Q
|
---|
49 | Q
|
---|
50 | NO W !,"This action is inappropriate for this order.",!
|
---|
51 | Q
|
---|