RTRAD.m

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 ---RTRAD   1553     printed  Sep 02, 2024@19:19:55                                                                                                                                                                                                       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       ;