RAORD3 ;HISC/CAH - AISC/RMO-Detailed Request Display Cont. ; 06 Oct 2013 11:04 AM
;;5.0;Radiology/Nuclear Medicine;**5,15,21,27,45,41,75,99,1005**;Mar 16, 1998;Build 13
;Supported IA #2056 reference to ^DIQ
;Supported IA #10103 reference to ^XLFDT
;
;IHS/BJI/DAY - Patch 1005 - Gender Fix
;I $$PTSEX^RAUTL8(RADFN)="F" D ;display pregnancy status for females ptch 45, P#99 changed Pregnancy title.'Pregnancy Screen:' field. This field shall be a display-only field
I $$PTSEX^RAUTL8(RADFN)'="M" D
.;
.W !,"Pregnant at time of order entry: ",?22,$S($P(RAORD0,"^",13)="y":"YES",$P(RAORD0,"^",13)="n":"NO",1:"UNKNOWN")
.N RA700332,RA700380
.S RA700332=$$GET1^DIQ(70.03,$G(RACNI)_","_$G(RADTI)_","_$G(RADFN),32)
.S RA700380=$$GET1^DIQ(70.03,$G(RACNI)_","_$G(RADTI)_","_$G(RADFN),80)
.I RA700332'="" W !,"Pregnancy Screen: ",RA700332
.I RA700380'="" W !,"Pregnancy Screen Comment: ",RA700380
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)
RAORD3 ;HISC/CAH - AISC/RMO-Detailed Request Display Cont. ; 06 Oct 2013 11:04 AM
+1 ;;5.0;Radiology/Nuclear Medicine;**5,15,21,27,45,41,75,99,1005**;Mar 16, 1998;Build 13
+2 ;Supported IA #2056 reference to ^DIQ
+3 ;Supported IA #10103 reference to ^XLFDT
+4 ;
+5 ;IHS/BJI/DAY - Patch 1005 - Gender Fix
+6 ;I $$PTSEX^RAUTL8(RADFN)="F" D ;display pregnancy status for females ptch 45, P#99 changed Pregnancy title.'Pregnancy Screen:' field. This field shall be a display-only field
+7 IF $$PTSEX^RAUTL8(RADFN)'="M"
Begin DoDot:1
+8 ;
+9 WRITE !,"Pregnant at time of order entry: ",?22,$SELECT($PIECE(RAORD0,"^",13)="y":"YES",$PIECE(RAORD0,"^",13)="n":"NO",1:"UNKNOWN")
+10 NEW RA700332,RA700380
+11 SET RA700332=$$GET1^DIQ(70.03,$GET(RACNI)_","_$GET(RADTI)_","_$GET(RADFN),32)
+12 SET RA700380=$$GET1^DIQ(70.03,$GET(RACNI)_","_$GET(RADTI)_","_$GET(RADFN),80)
+13 IF RA700332'=""
WRITE !,"Pregnancy Screen: ",RA700332
+14 IF RA700380'=""
WRITE !,"Pregnancy Screen Comment: ",RA700380
End DoDot:1
+15 IF $PIECE(RAORD0,"^",24)="y"
WRITE !?12,"*** Universal Isolation Precautions ***"
IF $DATA(RA("VDT"))
WRITE !?8,$CHAR(7),"** Note: Request Associated with Visit on ",RA("VDT")," **"
+16 IF $DATA(RA("RDT"))&($DATA(RAPKG))
WRITE !,"Desired Date:",?22,RA("RDT")
IF $DATA(RA("PDT"))
WRITE !,"Pre-op Scheduled:",?22,RA("PDT")
SET RAOSTS=$PIECE(RAORD0,"^",5)
IF RAOSTS=8
IF $DATA(RA("SDT"))
WRITE !,"Exam Scheduled:",?22,RA("SDT")
+17 IF RAOSTS=1
DO USERCAN
+18 WRITE !,"Transport:",?22,RA("TRAN")
+19 ;P75
IF $LENGTH(RA("STY_REA"))
DO DIWP^RAUTL5(1,68,"Reason for Study: "_RA("STY_REA"))
+20 ;display Ordering DX and Clin Inds, Billing Aware
DO ODX^RABWUTL(RAOIFN)
+21 IF $ORDER(^RAO(75.1,RAOIFN,"H",0))
Begin DoDot:1
+22 DO CHIST(RAOIFN)
+23 QUIT
End DoDot:1
IF $GET(OREND)=1!($GET(RAX)="^")
QUIT
+24 IF RAOSTS=1!(RAOSTS=3)
WRITE !,"Reason ",$SELECT(RAOSTS=1:"Cancelled",1:"Held"),":",?22,$SELECT($DATA(^RA(75.2,+$PIECE(RAORD0,"^",10),0)):$EXTRACT($PIECE(^(0),"^"),1,50),$PIECE(RAORD0,"^",27)]"":$EXTRACT($PIECE(RAORD0,"^",27),1,50),1:"UNKNOWN")
IF RAOSTS=3
DO TEXT
+25 IF $DATA(RA("ST"))
WRITE !,"Exam Status:",?22,RA("ST")
IF $DATA(RA("ILC"))
WRITE !,"Request Submitted to: ",RA("ILC")
+26 IF $PIECE(RAORD0,"^",11)'="y"
GOTO A
IF '$DATA(RADTI)!('$DATA(RACNI))
GOTO A
+27 WRITE !!?7,$CHAR(7),"** Note: Request has been changed by the Imaging Service **"
A IF $DATA(^RAO(75.1,RAOIFN,"T"))
IF $EXTRACT(IOST,1,2)="C-"
DO ASK
IF $DATA(DIRUT)
SET RAX="^"
KILL DIRUT
+1 IF Y'=1
QUIT
IF $DATA(RAPKG)
IF RAX'="^"
READ !!,"Press return to continue or ""^"" to escape ",X:DTIME
SET RAX=$EXTRACT(X)
+2 QUIT
+3 ;
ASK WRITE !
SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Do you wish to display request status tracking log"
SET DIR("?")="Enter 'YES' if status tracking log should be displayed, or 'NO' if not."
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET OREND=1
IF $DATA(DIRUT)!(Y=0)
QUIT
+1 WRITE !!?20,"*** Request Status Tracking Log ***",!,"Date/Time",?18,"Status",?31,"User",?44,"Reason",!,"-----------------",?18,"------------",?31,"-----------",?44,"------------------------------------"
+2 FOR RALNB=0:0
SET RALNB=$ORDER(^RAO(75.1,RAOIFN,"T",RALNB))
IF 'RALNB
QUIT
IF $DATA(^(RALNB,0))
SET RATORD0=^(0)
DO PRTLOG
Q KILL RALNB,RATORD0,RATODT,RATOST,RATREA,RATUSR
QUIT
+1 ;
PRTLOG SET (X,RATODT)=$PIECE(RATORD0,"^")
IF X
SET RATODT=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
IF $PIECE(X,".",2)
DO TIME^RAUTL1
SET RATODT=RATODT_" "_X
+1 SET RATOST=$PIECE($PIECE(^DD(75.12,2,0),$PIECE(RATORD0,"^",2)_":",2),";")
SET RATUSR=$SELECT($DATA(^VA(200,+$PIECE(RATORD0,"^",3),0)):$PIECE(^(0),"^"),1:"")
+2 SET RATREA=$SELECT($DATA(^RA(75.2,+$PIECE(RATORD0,"^",4),0)):$PIECE(^(0),"^"),1:"")
+3 WRITE !,RATODT,?18,$EXTRACT(RATOST,1,12),?31,$EXTRACT(RATUSR,1,11),?44,$EXTRACT(RATREA,1,35)
IF $EXTRACT(RATREA,36,70)'=""
WRITE !,?44,$EXTRACT(RATREA,36,70)
+4 QUIT
TEXT ; display Hold Description text
+1 IF '$ORDER(^RAO(75.1,RAOIFN,1,0))
QUIT
+2 WRITE !,"Hold Description:",!
+3 KILL ^UTILITY($JOB,"W"),^(1)
SET DIWL=22
SET DIWR=75
SET DIWF="W"
+4 FOR RARR=0:0
SET RARR=$ORDER(^RAO(75.1,RAOIFN,1,RARR))
IF RARR'>0
QUIT
SET X=^(RARR,0)
DO ^DIWP
+5 DO ^DIWW
+6 QUIT
CHIST(RAY) ; display Clinical History (if applicable)
+1 IF RAY'?1N.N
QUIT
IF '$ORDER(^RAO(75.1,RAY,"H",0))
QUIT
+2 NEW DIWF,DIWL,DIWR,RABAN,RARR,RAXIT
+3 KILL ^UTILITY($JOB,"W")
SET DIWL=22
SET DIWR=75
SET DIWF=""
SET RARR=0
+4 FOR
SET RARR=$ORDER(^RAO(75.1,RAY,"H",RARR))
IF RARR'>0
QUIT
Begin DoDot:1
+5 ; store into ^UTILITY($J,"W")
+6 SET X=$GET(^RAO(75.1,RAY,"H",RARR,0))
DO ^DIWP
+7 QUIT
End DoDot:1
+8 SET (RARR,RAXIT)=0
SET RABAN="Clinical History: "
+9 IF $Y>(IOSL-4)
Begin DoDot:1
+10 SET RAXIT=$$EOS()
+11 IF 'RAXIT
IF ('$DATA(RAPKG))
WRITE @IOF
+12 IF 'RAXIT
IF ($DATA(RAPKG))
DO HDR^RAORD2
+13 QUIT
End DoDot:1
+14 IF RAXIT
IF $DATA(RAPKG)
SET RAX="^"
KILL ^UTILITY($JOB,"W")
QUIT
+15 WRITE !,RABAN
+16 FOR
SET RARR=$ORDER(^UTILITY($JOB,"W",DIWL,RARR))
IF RARR'>0
QUIT
Begin DoDot:1
+17 SET X=$GET(^UTILITY($JOB,"W",DIWL,RARR,0))
WRITE ?22,X,!
+18 IF $Y>(IOSL-4)
Begin DoDot:2
+19 SET RAXIT=$$EOS()
+20 IF 'RAXIT
IF ('$DATA(RAPKG))
WRITE @IOF
+21 IF 'RAXIT
IF ($DATA(RAPKG))
DO HDR^RAORD2
WRITE !
+22 QUIT
End DoDot:2
+23 QUIT
End DoDot:1
IF RAXIT
QUIT
+24 ; kill global
IF RAXIT&($DATA(RAPKG))
SET RAX="^"
KILL ^UTILITY($JOB,"W")
+25 QUIT
EOS() ; End of screen check for both OE/RR & Rad/Nuc Med
+1 ; Var List: $D(RAPKG) entry through Rad/Nuc Med, else through OE/RR
+2 ; Passes back 'Y', Y=1 do not continue, Y=0 continue
+3 ; NOTE: Sets OREND if code entered through OE/RR. This code may be
+4 ; hit when the user accesses the 'Act On Existing Orders' through
+5 ; OE/RR. 'Detailed Order Display' (8^RAORR) hits ENDIS^RAORD2
+6 ; which mimics (hits same code) the Rad/Nuc Med 'Detailed Request
+7 ; Display' option. The old PGBRK^ORUHDR code set OREND to 0
+8 ; initially, (even though it is set to 0 upon entering this
+9 ; sub-routine) and re-set it to 1 if the user enters an '^' at
+10 ; the "Enter RETURN to continue or '^' to exit:" prompt.
+11 SET Y=$$EOS^RAUTL5()
IF '$DATA(RAPKG)
SET OREND=Y
+12 QUIT Y
USERCAN ;user who cancelled this request
+1 ;only look at 'discontinued'
IF $PIECE($GET(^RAO(75.1,RAOIFN,0)),U,5)'=1
QUIT
+2 NEW RA8,RA9
SET RA8=0
+3 ; find latest ien of 'discontinued'
FOR
SET RA8=$ORDER(^RAO(75.1,RAOIFN,"T",RA8))
IF 'RA8
QUIT
IF $GET(^(RA8,0))]""
IF $PIECE(^(0),U,2)=1
SET RA9=RA8
+4 SET RA("ODT")=""
SET RA("USR")=""
+5 IF $GET(RA9)
DO USERCAN1
+6 IF '$TEST
DO USERCAN2
+7 WRITE !,"Cancelled:",?22,RA("ODT")
IF RA("USR")]""
WRITE " by ",RA("USR")
+8 KILL RA("ODT"),RA("USR")
+9 QUIT
USERCAN1 ;use request track times to get when and who cancelled
+1 SET X=$PIECE(^RAO(75.1,RAOIFN,"T",RA9,0),U)
IF X
DO TRDT
+2 SET RA("USR")=$PIECE($GET(^VA(200,+$PIECE(^RAO(75.1,RAOIFN,"T",RA9,0),U,3),0)),U)
+3 QUIT
USERCAN2 ;use vars DUZ and RAORD0 to get "who" and "when" cancelled
+1 SET X=$PIECE($GET(RAORD0),U,18)
IF X
DO TRDT
+2 ; don't use duz if within any one of 3 rad request options
+3 IF $DATA(RASCREEN)
QUIT
IF $DATA(RAOPT("ORDERPRINTS"))
QUIT
IF $DATA(RAOPT("ORDERPRINTPAT"))
QUIT
+4 SET RA("USR")=$PIECE($GET(^VA(200,$GET(DUZ),0)),U)
+5 QUIT
TRDT IF $PIECE(X,".",2)
SET X=$PIECE(X,".")_"."_$$NOSECNDS($PIECE(X,".",2))
+1 SET RA("ODT")=$$FMTE^XLFDT(X,"1P")
+2 QUIT
NOSECNDS(X) ; If a timestamp is associated with a date, strip off seconds.
+1 ; Input : X-timestamp (153048)
+2 ; Output: (1530)
+3 QUIT $EXTRACT(X,1,4)
