XDRDPDTI ;IHS/OHPRD/JCM - CHECKS POTENTIAL DUPLICATES IF THRESHOLD RAISED;   [ 08/13/92  09:50 AM ]
 ;;7.3;TOOLKIT;;Apr 25, 1995
START ;
 I '$D(^VA(15,"APOT",$P(XDRGL,U,2))) G END
 S (XDRDPDTI,XDRD("NOADD"))=""
 S XDRDPAIR=$S($D(^VA(15.1,XDRFL,"APDTI")):^VA(15.1,XDRFL,"APDTI"),1:0)
 F XDRDI=0:0 S XDRDPAIR=$O(^VA(15,"APOT",$P(XDRGL,U,2),XDRDPAIR)) Q:XDRDPAIR=""!($P(^VA(15.1,XDRFL,0),U,2)="h")  S XDRDPDA=$O(^VA(15,"APOT",$P(XDRGL,U,2),XDRDPAIR,"")) I $D(^VA(15,XDRDPDA,0)),$P(^(0),U,18) D CHECK
 K XDRDI
 I XDRDPAIR]"" S ^VA(15.1,XDRFL,"APDTI")=XDRDPAIR
 E  K ^VA(15.1,XDRFL,"APDTI")
END D EOJ
 Q
 ;
CHECK ;
 D EN^XDRDUP
 I XDRD("DUPSCORE")<XDRDSCOR("PDT") D DELETE I 1
 E  D DIE
 Q
 ;
DELETE ;
 S DIK="^VA(15,",DA=XDRDPDA D ^DIK K DIK,DA,DIC
 Q
DIE ;
 S DIE="^VA(15,",DA=XDRDPDA,DR=".17////"_XDRDSCOR("PDT%")
 D ^DIE K DIE,DA,DR
 Q
 ;
EOJ ;
 K:'$D(XDRDPAIR) ^VA(15.1,XDRFL,"APDTI")
 K XDRDPAIR,XDRDPDA,XDRDPDTI,XDRD("NOADD")
 Q