XDRPTSSN.m

XDRPTSSN ;SF-IRMFO/IHS/OHPRD/JCM;COMPARES SSN'S; ;1/27/97  15:20 [ 04/02/2003   8:47 AM ]

 ;;7.3;TOOLKIT;**1001**;APR 1, 2003

 ;;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

XDRPTSSN  ;SF-IRMFO/IHS/OHPRD/JCM;COMPARES SSN'S; ;1/27/97  15:20 [ 04/02/2003   8:47 AM ]

 +1       ;;7.3;TOOLKIT;**1001**;APR 1, 2003

 +2       ;;7.3;TOOLKIT;**23**;Apr 25, 1995

 +3       ;;

 +4       ;

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