| 1 | XDRDFPD ;IHS/OHPRD/LAB - find all potential duplicates for an entry in a file ;09/13/93 08:42
|
|---|
| 2 | ;;7.3;TOOLKIT;;Apr 25, 1995
|
|---|
| 3 | START ;
|
|---|
| 4 | INIT ;Initialization
|
|---|
| 5 | W !,"This option will collect all Potential Duplicates for an entry in a file.",!,"It will then add any pairs found to the Duplicate Record file.",!
|
|---|
| 6 | D PROCESS
|
|---|
| 7 | G:XDRQFLG END
|
|---|
| 8 | D INFORM
|
|---|
| 9 | END D EOJ
|
|---|
| 10 | Q
|
|---|
| 11 | PROCESS ;
|
|---|
| 12 | K XDRD
|
|---|
| 13 | S XDRQFLG=0,XDRDTYPE="b"
|
|---|
| 14 | S DIC("A")="Find Potential Duplicates for entry in what file: " D FILE^XDRDQUE
|
|---|
| 15 | G:XDRQFLG PROCESSX
|
|---|
| 16 | D SETUP
|
|---|
| 17 | S XDRGL=^DIC(XDRFL,0,"GL")
|
|---|
| 18 | I '$D(XDRCD) D LKUP Q:XDRQFLG
|
|---|
| 19 | W:'$D(ZTQUEUED) !!,"Hold On... This may take a little while...",!
|
|---|
| 20 | ;
|
|---|
| 21 | D POSDUPS^XDRDMAIN
|
|---|
| 22 | D:$D(^TMP("XDRD",$J,XDRFL)) CHECK
|
|---|
| 23 | PROCESSX Q
|
|---|
| 24 | EOJ ;clean up
|
|---|
| 25 | K XDRQFLG,XDRD,XDRDSCOR,XDRDTEST,XDRFL,XDRGL,XDRCD,XDRCD2,XDRDCNT,XDRDMAIN,XDRDTYPE,XDRDUP,XDRDFPD
|
|---|
| 26 | K ^TMP("XDRD",$J)
|
|---|
| 27 | Q
|
|---|
| 28 | EN ;Entry Point (caller must pass XDRCD,XDRFL)
|
|---|
| 29 | I '$D(XDRCD) S XDRERR=15 D ^XDREMSG G ENX
|
|---|
| 30 | I '$D(XDRFL) S XDRERR=14 D ^XDREMSG G ENX
|
|---|
| 31 | I '$D(^VA(15.1,XDRFL,0)) S XDRERR=6 D ^XDREMSG G ENX
|
|---|
| 32 | D PROCESS
|
|---|
| 33 | ENX ;
|
|---|
| 34 | K XDRDFPD,XDRDSCOR,XDRD,XDRDTEST,XDRGL,XDRCD2,XDRDCNT,XDRDMAIN,XDRDTYPE,XDRDUP
|
|---|
| 35 | Q
|
|---|
| 36 | LKUP ;
|
|---|
| 37 | S DIC=XDRGL,DIC(0)="AEMQ",DIC("A")="Find Potential Duplicates for "_$P(^DIC(XDRFL,0),U)_": "
|
|---|
| 38 | D ^DIC K DIC,DA
|
|---|
| 39 | I Y=-1 S XDRQFLG=1 G LKUPX
|
|---|
| 40 | S XDRCD=+Y
|
|---|
| 41 | LKUPX ;
|
|---|
| 42 | Q
|
|---|
| 43 | SETUP ;
|
|---|
| 44 | S XDRD("COLLECTION ROUTINE")=$S($P($P(XDRD(0),U,9),"-",2)]"":$P($P(XDRD(0),U,9),"-")_"^"_$P($P(XDRD(0),U,9),"-",2),1:U_$P(XDRD(0),U,9))
|
|---|
| 45 | I '$D(XDRD("DMAILGRP")),$D(XDRD(0)),$P(XDRD(0),U,11),$D(^XMB(3.8,$P(XDRD(0),U,11),1,"B")) F XDRI=0:0 S XDRI=$O(^XMB(3.8,$P(XDRD(0),U,11),1,"B",XDRI)) Q:'XDRI S XDRD("DMAILGRP",XDRI)=""
|
|---|
| 46 | K XDRI
|
|---|
| 47 | D ^XDRDSCOR ; Sets up Duplicate Test Scores
|
|---|
| 48 | SETUPX ;
|
|---|
| 49 | Q
|
|---|
| 50 | CHECK ;check for duplicates and add to Duplicate record file
|
|---|
| 51 | F XDRCD2=0:0 S XDRCD2=$O(^TMP("XDRD",$J,XDRFL,XDRCD2)) Q:'XDRCD2!(XDRQFLG) D CHECK^XDRDMAIN
|
|---|
| 52 | Q
|
|---|
| 53 | INFORM ;
|
|---|
| 54 | S XDRDFPD("PAIR")="",%=0 F S XDRDFPD("PAIR")=$O(^VA(15,"APOT",$P(XDRGL,"^",2),XDRDFPD("PAIR"))) Q:XDRDFPD("PAIR")="" D
|
|---|
| 55 | .I $P(XDRDFPD("PAIR"),U)=XDRCD!($P(XDRDFPD("PAIR"),U,2)=XDRCD) S %=%+1,XDRDFPD("FOUND",%)=XDRDFPD("PAIR")
|
|---|
| 56 | .Q
|
|---|
| 57 | I '$D(XDRDFPD("FOUND")) W !!,"NO Potential Duplicates were found for ",$P(^DIC(XDRFL,0),U),": ",$P(@(XDRGL_XDRCD_",0)"),U) Q
|
|---|
| 58 | W !!,"The following ",$P(^DIC(XDRFL,0),U)," entry(ies) are now in the Duplicate ",!,"Record file as Potential Duplicates to ",!,$P(^DIC(XDRFL,0),U),": ",$P(@(XDRGL_XDRCD_",0)"),U)
|
|---|
| 59 | S X="" F S X=$O(XDRDFPD("FOUND",X)) Q:X="" D
|
|---|
| 60 | .W !?20,$S($P(XDRDFPD("FOUND",X),U)=XDRCD:$P(@(XDRGL_$P(XDRDFPD("FOUND",X),U,2)_",0)"),U),1:$P(@(XDRGL_$P(XDRDFPD("FOUND",X),U)_",0)"),U))
|
|---|
| 61 | .Q
|
|---|
| 62 | Q
|
|---|
