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

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1XDRDPRGE ;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 ;;
4START ;
5 D INIT G:XDRQFLG END
6 D ASK G:XDRQFLG END
7DQ ; Entry point for Tasked job
8 I XDRDPRGE("CHOICE")="BOTH" D BOTH I 1
9 E D XREF
10END D EOJ
11 Q
12 ;
13INIT ;
14 S XDRQFLG=0
15 D FILE
16 G:XDRQFLG INITX
17 S XDRGL=^DIC(XDRFL,0,"GL")
18INITX Q
19 ;
20FILE ;
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
27FILEX Q
28 ;
29ASK ;
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
43ASKX K Y
44 Q
45 ;
46QUEUE ;
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 ;
53BOTH ;
54 S XDRDPRGE("XREF")="APOT" D XREF
55 S XDRDPRGE("XREF")="ANOT" D XREF
56 Q
57 ;
58XREF ;
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
62XREFX K XDRDI1,DIK,DA,XDRDPRGE("GL")
63 Q
64 ;
65EOJ ;
66 K XDRFL,XDRGL,XDRDPRGE
67 S:$D(ZTQUEUED) ZTREQ="@"
68 Q
Note: See TracBrowser for help on using the repository browser.