DPTDZTR.m

DPTDZTR ; IHS/TUCSON/JCM - IHS COMPARE TRIBE OF MEMBERSHIPS ;

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

START ;

 D INIT

 D COMPARE

END D EOJ

 Q

 ;

INIT ;

 D EOJ

 S DPTDZTR=$G(XDRCD(9000001,XDRCD,1108,"I")),DPTDZTR2=$G(XDRCD2(9000001,XDRCD2,1108,"I"))

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

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

 Q

 ;

COMPARE ;

 I DPTDZTR']""!(DPTDZTR2']"") G COMPAREX

 I DPTDZTR=DPTDZTR2 S XDRD("TEST SCORE")=DPTDZTR("MATCH") G COMPAREX

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

COMPAREX Q

 ;

EOJ ;

 K DPTDZTR,DPTDZTR2

 Q

DPTDZTR   ; IHS/TUCSON/JCM - IHS COMPARE TRIBE OF MEMBERSHIPS ;

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

START     ;

 +1        DO INIT

 +2        DO COMPARE

END        DO EOJ

 +1        QUIT 

 +2       ;

INIT      ;

 +1        DO EOJ

 +2        SET DPTDZTR=$GET(XDRCD(9000001,XDRCD,1108,"I"))

           SET DPTDZTR2=$GET(XDRCD2(9000001,XDRCD2,1108,"I"))

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

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

 +5        QUIT 

 +6       ;

COMPARE   ;

 +1        IF DPTDZTR']""!(DPTDZTR2']"")

               GOTO COMPAREX

 +2        IF DPTDZTR=DPTDZTR2

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

               GOTO COMPAREX

 +3        SET XDRD("TEST SCORE")=DPTDZTR("NO MATCH")

COMPAREX   QUIT 

 +1       ;

EOJ       ;

 +1        KILL DPTDZTR,DPTDZTR2

 +2        QUIT