RAORR ;HISC/CAH,FPT,GJC AISC/DMK-OE/RR driver ;2/2/98 14:43
;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
;OE/RR Utility routine for Rad/Nuc Med
Q:'$D(ORACTION)
I $$ORVR^RAORDU()'=2.5!(ORACTION="")!("012345678"'[ORACTION) Q
D @ORACTION
Q
0 ;Adding new order
I '$D(ORGY) K RAPKG D ENADD^RAORD1 K RADR1 Q
I ORGY=0 K RAPKG D ENADD^RAORD1 K RADR1 Q ;new order
I ORGY=9 S ORETURN("ORSTS")=5 D ^RAORR1 Q ;If released & pending
I ORGY=10 D ^RAORR2 ;verify a signed order
Q
1 ;Edit order
I $D(ORPRES),+ORPRES=6 G ^RAORR1
I $D(ORSTS),ORSTS=11 G ^RAORR1 ;If unreleased
D NO
W !,"Cannot edit a Radiology/Nuclear Medicine order once released."
W !,"To change the order, discontinue the current order and add a"
W !,"new one.",!
Q
2 ;RENEW ORDERS
D NO
Q
3 ;Flag orders
D NO
Q
4 ;Hold orders
D NO
W !,"Holding requests is reserved for Radiology/Nuclear Medicine personnel.",!
Q ;not used
5 ;Event processor
D NO
Q
6 ;Discontinue order
; if new order and unreleased, delete entries from Rad/Nuc Med & OE/RR
; Orders files.
N RAXIT S RAXIT=0
I ORGY=0,ORSTS=11 D CHECK^RAORD Q:OREND S RAORDS(1)=+ORPK D ENCAN^RAORD Q
I ORGY=0 D CHECK^RAORD Q:OREND D REASON^RAORD Q:RAXIT!(+$G(OREND)) D DC^ORX5 Q
I ORGY=10 D CHECK^RAORD Q
I ORGY=9 S RAORDS(1)=+ORPK D ENCAN^RAORD Q
Q
7 ;Purge order
K RAPKG D ENPUR^RAPURGE1
Q
8 ;Print order
K RAPKG D ENDIS^RAORD2 Q
Q
NO W !,"This action is inappropriate for this order.",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAORR 1491 printed Dec 13, 2024@02:38:24 Page 2
RAORR ;HISC/CAH,FPT,GJC AISC/DMK-OE/RR driver ;2/2/98 14:43
+1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
+2 ;OE/RR Utility routine for Rad/Nuc Med
+3 if '$DATA(ORACTION)
QUIT
+4 IF $$ORVR^RAORDU()'=2.5!(ORACTION="")!("012345678"'[ORACTION)
QUIT
+5 DO @ORACTION
+6 QUIT
0 ;Adding new order
+1 IF '$DATA(ORGY)
KILL RAPKG
DO ENADD^RAORD1
KILL RADR1
QUIT
+2 ;new order
IF ORGY=0
KILL RAPKG
DO ENADD^RAORD1
KILL RADR1
QUIT
+3 ;If released & pending
IF ORGY=9
SET ORETURN("ORSTS")=5
DO ^RAORR1
QUIT
+4 ;verify a signed order
IF ORGY=10
DO ^RAORR2
+5 QUIT
1 ;Edit order
+1 IF $DATA(ORPRES)
IF +ORPRES=6
GOTO ^RAORR1
+2 ;If unreleased
IF $DATA(ORSTS)
IF ORSTS=11
GOTO ^RAORR1
+3 DO NO
+4 WRITE !,"Cannot edit a Radiology/Nuclear Medicine order once released."
+5 WRITE !,"To change the order, discontinue the current order and add a"
+6 WRITE !,"new one.",!
+7 QUIT
2 ;RENEW ORDERS
+1 DO NO
+2 QUIT
3 ;Flag orders
+1 DO NO
+2 QUIT
4 ;Hold orders
+1 DO NO
+2 WRITE !,"Holding requests is reserved for Radiology/Nuclear Medicine personnel.",!
+3 ;not used
QUIT
5 ;Event processor
+1 DO NO
+2 QUIT
6 ;Discontinue order
+1 ; if new order and unreleased, delete entries from Rad/Nuc Med & OE/RR
+2 ; Orders files.
+3 NEW RAXIT
SET RAXIT=0
+4 IF ORGY=0
IF ORSTS=11
DO CHECK^RAORD
if OREND
QUIT
SET RAORDS(1)=+ORPK
DO ENCAN^RAORD
QUIT
+5 IF ORGY=0
DO CHECK^RAORD
if OREND
QUIT
DO REASON^RAORD
if RAXIT!(+$GET(OREND))
QUIT
DO DC^ORX5
QUIT
+6 IF ORGY=10
DO CHECK^RAORD
QUIT
+7 IF ORGY=9
SET RAORDS(1)=+ORPK
DO ENCAN^RAORD
QUIT
+8 QUIT
7 ;Purge order
+1 KILL RAPKG
DO ENPUR^RAPURGE1
+2 QUIT
8 ;Print order
+1 KILL RAPKG
DO ENDIS^RAORD2
QUIT
+2 QUIT
NO WRITE !,"This action is inappropriate for this order.",!
+1 QUIT
