XUSESIG1 ;SF/RWF - More E-Sig functions. ;10/10/96 09:42
;;8.0;KERNEL;**14,55**;Jul 10, 1995
W !,"NO ENTRY FROM THE TOP." Q
;
ESBLOCK(IEN) ;EF. Return the E-SIG block data.
N X S:'$D(IEN) IEN=DUZ
S X=$G(^VA(200,IEN,20)) Q:$P(X,U,2)="" ""
Q $P(X,U,2)_U_$P($G(^VA(200,IEN,3.1)),U,6)_U_$P(X,U,3)_U_$$NOW^XLFDT()
;
CHKSUM(ROOT,FLAG) ;EF. Retuern a CHECKSUM of a sub-tree.
;ROOT is a $NA value, FLAG un-used at this time.
N SUM,IX,IX2,XU1,Y
Q:$D(@ROOT)=0 0
A ;Type A
S SUM=0,IX=0,XU1=ROOT,ROOT=$E(ROOT,1,$L(ROOT)-1)
F S Y=$G(@XU1) D S XU1=$Q(@XU1) Q:XU1'[ROOT
. F IX2=1:1:$L(Y) S IX=IX+1,SUM=($A(Y,IX2)-31*IX)+SUM
Q SUM_"A"
EN(CHKSUM,ESBLK) ;EF. Return encoded ESBLOCK.
;Get the ESBLOCK first.
N X,X1,X2 I '$D(ESBLK) S ESBLK=$$ESBLOCK()
S X=ESBLK,X1=+CHKSUM,X2=1 D EN^XUSHSHP
Q X
DE(CHKSUM,ESBLK) ;EF. Return decoded ESBLOCK
N X,X1,X2
S X=ESBLK,X1=+CHKSUM,X2=1 D DE^XUSHSHP
Q X
CMP(CHKSUM,ROOT) ;EF. Compair. Return 1 for match, 0 no match.
;ROOT is a $NA value.
N FLAG,NEWSUM
S FLAG=$E(CHKSUM,$L(CHKSUM)),NEWSUM=$$CHKSUM(ROOT,FLAG)
Q NEWSUM=CHKSUM
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUSESIG1 1104 printed Dec 13, 2024@02:12:27 Page 2
XUSESIG1 ;SF/RWF - More E-Sig functions. ;10/10/96 09:42
+1 ;;8.0;KERNEL;**14,55**;Jul 10, 1995
+2 WRITE !,"NO ENTRY FROM THE TOP."
QUIT
+3 ;
ESBLOCK(IEN) ;EF. Return the E-SIG block data.
+1 NEW X
if '$DATA(IEN)
SET IEN=DUZ
+2 SET X=$GET(^VA(200,IEN,20))
if $PIECE(X,U,2)=""
QUIT ""
+3 QUIT $PIECE(X,U,2)_U_$PIECE($GET(^VA(200,IEN,3.1)),U,6)_U_$PIECE(X,U,3)_U_$$NOW^XLFDT()
+4 ;
CHKSUM(ROOT,FLAG) ;EF. Retuern a CHECKSUM of a sub-tree.
+1 ;ROOT is a $NA value, FLAG un-used at this time.
+2 NEW SUM,IX,IX2,XU1,Y
+3 if $DATA(@ROOT)=0
QUIT 0
A ;Type A
+1 SET SUM=0
SET IX=0
SET XU1=ROOT
SET ROOT=$EXTRACT(ROOT,1,$LENGTH(ROOT)-1)
+2 FOR
SET Y=$GET(@XU1)
Begin DoDot:1
+3 FOR IX2=1:1:$LENGTH(Y)
SET IX=IX+1
SET SUM=($ASCII(Y,IX2)-31*IX)+SUM
End DoDot:1
SET XU1=$QUERY(@XU1)
if XU1'[ROOT
QUIT
+4 QUIT SUM_"A"
EN(CHKSUM,ESBLK) ;EF. Return encoded ESBLOCK.
+1 ;Get the ESBLOCK first.
+2 NEW X,X1,X2
IF '$DATA(ESBLK)
SET ESBLK=$$ESBLOCK()
+3 SET X=ESBLK
SET X1=+CHKSUM
SET X2=1
DO EN^XUSHSHP
+4 QUIT X
DE(CHKSUM,ESBLK) ;EF. Return decoded ESBLOCK
+1 NEW X,X1,X2
+2 SET X=ESBLK
SET X1=+CHKSUM
SET X2=1
DO DE^XUSHSHP
+3 QUIT X
CMP(CHKSUM,ROOT) ;EF. Compair. Return 1 for match, 0 no match.
+1 ;ROOT is a $NA value.
+2 NEW FLAG,NEWSUM
+3 SET FLAG=$EXTRACT(CHKSUM,$LENGTH(CHKSUM))
SET NEWSUM=$$CHKSUM(ROOT,FLAG)
+4 QUIT NEWSUM=CHKSUM
