Routine: ZOSVKSOS

%ZOSVKSS ;OAK/KAK - Automatic INTEGRIT Routine (cont.) (Cache) ;5/9/07  10:44

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

 ; Version for Cache

RESTART ;-- called by routine C+6^%ZOSVKSE

 ;-- code from routine CHECKPNT

 K SUB,C

 N B,D,E,FLAG,LE,LL,LN,LNP,TL1

 S (ERR,FLAG,NP,NB,LSNP,LNB)=0

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

 V BLK

 S A=$V(2,-5)

V A

 S A=",,"_($V(2043,0,1)*16777216+A)_","

 S X="ERR^%ZOSVKSS",@^%ZOSF("TRAP")

CHK Q:+$G(^XTMP("KMPS","STOP"))

 V BLK

 S LINK=$V(2040,0,"3O")

 S A=$V($P(A,",",3),-7,$P(A,",",4),400)

 S TL=$P(A,",",3)\16777216

 S NP=NP+A,NB=NB+$P(A,",",2)

 ; big global data blocks (type 12)

 I FLAG=0,(TL=8)!(TL=12) S FLAG=1 V BLK S B=$V(2,-5) D

 .F  Q:'B  V B S B=$V(2040,0,"3O") F N=1:1 Q:$V(N-1*2+1,-6)=""  S X=$V(N-1*2+2,-6) S:$A(X)=3 LNB=LNB+($A(X,2)*2048)+$ZWA(X,3),LSNP=LSNP+$A(X,2)+1

CHKB I LINK S BLK=LINK G CHK

 ; ragged edge

 I $P(A,",",3)#16777216,$P(A,",",3)\16777216-16 G ER6

END S X="",@^%ZOSF("TRAP")

 ; W "# ptrs = "_NP

 S LNBLK=+$G(LNBLK)

 ; na% => cannot calculate the percent efficiency of first pointer block

 I CUR=1 S ^XTMP("KMPS",KMPSSITE,NUM,$P(GLO,"^"),KMPSZU,KMPSDT,CUR)="1^na%^Pointer"

 I (NBLK+LNBLK) D

 .; W ", # blks = "_(NBLK+LNBLK)_", # ptrs/blk = "_(NP\(NBLK+LNBLK))

 .; W ", eff = "_(((NBYTE+LNBYTE)*100)\((2036*NBLK)+(2048*LNBLK)))_"%"

 .S ^XTMP("KMPS",KMPSSITE,NUM,$P(GLO,"^"),KMPSZU,KMPSDT,CUR)=(NBLK+LNBLK)_"^"_(((NBYTE+LNBYTE)*100)\((2036*NBLK)+(2048*LNBLK)))_"%^"_$S(CUR=(LEV-1):"Bottom p",1:"P")_"ointer"

 S TL=$P(A,",",3)\16777216

 ; m-code blocks (type 16) - do not store into ^XTMP("KMPS")

 ; I TL=16 W "Routine level:  # rtns = "_NP

 ; global data blocks (type 8) and big global data blocks (type 12)

 I TL=8!(TL=12) D

 .; I NP W "Data level:  # blks = "_NP_", eff = " W:NP (NB*100\(2036*NP))_"%"

 .I NP S ^XTMP("KMPS",KMPSSITE,NUM,$P(GLO,"^"),KMPSZU,KMPSDT,"D")=NP_"^"_$S(NP:NB*100\(2036*NP),1:"")_"%^Data"

 .; I LSNP W "Long String level: # blks = "_LSNP_",eff = " W:LSNP (LNB*100\(2048*LSNP))_"%"

 .I LSNP S ^XTMP("KMPS",KMPSSITE,NUM,$P(GLO,"^"),KMPSZU,KMPSDT,"L")=LSNP_"^"_$S(LSNP:LNB*100\(2048*LSNP),1:"")_"%^LongString"

 S NBLK=NP,LNBLK=LSNP,NBYTE=NB,LNBYTE=LNB

 ;-- end code from routine CHECKPNT

ERR ;-- code from routine CHECK0

 S (LE,LL,ERR)=0

 ; global is too large for INTEGRIT - use ^DIAG to check this global

 I $ZE?1"<MAXARRAY>".E S ERR=1 Q

 S D=BLK,LN=$P(A,",",4),TL=$P(A,",",3)\16777216

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

 V BLK

 D CHECK1

 Q:ERR

K B

 F I=1:2:C-2 S B=C(I)-1#400,B(C(I)-B,B)=""

 D CM(1)

 Q:ERR

K B

 F I=1:2:C-2 I C(I,1) D MB

 D CM(249)

 Q:ERR

K B

 S NP=C\2+NP,NB=NB+LE,A=",,"_(TL*16777216+LL)_","_LN

K C

 S X="ERR^%ZOSVKSS",@^%ZOSF("TRAP")

 G CHKB

ERROR I $ZE?1"<DISK".E!($ZE?1"<DATA".E) G ERDK

 G MISC

CM(X) S D=""

 F I=1:1 S D=$O(B(D)) Q:D=""  V D D ER15:$V(2038,0,"4O")-1431699455!($V(2042,0,"4O")=0) Q:ERR  S B="" F J=1:1 S B=$O(B(D,B)) Q:B=""  I $V(B,0)'=X,$V(B,0)'=255 D ER5

