XDRMERGB ;SF-IRMFO.SEA/JLI - TENATIVE UPDATE POINTER NODES ;5/14/98 10:30
;;7.3;TOOLKIT;**23,137**;Apr 25, 1995;Build 10
;;
Q
;
MERGEIT ; MERGE TWO ENTRIES IN FILE
N NODE,NODE1,NODE2,NODEA,SFILE,XDRFROM,XDRTO,NODEA,VALUE,XVALUE,XDRXX,NODEB,DIK,DA,I,Y,VREF,XNN,XFILNO,IENTOSTR,DFN,XDRZZ
N XDRAA ; DEBUG STATEMENT
;
S XFILNO=+$P(@(XDRDIC_"0)"),U,2)
S IENTOSTR=IENTO_","_XDRIENS
S DFN=IENTO
;
; NOW MERGE DATA GOING NODE BY NODE
;
S NODE=""
F D Q:NODE=""
. S NODE1=$O(@(XDRDIC_IENFROM_","""_NODE_""")"))
. I NODE1="" S NODE="" Q ; NOTHING MORE TO MOVE OVER
. S NODE2=$O(@(XDRDIC_IENTO_","""_NODE_""")"))
. I NODE2'="",NODE1]NODE2 S NODE=NODE2 Q ; NODE ON TO, BUT NOT ON FROM - GO TO NEXT
. S NODE=NODE1
. I $D(@(XDRDIC_IENFROM_","""_NODE_""")"))=1 D Q ; SINGLE NODE, MERGE DATA
. . I NODE2]NODE1!(NODE2="") D Q ; MISSING NODE, JUST MOVE IT OVER
. . . N XDRXX,FLD,N,J
. . . F N=0:0 S N=$O(^DD(XFILNO,"GL",NODE,N)) Q:N'>0 S FLD=$O(^(N,0)) I $O(^DD(XFILNO,FLD,1,0))>0 D
. . . . S X=0 F J=0:0 S J=$O(^DD(XFILNO,FLD,1,J)) Q:J'>0 I $O(^(J,0))>0 S X=1 Q
. . . . I X>0 D
. . . . . S XDRXX(XFILNO,IENTOSTR,FLD)=$P(@(XDRDIC_IENFROM_","""_NODE_""")"),U,N)
. . . K XDRAA I $D(XDRTESTK),$D(XDRXX) M XDRAA=XDRXX ; DEBUT STATEMENT
. . . K XDRZZ
. . . I $D(XDRXX) D FILE^DIE("","XDRXX","XDRZZ")
. . . I $D(XDRTESTK),$D(XDRZZ) S XDRTESTK=XDRTESTK+1 M ^XTMP("XDRTESTK",$$NOW^XLFDT(),XDRTESTK,"XX")=XDRAA,^("ZZ")=XDRZZ ; DEBUG STATMENT
. . . M @(XDRDIC_IENTO_","""_NODE_""")")=@(XDRDIC_IENFROM_","""_NODE_""")")
. . I $D(@(XDRDIC_IENTO_","""_NODE_""")"))>1 Q ; MISMATCH SO QUIT
. . N XDRXX,FLD
. . S X1=@(XDRDIC_IENFROM_","""_NODE_""")")
. . S (X2,X3)=@(XDRDIC_IENTO_","""_NODE_""")")
. . F I=1:1 Q:X1="" S X=$P(X1,U),X1=$P(X1,U,2,999) I X'="" D
. . . S Y=$P(X2,U,I)
. . . I Y="" D
. . . . ;S $P(X2,U,I)=X ;LLS 26-OCT-2013 replaced with conditional SET below
. . . . S FLD=$O(^DD(XFILNO,"GL",NODE,I,0)) S JXFLD=FLD
. . . . I (XFILNO'=2)!(FLD'=.6) S $P(X2,U,I)=X ;LLS 26-OCT-2013 - replaced set of X2 so do not move 'test patient indicator'
. . . . I XFILNO=2,FLD=.6 Q ;LLS 26-OCT-2013 - Do not want to move 'test patient indicator'
. . . . I FLD>0,$O(^DD(XFILNO,FLD,1,0))>0 S XDRXX(XFILNO,IENTOSTR,FLD)=X
. . I X2'=X3 D
. . . I $D(XDRXX) D
. . . . K XDRAA I $D(XDRTESTK) M XDRAA=XDRXX ; DEBUG STATEMENT
. . . . K XDRZZ
. . . . N X2 D FILE^DIE("","XDRXX","XDRZZ")
. . . . I $D(XDRTESTK),$D(XDRZZ) S XDRTESTK=XDRTESTK+1 M ^XTMP("XDRTESTK",$$NOW^XLFDT(),XDRTESTK,"XX")=XDRAA,^("ZZ")=XDRZZ ; DEBUG STATMENT
. . . S @(XDRDIC_IENTO_","""_NODE_""")")=X2 ; SET MERGED DATA ON NODE
. ;
. ; THE FOLLOWING HANDLES NODES THAT HAVE MULTIPLES
. ;
. S XDRFROM=XDRDIC_IENFROM_","""_NODE_""","
. S XDRTO=XDRDIC_IENTO_","""_NODE_""","
. I NODE="DIS",XFILNO=2 D DODIS^XDRMERGA Q
. S IENTOSTR=IENTO_","_XDRIENS
. D DOSUBS^XDRMERGA(XDRFROM,XDRTO,IENTOSTR,IENTO)
S XDRXX=$P(@(XDRDIC_IENFROM_",0)"),U)
K DA N DIU S DIU(0)=1 S DIK=XDRDIC,DA=IENFROM,DFN=DA D ^DIK ; KILL OFF MERGED FROM ENTRY
S @(XDRDIC_IENFROM_",0)")=XDRXX
Q
;
SAVEMERG(FILE,IENFROM,IENTO) ;
N IENS,XDRFILE,YYY,ZZZ,XDRFDA,FROMARG,TOARG,XDRDA,Q,Q1,IENVAL,XDRSUB
S FROMARG=$O(@FROM@(IENFROM,IENTO,"")) Q:FROMARG=""
S TOARG=$O(@FROM@(IENFROM,IENTO,FROMARG,""))
S XDRDA=$$FIND1^DIC(15.4,"","Q",FROMARG)
I XDRDA>0,$P(^XDRM(XDRDA,0),U)'=FROMARG S XDRDA=0
I XDRDA'>0 D
. N XDRFDA
. S XDRFDA(15.4,"+1,",.01)=FROMARG
. S XDRFDA(15.4,"+1,",.02)=TOARG
. S XDRFDA(15.4,"+1,",.03)=DT
. D UPDATE^DIE("","XDRFDA","YYY") S IENS=YYY(1)
. S XDRDA=YYY(1)
S XDRFILE=$P(^DIC(FILE,0),U)
S IENS=$$FIND1^DIC(15.41,","_XDRDA_",","Q",XDRFILE)
I IENS'>0 D
. S IENS="+1,"_XDRDA_","
. S XDRFDA(15.41,IENS,.01)=XDRFILE
. I IENFROM>0 S XDRFDA(15.41,IENS,.02)=IENFROM
. K YYY
. D UPDATE^DIE("","XDRFDA","YYY","ZZZ") S IENS=YYY(1)
I IENFROM>0 D
. S XDRSUB=15.411,IENVAL=IENFROM
. D STORMERG
K XDRFDA
S IENS=$$FIND1^DIC(15.42,","_XDRDA_",","Q",XDRFILE)
I IENS'>0 D
. S IENS="+1,"_XDRDA_","
. S XDRFDA(15.42,IENS,.01)=XDRFILE
. I IENTO>0 S XDRFDA(15.42,IENS,.02)=IENTO
. K YYY,ZZZ
. D UPDATE^DIE("","XDRFDA","YYY","ZZZ") S IENS=YYY(1)
I IENTO>0 D
. S XDRSUB=15.421,IENVAL=IENTO
. D STORMERG
Q
STORMERG ;
K ^VA(15.4,XDRDA,$S(XDRSUB=15.411:1,1:2),IENS,1) ; REMOVE ANY PREVIOUS TRIES
S IENS="+1,"_IENS_","_XDRDA_","
S Q=^DIC(FILE,0,"GL")_IENVAL_")",Q1=$E(Q,1,$L(Q)-1)
F S Q=$Q(@Q) Q:Q'[Q1 D
. K XDRFDA
. S XDRFDA(XDRSUB,IENS,.01)=$E(Q,2,$L(Q))
. I @Q'="" S XDRFDA(XDRSUB,IENS,1.01)=@Q
. D UPDATE^DIE("","XDRFDA")
Q
;
SAVEPNTR(IENFROM,IENTO,FILE,IENS,FIELD,VALUE) ;
N XDRFDA,XDRDA,FROMARG
S FROMARG=$O(@FROM@(IENFROM,IENTO,"")) Q:FROMARG=""
S XDRDA=$$FIND1^DIC(15.4,"","Q",FROMARG)
S X=FILE_";"_IENS_";"_FIELD
S XDRFDA(15.43,"+1,"_XDRDA_",",.01)=X
S XDRFDA(15.43,"+1,"_XDRDA_",",1.01)=VALUE
D UPDATE^DIE("","XDRFDA")
Q
SNDMSG(XDRFDA) ;Sends msg when merge process has completed.
N XDRGRP,XMTEXT,XMSUB,XMDUZ,XDRNAME
S XDRNAME=$$GET1^DIQ(15.2,XDRFDA,.01)
S R(1,0)=XDRNAME_" merge process has completed."
S XDRGRP=$$GET1^DIQ(15.1,"2,",.29,"I")
S:XDRGRP>0 XDRGRPN=$$GET1^DIQ(3.8,XDRGRP,.01)
S XDRGRP=$S(XDRGRP>0:"G."_XDRGRPN,1:"")
S:XDRGRP'="" XMY(XDRGRP)=""
S:XDRGRP="" XMY(.5)="" ;If no mail grp found, send msg to postmaster
S XMTEXT="R(",XMSUB=XDRNAME_" Completed",XMDUZ=.5,XMCHAN=1
D ^XMD
Q
;
QUE ; (Moved from XDRMERG0)
;
N XDRXX,XDRYY,XDRMA,DIE,DIC,DIR,DR,ZTDTH,ZTSK
N XDRX,XDRY,XDRFIL,XDRGLOB,X,Y,XDRNAME
N XDRFDA,XDRIENS,XDRI,XDRJ,XDRK,DA,DIK
;
S XDRFIL=$$FILE^XDRDPICK() Q:XDRFIL'>0
I XDRFIL=2 D Q:Y
. N X,XDRKEY
. S (X,XDRKEY)=0 F S X=$O(^VA(200,DUZ,51,"B",X)) Q:X'>0!(XDRKEY) D
. . I $$GET1^DIQ(19.1,X,.01)="DG ELIGIBILITY" S XDRKEY=1
. . Q
. S Y=0 I 'XDRKEY W !!,"You should hold the 'DG ELIGIBILITY' key to run a patient file merge." S Y=1
. Q
S XDRDIC=^DIC(XDRFIL,0,"GL")
S XDRGLOB=$E(XDRDIC,2,999)
S X=""
S XNCNT=0,XNCNT0=0
F S X=$O(^VA(15,"AVDUP",XDRGLOB,X)) Q:X="" S Y=$O(^(X,0)) D
. N YVAL S YVAL=^VA(15,Y,0)
. I $P(YVAL,U,20)>0 Q ; ALREADY DONE OR SCHEDULED
. I $P(YVAL,U,3)'="V" Q ; TAKE ONLY VERIFIED
. I $P(YVAL,U,5)'=1 Q ; TAKE ONLY IF MARKED READY TO MERGE
. I $P(YVAL,U,13)>0 D
. . I '$D(@(XDRDIC_(+YVAL)_",0)"))!'$D(@(XDRDIC_(+$P(YVAL,U,2))_",0)")) Q
. . I $P(YVAL,U,4)'=2 S XDRX(+YVAL,+$P(YVAL,U,2))=Y ; get ien numbers from duplicate file
. . E S XDRX(+$P(YVAL,U,2),+YVAL)=Y ; Reverse - merge to switched
. . S XNCNT=XNCNT+1
W !!,XNCNT," Entries Ready to be included in merge"
I $O(XDRX(0))'>0 D Q
. W !!?15,$C(7),"No Verified Duplicates included in merge",$C(7),!!
;
K DIR S DIR(0)="Y"
S DIR("A",1)="This process will take a **LONG** time (usually over 15 hours, and sometimes"
S DIR("A",2)="considerably longer), but you CAN stop and restart the process when you"
S DIR("A")="want using the options. OK"
D ^DIR K DIR Q:Y'>0
NAME W !! S DIR(0)="F^2:30"
S DIR("A")="Name for Merge Process"
S DIR("?",1)="Enter a unique name by which the MERGE PROCESS will be identified"
S DIR("?")="This name should be 2 to 30 characters in length"
D ^DIR
K DIR Q:Y=U S XDRNAME=Y
I $$FIND1^DIC(15.2,",","Q",XDRNAME)>0 D G NAME
. W !!,$C(7),"The name entered has already been used. The name must be unique.",!!
;
; CREATE PROCESS ENTRY
;
S XDRXX(15.2,"+1,",.01)=XDRNAME
S XDRXX(15.2,"+1,",.02)=XDRFIL
D UPDATE^DIE("","XDRXX","XDRYY","XDRMA")
S XDRFDA=$G(XDRYY(1))
;
; NOW MOVE LIST OF DUPLICATES TO BE PROCESSED INTO THIS ENTRY
S XDRIENS="+1,"_XDRFDA_","
F XDRI=0:0 S XDRI=$O(XDRX(XDRI)) Q:XDRI'>0 D
. S XDRJ=$O(XDRX(XDRI,0))
. S XDRK=XDRX(XDRI,XDRJ)
. K XDRXX,XDRYY
. S XDRXX(15.22,XDRIENS,.01)=XDRI ; IEN1
. S XDRXX(15.22,XDRIENS,.02)=XDRJ ; IEN2
. S XDRXX(15.22,XDRIENS,.03)=XDRK ; ENTRY # IN FILE 15
. D UPDATE^DIE("","XDRXX","XDRYY","XDRMA")
. K XDRXX,XDRYY,XDRMA
. ; AND MARK THEM AS IN THIS MERGE PROCESS IN FILE 15
. S XDRXX(15,XDRK_",",.05)=3
. S XDRXX(15,XDRK_",",.2)=XDRFDA
. D FILE^DIE("","XDRXX")
. ; JLI 3/12/98 - FOR SOME REASON THE .05 FIELD STILL DOESN'T SEEM TO BE GETTING SET TO 3, SO CHECK IT AND IF THAT IS THE CASE, HARDSET IT.
. I $P(^VA(15,XDRK,0),U,5)'=3 S $P(^(0),U,5)=3
;
K DR S DR=".03;.04///S;" ; GET DESIRED START TIME AND MARK PROCESS AS SCHEDULED
S DIE="^VA(15.2,"
S DA=XDRFDA
D ^DIE
S ZTDTH=$P(^VA(15.2,XDRFDA,0),U,3) ; TAKE DESIRED TIME
I ZTDTH>0 D Q:$G(ZTSK)>0 ; AND SET UP TASK
. S ZTRTN="DQ^XDRMERG0",ZTDESC="MERGE PROCESS "_XDRNAME
. S ZTIO="NULL",ZTSAVE("XDRFDA")=""
. D ^%ZTLOAD
. I $G(ZTSK)>0 D
. . K DR S DR=".08///"_ZTSK_";",DIE="^VA(15.2,",DA=XDRFDA D ^DIE
. . W !!,"Merge process '",$P(^VA(15.2,XDRFDA,0),U),"' for Verified Duplicates in File ",XDRFIL," scheduled",!,"as task ",ZTSK,".",!
;
; TASK INFO, TIME, ETC. NOT COMPLETE - SO REVERSE IT
;
F XDRI=0:0 S XDRI=$O(XDRX(XDRI)) Q:XDRI'>0 D
. S XDRJ=$O(XDRX(XDRI,0))
. S XDRK=XDRX(XDRI,XDRJ)
. K XDRXX,XDRYY
. S XDRXX(15,XDRK_",",.2)="@" ; UNMARK ENTRY IN FILE 15
. S XDRXX(15,XDRK_",",.05)=1
. D UPDATE^DIE("","XDRXX")
S DA=XDRFDA
S DIK="^VA(15.2,"
D ^DIK
W !!,$C(7),"The Merge Process has been aborted, no changes made."
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXDRMERGB 9323 printed Nov 22, 2024@17:49:28 Page 2
XDRMERGB ;SF-IRMFO.SEA/JLI - TENATIVE UPDATE POINTER NODES ;5/14/98 10:30
+1 ;;7.3;TOOLKIT;**23,137**;Apr 25, 1995;Build 10
+2 ;;
+3 QUIT
+4 ;
MERGEIT ; MERGE TWO ENTRIES IN FILE
+1 NEW NODE,NODE1,NODE2,NODEA,SFILE,XDRFROM,XDRTO,NODEA,VALUE,XVALUE,XDRXX,NODEB,DIK,DA,I,Y,VREF,XNN,XFILNO,IENTOSTR,DFN,XDRZZ
+2 ; DEBUG STATEMENT
NEW XDRAA
+3 ;
+4 SET XFILNO=+$PIECE(@(XDRDIC_"0)"),U,2)
+5 SET IENTOSTR=IENTO_","_XDRIENS
+6 SET DFN=IENTO
+7 ;
+8 ; NOW MERGE DATA GOING NODE BY NODE
+9 ;
+10 SET NODE=""
+11 FOR
Begin DoDot:1
+12 SET NODE1=$ORDER(@(XDRDIC_IENFROM_","""_NODE_""")"))
+13 ; NOTHING MORE TO MOVE OVER
IF NODE1=""
SET NODE=""
QUIT
+14 SET NODE2=$ORDER(@(XDRDIC_IENTO_","""_NODE_""")"))
+15 ; NODE ON TO, BUT NOT ON FROM - GO TO NEXT
IF NODE2'=""
IF NODE1]NODE2
SET NODE=NODE2
QUIT
+16 SET NODE=NODE1
+17 ; SINGLE NODE, MERGE DATA
IF $DATA(@(XDRDIC_IENFROM_","""_NODE_""")"))=1
Begin DoDot:2
+18 ; MISSING NODE, JUST MOVE IT OVER
IF NODE2]NODE1!(NODE2="")
Begin DoDot:3
+19 NEW XDRXX,FLD,N,J
+20 FOR N=0:0
SET N=$ORDER(^DD(XFILNO,"GL",NODE,N))
if N'>0
QUIT
SET FLD=$ORDER(^(N,0))
IF $ORDER(^DD(XFILNO,FLD,1,0))>0
Begin DoDot:4
+21 SET X=0
FOR J=0:0
SET J=$ORDER(^DD(XFILNO,FLD,1,J))
if J'>0
QUIT
IF $ORDER(^(J,0))>0
SET X=1
QUIT
+22 IF X>0
Begin DoDot:5
+23 SET XDRXX(XFILNO,IENTOSTR,FLD)=$PIECE(@(XDRDIC_IENFROM_","""_NODE_""")"),U,N)
End DoDot:5
End DoDot:4
+24 ; DEBUT STATEMENT
KILL XDRAA
IF $DATA(XDRTESTK)
IF $DATA(XDRXX)
MERGE XDRAA=XDRXX
+25 KILL XDRZZ
+26 IF $DATA(XDRXX)
DO FILE^DIE("","XDRXX","XDRZZ")
+27 ; DEBUG STATMENT
IF $DATA(XDRTESTK)
IF $DATA(XDRZZ)
SET XDRTESTK=XDRTESTK+1
MERGE ^XTMP("XDRTESTK",$$NOW^XLFDT(),XDRTESTK,"XX")=XDRAA,^("ZZ")=XDRZZ
+28 MERGE @(XDRDIC_IENTO_","""_NODE_""")")=@(XDRDIC_IENFROM_","""_NODE_""")")
End DoDot:3
QUIT
+29 ; MISMATCH SO QUIT
IF $DATA(@(XDRDIC_IENTO_","""_NODE_""")"))>1
QUIT
+30 NEW XDRXX,FLD
+31 SET X1=@(XDRDIC_IENFROM_","""_NODE_""")")
+32 SET (X2,X3)=@(XDRDIC_IENTO_","""_NODE_""")")
+33 FOR I=1:1
if X1=""
QUIT
SET X=$PIECE(X1,U)
SET X1=$PIECE(X1,U,2,999)
IF X'=""
Begin DoDot:3
+34 SET Y=$PIECE(X2,U,I)
+35 IF Y=""
Begin DoDot:4
+36 ;S $P(X2,U,I)=X ;LLS 26-OCT-2013 replaced with conditional SET below
+37 SET FLD=$ORDER(^DD(XFILNO,"GL",NODE,I,0))
SET JXFLD=FLD
+38 ;LLS 26-OCT-2013 - replaced set of X2 so do not move 'test patient indicator'
IF (XFILNO'=2)!(FLD'=.6)
SET $PIECE(X2,U,I)=X
+39 ;LLS 26-OCT-2013 - Do not want to move 'test patient indicator'
IF XFILNO=2
IF FLD=.6
QUIT
+40 IF FLD>0
IF $ORDER(^DD(XFILNO,FLD,1,0))>0
SET XDRXX(XFILNO,IENTOSTR,FLD)=X
End DoDot:4
End DoDot:3
+41 IF X2'=X3
Begin DoDot:3
+42 IF $DATA(XDRXX)
Begin DoDot:4
+43 ; DEBUG STATEMENT
KILL XDRAA
IF $DATA(XDRTESTK)
MERGE XDRAA=XDRXX
+44 KILL XDRZZ
+45 NEW X2
DO FILE^DIE("","XDRXX","XDRZZ")
+46 ; DEBUG STATMENT
IF $DATA(XDRTESTK)
IF $DATA(XDRZZ)
SET XDRTESTK=XDRTESTK+1
MERGE ^XTMP("XDRTESTK",$$NOW^XLFDT(),XDRTESTK,"XX")=XDRAA,^("ZZ")=XDRZZ
End DoDot:4
+47 ; SET MERGED DATA ON NODE
SET @(XDRDIC_IENTO_","""_NODE_""")")=X2
End DoDot:3
End DoDot:2
QUIT
+48 ;
+49 ; THE FOLLOWING HANDLES NODES THAT HAVE MULTIPLES
+50 ;
+51 SET XDRFROM=XDRDIC_IENFROM_","""_NODE_""","
+52 SET XDRTO=XDRDIC_IENTO_","""_NODE_""","
+53 IF NODE="DIS"
IF XFILNO=2
DO DODIS^XDRMERGA
QUIT
+54 SET IENTOSTR=IENTO_","_XDRIENS
+55 DO DOSUBS^XDRMERGA(XDRFROM,XDRTO,IENTOSTR,IENTO)
End DoDot:1
if NODE=""
QUIT
+56 SET XDRXX=$PIECE(@(XDRDIC_IENFROM_",0)"),U)
+57 ; KILL OFF MERGED FROM ENTRY
KILL DA
NEW DIU
SET DIU(0)=1
SET DIK=XDRDIC
SET DA=IENFROM
SET DFN=DA
DO ^DIK
+58 SET @(XDRDIC_IENFROM_",0)")=XDRXX
+59 QUIT
+60 ;
SAVEMERG(FILE,IENFROM,IENTO) ;
+1 NEW IENS,XDRFILE,YYY,ZZZ,XDRFDA,FROMARG,TOARG,XDRDA,Q,Q1,IENVAL,XDRSUB
+2 SET FROMARG=$ORDER(@FROM@(IENFROM,IENTO,""))
if FROMARG=""
QUIT
+3 SET TOARG=$ORDER(@FROM@(IENFROM,IENTO,FROMARG,""))
+4 SET XDRDA=$$FIND1^DIC(15.4,"","Q",FROMARG)
+5 IF XDRDA>0
IF $PIECE(^XDRM(XDRDA,0),U)'=FROMARG
SET XDRDA=0
+6 IF XDRDA'>0
Begin DoDot:1
+7 NEW XDRFDA
+8 SET XDRFDA(15.4,"+1,",.01)=FROMARG
+9 SET XDRFDA(15.4,"+1,",.02)=TOARG
+10 SET XDRFDA(15.4,"+1,",.03)=DT
+11 DO UPDATE^DIE("","XDRFDA","YYY")
SET IENS=YYY(1)
+12 SET XDRDA=YYY(1)
End DoDot:1
+13 SET XDRFILE=$PIECE(^DIC(FILE,0),U)
+14 SET IENS=$$FIND1^DIC(15.41,","_XDRDA_",","Q",XDRFILE)
+15 IF IENS'>0
Begin DoDot:1
+16 SET IENS="+1,"_XDRDA_","
+17 SET XDRFDA(15.41,IENS,.01)=XDRFILE
+18 IF IENFROM>0
SET XDRFDA(15.41,IENS,.02)=IENFROM
+19 KILL YYY
+20 DO UPDATE^DIE("","XDRFDA","YYY","ZZZ")
SET IENS=YYY(1)
End DoDot:1
+21 IF IENFROM>0
Begin DoDot:1
+22 SET XDRSUB=15.411
SET IENVAL=IENFROM
+23 DO STORMERG
End DoDot:1
+24 KILL XDRFDA
+25 SET IENS=$$FIND1^DIC(15.42,","_XDRDA_",","Q",XDRFILE)
+26 IF IENS'>0
Begin DoDot:1
+27 SET IENS="+1,"_XDRDA_","
+28 SET XDRFDA(15.42,IENS,.01)=XDRFILE
+29 IF IENTO>0
SET XDRFDA(15.42,IENS,.02)=IENTO
+30 KILL YYY,ZZZ
+31 DO UPDATE^DIE("","XDRFDA","YYY","ZZZ")
SET IENS=YYY(1)
End DoDot:1
+32 IF IENTO>0
Begin DoDot:1
+33 SET XDRSUB=15.421
SET IENVAL=IENTO
+34 DO STORMERG
End DoDot:1
+35 QUIT
STORMERG ;
+1 ; REMOVE ANY PREVIOUS TRIES
KILL ^VA(15.4,XDRDA,$SELECT(XDRSUB=15.411:1,1:2),IENS,1)
+2 SET IENS="+1,"_IENS_","_XDRDA_","
+3 SET Q=^DIC(FILE,0,"GL")_IENVAL_")"
SET Q1=$EXTRACT(Q,1,$LENGTH(Q)-1)
+4 FOR
SET Q=$QUERY(@Q)
if Q'[Q1
QUIT
Begin DoDot:1
+5 KILL XDRFDA
+6 SET XDRFDA(XDRSUB,IENS,.01)=$EXTRACT(Q,2,$LENGTH(Q))
+7 IF @Q'=""
SET XDRFDA(XDRSUB,IENS,1.01)=@Q
+8 DO UPDATE^DIE("","XDRFDA")
End DoDot:1
+9 QUIT
+10 ;
SAVEPNTR(IENFROM,IENTO,FILE,IENS,FIELD,VALUE) ;
+1 NEW XDRFDA,XDRDA,FROMARG
+2 SET FROMARG=$ORDER(@FROM@(IENFROM,IENTO,""))
if FROMARG=""
QUIT
+3 SET XDRDA=$$FIND1^DIC(15.4,"","Q",FROMARG)
+4 SET X=FILE_";"_IENS_";"_FIELD
+5 SET XDRFDA(15.43,"+1,"_XDRDA_",",.01)=X
+6 SET XDRFDA(15.43,"+1,"_XDRDA_",",1.01)=VALUE
+7 DO UPDATE^DIE("","XDRFDA")
+8 QUIT
SNDMSG(XDRFDA) ;Sends msg when merge process has completed.
+1 NEW XDRGRP,XMTEXT,XMSUB,XMDUZ,XDRNAME
+2 SET XDRNAME=$$GET1^DIQ(15.2,XDRFDA,.01)
+3 SET R(1,0)=XDRNAME_" merge process has completed."
+4 SET XDRGRP=$$GET1^DIQ(15.1,"2,",.29,"I")
+5 if XDRGRP>0
SET XDRGRPN=$$GET1^DIQ(3.8,XDRGRP,.01)
+6 SET XDRGRP=$SELECT(XDRGRP>0:"G."_XDRGRPN,1:"")
+7 if XDRGRP'=""
SET XMY(XDRGRP)=""
+8 ;If no mail grp found, send msg to postmaster
if XDRGRP=""
SET XMY(.5)=""
+9 SET XMTEXT="R("
SET XMSUB=XDRNAME_" Completed"
SET XMDUZ=.5
SET XMCHAN=1
+10 DO ^XMD
+11 QUIT
+12 ;
QUE ; (Moved from XDRMERG0)
+1 ;
+2 NEW XDRXX,XDRYY,XDRMA,DIE,DIC,DIR,DR,ZTDTH,ZTSK
+3 NEW XDRX,XDRY,XDRFIL,XDRGLOB,X,Y,XDRNAME
+4 NEW XDRFDA,XDRIENS,XDRI,XDRJ,XDRK,DA,DIK
+5 ;
+6 SET XDRFIL=$$FILE^XDRDPICK()
if XDRFIL'>0
QUIT
+7 IF XDRFIL=2
Begin DoDot:1
+8 NEW X,XDRKEY
+9 SET (X,XDRKEY)=0
FOR
SET X=$ORDER(^VA(200,DUZ,51,"B",X))
if X'>0!(XDRKEY)
QUIT
Begin DoDot:2
+10 IF $$GET1^DIQ(19.1,X,.01)="DG ELIGIBILITY"
SET XDRKEY=1
+11 QUIT
End DoDot:2
+12 SET Y=0
IF 'XDRKEY
WRITE !!,"You should hold the 'DG ELIGIBILITY' key to run a patient file merge."
SET Y=1
+13 QUIT
End DoDot:1
if Y
QUIT
+14 SET XDRDIC=^DIC(XDRFIL,0,"GL")
+15 SET XDRGLOB=$EXTRACT(XDRDIC,2,999)
+16 SET X=""
+17 SET XNCNT=0
SET XNCNT0=0
+18 FOR
SET X=$ORDER(^VA(15,"AVDUP",XDRGLOB,X))
if X=""
QUIT
SET Y=$ORDER(^(X,0))
Begin DoDot:1
+19 NEW YVAL
SET YVAL=^VA(15,Y,0)
+20 ; ALREADY DONE OR SCHEDULED
IF $PIECE(YVAL,U,20)>0
QUIT
+21 ; TAKE ONLY VERIFIED
IF $PIECE(YVAL,U,3)'="V"
QUIT
+22 ; TAKE ONLY IF MARKED READY TO MERGE
IF $PIECE(YVAL,U,5)'=1
QUIT
+23 IF $PIECE(YVAL,U,13)>0
Begin DoDot:2
+24 IF '$DATA(@(XDRDIC_(+YVAL)_",0)"))!'$DATA(@(XDRDIC_(+$PIECE(YVAL,U,2))_",0)"))
QUIT
+25 ; get ien numbers from duplicate file
IF $PIECE(YVAL,U,4)'=2
SET XDRX(+YVAL,+$PIECE(YVAL,U,2))=Y
+26 ; Reverse - merge to switched
IF '$TEST
SET XDRX(+$PIECE(YVAL,U,2),+YVAL)=Y
+27 SET XNCNT=XNCNT+1
End DoDot:2
End DoDot:1
+28 WRITE !!,XNCNT," Entries Ready to be included in merge"
+29 IF $ORDER(XDRX(0))'>0
Begin DoDot:1
+30 WRITE !!?15,$CHAR(7),"No Verified Duplicates included in merge",$CHAR(7),!!
End DoDot:1
QUIT
+31 ;
+32 KILL DIR
SET DIR(0)="Y"
+33 SET DIR("A",1)="This process will take a **LONG** time (usually over 15 hours, and sometimes"
+34 SET DIR("A",2)="considerably longer), but you CAN stop and restart the process when you"
+35 SET DIR("A")="want using the options. OK"
+36 DO ^DIR
KILL DIR
if Y'>0
QUIT
NAME WRITE !!
SET DIR(0)="F^2:30"
+1 SET DIR("A")="Name for Merge Process"
+2 SET DIR("?",1)="Enter a unique name by which the MERGE PROCESS will be identified"
+3 SET DIR("?")="This name should be 2 to 30 characters in length"
+4 DO ^DIR
+5 KILL DIR
if Y=U
QUIT
SET XDRNAME=Y
+6 IF $$FIND1^DIC(15.2,",","Q",XDRNAME)>0
Begin DoDot:1
+7 WRITE !!,$CHAR(7),"The name entered has already been used. The name must be unique.",!!
End DoDot:1
GOTO NAME
+8 ;
+9 ; CREATE PROCESS ENTRY
+10 ;
+11 SET XDRXX(15.2,"+1,",.01)=XDRNAME
+12 SET XDRXX(15.2,"+1,",.02)=XDRFIL
+13 DO UPDATE^DIE("","XDRXX","XDRYY","XDRMA")
+14 SET XDRFDA=$GET(XDRYY(1))
+15 ;
+16 ; NOW MOVE LIST OF DUPLICATES TO BE PROCESSED INTO THIS ENTRY
+17 SET XDRIENS="+1,"_XDRFDA_","
+18 FOR XDRI=0:0
SET XDRI=$ORDER(XDRX(XDRI))
if XDRI'>0
QUIT
Begin DoDot:1
+19 SET XDRJ=$ORDER(XDRX(XDRI,0))
+20 SET XDRK=XDRX(XDRI,XDRJ)
+21 KILL XDRXX,XDRYY
+22 ; IEN1
SET XDRXX(15.22,XDRIENS,.01)=XDRI
+23 ; IEN2
SET XDRXX(15.22,XDRIENS,.02)=XDRJ
+24 ; ENTRY # IN FILE 15
SET XDRXX(15.22,XDRIENS,.03)=XDRK
+25 DO UPDATE^DIE("","XDRXX","XDRYY","XDRMA")
+26 KILL XDRXX,XDRYY,XDRMA
+27 ; AND MARK THEM AS IN THIS MERGE PROCESS IN FILE 15
+28 SET XDRXX(15,XDRK_",",.05)=3
+29 SET XDRXX(15,XDRK_",",.2)=XDRFDA
+30 DO FILE^DIE("","XDRXX")
+31 ; JLI 3/12/98 - FOR SOME REASON THE .05 FIELD STILL DOESN'T SEEM TO BE GETTING SET TO 3, SO CHECK IT AND IF THAT IS THE CASE, HARDSET IT.
+32 IF $PIECE(^VA(15,XDRK,0),U,5)'=3
SET $PIECE(^(0),U,5)=3
End DoDot:1
+33 ;
+34 ; GET DESIRED START TIME AND MARK PROCESS AS SCHEDULED
KILL DR
SET DR=".03;.04///S;"
+35 SET DIE="^VA(15.2,"
+36 SET DA=XDRFDA
+37 DO ^DIE
+38 ; TAKE DESIRED TIME
SET ZTDTH=$PIECE(^VA(15.2,XDRFDA,0),U,3)
+39 ; AND SET UP TASK
IF ZTDTH>0
Begin DoDot:1
+40 SET ZTRTN="DQ^XDRMERG0"
SET ZTDESC="MERGE PROCESS "_XDRNAME
+41 SET ZTIO="NULL"
SET ZTSAVE("XDRFDA")=""
+42 DO ^%ZTLOAD
+43 IF $GET(ZTSK)>0
Begin DoDot:2
+44 KILL DR
SET DR=".08///"_ZTSK_";"
SET DIE="^VA(15.2,"
SET DA=XDRFDA
DO ^DIE
+45 WRITE !!,"Merge process '",$PIECE(^VA(15.2,XDRFDA,0),U),"' for Verified Duplicates in File ",XDRFIL," scheduled",!,"as task ",ZTSK,".",!
End DoDot:2
End DoDot:1
if $GET(ZTSK)>0
QUIT
+46 ;
+47 ; TASK INFO, TIME, ETC. NOT COMPLETE - SO REVERSE IT
+48 ;
+49 FOR XDRI=0:0
SET XDRI=$ORDER(XDRX(XDRI))
if XDRI'>0
QUIT
Begin DoDot:1
+50 SET XDRJ=$ORDER(XDRX(XDRI,0))
+51 SET XDRK=XDRX(XDRI,XDRJ)
+52 KILL XDRXX,XDRYY
+53 ; UNMARK ENTRY IN FILE 15
SET XDRXX(15,XDRK_",",.2)="@"
+54 SET XDRXX(15,XDRK_",",.05)=1
+55 DO UPDATE^DIE("","XDRXX")
End DoDot:1
+56 SET DA=XDRFDA
+57 SET DIK="^VA(15.2,"
+58 DO ^DIK
+59 WRITE !!,$CHAR(7),"The Merge Process has been aborted, no changes made."
+60 QUIT
+61 ;
