cQSS ; System Status Report ; cQSS; [ 06/18/01  3:21 PM ]
 ;
 N PAGES,Dir S PAGES=1,Dir="" D SYSP Q
1 G ALL ; ALternative to ALL^%SS 
ALL D SYS("") Q  ;system status, all directories
THIS D SYS($ZU(5)) Q  ;system status, THIS directory only
MGR D SYS("^^"_$ZU(12)) Q  ;system status, manager's namespace only
INT() N NSYS,NJOB,NUSR,NLIC,NGLO,NROU,IO  ; NGA031+
 i ($zv["VMS") S IO="NL:" O IO U IO
 i ($zv["Windows") S IO="//./nul" O IO U IO
 i ($zv["UNIX") S IO="/dev/null" O IO U IO
 D SYS(1) C IO Q NJOB_"^"_NSYS_"^"_NUSR_"^"_NGLO_"^"_NROU_"^"_NLIC
 ; NGA031- 
SYS(Dir) ;system status for a specific directory (or all if none)
 ;VGG195 parameter accepted now is a namespace
  N PAGES S PAGES=0
SYSP ;entry for pagination
 I Dir=1 S Dir="" N MSYS,BS,FF,RM,SL,SUB,XY,JOB,SORT
 E  N MSYS,BS,FF,RM,SL,SUB,XY,NSYS,NJOB,NUSR,NLIC,NGLO,NROU,JOB,SORT
 N TAB,WID,J,MGR,SW10,SWJOB,pid1,pid2
 S MGR=$$Dir("^^"_$ZU(12)),Dir=$G(Dir) I Dir]"" S Dir=$$Dir(Dir)
 S SW10=$V(0,-2,$ZU(40,0,1))\1024#2,SWJOB=$S('SW10:"",1:$V($ZU(40,2,19),-2,$ZU(40,0,1)))
 D:'SW10 CURRENT
 S:SW10 RM=80     
 D Init
 ;
 ; remove evrything after maj vers and get dbms rel from dbms global
 s J=$$ZV,J=$e(J,1,$f(J,"-",$f(J,")"))-1)
 w #
 W !,$$CC("Cache System Status: "_$$ZT($P($H,",",2))_" "_$ZDATE($H,2,,4),RM)
 I SW10 d
 . W !,$$CC("*** Switch 10 Set by Process: "_$s(($zv["VMS"):$ZH(+SWJOB),1:SWJOB)_" ***",RM)
 W ! I Dir]"" W $$CC("For Namespace: "_Dir,RM),!
 ;
 S (NSYS,NJOB)=0 ;# of SYSTEM jobs and # of jobs                  
 n maxpid
 d BUILD,HEAD ; build JOB(i,j)=pid
 d BUILD
 s pid1="",pid2=""
 f  s pid1=$o(JOB(pid1)) q:pid1=""  d
 . f  s pid2=$o(JOB(pid1,pid2)) q:pid2=""  d Print(JOB(pid1,pid2))                 
 W ! ;
 S NGLO=$V($ZU(40,2,17),-2,$ZU(40,0,1))  ;number of global buffers
 S NROU=$V($ZU(40,2,26),-2,$ZU(40,0,1)) ;number of routine buffers
 S NUSR=NJOB-NSYS ;number of user processes
 S NLIC=$$JOBS
 ;
 W !,NUSR_" user, "_NSYS_" system, "
 w maxpid-NSYS_" max, "
 W NGLO_" global/"_NROU_" routine buffers"
 W ! Q
Init ;initialize some values
 S:'RM!(RM>100) RM=80 K WID
 S WID(1)=7,WID(2)=2,WID(3)=12
 S WID(4)=4,WID(5)=15,WID(6)=10
 S WID(7)=12,WID(8)=3,WID(9)=7
 s WIDDirsave=WID(5)
 Q
Dir(dir) I dir=" " Q "" ;no such directory
 i dir'?1"^^".e q dir  ; it's a defined namespace so leave it unchanged
 n realdir s realdir=$e(dir,3,$l(dir))
 s realdir=$zu(12,realdir)
 q "^^"_realdir
BUILD ;build JOB()=job information
 n base,i,pid
 s base=$v($zu(40,2,47),-2,"S")
 s maxpid=$v($zu(40,2,118),-2,4)
 f i=1:1:maxpid s pid=$v(i*4+base,-3,4) s:pid JOB(i\1000,i#1000)=pid
 Q
BldJob(J,JOB)      ;build the JOB(J) entry for one job
 N Info,X,SYS
 S JOB(J)="" ;always set to SOMETHING
 D JobInfo(J,.Info) ;get job information
 I $G(Info)="" Q  ;no information on job
 ;
 S Info(5)=$$Dir(Info(5)) ;'normalize' directory
 I $G(Dir)]"",Info(5)'=Dir Q  ;not an interesting job
 ;
 I ($ZU(67,10,J)>3),($ZU(67,10,J)'=48) S SYS=1,Info(5)="%SYS"   ;system job
 E  S SYS=0
 ;
 ;
 S Info(11)=SYS
 I SYS,$D(NSYS) S NSYS=NSYS+1 ;count of system jobs
 ;
 I '$G(SW10),Info(10)="",Info("P")]"" DO  ;possible substitute?
 . S Info(10)=$G(^%IS(Info("P"),0)) ;location information
 i $ZU(67,10,J)=72 S Info(10)="RCVDMN"
 ;
 ;
 I $D(NJOB) S NJOB=NJOB+1 ;count of total jobs
 S JOB(J)=Info F X=1:1:11,"P","D" S JOB(J,X)=Info(X)
 ;
 I $D(WID(5)) DO
 . N X S X=$L(Info(5)) I X>WID(5) S WID(5)=X ;width
 Q
JobInfo(job,Info)  ;place job information into Info()
 N L,X,ii,pdev,odev,pm,dev,par,dir,rou,glo,pri,uic,loc K Info
 S L=$$JobVw(job) I L="" Q  ;try twice for each job
 S (pdev,odev)="",dev=$P(L,"^",3) F ii=1:1:$L(dev,",") DO
 . S X=$P(dev,",",ii) 
 . i X["TCP" d
 . . i X["*" s X=$p($e(X,1,$l(X)-1),"|",1,3)_"*"
 . . i X'["*" s X=$p(X,"|",1,3)
 . I pdev="",X?.E1"*" S pdev=$E(X,1,$L(X)-1) Q
 . ;otherwise build a list of 'other' devices, not including null device        . i "/dev/nul,_NLA0:,//./nul"'[odev S odev=odev_","_X 
 ;
 S Info=L,Info("P")=pdev,Info("D")=$E(odev,2,$L(odev))
 F ii=1:1:10 S Info(ii)=$P(L,"^",ii)
 s Info(13)=$tr($p(L,"^",14),$c(0),"^")
 s Info(5)=Info(13)
 Q
NOJOB S $ZT="",Info=" " F ii=1:1:10 S Info(ii)=" " ;ghost!
 S Info("D")="",Info("P")="******"
 Q
JobVw(J) S $ZT="JobE1" 
 i SW10,($ZU(67,0,J)'=2) D NOJOB Q "" 
 Q $V(-1,J)
JobE1 S $ZT="JobE2" Q $V(-1,J)
JobE2 S $ZT="" D NOJOB Q ""
HEAD ;print header, first compute tab columns
 N ii
 s WID(5)=WIDDirsave
 K TAB F ii=1:1:10 S TAB(ii)=$G(TAB(ii-1))+$G(WID(ii-1))
 W !,"Process",?TAB(3),"Devices",?TAB(4)," KB"
 W ?TAB(5),"Namespace",?TAB(6),"Routine"
 W ?TAB(7),"  CPU,Glob",?TAB(8),"Pri",?TAB(9),"  UIC"
 W ?TAB(10),"Location"
 Q
Print(job,hasjob)  ;print one job's information
 N pm,dev,pdev,odev,par,dir,pro,glo,pri,uic,loc,ii,X,info
 i '$g(hasjob) n JOB D BldJob(job,.JOB) ;build the JOB(J) entry 
 Q:'$D(JOB(job,2))
 S pm=JOB(job,2),pdev=JOB(job,"P"),odev=JOB(job,"D")
 S par=JOB(job,4),dir=JOB(job,5),pro=JOB(job,6)
 S glo=JOB(job,7),pri=JOB(job,8),uic=JOB(job,9)
 S loc=JOB(job,10)
 ;
 I $L(pdev)'<WID(3) S odev=pdev_$E(",",odev]"")_odev,pdev="-"
 ;
 i (PAGES=1)&(($Y+$L(odev,",")+(job=SWJOB))>20) d prompt
 W !,$J($s(($zv["VMS"):$ZH(+job),1:job),6)_pm,?TAB(3),pdev_" "
 W ?TAB(4),$J(par,3)
 W ?TAB(5),dir_" "
 I pro]"" W:$X>TAB(6) ! W ?TAB(6),pro_" "
 W ?TAB(7)+5-$L($P(glo,",")),glo_" "
 W ?TAB(8),$J(pri,2)_" ",?TAB(9)+3-$L($P(uic,",")),uic
 W ?TAB(10) S ii=RM-$X W $S($L(loc)>ii:$E(loc,1,ii-1)_"*",1:loc)
 ;
 I odev]"" F ii=1:1:$L(odev,",") S dev=$P(odev,",",ii) I dev]"" DO
 . W !?TAB(3),dev
 I SW10,job=SWJOB W !?TAB(3),"*** Has Switch 10 Set ***"
 Q
ZV() ; Return system version
 Q $V($ZU(40,2,23)+1,-2,-$V($ZU(40,2,23),-2))
ZT(t) ; return formatted time string given 't' seconds
 N h,m,a S h=t\3600,m=$TR($J(t\60#60,2)," ",0),a=" am"
 S:h>11 a=" pm",h=h-12 S:'h h=12 Q ($J(h,2)_":"_m_a) ;hh:mm am
CC(str,rm)         ; Center a string within 'rm' margin
 Q $J(str,$L(str)+rm\2)
 ; Copied from ^%IS
CURRENT ; INTERNAL ENTRY TO SET PARAMETERS FOR CURRENT DEVICE
 N (MSYS,FF,SL,BS,RM,SUB,XY)
 S MSYS=$$MSYS() ;get platform type
 ;
SFF N ZFF,ZBS,%A,%E S %E=$G(^%IS($I,1)) D VTRMCK:%E=""
 S FF="#",SL=24,BS="*8",RM=80,SUB="",XY="",ZFF=$C(12),ZBS=$C(8,32,8)
 S %A=$P(%E,"^",3) I %A]"",$G(^%IS(0,"SUB",%A))]"" DO  ;
 . S SUB=%A,%A=^%IS(0,"SUB",SUB),FF=$P(%A,"^",2),RM=+%A,SL=$P(%A,"^",3)
 . S BS=$P(%A,"^",4),XY=$P(%A,"^",5),ZFF=$P(%A,"^",8),ZBS=$P(%A,"^",9)
 . I ZFF]"" S ZFF=$$VALUE(ZFF)
 . I ZBS]"" S ZBS=$$VALUE(ZBS)
 I $ZU(22,0,ZFF,ZBS) ;set the new value
 O $I:RM Q
VALUE(x) N X S $ZT="VALERR^"_$ZN X ("S X="_x) Q X
VALERR Q $G(X)
VTRMCK ;Check for virtual terminal, if $I is not in %IS table.
 I $$MSYS()="M/UX" DO  Q  ;unix default terminal type
 . ;no longer limited to /dev/tty or /dev/pt
 . S %X="TERM",%E=$G(^%IS(%X,1)) ;default terminal type
 ; If the tty is not in the %IS table, it's probably a network device.
 ; It should probably just be put in the table, but for now we will
 ; just do what M/VX does, in case anything out there depends on this.
 ;
 S %X="TERM" I $$UC($I)?1"VT".E,$D(^%IS("VT0:")) S %X="VT0:"
 E  I $$UC($I)?1"RTA".E,$D(^%IS("RT0:")) S %X="RT0:"
 E  I $$UC($I)?1"LTA".E,$D(^%IS("LT0:")) S %X="LT0:"
 E  I $$UC($I)?1"|LAT|".E,$D(^%IS("|LAT|")) s %X="|LAT|"
 E  I $$UC($I)?1"|TNT|".E,$D(^%IS("|TNT|")) s %X="|TNT|"
 E  I $$UC($I)?1"|TRM|".E,$D(^%IS("|TRM|")) s %X="|TRM|"
 S %E=$G(^%IS(%X,1)) Q  ;default terminal types
MSYS() Q $S(($zv["VMS"):"M/AV",($zv["Windows"):"M/WNT",($zv["UNIX"):"M/UX",1:"UNKNOWN") ;what platform is this?
UC(x) q $zcvt(x,"u")
 ; Copied from %MACHINE
JOBS() N X S X=$ZU(200,5) I $ZU(200,8)["(unlimited)" S X="unlimited"
 Q X
prompt ; ask for prompt when pagination in effect
 r !,!,"Press Q or q to quit, any other character to continue. ",ans#1:20
 I "Qq"'[$E(ans_"X") W # d HEAD q
 ZQ
 q
GFLS ; Display Free License Slot info
 N gflsflg S gflsflg=0 g gflscom
gfls() ; Return Free License Slot info
 N gflsflg S gflsflg=1
gflscom w !,"Please use Control Panel for license display"
 q
 ;
SHUTDOWN N MSYS,NSYS,NBKG,NINT,NCDS,NCOS,NCSP,NODB,NJOB,NOTH,pid1,pid2,maxpid,JOB,J
 S (NSYS,NJOB,NBKG,NINT,NCDS,NCOS,NCSP,NODB,NOTH)=0
 d BUILD ; build JOB(i,j)=pid
 s pid1="",pid2=""
 f  s pid1=$o(JOB(pid1)) q:pid1=""  d
 . f  s pid2=$o(JOB(pid1,pid2)) q:pid2=""  d Count(JOB(pid1,pid2))                 
 S J=$$ZV,J=$e(J,1,$f(J,"-",$f(J,")"))-1)
 ;w #
 ;W !,$$CC("Cache Shutdown Status: "_$$ZT($P($H,",",2))_" "_$ZDATE($H,2,,4),80)
 ;W ! ;
 ;
 S TAB=$C(9),R=""
 S R(0)=$ZU(110)
 S R(1)=$ZD($H,4)
 S R(2)=$ZT($P($H,",",2),1)
 S R(3)=NINT
 S R(4)=NBKG
 S R(5)=NCDS
 S R(6)=NCOS
 S R(7)=NCSP
 S R(8)=NODB
 S R(9)=NSYS
 F i=0:1:9 S R=R_R(i)_TAB
 Q
 ;
BEGIN S TAB=$C(9),R=""
 S R(0)="System"
 S R(1)="Datum"
 S R(2)="Tijd"
 S R(3)="interactive jobs (Telnet/Lat)"
 s R(4)="background jobs (from job command)"
 S R(5)="Cache Direct server jobs"
 S R(6)="Cache Objects server jobs"
 S R(7)="CSP server jobs"
 S R(8)="ODBC server jobs"
 S R(9)="system jobs"
 F i=0:1:9 S R=R_R(i)_TAB
 Q
 ;
LOG(X) ;Log jobs into logfile in directory X;
 N K S K=$$INFO^cQ14,K=$P(K,"\",1,$L(K,"\")-1),X=$TR($G(X,K),"/","\") I $E(X,$L(X))="\" S X=$E(X,1,$L(X)-1)
 S file=X_"\joblog.txt",ER=$$TST^cA710(file)
 I ER S ER=$$OA^cA710(file) Q:ER  D BEGIN S ER=$$WF^cA710(file,R_$C(13,10)),ER=$$CF^cA710(file)
 D SHUTDOWN S ER=$$OA^cA710(file) Q:ER  S ER=$$WF^cA710(file,R_$C(13,10))
 S ER=$$CF^cA710(file)
 Q
 ;
BG D LOW^%PRIO,LOG,LOG^cQCTK1 Q
 ;
Count(pid)         N jtype S jtype=$ZU(67,10,pid)
 I jtype#2 Q:pid=$j  S NINT=NINT+1
 E  I jtype=2 S NBKG=NBKG+1
 E  I jtype=96 S NCDS=NCDS+1
 E  I jtype=100 S NCOS=NCOS+1
 E  I jtype=104 S NCSP=NCSP+1
 E  I jtype=108 S NODB=NODB+1
 E  I jtype>3,jtype'=48 S NSYS=NSYS+1
 E  S NOTH=NOTH+1
 Q
 ;
ZZ ; 24.08.01 -  9 u 19 * Cache-r3.1.8