MB N A,X,L,BL,J,K,R

 V C(I)

 F J=1:2 Q:$V(J,-6)=""  S X=$V(J+1,-6) I $E(X)=3 D

 .S N=$A(X,2),A=4,L=A+((N+1)*3) I L'=$L(X) D ER18 Q

 .S R=$A(X,4)*256+$A(X,3) I (R<1)!(R>2048) D ER19

 .F K=0:1:N S BL=(((($A(X,A+3)*256)+$A(X,A+2))*256)+$A(X,A+1)),A=A+3 S B=BL-1#400 I $D(B(BL-B,B)) D ER20 S B(BL-B,B)=C(I)_","_J_","_K

 ;-- end code from routine CHECK0

CHECK1 ;-- code from routine CHECK1

 F C=1:2 Q:$V(C,-5)=""  S SUB(C)=$V(C,-5)

 F I=1:2:C-2 D

 .S C(I)=$V(I+1,-6),C(I,1)=C(I)\8388608#2,C(I)=C(I)#8388608

 .I C(I)=BLK G ER10

 I $P(A,",",3)#16777216-C(1),$P(A,",",3)\16777216-16 G ER3

 F E=1:2:C-2 S D=C(E) V D D CH Q:ERR

 I TL=16,LINK S D=LINK V D S LL=$V(2,-5)

CH I $V(0,0)#256 G ER7

 S TL1=$V(2043,0,1)

 I (TL=8)!(TL=12) D

 .I 'C(E,1),TL1'=8 G ER16

 .I C(E,1),TL1'=12 G ER17

 I (TL-8),(TL-12),$V(2043,0,1)-TL G ER12

 S LE=LE+$V(2046,0,2)

 I $V(1,-5)'=SUB(E) G ER8

 Q:TL=16

 S LL=$V(2040,0,"3O") I E+2<C,LL-C(E+2) G ER9

 I $V(1,-6)']LN G ER1

 S LN=$V(-1,-6),LNP=$V(-1,-5)

 ;-- end code from routine CHECK1

 ;-- code from routine CHECKERR

ER1 ; error: the first node in block D is $V(1,-5) and it should collate after the previous block's last node, which was LNP

 S KMPSERR4="ER1",ERR=1

ER3 ; error: pointer block BLK has a first pointer of C(1) [ The node is SUB(1) ] but the link from the previous lower level block is $P(A,",",3)#16777216

 S KMPSERR4="ER3",ERR=1

ER5 ; block B+D, which is pointed to by block BLK appears to be available in map block D - checking of this global will continue

 S KMPSERR4="ER5"

 I '$V(B,0) Q

 ; block B+D, which is pointed to by block BLK has code $V(B,0) in the map block D whereas code X was expected - checking of this global will continue

ER6 ; error: pointer block BLK should have had a right link

 ; V BLK F I=1:2 Q:$V(I,-6)=""

 ; according to the lower level block $V(I-1,-5), which had a link to block $P(A,",",3)#16777216

 S KMPSERR4="ER6",ERR=1

ER7 ; error: the 1st byte of block D should have been zero - the pointer block was BLK

 S KMPSERR4="ER7",ERR=1

ER8 ; error: the lower block's first node didn't match the pointer node - node E+1\2 in pointer block BLK was: SUB(E) - the 1st node in the lower level block D was: $V(1,-5)

 S KMPSERR4="ER8",ERR=1

ER9 ; error: the link in block D is LL although the pointer block BLK specifies that C(E+2) should be the next block

 S KMPSERR4="ER9",ERR=1

ER10 ; error: node I+1\2 in block BLK points to itself - the node is: SUB(I)

 S KMPSERR4="ER10",ERR=1

ER12 ; error: block D, which is pointed to by pointer block BLK has a block type of $V(2043,0,1) whereas a block type of TL was expected

 S KMPSERR4="ER12",ERR=1

ER15 ; error: map block D does not have a correct map label - the pointer block was BLK

 S KMPSERR4="ER15",ERR=1

ER16 ; block D, which is pointed to by pointer block BLK has a block type of $V(2043,0,1) whereas a block type of 8 was expected since the pointer block say big data nodes are not present

 ; checking of this global will continue if $V(2043,0,1)=12

 I $V(2043,0,1)=12 Q

 ; else error

 S KMPSERR="ER16",ERR=1

ER17 ; block D, which is pointed to by pointer block BLK has a block type of $V(2043,0,1),whereas a block type of 12 was expected since the pointer block says big data nodes are present

 ; checking of this global will continue if $V(2043,0,1)=8

 I $V(2043,0,1)=8 Q

 ; else error

 S KMPSERR="ER17",ERR=1

ER18 ; node J+1\2 in big data block C(I), which is pointed to by block BLK says number of data blocks is  N, but length of node is $L(X) rather than L

 ; this big string node will not be checked - checking of this global will continue

ER19 ; node J+1\2 in big data block C(I), which is pointed to by block BLK says it has R bytes in last block, which is illegal - checking of this global will continue

ER20 ; node J+1\2 in big data block C(I), which is pointed to by block BLK has data block BL which is also used as data block $P(B(BL-B,B),",",3) in node $P(B(BL-B,B),",",2)+1\2 of block $P(B(BL-B,B),",",1)

 ; checking of this global will continue

ERDK ; if D-BL error in lower block D - pointer block is BLK

 ; else error in pointer block D - last node in prev pntr block was LNP

 S KMPSERR="ERDK",ERR=1

MISC ; misc error

 S KMPSERR="MISC",ERR=1

ZOSVKSOS.m