| 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
|
|---|
| 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 %=$ZJOB(%) Q:%=""
|
|---|
| 7 | S Y=$system.License.LUConsumed() ;Cache 5 up
|
|---|
| 8 | Q Y
|
|---|
| 9 | AVJ() ;# 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 | ;
|
|---|
| 28 | PRIINQ() ;
|
|---|
| 29 | Q 8
|
|---|
| 30 | ;
|
|---|
| 31 | UCI ;Current UCI,VOL
|
|---|
| 32 | S Y=$ZU(5)_","_^%ZOSF("VOL") Q
|
|---|
| 33 | ;
|
|---|
| 34 | UCICHECK(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 | ;
|
|---|
| 39 | GETPEER() ;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 | ;
|
|---|
| 45 | SHARELIC(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
|
|---|
| 54 | JOBPAR ;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")
|
|---|
| 57 | JOBX Q
|
|---|
| 58 | ;
|
|---|
| 59 | NOLOG ;4096 is switch 12 - sign on inhibited.
|
|---|
| 60 | S Y="$V(0,-2,4)\4096#2" Q
|
|---|
| 61 | ;
|
|---|
| 62 | PROGMODE() ;Check if in PROG mode
|
|---|
| 63 | Q $ZJ#2
|
|---|
| 64 | ;
|
|---|
| 65 | PRGMODE ;
|
|---|
| 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
|
|---|
| 72 | LGR() S $ZT="LGRX^%ZOSV"
|
|---|
| 73 | Q $ZR ;Last Global ref.
|
|---|
| 74 | LGRX Q ""
|
|---|
| 75 | ;
|
|---|
| 76 | EC() Q $ZE ;Error code
|
|---|
| 77 | ;
|
|---|
| 78 | DOLRO ;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 | ;
|
|---|
| 85 | ORDER ;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 | ;
|
|---|
| 94 | PARSIZ ;
|
|---|
| 95 | S X=3
|
|---|
| 96 | Q
|
|---|
| 97 | ;
|
|---|
| 98 | DEVOPN ;List of Devices opened
|
|---|
| 99 | ;Returns variable Y. Y=Devices owned separated by a comma
|
|---|
| 100 | Q
|
|---|
| 101 | DEVOK ;
|
|---|
| 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 | ;
|
|---|
| 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 | Q $S($ZV["VMS":"VMS",$ZV["Windows":"NT",$ZV["NT":"NT",$ZV["UNIX":"UNIX",1:"UNK")
|
|---|
| 121 | ;
|
|---|
| 122 | SETNM(X) ;Set name, Fall into SETENV
|
|---|
| 123 | SETENV ;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 | ;
|
|---|
| 128 | SID() ;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 | ;
|
|---|
| 136 | PRI() ;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 | ;
|
|---|
| 144 | HFSREW(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
|
|---|
| 148 | HFSRWERR ;Error encountered
|
|---|
| 149 | Q 0
|
|---|
| 150 | LOGRSRC(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
|
|---|
| 155 | SETTRM(X) ;Turn on specified terminators.
|
|---|
| 156 | U $I:(:"+T":X)
|
|---|
| 157 | Q 1
|
|---|
| 158 | ;
|
|---|
| 159 | T0 ; start RT clock
|
|---|
| 160 | ;S XRT0=$H
|
|---|
| 161 | Q
|
|---|
| 162 | T1 ; store RT datum, obsolete
|
|---|
| 163 | ;S ^%ZRTL(3,XRTL,+$H,XRTN,$P($H,",",2))=XRT0 K XRT0
|
|---|
| 164 | Q
|
|---|
