source: FOIAVistA/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/_ZOSV.m@ 1518

%ZOSV ;SFISC/AC,PUG/TOAD,HOU/DHW - View commands & special functions. ;4/12/07  16:48
 ;;8.0;KERNEL;**275,425**;Jul 10, 1995;Build 18
 ;
ACTJ() ; # active jobs
 I $G(^XUTL("XUSYS","CNT")) Q $G(^XUTL("XUSYS","CNT"))
 ;This would also work
 N %I,%FILE,Y
 S %FILE=$$TEMP_"zosv_actj_"_$J_".tmp"
 ZSYSTEM "ps cef -C mumps|wc>"_%FILE
 S %I=$I
 O %FILE
 U %FILE R Y:99 U %I
 C %FILE:DELETE
 F  Q:$E(Y)'=" "  S $E(Y)=""
 S Y=Y-1,^XUTL("XUSYS","CNT")=Y
 Q Y
 ;
AVJ() ; # available jobs, Limit is in the OS.
 N V,J
 S V=^%ZOSF("VOL"),J=$O(^XTV(8989.3,1,4,"B",V,0)),J=$P($G(^XTV(8989.3,1,4,J,0),"^^1000"),"^",3)
 Q J-$$ACTJ ;Use signon Max
 ;
RTNDIR() ; primary routine source directory
 ;Assume /home/xxx/o(/home/xxx/r /home/gtm)
 Q $P($S($ZRO["(":$P($P($ZRO,"(",2),")"),1:$ZRO)," ")_"/"
 ;
TEMP() ; Return path to temp directory
 ;N %TEMP S %TEMP=$P($$RTNDIR," "),%TEMP=$P(%TEMP,"/",1,$L(%TEMP,"/")-2)_"/t/"
 Q $G(^%ZOSF("TMP"),$G(^XTV(8989.3,1,"DEV"),"/tmp/"))
 ;
PASSALL ;
 U $I:(NOESCAPE:NOTERMINATOR:PASTHRU) Q
NOPASS ;
 U $I:(ESCAPE:TERMINATOR="":NOPASTHRU) Q
 ;
GETPEER() ;Get the IP address of a connection peer
 N % S %=$P($ZTRNLNM("SSH_CLIENT")," ") S:%="" %=$ZTRNLNM("REMOTEHOST")
 Q $S($L(%):%,$L($G(IO("GTM-IP"))):IO("GTM-IP"),1:"")
 ;
PRGMODE ;Drop into direct mode
 N X,XUCI,XUSLNT
 W ! S ZTPAC=$P($G(^VA(200,+DUZ,.1)),"^",5),XUVOL=^%ZOSF("VOL")
 S X="" X ^%ZOSF("EOFF") R:ZTPAC]"" !,"PAC: ",X:60 D LC^XUS X ^%ZOSF("EON") I X'=ZTPAC W "??",$C(7) Q
 N XMB,XMTEXT,XMY S XMB="XUPROGMODE",XMB(1)=DUZ,XMB(2)=$I D ^XMB:$L($T(^XMB)) D BYE^XUSCLEAN K ZTPAC,X,XMB
 D UCI S XUCI=Y D PRGM^ZUA
 F  BREAK
 HALT
 ;
PROGMODE() ; In Application mode
 Q 0 ; This was used to control UCI switching, has no meaning in GT.M
 ;
UCI ;
 S Y=^%ZOSF("PROD") Q
 ;
UCICHECK(X) ;
 Q X
 ;
JOBPAR ; <=====
 N %FILE,%I S %FILE=$$PWD^%ZISH_"zosv_jobpar_"_$J_".tmp"
 ZSYSTEM "ps c -p "_X_"|tail -1>"_%FILE
 S %I=$I
 O %FILE
 U %FILE R Y:99 U %I
 C %FILE:DELETE
 F  Q:$E(Y)'=" "  S $E(Y)=""
 I +Y=X,$E(Y,$L(Y)-4,$L(Y))="mumps" S Y=^%ZOSF("PROD")
 E  S Y=""
 Q
 ;
