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

XUCIGTM.m

Go to the documentation of this file.
  1. %XUCI ;SFISC/STAFF,PUG/TOAD - SWAP UCIs GT.M ;20 May 2003 8:43 am
  1. ;;8.0;KERNEL;**275**;Jul 10, 1995;
  1. ; for GT.M for Unix & VMS, version 4.3--based on single UCI model
  1. ;
  1. 1 W !,"GT.M doesn't have an equivlent to UCI's.",!,"You will remain in this enviroment."
  1. R !,"What UCI: ",%UCI:$S($D(DTIME):DTIME,1:10)," " Q:%UCI=""!(%UCI["^")
  1. G 2
  1. ;
  1. 2 ;For GT.M this is a NOP, Return Y.
  1. X ^%ZOSF("UCI")
  1. U I '($D(XUSLNT)!$D(ZTQUEUED)) W *7,!,"YOU'RE IN UCI: ",Y,!
  1. S %=$D(^%ZOSF("OS"))
  1. K K %,%UCI S Y=1 Q
  1. ;
  1. SWAP ;
  1. ; X ^%ZOSF("PROGMODE") I 'Y S X=$S(X[",":$ZC(%SETUCI,$P(X,","),$P(X,",",2)),1:$ZC(%SETUCI,$P(X,","))),X=$ZC(%PGMSET),X=$ZC(%SECMAP)
  1. Q
  1. ;
  1. ENT G 2:$D(%UCI)#2,1
  1. ;
  1. GO ;GOTO some routine
  1. D 2 Q:0[Y
  1. 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 ;Do some routine and return
  1. S %UCI=$P(XQZ,"[",2,9),PGM=$P(XQZ,"[",1),%UCI=$E(%UCI,1,$L(%UCI)-1)
  1. D SAV,D S %UCI=Y D 2,RES Q
  1. D N Y,%XUCI D 2 Q:0[Y G @PGM Q
  1. ;
  1. SAV S %XUCI="" F %="DUZ","DUZ(0)","DT","DTIME","IO","IO(0)","IOF","IOM","IOST","IOST(0)" S %XUCI=%XUCI_$S($D(@%)#2:@%,1:"")_"^"
  1. Q
  1. RES F %=1:1:10 S @($P("DUZ^DUZ(0)^DT^DTIME^IO^IO(0)^IOF^IOM^IOST^IOST(0)","^",%))=$P(%XUCI,"^",%)
  1. Q
  1. ;
  1. ERR W !?9,"'"_X_"' IS AN INVALID UCI!",!