RAORR1 ;HISC/CAH,FPT,GJC AISC/DMK-Edit a new request from OERR ;11/13/97 15:25
;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
;OE/RR Utility routine for Rad/Nuc Med
I $S('$D(ORIFN):1,'$L(ORIFN):1,1:0) G END
I $S('$D(ORPK):1,'$D(^RAO(75.1,+ORPK,0)):1,1:0) G END
G END:'$D(ORVP)!('$D(ORL))!('$D(ORNP))
S RADFN=+ORVP,RALIFN=+ORL,RAPIFN=+ORNP
SELECT S RAORIFN=ORIFN,RAOIFN=+ORPK D OERR1
Q
OERR1 ;
S RAORD0=$S($D(^RAO(75.1,RAOIFN,0)):^(0),1:"") G END:'RAORD0 D SETDIV
I ORACTION=1 D ; editing an existing order
. N RALOC,RAREQER S RAREQER(0)=$P(RAORD0,"^",6) ; Request Urgency before
. S DA=RAOIFN,DIE="^RAO(75.1,",DR="[RA OERR EDIT]" D ^DIE
. K DR,DIE S RAORD0=$G(^RAO(75.1,RAOIFN,0)),RALOC=+$P(RAORD0,"^",20)
. S RAREQER(1)=$P(RAORD0,"^",6) ; Request Urgency after
. I RAREQER(1)=1!(RAREQER(1)=2&($P($G(^RA(79.1,RALOC,0)),"^",20)="Y")) D
.. ; If Req. Urgency is STAT (1) -or- [Req. Urgency is URGENT (2) -and-
.. ; Urgent Request Alerts? set to 'yes'.]
.. Q:$$ORVR^RAORDU()<3 ; needs OE/RR 3.0 or greater for alerts to fire
.. D OENO^RAUTL19(RAOIFN)
.. Q
. Q
UPDATE ;
N RAPRGST S RAPRGST=$P(RAORD0,"^",13)
S RABLNK="",$P(RABLNK," ",40)=""
K RAMOD F I=0:0 S I=$O(^RAO(75.1,RAOIFN,"M","B",I)) Q:'I I $D(^RAMIS(71.2,+I,0)) S RAMOD=$S('$D(RAMOD):$P(^(0),"^"),1:RAMOD_", "_$P(^(0),"^"))
S RASEX=$P($G(^DPT(+RAORD0,0)),"^",2)
I $$ORVR^RAORDU()=2.5 S (RAPRC,ORETURN("ORTX",1))=$P($G(^RAMIS(71,+$P(RAORD0,"^",2),0)),"^")_"," D
.I $D(RAMOD) S ORETURN("ORTX",2)="Modifiers: "_$E(RAMOD,1,80)_","
.S ORETURN("ORTX",3)="Urgency: "_$S($P(RAORD0,"^",6)=1:"STAT",$P(RAORD0,"^",6)=2:"URGENT",1:"ROUTINE")_","
.I $P(RAORD0,"^",19)]"" S X=$P(RAORD0,"^",19),ORETURN("ORTX",3)=ORETURN("ORTX",3)_" Transport: "_$S(X="a":"AMBULATORY",X="p":"PORTABLE",X="s":"STRETCHER",1:"WHEELCHAIR")_","
.I $D(RASEX),RASEX'="M" S ORETURN("ORTX",3)=ORETURN("ORTX",3)_" Pregnant: "_$S(RAPRGST="n":"NO",RAPRGST="y":"YES",RAPRGST="u":"UNKNOWN",1:"")
.S ORETURN("ORIT")=$P(RAORD0,"^",2)_";RAMIS(71,"
S DIC="^RA(79.2,",DIC(0)="N",X=+$P(^RAMIS(71,+$P(RAORD0,"^",2),0),"^",12) D ^DIC K DIC S ORETURN("ORPURG")=$S(Y<0:30,$D(^RA(79.2,+Y,.1)):+$P(^(.1),"^",6),1:30)
S ORETURN("ORSTRT")=$P(^RAO(75.1,RAOIFN,0),"^",21)
D RETURN^ORX
I $D(ORGY),ORGY=9 D RELEASE
D END Q
QUE ;
F RAORIFN=0:0 S RAORIFN=$O(^XUTL("OR",$J,"RA",RAORIFN)) Q:'RAORIFN F RAOIFN=0:0 S RAOIFN=$O(^(RAORIFN,RAOIFN)) Q:'RAOIFN S RADIV=^(RAOIFN) D DIV I $D(^RAO(75.1,RAOIFN,0)) S RAORD0=^(0),RADFN=+RAORD0 D ^RAORDQ K ^XUTL("OR",$J,"RA",RAORIFN)
;
END K RAOIFN,RAORD0,DA,DIE,DR,RABLNK,RAMOD,RAPRC,DIC,RADFN,RALOCFLG,RADIV,RAFIN,RAL0,RALIFN,RALOC,RANME,RAPIFN,RAREQPRT,RASEX,RAX,VA,RACAT,RAORIFN,RAWARD,RAOIFN0,RAFOERR
; RAOEFRR is set in ENADD^RAORD1. This variable is user to omit exam
; information from printing on the request. (If exam data present)
Q
DIV I $D(RADIV),$D(^RA(79,+RADIV,.1)),$P(^(.1),"^",21)="y" S RALOCFLG="" Q
I '$D(RADIV) S RADIV=$O(^RA(79,"AL",+$P($G(^RAO(75.1,RAOIFN,0)),"^",20),0)) Q:'RADIV I $D(^RA(79,+RADIV,.1)),$P(^(.1),"^",21)="y" S RALOCFLG=""
Q
SETDIV ;set RADIV and RACAT
S RAL0=$S($D(^SC(RALIFN,0)):^(0),1:0)
S RADIV=+$$SITE^VASITE(DT,+$P(RAL0,"^",15)) S:RADIV<0 RADIV=0
S RADIV=$S($D(^RA(79,RADIV,0)):RADIV,1:$O(^RA(79,0)))
S RACAT=$P($P(^DD(75.1,4,0),$P(RAORD0,"^",4)_":",2),";")
Q
RELEASE ;called to release an order
I $D(RADIV),$D(^RA(79,+RADIV,.1)),$P(^(.1),"^",21)="y" S RALOCFLG=""
I $S('$D(RADIV):1,'RADIV:1,1:0) S RADIV=$O(^RA(79,"AL",+$P($G(^RAO(75.1,RAOIFN,0)),"^",20),0)) Q:'RADIV
S DA=RAOIFN,DIE="^RAO(75.1,",DR="5////^S X=5" D ^DIE K DIE,DA,DR
I $$UP^XLFSTR($P($G(^RA(79,+RADIV,.1)),"^",19))="Y" D
. ; update 'Request Status Times' multiple
. N DA,DE,DIE,DQ,DR
. S DA=RAOIFN,DIE="^RAO(75.1,",DR="75///^S X=""""""NOW"""""""
. S DR(2,75.12)="2////^S X=5;3////^S X="_DUZ D ^DIE
. Q
S RAMES="W """"" D ^RAORDQ K ^XUTL("OR",$J,"RA") Q
RAORR1 ;HISC/CAH,FPT,GJC AISC/DMK-Edit a new request from OERR ;11/13/97 15:25
+1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
+2 ;OE/RR Utility routine for Rad/Nuc Med
+3 IF $SELECT('$DATA(ORIFN):1,'$LENGTH(ORIFN):1,1:0)
GOTO END
+4 IF $SELECT('$DATA(ORPK):1,'$DATA(^RAO(75.1,+ORPK,0)):1,1:0)
GOTO END
+5 IF '$DATA(ORVP)!('$DATA(ORL))!('$DATA(ORNP))
GOTO END
+6 SET RADFN=+ORVP
SET RALIFN=+ORL
SET RAPIFN=+ORNP
SELECT SET RAORIFN=ORIFN
SET RAOIFN=+ORPK
DO OERR1
+1 QUIT
OERR1 ;
+1 SET RAORD0=$SELECT($DATA(^RAO(75.1,RAOIFN,0)):^(0),1:"")
IF 'RAORD0
GOTO END
DO SETDIV
+2 ; editing an existing order
IF ORACTION=1
Begin DoDot:1
+3 ; Request Urgency before
NEW RALOC,RAREQER
SET RAREQER(0)=$PIECE(RAORD0,"^",6)
+4 SET DA=RAOIFN
SET DIE="^RAO(75.1,"
SET DR="[RA OERR EDIT]"
DO ^DIE
+5 KILL DR,DIE
SET RAORD0=$GET(^RAO(75.1,RAOIFN,0))
SET RALOC=+$PIECE(RAORD0,"^",20)
+6 ; Request Urgency after
SET RAREQER(1)=$PIECE(RAORD0,"^",6)
+7 IF RAREQER(1)=1!(RAREQER(1)=2&($PIECE($GET(^RA(79.1,RALOC,0)),"^",20)="Y"))
Begin DoDot:2
+8 ; If Req. Urgency is STAT (1) -or- [Req. Urgency is URGENT (2) -and-
+9 ; Urgent Request Alerts? set to 'yes'.]
+10 ; needs OE/RR 3.0 or greater for alerts to fire
IF $$ORVR^RAORDU()<3
QUIT
+11 DO OENO^RAUTL19(RAOIFN)
+12 QUIT
End DoDot:2
+13 QUIT
End DoDot:1
UPDATE ;
+1 NEW RAPRGST
SET RAPRGST=$PIECE(RAORD0,"^",13)
+2 SET RABLNK=""
SET $PIECE(RABLNK," ",40)=""
+3 KILL RAMOD
FOR I=0:0
SET I=$ORDER(^RAO(75.1,RAOIFN,"M","B",I))
IF 'I
QUIT
IF $DATA(^RAMIS(71.2,+I,0))
SET RAMOD=$SELECT('$DATA(RAMOD):$PIECE(^(0),"^"),1:RAMOD_", "_$PIECE(^(0),"^"))
+4 SET RASEX=$PIECE($GET(^DPT(+RAORD0,0)),"^",2)
+5 IF $$ORVR^RAORDU()=2.5
SET (RAPRC,ORETURN("ORTX",1))=$PIECE($GET(^RAMIS(71,+$PIECE(RAORD0,"^",2),0)),"^")_","
Begin DoDot:1
+6 IF $DATA(RAMOD)
SET ORETURN("ORTX",2)="Modifiers: "_$EXTRACT(RAMOD,1,80)_","
+7 SET ORETURN("ORTX",3)="Urgency: "_$SELECT($PIECE(RAORD0,"^",6)=1:"STAT",$PIECE(RAORD0,"^",6)=2:"URGENT",1:"ROUTINE")_","
+8 IF $PIECE(RAORD0,"^",19)]""
SET X=$PIECE(RAORD0,"^",19)
SET ORETURN("ORTX",3)=ORETURN("ORTX",3)_" Transport: "_$SELECT(X="a":"AMBULATORY",X="p":"PORTABLE",X="s":"STRETCHER",1:"WHEELCHAIR")_","
+9 IF $DATA(RASEX)
IF RASEX'="M"
SET ORETURN("ORTX",3)=ORETURN("ORTX",3)_" Pregnant: "_$SELECT(RAPRGST="n":"NO",RAPRGST="y":"YES",RAPRGST="u":"UNKNOWN",1:"")
+10 SET ORETURN("ORIT")=$PIECE(RAORD0,"^",2)_";RAMIS(71,"
End DoDot:1
+11 SET DIC="^RA(79.2,"
SET DIC(0)="N"
SET X=+$PIECE(^RAMIS(71,+$PIECE(RAORD0,"^",2),0),"^",12)
DO ^DIC
KILL DIC
SET ORETURN("ORPURG")=$SELECT(Y<0:30,$DATA(^RA(79.2,+Y,.1)):+$PIECE(^(.1),"^",6),1:30)
+12 SET ORETURN("ORSTRT")=$PIECE(^RAO(75.1,RAOIFN,0),"^",21)
+13 DO RETURN^ORX
+14 IF $DATA(ORGY)
IF ORGY=9
DO RELEASE
+15 DO END
QUIT
QUE ;
+1 FOR RAORIFN=0:0
SET RAORIFN=$ORDER(^XUTL("OR",$JOB,"RA",RAORIFN))
IF 'RAORIFN
QUIT
FOR RAOIFN=0:0
SET RAOIFN=$ORDER(^(RAORIFN,RAOIFN))
IF 'RAOIFN
QUIT
SET RADIV=^(RAOIFN)
DO DIV
IF $DATA(^RAO(75.1,RAOIFN,0))
SET RAORD0=^(0)
SET RADFN=+RAORD0
DO ^RAORDQ
KILL ^XUTL("OR",$JOB,"RA",RAORIFN)
+2 ;
END KILL RAOIFN,RAORD0,DA,DIE,DR,RABLNK,RAMOD,RAPRC,DIC,RADFN,RALOCFLG,RADIV,RAFIN,RAL0,RALIFN,RALOC,RANME,RAPIFN,RAREQPRT,RASEX,RAX,VA,RACAT,RAORIFN,RAWARD,RAOIFN0,RAFOERR
+1 ; RAOEFRR is set in ENADD^RAORD1. This variable is user to omit exam
+2 ; information from printing on the request. (If exam data present)
+3 QUIT
DIV IF $DATA(RADIV)
IF $DATA(^RA(79,+RADIV,.1))
IF $PIECE(^(.1),"^",21)="y"
SET RALOCFLG=""
QUIT
+1 IF '$DATA(RADIV)
SET RADIV=$ORDER(^RA(79,"AL",+$PIECE($GET(^RAO(75.1,RAOIFN,0)),"^",20),0))
IF 'RADIV
QUIT
IF $DATA(^RA(79,+RADIV,.1))
IF $PIECE(^(.1),"^",21)="y"
SET RALOCFLG=""
+2 QUIT
SETDIV ;set RADIV and RACAT
+1 SET RAL0=$SELECT($DATA(^SC(RALIFN,0)):^(0),1:0)
+2 SET RADIV=+$$SITE^VASITE(DT,+$PIECE(RAL0,"^",15))
IF RADIV<0
SET RADIV=0
+3 SET RADIV=$SELECT($DATA(^RA(79,RADIV,0)):RADIV,1:$ORDER(^RA(79,0)))
+4 SET RACAT=$PIECE($PIECE(^DD(75.1,4,0),$PIECE(RAORD0,"^",4)_":",2),";")
+5 QUIT
RELEASE ;called to release an order
+1 IF $DATA(RADIV)
IF $DATA(^RA(79,+RADIV,.1))
IF $PIECE(^(.1),"^",21)="y"
SET RALOCFLG=""
+2 IF $SELECT('$DATA(RADIV):1,'RADIV:1,1:0)
SET RADIV=$ORDER(^RA(79,"AL",+$PIECE($GET(^RAO(75.1,RAOIFN,0)),"^",20),0))
IF 'RADIV
QUIT
+3 SET DA=RAOIFN
SET DIE="^RAO(75.1,"
SET DR="5////^S X=5"
DO ^DIE
KILL DIE,DA,DR
+4 IF $$UP^XLFSTR($PIECE($GET(^RA(79,+RADIV,.1)),"^",19))="Y"
Begin DoDot:1
+5 ; update 'Request Status Times' multiple
+6 NEW DA,DE,DIE,DQ,DR
+7 SET DA=RAOIFN
SET DIE="^RAO(75.1,"
SET DR="75///^S X=""""""NOW"""""""
+8 SET DR(2,75.12)="2////^S X=5;3////^S X="_DUZ
DO ^DIE
+9 QUIT
End DoDot:1
+10 SET RAMES="W """""
DO ^RAORDQ
KILL ^XUTL("OR",$JOB,"RA")
QUIT
