| 1 | XLFUTL ;SFISC/RWF - Library Function, Check digit ;6/29/94 14:04
|
|---|
| 2 | ;;8.0;KERNEL;;Jul 10, 1995
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | CCD(%X) ; Compute check digit and append to number
|
|---|
| 6 | ;see Taylor report Computerworld 1975
|
|---|
| 7 | ; X= integer, Return X with check digit
|
|---|
| 8 | ;
|
|---|
| 9 | N %I,%N,%D,%S S %S=0,%D=1,%X=$G(%X) S:+%X'=%X (%X,%S)=""
|
|---|
| 10 | F %I=$L(%X):-1:1 S %N=$E(%X,%I),%N=%N*(%D+1),%N=$E(%N)+$E(%N,2),%S=%S+%N,%D='%D
|
|---|
| 11 | Q %X_$S(+%X:(-%S#10),1:"")
|
|---|
| 12 | ;
|
|---|
| 13 | VCD(%X) ; -- Verify check digit (last digit)
|
|---|
| 14 | ; -- Pass X = integer with check digit appended
|
|---|
| 15 | ; -- rtns 0 if check not valid or 1 if valid
|
|---|
| 16 | ;
|
|---|
| 17 | Q %X=$$CCD($E(%X,1,$L(%X)-1))
|
|---|
| 18 | ;
|
|---|
| 19 | QL(X) ;$QLENGTH OF GLOBAL STRING
|
|---|
| 20 | N %,%1
|
|---|
| 21 | S %1="" F %=0:1 Q:%1=$NA(@X,%) S %1=$NA(@X,%)
|
|---|
| 22 | Q %-1
|
|---|
| 23 | ;
|
|---|
| 24 | QS(X1,X2) ;$QSUBSCRIPT OF GLOBAL STRING
|
|---|
| 25 | N %,%1,Y
|
|---|
| 26 | I X2=-1,X1?1"^"1"[".E1"]".E Q $TR($P($P($NA(@X1,0),"]"),"[",2),"""")
|
|---|
| 27 | I X2=-1,X1?1"^"1"|".E1"|".E Q $TR($P($NA(@X1,0),"|",2,$L($NA(@X1,0),"|")-1),"""")
|
|---|
| 28 | I X2=0,(X1'?1"^"1"[".E)&(X1'?1"^"1"|".E) Q $NA(@X1,X2)
|
|---|
| 29 | I X2=0,X1?1"^"1"[".E1"]".E Q "^"_$P($NA(@X1,X2),"]",2,999)
|
|---|
| 30 | I X2=0,X1?1"^"1"|".E Q "^"_$P($NA(@X1,X2),"|",$L($NA(@X1,X2),"|"))
|
|---|
| 31 | S %1=$NA(@X1,X2-1)
|
|---|
| 32 | I $E(%1,$L(%1))=")" S %1=$E(%1,1,$L(%1)-1)
|
|---|
| 33 | S Y=$P($NA(@X1,X2),%1,2,999),Y=$E(Y,1,$L(Y)-1)
|
|---|
| 34 | I X2=1,$E(Y)="(" S Y=$E(Y,2,999)
|
|---|
| 35 | I X2>1,$E(Y)="," S Y=$E(Y,2,999)
|
|---|
| 36 | I $A(Y)=34,$A(Y,$L(Y))=34 S Y=$E(Y,2,$L(Y)-1)
|
|---|
| 37 | Q Y
|
|---|
| 38 | BASE(%X1,%X2,%X3) ;Convert %X1 from %X2 base to %X3 base
|
|---|
| 39 | I (%X2<2)!(%X2>16)!(%X3<2)!(%X3>16) Q -1
|
|---|
| 40 | Q $$CNV($$DEC(%X1,%X2),%X3)
|
|---|
| 41 | DEC(N,B) ;Cnv N from B to 10
|
|---|
| 42 | Q:B=10 N N I,Y S Y=0
|
|---|
| 43 | F I=1:1:$L(N) S Y=Y*B+($F("0123456789ABCDEF",$E(N,I))-2)
|
|---|
| 44 | Q Y
|
|---|
| 45 | CNV(N,B) ;Cnv N from 10 to B
|
|---|
| 46 | Q:B=10 N N I,Y S Y=""
|
|---|
| 47 | F I=1:1 S Y=$E("0123456789ABCDEF",N#B+1)_Y,N=N\B Q:N<1
|
|---|
| 48 | Q Y
|
|---|
