Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XDRMERG1

XDRMERG1.m

Go to the documentation of this file.
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