Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XUCIDTM

XUCIDTM.m

Go to the documentation of this file.
  1. %XUCI ;SF/STAFF - SWAP UCIs DSM-11 ;2/3/93 16:37 ; [ 04/02/2003 8:29 AM ]
  1. ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
  1. ;;8.0;KERNEL;;Jul 10, 1995
  1. ; *** For DataTree ***
  1. 1 R !,"What Namespace: ",%UCI:$S($D(DTIME):DTIME,1:10)," " Q:%UCI=""!(%UCI["^") G 2
  1. ;
  1. 2 ;
  1. I %UCI="PROD"!(%UCI="MGR") S %UCI=^%ZOSF(%UCI)
  1. S X=%UCI X ^%ZOSF("UCICHECK") G ERR:0[Y
  1. X ^%ZOSF("PROGMODE") I Y W:'$D(XUSLNT) !,*7,"NO SWITCHING UCI'S IN PROGRAMMER MODE!",! S Y=0 Q
  1. V D SWAP
  1. U I '$D(XUSLNT) W *7,!,"You're now in namespace: ",Y,!
  1. S $ZT="^%errlog",%ST=$D(^%ZOSF("OS")),^XUTL("XQ",$J,0)=DT,^("DUZ")=DUZ
  1. K K %ST,%UCI Q
  1. ;
  1. SWAP S X=$P(X,",")
  1. I $P($ZVER,"/",2)<4 X ^%ZOSF("PROGMODE") ZNSPACE:'Y X I 1
  1. E X ^%ZOSF("PROGMODE") D:'Y ns^%m(X,1)
  1. Q
  1. ;
  1. GO ;
  1. 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
  1. K ^XUTL("XQ",$J),^UTILITY($J) G @(U_PGM)
  1. ;
  1. DO S %UCI=$P(XQZ,"[",2,9),PGM=$P(XQZ,"[",1),%UCI=$E(%UCI,1,$L(%UCI)-1)
  1. I %UCI="PROD"!(%UCI="MGR") S %UCI=^%ZOSF(%UCI)
  1. E S X=%UCI X ^%ZOSF("UCICHECK") G ERR:0[Y
  1. X ^%ZOSF("UCI") D SAV,D S %UCI=Y D 2^%XUCI,RES Q
  1. D N Y,%XUCI D 2 Q:0[Y G @PGM Q
  1. SAV S %XUCI="" F %="DUZ","DUZ(0)","DT","DTIME","IO","IO(0)","IOM","IOST","IOST(0)" S %XUCI=%XUCI_$S($D(@%)#2:@%,1:"")_"^"
  1. Q
  1. RES F %=1:1:9 S @($P("DUZ^DUZ(0)^DT^DTIME^IO^IO(0)^IOM^IOST^IOST(0)","^",%))=$P(%XUCI,"^",%)
  1. Q
  1. ;
  1. ERR W !?9,"'"_X_"' IS AN INVALID NAMESPACE!",!