1 | XDRDPDTI ;IHS/OHPRD/JCM - CHECKS POTENTIAL DUPLICATES IF THRESHOLD RAISED; [ 08/13/92 09:50 AM ]
|
---|
2 | ;;7.3;TOOLKIT;;Apr 25, 1995
|
---|
3 | START ;
|
---|
4 | I '$D(^VA(15,"APOT",$P(XDRGL,U,2))) G END
|
---|
5 | S (XDRDPDTI,XDRD("NOADD"))=""
|
---|
6 | S XDRDPAIR=$S($D(^VA(15.1,XDRFL,"APDTI")):^VA(15.1,XDRFL,"APDTI"),1:0)
|
---|
7 | 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
|
---|
8 | K XDRDI
|
---|
9 | I XDRDPAIR]"" S ^VA(15.1,XDRFL,"APDTI")=XDRDPAIR
|
---|
10 | E K ^VA(15.1,XDRFL,"APDTI")
|
---|
11 | END D EOJ
|
---|
12 | Q
|
---|
13 | ;
|
---|
14 | CHECK ;
|
---|
15 | D EN^XDRDUP
|
---|
16 | I XDRD("DUPSCORE")<XDRDSCOR("PDT") D DELETE I 1
|
---|
17 | E D DIE
|
---|
18 | Q
|
---|
19 | ;
|
---|
20 | DELETE ;
|
---|
21 | S DIK="^VA(15,",DA=XDRDPDA D ^DIK K DIK,DA,DIC
|
---|
22 | Q
|
---|
23 | DIE ;
|
---|
24 | S DIE="^VA(15,",DA=XDRDPDA,DR=".17////"_XDRDSCOR("PDT%")
|
---|
25 | D ^DIE K DIE,DA,DR
|
---|
26 | Q
|
---|
27 | ;
|
---|
28 | EOJ ;
|
---|
29 | K:'$D(XDRDPAIR) ^VA(15.1,XDRFL,"APDTI")
|
---|
30 | K XDRDPAIR,XDRDPDA,XDRDPDTI,XDRD("NOADD")
|
---|
31 | Q
|
---|