DPTDOB.m

DPTDOB ; IHS/TUCSON/JCM - COMPARES DATE OF BIRTHS ;

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

START ;

 D INIT

EN ; EP - Entry point for comparing dates

 D COMPARE

END D EOJ

 Q

 ;

INIT ;

 K DPTDOB,DPTDOB2

 S DPTDOB=$G(XDRCD(XDRFL,XDRCD,.03,"I")),DPTDOB2=$G(XDRCD2(XDRFL,XDRCD2,.03,"I"))

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

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

 Q

 ;

COMPARE ;

 I DPTDOB']""!(DPTDOB2']"") G COMPAREX

 I DPTDOB=DPTDOB2 S XDRD("TEST SCORE")=DPTDOB("MATCH") G COMPAREX

 S DPTDOB("CNT")=0

 F DPTDOBI=1:1:7 Q:DPTDOB("CNT")>2  I $E(DPTDOB,DPTDOBI)'=$E(DPTDOB2,DPTDOBI) S DPTDOB("CNT")=DPTDOB("CNT")+1

 K DPTDOBI

 S XDRD("TEST SCORE")=$S(DPTDOB("CNT")>2:DPTDOB("NO MATCH"),1:(DPTDOB("MATCH")*.8))

COMPAREX Q

 ;

EOJ ;

 K DPTDOB,DPTDOB2

 Q

DPTDOB    ; IHS/TUCSON/JCM - COMPARES DATE OF BIRTHS ;

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

START     ;

 +1        DO INIT

EN        ; EP - Entry point for comparing dates

 +1        DO COMPARE

END        DO EOJ

 +1        QUIT 

 +2       ;

INIT      ;

 +1        KILL DPTDOB,DPTDOB2

 +2        SET DPTDOB=$GET(XDRCD(XDRFL,XDRCD,.03,"I"))

           SET DPTDOB2=$GET(XDRCD2(XDRFL,XDRCD2,.03,"I"))

 +3        SET DPTDOB("MATCH")=$PIECE(XDRDTEST(XDRDTO),U,6)

 +4        SET DPTDOB("NO MATCH")=$PIECE(XDRDTEST(XDRDTO),U,7)

 +5        QUIT 

 +6       ;

COMPARE   ;

 +1        IF DPTDOB']""!(DPTDOB2']"")

               GOTO COMPAREX

 +2        IF DPTDOB=DPTDOB2

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

               GOTO COMPAREX

 +3        SET DPTDOB("CNT")=0

 +4        FOR DPTDOBI=1:1:7

               IF DPTDOB("CNT")>2

                   QUIT 

               IF $EXTRACT(DPTDOB,DPTDOBI)'=$EXTRACT(DPTDOB2,DPTDOBI)

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

 +5        KILL DPTDOBI

 +6        SET XDRD("TEST SCORE")=$SELECT(DPTDOB("CNT")>2:DPTDOB("NO MATCH"),1:(DPTDOB("MATCH")*.8))

COMPAREX   QUIT 

 +1       ;

EOJ       ;

 +1        KILL DPTDOB,DPTDOB2

 +2        QUIT