RTRAD ;MJK/TROY ISC;Radiology Specific Setup Menu; ; 4/9/87 12:39 PM ;
;;v 2.0;Record Tracking;;10/22/91
D DT^DICRW S X=$T(+1),DIK="^DOPT("""_$P(X," ;",1)_""","
G:$D(^DOPT($P(X," ;"),3)) A S ^DOPT($P(X," ;"),0)=$P(X,";",3)_"^1N^" F I=1:1 S Y=$T(@I) Q:Y="" S ^DOPT($P(X," ;"),I,0)=$P(Y,";",3,99)
D IXALL^DIK
A S X="RAD" D ^RTPSET Q:$D(XQUIT)
W !! S DIC="^DOPT("""_$P($T(+1)," ;")_""",",DIC(0)="IQEAM" D ^DIC Q:Y<0 D @+Y G A
;
1 ;;Clinic Set-up
G 1^RTMAS
;
2 ;;Imaging Area Set-up
L2 D RA G Q:"^"[X D BOR^RTSYS:Y>0 G L2
Q K DA,D0,DR,DIE,RTBO,X,Y,I Q
RA W ! S DIC="^SC(",DIC("A")="Select Reception/Viewing/Rack Area: ",DIC(0)="IAEMLQ",DIC("DR")="2///I",DIC("S")="I $P(^(0),U,3)=""I""" D ^DIC K DIC Q:Y<0 D CHK^RTDPA3
Q
;
3 ;;Create a Temporary Folder
Q
;DO NOT USE --- POSSIBLE FUTURE OPTION
W ! S RTRD(1)="Wet Reading^create a wet reading folder",RTRD(2)="Exam^create an temporary exam folder",RTRD(3)="Outside^create an outside film folder",RTRD("B")=1,RTRD("A")="What kind of temporary folder you want to create? "
D SET^RTRD K RTRD S X=$E(X) G Q3:X="^" S RTPCE=$S(X="W":"3^WET",X="E":"4^TEMPORARY",1:"5^OUTSIDE")
I $S('$D(^DIC(195.4,1,"RAD")):1,'$D(^DIC(195.2,+$P(^("RAD"),"^",RTPCE),0)):1,1:0) W !!,*7,"'",$P(RTPCE,"^",2),"' folder is not defined in overall system parameter file." G Q3
S Y=+$P(^DIC(195.4,1,"RAD"),"^",+RTPCE) I $S('$D(^DIC(195.2,Y,"I")):0,'^("I"):0,DT'>^("I"):0,1:1) W !!,*7,"The '",$P(^DIC(195.2,Y,0),"^"),"' record type is inactive." G Q3
D TYPE1^RTUTL,^RTDPA1
Q3 K RTPCE,RTTY Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTRAD 1553 printed Dec 13, 2024@02:34:33 Page 2
RTRAD ;MJK/TROY ISC;Radiology Specific Setup Menu; ; 4/9/87 12:39 PM ;
+1 ;;v 2.0;Record Tracking;;10/22/91
+2 DO DT^DICRW
SET X=$TEXT(+1)
SET DIK="^DOPT("""_$PIECE(X," ;",1)_""","
+3 if $DATA(^DOPT($PIECE(X," ;"),3))
GOTO A
SET ^DOPT($PIECE(X," ;"),0)=$PIECE(X,";",3)_"^1N^"
FOR I=1:1
SET Y=$TEXT(@I)
if Y=""
QUIT
SET ^DOPT($PIECE(X," ;"),I,0)=$PIECE(Y,";",3,99)
+4 DO IXALL^DIK
A SET X="RAD"
DO ^RTPSET
if $DATA(XQUIT)
QUIT
+1 WRITE !!
SET DIC="^DOPT("""_$PIECE($TEXT(+1)," ;")_""","
SET DIC(0)="IQEAM"
DO ^DIC
if Y<0
QUIT
DO @+Y
GOTO A
+2 ;
1 ;;Clinic Set-up
+1 GOTO 1^RTMAS
+2 ;
2 ;;Imaging Area Set-up
L2 DO RA
if "^"[X
GOTO Q
if Y>0
DO BOR^RTSYS
GOTO L2
Q KILL DA,D0,DR,DIE,RTBO,X,Y,I
QUIT
RA WRITE !
SET DIC="^SC("
SET DIC("A")="Select Reception/Viewing/Rack Area: "
SET DIC(0)="IAEMLQ"
SET DIC("DR")="2///I"
SET DIC("S")="I $P(^(0),U,3)=""I"""
DO ^DIC
KILL DIC
if Y<0
QUIT
DO CHK^RTDPA3
+1 QUIT
+2 ;
3 ;;Create a Temporary Folder
+1 QUIT
+2 ;DO NOT USE --- POSSIBLE FUTURE OPTION
+3 WRITE !
SET RTRD(1)="Wet Reading^create a wet reading folder"
SET RTRD(2)="Exam^create an temporary exam folder"
SET RTRD(3)="Outside^create an outside film folder"
SET RTRD("B")=1
SET RTRD("A")="What kind of temporary folder you want to create? "
+4 DO SET^RTRD
KILL RTRD
SET X=$EXTRACT(X)
if X="^"
GOTO Q3
SET RTPCE=$SELECT(X="W":"3^WET",X="E":"4^TEMPORARY",1:"5^OUTSIDE")
+5 IF $SELECT('$DATA(^DIC(195.4,1,"RAD")):1,'$DATA(^DIC(195.2,+$PIECE(^("RAD"),"^",RTPCE),0)):1,1:0)
WRITE !!,*7,"'",$PIECE(RTPCE,"^",2),"' folder is not defined in overall system parameter file."
GOTO Q3
+6 SET Y=+$PIECE(^DIC(195.4,1,"RAD"),"^",+RTPCE)
IF $SELECT('$DATA(^DIC(195.2,Y,"I")):0,'^("I"):0,DT'>^("I"):0,1:1)
WRITE !!,*7,"The '",$PIECE(^DIC(195.2,Y,0),"^"),"' record type is inactive."
GOTO Q3
+7 DO TYPE1^RTUTL
DO ^RTDPA1
Q3 KILL RTPCE,RTTY
QUIT
+1 ;
