Routine: ZOSVKSOE

%ZOSVKSE ;OAK/KAK/RAK/JML - ZOSVKSOE - Global data (Cache) ;9/1/2015

 ;;8.0;KERNEL;**90,94,197,268,456,568**;Jul 26, 2004;Build 48

START(KMPSTEMP) ;-- called by routine CVMS+2^KMPSGE/CWINNT+1^KMPSGE in VAH

 ;------------------------------------------------------------------------

 ; KMPSTEMP... ^ piece 1: SiteNumber

 ;               piece 2: SessionNumber

 ;               piece 3: XTMP Global Location

 ;               piece 4: Current Date/Time

 ;               piece 5: Production UCI

 ;               piece 6: Volume set

 ;-------------------------------------------------------------------------

 Q:$G(KMPSTEMP)=""

 N KMPSDT,KMPSERR,KMPSERR1,KMPSERR2,KMPSERR3,KMPSERR4

 N KMPSLOC,KMPSPROD,KMPSSITE,KMPSVOL,KMPSZU,NUM,X,VERSION,ZV

 I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERROR^%ZOSVKSE"

 E  S X="ERROR^%ZOSVKSE",@^%ZOSF("TRAP")

 S U="^",KMPSSITE=$P(KMPSTEMP,U),NUM=$P(KMPSTEMP,U,2),KMPSLOC=$P(KMPSTEMP,U,3)

 S KMPSDT=$P(KMPSTEMP,U,4),KMPSPROD=$P(KMPSTEMP,U,5),KMPSVOL=$P(KMPSTEMP,U,6)

 K KMPSTEMP

 S KMPSZU=$ZNSPACE_","_KMPSVOL

 S ^XTMP("KMPS","START",KMPSVOL,NUM)=$H

 S VERSION=$$VERSION^%ZOSV ; IA# 10097

 I VERSION<2008 D DONE Q

 ; version

 S ZV=$P($$VERSION^%ZOSV(1),"/")  ; IA# 10097

 ; check for accepted operating system

 Q:'$$OSOKAY(ZV)

 D ALLOS

DONE ; normal exit

 K ^XTMP("KMPS","START",KMPSVOL)