SHARELIC(TYPE) ;Used by Cache implementations
 Q
 ;
PRIORITY ;
 K Y ; VA has this disabled in general.
 Q
 ;
PRIINQ() ;
 Q 5 ; for now, we're always middle of the road
 ;
BAUD S X="UNKNOWN"
 Q
 ;
LGR() ; Last global reference ($REFERENCE)
 Q $R
 ;
EC() ; Error Code: returning $ZS in format more like $ZE from DSM
 N %ZE
 I $ZS="" S %ZE=""
 S %ZE=$P($ZS,",",2)_","_$P($ZS,",",4)_","_$P($ZS,",")_",-"_$P($ZS,",",3)
 Q %ZE
 ;
DOLRO ;SAVE ENTIRE SYMBOL TABLE IN LOCATION SPECIFIED BY X
 ;S Y="%" F  S Y=$O(@Y) Q:Y=""  D
 ;. I $D(@Y)#2 S @(X_"Y)="_Y)
 ;. I $D(@Y)>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR
 S Y="%" F  M:$D(@Y) @(X_"Y)="_Y) S Y=$O(@Y) Q:Y=""
 Q
 ;
ORDER ;SAVE PART OF SYMBOL TABLE IN LOCATION SPECIFIED BY X
 N %
 S (Y,%)=$P(Y,"*",1) ;I $D(@Y)=0 F  S Y=$O(@Y) Q:Y=""!(Y[Y1)
 Q:Y=""
 ;S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR
 ;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
 F  M:$D(@Y) @(X_"Y)="_Y) S Y=$O(@Y) Q:Y=""!(Y'[%)
 Q
 ;
PARSIZ ;
 S X=3 Q
 ;
NOLOG ;
 S Y=0 Q
 ;
GETENV ;Get environment Return Y='UCI^VOL^NODE^BOX LOOKUP'
 N %HOST,%V S %V=^%ZOSF("PROD"),%HOST=$$RETURN("hostname -s")
 S Y=$TR(%V,",","^")_"^"_%HOST_"^"_$P(%V,",",2)_":"_%HOST
 Q
 ;
VERSION(X) ;return OS version, X=1 - return OS
 Q $S($G(X):$P($ZV," V"),1:+$P($ZV," V",2))
 ;
OS() ;
 Q "UNIX"
 ;
SETNM(X) ;Set name, Trap dup's, Fall into SETENV
 N $ETRAP S $ETRAP="S $ECODE="""" Q"
SETENV ;Set environment X='PROCESS NAME^ '
 S ^XUTL("XUSYS",$J,0)=$H,^("NM")=X ; workaround
 Q
 ;
SID() ;System ID
 N J1,T S T="~"
 S J1(1)=$ZROUTINES,J1(1)=$P(J1(1)," ")
 S J1(2)=$ZGBLDIR
 Q "1~"_J1(1)_T_J1(2)
 ;
PRI() ;Check if a mixed OS enviroment.
 ;Default return 1 unless we are on the secondary OS.
 ;Only Cache on a VMS/Linux mix is supported now.
 Q 1
 ;
T0 ; start RT clock
 Q  ; we don't have $ZH on GT.M
 ;
T1 ; store RT datum w/ZHDIF
 Q  ; we don't have $ZH on GT.M
 ;
ZHDIF ;Display dif of two $ZH's
 W !," ET=",$J(($P(%ZH1,",")-$P(%ZH0,",")*86400)+($P(%ZH1,",",2)-$P(%ZH0,",",2)),6,2)
 Q
 ;
 ;Code moved to %ZOSVKR, Comment out if needed.
LOGRSRC(OPT,TYPE,STATUS) ;record resource usage in ^XTMP("KMPR"
 Q:'$G(^%ZTSCH("LOGRSRC"))  ; quit if RUM not turned on.
 ; call to RUM routine.
 D RU^%ZOSVKR($G(OPT),$G(TYPE),$G(STATUS))
 Q
 ;
SETTRM(X) ;Turn on specified terminators.
 U $I:(TERMINATOR=X)
 Q 1
 ;
DEVOK ;
 ;use lsof (list open files)
 ; given a device name in X
 ;INPUT:  X=Device $I, X1=IOT -- X1 needed for resources
 ;OUTPUT: Y=0 if available, Y=job # if owned
 ; Y=-1 if device does not exists.
 ; return Y=0 if not owned, Y=$J of owning job, Y=999 if dev cycling
 ;
 I $G(X1)="RES" G RESOK^%ZIS6
 S Y=0
 Q  ;Let ZIS deal with it.
 ;
 N %FILE S %FILE=$$TEMP_"zosv_devok_"_$J_".tmp"
 ZSYSTEM "/usr/sbin/lsof -F Pc "_X_" >"_%FILE
 N %I,%X,%Y S %I=$I
 O %FILE U %FILE
 F %Y=0:1 R %X:99 Q:%X=""  Q:%X["lsof: status error"  D
 . S %Y(%Y\2,$S($E(%X)="p":"PID",$E(%X)="c":"CMD",1:"?"))=$E(%X,2,$L(%X))
 U %I
 C %FILE:(DELETE)
 I %X["lsof: status error" S Y=-1 Q
 S %X="",Y=0
 F  S %X=$O(%Y(%X)) Q:%X=""  I %Y(%X,"CMD")="mumps" S Y=%Y(%X,"PID") Q
 Q
 ;
DEVOPN ;List of Devices opened.  Linux only
 ;Returns variable Y. Y=Devices owned separated by a comma
 ; ZSHOW "D":Y
 N %FILE S %FILE=$$TEMP_"zosv_devopn_"_$J_".tmp"
 ZSYSTEM "lsof -F n -p "_$J_" >"_%FILE
 N %I,%X,%Y S %I=$I
 O %FILE
 U %FILE
 F %Y=0:1 R %X:99 Q:%X=""  S %Y($S($E(%X)="p":"PID",$E(%X)="n":%Y,1:"?"))=$E(%X,2,$L(%X))
 U %I
 C %FILE:(DELETE)
 I %Y("PID")'=$J S Y="" Q
 I $D(%Y("?")) S Y="" Q
 K %Y("PID"),%Y("?")
 S (Y,%X)="" F  S %X=$O(%Y(%X)) Q:%X=""  S Y=Y_","_%Y(%X)
 Q
 ;
RETURN(%COMMAND) ; ** Private Entry Point: execute a shell command & return the resulting value **
 ; %COMMAND is the string value of the Linux command
 N %VALUE S %VALUE="" ; value to return
 N %FILE S %FILE=$$TEMP_"RET"_$J_".txt" ; temporary results file
 ZSYSTEM %COMMAND_" > "_%FILE ; execute command & save result
 O %FILE:(REWIND) U %FILE R:'$ZEOF %VALUE:99 C %FILE:(DELETE) ; fetch value & delete file
 ;
 QUIT %VALUE ; return value
 ;
 ;
STRIPCR(%DIRECT) ; ** Private Entry Point: strip extraneous CR from end of lines of all
 ; routines in %DIRECTORY Linux directory
 ;
 ZSYSTEM "perl -pi -e 's/\r\n$/\n/' "_%DIRECT_"[A-K]*.m"
 ZSYSTEM "perl -pi -e 's/\r\n$/\n/' "_%DIRECT_"[L-S]*.m"
 ZSYSTEM "perl -pi -e 's/\r\n$/\n/' "_%DIRECT_"[T-z]*.m"
 ZSYSTEM "perl -pi -e 's/\r\n$/\n/' "_%DIRECT_"[_]*.m"
 Q
 ;