- 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 Feb 18, 2025@23:38:53 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