DPTDSSN.m

DPTDSSN ; IHS/TUCSON/JCM - COMPARES SSN'S ;

 ;;1.0;PATIENT MERGE;;FEB 02, 1994

 ;

START ;

 I $G(XDRCD(XDRFL,XDRCD,.09,"I"))']""!($G(XDRCD2(XDRFL,XDRCD2,.09,"I"))']"") G END

 D INIT

 D COMPARE

END D EOJ

 Q

 ;

INIT ;

 D EOJ

 S DPTDSSN("MATCH")=$P(XDRDTEST(XDRDTO),U,6)

 S DPTDSSN("NO MATCH")=$P(XDRDTEST(XDRDTO),U,7)

 S DPTDSN=$G(XDRCD(XDRFL,XDRCD,.09,"I"))

 S DPTDSN2=$G(XDRCD2(XDRFL,XDRCD2,.09,"I"))

 S DPTDSNF=$E(DPTDSN,1,3),DPTDSN2F=$E(DPTDSN2,1,3)

 S DPTDSNS=$E(DPTDSN,4,5),DPTDSN2S=$E(DPTDSN2,4,5)

 S DPTDSNT=$E(DPTDSN,6,9),DPTDSN2T=$E(DPTDSN2,6,9)

 Q

 ;

COMPARE ;

 ;CHECK TO SEE IF LAST FOUR MATCH OR TWO OF THREE PARTS MATCH

 I DPTDSNT=DPTDSN2T S XDRD("TEST SCORE")=DPTDSSN("MATCH") G COMPAREX

 S DPTDSSN("CNT")=0

 I DPTDSNF=DPTDSN2F S DPTDSSN("CNT")=DPTDSSN("CNT")+1

 I DPTDSNS=DPTDSN2S S DPTDSSN("CNT")=DPTDSSN("CNT")+1

 I DPTDSSN("CNT")>1 S XDRD("TEST SCORE")=DPTDSSN("MATCH")*.8 K DPTDSSN("CNT") G COMPAREX

 ;

 ;CHECK POSITIONAL RELATIONSHIP OF LAST FOUR DIGITS OF SSN'S

 S DPTDSSN("PCNT")=0

 F DPTDSSN("I")=1:1:4 Q:(DPTDSSN("PCNT")>2)  I $E(DPTDSNT,DPTDSSN("I"))'=$E(DPTDSN2T,DPTDSSN("I")) S DPTDSSN("PCNT")=DPTDSSN("PCNT")+1

 I DPTDSSN("PCNT")'>2,DPTDSSN("CNT")>0 S XDRD("TEST SCORE")=DPTDSSN("MATCH")*.5 G COMPAREX

 ;

 ;ASSIGN NEGATIVE VALUE FOR NO SSN MATCH

 S XDRD("TEST SCORE")=DPTDSSN("NO MATCH")

COMPAREX ;

 Q

 ;

EOJ ;

 K DPTDSN,DPTDSN2,DPTDSNF,DPTDSN2F,DPTDSNS,DPTDSN2S,DPTDSNT,DPTDSN2T

 K DPTDSSN

 Q

DPTDSSN   ; IHS/TUCSON/JCM - COMPARES SSN'S ;

 +1       ;;1.0;PATIENT MERGE;;FEB 02, 1994

 +2       ;

START     ;

 +1        IF $GET(XDRCD(XDRFL,XDRCD,.09,"I"))']""!($GET(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 DPTDSSN("MATCH")=$PIECE(XDRDTEST(XDRDTO),U,6)

 +3        SET DPTDSSN("NO MATCH")=$PIECE(XDRDTEST(XDRDTO),U,7)

 +4        SET DPTDSN=$GET(XDRCD(XDRFL,XDRCD,.09,"I"))

 +5        SET DPTDSN2=$GET(XDRCD2(XDRFL,XDRCD2,.09,"I"))

 +6        SET DPTDSNF=$EXTRACT(DPTDSN,1,3)

           SET DPTDSN2F=$EXTRACT(DPTDSN2,1,3)

 +7        SET DPTDSNS=$EXTRACT(DPTDSN,4,5)

           SET DPTDSN2S=$EXTRACT(DPTDSN2,4,5)

 +8        SET DPTDSNT=$EXTRACT(DPTDSN,6,9)

           SET DPTDSN2T=$EXTRACT(DPTDSN2,6,9)

 +9        QUIT 

 +10      ;

COMPARE   ;

 +1       ;CHECK TO SEE IF LAST FOUR MATCH OR TWO OF THREE PARTS MATCH

 +2        IF DPTDSNT=DPTDSN2T

               SET XDRD("TEST SCORE")=DPTDSSN("MATCH")

               GOTO COMPAREX

 +3        SET DPTDSSN("CNT")=0

 +4        IF DPTDSNF=DPTDSN2F

               SET DPTDSSN("CNT")=DPTDSSN("CNT")+1

 +5        IF DPTDSNS=DPTDSN2S

               SET DPTDSSN("CNT")=DPTDSSN("CNT")+1

 +6        IF DPTDSSN("CNT")>1

               SET XDRD("TEST SCORE")=DPTDSSN("MATCH")*.8

               KILL DPTDSSN("CNT")

               GOTO COMPAREX

 +7       ;

 +8       ;CHECK POSITIONAL RELATIONSHIP OF LAST FOUR DIGITS OF SSN'S

 +9        SET DPTDSSN("PCNT")=0

 +10       FOR DPTDSSN("I")=1:1:4

               IF (DPTDSSN("PCNT")>2)

                   QUIT 

               IF $EXTRACT(DPTDSNT,DPTDSSN("I"))'=$EXTRACT(DPTDSN2T,DPTDSSN("I"))

                   SET DPTDSSN("PCNT")=DPTDSSN("PCNT")+1

 +11       IF DPTDSSN("PCNT")'>2

               IF DPTDSSN("CNT")>0

                   SET XDRD("TEST SCORE")=DPTDSSN("MATCH")*.5

                   GOTO COMPAREX

 +12      ;

 +13      ;ASSIGN NEGATIVE VALUE FOR NO SSN MATCH

 +14       SET XDRD("TEST SCORE")=DPTDSSN("NO MATCH")

COMPAREX  ;

 +1        QUIT 

 +2       ;

EOJ       ;

 +1        KILL DPTDSN,DPTDSN2,DPTDSNF,DPTDSN2F,DPTDSNS,DPTDSN2S,DPTDSNT,DPTDSN2T

 +2        KILL DPTDSSN

 +3        QUIT