- 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 Mar 13, 2025@20:46:11 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
