- 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
- 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