DPTDN.m

DPTDN ; IHS/TUCSON/JCM - COMPARES NAMES ;

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

 ;

 ; Calls: SOU^DICM1

 ;

START ;

 D INIT

 D NAME

 I $O(^DPT(XDRCD,.01,0)) D OTHER

END D EOJ

 Q

 ;

EN ; EP - Entry Point for any routines comparing names

 ;

 D INIT1

 D COMPARE

 D EOJ

 Q

 ;

INIT ;

 D EOJ

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

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

 S DPTDN=$G(XDRCD(XDRFL,XDRCD,.01,"I")),DPTDN2=$G(XDRCD2(XDRFL,XDRCD2,.01,"I"))

 ;

INIT1 S DPTDNL=$P(DPTDN,","),DPTDNF=$P($P(DPTDN,",",2)," "),DPTDNFI=$E(DPTDNF),DPTDNM=$P($P(DPTDN,",",2)," ",2),DPTDNMI=$E(DPTDNM)

 ;

INIT2 S DPTDNL2=$P(DPTDN2,","),DPTDNF2=$P($P(DPTDN2,",",2)," "),DPTDNFI2=$E(DPTDNF2),DPTDNM2=$P($P(DPTDN2,",",2)," ",2),DPTDNMI2=$E(DPTDNM2)

 Q

 ;

NAME ;

 D COMPARE

 D:$O(^DPT(XDRCD2,.01,0)) OTHER2

 Q

 ;

OTHER ;

 F DPTDNO=0:0 S DPTDNO=$O(^DPT(XDRCD,.01,DPTDNO)) Q:'DPTDNO  S DPTDN=$P(^DPT(XDRCD,.01,DPTDNO,0),U,1) S:'$D(DPTDN2) DPTDN2=XDRCD2(XDRFL,XDRCD2,.01,"I") D INIT1,NAME

 Q

 ;

OTHER2 ;

 F DPTDNO2=0:0 S DPTDNO2=$O(^DPT(XDRCD2,.01,DPTDNO2)) Q:'DPTDNO2  S DPTDN2=$P(^DPT(XDRCD2,.01,DPTDNO2,0),U,1) D INIT2,COMPARE

 Q

 ;

COMPARE ;

 S:'$D(DPTDN("TEST SCORE")) DPTDN("TEST SCORE")=DPTDN("NO MATCH")

 I DPTDN=DPTDN2 S DPTDN("TEST SCORE2")=DPTDN("MATCH") G COMPAREX

 I DPTDNF=DPTDNF2,DPTDNL=DPTDNL2 S DPTDN("TEST SCORE2")=DPTDN("MATCH")*.8 G COMPAREX

 I DPTDNFI=DPTDNFI2,DPTDNL=DPTDNL2 S DPTDN("TEST SCORE2")=DPTDN("MATCH")*.6 G COMPAREX

 I DPTDNL=DPTDNL2 S DPTDN("TEST SCORE2")=DPTDN("MATCH")*.4 G COMPAREX

 S X=DPTDNL D SOU^DICM1 S DPTDNLS=X S X=DPTDNL2 D SOU^DICM1 S DPTDNL2S=X

 S X=DPTDNF D SOU^DICM1 S DPTDNFS=X S X=DPTDNF2 D SOU^DICM1 S DPTDNF2S=X

 I DPTDNLS=DPTDNL2S,DPTDNFS=DPTDNF2S S DPTDN("TEST SCORE2")=DPTDN("MATCH")*.6 G COMPAREX

 I DPTDNFS=DPTDNF2S S DPTDN("TEST SCORE2")=DPTDN("MATCH")*.2 G COMPAREX

 S DPTDN("TEST SCORE2")=DPTDN("NO MATCH")

COMPAREX ;

 S:DPTDN("TEST SCORE2")>(DPTDN("TEST SCORE")) DPTDN("TEST SCORE")=DPTDN("TEST SCORE2")

 K X,DPTDNLS,DPTDNL2S,DPTDNFS,DPTDNF2S,DPTDN("TEST SCORE2")

 Q

 ;

EOJ ;

 S:$D(DPTDN("TEST SCORE")) XDRD("TEST SCORE")=DPTDN("TEST SCORE")

 K DPTDN,DPTDN2,DPTDNF,DPTDNF2,DPTDNL,DPTDNL2,DPTDNM,DPTDNM2

 K DPTDNMI,DPTDNMI2,DPTDNFI,DPTDNFI2,DPTDNO,DPTDNO2

 Q

DPTDN     ; IHS/TUCSON/JCM - COMPARES NAMES ;

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

 +2       ;

 +3       ; Calls: SOU^DICM1

 +4       ;

START     ;

 +1        DO INIT

 +2        DO NAME

 +3        IF $ORDER(^DPT(XDRCD,.01,0))

               DO OTHER

END        DO EOJ

 +1        QUIT 

 +2       ;

EN        ; EP - Entry Point for any routines comparing names

 +1       ;

 +2        DO INIT1

 +3        DO COMPARE

 +4        DO EOJ

 +5        QUIT 

 +6       ;

