XDRDUP ;SF-IRMFO/IHS/OHPRD/JCM - COMPARES TWO RECORDS TO SEE IF DUP OF EACH OTHER;   [ 08/13/92  09:50 AM ] ;04/30/2001  10:35
 ;;7.3;TOOLKIT;**23,46,49,56**;Apr 25, 1995
 ;;
START ;
 K % S XDRQFLG=0
 I '$D(XDRCD)!('$D(XDRCD2)) S XDRERR=7 D ^XDREMSG G END
 I '$D(XDRDSCOR) D ^XDRDSCOR G:XDRQFLG END
 F %="MAX","PDT" S XDRDSCOR(%)=0
 S:$D(XDRDSCOR("VDT%")) XDRDSCOR("VDT")=0
 D VALUE I $D(XDRCD2)'>1 Q
 ;   sites are requesting to merge test patients, REMing next line 
 ;I XDRFL=2,$E(XDRCD2(2,XDRCD2,.09,"I"),1,5)="00000" Q
 D MAIN
END D EOJ
 Q
 ;
MAIN ;
 F XDRDUPFL=0:0 S XDRDUPFL=$O(XDRDSCOR("DR",XDRDUPFL)) Q:'XDRDUPFL  D DIQ1
 K XDRDUPFL
 I $D(XDRCD2)'>0 S ^XTMP("XDRERR",2,XDRDTYPE,"NO DATA",XDRCD2)="" Q
 S XDRD("DUPSCORE")=0
 F XDRDTO=0:0 S XDRDTO=$O(XDRDTEST(XDRDTO)) Q:'XDRDTO!(XDRQFLG)  D TEST
 K XDRDTO F %=0:0 S %=$O(XDRCD2(%)) Q:'%  K XDRCD2(%)
 K %
 S XDRDSCOR("PDT")="."_XDRDSCOR("PDT%")*XDRDSCOR("MAX")
 S:$D(XDRDSCOR("VDT%")) XDRDSCOR("VDT")="."_XDRDSCOR("VDT%")*XDRDSCOR("MAX")
 I XDRDSCOR("MAX")>0 D
 . N J1,J2
 . S J1=+$J(XDRD("DUPSCORE")/XDRDSCOR("MAX"),1,2)
 . S (^(J1),J2)=$G(^TMP("XDRDUPSC",XDRFL,XDRDTYPE,J1))+1
 . I J1>.6 S ^TMP("XDRDUPS1",XDRFL,XDRDTYPE,J1,J2)=XDRCD_U_XDRCD2
 I '$D(XDRD("NOADD")),XDRD("DUPSCORE")'<XDRDSCOR("PDT"),'$D(XDRDCOMP) D ^XDRDADD
MAINX Q
 ;
DIQ1 ;
 S DIC=XDRDUPFL,DIQ(0)="I",DR=XDRDSCOR("DR",XDRDUPFL)
 I '$D(XDRCD(XDRDUPFL)) S DA=XDRCD,DIQ="XDRCD" D EN^DIQ1 K DA,D0
 S DA=XDRCD2,DIQ="XDRCD2" D EN^DIQ1 K DIC,DR,DIQ,DA,D0
 Q
 ;
TEST ;
 S XDRD("TEST ROUTINE")=$S($P($P(XDRDTEST(XDRDTO),U,3),"-",2)]"":$P($P(XDRDTEST(XDRDTO),U,3),"-")_"^"_$P($P(XDRDTEST(XDRDTO),U,3),"-",2),1:U_$P(XDRDTEST(XDRDTO),U,3))
 S X=$P(XDRD("TEST ROUTINE"),U,2) X ^%ZOSF("TEST") K X I '$T S XDRERR=8 D ^XDREMSG G TESTX
 S XDRD("TEST SCORE")=0
 D @XDRD("TEST ROUTINE")
 S XDRDUP("TEST SCORE",XDRDTO)=XDRD("TEST SCORE")
 S XDRD("DUPSCORE")=XDRD("DUPSCORE")+(XDRD("TEST SCORE"))
 S:+XDRD("TEST SCORE")'=0 XDRDSCOR("MAX")=XDRDSCOR("MAX")+($P(XDRDTEST(XDRDTO),U,6))
TESTX K XDRD("TEST ROUTINE")
 Q
 ;
EN ; EP - Called by XDRDADJ,XDRDPDTI
 ;
 N XDRDTYPE
 S XDRDTYPE="BASIC"
 K XDRCD,XDRCD2
 S XDRCD=+$P(^VA(15,XDRDPDA,0),U)
 S XDRCD2=+$P(^VA(15,XDRDPDA,0),U,2)
 S XDRFL=$O(^VA(15.1,"AGL",$P($P(^VA(15,XDRDPDA,0),U),";",2),0))
 I 'XDRFL S XDRERR=6 D ^XDREMSG G ENX
 S:XDRFL XDRD(0)=^VA(15.1,XDRFL,0)
 D START
ENX Q
 ;
EOJ ;
 I $D(XDRDPDA),'$D(XDRDPDTI) K XDRFL,XDRDSCOR,XDRDTEST,XDRD,XDRQFLG,XDRCD,XDRCD2
 Q
VALUE ;
 S DA=XDRCD2 K XDRCD2 S XDRCD2=DA
 F XDRI=0:0 S XDRI=$O(XDRDSCOR("DR",XDRI)) Q:XDRI'>0  D
 . S DIC=XDRI,DA=XDRCD2,DIQ(0)="I",DIQ="XX",DR=XDRDSCOR("DR",XDRI)
 . K XX
 . D EN^DIQ1
 . M XDRCD2=XX K XX,DA,DIC,DR,DIQ
 Q