[613] | 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
|
---|