source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAORD3.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 5.6 KB
Line 
1RAORD3 ;HISC/CAH - AISC/RMO-Detailed Request Display Cont. ;01/20/05 11:55
2 ;;5.0;Radiology/Nuclear Medicine;**5,15,21,27,45,41,75**;Mar 16, 1998;Build 4
3 I $P(RADPT0,U,2)="F" D ;display pregnancy status for females ptch 45
4 .W !,"Pregnancy Status: ",?22,$S($P(RAORD0,"^",13)="y":"Patient is Pregnant",$P(RAORD0,"^",13)="n":"Patient not pregnant at time of order",1:"Unknown")
5 .Q
6 W:$P(RAORD0,"^",24)="y" !?12,"*** Universal Isolation Precautions ***" W:$D(RA("VDT")) !?8,$C(7),"** Note: Request Associated with Visit on ",RA("VDT")," **"
7 W:$D(RA("RDT"))&($D(RAPKG)) !,"Desired Date:",?22,RA("RDT") W:$D(RA("PDT")) !,"Pre-op Scheduled:",?22,RA("PDT") S RAOSTS=$P(RAORD0,"^",5) I RAOSTS=8,$D(RA("SDT")) W !,"Exam Scheduled:",?22,RA("SDT")
8 I RAOSTS=1 D USERCAN
9 W !,"Transport:",?22,RA("TRAN")
10 I $L(RA("STY_REA")) D DIWP^RAUTL5(1,68,"Reason for Study: "_RA("STY_REA")) ;P75
11 D ODX^RABWUTL(RAOIFN) ;display Ordering DX and Clin Inds, Billing Aware
12 I $O(^RAO(75.1,RAOIFN,"H",0)) D Q:$G(OREND)=1!($G(RAX)="^")
13 . D CHIST(RAOIFN)
14 . Q
15 I RAOSTS=1!(RAOSTS=3) W !,"Reason ",$S(RAOSTS=1:"Cancelled",1:"Held"),":",?22,$S($D(^RA(75.2,+$P(RAORD0,"^",10),0)):$E($P(^(0),"^"),1,50),$P(RAORD0,"^",27)]"":$E($P(RAORD0,"^",27),1,50),1:"UNKNOWN") D TEXT:RAOSTS=3
16 W:$D(RA("ST")) !,"Exam Status:",?22,RA("ST") W:$D(RA("ILC")) !,"Request Submitted to: ",RA("ILC")
17 G A:$P(RAORD0,"^",11)'="y",A:'$D(RADTI)!('$D(RACNI))
18 W !!?7,$C(7),"** Note: Request has been changed by the Imaging Service **"
19A I $D(^RAO(75.1,RAOIFN,"T")) D ASK:$E(IOST,1,2)="C-" I $D(DIRUT) S RAX="^" K DIRUT
20 Q:Y'=1 I $D(RAPKG),RAX'="^" R !!,"Press return to continue or ""^"" to escape ",X:DTIME S RAX=$E(X)
21 Q
22 ;
23ASK W ! S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you wish to display request status tracking log",DIR("?")="Enter 'YES' if status tracking log should be displayed, or 'NO' if not." D ^DIR K DIR S:$D(DIRUT) OREND=1 Q:$D(DIRUT)!(Y=0)
24 W !!?20,"*** Request Status Tracking Log ***",!,"Date/Time",?18,"Status",?31,"User",?44,"Reason",!,"-----------------",?18,"------------",?31,"-----------",?44,"------------------------------------"
25 F RALNB=0:0 S RALNB=$O(^RAO(75.1,RAOIFN,"T",RALNB)) Q:'RALNB I $D(^(RALNB,0)) S RATORD0=^(0) D PRTLOG
26Q K RALNB,RATORD0,RATODT,RATOST,RATREA,RATUSR Q
27 ;
28PRTLOG S (X,RATODT)=$P(RATORD0,"^") I X S RATODT=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3) I $P(X,".",2) D TIME^RAUTL1 S RATODT=RATODT_" "_X
29 S RATOST=$P($P(^DD(75.12,2,0),$P(RATORD0,"^",2)_":",2),";"),RATUSR=$S($D(^VA(200,+$P(RATORD0,"^",3),0)):$P(^(0),"^"),1:"")
30 S RATREA=$S($D(^RA(75.2,+$P(RATORD0,"^",4),0)):$P(^(0),"^"),1:"")
31 W !,RATODT,?18,$E(RATOST,1,12),?31,$E(RATUSR,1,11),?44,$E(RATREA,1,35) I $E(RATREA,36,70)'="" W !,?44,$E(RATREA,36,70)
32 Q
33TEXT ; display Hold Description text
34 Q:'$O(^RAO(75.1,RAOIFN,1,0))
35 W !,"Hold Description:",!
36 K ^UTILITY($J,"W"),^(1) S DIWL=22,DIWR=75,DIWF="W"
37 F RARR=0:0 S RARR=$O(^RAO(75.1,RAOIFN,1,RARR)) Q:RARR'>0 S X=^(RARR,0) D ^DIWP
38 D ^DIWW
39 Q
40CHIST(RAY) ; display Clinical History (if applicable)
41 Q:RAY'?1N.N Q:'$O(^RAO(75.1,RAY,"H",0))
42 N DIWF,DIWL,DIWR,RABAN,RARR,RAXIT
43 K ^UTILITY($J,"W") S DIWL=22,DIWR=75,DIWF="",RARR=0
44 F S RARR=$O(^RAO(75.1,RAY,"H",RARR)) Q:RARR'>0 D
45 . ; store into ^UTILITY($J,"W")
46 . S X=$G(^RAO(75.1,RAY,"H",RARR,0)) D ^DIWP
47 . Q
48 S (RARR,RAXIT)=0,RABAN="Clinical History: "
49 I $Y>(IOSL-4) D
50 . S RAXIT=$$EOS()
51 . I 'RAXIT,('$D(RAPKG)) W @IOF
52 . I 'RAXIT,($D(RAPKG)) D HDR^RAORD2
53 . Q
54 I RAXIT S:$D(RAPKG) RAX="^" K ^UTILITY($J,"W") Q
55 W !,RABAN
56 F S RARR=$O(^UTILITY($J,"W",DIWL,RARR)) Q:RARR'>0 D Q:RAXIT
57 . S X=$G(^UTILITY($J,"W",DIWL,RARR,0)) W ?22,X,!
58 . I $Y>(IOSL-4) D
59 .. S RAXIT=$$EOS()
60 .. I 'RAXIT,('$D(RAPKG)) W @IOF
61 .. I 'RAXIT,($D(RAPKG)) D HDR^RAORD2 W !
62 .. Q
63 . Q
64 S:RAXIT&($D(RAPKG)) RAX="^" K ^UTILITY($J,"W") ; kill global
65 Q
66EOS() ; End of screen check for both OE/RR & Rad/Nuc Med
67 ; Var List: $D(RAPKG) entry through Rad/Nuc Med, else through OE/RR
68 ; Passes back 'Y', Y=1 do not continue, Y=0 continue
69 ; NOTE: Sets OREND if code entered through OE/RR. This code may be
70 ; hit when the user accesses the 'Act On Existing Orders' through
71 ; OE/RR. 'Detailed Order Display' (8^RAORR) hits ENDIS^RAORD2
72 ; which mimics (hits same code) the Rad/Nuc Med 'Detailed Request
73 ; Display' option. The old PGBRK^ORUHDR code set OREND to 0
74 ; initially, (even though it is set to 0 upon entering this
75 ; sub-routine) and re-set it to 1 if the user enters an '^' at
76 ; the "Enter RETURN to continue or '^' to exit:" prompt.
77 S Y=$$EOS^RAUTL5() S:'$D(RAPKG) OREND=Y
78 Q Y
79USERCAN ;user who cancelled this request
80 Q:$P($G(^RAO(75.1,RAOIFN,0)),U,5)'=1 ;only look at 'discontinued'
81 N RA8,RA9 S RA8=0
82 F S RA8=$O(^RAO(75.1,RAOIFN,"T",RA8)) Q:'RA8 I $G(^(RA8,0))]"",$P(^(0),U,2)=1 S RA9=RA8 ; find latest ien of 'discontinued'
83 S RA("ODT")="",RA("USR")=""
84 I $G(RA9) D USERCAN1
85 E D USERCAN2
86 W !,"Cancelled:",?22,RA("ODT") W:RA("USR")]"" " by ",RA("USR")
87 K RA("ODT"),RA("USR")
88 Q
89USERCAN1 ;use request track times to get when and who cancelled
90 S X=$P(^RAO(75.1,RAOIFN,"T",RA9,0),U) D:X TRDT
91 S RA("USR")=$P($G(^VA(200,+$P(^RAO(75.1,RAOIFN,"T",RA9,0),U,3),0)),U)
92 Q
93USERCAN2 ;use vars DUZ and RAORD0 to get "who" and "when" cancelled
94 S X=$P($G(RAORD0),U,18) D:X TRDT
95 ; don't use duz if within any one of 3 rad request options
96 Q:$D(RASCREEN) Q:$D(RAOPT("ORDERPRINTS")) Q:$D(RAOPT("ORDERPRINTPAT"))
97 S RA("USR")=$P($G(^VA(200,$G(DUZ),0)),U)
98 Q
99TRDT S:$P(X,".",2) X=$P(X,".")_"."_$$NOSECNDS($P(X,".",2))
100 S RA("ODT")=$$FMTE^XLFDT(X,"1P")
101 Q
102NOSECNDS(X) ; If a timestamp is associated with a date, strip off seconds.
103 ; Input : X-timestamp (153048)
104 ; Output: (1530)
105 Q $E(X,1,4)
Note: See TracBrowser for help on using the repository browser.