- 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 Feb 19, 2025@00:01:04 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 ;
