| [613] | 1 | XDRDPRGE ;SF-IRMFO/IHS/OHPRD/JCM - PURGE DUPLICATE RECORD FILE; [ 08/13/92 09:50 AM ] ;08/24/99 09:59
|
|---|
| 2 | ;;7.3;TOOLKIT;**23,42**;Apr 25, 1995
|
|---|
| 3 | ;;
|
|---|
| 4 | START ;
|
|---|
| 5 | D INIT G:XDRQFLG END
|
|---|
| 6 | D ASK G:XDRQFLG END
|
|---|
| 7 | DQ ; Entry point for Tasked job
|
|---|
| 8 | I XDRDPRGE("CHOICE")="BOTH" D BOTH I 1
|
|---|
| 9 | E D XREF
|
|---|
| 10 | END D EOJ
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | INIT ;
|
|---|
| 14 | S XDRQFLG=0
|
|---|
| 15 | D FILE
|
|---|
| 16 | G:XDRQFLG INITX
|
|---|
| 17 | S XDRGL=^DIC(XDRFL,0,"GL")
|
|---|
| 18 | INITX Q
|
|---|
| 19 | ;
|
|---|
| 20 | FILE ;
|
|---|
| 21 | ;S DIC("S")=
|
|---|
| 22 | S DIC(0)="QEAZ"
|
|---|
| 23 | S DIC("A")="Select File to Be Checked to purge: "
|
|---|
| 24 | S DIC="^VA(15.1," D ^DIC K DIC,X
|
|---|
| 25 | I Y=-1 S XDRQFLG=1 G FILEX
|
|---|
| 26 | S XDRFL=$P(Y(0),U) K Y
|
|---|
| 27 | FILEX Q
|
|---|
| 28 | ;
|
|---|
| 29 | ASK ;
|
|---|
| 30 | S DIR(0)="S^1:POTENTIAL DUPLICATES PURGE;2:VERIFIED NOT DUPLICATES PURGE;3:ALL RECORDS EXCEPT VERIFIED DUPLICATES PURGE"
|
|---|
| 31 | S DIR("A")="Choice "
|
|---|
| 32 | S DIR("?",1)="Enter a 1 if you wish to purge only the potential non-verified duplicates"
|
|---|
| 33 | S DIR("?",2)="Enter a 2 if you wish to purge only Verified Non-Duplicates"
|
|---|
| 34 | S DIR("?",3)="Enter a 3 if you wish to purge everything except verifed duplicates"
|
|---|
| 35 | D ^DIR K DIR
|
|---|
| 36 | I $D(DIRUT) S XDRQFLG=1 G ASKX
|
|---|
| 37 | S (XDRDPRGE("XREF"),XDRDPRGE("CHOICE"))=$S(Y=1:"APOT",Y=2:"ANOT",1:"BOTH") K Y
|
|---|
| 38 | S DIR(0)="Y"
|
|---|
| 39 | S DIR("A")="Do you wish to Queue this purging (Y/N)"
|
|---|
| 40 | D ^DIR K DIR
|
|---|
| 41 | I $D(DIRUT) S XDRQFLG=1 G ASKX
|
|---|
| 42 | I Y D QUEUE
|
|---|
| 43 | ASKX K Y
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
| 46 | QUEUE ;
|
|---|
| 47 | S ZTRTN="DQ^XDRDPRGE",ZTIO="",ZTDESC="Duplicate Record Purge"
|
|---|
| 48 | F %="XDRFL","XDRGL","XDRDPRGE(" S ZTSAVE(%)=""
|
|---|
| 49 | D ^%ZTLOAD K ZTSK
|
|---|
| 50 | S XDRQFLG=1
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
| 53 | BOTH ;
|
|---|
| 54 | S XDRDPRGE("XREF")="APOT" D XREF
|
|---|
| 55 | S XDRDPRGE("XREF")="ANOT" D XREF
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | XREF ;
|
|---|
| 59 | G:'$D(^VA(15,XDRDPRGE("XREF"))) XREFX
|
|---|
| 60 | S XDRDPRGE("GL")="^VA(15,"_""""_XDRDPRGE("XREF")_""""_","_""""_$P(XDRGL,U,2)_""""_","
|
|---|
| 61 | S XDRDPRGE("RCDS")=0,DIK="^VA(15," F XDRDI1=0:0 S XDRDPRGE("RCDS")=$O(@(XDRDPRGE("GL")_"XDRDPRGE(""RCDS""))")) Q:XDRDPRGE("RCDS")="" S DA=$O(@(XDRDPRGE("GL")_"XDRDPRGE(""RCDS""),0)")) D ^DIK
|
|---|
| 62 | XREFX K XDRDI1,DIK,DA,XDRDPRGE("GL")
|
|---|
| 63 | Q
|
|---|
| 64 | ;
|
|---|
| 65 | EOJ ;
|
|---|
| 66 | K XDRFL,XDRGL,XDRDPRGE
|
|---|
| 67 | S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 68 | Q
|
|---|
