source: IHS-VA_UTILITIES-XB/trunk/XBUTL.m@ 686

Last change on this file since 686 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 939 bytes
Line 
1XBUTL ;IHS/ITSC/CLS - XB MISCELLANEOUS UTILITIES [ 10/06/2005 9:59 AM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4LINK(P,C) ;link protocols child to parent
5 ;Input: P-Parent protocol
6 ; C-Child protocol
7 N IENARY,PIEN,AIEN,FDA,ERR
8 Q:'$L(P)!('$L(C))
9 S IENARY(1)=$$FIND1^DIC(101,"","",P)
10 S AIEN=$$FIND1^DIC(101,"","",C)
11 Q:'IENARY(1)!'AIEN
12 S FDA(101.01,"?+2,"_IENARY(1)_",",.01)=AIEN
13 D UPDATE^DIE("S","FDA","IENARY","ERR")
14 ;I $G(ERR("DIERR",1)) W ! ZW ERR ;IHS/CIA/PLS for debugging use
15 Q
16LUHN(X) ;calulate check digit, Luhn formula for NPI
17 ;x=10 digit number
18 I '+X S X=0 Q X
19 I $E(X,1,5)=80840 D
20 .S X=$E(X,6,15)
21 S XBSTRING=""
22 I X'?10N S X=0 Q X
23 S XBCD=$E(X,10)
24 F I=1:1:9 D
25 .I (I#2) D
26 ..S XBSTRING=XBSTRING_($E(X,I)*2)
27 .I '(I#2) D
28 ..S XBSTRING=XBSTRING_$E(X,I)
29 S XBTOT=0
30 F I=1:1:$L(XBSTRING) D
31 .S XBTOT=XBTOT+$E(XBSTRING,I)
32 S XBTOT=XBTOT+24
33 S XBTOT=1000-XBTOT
34 S X=$E(XBTOT,$L(XBTOT))
35 I X'=XBCD S X=0 Q X
36 S X=1 Q X
Note: See TracBrowser for help on using the repository browser.