Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RGDRM01

RGDRM01.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;Reference to ^DPT( supported by IA #2070
  1.  ;Reference to ^DPT("AICN" supported by IA #2070
  1.  ;Reference to $$A40^MPIFA40 supported by IA #4294
  1.  ;
  1. CKICNS(DFNFRM,DFNTO) ;Check ICN's and CMORs of FROM and TO records of
  1.  ; duplicate record pair
  1.  N CMORFRM,CMORTO,RETURN,ICNFRM,ICNTO,LOCFRM,LOCTO,PICN,ERR
  1.  S RETURN="1^OK to merge"
  1.  I ($G(DFNFRM)'>0)!($G(DFNTO)'>0) S RETURN="0^DFN NOT PASSED" G EXIT
  1.  S CMORFRM=$$GETVCCI^MPIF001(DFNFRM)
  1.  S CMORTO=$$GETVCCI^MPIF001(DFNTO)
  1.  S ICNFRM=$$GETICN^MPIF001(DFNFRM)
  1.  S ICNTO=$$GETICN^MPIF001(DFNTO)
  1.  S LOCFRM=$$IFLOCAL^MPIF001(DFNFRM)
  1.  S LOCTO=$$IFLOCAL^MPIF001(DFNTO)
  1.  S HOME=$$SITE^VASITE()
  1.  S PICN=ICNTO
  1.  I $E(ICNTO,1,3)=$E($P(HOME,"^",3),1,3)!(ICNTO<0) D
  1.  .;HAVE LOCAL ICN OR NO ICN AS TO ICN
  1.  .I ICNFRM>0,$E(ICNFRM,1,3)'=$E($P(HOME,"^",3),1,3) S PICN=ICNFRM ;FROM ICN IS NATIONAL ICN
  1.  ;**51 send A40 regardless of ICN status on TO or FROM record
  1.  S ERR=$$A40^MPIFA40(DFNTO,DFNFRM,PICN)
  1.  I $P(ERR,"^",1)=-1 S RETURN="0^CANNOT MERGE RECORDS "_DFNFRM_" AND "_DFNTO_", "_$P(ERR,"^",2) G EXIT
  1.  ; If both records have local ICNs, delete FROM data, keep TO data 
  1.  I (LOCFRM=1)&(LOCTO=1) S ICN=$P(ICNFRM,"V",1) D DEL D DEL^RGDRM03 G EXIT
  1.  ; If both records have a national ICN, delete the FROM data
  1.  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
  1.  .S ICN=$P(ICNFRM,"V",1) D DEL D DEL^RGDRM03
  1.  ; If both records have local ICNs, delete FROM data, keep TO data 
  1.  I (LOCFRM=1)&(LOCTO=1) S ICN=$P(ICNFRM,"V",1) D DEL D DEL^RGDRM03 G EXIT
  1.  ; If FROM record is local and TO record is null, merge
  1.  I (LOCFRM=1)&(ICNTO<0) D MRGICN D MRGCMOR^RGDRM03
  1.  ; If FROM record is National and TO record is local OR null, merge
  1.  I $E(ICNFRM,1,3)'=$E($P(HOME,"^",3),1,3),ICNFRM>0 D  G EXIT
  1.  .I LOCTO=1!(ICNTO<1) D MRGICN D MRGCMOR^RGDRM03
  1.  ; If FROM record is local and TO record is National, delete FROM data, keep TO data
  1.  I (LOCFRM=1)&(LOCTO=0)&(ICNTO>0) S ICN=$P(ICNFRM,"V",1) D DEL D DEL^RGDRM03
  1.  ;
  1. EXIT ;
  1.  Q RETURN
  1. MRGICN ;Set ICN and ICN Checksum in TO record to values in FROM record
  1.  N ICN,CKSUM,DIQUIET,RGRSICN
  1.  S DIQUIET=1,RGRSICN=1
  1.  S ICN=$P(ICNFRM,"V",1),CKSUM=$P(ICNFRM,"V",2)
  1.  L +^DPT(DFNTO):10
  1.  ;**69, Story 625205 (jfw) - Add FULL ICN to update
  1.  S DIE="^DPT(",DA=DFNTO,DR="991.01///^S X=ICN;991.02///^S X=CKSUM;991.1///^S X=ICNFRM"
  1.  D ^DIE K DIE,DA,DR
  1.  L -^DPT(DFNTO)
  1.  S ICNTO="" S ICNTO=$$GETICN^MPIF001(DFNTO)
  1.  ;Make sure local icn flag is not set if national just got assigned
  1.  I ($E(ICNTO,1,3)'=$E($P(HOME,"^",3),1,3)&(ICNTO>0)) D
  1.  . L +^DPT(DFNTO):10
  1.  . S DIE="^DPT(",DA=DFNTO,DR="991.04///@"
  1.  . D ^DIE K DIE,DA,DR
  1.  . L -^DPT(DFNTO)
  1.  ; set local icn flag to Y if local just got assigned
  1.  I $E(ICNTO,1,3)=$E($P(HOME,"^",3),1,3) D
  1.  . L +^DPT(DFNTO):10
  1.  . S DIE="^DPT(",DA=DFNTO,DR="991.04///^S X=1"
  1.  . D ^DIE K DIE,DA,DR
  1.  . L -^DPT(DFNTO)
  1. DEL ;Delete ICN, ICN Checksum and Locally Assigned ICN fields in FROM record
  1.  N DIQUIET,RGRSICN
  1.  S DIQUIET=1,RGRSICN=1
  1.  L +^DPT(DFNFRM):10
  1.  ;**69, Story 625205 (jfw) - Add FULL ICN to update 
  1.  S DIE="^DPT(",DA=DFNFRM,DR="991.01///@;991.02///@;991.04///@;991.1///@"
  1.  D ^DIE K DIE,DA,DR
  1.  K ^DPT("AICN",ICN,DFNFRM)
  1.  L -^DPT(DFNFRM)
  1. DELEXC ;Delete exceptions on file for patient record being removed.
  1.  S EXCT=""
  1.  F  S EXCT=$O(^RGHL7(991.1,"ADFN",EXCT)) Q:EXCT=""  D
  1.  . I $D(^RGHL7(991.1,"ADFN",EXCT,DFNFRM)) D
  1.  .. S IEN=0
  1.  .. F  S IEN=$O(^RGHL7(991.1,"ADFN",EXCT,DFNFRM,IEN)) Q:'IEN  D
  1.  ... S IEN2=0
  1.  ... F  S IEN2=$O(^RGHL7(991.1,"ADFN",EXCT,DFNFRM,IEN,IEN2)) Q:'IEN2  D
  1.  .... S NUM="" S NUM=$P(^RGHL7(991.1,IEN,1,0),"^",4)
  1.  .... I NUM=1 D
  1.  ..... L +^RGHL7(991.1,IEN):10
  1.  ..... S DIK="^RGHL7(991.1,",DA=IEN
  1.  ..... D ^DIK K DIK,DA
  1.  ..... L -^RGHL7(991.1,IEN)
  1.  .... E  I NUM>1 D DELE
  1.  K EXCT,IEN,IEN2,NUM
  1. QUIT Q
  1. DELE ;Delete exception
  1.  L +^RGHL7(991.1,IEN):10
  1.  S DA(1)=IEN,DA=IEN2
  1.  S DIK="^RGHL7(991.1,"_DA(1)_",1,"
  1.  D ^DIK K DIK,DA
  1.  L -^RGHL7(991.1,IEN)
  1.  Q