RGDRM01 ;BAY/ALS-MPI/PD AWARE DUPLICATE RECORD MERGE ;02/22/00
;;1.0;CLINICAL INFO RESOURCE NETWORK;**6,10,12,29,36,51,69**;30 Apr 99;Build 1
;
;Reference to ^DPT( supported by IA #2070
;Reference to ^DPT("AICN" supported by IA #2070
;Reference to $$A40^MPIFA40 supported by IA #4294
;
CKICNS(DFNFRM,DFNTO) ;Check ICN's and CMORs of FROM and TO records of
; duplicate record pair
N CMORFRM,CMORTO,RETURN,ICNFRM,ICNTO,LOCFRM,LOCTO,PICN,ERR
S RETURN="1^OK to merge"
I ($G(DFNFRM)'>0)!($G(DFNTO)'>0) S RETURN="0^DFN NOT PASSED" G EXIT
S CMORFRM=$$GETVCCI^MPIF001(DFNFRM)
S CMORTO=$$GETVCCI^MPIF001(DFNTO)
S ICNFRM=$$GETICN^MPIF001(DFNFRM)
S ICNTO=$$GETICN^MPIF001(DFNTO)
S LOCFRM=$$IFLOCAL^MPIF001(DFNFRM)
S LOCTO=$$IFLOCAL^MPIF001(DFNTO)
S HOME=$$SITE^VASITE()
S PICN=ICNTO
I $E(ICNTO,1,3)=$E($P(HOME,"^",3),1,3)!(ICNTO<0) D
.;HAVE LOCAL ICN OR NO ICN AS TO ICN
.I ICNFRM>0,$E(ICNFRM,1,3)'=$E($P(HOME,"^",3),1,3) S PICN=ICNFRM ;FROM ICN IS NATIONAL ICN
;**51 send A40 regardless of ICN status on TO or FROM record
S ERR=$$A40^MPIFA40(DFNTO,DFNFRM,PICN)
I $P(ERR,"^",1)=-1 S RETURN="0^CANNOT MERGE RECORDS "_DFNFRM_" AND "_DFNTO_", "_$P(ERR,"^",2) G EXIT
; If both records have local ICNs, delete FROM data, keep TO data
I (LOCFRM=1)&(LOCTO=1) S ICN=$P(ICNFRM,"V",1) D DEL D DEL^RGDRM03 G EXIT
; If both records have a national ICN, delete the FROM data
I ($E(ICNFRM,1,3)'=$E($P(HOME,"^",3),1,3)&(ICNFRM>0))&($E(ICNTO,1,3)'=$E($P(HOME,"^",3),1,3)&(ICNTO>0)) D G EXIT
.S ICN=$P(ICNFRM,"V",1) D DEL D DEL^RGDRM03
; If both records have local ICNs, delete FROM data, keep TO data
I (LOCFRM=1)&(LOCTO=1) S ICN=$P(ICNFRM,"V",1) D DEL D DEL^RGDRM03 G EXIT
; If FROM record is local and TO record is null, merge
I (LOCFRM=1)&(ICNTO<0) D MRGICN D MRGCMOR^RGDRM03
; If FROM record is National and TO record is local OR null, merge
I $E(ICNFRM,1,3)'=$E($P(HOME,"^",3),1,3),ICNFRM>0 D G EXIT
.I LOCTO=1!(ICNTO<1) D MRGICN D MRGCMOR^RGDRM03
; If FROM record is local and TO record is National, delete FROM data, keep TO data
I (LOCFRM=1)&(LOCTO=0)&(ICNTO>0) S ICN=$P(ICNFRM,"V",1) D DEL D DEL^RGDRM03
;
EXIT ;
Q RETURN
MRGICN ;Set ICN and ICN Checksum in TO record to values in FROM record
N ICN,CKSUM,DIQUIET,RGRSICN
S DIQUIET=1,RGRSICN=1
S ICN=$P(ICNFRM,"V",1),CKSUM=$P(ICNFRM,"V",2)
L +^DPT(DFNTO):10
;**69, Story 625205 (jfw) - Add FULL ICN to update
S DIE="^DPT(",DA=DFNTO,DR="991.01///^S X=ICN;991.02///^S X=CKSUM;991.1///^S X=ICNFRM"
D ^DIE K DIE,DA,DR
L -^DPT(DFNTO)
S ICNTO="" S ICNTO=$$GETICN^MPIF001(DFNTO)
;Make sure local icn flag is not set if national just got assigned
I ($E(ICNTO,1,3)'=$E($P(HOME,"^",3),1,3)&(ICNTO>0)) D
. L +^DPT(DFNTO):10
. S DIE="^DPT(",DA=DFNTO,DR="991.04///@"
. D ^DIE K DIE,DA,DR
. L -^DPT(DFNTO)
; set local icn flag to Y if local just got assigned
I $E(ICNTO,1,3)=$E($P(HOME,"^",3),1,3) D
. L +^DPT(DFNTO):10
. S DIE="^DPT(",DA=DFNTO,DR="991.04///^S X=1"
. D ^DIE K DIE,DA,DR
. L -^DPT(DFNTO)
DEL ;Delete ICN, ICN Checksum and Locally Assigned ICN fields in FROM record
N DIQUIET,RGRSICN
S DIQUIET=1,RGRSICN=1
L +^DPT(DFNFRM):10
;**69, Story 625205 (jfw) - Add FULL ICN to update
S DIE="^DPT(",DA=DFNFRM,DR="991.01///@;991.02///@;991.04///@;991.1///@"
D ^DIE K DIE,DA,DR
K ^DPT("AICN",ICN,DFNFRM)
L -^DPT(DFNFRM)
DELEXC ;Delete exceptions on file for patient record being removed.
S EXCT=""
F S EXCT=$O(^RGHL7(991.1,"ADFN",EXCT)) Q:EXCT="" D
. I $D(^RGHL7(991.1,"ADFN",EXCT,DFNFRM)) D
.. S IEN=0
.. F S IEN=$O(^RGHL7(991.1,"ADFN",EXCT,DFNFRM,IEN)) Q:'IEN D
... S IEN2=0
... F S IEN2=$O(^RGHL7(991.1,"ADFN",EXCT,DFNFRM,IEN,IEN2)) Q:'IEN2 D
.... S NUM="" S NUM=$P(^RGHL7(991.1,IEN,1,0),"^",4)
.... I NUM=1 D
..... L +^RGHL7(991.1,IEN):10
..... S DIK="^RGHL7(991.1,",DA=IEN
..... D ^DIK K DIK,DA
..... L -^RGHL7(991.1,IEN)
.... E I NUM>1 D DELE
K EXCT,IEN,IEN2,NUM
QUIT Q
DELE ;Delete exception
L +^RGHL7(991.1,IEN):10
S DA(1)=IEN,DA=IEN2
S DIK="^RGHL7(991.1,"_DA(1)_",1,"
D ^DIK K DIK,DA
L -^RGHL7(991.1,IEN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGDRM01 4137 printed Apr 09, 2024@20:47:33 Page 2
RGDRM01 ;BAY/ALS-MPI/PD AWARE DUPLICATE RECORD MERGE ;02/22/00
+1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**6,10,12,29,36,51,69**;30 Apr 99;Build 1
+2 ;
+3 ;Reference to ^DPT( supported by IA #2070
+4 ;Reference to ^DPT("AICN" supported by IA #2070
+5 ;Reference to $$A40^MPIFA40 supported by IA #4294
+6 ;
CKICNS(DFNFRM,DFNTO) ;Check ICN's and CMORs of FROM and TO records of
+1 ; duplicate record pair
+2 NEW CMORFRM,CMORTO,RETURN,ICNFRM,ICNTO,LOCFRM,LOCTO,PICN,ERR
+3 SET RETURN="1^OK to merge"
+4 IF ($GET(DFNFRM)'>0)!($GET(DFNTO)'>0)
SET RETURN="0^DFN NOT PASSED"
GOTO EXIT
+5 SET CMORFRM=$$GETVCCI^MPIF001(DFNFRM)
+6 SET CMORTO=$$GETVCCI^MPIF001(DFNTO)
+7 SET ICNFRM=$$GETICN^MPIF001(DFNFRM)
+8 SET ICNTO=$$GETICN^MPIF001(DFNTO)
+9 SET LOCFRM=$$IFLOCAL^MPIF001(DFNFRM)
+10 SET LOCTO=$$IFLOCAL^MPIF001(DFNTO)
+11 SET HOME=$$SITE^VASITE()
+12 SET PICN=ICNTO
+13 IF $EXTRACT(ICNTO,1,3)=$EXTRACT($PIECE(HOME,"^",3),1,3)!(ICNTO<0)
Begin DoDot:1
+14 ;HAVE LOCAL ICN OR NO ICN AS TO ICN
+15 ;FROM ICN IS NATIONAL ICN
IF ICNFRM>0
IF $EXTRACT(ICNFRM,1,3)'=$EXTRACT($PIECE(HOME,"^",3),1,3)
SET PICN=ICNFRM
End DoDot:1
+16 ;**51 send A40 regardless of ICN status on TO or FROM record
+17 SET ERR=$$A40^MPIFA40(DFNTO,DFNFRM,PICN)
+18 IF $PIECE(ERR,"^",1)=-1
SET RETURN="0^CANNOT MERGE RECORDS "_DFNFRM_" AND "_DFNTO_", "_$PIECE(ERR,"^",2)
GOTO EXIT
+19 ; If both records have local ICNs, delete FROM data, keep TO data
+20 IF (LOCFRM=1)&(LOCTO=1)
SET ICN=$PIECE(ICNFRM,"V",1)
DO DEL
DO DEL^RGDRM03
GOTO EXIT
+21 ; If both records have a national ICN, delete the FROM data
+22 IF ($EXTRACT(ICNFRM,1,3)'=$EXTRACT($PIECE(HOME,"^",3),1,3)&(ICNFRM>0))&($EXTRACT(ICNTO,1,3)'=$EXTRACT($PIECE(HOME,"^",3),1,3)&(ICNTO>0))
Begin DoDot:1
+23 SET ICN=$PIECE(ICNFRM,"V",1)
DO DEL
DO DEL^RGDRM03
End DoDot:1
GOTO EXIT
+24 ; If both records have local ICNs, delete FROM data, keep TO data
+25 IF (LOCFRM=1)&(LOCTO=1)
SET ICN=$PIECE(ICNFRM,"V",1)
DO DEL
DO DEL^RGDRM03
GOTO EXIT
+26 ; If FROM record is local and TO record is null, merge
+27 IF (LOCFRM=1)&(ICNTO<0)
DO MRGICN
DO MRGCMOR^RGDRM03
+28 ; If FROM record is National and TO record is local OR null, merge
+29 IF $EXTRACT(ICNFRM,1,3)'=$EXTRACT($PIECE(HOME,"^",3),1,3)
IF ICNFRM>0
Begin DoDot:1
+30 IF LOCTO=1!(ICNTO<1)
DO MRGICN
DO MRGCMOR^RGDRM03
End DoDot:1
GOTO EXIT
+31 ; If FROM record is local and TO record is National, delete FROM data, keep TO data
+32 IF (LOCFRM=1)&(LOCTO=0)&(ICNTO>0)
SET ICN=$PIECE(ICNFRM,"V",1)
DO DEL
DO DEL^RGDRM03
+33 ;
EXIT ;
+1 QUIT RETURN
MRGICN ;Set ICN and ICN Checksum in TO record to values in FROM record
+1 NEW ICN,CKSUM,DIQUIET,RGRSICN
+2 SET DIQUIET=1
SET RGRSICN=1
+3 SET ICN=$PIECE(ICNFRM,"V",1)
SET CKSUM=$PIECE(ICNFRM,"V",2)
+4 LOCK +^DPT(DFNTO):10
+5 ;**69, Story 625205 (jfw) - Add FULL ICN to update
+6 SET DIE="^DPT("
SET DA=DFNTO
SET DR="991.01///^S X=ICN;991.02///^S X=CKSUM;991.1///^S X=ICNFRM"
+7 DO ^DIE
KILL DIE,DA,DR
+8 LOCK -^DPT(DFNTO)
+9 SET ICNTO=""
SET ICNTO=$$GETICN^MPIF001(DFNTO)
+10 ;Make sure local icn flag is not set if national just got assigned
+11 IF ($EXTRACT(ICNTO,1,3)'=$EXTRACT($PIECE(HOME,"^",3),1,3)&(ICNTO>0))
Begin DoDot:1
+12 LOCK +^DPT(DFNTO):10
+13 SET DIE="^DPT("
SET DA=DFNTO
SET DR="991.04///@"
+14 DO ^DIE
KILL DIE,DA,DR
+15 LOCK -^DPT(DFNTO)
End DoDot:1
+16 ; set local icn flag to Y if local just got assigned
+17 IF $EXTRACT(ICNTO,1,3)=$EXTRACT($PIECE(HOME,"^",3),1,3)
Begin DoDot:1
+18 LOCK +^DPT(DFNTO):10
+19 SET DIE="^DPT("
SET DA=DFNTO
SET DR="991.04///^S X=1"
+20 DO ^DIE
KILL DIE,DA,DR
+21 LOCK -^DPT(DFNTO)
End DoDot:1
DEL ;Delete ICN, ICN Checksum and Locally Assigned ICN fields in FROM record
+1 NEW DIQUIET,RGRSICN
+2 SET DIQUIET=1
SET RGRSICN=1
+3 LOCK +^DPT(DFNFRM):10
+4 ;**69, Story 625205 (jfw) - Add FULL ICN to update
+5 SET DIE="^DPT("
SET DA=DFNFRM
SET DR="991.01///@;991.02///@;991.04///@;991.1///@"
+6 DO ^DIE
KILL DIE,DA,DR
+7 KILL ^DPT("AICN",ICN,DFNFRM)
+8 LOCK -^DPT(DFNFRM)
DELEXC ;Delete exceptions on file for patient record being removed.
+1 SET EXCT=""
+2 FOR
SET EXCT=$ORDER(^RGHL7(991.1,"ADFN",EXCT))
if EXCT=""
QUIT
Begin DoDot:1
+3 IF $DATA(^RGHL7(991.1,"ADFN",EXCT,DFNFRM))
Begin DoDot:2
+4 SET IEN=0
+5 FOR
SET IEN=$ORDER(^RGHL7(991.1,"ADFN",EXCT,DFNFRM,IEN))
if 'IEN
QUIT
Begin DoDot:3
+6 SET IEN2=0
+7 FOR
SET IEN2=$ORDER(^RGHL7(991.1,"ADFN",EXCT,DFNFRM,IEN,IEN2))
if 'IEN2
QUIT
Begin DoDot:4
+8 SET NUM=""
SET NUM=$PIECE(^RGHL7(991.1,IEN,1,0),"^",4)
+9 IF NUM=1
Begin DoDot:5
+10 LOCK +^RGHL7(991.1,IEN):10
+11 SET DIK="^RGHL7(991.1,"
SET DA=IEN
+12 DO ^DIK
KILL DIK,DA
+13 LOCK -^RGHL7(991.1,IEN)
End DoDot:5
+14 IF '$TEST
IF NUM>1
DO DELE
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+15 KILL EXCT,IEN,IEN2,NUM
QUIT QUIT
DELE ;Delete exception
+1 LOCK +^RGHL7(991.1,IEN):10
+2 SET DA(1)=IEN
SET DA=IEN2
+3 SET DIK="^RGHL7(991.1,"_DA(1)_",1,"
+4 DO ^DIK
KILL DIK,DA
+5 LOCK -^RGHL7(991.1,IEN)
+6 QUIT
