49 lines
1.6 KiB
Mathematica
49 lines
1.6 KiB
Mathematica
XLFUTL ;SFISC/RWF - Library Function, Check digit ;6/29/94 14:04
|
|
;;8.0;KERNEL;;Jul 10, 1995
|
|
Q
|
|
;
|
|
CCD(%X) ; Compute check digit and append to number
|
|
;see Taylor report Computerworld 1975
|
|
; X= integer, Return X with check digit
|
|
;
|
|
N %I,%N,%D,%S S %S=0,%D=1,%X=$G(%X) S:+%X'=%X (%X,%S)=""
|
|
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
|
|
Q %X_$S(+%X:(-%S#10),1:"")
|
|
;
|
|
VCD(%X) ; -- Verify check digit (last digit)
|
|
; -- Pass X = integer with check digit appended
|
|
; -- rtns 0 if check not valid or 1 if valid
|
|
;
|
|
Q %X=$$CCD($E(%X,1,$L(%X)-1))
|
|
;
|
|
QL(X) ;$QLENGTH OF GLOBAL STRING
|
|
N %,%1
|
|
S %1="" F %=0:1 Q:%1=$NA(@X,%) S %1=$NA(@X,%)
|
|
Q %-1
|
|
;
|
|
QS(X1,X2) ;$QSUBSCRIPT OF GLOBAL STRING
|
|
N %,%1,Y
|
|
I X2=-1,X1?1"^"1"[".E1"]".E Q $TR($P($P($NA(@X1,0),"]"),"[",2),"""")
|
|
I X2=-1,X1?1"^"1"|".E1"|".E Q $TR($P($NA(@X1,0),"|",2,$L($NA(@X1,0),"|")-1),"""")
|
|
I X2=0,(X1'?1"^"1"[".E)&(X1'?1"^"1"|".E) Q $NA(@X1,X2)
|
|
I X2=0,X1?1"^"1"[".E1"]".E Q "^"_$P($NA(@X1,X2),"]",2,999)
|
|
I X2=0,X1?1"^"1"|".E Q "^"_$P($NA(@X1,X2),"|",$L($NA(@X1,X2),"|"))
|
|
S %1=$NA(@X1,X2-1)
|
|
I $E(%1,$L(%1))=")" S %1=$E(%1,1,$L(%1)-1)
|
|
S Y=$P($NA(@X1,X2),%1,2,999),Y=$E(Y,1,$L(Y)-1)
|
|
I X2=1,$E(Y)="(" S Y=$E(Y,2,999)
|
|
I X2>1,$E(Y)="," S Y=$E(Y,2,999)
|
|
I $A(Y)=34,$A(Y,$L(Y))=34 S Y=$E(Y,2,$L(Y)-1)
|
|
Q Y
|
|
BASE(%X1,%X2,%X3) ;Convert %X1 from %X2 base to %X3 base
|
|
I (%X2<2)!(%X2>16)!(%X3<2)!(%X3>16) Q -1
|
|
Q $$CNV($$DEC(%X1,%X2),%X3)
|
|
DEC(N,B) ;Cnv N from B to 10
|
|
Q:B=10 N N I,Y S Y=0
|
|
F I=1:1:$L(N) S Y=Y*B+($F("0123456789ABCDEF",$E(N,I))-2)
|
|
Q Y
|
|
CNV(N,B) ;Cnv N from 10 to B
|
|
Q:B=10 N N I,Y S Y=""
|
|
F I=1:1 S Y=$E("0123456789ABCDEF",N#B+1)_Y,N=N\B Q:N<1
|
|
Q Y
|