source: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XDRDPDTI.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 931 bytes
RevLine 
[613]1XDRDPDTI ;IHS/OHPRD/JCM - CHECKS POTENTIAL DUPLICATES IF THRESHOLD RAISED; [ 08/13/92 09:50 AM ]
2 ;;7.3;TOOLKIT;;Apr 25, 1995
3START ;
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")
11END D EOJ
12 Q
13 ;
14CHECK ;
15 D EN^XDRDUP
16 I XDRD("DUPSCORE")<XDRDSCOR("PDT") D DELETE I 1
17 E D DIE
18 Q
19 ;
20DELETE ;
21 S DIK="^VA(15,",DA=XDRDPDA D ^DIK K DIK,DA,DIC
22 Q
23DIE ;
24 S DIE="^VA(15,",DA=XDRDPDA,DR=".17////"_XDRDSCOR("PDT%")
25 D ^DIE K DIE,DA,DR
26 Q
27 ;
28EOJ ;
29 K:'$D(XDRDPAIR) ^VA(15.1,XDRFL,"APDTI")
30 K XDRDPAIR,XDRDPDA,XDRDPDTI,XDRD("NOADD")
31 Q
Note: See TracBrowser for help on using the repository browser.