106 lines
5.6 KiB
Mathematica
106 lines
5.6 KiB
Mathematica
RAORD3 ;HISC/CAH - AISC/RMO-Detailed Request Display Cont. ;01/20/05 11:55
|
|
;;5.0;Radiology/Nuclear Medicine;**5,15,21,27,45,41,75**;Mar 16, 1998;Build 4
|
|
I $P(RADPT0,U,2)="F" D ;display pregnancy status for females ptch 45
|
|
.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")
|
|
.Q
|
|
W:$P(RAORD0,"^",24)="y" !?12,"*** Universal Isolation Precautions ***" W:$D(RA("VDT")) !?8,$C(7),"** Note: Request Associated with Visit on ",RA("VDT")," **"
|
|
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")
|
|
I RAOSTS=1 D USERCAN
|
|
W !,"Transport:",?22,RA("TRAN")
|
|
I $L(RA("STY_REA")) D DIWP^RAUTL5(1,68,"Reason for Study: "_RA("STY_REA")) ;P75
|
|
D ODX^RABWUTL(RAOIFN) ;display Ordering DX and Clin Inds, Billing Aware
|
|
I $O(^RAO(75.1,RAOIFN,"H",0)) D Q:$G(OREND)=1!($G(RAX)="^")
|
|
. D CHIST(RAOIFN)
|
|
. Q
|
|
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
|
|
W:$D(RA("ST")) !,"Exam Status:",?22,RA("ST") W:$D(RA("ILC")) !,"Request Submitted to: ",RA("ILC")
|
|
G A:$P(RAORD0,"^",11)'="y",A:'$D(RADTI)!('$D(RACNI))
|
|
W !!?7,$C(7),"** Note: Request has been changed by the Imaging Service **"
|
|
A I $D(^RAO(75.1,RAOIFN,"T")) D ASK:$E(IOST,1,2)="C-" I $D(DIRUT) S RAX="^" K DIRUT
|
|
Q:Y'=1 I $D(RAPKG),RAX'="^" R !!,"Press return to continue or ""^"" to escape ",X:DTIME S RAX=$E(X)
|
|
Q
|
|
;
|
|
ASK 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)
|
|
W !!?20,"*** Request Status Tracking Log ***",!,"Date/Time",?18,"Status",?31,"User",?44,"Reason",!,"-----------------",?18,"------------",?31,"-----------",?44,"------------------------------------"
|
|
F RALNB=0:0 S RALNB=$O(^RAO(75.1,RAOIFN,"T",RALNB)) Q:'RALNB I $D(^(RALNB,0)) S RATORD0=^(0) D PRTLOG
|
|
Q K RALNB,RATORD0,RATODT,RATOST,RATREA,RATUSR Q
|
|
;
|
|
PRTLOG 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
|
|
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:"")
|
|
S RATREA=$S($D(^RA(75.2,+$P(RATORD0,"^",4),0)):$P(^(0),"^"),1:"")
|
|
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)
|
|
Q
|
|
TEXT ; display Hold Description text
|
|
Q:'$O(^RAO(75.1,RAOIFN,1,0))
|
|
W !,"Hold Description:",!
|
|
K ^UTILITY($J,"W"),^(1) S DIWL=22,DIWR=75,DIWF="W"
|
|
F RARR=0:0 S RARR=$O(^RAO(75.1,RAOIFN,1,RARR)) Q:RARR'>0 S X=^(RARR,0) D ^DIWP
|
|
D ^DIWW
|
|
Q
|
|
CHIST(RAY) ; display Clinical History (if applicable)
|
|
Q:RAY'?1N.N Q:'$O(^RAO(75.1,RAY,"H",0))
|
|
N DIWF,DIWL,DIWR,RABAN,RARR,RAXIT
|
|
K ^UTILITY($J,"W") S DIWL=22,DIWR=75,DIWF="",RARR=0
|
|
F S RARR=$O(^RAO(75.1,RAY,"H",RARR)) Q:RARR'>0 D
|
|
. ; store into ^UTILITY($J,"W")
|
|
. S X=$G(^RAO(75.1,RAY,"H",RARR,0)) D ^DIWP
|
|
. Q
|
|
S (RARR,RAXIT)=0,RABAN="Clinical History: "
|
|
I $Y>(IOSL-4) D
|
|
. S RAXIT=$$EOS()
|
|
. I 'RAXIT,('$D(RAPKG)) W @IOF
|
|
. I 'RAXIT,($D(RAPKG)) D HDR^RAORD2
|
|
. Q
|
|
I RAXIT S:$D(RAPKG) RAX="^" K ^UTILITY($J,"W") Q
|
|
W !,RABAN
|
|
F S RARR=$O(^UTILITY($J,"W",DIWL,RARR)) Q:RARR'>0 D Q:RAXIT
|
|
. S X=$G(^UTILITY($J,"W",DIWL,RARR,0)) W ?22,X,!
|
|
. I $Y>(IOSL-4) D
|
|
.. S RAXIT=$$EOS()
|
|
.. I 'RAXIT,('$D(RAPKG)) W @IOF
|
|
.. I 'RAXIT,($D(RAPKG)) D HDR^RAORD2 W !
|
|
.. Q
|
|
. Q
|
|
S:RAXIT&($D(RAPKG)) RAX="^" K ^UTILITY($J,"W") ; kill global
|
|
Q
|
|
EOS() ; End of screen check for both OE/RR & Rad/Nuc Med
|
|
; Var List: $D(RAPKG) entry through Rad/Nuc Med, else through OE/RR
|
|
; Passes back 'Y', Y=1 do not continue, Y=0 continue
|
|
; NOTE: Sets OREND if code entered through OE/RR. This code may be
|
|
; hit when the user accesses the 'Act On Existing Orders' through
|
|
; OE/RR. 'Detailed Order Display' (8^RAORR) hits ENDIS^RAORD2
|
|
; which mimics (hits same code) the Rad/Nuc Med 'Detailed Request
|
|
; Display' option. The old PGBRK^ORUHDR code set OREND to 0
|
|
; initially, (even though it is set to 0 upon entering this
|
|
; sub-routine) and re-set it to 1 if the user enters an '^' at
|
|
; the "Enter RETURN to continue or '^' to exit:" prompt.
|
|
S Y=$$EOS^RAUTL5() S:'$D(RAPKG) OREND=Y
|
|
Q Y
|
|
USERCAN ;user who cancelled this request
|
|
Q:$P($G(^RAO(75.1,RAOIFN,0)),U,5)'=1 ;only look at 'discontinued'
|
|
N RA8,RA9 S RA8=0
|
|
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'
|
|
S RA("ODT")="",RA("USR")=""
|
|
I $G(RA9) D USERCAN1
|
|
E D USERCAN2
|
|
W !,"Cancelled:",?22,RA("ODT") W:RA("USR")]"" " by ",RA("USR")
|
|
K RA("ODT"),RA("USR")
|
|
Q
|
|
USERCAN1 ;use request track times to get when and who cancelled
|
|
S X=$P(^RAO(75.1,RAOIFN,"T",RA9,0),U) D:X TRDT
|
|
S RA("USR")=$P($G(^VA(200,+$P(^RAO(75.1,RAOIFN,"T",RA9,0),U,3),0)),U)
|
|
Q
|
|
USERCAN2 ;use vars DUZ and RAORD0 to get "who" and "when" cancelled
|
|
S X=$P($G(RAORD0),U,18) D:X TRDT
|
|
; don't use duz if within any one of 3 rad request options
|
|
Q:$D(RASCREEN) Q:$D(RAOPT("ORDERPRINTS")) Q:$D(RAOPT("ORDERPRINTPAT"))
|
|
S RA("USR")=$P($G(^VA(200,$G(DUZ),0)),U)
|
|
Q
|
|
TRDT S:$P(X,".",2) X=$P(X,".")_"."_$$NOSECNDS($P(X,".",2))
|
|
S RA("ODT")=$$FMTE^XLFDT(X,"1P")
|
|
Q
|
|
NOSECNDS(X) ; If a timestamp is associated with a date, strip off seconds.
|
|
; Input : X-timestamp (153048)
|
|
; Output: (1530)
|
|
Q $E(X,1,4)
|