37 lines
939 B
Mathematica
37 lines
939 B
Mathematica
|
XBUTL ;IHS/ITSC/CLS - XB MISCELLANEOUS UTILITIES [ 10/06/2005 9:59 AM ]
|
||
|
|
;;4.0;XB;;Jul 20, 2009;Build 2
|
||
|
|
;
|
||
|
|
LINK(P,C) ;link protocols child to parent
|
||
|
|
;Input: P-Parent protocol
|
||
|
|
; C-Child protocol
|
||
|
|
N IENARY,PIEN,AIEN,FDA,ERR
|
||
|
|
Q:'$L(P)!('$L(C))
|
||
|
|
S IENARY(1)=$$FIND1^DIC(101,"","",P)
|
||
|
|
S AIEN=$$FIND1^DIC(101,"","",C)
|
||
|
|
Q:'IENARY(1)!'AIEN
|
||
|
|
S FDA(101.01,"?+2,"_IENARY(1)_",",.01)=AIEN
|
||
|
|
D UPDATE^DIE("S","FDA","IENARY","ERR")
|
||
|
|
;I $G(ERR("DIERR",1)) W ! ZW ERR ;IHS/CIA/PLS for debugging use
|
||
|
|
Q
|
||
|
|
LUHN(X) ;calulate check digit, Luhn formula for NPI
|
||
|
|
;x=10 digit number
|
||
|
|
I '+X S X=0 Q X
|
||
|
|
I $E(X,1,5)=80840 D
|
||
|
|
.S X=$E(X,6,15)
|
||
|
|
S XBSTRING=""
|
||
|
|
I X'?10N S X=0 Q X
|
||
|
|
S XBCD=$E(X,10)
|
||
|
|
F I=1:1:9 D
|
||
|
|
.I (I#2) D
|
||
|
|
..S XBSTRING=XBSTRING_($E(X,I)*2)
|
||
|
|
.I '(I#2) D
|
||
|
|
..S XBSTRING=XBSTRING_$E(X,I)
|
||
|
|
S XBTOT=0
|
||
|
|
F I=1:1:$L(XBSTRING) D
|
||
|
|
.S XBTOT=XBTOT+$E(XBSTRING,I)
|
||
|
|
S XBTOT=XBTOT+24
|
||
|
|
S XBTOT=1000-XBTOT
|
||
|
|
S X=$E(XBTOT,$L(XBTOT))
|
||
|
|
I X'=XBCD S X=0 Q X
|
||
|
|
S X=1 Q X
|