|
Last change
on this file since 808 was 642, checked in by Sam Habiel, 15 years ago |
|
Modified directory structure; moved routines.
|
|
File size:
939 bytes
|
| Rev | Line | |
|---|
| [641] | 1 | XBUTL ;IHS/ITSC/CLS - XB MISCELLANEOUS UTILITIES [ 10/06/2005 9:59 AM ]
|
|---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
|---|
| 3 | ;
|
|---|
| 4 | LINK(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
|
|---|
| 16 | LUHN(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.
