XPDRSUM.m

XPDRSUM ;SFISC/RWF - Routine checksum utilities ; 13 Oct 95 11:21 [ 04/02/2003   8:29 AM ]

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

 ;;8.0;KERNEL;**10**;Jul 10, 1995

 Q

SUMA(GLO) ;This tag builds the old RSUM value

 ;Call with a reference to a global that has the routine

 N Y,%,%1,%2,%3 S Y=0

 F %=1,3:1 S %1=$G(@GLO@(%,0)),%3=$F(%1," ") Q:'%3  S %3=$S($E(%1,%3)'=";":$L(%1),$E(%1,%3+1)=";":$L(%1),1:%3-2) F %2=1:1:%3 S Y=$A(%1,%2)*%2+Y

 Q Y

SUMB(GLO) ;This tag builds the new RSUM value

 ;Call with a reference to a global that has the routine

 N Y,%,%1,%2,%3 S Y=0

 F %=1,3:1 S %1=$G(@GLO@(%,0)),%3=$F(%1," ") Q:'%3  S %3=$S($E(%1,%3)'=";":$L(%1),$E(%1,%3+1)=";":$L(%1),1:%3-2) F %2=1:1:%3 S Y=$A(%1,%2)*(%2+%)+Y

 Q Y

SUMC(GLO) ;This tag builds the new checksum for global

 ;Call with a reference to a global

 N Y,%,%1,%2,%3,%4,%5

 S Y=0,%=$NA(@GLO),%1=$E(%,1,$L(%)-1),%2=$L(%1)

 F %5=1:1 S GLO=$Q(@GLO) Q:GLO=""!($E(GLO,1,%2)'=%1)  S %3=@GLO F %4=1:1:$L(%3) S Y=$A(%3,%4)*(%4+%5)+Y

 Q Y

XPDRSUM   ;SFISC/RWF - Routine checksum utilities ; 13 Oct 95 11:21 [ 04/02/2003   8:29 AM ]

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

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

 +3        QUIT 

SUMA(GLO) ;This tag builds the old RSUM value

 +1       ;Call with a reference to a global that has the routine

 +2        NEW Y,%,%1,%2,%3

           SET Y=0

 +3        FOR %=1,3:1

               SET %1=$GET(@GLO@(%,0))

               SET %3=$FIND(%1," ")

               IF '%3

                   QUIT 

               SET %3=$SELECT($EXTRACT(%1,%3)'=";":$LENGTH(%1),$EXTRACT(%1,%3+1)=";":$LENGTH(%1),1:%3-2)

               FOR %2=1:1:%3

                   SET Y=$ASCII(%1,%2)*%2+Y

 +4        QUIT Y

SUMB(GLO) ;This tag builds the new RSUM value

 +1       ;Call with a reference to a global that has the routine

 +2        NEW Y,%,%1,%2,%3

           SET Y=0

 +3        FOR %=1,3:1

               SET %1=$GET(@GLO@(%,0))

               SET %3=$FIND(%1," ")

               IF '%3

                   QUIT 

               SET %3=$SELECT($EXTRACT(%1,%3)'=";":$LENGTH(%1),$EXTRACT(%1,%3+1)=";":$LENGTH(%1),1:%3-2)

               FOR %2=1:1:%3

                   SET Y=$ASCII(%1,%2)*(%2+%)+Y

 +4        QUIT Y

SUMC(GLO) ;This tag builds the new checksum for global

 +1       ;Call with a reference to a global

 +2        NEW Y,%,%1,%2,%3,%4,%5

 +3        SET Y=0

           SET %=$NAME(@GLO)

           SET %1=$EXTRACT(%,1,$LENGTH(%)-1)

           SET %2=$LENGTH(%1)

 +4        FOR %5=1:1

               SET GLO=$QUERY(@GLO)

               IF GLO=""!($EXTRACT(GLO,1,%2)'=%1)

                   QUIT 

               SET %3=@GLO

               FOR %4=1:1:$LENGTH(%3)

                   SET Y=$ASCII(%3,%4)*(%4+%5)+Y

 +5        QUIT Y