source: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XUCIMSM.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1%XUCI ;SF/STAFF - SWAP UCIS FOR MSM-UNIX ;11/20/92 07:30
2 ;;8.0;KERNEL;;Jul 10, 1995
31 R !,"What UCI: ",%UCI:$S($D(DTIME):DTIME,1:10)," " Q:%UCI=""!(%UCI["^") G 2
4 ;
52 ;
6 I %UCI="PROD"!(%UCI="MGR") S %UCI=^%ZOSF(%UCI)
7 S X=%UCI X ^%ZOSF("UCICHECK") G ERR:0[Y
8 I $S($P($ZV,"Version ",2)'<2:$V(0,$J,2)#2,1:$V(2,$J)#2) W:'($D(XUSLNT)!$D(ZTQUEUED)) !,*7,"NO SWITCHING UCI'S IN PROGRAMMER MODE!",! S Y=0 Q
9V D SWAP
10U I '($D(XUSLNT)!$D(ZTQUEUED)) W *7,!,"YOU'RE IN UCI: ",Y,!
11 S $ZT="^%ZTER",%=$D(^%ZOSF("OS"))
12K K %,%UCI S Y=1 Q
13 ;
14SWAP ;I $P($ZV,"Version ",2)'<2
15 S %ST=$S(X[",":$ZU($P(X,","),$P(X,",",2)),1:$ZU(X))
16 I $P($ZV,"Version ",2),%ST["," S %ST=$P(%ST,",",2)*32+$P(%ST,",") V:'($V(0,$J,2)#2) 2:$J:%ST:2 Q
17 F %ST=1:1:64 Q:$ZU(%ST)=X
18 V:'($V(2,$J)#2) 2:$J:%ST-1:2 Q
19 ;
20ENT G 2:$D(%UCI)#2,1
21 ;
22GO ;
23 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
24 K ^XUTL("XQ",$J),^UTILITY($J) G @(U_PGM)
25 ;
26DO S %UCI=$P(XQZ,"[",2,9),PGM=$P(XQZ,"[",1),%UCI=$E(%UCI,1,$L(%UCI)-1)
27 I %UCI="PROD"!(%UCI="MGR") S %UCI=^%ZOSF(%UCI)
28 E S X=%UCI X ^%ZOSF("UCICHECK") G ERR:0[Y
29 X ^%ZOSF("UCI") D SAV,D S %UCI=Y D 2^%XUCI,RES Q
30D N Y,%XUCI D 2 Q:0[Y G @PGM Q
31SAV S %XUCI="" F %="DUZ","DUZ(0)","DT","DTIME","IO","IO(0)","IOF","IOM","IOST","IOST(0)" S %XUCI=%XUCI_$S($D(@%)#2:@%,1:"")_"^"
32 Q
33RES F %=1:1:10 S @($P("DUZ^DUZ(0)^DT^DTIME^IO^IO(0)^IOF^IOM^IOST^IOST(0)","^",%))=$P(%XUCI,"^",%)
34 Q
35 ;
36ERR W !?9,"'"_X_"' IS AN INVALID UCI!",!
Note: See TracBrowser for help on using the repository browser.