source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUS3A.m@ 623

Last change on this file since 623 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.7 KB
RevLine 
[613]1XUS3A ;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
5SWITCH ;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.
14UCI 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
20SAME 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
27BAD W !,"UCI not found!" D SHOW G UCI
28 ;
29NXT ;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 ;
35SHOW 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 ;
45PM I X="PROD"!(X="MGR") S X=^%ZOSF(X)
46 Q
Note: See TracBrowser for help on using the repository browser.