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)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