[613] | 1 | XUSESIG1 ;SF/RWF - More E-Sig functions. ;10/10/96 09:42
|
---|
| 2 | ;;8.0;KERNEL;**14,55**;Jul 10, 1995
|
---|
| 3 | W !,"NO ENTRY FROM THE TOP." Q
|
---|
| 4 | ;
|
---|
| 5 | ESBLOCK(IEN) ;EF. Return the E-SIG block data.
|
---|
| 6 | N X S:'$D(IEN) IEN=DUZ
|
---|
| 7 | S X=$G(^VA(200,IEN,20)) Q:$P(X,U,2)="" ""
|
---|
| 8 | Q $P(X,U,2)_U_$P($G(^VA(200,IEN,3.1)),U,6)_U_$P(X,U,3)_U_$$NOW^XLFDT()
|
---|
| 9 | ;
|
---|
| 10 | CHKSUM(ROOT,FLAG) ;EF. Retuern a CHECKSUM of a sub-tree.
|
---|
| 11 | ;ROOT is a $NA value, FLAG un-used at this time.
|
---|
| 12 | N SUM,IX,IX2,XU1,Y
|
---|
| 13 | Q:$D(@ROOT)=0 0
|
---|
| 14 | A ;Type A
|
---|
| 15 | S SUM=0,IX=0,XU1=ROOT,ROOT=$E(ROOT,1,$L(ROOT)-1)
|
---|
| 16 | F S Y=$G(@XU1) D S XU1=$Q(@XU1) Q:XU1'[ROOT
|
---|
| 17 | . F IX2=1:1:$L(Y) S IX=IX+1,SUM=($A(Y,IX2)-31*IX)+SUM
|
---|
| 18 | Q SUM_"A"
|
---|
| 19 | EN(CHKSUM,ESBLK) ;EF. Return encoded ESBLOCK.
|
---|
| 20 | ;Get the ESBLOCK first.
|
---|
| 21 | N X,X1,X2 I '$D(ESBLK) S ESBLK=$$ESBLOCK()
|
---|
| 22 | S X=ESBLK,X1=+CHKSUM,X2=1 D EN^XUSHSHP
|
---|
| 23 | Q X
|
---|
| 24 | DE(CHKSUM,ESBLK) ;EF. Return decoded ESBLOCK
|
---|
| 25 | N X,X1,X2
|
---|
| 26 | S X=ESBLK,X1=+CHKSUM,X2=1 D DE^XUSHSHP
|
---|
| 27 | Q X
|
---|
| 28 | CMP(CHKSUM,ROOT) ;EF. Compair. Return 1 for match, 0 no match.
|
---|
| 29 | ;ROOT is a $NA value.
|
---|
| 30 | N FLAG,NEWSUM
|
---|
| 31 | S FLAG=$E(CHKSUM,$L(CHKSUM)),NEWSUM=$$CHKSUM(ROOT,FLAG)
|
---|
| 32 | Q NEWSUM=CHKSUM
|
---|