1 | XUS3A ;SF-ISC/STAFF - CHANGE UCI'S ; 2/4/03 9:51am
|
---|
2 | ;;8.0;KERNEL;**13,282**;Jul 10, 1995
|
---|
3 | Q
|
---|
4 | ;PICK A UCI TO SWITCH TO
|
---|
5 | SWITCH ;Allow users that have the UCI field in there NP file to switch UCI's.
|
---|
6 | W !!,"Switch UCI's option.",!
|
---|
7 | I $$PROGMODE^%ZOSV() W !,$C(7),"No switching UCI's in Programmer Mode." Q
|
---|
8 | I $O(^VA(200,DUZ,.2,0))'>0 D Q
|
---|
9 | . W !,"Sorry but you do not have any UCI's that you are allowed to"
|
---|
10 | . W !,"switch to."
|
---|
11 | . Q
|
---|
12 | N DIR,X,Y,PGM,%UCI,DEF
|
---|
13 | S DEF="ZU" ;DEF is default routine to switch to.
|
---|
14 | UCI S DIR(0)="F",DIR("A")="Select UCI:ROUTINE",DIR("??")="^D SHOW^XUS3A"
|
---|
15 | S DIR("?")="Enter a UCI name (:Routine) to switch to."
|
---|
16 | D ^DIR K DIR I $D(DUOUT)!$D(DTOUT)!(X="^") Q
|
---|
17 | I Y?.N,$D(^VA(200,DUZ,.2,Y,0)) S UC=^(0),Y=$P(UC,U)_":"_$P($P(UC,U,2),":")
|
---|
18 | S X=$P(Y,":"),PGM=$P(Y,":",2,3) S:PGM[":" X=$P(Y,":",1,2),PGM=$P(Y,":",3) ;for M/vx
|
---|
19 | S:PGM="" PGM=DEF
|
---|
20 | SAME I X="" Q ;Didn't select anything.
|
---|
21 | D PM S %UCI=X X ^%ZOSF("UCICHECK") I 0[Y G BAD
|
---|
22 | F DA=0:0 S DA=$O(^VA(200,DUZ,.2,DA)) Q:DA'>0 S Y=^(DA,0) D G:GO NXT
|
---|
23 | . S GO=0,X=$P(Y,U),XUA=$P(Y,U,2) D PM Q:%UCI'=X
|
---|
24 | . I XUA="" S XUA=DEF
|
---|
25 | . F %=1:1:20 I $P(XUA,":",%)=PGM S GO=1 Q
|
---|
26 | . Q
|
---|
27 | BAD W !,"UCI not found!" D SHOW G UCI
|
---|
28 | ;
|
---|
29 | NXT ;Here we go.
|
---|
30 | D C^XUSCLEAN K ^XUTL("XQ",$J),^XUTL($J),^TMP($J),^UTILITY($J)
|
---|
31 | ;K DA S XQZ="^"_PGM_"["_%UCI_"]" D DO^%XUCI G ^XUSCLEAN
|
---|
32 | K DA G GO^%XUCI
|
---|
33 | ;
|
---|
34 | ;
|
---|
35 | SHOW W ! S I=0,UC="",X=$S($D(^VA(200,DUZ,201)):+^(201),1:0)
|
---|
36 | W !,"Enter ^ to return to your current menu, or select from:"
|
---|
37 | F I=0:0 S I=$O(^VA(200,DUZ,.2,I)) Q:I'>0 D
|
---|
38 | . W !,?5 S UC=$G(^VA(200,DUZ,.2,I,0)),X=$P(UC,U,1),UC=$P(UC,U,2,99)
|
---|
39 | . I UC'[":" W I
|
---|
40 | . D PM W ?10,X X ^%ZOSF("UCICHECK") I 0[Y W " -- Not currently a valid UCI!",$C(7) Q
|
---|
41 | . W:UC]"" ":"_UC
|
---|
42 | . Q
|
---|
43 | Q
|
---|
44 | ;
|
---|
45 | PM I X="PROD"!(X="MGR") S X=^%ZOSF(X)
|
---|
46 | Q
|
---|