102 lines
4.8 KiB
Mathematica
102 lines
4.8 KiB
Mathematica
XDRMERG1 ;SF-IRMFO.SEA/JLI - TENATIVE UPDATE POINTER NODES ;06/02/2005 09:01
|
|
;;7.3;TOOLKIT;**23,34,38,44,47,95**;Apr 25, 1995
|
|
;;
|
|
;;
|
|
CHASE(XVAL,RVAL,XDRIENS) ;
|
|
N XDRYT,XDRYTT,NODE,X,PC,Y,XDRTO,XDRIEN,XV,XN,XXV,XTYPE,X
|
|
N DA,XV,XXV,XDRFILE,OLDH
|
|
S OLDH=$P($H,",",2)
|
|
F DA=SENTRY:0 Q:$D(ZTSTOP) S DA=$O(@(XVAL_DA_")")) Q:DA'>0 D
|
|
. I (($P($H,",",2)-OLDH>XDRTIME)!($P($H,",",2)<OLDH)) S OLDH=$P($H,",",2) I $$S^%ZTLOAD S ZTSTOP=1 D Q
|
|
. . I '$D(XDRFDA) Q
|
|
. . I $P(^VA(15.2,XDRFDA,0),U,9)="" S $P(^(0),U,9)=1
|
|
. I $D(XDRFDA),$P(^VA(15.2,XDRFDA,0),U,9)=1 S ZTSTOP=1 Q
|
|
. I XDRIENS="" D
|
|
. . S XDRYT=$$NOW^XLFDT()
|
|
. . I $$FMDIFF^XLFDT(XDRYT,XDRXT,2)>5 D ;60 D
|
|
. . . I $D(XDRFDA) D I 1
|
|
. . . . S ^VA(15.2,XDRFDA,3,XDRFDA1,1)=XDRYT_U_CURRTYPE_U_CURRFIL_U_DA
|
|
. . . E D
|
|
. . . . S ^XTMP("XDRSTAT",XDRGID,"TIME",$J)=XDRYT_U_CURRTYPE_U_CURRFIL_U_DA
|
|
. . . S XDRXT=XDRYT
|
|
. I $D(^TMP($J,"XGLOB",RVAL)) D
|
|
. . S NODE="" F S NODE=$O(^TMP($J,"XGLOB",RVAL,NODE)) Q:NODE="" D
|
|
. . . S X=$G(@(XVAL_DA_","_NODE_")")) Q:X=""
|
|
. . . F PC=0:0 S PC=$O(^TMP($J,"XGLOB",RVAL,NODE,PC)) Q:PC'>0 D
|
|
. . . . S Y=$P(X,U,PC),XDRFR=Y
|
|
. . . . 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.
|
|
. . . . I Y>0 S XDRTO=$O(@FROM@(+Y,"")) I XDRTO>0 D
|
|
. . . . . I +Y'=Y D Q:Y'>0
|
|
. . . . . . I $P(Y,";",2)'=$E(XDRFGLOB,2,99) S Y=0 Q
|
|
. . . . . . S XDRTO=XDRTO_";"_$E(XDRFGLOB,2,99)
|
|
. . . . . I $P(^TMP($J,"XGLOB",RVAL,NODE,PC),U,3)="DINUM" D Q
|
|
. . . . . . D DINUM^XDRMERG2(XVAL,RVAL,XDRIENS)
|
|
. . . . . I ^TMP($J,"XGLOB",RVAL,NODE,PC)>0 D Q
|
|
. . . . . . S XDRIEN=DA_","_XDRIENS
|
|
. . . . . . N DA,XDRFILE,XDRFLD,XDR
|
|
. . . . . . S XDRFILE=+^TMP($J,"XGLOB",RVAL,NODE,PC)
|
|
. . . . . . S XDRFLD=+$P(^TMP($J,"XGLOB",RVAL,NODE,PC),U,2)
|
|
. . . . . . S XDR(XDRFILE,XDRIEN,XDRFLD)=XDRTO
|
|
. . . . . . ; S ^XDRM(+XDRFR,"P",XDRFILE,XDRIEN,XDRFLD)=XDRFR ; ORIGINAL VERSION SIMPLY STORE DATA ON POINTER CHANGE
|
|
. . . . . . D SAVEPNTR^XDRMERGB(+XDRFR,+XDRTO,XDRFILE,XDRIEN,XDRFLD,XDRFR) ; REVISED TO STORE POINTER CHANGE IN FM COMPATIBLE STRUCTURE
|
|
. . . . . . D FILE^DIE("","XDR")
|
|
. . . . . S $P(@(XVAL_DA_","_NODE_")"),U,PC)=XDRTO
|
|
. . . . . S XDRFILE=+$P(@(XVAL_"0)"),U,2)
|
|
. . . . . S XDRFLD=$O(@("^DD("_XDRFILE_",""GL"","_NODE_","_PC_",0)"))
|
|
. . . . . S XDRIEN=DA_","_XDRIENS
|
|
. . . . . ; S ^XDRM(+XDRFR,"P",XDRFILE,XDRIEN,XDRFLD)=XDRFR ; ORIGINAL VERSION SIMPLY STORE DATA ON POINTER CHANGE
|
|
. . . . . D SAVEPNTR^XDRMERGB(+XDRFR,+XDRTO,XDRFILE,XDRIEN,XDRFLD,XDRFR)
|
|
. S XV=RVAL
|
|
. F S XV=$O(^TMP($J,"XGLO",XV)) Q:XV'[RVAL D
|
|
. . S XN=$P(XV,RVAL,2),XN=DA_","_$P(XN,"DA,",2)
|
|
. . S XXV=XVAL_XN
|
|
. . S XTYPE=$$TYPE(XV)
|
|
. . I XTYPE="DINUM" D DINUM^XDRMERG2(XXV,XV,DA_","_XDRIENS) Q
|
|
. . I XTYPE'="" D XREFS^XDRMERG2(XXV,XV,DA_","_XDRIENS) Q
|
|
. . D CHASE(XXV,XV,DA_","_XDRIENS)
|
|
S SENTRY=0
|
|
Q
|
|
;
|
|
TYPE(GLOB) ;
|
|
N I,J
|
|
S I=$O(^TMP($J,"XGLOB",GLOB,"")) Q:I="" ""
|
|
S J=$O(^TMP($J,"XGLOB",GLOB,I,"")) Q:J="" ""
|
|
Q $P(^TMP($J,"XGLOB",GLOB,I,J),U,3)
|
|
;
|
|
XREFS ; CONTINUATION FROM XDRMERG2 DUE TO SPACE LIMITS
|
|
N IENOLD,IENNEW,IENVAL,FILEI,FLDJ,XREF,XDRXX,VREF,NMAX,GLOBPCS
|
|
N NODE,PIECE
|
|
N XDRZZ,XDRAA ; DEBUG STATEMENT
|
|
S XDRXX=$NA(^TMP($J,"XDRXX"))
|
|
K @XDRXX
|
|
S NMAX=$L(XR,"DA,") F J=1:1:NMAX S GLOBPCS(J)=$P(XR,"DA,",J)
|
|
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
|
|
. 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)
|
|
. I XREF="DINUM" Q
|
|
. F IENOLD=0:0 S IENOLD=$O(@FROM@(IENOLD)) Q:IENOLD'>0 D
|
|
. . N KVALUE,YGLOB,NCNT,DAIENS,ZGLOB
|
|
. . S IENNEW=$O(@FROM@(IENOLD,"")) Q:IENNEW'>0&'$D(XDRXFLG)
|
|
. . 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)
|
|
. . Q
|
|
. Q
|
|
K XDRAA,XDRZZ I $D(XDRTESTK) M XDRAA=@XDRXX ; DEBUG STATEMENT
|
|
I $D(@XDRXX) D FILE^DIE("",XDRXX)
|
|
I $D(XDRZZ),$D(XDRTESTK) S XDRTESTK=XDRTESTK+1 M ^XTMP("XDRTESTK",$$NOW^XLFDT(),XDRTESTK,"XX")=XDRAA,^("ZZ")=XDRZZ K XDRAA,XDRZZ ; DEBUG STATEMENT
|
|
Q
|
|
;
|
|
FINDXREF(NMAX,XDRXX,ZGLOB,NCNT,DAIENS,YGLOB) ;
|
|
N LVAL,NVAL
|
|
S NVAL=NCNT+1
|
|
I NVAL=NMAX D Q
|
|
. F LVAL=0:0 S LVAL=$O(@ZGLOB@(LVAL)) Q:LVAL'>0!(LVAL'=+LVAL) D SETXREF((YGLOB_LVAL_","),(LVAL_","_DAIENS))
|
|
. Q
|
|
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)))
|
|
Q
|
|
;
|
|
SETXREF(YGLOB,DAIENS) ;
|
|
I $E($P($G(@(YGLOB_NODE_")")),U,PIECE),1,30)'=KVALUE Q
|
|
I $D(XDRXFLG) S @FROM@(IENOLD,"R",FILEI)=$G(@FROM@(IENOLD,"R",FILEI))+1 Q ; POINTER WAS FOUND, MARK ENTRY FOR FILE
|
|
S @XDRXX@(FILEI,DAIENS,FLDJ)=IENNEW_VREF
|
|
D SAVEPNTR^XDRMERGB(+IENOLD,+IENNEW,FILEI,DAIENS,FLDJ,(IENOLD_VREF))
|
|
Q
|