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/ZOSVONT.m@ 789

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

revised back to 6/30/08 version

File size: 5.1 KB
Line 
1%ZOSV ;SFISC/AC - $View commands for Open M for NT. ;4/26/07 09:39
2 ;;8.0;KERNEL;**34,94,107,118,136,215,293,284,385,425**;Jul 10, 1995;Build 18
3ACTJ() ;# Active jobs
4 N %,V,Y S V=$$VERSION()
5 I V<5 D Q Y
6 . S %=0 F Y=0:1 S %=$ZJOB(%) Q:%=""
7 S Y=$system.License.LUConsumed() ;Cache 5 up
8 Q Y
9AVJ() ;# available jobs
10 N %,AVJ,V,ZOSV,$ET
11 S V=+$$VERSION()
12 ;Cache 3 and 4
13 ;maxpid: from %SS
14 I V<5 D Q AVJ
15 . N port,t,x,maxpid,lmflim
16 . S $ET="",maxpid=$V($ZU(40,2,118),-2,4)
17 . X "S ZOSV=$ZU(5),%=$ZU(5,""%SYS"") S lmflim=$$inquire^LMFCLI,%=$ZU(5,ZOSV)" ;Get the license info
18 . ;Add together the enterprise and division licenses avaliable
19 . S x=$P(lmflim,";",2)+$P($P(lmflim,"|",2),";",2)
20 . S t=+lmflim+$P(lmflim,"|",2) ;Check the license total
21 . S AVJ=$S(t<maxpid:x,1:maxpid-$$ACTJ) ;Return the smaller of license or pid
22 ;To get available jobs from Cache 5.0 up
23 I V'<5 D Q AVJ
24 . X "S AVJ=$system.License.LUAvailable()"
25 ;Return fixed value not known version
26 Q 15
27 ;
28PRIINQ() ;
29 Q 8
30 ;
31UCI ;Current UCI,VOL
32 S Y=$ZU(5)_","_^%ZOSF("VOL") Q
33 ;
34UCICHECK(X) ;Check if valid namespace (UCI)
35 N Y,%
36 S %=$P(X,",",1),Y=0 I $ZU(90,10,%) S Y=%
37 Q Y
38 ;
39GETPEER() ;Get the PEER tcp/ip address
40 N PEER,NL,$ET S NL="",$ET="S $EC=NL Q NL",PEER=""
41 I $$OS="VMS" S PEER=$ZF("TRNLNM","VISTA$IP")
42 I '$L(PEER) S PEER=$ZU(111,0) S:$L(PEER) PEER=$A(PEER,1)_"."_$A(PEER,2)_"."_$A(PEER,3)_"."_$A(PEER,4)
43 Q PEER
44 ;
45SHARELIC(TYPE) ;See if can share a C/S license
46 ;Type is 1 for C/S and 0 for Telnet
47 N %,%N,%2,UID,%V,$ET S $ET="S $EC="""" Q",%V=$$VERSION()
48 I %V<3.1 X:TYPE "S %N=$ZU(5),%2=$ZU(5,""%SYS""),%2=$$GetLic^LMFCLI,%N=$ZU(5,%N)" Q
49 I %V<5 S:TYPE %=$$GetCSLic^%LICENSE S:'TYPE %=$$ShareLic^%LICENSE
50 ;Per Sandy Waal 10/18/2003: With Cache' 5.0, your telnet and IP connections are now handled properly.
51 I %V'<5 S %V=%V
52 S $EC=""
53 Q
54JOBPAR ;See if X points to a valid Job. Return its UCI.
55 N ZJ S Y="",$ZT="JOBX"
56 Q:'$D(^$JOB(X)) S Y=$V(-1,X),Y=$P(Y,"^",14)_","_^%ZOSF("VOL")
57JOBX Q
58 ;
59NOLOG ;4096 is switch 12 - sign on inhibited.
60 S Y="$V(0,-2,4)\4096#2" Q
61 ;
62PROGMODE() ;Check if in PROG mode
63 Q $ZJ#2
64 ;
65PRGMODE ;
66 N X,XMB,XQZ,XUCI,XUSLNT,XUVOL,Y,ZTPAC
67 W ! S ZTPAC=$S('$D(^VA(200,+DUZ,.1)):"",1:$P(^(.1),U,5)),XUVOL=^%ZOSF("VOL")
68 S X="" X ^%ZOSF("EOFF") R:ZTPAC]"" !,"PAC: ",X:60 D LC^XUS X ^%ZOSF("EON") I X'=ZTPAC W "??"_$C(7) Q
69 S XMB="XUPROGMODE",XMB(1)=DUZ,XMB(2)=$I D ^XMB:$L($T(^XMB)) D BYE^XUSCLEAN K ZTPAC,X,XMB
70 D UCI S XUCI=Y,XQZ="PRGM^ZUA[MGR]",XUSLNT=1 D DO^%XUCI D ^%PMODE U $I:(:"+B+C+R") S $ZT="" Q
71 Q
72LGR() S $ZT="LGRX^%ZOSV"
73 Q $ZR ;Last Global ref.
74LGRX Q ""
75 ;
76EC() Q $ZE ;Error code
77 ;
78DOLRO ;SAVE ENTIRE SYMBOL TABLE IN LOCATION SPECIFIED BY X
79 ;S Y="%" F S Y=$O(@Y) Q:Y="" D
80 ;. I $D(@Y)#2 S @(X_"Y)="_Y)
81 ;. I $D(@Y)>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR
82 S Y="%" F M:$D(@Y) @(X_"Y)="_Y) S Y=$O(@Y) Q:Y=""
83 Q
84 ;
85ORDER ;SAVE PART OF SYMBOL TABLE IN LOCATION SPECIFIED BY X
86 N %
87 S (Y,%)=$P(Y,"*",1) ;I $D(@Y)=0 F S Y=$O(@Y) Q:Y=""!(Y[Y1)
88 Q:Y=""
89 ;S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR
90 ;F S Y=$O(@Y) Q:Y=""!(Y'[Y1) S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR
91 F M:$D(@Y) @(X_"Y)="_Y) S Y=$O(@Y) Q:Y=""!(Y'[%)
92 Q
93 ;
94PARSIZ ;
95 S X=3
96 Q
97 ;
98DEVOPN ;List of Devices opened
99 ;Returns variable Y. Y=Devices owned separated by a comma
100 Q
101DEVOK ;
102 S Y=0,X1=$G(X1) Q:X=2 Q:(X1="HFS")!(X1="SPL")!(X1="MT")!(X1="CHAN") ;Quit w/ OK for HFS, Spool, MT, TCP/IP
103 G:X1="RES" RESOK^%ZIS6
104 N $ET S $ET="D OPNERR Q"
105 O X::$S($D(%ZISTO):%ZISTO,1:0) E S Y=999 Q ;G NOPN
106 S Y=0 I '$D(%ZISCHK)!($G(%ZIS)["T") C X Q
107 S:X]"" IO(1,X)="" Q
108 Q
109 ;
110OPNERR S $EC="",Y=-1 Q
111 ;
112GETENV ;Get environment (UCI^VOL^NODE^BOX:VOLUME)
113 N %,%1 S %=$$VERSION,%1=$ZU(86),%1=$S(%<3.1:$P(%1,"*",3),1:$P(%1,"*",2))
114 D UCI S Y=$P(Y,",")_"^"_^%ZOSF("VOL")_"^"_$ZU(110)_"^"_^%ZOSF("VOL")_":"_%1
115 Q
116VERSION(X) ;return Cache version, X=1 - return full name
117 Q $S($G(X):$P($ZV,")")_")",1:$P($P($ZV,") ",2),"("))
118 ;
119OS() ;Return the OS NT, VMS, Unix
120 Q $S($ZV["VMS":"VMS",$ZV["Windows":"NT",$ZV["NT":"NT",$ZV["UNIX":"UNIX",1:"UNK")
121 ;
122SETNM(X) ;Set name, Fall into SETENV
123SETENV ;Set environment
124 N Q,$ET,$ES S $ET="S $EC="""" Q"
125 I $$OS="VMS" S Q=$ZF("SETPRN",$E(X,1,15))
126 Q
127 ;
128SID() ;System ID Ver 1
129 N %1,%2,%3,T S T="~"
130 S %1=$ZU(5) ;namespace
131 S %2=$ZU(12,"") ;directory
132 I '$L(%2),$$VERSION'<5.2 S %2=$$defdir^%SYS.GLO(%1) ;remote directory
133 S %3=%1_T_%2 ;namespace~directory
134 Q "1~"_%3
135 ;
136PRI() ;Check if a mixed OS enviroment.
137 ;Default return 1 unless we are on the secondary OS.
138 ;Only Cache on a VMS(1)/Linux(2) mix is supported now.
139 N % S %=1
140 I $P(^XTV(8989.3,1,0),"^",5),$$OS'="VMS" S %=2
141 ;I $P(^XTV(8989.3,1,0),"^",5),$$OS["NT" S %=2
142 Q %
143 ;
144HFSREW(IO,IOPAR) ;Rewind Host File.
145 S $ZT="HFSRWERR"
146 C IO O @(""""_IO_""""_$S(IOPAR]"":":"_IOPAR_":1",1:":1")) I '$T Q 0
147 Q 1
148HFSRWERR ;Error encountered
149 Q 0
150LOGRSRC(OPT,TYPE,STATUS) ;record resource usage in ^XTMP("KMPR"
151 Q:'$G(^%ZTSCH("LOGRSRC")) ; quit if RUM not turned on.
152 ; call to RUM routine.
153 D RU^%ZOSVKR($G(OPT),$G(TYPE),$G(STATUS))
154 Q
155SETTRM(X) ;Turn on specified terminators.
156 U $I:(:"+T":X)
157 Q 1
158 ;
159T0 ; start RT clock
160 ;S XRT0=$H
161 Q
162T1 ; store RT datum, obsolete
163 ;S ^%ZRTL(3,XRTL,+$H,XRTN,$P($H,",",2))=XRT0 K XRT0
164 Q
Note: See TracBrowser for help on using the repository browser.