source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUSESIG1.m@ 1801

Last change on this file since 1801 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.0 KB
RevLine 
[613]1XUSESIG1 ;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 ;
5ESBLOCK(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 ;
10CHKSUM(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
14A ;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"
19EN(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
24DE(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
28CMP(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
Note: See TracBrowser for help on using the repository browser.