| [613] | 1 | RTPSET1 ;MJK/TROY ISC;Sign-on Parameter Routine; ; 5/26/87  4:13 PM ;
 | 
|---|
 | 2 |  ;;v 2.0;Record Tracking;**16**;10/22/91 
 | 
|---|
 | 3 | FR ;entry point will return RTFR ; RTAPL must be defined ; RTTY is optional
 | 
|---|
 | 4 |  I '($D(DUZ)#2) W !!?5,*7,"User's 'DUZ' is not defined." Q
 | 
|---|
 | 5 |  S %ZIS="L",IOP="HOME" D ^%ZIS K %ZIS,IOP,RTFR S DIC("V")="I $P(Y(0),U,4)=""L"""
 | 
|---|
 | 6 |  S IONSAV=ION I $D(IO("ZIO")),IO("ZIO")'=IO(0) S ION=IO("ZIO")
 | 
|---|
 | 7 |  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"
 | 
|---|
 | 8 |  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
 | 
|---|
 | 9 |  S DIC(0)="IAMEQZ",DIC="^RTV(195.9,",DIC("A")="Select Record Tracking File Room: " D DEF:$D(DUZ(2)),^DIC S:Y>0 RTFR=+Y_"^"_$P(Y(0),"^",2,99)
 | 
|---|
 | 10 | FRQ I $D(RTSYS),$P(RTSYS,"^",4)="e",$D(RTFR) S $P(RTFR,"^",4,6)="^^"
 | 
|---|
 | 11 |  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)="^^"
 | 
|---|
 | 12 |  S ION=IONSAV K IONSAV,DIC Q
 | 
|---|
 | 13 |  ;
 | 
|---|
 | 14 | 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),"^"))
 | 
|---|
 | 15 |  Q
 | 
|---|
 | 16 |  ;
 | 
|---|
 | 17 | PGM ;Entry point to run a record tracking program for a specific application
 | 
|---|
 | 18 |  ;     RTAPPL = <application name or synonym>   [ex. MAS]
 | 
|---|
 | 19 |  ;     RTPGM  = <program to be executed>        [ex. 1^RTQ]
 | 
|---|
 | 20 |  ;
 | 
|---|
 | 21 |  S IOP="" D ^%ZIS K IOP I $D(RTAPL) S X=RTAPPL D SAVE,APL^RTPSET D:$D(RTAPL) @RTPGM D RESTORE Q
 | 
|---|
 | 22 |  S X=RTAPPL D APL^RTPSET D:$D(RTAPL) @RTPGM K RTAPL,RTSYS Q
 | 
|---|
 | 23 |  ;
 | 
|---|
 | 24 | MAS ;Entry point to run a RT program for 'MAS' application / RTPGM defined
 | 
|---|
 | 25 |  S RTAPPL="MAS" D PGM K RTAPPL,RTPGM Q
 | 
|---|
 | 26 |  ;
 | 
|---|
 | 27 | RAD ;Entry point to run a RT program for 'FILM TRACKING' application / RTPGM defined
 | 
|---|
 | 28 |  S RTAPPL="RAD" D PGM K RTAPPL,RTPGM,RTD,J Q
 | 
|---|
 | 29 |  ;
 | 
|---|
 | 30 | SAVE K RTNEW F I="RTAPL","RTSYS","RTFR","RTDIV" I $D(@I) S RTNEW(I)=@I
 | 
|---|
 | 31 |  Q
 | 
|---|
 | 32 |  ;
 | 
|---|
 | 33 | RESTORE F I="RTAPL","RTSYS","RTFR","RTDIV" I $D(RTNEW(I)) S @I=RTNEW(I)
 | 
|---|
 | 34 |  K RTNEW Q
 | 
|---|
 | 35 |  ;
 | 
|---|
 | 36 | 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
 | 
|---|