87 lines
2.9 KiB
Mathematica
87 lines
2.9 KiB
Mathematica
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
|