Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XDRDPDTI

XDRDPDTI.m

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