source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XLFUTL.m@ 724

Last change on this file since 724 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1XLFUTL ;SFISC/RWF - Library Function, Check digit ;6/29/94 14:04
2 ;;8.0;KERNEL;;Jul 10, 1995
3 Q
4 ;
5CCD(%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 ;
13VCD(%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 ;
19QL(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 ;
24QS(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
38BASE(%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)
41DEC(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
45CNV(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
Note: See TracBrowser for help on using the repository browser.