source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAORR1.m@ 794

Last change on this file since 794 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1RAORR1 ;HISC/CAH,FPT,GJC AISC/DMK-Edit a new request from OERR ;11/13/97 15:25
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3 ;OE/RR Utility routine for Rad/Nuc Med
4 I $S('$D(ORIFN):1,'$L(ORIFN):1,1:0) G END
5 I $S('$D(ORPK):1,'$D(^RAO(75.1,+ORPK,0)):1,1:0) G END
6 G END:'$D(ORVP)!('$D(ORL))!('$D(ORNP))
7 S RADFN=+ORVP,RALIFN=+ORL,RAPIFN=+ORNP
8SELECT S RAORIFN=ORIFN,RAOIFN=+ORPK D OERR1
9 Q
10OERR1 ;
11 S RAORD0=$S($D(^RAO(75.1,RAOIFN,0)):^(0),1:"") G END:'RAORD0 D SETDIV
12 I ORACTION=1 D ; editing an existing order
13 . N RALOC,RAREQER S RAREQER(0)=$P(RAORD0,"^",6) ; Request Urgency before
14 . S DA=RAOIFN,DIE="^RAO(75.1,",DR="[RA OERR EDIT]" D ^DIE
15 . K DR,DIE S RAORD0=$G(^RAO(75.1,RAOIFN,0)),RALOC=+$P(RAORD0,"^",20)
16 . S RAREQER(1)=$P(RAORD0,"^",6) ; Request Urgency after
17 . I RAREQER(1)=1!(RAREQER(1)=2&($P($G(^RA(79.1,RALOC,0)),"^",20)="Y")) D
18 .. ; If Req. Urgency is STAT (1) -or- [Req. Urgency is URGENT (2) -and-
19 .. ; Urgent Request Alerts? set to 'yes'.]
20 .. Q:$$ORVR^RAORDU()<3 ; needs OE/RR 3.0 or greater for alerts to fire
21 .. D OENO^RAUTL19(RAOIFN)
22 .. Q
23 . Q
24UPDATE ;
25 N RAPRGST S RAPRGST=$P(RAORD0,"^",13)
26 S RABLNK="",$P(RABLNK," ",40)=""
27 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),"^"))
28 S RASEX=$P($G(^DPT(+RAORD0,0)),"^",2)
29 I $$ORVR^RAORDU()=2.5 S (RAPRC,ORETURN("ORTX",1))=$P($G(^RAMIS(71,+$P(RAORD0,"^",2),0)),"^")_"," D
30 .I $D(RAMOD) S ORETURN("ORTX",2)="Modifiers: "_$E(RAMOD,1,80)_","
31 .S ORETURN("ORTX",3)="Urgency: "_$S($P(RAORD0,"^",6)=1:"STAT",$P(RAORD0,"^",6)=2:"URGENT",1:"ROUTINE")_","
32 .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")_","
33 .I $D(RASEX),RASEX'="M" S ORETURN("ORTX",3)=ORETURN("ORTX",3)_" Pregnant: "_$S(RAPRGST="n":"NO",RAPRGST="y":"YES",RAPRGST="u":"UNKNOWN",1:"")
34 .S ORETURN("ORIT")=$P(RAORD0,"^",2)_";RAMIS(71,"
35 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)
36 S ORETURN("ORSTRT")=$P(^RAO(75.1,RAOIFN,0),"^",21)
37 D RETURN^ORX
38 I $D(ORGY),ORGY=9 D RELEASE
39 D END Q
40QUE ;
41 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)
42 ;
43END 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
44 ; RAOEFRR is set in ENADD^RAORD1. This variable is user to omit exam
45 ; information from printing on the request. (If exam data present)
46 Q
47DIV I $D(RADIV),$D(^RA(79,+RADIV,.1)),$P(^(.1),"^",21)="y" S RALOCFLG="" Q
48 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=""
49 Q
50SETDIV ;set RADIV and RACAT
51 S RAL0=$S($D(^SC(RALIFN,0)):^(0),1:0)
52 S RADIV=+$$SITE^VASITE(DT,+$P(RAL0,"^",15)) S:RADIV<0 RADIV=0
53 S RADIV=$S($D(^RA(79,RADIV,0)):RADIV,1:$O(^RA(79,0)))
54 S RACAT=$P($P(^DD(75.1,4,0),$P(RAORD0,"^",4)_":",2),";")
55 Q
56RELEASE ;called to release an order
57 I $D(RADIV),$D(^RA(79,+RADIV,.1)),$P(^(.1),"^",21)="y" S RALOCFLG=""
58 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
59 S DA=RAOIFN,DIE="^RAO(75.1,",DR="5////^S X=5" D ^DIE K DIE,DA,DR
60 I $$UP^XLFSTR($P($G(^RA(79,+RADIV,.1)),"^",19))="Y" D
61 . ; update 'Request Status Times' multiple
62 . N DA,DE,DIE,DQ,DR
63 . S DA=RAOIFN,DIE="^RAO(75.1,",DR="75///^S X=""""""NOW"""""""
64 . S DR(2,75.12)="2////^S X=5;3////^S X="_DUZ D ^DIE
65 . Q
66 S RAMES="W """"" D ^RAORDQ K ^XUTL("OR",$J,"RA") Q
Note: See TracBrowser for help on using the repository browser.