INIT      ;

 +1        DO EOJ

 +2        SET DPTDN("MATCH")=$PIECE(XDRDTEST(XDRDTO),U,6)

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

 +4        SET DPTDN=$GET(XDRCD(XDRFL,XDRCD,.01,"I"))

           SET DPTDN2=$GET(XDRCD2(XDRFL,XDRCD2,.01,"I"))

 +5       ;

INIT1      SET DPTDNL=$PIECE(DPTDN,",")

           SET DPTDNF=$PIECE($PIECE(DPTDN,",",2)," ")

           SET DPTDNFI=$EXTRACT(DPTDNF)

           SET DPTDNM=$PIECE($PIECE(DPTDN,",",2)," ",2)

           SET DPTDNMI=$EXTRACT(DPTDNM)

 +1       ;

INIT2      SET DPTDNL2=$PIECE(DPTDN2,",")

           SET DPTDNF2=$PIECE($PIECE(DPTDN2,",",2)," ")

           SET DPTDNFI2=$EXTRACT(DPTDNF2)

           SET DPTDNM2=$PIECE($PIECE(DPTDN2,",",2)," ",2)

           SET DPTDNMI2=$EXTRACT(DPTDNM2)

 +1        QUIT 

 +2       ;

NAME      ;

 +1        DO COMPARE

 +2        IF $ORDER(^DPT(XDRCD2,.01,0))

               DO OTHER2

 +3        QUIT 

 +4       ;

OTHER     ;

 +1        FOR DPTDNO=0:0

               SET DPTDNO=$ORDER(^DPT(XDRCD,.01,DPTDNO))

               IF 'DPTDNO

                   QUIT 

               SET DPTDN=$PIECE(^DPT(XDRCD,.01,DPTDNO,0),U,1)

               IF '$DATA(DPTDN2)

                   SET DPTDN2=XDRCD2(XDRFL,XDRCD2,.01,"I")

               DO INIT1

               DO NAME

 +2        QUIT 

 +3       ;

OTHER2    ;

 +1        FOR DPTDNO2=0:0

               SET DPTDNO2=$ORDER(^DPT(XDRCD2,.01,DPTDNO2))

               IF 'DPTDNO2

                   QUIT 

               SET DPTDN2=$PIECE(^DPT(XDRCD2,.01,DPTDNO2,0),U,1)

               DO INIT2

               DO COMPARE

 +2        QUIT 

 +3       ;

COMPARE   ;

 +1        IF '$DATA(DPTDN("TEST SCORE"))

               SET DPTDN("TEST SCORE")=DPTDN("NO MATCH")

 +2        IF DPTDN=DPTDN2

               SET DPTDN("TEST SCORE2")=DPTDN("MATCH")

               GOTO COMPAREX

 +3        IF DPTDNF=DPTDNF2

               IF DPTDNL=DPTDNL2

                   SET DPTDN("TEST SCORE2")=DPTDN("MATCH")*.8

                   GOTO COMPAREX

 +4        IF DPTDNFI=DPTDNFI2

               IF DPTDNL=DPTDNL2

                   SET DPTDN("TEST SCORE2")=DPTDN("MATCH")*.6

                   GOTO COMPAREX

 +5        IF DPTDNL=DPTDNL2

               SET DPTDN("TEST SCORE2")=DPTDN("MATCH")*.4

               GOTO COMPAREX

 +6        SET X=DPTDNL

           DO SOU^DICM1

           SET DPTDNLS=X

           SET X=DPTDNL2

           DO SOU^DICM1

           SET DPTDNL2S=X

 +7        SET X=DPTDNF

           DO SOU^DICM1

           SET DPTDNFS=X

           SET X=DPTDNF2

           DO SOU^DICM1

           SET DPTDNF2S=X

 +8        IF DPTDNLS=DPTDNL2S

               IF DPTDNFS=DPTDNF2S

                   SET DPTDN("TEST SCORE2")=DPTDN("MATCH")*.6

                   GOTO COMPAREX

 +9        IF DPTDNFS=DPTDNF2S

               SET DPTDN("TEST SCORE2")=DPTDN("MATCH")*.2

               GOTO COMPAREX

 +10       SET DPTDN("TEST SCORE2")=DPTDN("NO MATCH")

COMPAREX  ;

 +1        IF DPTDN("TEST SCORE2")>(DPTDN("TEST SCORE"))

               SET DPTDN("TEST SCORE")=DPTDN("TEST SCORE2")

 +2        KILL X,DPTDNLS,DPTDNL2S,DPTDNFS,DPTDNF2S,DPTDN("TEST SCORE2")

 +3        QUIT 

 +4       ;

EOJ       ;

 +1        IF $DATA(DPTDN("TEST SCORE"))

               SET XDRD("TEST SCORE")=DPTDN("TEST SCORE")

 +2        KILL DPTDN,DPTDN2,DPTDNF,DPTDNF2,DPTDNL,DPTDNL2,DPTDNM,DPTDNM2

 +3        KILL DPTDNMI,DPTDNMI2,DPTDNFI,DPTDNFI2,DPTDNO,DPTDNO2

 +4        QUIT