233 lines
8.6 KiB
Mathematica
233 lines
8.6 KiB
Mathematica
XDRMERGB ;SF-IRMFO.SEA/JLI - TENATIVE UPDATE POINTER NODES ;5/14/98 10:30
|
|
;;7.3;TOOLKIT;**23**;Apr 25, 1995
|
|
;;
|
|
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
|
|
. . . . S FLD=$O(^DD(XFILNO,"GL",NODE,I,0)) S JXFLD=FLD
|
|
. . . . 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
|
|
;
|