RTPSET1 ;MJK/TROY ISC;Sign-on Parameter Routine; ; 5/26/87 4:13 PM ;
;;2.0;Record Tracking;**16,46**;10/22/91 ;Build 46
FR ;entry point will return RTFR ; RTAPL must be defined ; RTTY is optional
I '($D(DUZ)#2) W !!?5,*7,"User's 'DUZ' is not defined." Q
S %ZIS="L",IOP="HOME" D ^%ZIS K %ZIS,IOP,RTFR S DIC("V")="I $P(Y(0),U,4)=""L"""
S IONSAV=ION I $D(IO("ZIO")),IO("ZIO")'=IO(0) S ION=IO("ZIO")
S DIC("S")="S Z0=^(0) I $P(Z0,U,3)="_+RTAPL_",$P(Z0,U,13)=""F"",$D(^SC(+$P(Z0,U,2),0)),$D(^DIC(195.1,"_+RTAPL_",""INST"",+$P(^(0),U,4),0)),$S('$D(RTTY):1,$D(^DIC(195.2,""AF"",Y,+RTTY)):1,1:0) D DICS^RTDPA31"
I $D(RTSYS),$P(RTSYS,"^",4)="n",$D(^RTV(195.9,"ADEV",ION)) S Y=+$O(^(ION,0)) I $D(^RTV(195.9,Y,0)) X DIC("S") I $T S RTFR=Y_"^"_$P(^RTV(195.9,Y,0),"^",2,99) G FRQ
;RT*2.0*46 Requires User to enter a valid file room or "^" to exit
D:$D(DUZ(2)) DEF
F S DIC(0)="IAMEQZ",DIC="^RTV(195.9,",DIC("A")="Select Record Tracking File Room: " D ^DIC S:Y>0 RTFR=+Y_"^"_$P(Y(0),"^",2,99) Q:Y>0!($D(DUOUT)) W !,"Enter a Valid File Room or '^' to Exit",!
K:$D(DUOUT) RTAPL,RTSYS
FRQ I $D(RTSYS),$P(RTSYS,"^",4)="e",$D(RTFR) S $P(RTFR,"^",4,6)="^^"
I $D(RTFR),$S('$D(^RTV(195.9,"ADEV",ION)):1,1:+RTFR'=$O(^(ION,0))),$P(RTFR,"^",4,6)'="^^" D ASK S:"N^"[$E(X) $P(RTFR,"^",4,6)="^^"
S ION=IONSAV K IONSAV,DIC Q
;
DEF Q:'$D(^DIC(195.1,+RTAPL,"INST",+DUZ(2),0)) S Y=+$P(^(0),"^",2) I $D(^RTV(195.9,Y,0)),$P(^(0),"^")["SC(",$D(^SC(+^(0),0)) S DIC("B")=$S('+$P(^(0),"^"):$P(^(0),"^"),1:$P(^RTV(195.9,Y,0),"^"))
Q
;
PGM ;Entry point to run a record tracking program for a specific application
; RTAPPL = <application name or synonym> [ex. MAS]
; RTPGM = <program to be executed> [ex. 1^RTQ]
;
S IOP="" D ^%ZIS K IOP I $D(RTAPL) S X=RTAPPL D SAVE,APL^RTPSET D:$D(RTAPL) @RTPGM D RESTORE Q
S X=RTAPPL D APL^RTPSET D:$D(RTAPL) @RTPGM K RTAPL,RTSYS Q
;
MAS ;Entry point to run a RT program for 'MAS' application / RTPGM defined
S RTAPPL="MAS" D PGM K RTAPPL,RTPGM Q
;
RAD ;Entry point to run a RT program for 'FILM TRACKING' application / RTPGM defined
S RTAPPL="RAD" D PGM K RTAPPL,RTPGM,RTD,J Q
;
SAVE K RTNEW F I="RTAPL","RTSYS","RTFR","RTDIV" I $D(@I) S RTNEW(I)=@I
Q
;
RESTORE F I="RTAPL","RTSYS","RTFR","RTDIV" I $D(RTNEW(I)) S @I=RTNEW(I)
K RTNEW Q
;
ASK S RTRD(1)="Yes^use default devices",RTRD(2)="No^do not use default devices",RTRD("B")=1,RTRD("A")="Do you want to use the file room's default devices? ",RTRD(0)="S" D SET^RTRD K RTRD Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTPSET1 2512 printed Apr 09, 2024@21:38:13 Page 2
RTPSET1 ;MJK/TROY ISC;Sign-on Parameter Routine; ; 5/26/87 4:13 PM ;
+1 ;;2.0;Record Tracking;**16,46**;10/22/91 ;Build 46
FR ;entry point will return RTFR ; RTAPL must be defined ; RTTY is optional
+1 IF '($DATA(DUZ)#2)
WRITE !!?5,*7,"User's 'DUZ' is not defined."
QUIT
+2 SET %ZIS="L"
SET IOP="HOME"
DO ^%ZIS
KILL %ZIS,IOP,RTFR
SET DIC("V")="I $P(Y(0),U,4)=""L"""
+3 SET IONSAV=ION
IF $DATA(IO("ZIO"))
IF IO("ZIO")'=IO(0)
SET ION=IO("ZIO")
+4 SET DIC("S")="S Z0=^(0) I $P(Z0,U,3)="_+RTAPL_",$P(Z0,U,13)=""F"",$D(^SC(+$P(Z0,U,2),0)),$D(^DIC(195.1,"_+RTAPL_",""INST"",+$P(^(0),U,4),0)),$S('$D(RTTY):1,$D(^DIC(195.2,""AF"",Y,+RTTY)):1,1:0) D DICS^RTDPA31"
+5 IF $DATA(RTSYS)
IF $PIECE(RTSYS,"^",4)="n"
IF $DATA(^RTV(195.9,"ADEV",ION))
SET Y=+$ORDER(^(ION,0))
IF $DATA(^RTV(195.9,Y,0))
XECUTE DIC("S")
IF $TEST
SET RTFR=Y_"^"_$PIECE(^RTV(195.9,Y,0),"^",2,99)
GOTO FRQ
+6 ;RT*2.0*46 Requires User to enter a valid file room or "^" to exit
+7 if $DATA(DUZ(2))
DO DEF
+8 FOR
SET DIC(0)="IAMEQZ"
SET DIC="^RTV(195.9,"
SET DIC("A")="Select Record Tracking File Room: "
DO ^DIC
if Y>0
SET RTFR=+Y_"^"_$PIECE(Y(0),"^",2,99)
if Y>0!($DATA(DUOUT))
QUIT
WRITE !,"Enter a Valid File Room or '^' to Exit",!
+9 if $DATA(DUOUT)
KILL RTAPL,RTSYS
FRQ IF $DATA(RTSYS)
IF $PIECE(RTSYS,"^",4)="e"
IF $DATA(RTFR)
SET $PIECE(RTFR,"^",4,6)="^^"
+1 IF $DATA(RTFR)
IF $SELECT('$DATA(^RTV(195.9,"ADEV",ION)):1,1:+RTFR'=$ORDER(^(ION,0)))
IF $PIECE(RTFR,"^",4,6)'="^^"
DO ASK
if "N^"[$EXTRACT(X)
SET $PIECE(RTFR,"^",4,6)="^^"
+2 SET ION=IONSAV
KILL IONSAV,DIC
QUIT
+3 ;
DEF if '$DATA(^DIC(195.1,+RTAPL,"INST",+DUZ(2),0))
QUIT
SET Y=+$PIECE(^(0),"^",2)
IF $DATA(^RTV(195.9,Y,0))
IF $PIECE(^(0),"^")["SC("
IF $DATA(^SC(+^(0),0))
SET DIC("B")=$SELECT('+$PIECE(^(0),"^"):$PIECE(^(0),"^"),1:$PIECE(^RTV(195.9,Y,0),"^"))
+1 QUIT
+2 ;
PGM ;Entry point to run a record tracking program for a specific application
+1 ; RTAPPL = <application name or synonym> [ex. MAS]
+2 ; RTPGM = <program to be executed> [ex. 1^RTQ]
+3 ;
+4 SET IOP=""
DO ^%ZIS
KILL IOP
IF $DATA(RTAPL)
SET X=RTAPPL
DO SAVE
DO APL^RTPSET
if $DATA(RTAPL)
DO @RTPGM
DO RESTORE
QUIT
+5 SET X=RTAPPL
DO APL^RTPSET
if $DATA(RTAPL)
DO @RTPGM
KILL RTAPL,RTSYS
QUIT
+6 ;
MAS ;Entry point to run a RT program for 'MAS' application / RTPGM defined
+1 SET RTAPPL="MAS"
DO PGM
KILL RTAPPL,RTPGM
QUIT
+2 ;
RAD ;Entry point to run a RT program for 'FILM TRACKING' application / RTPGM defined
+1 SET RTAPPL="RAD"
DO PGM
KILL RTAPPL,RTPGM,RTD,J
QUIT
+2 ;
SAVE KILL RTNEW
FOR I="RTAPL","RTSYS","RTFR","RTDIV"
IF $DATA(@I)
SET RTNEW(I)=@I
+1 QUIT
+2 ;
RESTORE FOR I="RTAPL","RTSYS","RTFR","RTDIV"
IF $DATA(RTNEW(I))
SET @I=RTNEW(I)
+1 KILL RTNEW
QUIT
+2 ;
ASK SET RTRD(1)="Yes^use default devices"
SET RTRD(2)="No^do not use default devices"
SET RTRD("B")=1
SET RTRD("A")="Do you want to use the file room's default devices? "
SET RTRD(0)="S"
DO SET^RTRD
KILL RTRD
QUIT
