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

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

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1XDRPTSSN ;SF-IRMFO/IHS/OHPRD/JCM;COMPARES SSN'S; ;1/27/97 15:20
2 ;;7.3;TOOLKIT;**23**;Apr 25, 1995
3 ;;
4 ;
5START ;
6 I XDRCD(XDRFL,XDRCD,.09,"I")']""!(XDRCD2(XDRFL,XDRCD2,.09,"I")']"") G END
7 D INIT
8 D COMPARE
9END D EOJ
10 Q
11 ;
12INIT ;
13 D EOJ
14 S XDRDSSN("MATCH")=$P(XDRDTEST(XDRDTO),U,6)
15 S XDRDSSN("NO MATCH")=$P(XDRDTEST(XDRDTO),U,7)
16 S XDRDSN=XDRCD(XDRFL,XDRCD,.09,"I")
17 I XDRDSN'?9N.E S XDRDSN="",^XTMP("XDRERR","BADSSN",XDRCD)=""
18 S XDRDSN2=XDRCD2(XDRFL,XDRCD2,.09,"I")
19 I XDRDSN2'?9N.E S XDRDSN="",^XTMP("XDRERR","BADSSN",XDRCD2)=""
20 S XDRDSNF=$E(XDRDSN,1,3),XDRDSN2F=$E(XDRDSN2,1,3)
21 S XDRDSNS=$E(XDRDSN,4,5),XDRDSN2S=$E(XDRDSN2,4,5)
22 S XDRDSNT=$E(XDRDSN,6,9),XDRDSN2T=$E(XDRDSN2,6,9)
23 Q
24 ;
25COMPARE ;
26 I XDRDSN=""!(XDRDSN2="") G COMPAREX
27 ; SKIP SSN'S IF THEY ARE PSEUDOS
28 I $E(XDRDSN,10)="P"!($E(XDRDSN2,10)="P") G COMPAREX
29 ; SKIP SSN'S IF THEY ARE NOT REAL (I.E., 00000NNNN)
30 I $E(XDRDSN,1,5)="00000"!($E(XDRDSN2,1,5)="00000") G COMPAREX
31 ; ADDED LOGIC TO DETERMINE IF ONLY ONE DIGIT IS CHANGED, OR TWO
32 ; DIGITS SWITCHED
33 ; THIS IS ASSIGNED THE MAXIMUM MATCH VALUE, AND LAST 4, ETC LESS.
34 ;
35 N N
36 S N=$$NUMCOMP^XDRPTCLN(XDRDSN,XDRDSN2,XDRDSSN("MATCH"),XDRDSSN("NO MATCH"),1) I N=XDRDSSN("MATCH") S XDRD("TEST SCORE")=XDRDSSN("MATCH") G COMPAREX
37 ;CHECK TO SEE IF LAST FOUR MATCH OR TWO OF THREE PARTS MATCH
38 I XDRDSNT=XDRDSN2T D G COMPAREX
39 . S XDRD("TEST SCORE")=.6*XDRDSSN("MATCH")
40 . I $E($P(^DPT(XDRCD,0),U))=$E($P(^DPT(XDRCD2,0),U)) D
41 . . S XDRD("TEST SCORE")=.8*XDRDSSN("MATCH")
42 S XDRDSSN("CNT")=0
43 I XDRDSNF=XDRDSN2F S XDRDSSN("CNT")=XDRDSSN("CNT")+1
44 I XDRDSNS=XDRDSN2S S XDRDSSN("CNT")=XDRDSSN("CNT")+1
45 I XDRDSSN("CNT")>1 S XDRD("TEST SCORE")=XDRDSSN("MATCH")*.4 K XDRDSSN("CNT") G COMPAREX
46 ;
47 ;CHECK POSITIONAL RELATIONSHIP OF LAST FOUR DIGITS OF SSN'S
48 S XDRDSSN("PCNT")=0
49 F XDRDSSN("I")=1:1:4 Q:(XDRDSSN("PCNT")>2) I $E(XDRDSNT,XDRDSSN("I"))'=$E(XDRDSN2T,XDRDSSN("I")) S XDRDSSN("PCNT")=XDRDSSN("PCNT")+1
50 I XDRDSSN("PCNT")'>2,XDRDSSN("CNT")>0 S XDRD("TEST SCORE")=XDRDSSN("MATCH")*.2 G COMPAREX
51 ;
52 ;ASSIGN NEGATIVE VALUE FOR NO SSN MATCH
53 S XDRD("TEST SCORE")=XDRDSSN("NO MATCH")
54COMPAREX ;
55 Q
56 ;
57EOJ ;
58 K XDRDSN,XDRDSN2,XDRDSNF,XDRDSN2F,XDRDSNS,XDRDSN2S,XDRDSNT,XDRDSN2T
59 K XDRDSSN
60 Q
Note: See TracBrowser for help on using the repository browser.