← Back to branch summary

~jontai/openvista-gtm-integration/bug383367

« back to all changes in this revision

Viewing changes to mumps/ZOSVONT.m

  • Committer: Jonathan Tai
  • Date: 2009-06-02 17:11:29 UTC
  • mfrom: (47.3.5 bug381117)
  • Revision ID: jon.tai@medsphere.com-20090602171129-wd07mgxmvf6219fu
Merge bug 381117 - GT.M/Unix version of ORDER^%ZOSV out of sync with Cache version

Show diffs side-by-side

added added

removed removed

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