source: FOIAVistA/tag/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XDRMRG.m@ 1796

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

initial load of FOIAVistA 6/30/08 version

File size: 4.5 KB
Line 
1XDRMRG ;IHS/OHPRD/JCM - MERGE DUPLICATE RECORDS ;02/10/95 11:15
2 ;;7.3;TOOLKIT;;Apr 25, 1995
3START ;
4 D INIT
5 D:XDRM("PRE-MERGE")]"" @XDRM("PRE-MERGE")
6 G:XDRMRG("QFLG") END
7 D @$S('$D(XDRM("DINUMS")):"SINGLE",1:"MULTI")
8 G:XDRMRG("QFLG") END
9 I XDRM("POST-MERGE")]"" W:'$D(XDRM("NOTALK")) !!,"I will now do any post merge action that needs to occur, this may take some time please be patient." D @XDRM("POST-MERGE")
10 I XDRM("POST-MERGE")']"",$P(XDRM(0),U,26) D DELETE
11 D STATUS
12END D EOJ
13 Q
14 ;
15INIT ;
16 F XDRI="XDRMRGFR","XDRMRGTO" K ^TMP(XDRI,$J)
17 S %X=XDRGL_XDRMRG("FR")_",",%Y="^TMP(""XDRMRGFR"",$J,"_XDRMRG("FR")_"," D %XY^%RCR
18 S %X=XDRGL_XDRMRG("TO")_",",%Y="^TMP(""XDRMRGTO"",$J,"_XDRMRG("TO")_"," D %XY^%RCR
19 K %X,%Y
20 S (XDRQFLG,XDRMRG("QFLG"))=0
21 I $D(XDRM("AUTO")),'$D(XDRM("NOTALK")) S (XDRM("NOTALK"),XDRM("NON-INTERACTIVE"))=""
22 I '$D(XDRM("DINUMS")),$O(^VA(15.1,XDRFL,12,0)) F XDRI=0:0 S XDRI=$O(^(XDRI)) Q:'XDRI S XDRM("DINUMS",XDRI)=""
23 K XDRI
24 Q
25 ;
26SINGLE ;
27 S XDRMRGFL=XDRFL,XDRMRGL=XDRGL
28 I '$D(XDRM("NON-INTERACTIVE")) K DITM D DITM2 G:XDRMRG("QFLG") SINGLEX I 1
29 E D DIT0
30 D PACKAGE
31 D DITMGMRG
32SINGLEX Q
33 ;
34MULTI ;
35 S XDRMRGFL=XDRFL,XDRMRGL=XDRGL
36 I '$D(XDRM("NON-INTERACTIVE")) K DITM D DITM2 G:XDRMRG("QFLG") MULTIX I 1
37 E D DIT0
38 F XDRMRGFL=0:0 S XDRMRGFL=$O(XDRM("DINUMS",XDRMRGFL)) Q:'XDRMRGFL!(XDRMRG("QFLG")) S XDRMRGL=^DIC(XDRMRGFL,0,"GL") D @$S('$D(XDRM("NON-INTERACTIVE")):"DITM2",1:"DIT0")
39 G:XDRMRG("QFLG") MULTIX
40 S XDRMRGFL=XDRFL,XDRMRGL=XDRGL
41 D PACKAGE
42 F XDRI=0:0 S XDRI=$O(XDRM("DINUMS",XDRI)) Q:'XDRI S DITMGMRG("EXCLUDE",XDRI)=""
43 K XDRI
44 D DITMGMRG
45 F XDRMRGFL=0:0 S XDRMRGFL=$O(XDRM("DINUMS",XDRMRGFL)) Q:'XDRMRGFL S XDRMRGL=^DIC(XDRMRGFL,0,"GL") D DITMGMRG
46MULTIX Q
47 ;
48DITM2 ;
49 S:XDRMRGFL'=XDRFL X="DITM2^XDRMRG1",@^%ZOSF("TRAP") K X
50 S:$D(XDRM("NOTALK")) DITM("NOTALK")=""
51 S:'$D(DITM("NOTALK")) DITM("DDSP")=""
52 S DITM("DIMERGE")=1
53 S DITM("DFF")=XDRMRGFL,DITM("DIC")=XDRMRGL
54 S DITM("DIT(1)")=XDRMRG("FR"),DITM("DIT(2)")=XDRMRG("TO"),DITM("DDEF")=2
55 S DITM("PACKAGE")="",DITM("EXCLUDE",15)="",IOP=IO(0)
56 W:'$D(XDRM("NOTALK")) !!,"I will now merge the ",$P(^DIC(XDRMRGFL,0),U,1)," file, this may take some time please be patient."
57 D ^DITM2 K DITM,IOP
58 D:$D(DIRUT)!($D(DMSG))!($D(DUOUT)) ASK
59 K DIRUT,DMSG
60 Q
61 ;
62ASK ;
63 W !!
64 S DIR(0)="YO",DIR("A")="Do you wish to continue MERGING these records",DIR("B")="N"
65 D ^DIR
66 I $D(DTOUT)!($D(DUOUT)) S XDRMRG("QFLG")=1 G ASKX
67 S:'Y XDRMRG("QFLG")=1
68ASKX K DIR,DA,Y
69 Q
70 ;
71DIT0 ;
72 S:XDRMRGFL'=XDRFL X="DIT0^XDRMRG1",@^%ZOSF("TRAP") K X
73 W:'$D(XDRM("NOTALK")) !!,"I will now merge the ",$P(^DIC(XDRMRGFL,0),U,1)," file, this may take some time please be patient."
74 K DA
75 S (DIT("T"),DIT("F"))=XDRMRGL
76 S (D0,DA("T"))=XDRMRG("TO"),DA("F")=XDRMRG("FR")
77 D EN^DIT0 K D0,DA,DIC,DIK,DIT
78 Q
79 ;
80PACKAGE ;
81 F XDRMPKGE=0:0 S XDRMPKGE=$O(^VA(15,XDRMPDA,11,XDRMPKGE)) Q:'XDRMPKGE D:$P(^VA(15,XDRMPDA,11,XDRMPKGE,0),U,2)=1 MERGE
82 K XDRMPKGE
83 Q
84 ;
85MERGE ;
86 S X="MERGE^XDRMRG1",@^%ZOSF("TRAP") K X
87 W:'$D(XDRM("NOTALK")) !!,"I will now merge all files associated with the ",$P(^DIC(9.4,XDRMPKGE,0),U,1)," package."
88 W:'$D(XDRM("NOTALK")) !,"This may take some time, Please be patient."
89 I $D(^DIC(9.4,XDRMPKGE,20,XDRFL,0))#2,$P(^(0),U,3)]"" S XDRMRG("PKGMRG")=U_$P(^(0),U,3) D @XDRMRG("PKGMRG")
90 W:'$D(XDRM("NOTALK")) !!,"Completed merging all files associated with the ",$P(^DIC(9.4,XDRMPKGE,0),U,1)," package."
91 Q
92DITMGMRG ;
93 S X="DITMGMRG^XDRMRG1",@^%ZOSF("TRAP") K X
94 W:'$D(XDRM("NOTALK")) !!,"I will now merge all files that point to the ",$P(^DIC(XDRMRGFL,0),U,1)," file that do not have a specific package merge ... This may take some time, please be patient."
95 S DITMGMRG("FILE")=XDRMRGFL,DITMGMRG("FR")=XDRMRG("FR"),DITMGMRG("TO")=XDRMRG("TO")
96 S DITMGMRG("EXCLUDE",15)="",DITMGMRG("PACKAGE")=""
97 S:$D(XDRM("NOTALK")) DITMGMRG("NOTALK")=""
98 S:$G(XDRM("TOP FILE")) DITMGMRG("TOP FILE")=XDRM("TOP FILE")
99 D EN^DITMGMRG K DITMGMRG
100 Q
101 ;
102DELETE ;
103 W:'$D(XDRM("NOTALK")) !!,"I will now delete the From Record from the ",$P(^DIC(XDRFL,0),U,1)," file and any files that were excluded from the repointing. This may take some time, please be patient."
104 K XDRMRGFL,XDRMRGL
105 I $D(XDRM("DINUMS")) F XDRMRGFL=0:0 S XDRMRGFL=$O(XDRM("DINUMS",XDRMRGFL)) Q:'XDRMRGFL S XDRMRGL=^DIC(XDRMRGFL,0,"GL") S DIK=XDRMRGL,DA=XDRMRG("FR") D DIK
106 S DIK=XDRGL,DA=XDRMRG("FR") D DIK
107 Q
108 ;
109DIK ;
110 S X="DIK^XDRMRG1",@^%ZOSF("TRAP") K X
111 D ^DIK K DIK,DA
112 Q
113STATUS ;
114 S DIE="^VA(15,",DA=XDRMPDA,DR=".05////2;.08////"_DT D ^DIE K DIE,DR,DA
115 Q
116EOJ ;
117 F XDRI="XDRMRGFR","XDRMRGTO" K ^TMP(XDRI,$J)
118 K DITM,DITMGMRG,XDRMRGFL,XDRMGL
119 Q
Note: See TracBrowser for help on using the repository browser.