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