- 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
