XUSESIG1.m

XUSESIG1 ;SF/RWF - More E-Sig functions. ;10/10/96  09:42 [ 04/02/2003   8:29 AM ]

 ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003

 ;;8.0;KERNEL;**14**;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

XUSESIG1  ;SF/RWF - More E-Sig functions. ;10/10/96  09:42 [ 04/02/2003   8:29 AM ]

 +1       ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003

 +2       ;;8.0;KERNEL;**14**;Jul 10, 1995

 +3        WRITE !,"NO ENTRY FROM THE TOP."

           QUIT 

 +4       ;

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