- XUS3A ;SF-ISC/STAFF - CHANGE UCI'S ; 2/4/03 9:51am [ 07/29/2004 9:01 AM ]
- ;;8.0;KERNEL;**13,282**;Jul 10, 1995
- Q
- ;PICK A UCI TO SWITCH TO
- SWITCH ;Allow users that have the UCI field in there NP file to switch UCI's.
- W !!,"Switch UCI's option.",!
- I $$PROGMODE^%ZOSV() W !,$C(7),"No switching UCI's in Programmer Mode." Q
- I $O(^VA(200,DUZ,.2,0))'>0 D Q
- . W !,"Sorry but you do not have any UCI's that you are allowed to"
- . W !,"switch to."
- . Q
- N DIR,X,Y,PGM,%UCI,DEF
- S DEF="ZU" ;DEF is default routine to switch to.
- UCI S DIR(0)="F",DIR("A")="Select UCI:ROUTINE",DIR("??")="^D SHOW^XUS3A"
- S DIR("?")="Enter a UCI name (:Routine) to switch to."
- D ^DIR K DIR I $D(DUOUT)!$D(DTOUT)!(X="^") Q
- I Y?.N,$D(^VA(200,DUZ,.2,Y,0)) S UC=^(0),Y=$P(UC,U)_":"_$P($P(UC,U,2),":")
- S X=$P(Y,":"),PGM=$P(Y,":",2,3) S:PGM[":" X=$P(Y,":",1,2),PGM=$P(Y,":",3) ;for M/vx
- S:PGM="" PGM=DEF
- SAME I X="" Q ;Didn't select anything.
- D PM S %UCI=X X ^%ZOSF("UCICHECK") I 0[Y G BAD
- F DA=0:0 S DA=$O(^VA(200,DUZ,.2,DA)) Q:DA'>0 S Y=^(DA,0) D G:GO NXT
- . S GO=0,X=$P(Y,U),XUA=$P(Y,U,2) D PM Q:%UCI'=X
- . I XUA="" S XUA=DEF
- . F %=1:1:20 I $P(XUA,":",%)=PGM S GO=1 Q
- . Q
- BAD W !,"UCI not found!" D SHOW G UCI
- ;
- NXT ;Here we go.
- D C^XUSCLEAN K ^XUTL("XQ",$J),^XUTL($J),^TMP($J),^UTILITY($J)
- ;K DA S XQZ="^"_PGM_"["_%UCI_"]" D DO^%XUCI G ^XUSCLEAN
- K DA G GO^%XUCI
- ;
- ;
- SHOW W ! S I=0,UC="",X=$S($D(^VA(200,DUZ,201)):+^(201),1:0)
- W !,"Enter ^ to return to your current menu, or select from:"
- F I=0:0 S I=$O(^VA(200,DUZ,.2,I)) Q:I'>0 D
- . W !,?5 S UC=$G(^VA(200,DUZ,.2,I,0)),X=$P(UC,U,1),UC=$P(UC,U,2,99)
- . I UC'[":" W I
- . D PM W ?10,X X ^%ZOSF("UCICHECK") I 0[Y W " -- Not currently a valid UCI!",$C(7) Q
- . W:UC]"" ":"_UC
- . Q
- Q
- ;
- PM I X="PROD"!(X="MGR") S X=^%ZOSF(X)
- Q
- XUS3A ;SF-ISC/STAFF - CHANGE UCI'S ; 2/4/03 9:51am [ 07/29/2004 9:01 AM ]
- +1 ;;8.0;KERNEL;**13,282**;Jul 10, 1995
- +2 QUIT
- +3 ;PICK A UCI TO SWITCH TO
- SWITCH ;Allow users that have the UCI field in there NP file to switch UCI's.
- +1 WRITE !!,"Switch UCI's option.",!
- +2 IF $$PROGMODE^%ZOSV()
- WRITE !,$CHAR(7),"No switching UCI's in Programmer Mode."
- QUIT
- +3 IF $ORDER(^VA(200,DUZ,.2,0))'>0
- Begin DoDot:1
- +4 WRITE !,"Sorry but you do not have any UCI's that you are allowed to"
- +5 WRITE !,"switch to."
- +6 QUIT
- End DoDot:1
- QUIT
- +7 NEW DIR,X,Y,PGM,%UCI,DEF
- +8 ;DEF is default routine to switch to.
- SET DEF="ZU"
- UCI SET DIR(0)="F"
- SET DIR("A")="Select UCI:ROUTINE"
- SET DIR("??")="^D SHOW^XUS3A"
- +1 SET DIR("?")="Enter a UCI name (:Routine) to switch to."
- +2 DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)!$DATA(DTOUT)!(X="^")
- QUIT
- +3 IF Y?.N
- IF $DATA(^VA(200,DUZ,.2,Y,0))
- SET UC=^(0)
- SET Y=$PIECE(UC,U)_":"_$PIECE($PIECE(UC,U,2),":")
- +4 ;for M/vx
- SET X=$PIECE(Y,":")
- SET PGM=$PIECE(Y,":",2,3)
- IF PGM["
- SET X=$PIECE(Y,":",1,2)
- SET PGM=$PIECE(Y,":",3)
- +5 IF PGM=""
- SET PGM=DEF
- SAME ;Didn't select anything.
- IF X=""
- QUIT
- +1 DO PM
- SET %UCI=X
- XECUTE ^%ZOSF("UCICHECK")
- IF 0[Y
- GOTO BAD
- +2 FOR DA=0:0
- SET DA=$ORDER(^VA(200,DUZ,.2,DA))
- IF DA'>0
- QUIT
- SET Y=^(DA,0)
- Begin DoDot:1
- +3 SET GO=0
- SET X=$PIECE(Y,U)
- SET XUA=$PIECE(Y,U,2)
- DO PM
- IF %UCI'=X
- QUIT
- +4 IF XUA=""
- SET XUA=DEF
- +5 FOR %=1:1:20
- IF $PIECE(XUA,":",%)=PGM
- SET GO=1
- QUIT
- +6 QUIT
- End DoDot:1
- IF GO
- GOTO NXT
- BAD WRITE !,"UCI not found!"
- DO SHOW
- GOTO UCI
- +1 ;
- NXT ;Here we go.
- +1 DO C^XUSCLEAN
- KILL ^XUTL("XQ",$JOB),^XUTL($JOB),^TMP($JOB),^UTILITY($JOB)
- +2 ;K DA S XQZ="^"_PGM_"["_%UCI_"]" D DO^%XUCI G ^XUSCLEAN
- +3 KILL DA
- GOTO GO^%XUCI
- +4 ;
- +5 ;
- SHOW WRITE !
- SET I=0
- SET UC=""
- SET X=$SELECT($DATA(^VA(200,DUZ,201)):+^(201),1:0)
- +1 WRITE !,"Enter ^ to return to your current menu, or select from:"
- +2 FOR I=0:0
- SET I=$ORDER(^VA(200,DUZ,.2,I))
- IF I'>0
- QUIT
- Begin DoDot:1
- +3 WRITE !,?5
- SET UC=$GET(^VA(200,DUZ,.2,I,0))
- SET X=$PIECE(UC,U,1)
- SET UC=$PIECE(UC,U,2,99)
- +4 IF UC'[":"
- WRITE I
- +5 DO PM
- WRITE ?10,X
- XECUTE ^%ZOSF("UCICHECK")
- IF 0[Y
- WRITE " -- Not currently a valid UCI!",$CHAR(7)
- QUIT
- +6 IF UC]""
- WRITE ":"_UC
- +7 QUIT
- End DoDot:1
- +8 QUIT
- +9 ;
- PM IF X="PROD"!(X="MGR")
- SET X=^%ZOSF(X)
- +1 QUIT
