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