ALLOS ;-- entry point now for all OS's

 N GLOARRAY,RC

 ; set up GLOARRAY array indexed by global name

 S RC=$$GetDirGlobals^%SYS.DATABASE(KMPSVOL,.GLOARRAY)

 I ('+RC) D ERRVMS G ERROR

 I '$D(GLOARRAY) S ^XTMP("KMPS",KMPSSITE,NUM," NO GLOBALS ",KMPSVOL)="" Q

 D ALLGLO

ALLGLO ;- collect global info

 N COLLATE,DATASIZE,FBLK,GLO,GLOINFO,GLOTOTBLKS,GLOPNTBLKS,GLOTOTBYTES

 N GLOPNTBYTES,GLOBIGBLKS,GLOBIGBYTES,GLOBIGSTRINGS,GRWBLK

 N I,INFO,JRNL,LEV,MSGLIST,PROT,PROTECT,PROTINFO,RC,TPTRBLK,TRY

 S GLO="",RC=1

 S PROT(0)="N",PROT(1)="R",PROT(2)="RW",PROT(3)="RWD"

 F  S GLO=$O(GLOARRAY(GLO)) Q:GLO=""!+$G(^XTMP("KMPS","STOP"))  D  Q:+$G(^XTMP("KMPS","STOP"))!('+RC)

.;

 .S (COLLATE,FBLK,GRWBLK,JRNL,PROTECT,TPTRBLK)=""

 .S PROTINFO="^^^"

.;

 .; global info - '^' delimited

 .;         piece 1: first block

 .;         piece 2: jrnl^collate

 .;         piece 3: bits(blank)

 .;         piece 4: growth area block

 .;         piece 5: protection:system(blank)

 .;         piece 6: protection:world

 .;         piece 7: group^owner

 .;         piece 8: network^top (first) pointer block

 .S GLOINFO=FBLK_U_JRNL_U_COLLATE_"^^"_GRWBLK_"^^"_PROTINFO_U_TPTRBLK

.;

 .S ^XTMP("KMPS",KMPSSITE,NUM,KMPSDT,GLO,KMPSZU)=GLOINFO

.;

 .; get global total blocks.... GLOTOTBLKS

 .;     global pointer blocks.. GLOPNTBLKS

 .;     global total bytes..... GLOTOTBYTES

 .;     global pointer bytes... GLOPNTBYTE

 .;     global big blocks...... GLOBIGBLKS

 .;     global big bytes....... GLOBIGBYTES

 .;     global big strings..... GLOBIGSTRINGS

 .;     data size.............. DATASIZE

 .; will stop if there are more than 999 errors with this global

 .S RC=$$CheckGlobalIntegrity^%SYS.DATABASE(KMPSVOL,GLO,999,.GLOTOTBLKS,.GLOPNTBLKS,.GLOTOTBYTES,.GLOPNTBYTES,.GLOBIGBLKS,.GLOBIGBYTES,.GLOBIGSTRINGS,.DATASIZE)

.;

 .K MSGLIST

 .D DecomposeStatus^%SYS.DATABASE(RC,.MSGLIST,0,"")

.;

 .S (LEV,RC)=1

 .F I=1:1:MSGLIST D

 ..S INFO=MSGLIST(I),BLK=$$BLK(INFO),EFF=$$EFF(INFO)

..;

 ..; more than 999 errors reported

 ..I INFO["***Further checking of this global is aborted." S RC=0 D ERRVMS Q

..;

 ..I ($P(INFO,":")["Top Pointer Level")!($P(INFO,":")["Top/Bottom Pnt Level") D  Q

 ...S ^XTMP("KMPS",KMPSSITE,NUM,GLO,KMPSZU,KMPSDT,1)=BLK_"^"_EFF_"%^Pointer"

 ..I $P(INFO,":")["Pointer Level" D  Q

 ...S LEV=LEV+1,^XTMP("KMPS",KMPSSITE,NUM,GLO,KMPSZU,KMPSDT,LEV)=BLK_"^"_EFF_"%^Pointer"

 ..I $P(INFO,":")["Bottom Pointer Level" D  Q

 ...S LEV=LEV+1,^XTMP("KMPS",KMPSSITE,NUM,GLO,KMPSZU,KMPSDT,LEV)=BLK_"^"_EFF_"%^Bottom pointer"

 ..I $P(INFO,":")["Data Level" D  Q

 ...S ^XTMP("KMPS",KMPSSITE,NUM,GLO,KMPSZU,KMPSDT,"D")=BLK_"^"_EFF_"%^Data"

 ..I $P(INFO,":")["Big Strings" D  Q

 ...S ^XTMP("KMPS",KMPSSITE,NUM,GLO,KMPSZU,KMPSDT,"L")=BLK_"^"_EFF_"%^LongString"

 I ('+RC) G ERROR

BLK(STRNG)      ;-- function to obtain number of blocks from input string

 N BLK

 Q:$G(STRNG)="" ""

 S BLK=$$NOCOMMA($P($P(STRNG,"=",2)," "))

 Q BLK

EFF(STRNG)      ;-- function to obtain efficiency from input string

 N EFF

 Q:$G(STRNG)="" ""

 S EFF=$P($P(STRNG,"%"),"(",2)

 Q EFF

NOCOMMA(IN)     ;-- strip comma from input string

 Q $TR(IN,",","")

ERRVMS ;

 S $ZE="<ERROR>UC1VMS+6^%ZOSVKSE"

 I '+RC S KMPSERR1="ERROR: Cannot find global names for "_KMPSVOL

OSOKAY(ZV) ;-- extrinsic function - operating system ok for SAGG

 ;---------------------------------------------------------------

 ; ZV - Operating system

 ; Return: 1 - os is okay for sagg

 ;         "" - os not okay

 ;---------------------------------------------------------------

 Q:$G(ZV)="" ""

 Q:ZV="Cache for OpenVMS" 1

 Q:$E(ZV,1,14)="Cache for UNIX" 1

 Q:$E(ZV,1,17)="Cache for Windows" 1

 Q ""

ERROR ; ERROR - Tell all SAGG jobs to STOP collection

 C 63

 S KMPSERR="Error encountered while running SAGG collection routine for volume set "_$G(KMPSVOL)

 S KMPSERR2="Last global reference = "_$ZR

 S KMPSERR3="Error code = "_$$EC^%ZOSV ; IA# 10097

 I $D(KMPSERR4) S KMPSERR4="For more information, read text at line tag "_KMPSERR4_" in routine ^%ZOSVKSS"

 S ^XTMP("KMPS","ERROR",KMPSVOL)="",^XTMP("KMPS","STOP")=1

 K ^XTMP("KMPS","START",KMPSVOL)

 D ^%ZTER,UNWIND^%ZTER

ZOSVKSOE.m