source: FOIAVistA/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XDRMERG1.m@ 1704

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

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1XDRMERG1 ;SF-IRMFO.SEA/JLI - TENATIVE UPDATE POINTER NODES ;06/02/2005 09:01
2 ;;7.3;TOOLKIT;**23,34,38,44,47,95**;Apr 25, 1995
3 ;;
4 ;;
5CHASE(XVAL,RVAL,XDRIENS) ;
6 N XDRYT,XDRYTT,NODE,X,PC,Y,XDRTO,XDRIEN,XV,XN,XXV,XTYPE,X
7 N DA,XV,XXV,XDRFILE,OLDH
8 S OLDH=$P($H,",",2)
9 F DA=SENTRY:0 Q:$D(ZTSTOP) S DA=$O(@(XVAL_DA_")")) Q:DA'>0 D
10 . I (($P($H,",",2)-OLDH>XDRTIME)!($P($H,",",2)<OLDH)) S OLDH=$P($H,",",2) I $$S^%ZTLOAD S ZTSTOP=1 D Q
11 . . I '$D(XDRFDA) Q
12 . . I $P(^VA(15.2,XDRFDA,0),U,9)="" S $P(^(0),U,9)=1
13 . I $D(XDRFDA),$P(^VA(15.2,XDRFDA,0),U,9)=1 S ZTSTOP=1 Q
14 . I XDRIENS="" D
15 . . S XDRYT=$$NOW^XLFDT()
16 . . I $$FMDIFF^XLFDT(XDRYT,XDRXT,2)>5 D ;60 D
17 . . . I $D(XDRFDA) D I 1
18 . . . . S ^VA(15.2,XDRFDA,3,XDRFDA1,1)=XDRYT_U_CURRTYPE_U_CURRFIL_U_DA
19 . . . E D
20 . . . . S ^XTMP("XDRSTAT",XDRGID,"TIME",$J)=XDRYT_U_CURRTYPE_U_CURRFIL_U_DA
21 . . . S XDRXT=XDRYT
22 . I $D(^TMP($J,"XGLOB",RVAL)) D
23 . . S NODE="" F S NODE=$O(^TMP($J,"XGLOB",RVAL,NODE)) Q:NODE="" D
24 . . . S X=$G(@(XVAL_DA_","_NODE_")")) Q:X=""
25 . . . F PC=0:0 S PC=$O(^TMP($J,"XGLOB",RVAL,NODE,PC)) Q:PC'>0 D
26 . . . . S Y=$P(X,U,PC),XDRFR=Y
27 . . . . I Y>0,$D(XDRXFLG),$D(@FROM@(+Y))=1 S @FROM@(+Y,"R",CURRFIL)=$G(@FROM@(+Y,"R",CURRFIL))+1 Q ; USED TO DETERMINE WHICH ENTRIES AREN'T POINTED TO.
28 . . . . I Y>0 S XDRTO=$O(@FROM@(+Y,"")) I XDRTO>0 D
29 . . . . . I +Y'=Y D Q:Y'>0
30 . . . . . . I $P(Y,";",2)'=$E(XDRFGLOB,2,99) S Y=0 Q
31 . . . . . . S XDRTO=XDRTO_";"_$E(XDRFGLOB,2,99)
32 . . . . . I $P(^TMP($J,"XGLOB",RVAL,NODE,PC),U,3)="DINUM" D Q
33 . . . . . . D DINUM^XDRMERG2(XVAL,RVAL,XDRIENS)
34 . . . . . I ^TMP($J,"XGLOB",RVAL,NODE,PC)>0 D Q
35 . . . . . . S XDRIEN=DA_","_XDRIENS
36 . . . . . . N DA,XDRFILE,XDRFLD,XDR
37 . . . . . . S XDRFILE=+^TMP($J,"XGLOB",RVAL,NODE,PC)
38 . . . . . . S XDRFLD=+$P(^TMP($J,"XGLOB",RVAL,NODE,PC),U,2)
39 . . . . . . S XDR(XDRFILE,XDRIEN,XDRFLD)=XDRTO
40 . . . . . . ; S ^XDRM(+XDRFR,"P",XDRFILE,XDRIEN,XDRFLD)=XDRFR ; ORIGINAL VERSION SIMPLY STORE DATA ON POINTER CHANGE
41 . . . . . . D SAVEPNTR^XDRMERGB(+XDRFR,+XDRTO,XDRFILE,XDRIEN,XDRFLD,XDRFR) ; REVISED TO STORE POINTER CHANGE IN FM COMPATIBLE STRUCTURE
42 . . . . . . D FILE^DIE("","XDR")
43 . . . . . S $P(@(XVAL_DA_","_NODE_")"),U,PC)=XDRTO
44 . . . . . S XDRFILE=+$P(@(XVAL_"0)"),U,2)
45 . . . . . S XDRFLD=$O(@("^DD("_XDRFILE_",""GL"","_NODE_","_PC_",0)"))
46 . . . . . S XDRIEN=DA_","_XDRIENS
47 . . . . . ; S ^XDRM(+XDRFR,"P",XDRFILE,XDRIEN,XDRFLD)=XDRFR ; ORIGINAL VERSION SIMPLY STORE DATA ON POINTER CHANGE
48 . . . . . D SAVEPNTR^XDRMERGB(+XDRFR,+XDRTO,XDRFILE,XDRIEN,XDRFLD,XDRFR)
49 . S XV=RVAL
50 . F S XV=$O(^TMP($J,"XGLO",XV)) Q:XV'[RVAL D
51 . . S XN=$P(XV,RVAL,2),XN=DA_","_$P(XN,"DA,",2)
52 . . S XXV=XVAL_XN
53 . . S XTYPE=$$TYPE(XV)
54 . . I XTYPE="DINUM" D DINUM^XDRMERG2(XXV,XV,DA_","_XDRIENS) Q
55 . . I XTYPE'="" D XREFS^XDRMERG2(XXV,XV,DA_","_XDRIENS) Q
56 . . D CHASE(XXV,XV,DA_","_XDRIENS)
57 S SENTRY=0
58 Q
59 ;
60TYPE(GLOB) ;
61 N I,J
62 S I=$O(^TMP($J,"XGLOB",GLOB,"")) Q:I="" ""
63 S J=$O(^TMP($J,"XGLOB",GLOB,I,"")) Q:J="" ""
64 Q $P(^TMP($J,"XGLOB",GLOB,I,J),U,3)
65 ;
66XREFS ; CONTINUATION FROM XDRMERG2 DUE TO SPACE LIMITS
67 N IENOLD,IENNEW,IENVAL,FILEI,FLDJ,XREF,XDRXX,VREF,NMAX,GLOBPCS
68 N NODE,PIECE
69 N XDRZZ,XDRAA ; DEBUG STATEMENT
70 S XDRXX=$NA(^TMP($J,"XDRXX"))
71 K @XDRXX
72 S NMAX=$L(XR,"DA,") F J=1:1:NMAX S GLOBPCS(J)=$P(XR,"DA,",J)
73 S NODE="" F S NODE=$O(^TMP($J,"XGLOB",XR,NODE)) Q:NODE="" F PIECE=0:0 S PIECE=$O(^TMP($J,"XGLOB",XR,NODE,PIECE)) Q:PIECE'>0 S FILEI=^(PIECE) D
74 . S FLDJ=$P(FILEI,U,2),XREF=$P(FILEI,U,3),FILEI=+FILEI,VREF="" I $P(^DD(FILEI,FLDJ,0),U,2)["V" S VREF=";"_$E(XDRFGLOB,2,99)
75 . I XREF="DINUM" Q
76 . F IENOLD=0:0 S IENOLD=$O(@FROM@(IENOLD)) Q:IENOLD'>0 D
77 . . N KVALUE,YGLOB,NCNT,DAIENS,ZGLOB
78 . . S IENNEW=$O(@FROM@(IENOLD,"")) Q:IENNEW'>0&'$D(XDRXFLG)
79 . . S KVALUE=$S(VREF'="":IENOLD_VREF,1:IENOLD),ZGLOB=GLOBPCS(1)_XREF_","_""""_KVALUE_""""_")" I $D(@ZGLOB) S DAIENS="",YGLOB=GLOBPCS(1),NCNT=0 D FINDXREF(NMAX,XDRXX,ZGLOB,NCNT,DAIENS,YGLOB)
80 . . Q
81 . Q
82 K XDRAA,XDRZZ I $D(XDRTESTK) M XDRAA=@XDRXX ; DEBUG STATEMENT
83 I $D(@XDRXX) D FILE^DIE("",XDRXX)
84 I $D(XDRZZ),$D(XDRTESTK) S XDRTESTK=XDRTESTK+1 M ^XTMP("XDRTESTK",$$NOW^XLFDT(),XDRTESTK,"XX")=XDRAA,^("ZZ")=XDRZZ K XDRAA,XDRZZ ; DEBUG STATEMENT
85 Q
86 ;
87FINDXREF(NMAX,XDRXX,ZGLOB,NCNT,DAIENS,YGLOB) ;
88 N LVAL,NVAL
89 S NVAL=NCNT+1
90 I NVAL=NMAX D Q
91 . F LVAL=0:0 S LVAL=$O(@ZGLOB@(LVAL)) Q:LVAL'>0!(LVAL'=+LVAL) D SETXREF((YGLOB_LVAL_","),(LVAL_","_DAIENS))
92 . Q
93 F LVAL=0:0 S LVAL=$O(@ZGLOB@(LVAL)) Q:LVAL'>0!(LVAL'=+LVAL) D FINDXREF(NMAX,XDRXX,$NA(@ZGLOB@(LVAL)),NVAL,(LVAL_","_DAIENS),(YGLOB_LVAL_","_GLOBPCS(NVAL+1)))
94 Q
95 ;
96SETXREF(YGLOB,DAIENS) ;
97 I $E($P($G(@(YGLOB_NODE_")")),U,PIECE),1,30)'=KVALUE Q
98 I $D(XDRXFLG) S @FROM@(IENOLD,"R",FILEI)=$G(@FROM@(IENOLD,"R",FILEI))+1 Q ; POINTER WAS FOUND, MARK ENTRY FOR FILE
99 S @XDRXX@(FILEI,DAIENS,FLDJ)=IENNEW_VREF
100 D SAVEPNTR^XDRMERGB(+IENOLD,+IENNEW,FILEI,DAIENS,FLDJ,(IENOLD_VREF))
101 Q
Note: See TracBrowser for help on using the repository browser.