- 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 Jan 18, 2025@03:35:34 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