[613] | 1 | XDRPTN ;SF-IRMFO/IHS/OHPRD/JCM;COMPARES NAMES; ;11/6/97 16:14
|
---|
| 2 | ;;7.3;TOOLKIT;**23**;Apr 25, 1995
|
---|
| 3 | ;;
|
---|
| 4 | ;
|
---|
| 5 | ; Calls: SOU^DICM1
|
---|
| 6 | ;
|
---|
| 7 | START ;
|
---|
| 8 | D INIT
|
---|
| 9 | D NAME
|
---|
| 10 | I $O(^DPT(XDRCD,.01,0)) D OTHER
|
---|
| 11 | END D EOJ
|
---|
| 12 | Q
|
---|
| 13 | ;
|
---|
| 14 | EN ; EP - Entry Point for any routines comparing names
|
---|
| 15 | ;
|
---|
| 16 | D INIT1
|
---|
| 17 | D COMPARE
|
---|
| 18 | D EOJ
|
---|
| 19 | Q
|
---|
| 20 | ;
|
---|
| 21 | INIT ;
|
---|
| 22 | D EOJ
|
---|
| 23 | S XDRDN("MATCH")=$P(XDRDTEST(XDRDTO),U,6)
|
---|
| 24 | S XDRDN("NO MATCH")=$P(XDRDTEST(XDRDTO),U,7)
|
---|
| 25 | S XDRDN=XDRCD(XDRFL,XDRCD,.01,"I"),XDRDN2=XDRCD2(XDRFL,XDRCD2,.01,"I")
|
---|
| 26 | ;
|
---|
| 27 | INIT1 S XDRDN=$$CHKNAM(XDRDN),XDRDN2=$$CHKNAM(XDRDN2)
|
---|
| 28 | S XDRDNL=$P(XDRDN,","),XDRDNF=$P($P(XDRDN,",",2)," "),XDRDNFI=$E(XDRDNF),XDRDNM=$P($P(XDRDN,",",2)," ",2),XDRDNMI=$E(XDRDNM)
|
---|
| 29 | ;
|
---|
| 30 | INIT2 S XDRDNL2=$P(XDRDN2,","),XDRDNF2=$P($P(XDRDN2,",",2)," "),XDRDNFI2=$E(XDRDNF2),XDRDNM2=$P($P(XDRDN2,",",2)," ",2),XDRDNMI2=$E(XDRDNM2)
|
---|
| 31 | Q
|
---|
| 32 | ;
|
---|
| 33 | NAME ;
|
---|
| 34 | D COMPARE
|
---|
| 35 | D:$O(^DPT(XDRCD2,.01,0)) OTHER2
|
---|
| 36 | Q
|
---|
| 37 | ;
|
---|
| 38 | OTHER ;
|
---|
| 39 | 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
|
---|
| 40 | Q
|
---|
| 41 | ;
|
---|
| 42 | OTHER2 ;
|
---|
| 43 | 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
|
---|
| 44 | Q
|
---|
| 45 | ;
|
---|
| 46 | COMPARE ;
|
---|
| 47 | S:'$D(XDRDN("TEST SCORE")) XDRDN("TEST SCORE")=XDRDN("NO MATCH")
|
---|
| 48 | I XDRDN=XDRDN2 S XDRDN("TEST SCORE2")=XDRDN("MATCH") G COMPAREX
|
---|
| 49 | I XDRDNF=XDRDNF2,XDRDNL=XDRDNL2 S XDRDN("TEST SCORE2")=XDRDN("MATCH")*.8 G COMPAREX
|
---|
| 50 | S X=XDRDNL D SOU^DICM1 S XDRDNLS=X S X=XDRDNL2 D SOU^DICM1 S XDRDNL2S=X
|
---|
| 51 | S X=XDRDNF D SOU^DICM1 S XDRDNFS=X S X=XDRDNF2 D SOU^DICM1 S XDRDNF2S=X
|
---|
| 52 | I XDRDNLS=XDRDNL2S,XDRDNFS=XDRDNF2S S XDRDN("TEST SCORE2")=XDRDN("MATCH")*.6 G COMPAREX
|
---|
| 53 | I XDRDNFI=XDRDNFI2,XDRDNL=XDRDNL2 S XDRDN("TEST SCORE2")=XDRDN("MATCH")*.5 G COMPAREX ; CHANGED FROM .6 TO .5 04/15/96 JLI
|
---|
| 54 | I XDRDNL=XDRDNL2 S XDRDN("TEST SCORE2")=XDRDN("MATCH")*.4 G COMPAREX
|
---|
| 55 | I XDRDNFS=XDRDNF2S S XDRDN("TEST SCORE2")=XDRDN("MATCH")*.2 G COMPAREX
|
---|
| 56 | S XDRDN("TEST SCORE2")=XDRDN("NO MATCH")
|
---|
| 57 | COMPAREX ;
|
---|
| 58 | S:XDRDN("TEST SCORE2")>(XDRDN("TEST SCORE")) XDRDN("TEST SCORE")=XDRDN("TEST SCORE2")
|
---|
| 59 | K X,XDRDNLS,XDRDNL2S,XDRDNFS,XDRDNF2S,XDRDN("TEST SCORE2")
|
---|
| 60 | Q
|
---|
| 61 | ;
|
---|
| 62 | CHKNAM(NAME) ;
|
---|
| 63 | N X,XXX,YYY
|
---|
| 64 | S NAME=$$UP^XLFSTR(NAME)
|
---|
| 65 | I $E(NAME,1,2)="ZZ" D
|
---|
| 66 | . 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
|
---|
| 67 | S NAME=$$NOSPAC(NAME)
|
---|
| 68 | I $E(NAME,$L(NAME))="." S NAME=$E(NAME,1,$L(NAME)-1)
|
---|
| 69 | S X=$$NOSPAC($P(NAME,",",2))
|
---|
| 70 | I X'="",",JR,SR,II,III,3RD,"[(","_X_",") S NAME=$P(NAME,",")
|
---|
| 71 | I NAME'="",NAME'["," D
|
---|
| 72 | . I $L(NAME," ")=1 Q
|
---|
| 73 | LOOP . S X=$P(NAME," ",$L(NAME," ")),NAME=$P(NAME," ",1,$L(NAME," ")-1)
|
---|
| 74 | . I ",JR,SR,II,III,3RD,"[(","_X_",") G LOOP
|
---|
| 75 | . I NAME'="" S NAME=X_","_NAME
|
---|
| 76 | Q NAME
|
---|
| 77 | ;
|
---|
| 78 | NOSPAC(X) ;
|
---|
| 79 | F Q:X="" Q:$E(X)'=" " S X=$E(X,2,$L(X))
|
---|
| 80 | Q X
|
---|
| 81 | ;
|
---|
| 82 | EOJ ;
|
---|
| 83 | S:$D(XDRDN("TEST SCORE")) XDRD("TEST SCORE")=XDRDN("TEST SCORE")
|
---|
| 84 | K XDRDN,XDRDN2,XDRDNF,XDRDNF2,XDRDNL,XDRDNL2,XDRDNM,XDRDNM2
|
---|
| 85 | K XDRDNMI,XDRDNMI2,XDRDNFI,XDRDNFI2,XDRDNO,XDRDNO2
|
---|
| 86 | Q
|
---|