source: FOIAVistA/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XDRPTN.m@ 1397

XDRPTN ;SF-IRMFO/IHS/OHPRD/JCM;COMPARES NAMES; ;11/6/97  16:14
 ;;7.3;TOOLKIT;**23**;Apr 25, 1995
 ;;
 ;
 ; Calls: SOU^DICM1
 ;
START ;
 D INIT
 D NAME
 I $O(^DPT(XDRCD,.01,0)) D OTHER
END D EOJ
 Q
 ;
EN ; EP - Entry Point for any routines comparing names
 ;
 D INIT1
 D COMPARE
 D EOJ
 Q
 ;
INIT ;
 D EOJ
 S XDRDN("MATCH")=$P(XDRDTEST(XDRDTO),U,6)
 S XDRDN("NO MATCH")=$P(XDRDTEST(XDRDTO),U,7)
 S XDRDN=XDRCD(XDRFL,XDRCD,.01,"I"),XDRDN2=XDRCD2(XDRFL,XDRCD2,.01,"I")
 ;
INIT1 S XDRDN=$$CHKNAM(XDRDN),XDRDN2=$$CHKNAM(XDRDN2)
 S XDRDNL=$P(XDRDN,","),XDRDNF=$P($P(XDRDN,",",2)," "),XDRDNFI=$E(XDRDNF),XDRDNM=$P($P(XDRDN,",",2)," ",2),XDRDNMI=$E(XDRDNM)
 ;
INIT2 S XDRDNL2=$P(XDRDN2,","),XDRDNF2=$P($P(XDRDN2,",",2)," "),XDRDNFI2=$E(XDRDNF2),XDRDNM2=$P($P(XDRDN2,",",2)," ",2),XDRDNMI2=$E(XDRDNM2)
 Q
 ;
NAME ;
 D COMPARE
 D:$O(^DPT(XDRCD2,.01,0)) OTHER2
 Q
 ;
OTHER ;
 F XDRDNO=0:0 S XDRDNO=$O(^DPT(XDRCD,.01,XDRDNO)) Q:'XDRDNO  S XDRDN=$P(^DPT(XDRCD,.01,XDRDNO,0),U,1) S:'$D(XDRDN2) XDRDN2=XDRCD2(XDRFL,XDRCD2,.01,"I") D INIT1,NAME
 Q
 ;
OTHER2 ;
 F XDRDNO2=0:0 S XDRDNO2=$O(^DPT(XDRCD2,.01,XDRDNO2)) Q:'XDRDNO2  S XDRDN2=$P(^DPT(XDRCD2,.01,XDRDNO2,0),U,1) D INIT2,COMPARE
 Q
 ;
COMPARE ;
 S:'$D(XDRDN("TEST SCORE")) XDRDN("TEST SCORE")=XDRDN("NO MATCH")
 I XDRDN=XDRDN2 S XDRDN("TEST SCORE2")=XDRDN("MATCH") G COMPAREX
 I XDRDNF=XDRDNF2,XDRDNL=XDRDNL2 S XDRDN("TEST SCORE2")=XDRDN("MATCH")*.8 G COMPAREX
 S X=XDRDNL D SOU^DICM1 S XDRDNLS=X S X=XDRDNL2 D SOU^DICM1 S XDRDNL2S=X
 S X=XDRDNF D SOU^DICM1 S XDRDNFS=X S X=XDRDNF2 D SOU^DICM1 S XDRDNF2S=X
 I XDRDNLS=XDRDNL2S,XDRDNFS=XDRDNF2S S XDRDN("TEST SCORE2")=XDRDN("MATCH")*.6 G COMPAREX
 I XDRDNFI=XDRDNFI2,XDRDNL=XDRDNL2 S XDRDN("TEST SCORE2")=XDRDN("MATCH")*.5 G COMPAREX ; CHANGED FROM .6 TO .5 04/15/96 JLI
 I XDRDNL=XDRDNL2 S XDRDN("TEST SCORE2")=XDRDN("MATCH")*.4 G COMPAREX
 I XDRDNFS=XDRDNF2S S XDRDN("TEST SCORE2")=XDRDN("MATCH")*.2 G COMPAREX
 S XDRDN("TEST SCORE2")=XDRDN("NO MATCH")
COMPAREX ;
 S:XDRDN("TEST SCORE2")>(XDRDN("TEST SCORE")) XDRDN("TEST SCORE")=XDRDN("TEST SCORE2")
 K X,XDRDNLS,XDRDNL2S,XDRDNFS,XDRDNF2S,XDRDN("TEST SCORE2")
 Q
 ;
CHKNAM(NAME) ;
 N X,XXX,YYY
 S NAME=$$UP^XLFSTR(NAME)
 I $E(NAME,1,2)="ZZ" D
 . F  Q:$E(NAME,1)'="Z"  S NAME=$E(NAME,2,$L(NAME)) ;S NAME=$E(NAME,3,$L(NAME)) -- MODIFIED 11/06/97 JLI
 S NAME=$$NOSPAC(NAME)
 I $E(NAME,$L(NAME))="." S NAME=$E(NAME,1,$L(NAME)-1)
 S X=$$NOSPAC($P(NAME,",",2))
 I X'="",",JR,SR,II,III,3RD,"[(","_X_",") S NAME=$P(NAME,",")
 I NAME'="",NAME'["," D
 . I $L(NAME," ")=1 Q
LOOP . S X=$P(NAME," ",$L(NAME," ")),NAME=$P(NAME," ",1,$L(NAME," ")-1)
 . I ",JR,SR,II,III,3RD,"[(","_X_",") G LOOP
 . I NAME'="" S NAME=X_","_NAME
 Q NAME
 ;
NOSPAC(X) ;
 F  Q:X=""  Q:$E(X)'=" "  S X=$E(X,2,$L(X))
 Q X
 ;
EOJ ;
 S:$D(XDRDN("TEST SCORE")) XDRD("TEST SCORE")=XDRDN("TEST SCORE")
 K XDRDN,XDRDN2,XDRDNF,XDRDNF2,XDRDNL,XDRDNL2,XDRDNM,XDRDNM2
 K XDRDNMI,XDRDNMI2,XDRDNFI,XDRDNFI2,XDRDNO,XDRDNO2
 Q