source: FOIAVistA/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XUCIONT.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 1.3 KB
Line 
1%XUCI ;SF/STAFF - SWAP UCIs DTM and Open M-NT ;04/24/97 11:47
2 ;;8.0;KERNEL;**34**;Jul 10, 1995
3 ; *** For Intersystem Open M for NT***
41 R !,"What Namespace: ",%UCI:$S($D(DTIME):DTIME,1:10)," " Q:%UCI=""!(%UCI["^") G 2
5 ;
62 ;
7 I %UCI="PROD"!(%UCI="MGR") S %UCI=^%ZOSF(%UCI)
8 S X=%UCI X ^%ZOSF("UCICHECK") G ERR:0[Y
9 X ^%ZOSF("PROGMODE") I Y W:'$D(XUSLNT) !,*7,"NO SWITCHING UCI'S IN PROGRAMMER MODE!",! S Y=0 Q
10V D SWAP
11U I '$D(XUSLNT) W *7,!,"You're now in namespace: ",Y,!
12 S $ZT="^%errlog",%ST=$D(^%ZOSF("OS")),^XUTL("XQ",$J,0)=DT,^("DUZ")=DUZ
13K K %ST,%UCI S Y=1 Q
14 ;
15SWAP ;Do it
16 I X["," S X=$P(X,",")
17 N %ST X ^%ZOSF("PROGMODE") S:'Y %ST=$ZU(5,X)
18 Q
19 ;
20GO ;
21 D 2 Q:0[Y S X=PGM I PGM'?1"%".E X ^%ZOSF("TEST") I '$T W !?9,"'"_X_"' DOES NOT EXIST IN "_%UCI,! HALT
22 K ^XUTL("XQ",$J),^UTILITY($J) G @(U_PGM)
23 ;
24DO S %UCI=$P(XQZ,"[",2,9),PGM=$P(XQZ,"[",1),%UCI=$E(%UCI,1,$L(%UCI)-1)
25 I %UCI="PROD"!(%UCI="MGR") S %UCI=^%ZOSF(%UCI)
26 E S X=%UCI X ^%ZOSF("UCICHECK") G ERR:0[Y
27 X ^%ZOSF("UCI") D SAV,D S %UCI=Y D 2^%XUCI,RES Q
28D N Y,%XUCI D 2 Q:0[Y G @PGM Q
29SAV S %XUCI="" F %="DUZ","DUZ(0)","DT","DTIME","IO","IO(0)","IOM","IOST","IOST(0)" S %XUCI=%XUCI_$S($D(@%)#2:@%,1:"")_"^"
30 Q
31RES F %=1:1:9 S @($P("DUZ^DUZ(0)^DT^DTIME^IO^IO(0)^IOM^IOST^IOST(0)","^",%))=$P(%XUCI,"^",%)
32 Q
33 ;
34ERR W !?9,"'"_X_"' IS AN INVALID NAMESPACE!",!
Note: See TracBrowser for help on using the repository browser.