RGDRM02 ;BAY/ALS-MPI/PD AWARE DUPLICATE RECORD MERGE ;03/10/00
;;1.0;CLINICAL INFO RESOURCE NETWORK;**6,42**;30 Apr 99
MRGTF(DFNFRM,DFNTO) ; Merge Treating Facility entries
I '$D(DFNFRM)!'$D(DFNTO) Q
Q:'$D(^DGCN(391.91,"APAT",DFNFRM))
; Add Treating Facilities in FROM record to Treating
; Facility List for TO record
S INST=0
F S INST=$O(^DGCN(391.91,"APAT",DFNFRM,INST)) Q:'INST D
. I '$D(^DGCN(391.91,"APAT",DFNTO,INST)) DO
.. ;S STANUM=0
.. ;S STANUM=$P($$NS^XUAF4(INST),"^",2)
.. D FILE^VAFCTFU(DFNTO,INST,1) ;**42
.. I '$D(^DGCN(391.91,"APAT",DFNTO,INST)) D
... D START^RGHLLOG($G(HLMTIEN)),EXC^RGHLLOG(212,"Treating Facility Add failed for DFN: "_DFNTO_", Treating Facility: "_INST,DFNTO),STOP^RGHLLOG(0) Q
. ;Delete FROM record Treating Facility data
. S IEN=0
. F S IEN=$O(^DGCN(391.91,"APAT",DFNFRM,INST,IEN)) Q:'IEN D
.. S DA=IEN,DIK="^DGCN(391.91,"
.. D ^DIK K DIK,DA
K INST,STANUM,IEN
Q
MRGSUB(DFNFRM,DFNTO) ; Merge Subscription entries.
I '$D(DFNFRM)!'$D(DFNTO) Q
N SUBFRM,SUBTO
S SUBFRM=$$SUBNUM^MPIFAPI(DFNFRM)
Q:SUBFRM<0 ;No subscriptions in FRM record, quit
S SUBTO=$$SUBNUM^MPIFAPI(DFNTO)
I SUBTO<0 S SUBTO=$$GETSCN^RGJCREC(DFNTO)
S ENTRYF=0,ENTRYT=0
D GET^HLSUB(SUBFRM,0,"",.FROM)
D GET^HLSUB(SUBTO,0,"",.TO)
F S ENTRYF=$O(FROM("LINKS",ENTRYF)) Q:'ENTRYF D
. S LINKF=$P(FROM("LINKS",ENTRYF),"^",2)
. S MATCH=0
. F S ENTRYT=$O(TO("LINKS",ENTRYT)) Q:'ENTRYT D
.. S LINKT=$P(TO("LINKS",ENTRYT),"^",2)
.. I LINKF=LINKT S MATCH=1 Q
. I MATCH=0 D
.. S TYPE=0
.. D UPD^HLSUB(SUBTO,LINKF,TYPE,"","","",.ER)
.. K TO
.. D GET^HLSUB(SUBTO,0,"",.TO) ; get new list
.. S L=0,LINK="",ADD=0
.. F S L=$O(TO("LINKS",L)) Q:'L D
... S LINK=$P(TO("LINKS",L),"^",2) I LINK=LINKF S ADD=1
.. I ADD=0 D
... D START^RGHLLOG($G(HLMTIEN)),EXC^RGHLLOG(224,"Subscription Add Failed for DFN: "_DFNTO_", Subscriber: "_LINKF,DFNTO),STOP^RGHLLOG(0) Q
; Delete FROM record subscription data and pointer to subscription file
N RGARR,RGERR
S RGARR(991.05)="@"
S RGERR=$$UPDATE^MPIFAPI(DFNFRM,"RGARR")
K ENTRYF,ENTRYT,LINKF,LINKT,TO,MATCH,FROM,LNAME,LIEN,TYPE,ER,ADD,L,LINK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGDRM02 2178 printed Apr 09, 2024@20:46:52 Page 2
RGDRM02 ;BAY/ALS-MPI/PD AWARE DUPLICATE RECORD MERGE ;03/10/00
+1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**6,42**;30 Apr 99
MRGTF(DFNFRM,DFNTO) ; Merge Treating Facility entries
+1 IF '$DATA(DFNFRM)!'$DATA(DFNTO)
QUIT
+2 if '$DATA(^DGCN(391.91,"APAT",DFNFRM))
QUIT
+3 ; Add Treating Facilities in FROM record to Treating
+4 ; Facility List for TO record
+5 SET INST=0
+6 FOR
SET INST=$ORDER(^DGCN(391.91,"APAT",DFNFRM,INST))
if 'INST
QUIT
Begin DoDot:1
+7 IF '$DATA(^DGCN(391.91,"APAT",DFNTO,INST))
Begin DoDot:2
+8 ;S STANUM=0
+9 ;S STANUM=$P($$NS^XUAF4(INST),"^",2)
+10 ;**42
DO FILE^VAFCTFU(DFNTO,INST,1)
+11 IF '$DATA(^DGCN(391.91,"APAT",DFNTO,INST))
Begin DoDot:3
+12 DO START^RGHLLOG($GET(HLMTIEN))
DO EXC^RGHLLOG(212,"Treating Facility Add failed for DFN: "_DFNTO_", Treating Facility: "_INST,DFNTO)
DO STOP^RGHLLOG(0)
QUIT
End DoDot:3
End DoDot:2
+13 ;Delete FROM record Treating Facility data
+14 SET IEN=0
+15 FOR
SET IEN=$ORDER(^DGCN(391.91,"APAT",DFNFRM,INST,IEN))
if 'IEN
QUIT
Begin DoDot:2
+16 SET DA=IEN
SET DIK="^DGCN(391.91,"
+17 DO ^DIK
KILL DIK,DA
End DoDot:2
End DoDot:1
+18 KILL INST,STANUM,IEN
+19 QUIT
MRGSUB(DFNFRM,DFNTO) ; Merge Subscription entries.
+1 IF '$DATA(DFNFRM)!'$DATA(DFNTO)
QUIT
+2 NEW SUBFRM,SUBTO
+3 SET SUBFRM=$$SUBNUM^MPIFAPI(DFNFRM)
+4 ;No subscriptions in FRM record, quit
if SUBFRM<0
QUIT
+5 SET SUBTO=$$SUBNUM^MPIFAPI(DFNTO)
+6 IF SUBTO<0
SET SUBTO=$$GETSCN^RGJCREC(DFNTO)
+7 SET ENTRYF=0
SET ENTRYT=0
+8 DO GET^HLSUB(SUBFRM,0,"",.FROM)
+9 DO GET^HLSUB(SUBTO,0,"",.TO)
+10 FOR
SET ENTRYF=$ORDER(FROM("LINKS",ENTRYF))
if 'ENTRYF
QUIT
Begin DoDot:1
+11 SET LINKF=$PIECE(FROM("LINKS",ENTRYF),"^",2)
+12 SET MATCH=0
+13 FOR
SET ENTRYT=$ORDER(TO("LINKS",ENTRYT))
if 'ENTRYT
QUIT
Begin DoDot:2
+14 SET LINKT=$PIECE(TO("LINKS",ENTRYT),"^",2)
+15 IF LINKF=LINKT
SET MATCH=1
QUIT
End DoDot:2
+16 IF MATCH=0
Begin DoDot:2
+17 SET TYPE=0
+18 DO UPD^HLSUB(SUBTO,LINKF,TYPE,"","","",.ER)
+19 KILL TO
+20 ; get new list
DO GET^HLSUB(SUBTO,0,"",.TO)
+21 SET L=0
SET LINK=""
SET ADD=0
+22 FOR
SET L=$ORDER(TO("LINKS",L))
if 'L
QUIT
Begin DoDot:3
+23 SET LINK=$PIECE(TO("LINKS",L),"^",2)
IF LINK=LINKF
SET ADD=1
End DoDot:3
+24 IF ADD=0
Begin DoDot:3
+25 DO START^RGHLLOG($GET(HLMTIEN))
DO EXC^RGHLLOG(224,"Subscription Add Failed for DFN: "_DFNTO_", Subscriber: "_LINKF,DFNTO)
DO STOP^RGHLLOG(0)
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+26 ; Delete FROM record subscription data and pointer to subscription file
+27 NEW RGARR,RGERR
+28 SET RGARR(991.05)="@"
+29 SET RGERR=$$UPDATE^MPIFAPI(DFNFRM,"RGARR")
+30 KILL ENTRYF,ENTRYT,LINKF,LINKT,TO,MATCH,FROM,LNAME,LIEN,TYPE,ER,ADD,L,LINK
+31 QUIT
