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