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

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

initial load of FOIAVistA 6/30/08 version
File size: 8.2 KB
Line 
1XDRMERG2 ;SF-IRMFO.SEA/JLI - TENATIVE UPDATE POINTER NODES ; [6/12/02 9:48am]
2 ;;7.3;TOOLKIT;**23,38,40,42,46,62**;Apr 25, 1995
3 ;;
4 Q
5 ;
6 ; XDRXFLG is referenced in a few places, but not defined - it was
7 ; used where it was set at the time the run started to identify
8 ; entries which were referenced in one or more files and to
9 ; remove them from a list of entries which were not referenced
10 ; by any files within the database
11 ;
12DINUM(XVAL,XR,XDRIENS) ; FIND AND MERGE DINUMMED POINTERS
13 N IENOLD,IENNEW,FILEI,FLDJ,XREF,VREF
14 ;
15 D SETVALS
16 F IENOLD=0:0 S IENOLD=$O(@FROM@(IENOLD)) Q:IENOLD'>0 D
17 . I '$D(@(XVAL_IENOLD_",0)")) Q
18 . I $D(XDRXFLG) S @FROM@(IENOLD,"R",FILEI)=$G(@FROM@(IENOLD,"R",FILEI))+1 Q ; POINTER WAS FOUND MARK ENTRY FOR FILE
19 . S IENNEW=$O(@FROM@(IENOLD,"")) Q:IENNEW'>0
20 . ; N I F I=IENOLD,IENNEW M @("^XDRM(I,""M"",FILEI,I)="_XVAL_I_")") ; OLD SAVE IMAGE BY SIMPLY MERGING
21 . D SAVEMERG^XDRMERGB(FILEI,IENOLD,IENNEW)
22 . I '$D(@(XVAL_IENNEW_",0)")) D
23 . . N DD,DO,DIC,X,DINUM,DA
24 . . S DIC=XVAL,DIC(0)="L",X=IENNEW,DINUM=IENNEW D FILE^DICN Q:Y'>0
25 . D OVRWRI(FILEI,IENOLD,IENNEW)
26 . D MERGEIT(XVAL,IENOLD,IENNEW)
27 . D TIMSTAMP(2,FILEI,IENOLD)
28 Q
29MERGEIT(XDRDIC,IENFROM,IENTO) ; MERGE TWO ENTRIES IN FILE
30 N NODE,NODE1,NODE2,NODEA,SFILE,XDRFROM,XDRTO,NODEA,VALUE,XVALUE,XDRXX,XDRYY,NODEB,DIK,DA,I,Y,VREF,XNN,XFILNO,IENTOSTR,DFN
31 ;
32 D MERGEIT^XDRMERGB
33 Q
34TIMSTAMP(PHASE,FILE,IEN) ;
35 S XDRYT=$$NOW^XLFDT()
36 I $$FMDIFF^XLFDT(XDRYT,+$G(XDRXT),2)>5 D
37 . I $D(XDRFDA) D I 1
38 . . S ^VA(15.2,XDRFDA,3,XDRFDA1,1)=XDRYT_U_PHASE_U_FILE_U_IEN
39 . E D
40 . . S ^XTMP("XDRSTAT",XDRGID,"TIME",$J)=XDRYT_U_PHASE_U_FILE_U_IEN
41 . S XDRXT=XDRYT
42 Q
43XREFS(XVAL,XR,XDRIENS) ; FIND POINTERS BASED ON KNOWN X-REFS FOR FILE
44 D XREFS^XDRMERG1
45 Q
46 ;
47SETVALS ; IDENTIFY THE LOCATIONS OF POINTERS (NODE, PIECE, AND X-REF I ANY)
48 S FILEI=$O(^TMP($J,"XGLOB",XR,"")),FLDJ=$O(^TMP($J,"XGLOB",XR,FILEI,""))
49 S FILEI=^TMP($J,"XGLOB",XR,FILEI,FLDJ),FLDJ=+$P(FILEI,U,2)
50 S XREF=$P(FILEI,U,3),FILEI=+FILEI
51 S VREF="" I $P(^DD(FILEI,FLDJ,0),U,2)["V" S VREF=";"_$E(XDRFGLOB,2,99)
52 Q
53 ;
54DOMAIN(FILE,FROM) ; MERGE ACTUAL ENTRIES IN THE FILE (THE ONES POINTED TO)
55 N IENFROM,IENTO,XDRVAL,XDRIENS
56 I '$D(XDRTESTK) S XDRTESTK=0 S ^XTMP("XDRTESTK",0)=$$FMADD^XLFDT(DT,30)_U_DT ; DEBUG STATEMENT
57 S XFILNO=FILE
58 I $D(XDRXFLG) Q
59 S XDRIENS=""
60 S XDRDIC=$G(^DIC(FILE,0,"GL")) Q:XDRDIC=""
61 S IENFROM=0
62 F S IENFROM=$O(@FROM@(IENFROM)) Q:IENFROM'>0 D
63 . I '$D(@(XDRDIC_IENFROM_")")) Q
64 . S IENTO=$O(@FROM@(IENFROM,"")) Q:IENTO'>0
65 . I $D(@(XDRDIC_IENFROM_",-9)"))!$D(@(XDRDIC_IENTO_",-9)")) Q ; ALREADY MERGED
66 . S XDRVAL=$P($G(@(XDRDIC_IENFROM_",0)")),U)
67 . S XDRVAL=$P($G(@(XDRDIC_IENFROM_",0)")),U)
68 . I $E(XDRVAL,1,12)="MERGING INTO" D
69 . . N X S X=XDRVAL
70 . . F Q:X'["MERGING INTO" S X=$P(X,"(",2,99),X=$E(X,1,$L(X)-1)
71 . . S $P(@(XDRDIC_IENFROM_",0)"),U)=X
72 . . S XDRVAL=X
73 . D GETSSN ; GET SSN FOR SELECTED MAIN FILES
74 . S IENTO=$O(@FROM@(IENFROM,"")) Q:IENTO'>0 S DFN=IENTO D
75 . . ; N I F I=IENFROM,IENTO M @("^XDRM(I,""M"",FILE,I)="_XDRDIC_I_")") ; ORIGINAL VERSION SAVE IMAGE BY SIMPLY MERGING
76 . . D SAVEMERG^XDRMERGB(FILE,IENFROM,IENTO) ; SAVE IMAGE IN FM COMPATIBLE STRUCTURE
77 . . N XDRVAL
78 . . D OVRWRI(XFILNO,IENFROM,IENTO) ; LOOK FOR DATA TO BE OVERWRITTEN
79 . . D MERGEIT(XDRDIC,IENFROM,IENTO)
80 . S @(XDRDIC_IENFROM_",0)")=XDRVAL
81 . S @(XDRDIC_IENFROM_",-9)")=IENTO
82 . D SETALIAS ; SET UP ALIAS ENTRY IN SELECTED FILES
83 . N VALUE,XDRXX,XDRYY
84 . S VALUE=$$FIND1^DIC(15.3,",","Q",FILE)
85 . I VALUE'>0 D
86 . . S XDRXX(15.3,"+1,",.01)=FILE
87 . . K XDRYY S XDRYY(1)=FILE
88 . . D UPDATE^DIE("","XDRXX","XDRYY")
89 . K XDRXX,XDRYY
90 . S XDRXX(15.31,"+1,"_FILE_",",.01)=IENFROM
91 . S XDRXX(15.31,"+1,"_FILE_",",.02)=IENTO
92 . D UPDATE^DIE("","XDRXX","XDRYY","XDRMM")
93 . D TIMSTAMP(1,FILE,IENFROM)
94 Q
95 ;
96CHKFROM(FROM,FILE) ;
97 D CHKFROM^XDRMERGC(FROM,FILE)
98 Q
99 ;
100GETSSN ; For files 2 and 200, get SSN value for XDRFROM entry
101 I FILE=2 S XDRVAL("SSN")=$P(^DPT(IENFROM,0),U,9) Q
102 I FILE=200 S XDRVAL("SSN")=$P(^VA(200,IENFROM,1),U,9) Q
103 Q
104 ;
105OVRWRI(FILE,IENFR,IENTO) ;
106 N XNI,XDRARR,XDRARR1,IENSF,I,XNN,IENA,IENB ; THIS WOULD BE ONLY TOP LEVEL
107 ;
108 S IENA=$O(@FROM@(IENFR,IENTO,"")) Q:IENA=""
109 S IENB=$O(@FROM@(IENFR,IENTO,IENA,"")) Q:IENB=""
110 S XNN=@FROM@(IENFR,IENTO,IENA,IENB) Q:XNN'>0
111 S XNI="",IENSF=IENFR_","
112 F I=0:0 S I=$O(^VA(15,XNN,3,FILE,1,I)) Q:I'>0 S XNI=XNI_^(I,0)_";"
113 I XNI'="" D
114 . D GETS^DIQ(FILE,IENSF,XNI,"I","XDRARR")
115 . F I=0:0 S I=$O(XDRARR(FILE,IENSF,I)) Q:I'>0 D
116 . . S XDRARR1(FILE,(IENTO_","),I)=XDRARR(FILE,IENSF,I,"I")
117 . I FILE=2!(FILE=200),$D(XDRARR1(FILE,(IENTO_","),$S(FILE=2:.09,1:9))) D
118 . . N IENST,XDRARR2 S IENST=IENTO_","
119 . . D GETS^DIQ(FILE,IENST,$S(FILE=2:.09,1:9),"I","XDRARR2")
120 . . I $D(XDRARR2(FILE,IENST,$S(FILE=2:.09,1:9),"I")) D
121 . . . S XDRARR1(FILE,IENSF,$S(FILE=2:.09,1:9))=XDRARR2(FILE,IENST,$S(FILE=2:.09,1:9),"I")
122 . . . Q
123 . . Q
124 . D FILE^DIE("","XDRARR1")
125 Q
126SETALIAS ; For selected files place data into alias field of TO entry
127 N XDRARR
128 I FILE=2 D
129 . S XDRARR(2.01,"+1,"_IENTO_",",.01)=XDRVAL
130 . S XDRARR(2.01,"+1,"_IENTO_",",1)=XDRVAL("SSN")
131 . D UPDATE^DIE("","XDRARR")
132 I FILE=200 D
133 . S XDRARR(200.04,"+1,"_IENTO_",",.01)=XDRVAL
134 . D FILE^DIE("","XDRARR")
135 Q
136 ;
137CHKLOCAL ; CHECK STATUS FOR LOCAL MERGE PROCESSES (EVEN IF SOME DATA EXISTS IN MERGE PROCESS FILE)
138 N XJOB,X,N,XNAME,XSTAT,XDRFIL,DIRUT,CHKLOCAL
139 S CHKLOCAL=1,XDRFIL="^XTMP(""XDRSTAT"","
140 G CHK1
141 ;
142CHECK ;
143 N XJOB,X,N,M,BA,XNAME,XDRFIL,DIRUT,START,XDRFIL1,XDRFIL2
144CHK1 ;
145 I '$D(CHKLOCAL) S XDRFIL=$S($O(^VA(15.2,0))>0:"^VA(15.2,",1:"^XTMP(""XDRSTAT"",")
146 S N=0,BA=""
147 W @IOF
148 S M=":" F S M=$O(@(XDRFIL_""""_M_""")"),-1) Q:M'>0 D
149 . I XDRFIL["VA(15.2",$P(^VA(15.2,M,0),U,4)="S" Q
150 . S XDRFIL1=$S(XDRFIL["VA":$NA(@(XDRFIL_M_")")),1:$NA(^XTMP("XDRSTAT",M)))
151 . S N=$S($D(^TMP($J,"BDT",N)):N+1,1:N) S XNAME="",XJOB="",N=N+1
152 . D ONESET(XDRFIL1,0)
153 . I XDRFIL["VA" D
154 . . F J=0:0 S J=$O(@XDRFIL1@(3,J)) Q:J'>0 D
155 . . . S XDRFIL2=$NA(@XDRFIL1@(3,J))
156 . . . D ONESET(XDRFIL2,1)
157 D HEADER
158 F N=0:0 S N=$O(^TMP($J,"BDT",N)) Q:N'>0 D Q:$D(DIRUT)
159 .I (IOSL-$Y)<6 D:IOST["C-" Q:$D(DIRUT) W @IOF,! D HEADER ;REM -9/25/96 page breaks
160 ..W ! S DIR(0)="E" D ^DIR K DIR
161 . S XNAME=$P($G(^TMP($J,"BDT",N)),"~",2)
162 . S START=$P($G(^TMP($J,"BDT",N)),"~",3)
163 . S XJOB=$P($G(^TMP($J,"BDT",N)),"~",4)
164 . I BA'="",BA'=$P($G(START),"."),START'="" W !
165 . S BA=$P($G(START),".")
166 . S:XNAME["THREAD" XNAME=" "_XNAME
167 . W !,XNAME Q:XNAME="" I $L(XNAME)>18 W !
168 . S X=START D DATE8 W ?20,X," ",$P(^TMP($J,"BDT",N),"~") W:START="" !
169 . S X=$P(XJOB,U) I X'="" D DATE8 W ?36,X
170 . I X="" D
171 . . S X=$P(XJOB,U,2) D DATE8 W ?36,X
172 . . W ?50,$P(XJOB,U,3),?55,$P(XJOB,U,4),?64," ",$P(XJOB,U,5)
173 . . I $P(^TMP($J,"BDT",N),"~")="E" S N=N+1 W !?5,"ERROR: ",$E($P(^TMP($J,"BDT",N),"~"),1,230),!
174 K ^TMP($J,"BDT")
175 Q
176 ;
177HEADER ;REM -9/25/96 Write header.
178 W !,?55,"Current",?65,"Current"
179 W !,"Merge Set Start Stat Last Chk Phase File Entry",!
180 Q
181 ;
182DATE8 ;
183 N X1
184 I X="" S X=" " Q
185 S X1=X
186 S X=$E(X1,4,5)_"/"_$E(X1,6,7)_" "
187 S X1=$P(X1,".",2)_"000000"
188 S X=X_$E(X1,1,2)_":"_$E(X1,3,4)
189 Q
190 ;
191ONESET(FILE,SPECIAL) ;
192 N JOBNUM,JVAL
193 I FILE'["VA" S JVAL=0 F JOBNUM=0:0 S JOBNUM=$O(@FILE@("START",JOBNUM)) Q:JOBNUM'>0 S JVAL=JVAL+1 D LOOP
194 I FILE'["VA" Q
195LOOP S N=N+1 I $D(^TMP($J,"BDT",N)) G LOOP
196 I 'SPECIAL S START=$S(FILE'["VA":@FILE@("START",JOBNUM),$P(@FILE@(0),U,5)>0:$P(^(0),U,5),1:$P(^(0),U,3)) I 1
197 I SPECIAL S START=$S($P(@FILE@(0),U,4)>0:$P(^(0),U,4),1:$P(^(0),U,2))
198 S XNAME=$S(XDRFIL'["VA":XJOB_" J"_JVAL_" ",'SPECIAL:$P(@FILE@(0),U),1:" "_$E($P(@FILE@(0),U),1,15))
199 I XDRFIL["VA" S ^TMP($J,"BDT",N)=$S('SPECIAL:$P(@FILE@(0),U,4),1:$P(@FILE@(0),U,3))
200 E S ^TMP($J,"BDT",N)=$S($D(@FILE@("DONE",JOBNUM)):"C",1:"A")
201 I ^TMP($J,"BDT",N)="E" S ^TMP($J,"BDT",N+1)=$G(@FILE@(2))
202 S XJOB=$S(XDRFIL'["VA":$G(@FILE@("DONE",JOBNUM)),'SPECIAL:$P(@FILE@(0),U,6),1:$P(@FILE@(0),U,5))
203 I XJOB="" D
204 . S XJOB=XJOB_U_$S(XDRFIL'["VA":$G(@FILE@("TIME",JOBNUM)),1:$G(@FILE@(1)))
205 . I XDRFIL'["VA"!SPECIAL,^TMP($J,"BDT",N)="A",$$FMDIFF^XLFDT($$NOW^XLFDT(),$P(XJOB,U,2),2)>43000 D
206 . . S ^TMP($J,"BDT",N)="U"
207 . . I XDRFIL["VA" D
208 . . . S $P(@FILE@(0),U,3)="U"
209 . I ^TMP($J,"BDT",N)="U",XDRFIL["VA",SPECIAL,$$FMDIFF^XLFDT($$NOW^XLFDT(),$P(XJOB,U,2),2)'>43000 S ^TMP($J,"BDT",N)="A",$P(@FILE@(0),U,3)="A"
210 S ^TMP($J,"BDT",N)=$P(^TMP($J,"BDT",N),"~")_"~"_XNAME_"~"_START_"~"_XJOB
211 Q
Note: See TracBrowser for help on using the repository browser.