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

Last change on this file since 789 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1XDRPTN ;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 ;
7START ;
8 D INIT
9 D NAME
10 I $O(^DPT(XDRCD,.01,0)) D OTHER
11END D EOJ
12 Q
13 ;
14EN ; EP - Entry Point for any routines comparing names
15 ;
16 D INIT1
17 D COMPARE
18 D EOJ
19 Q
20 ;
21INIT ;
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 ;
27INIT1 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 ;
30INIT2 S XDRDNL2=$P(XDRDN2,","),XDRDNF2=$P($P(XDRDN2,",",2)," "),XDRDNFI2=$E(XDRDNF2),XDRDNM2=$P($P(XDRDN2,",",2)," ",2),XDRDNMI2=$E(XDRDNM2)
31 Q
32 ;
33NAME ;
34 D COMPARE
35 D:$O(^DPT(XDRCD2,.01,0)) OTHER2
36 Q
37 ;
38OTHER ;
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 ;
42OTHER2 ;
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 ;
46COMPARE ;
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")
57COMPAREX ;
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 ;
62CHKNAM(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
73LOOP . 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 ;
78NOSPAC(X) ;
79 F Q:X="" Q:$E(X)'=" " S X=$E(X,2,$L(X))
80 Q X
81 ;
82EOJ ;
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
Note: See TracBrowser for help on using the repository browser.