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

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

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1XDRDLIST ;SF-IRMFO/IHS/OHPRD/JCM - PRINT POTENTIAL AND VERIFIED DUPLICATES; [ 08/13/92 09:50 AM ] ;4/8/98 10:21
2 ;;7.3;TOOLKIT;**23**;Apr 25, 1995
3 ;;
4 N XDRFL,XDRFLD
5START ;
6 S XDRQFLG=0
7 ;W !!,"Choose type of list."
8 S DIR("?")="BRIEF prints the fields: RECORD1, RECORD2 and the IEN for each entry. CAPTIONED is FileMan's CAPTIONED format."
9 S DIR("A")="Choose type of list",DIR(0)="SO^1:BRIEF;2:CAPTIONED" D ^DIR K DIR G:$D(DIRUT) END
10 S XDRFLD=Y
11 I '$D(XDRFL) S DIC("A")="Select File you wish to list for: " D FILE^XDRDQUE G:XDRQFLG END
12 D ASK G:XDRQFLG END ; Asks which type of listing you want
13 D @$S(XDRDLIST("ASK")=1:"POT",XDRDLIST("ASK")=2:"NOT",XDRDLIST("ASK")=3:"VER",1:"MERGED")
14 G:'XDRQFLG START
15END D EOJ ; End of job and cleans up variables
16 Q ; End of routine
17 ;
18ASK ;
19 K XDRDLIST("ASK")
20 S XDRDLIST("GL")=$S($D(^DIC(XDRFL,0,"GL")):$P(^DIC(XDRFL,0,"GL"),U,2),1:"")
21 I XDRDLIST("GL")']"" S XDRQFLG=1 G ASKX
22 W !!,"This utility provides reports on verified and unverified potential duplicates."
23WHCH S DIR("A")="report",DIR(0)="SO^1:UNVERIFIED potential duplicates;2:NOT READY TO MERGE VERIFIED duplicates;3:READY TO MERGE VERIFIED duplicates;4:MERGED VERIFIED duplicates" D ^DIR K DIR
24 I $D(DIRUT) S XDRQFLG=1 G ASKX
25 I Y=" " S XDRQFLG=1 G ASKX
26 S XDRDLIST("ASK")=$S(Y=1:1,Y=2:2,Y=3:3,1:4)
27 I XDRDLIST("ASK")=1,'$D(^VA(15,"APOT",XDRDLIST("GL"))) W !,"There are no unverified potential duplicates at this time.",$C(7) K XDRDLIST("ASK") G WHCH
28 I XDRDLIST("ASK")=3,'$D(^VA(15,"AMRG",XDRDLIST("GL"),1)) W !,"There are no READY TO MERGE verified duplicates at this time.",$C(7) K XDRDLIST("ASK") G WHCH
29 I XDRDLIST("ASK")=2,'$D(^VA(15,"AMRG",XDRDLIST("GL"),0)) W !,"There are no NOT READY TO MERGE verified duplicates at this time.",$C(7) K XDRDLIST("ASK") G WHCH
30 I XDRDLIST("ASK")=4,'$D(^VA(15,"AFR",XDRDLIST("GL"))) W !,"There are no MERGED VERIFIED duplicates at this time.",$C(7) K XDRDLIST("ASK") G WHCH
31 ;
32ASKX ;
33 Q
34 ;
35POT ;
36 S DIC="^VA(15,",L="",FLDS=$S(XDRFLD=1:"[XDR BRIEF LIST]",1:"[CAPTIONED]")
37 S BY="[XDR POTENTIAL DUPLICATE LIST]"
38 S DIS(0)="I $P($P(^VA(15,D0,0),U),"";"",2)=XDRDLIST(""GL"")"
39 S DHD="Unverified Potential Duplicates"
40 D EN1^DIP K DIC,DIS,DHD,L,FLDS,BY
41 Q
42 ;
43VER ;
44 S DIC="^VA(15,",L="",FLDS=$S(XDRFLD=1:"[XDR BRIEF LIST]",1:"[CAPTIONED]")
45 ;S DIC="^VA(15,",L="",FLDS="[CAPTIONED]"
46 S BY="[XDR READY TO MERGE LIST]"
47 S DIS(0)="I $P($P(^VA(15,D0,0),U),"";"",2)=XDRDLIST(""GL"")"
48 S DHD="Verified Duplicates Ready to Merge"
49 D EN1^DIP K DIC,DIS,DHD,L,FLDS,BY
50 Q
51 ;
52NOT ;
53 S DIC="^VA(15,",L="",FLDS=$S(XDRFLD=1:"[XDR BRIEF LIST]",1:"[CAPTIONED]")
54 ;S DIC="^VA(15,",L="",FLDS="[CAPTIONED]"
55 S BY="[XDR NOT READY TO MERGE LIST]"
56 S DIS(0)="I $P($P(^VA(15,D0,0),U),"";"",2)=XDRDLIST(""GL"")"
57 S DHD="Verified Duplicates Not Ready to Merge"
58 D EN1^DIP K DIC,DIS,DHD,L,FLDS,BY
59 Q
60MERGED ;
61 S DIC="^VA(15,",L="",FLDS=$S(XDRFLD=1:"[XDR BRIEF LIST]",1:"[XDR MERGED LIST]")
62 ;S DIC="^VA(15,",L="",FLDS="[XDR MERGED LIST]"
63 S BY="[XDR MERGED LIST]"
64 S DIS(0)="I $P($P(^VA(15,D0,0),U),"";"",2)=XDRDLIST(""GL"")"
65 S DHD="Verified Duplicates that are Merged"
66 D EN1^DIP K DIC,DIS,DHD,L,FLDS,BY
67 Q
68EOJ ;
69 K XDRDLIST,DIRUT,X,Y,DTOUT,DUOUT,XDRD,XDRFL,XDRQFLG
70 Q
Note: See TracBrowser for help on using the repository browser.