32 lines
931 B
Mathematica
32 lines
931 B
Mathematica
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
|