BPMPTTR.m

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

 ;;1.0;IHS PATIENT MERGE;;MAR 01, 2010

 ;IHS/OIT/LJF 07/13/2006 took original ^DPTDZTR routine and renamespaced it

START ;

 D INIT

 D COMPARE

END D EOJ

 Q

 ;

INIT ;

 D EOJ

 S BPMTR=$G(XDRCD(9000001,XDRCD,1108,"I")),BPMTR2=$G(XDRCD2(9000001,XDRCD2,1108,"I"))

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

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

 Q

 ;

COMPARE ;

 I BPMTR']""!(BPMTR2']"") G COMPAREX

 I BPMTR=BPMTR2 S XDRD("TEST SCORE")=BPMTR("MATCH") G COMPAREX

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

COMPAREX Q

 ;

EOJ ;

 K BPMTR,BPMTR2

 Q

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

 +1       ;;1.0;IHS PATIENT MERGE;;MAR 01, 2010

 +2       ;IHS/OIT/LJF 07/13/2006 took original ^DPTDZTR routine and renamespaced it

START     ;

 +1        DO INIT

 +2        DO COMPARE

END        DO EOJ

 +1        QUIT 

 +2       ;

INIT      ;

 +1        DO EOJ

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

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

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

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

 +5        QUIT 

 +6       ;

COMPARE   ;

 +1        IF BPMTR']""!(BPMTR2']"")

               GOTO COMPAREX

 +2        IF BPMTR=BPMTR2

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

               GOTO COMPAREX

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

COMPAREX   QUIT 

 +1       ;

EOJ       ;

 +1        KILL BPMTR,BPMTR2

 +2        QUIT