Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XUSESIG1

XUSESIG1.m

Go to the documentation of this file.
  1. XUSESIG1 ;SF/RWF - More E-Sig functions. ;10/10/96 09:42
  1. ;;8.0;KERNEL;**14,55**;Jul 10, 1995
  1. W !,"NO ENTRY FROM THE TOP." Q
  1. ;
  1. ESBLOCK(IEN) ;EF. Return the E-SIG block data.
  1. N X S:'$D(IEN) IEN=DUZ
  1. S X=$G(^VA(200,IEN,20)) Q:$P(X,U,2)="" ""
  1. Q $P(X,U,2)_U_$P($G(^VA(200,IEN,3.1)),U,6)_U_$P(X,U,3)_U_$$NOW^XLFDT()
  1. ;
  1. CHKSUM(ROOT,FLAG) ;EF. Retuern a CHECKSUM of a sub-tree.
  1. ;ROOT is a $NA value, FLAG un-used at this time.
  1. N SUM,IX,IX2,XU1,Y
  1. Q:$D(@ROOT)=0 0
  1. A ;Type A
  1. S SUM=0,IX=0,XU1=ROOT,ROOT=$E(ROOT,1,$L(ROOT)-1)
  1. F S Y=$G(@XU1) D S XU1=$Q(@XU1) Q:XU1'[ROOT
  1. . F IX2=1:1:$L(Y) S IX=IX+1,SUM=($A(Y,IX2)-31*IX)+SUM
  1. Q SUM_"A"
  1. EN(CHKSUM,ESBLK) ;EF. Return encoded ESBLOCK.
  1. ;Get the ESBLOCK first.
  1. N X,X1,X2 I '$D(ESBLK) S ESBLK=$$ESBLOCK()
  1. S X=ESBLK,X1=+CHKSUM,X2=1 D EN^XUSHSHP
  1. Q X
  1. DE(CHKSUM,ESBLK) ;EF. Return decoded ESBLOCK
  1. N X,X1,X2
  1. S X=ESBLK,X1=+CHKSUM,X2=1 D DE^XUSHSHP
  1. Q X
  1. CMP(CHKSUM,ROOT) ;EF. Compair. Return 1 for match, 0 no match.
  1. ;ROOT is a $NA value.
  1. N FLAG,NEWSUM
  1. S FLAG=$E(CHKSUM,$L(CHKSUM)),NEWSUM=$$CHKSUM(ROOT,FLAG)
  1. Q NEWSUM=CHKSUM