- XPDRSUM ;SFISC/RWF - Routine checksum utilities ; 13 Oct 95 11:21
- ;;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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXPDRSUM 944 printed Feb 18, 2025@23:30:53 Page 2
- XPDRSUM ;SFISC/RWF - Routine checksum utilities ; 13 Oct 95 11:21
- +1 ;;8.0;KERNEL;**10**;Jul 10, 1995
- +2 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