XDRPTSSN ;SF-IRMFO/IHS/OHPRD/JCM;COMPARES SSN'S; ;1/27/97 15:20
;;7.3;TOOLKIT;**23**;Apr 25, 1995
;;
;
START ;
I XDRCD(XDRFL,XDRCD,.09,"I")']""!(XDRCD2(XDRFL,XDRCD2,.09,"I")']"") G END
D INIT
D COMPARE
END D EOJ
Q
;
INIT ;
D EOJ
S XDRDSSN("MATCH")=$P(XDRDTEST(XDRDTO),U,6)
S XDRDSSN("NO MATCH")=$P(XDRDTEST(XDRDTO),U,7)
S XDRDSN=XDRCD(XDRFL,XDRCD,.09,"I")
I XDRDSN'?9N.E S XDRDSN="",^XTMP("XDRERR","BADSSN",XDRCD)=""
S XDRDSN2=XDRCD2(XDRFL,XDRCD2,.09,"I")
I XDRDSN2'?9N.E S XDRDSN="",^XTMP("XDRERR","BADSSN",XDRCD2)=""
S XDRDSNF=$E(XDRDSN,1,3),XDRDSN2F=$E(XDRDSN2,1,3)
S XDRDSNS=$E(XDRDSN,4,5),XDRDSN2S=$E(XDRDSN2,4,5)
S XDRDSNT=$E(XDRDSN,6,9),XDRDSN2T=$E(XDRDSN2,6,9)
Q
;
COMPARE ;
I XDRDSN=""!(XDRDSN2="") G COMPAREX
; SKIP SSN'S IF THEY ARE PSEUDOS
I $E(XDRDSN,10)="P"!($E(XDRDSN2,10)="P") G COMPAREX
; SKIP SSN'S IF THEY ARE NOT REAL (I.E., 00000NNNN)
I $E(XDRDSN,1,5)="00000"!($E(XDRDSN2,1,5)="00000") G COMPAREX
; ADDED LOGIC TO DETERMINE IF ONLY ONE DIGIT IS CHANGED, OR TWO
; DIGITS SWITCHED
; THIS IS ASSIGNED THE MAXIMUM MATCH VALUE, AND LAST 4, ETC LESS.
;
N N
S N=$$NUMCOMP^XDRPTCLN(XDRDSN,XDRDSN2,XDRDSSN("MATCH"),XDRDSSN("NO MATCH"),1) I N=XDRDSSN("MATCH") S XDRD("TEST SCORE")=XDRDSSN("MATCH") G COMPAREX
;CHECK TO SEE IF LAST FOUR MATCH OR TWO OF THREE PARTS MATCH
I XDRDSNT=XDRDSN2T D G COMPAREX
. S XDRD("TEST SCORE")=.6*XDRDSSN("MATCH")
. I $E($P(^DPT(XDRCD,0),U))=$E($P(^DPT(XDRCD2,0),U)) D
. . S XDRD("TEST SCORE")=.8*XDRDSSN("MATCH")
S XDRDSSN("CNT")=0
I XDRDSNF=XDRDSN2F S XDRDSSN("CNT")=XDRDSSN("CNT")+1
I XDRDSNS=XDRDSN2S S XDRDSSN("CNT")=XDRDSSN("CNT")+1
I XDRDSSN("CNT")>1 S XDRD("TEST SCORE")=XDRDSSN("MATCH")*.4 K XDRDSSN("CNT") G COMPAREX
;
;CHECK POSITIONAL RELATIONSHIP OF LAST FOUR DIGITS OF SSN'S
S XDRDSSN("PCNT")=0
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
I XDRDSSN("PCNT")'>2,XDRDSSN("CNT")>0 S XDRD("TEST SCORE")=XDRDSSN("MATCH")*.2 G COMPAREX
;
;ASSIGN NEGATIVE VALUE FOR NO SSN MATCH
S XDRD("TEST SCORE")=XDRDSSN("NO MATCH")
COMPAREX ;
Q
;
EOJ ;
K XDRDSN,XDRDSN2,XDRDSNF,XDRDSN2F,XDRDSNS,XDRDSN2S,XDRDSNT,XDRDSN2T
K XDRDSSN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXDRPTSSN 2276 printed Apr 09, 2024@21:45:07 Page 2
XDRPTSSN ;SF-IRMFO/IHS/OHPRD/JCM;COMPARES SSN'S; ;1/27/97 15:20
+1 ;;7.3;TOOLKIT;**23**;Apr 25, 1995
+2 ;;
+3 ;
START ;
+1 IF XDRCD(XDRFL,XDRCD,.09,"I")']""!(XDRCD2(XDRFL,XDRCD2,.09,"I")']"")
GOTO END
+2 DO INIT
+3 DO COMPARE
END DO EOJ
+1 QUIT
+2 ;
INIT ;
+1 DO EOJ
+2 SET XDRDSSN("MATCH")=$PIECE(XDRDTEST(XDRDTO),U,6)
+3 SET XDRDSSN("NO MATCH")=$PIECE(XDRDTEST(XDRDTO),U,7)
+4 SET XDRDSN=XDRCD(XDRFL,XDRCD,.09,"I")
+5 IF XDRDSN'?9N.E
SET XDRDSN=""
SET ^XTMP("XDRERR","BADSSN",XDRCD)=""
+6 SET XDRDSN2=XDRCD2(XDRFL,XDRCD2,.09,"I")
+7 IF XDRDSN2'?9N.E
SET XDRDSN=""
SET ^XTMP("XDRERR","BADSSN",XDRCD2)=""
+8 SET XDRDSNF=$EXTRACT(XDRDSN,1,3)
SET XDRDSN2F=$EXTRACT(XDRDSN2,1,3)
+9 SET XDRDSNS=$EXTRACT(XDRDSN,4,5)
SET XDRDSN2S=$EXTRACT(XDRDSN2,4,5)
+10 SET XDRDSNT=$EXTRACT(XDRDSN,6,9)
SET XDRDSN2T=$EXTRACT(XDRDSN2,6,9)
+11 QUIT
+12 ;
COMPARE ;
+1 IF XDRDSN=""!(XDRDSN2="")
GOTO COMPAREX
+2 ; SKIP SSN'S IF THEY ARE PSEUDOS
+3 IF $EXTRACT(XDRDSN,10)="P"!($EXTRACT(XDRDSN2,10)="P")
GOTO COMPAREX
+4 ; SKIP SSN'S IF THEY ARE NOT REAL (I.E., 00000NNNN)
+5 IF $EXTRACT(XDRDSN,1,5)="00000"!($EXTRACT(XDRDSN2,1,5)="00000")
GOTO COMPAREX
+6 ; ADDED LOGIC TO DETERMINE IF ONLY ONE DIGIT IS CHANGED, OR TWO
+7 ; DIGITS SWITCHED
+8 ; THIS IS ASSIGNED THE MAXIMUM MATCH VALUE, AND LAST 4, ETC LESS.
+9 ;
+10 NEW N
+11 SET N=$$NUMCOMP^XDRPTCLN(XDRDSN,XDRDSN2,XDRDSSN("MATCH"),XDRDSSN("NO MATCH"),1)
IF N=XDRDSSN("MATCH")
SET XDRD("TEST SCORE")=XDRDSSN("MATCH")
GOTO COMPAREX
+12 ;CHECK TO SEE IF LAST FOUR MATCH OR TWO OF THREE PARTS MATCH
+13 IF XDRDSNT=XDRDSN2T
Begin DoDot:1
+14 SET XDRD("TEST SCORE")=.6*XDRDSSN("MATCH")
+15 IF $EXTRACT($PIECE(^DPT(XDRCD,0),U))=$EXTRACT($PIECE(^DPT(XDRCD2,0),U))
Begin DoDot:2
+16 SET XDRD("TEST SCORE")=.8*XDRDSSN("MATCH")
End DoDot:2
End DoDot:1
GOTO COMPAREX
+17 SET XDRDSSN("CNT")=0
+18 IF XDRDSNF=XDRDSN2F
SET XDRDSSN("CNT")=XDRDSSN("CNT")+1
+19 IF XDRDSNS=XDRDSN2S
SET XDRDSSN("CNT")=XDRDSSN("CNT")+1
+20 IF XDRDSSN("CNT")>1
SET XDRD("TEST SCORE")=XDRDSSN("MATCH")*.4
KILL XDRDSSN("CNT")
GOTO COMPAREX
+21 ;
+22 ;CHECK POSITIONAL RELATIONSHIP OF LAST FOUR DIGITS OF SSN'S
+23 SET XDRDSSN("PCNT")=0
+24 FOR XDRDSSN("I")=1:1:4
if (XDRDSSN("PCNT")>2)
QUIT
IF $EXTRACT(XDRDSNT,XDRDSSN("I"))'=$EXTRACT(XDRDSN2T,XDRDSSN("I"))
SET XDRDSSN("PCNT")=XDRDSSN("PCNT")+1
+25 IF XDRDSSN("PCNT")'>2
IF XDRDSSN("CNT")>0
SET XDRD("TEST SCORE")=XDRDSSN("MATCH")*.2
GOTO COMPAREX
+26 ;
+27 ;ASSIGN NEGATIVE VALUE FOR NO SSN MATCH
+28 SET XDRD("TEST SCORE")=XDRDSSN("NO MATCH")
COMPAREX ;
+1 QUIT
+2 ;
EOJ ;
+1 KILL XDRDSN,XDRDSN2,XDRDSNF,XDRDSN2F,XDRDSNS,XDRDSN2S,XDRDSNT,XDRDSN2T
+2 KILL XDRDSSN
+3 QUIT
