source: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGDRM01.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1RGDRM01 ;BAY/ALS-MPI/PD AWARE DUPLICATE RECORD MERGE ;02/22/00
2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**6,10,12,29,36**;30 Apr 99
3 ;
4 ;Reference to ^DPT( supported by IA #2070
5 ;Reference to ^DPT("AICN" supported by IA #2070
6 ;Reference to $$A40^MPIFA40 supported by IA #4294
7 ;
8CKICNS(DFNFRM,DFNTO) ;Check ICN's and CMORs of FROM and TO records of
9 ; duplicate record pair
10 N CMORFRM,CMORTO,RETURN,ICNFRM,ICNTO,LOCFRM,LOCTO
11 S RETURN="1^OK to merge"
12 I ($G(DFNFRM)'>0)!($G(DFNTO)'>0) S RETURN="0^DFN NOT PASSED" G EXIT
13 S CMORFRM=$$GETVCCI^MPIF001(DFNFRM)
14 S CMORTO=$$GETVCCI^MPIF001(DFNTO)
15 S ICNFRM=$$GETICN^MPIF001(DFNFRM)
16 ; If FROM record has no ICN quit
17 I ICNFRM<0 G EXIT
18 S ICNTO=$$GETICN^MPIF001(DFNTO)
19 S LOCFRM=$$IFLOCAL^MPIF001(DFNFRM)
20 S LOCTO=$$IFLOCAL^MPIF001(DFNTO)
21 ; If both records have local ICNs, delete FROM data, keep TO data
22 I (LOCFRM=1)&(LOCTO=1) S ICN=$P(ICNFRM,"V",1) D DEL D DEL^RGDRM03 G EXIT
23 S HOME=$$SITE^VASITE()
24 ; If both records have National ICNs, log an exception
25 ;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
26 ;. S RETURN="0^CANNOT MERGE RECORDS "_DFNFRM_" AND "_DFNTO_", both records have national ICNs assigned and must be resolved before merging."
27 ; If both records have a national ICN, delete the FROM data and call A40^MPIFA40 to trigger messaging to MPI and TFs
28 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
29 . S ERR=$$A40^MPIFA40(DFNTO,DFNFRM)
30 . I $P(ERR,"^",1)=-1 S RETURN="0^CANNOT MERGE RECORDS "_DFNFRM_" AND "_DFNTO_", "_$P(ERR,"^",2)
31 . I $P(RETURN,"^",1)>0 S ICN=$P(ICNFRM,"V",1) D DEL D DEL^RGDRM03
32 ; If FROM record is local and TO record is null, merge
33 I (LOCFRM=1)&(ICNTO<0) D MRGICN D MRGCMOR^RGDRM03
34 ; If FROM record is National and TO record is local, merge
35 E I ($E(ICNFRM,1,3)'=$E($P(HOME,"^",3),1,3)&(ICNFRM>0))&(LOCTO=1) D MRGICN D MRGCMOR^RGDRM03
36 ; If FROM record is National and TO record is null, merge
37 E I ($E(ICNFRM,1,3)'=$E($P(HOME,"^",3),1,3)&(ICNFRM>0))&(ICNTO<1) D MRGICN D MRGCMOR^RGDRM03
38 ; If FROM record is local and TO record is National, delete FROM data, keep TO data
39 E I (LOCFRM=1)&(LOCTO=0)&(ICNTO>0) S ICN=$P(ICNFRM,"V",1) D DEL D DEL^RGDRM03 G EXIT
40 ;
41EXIT ;
42 Q RETURN
43MRGICN ;Set ICN and ICN Checksum in TO record to values in FROM record
44 N ICN,CKSUM,DIQUIET,RGRSICN
45 S DIQUIET=1,RGRSICN=1
46 S ICN=$P(ICNFRM,"V",1),CKSUM=$P(ICNFRM,"V",2)
47 L +^DPT(DFNTO):10
48 S DIE="^DPT(",DA=DFNTO,DR="991.01///^S X=ICN;991.02///^S X=CKSUM"
49 D ^DIE K DIE,DA,DR
50 L -^DPT(DFNTO)
51 S ICNTO="" S ICNTO=$$GETICN^MPIF001(DFNTO)
52 ;Make sure local icn flag is not set if national just got assigned
53 I ($E(ICNTO,1,3)'=$E($P(HOME,"^",3),1,3)&(ICNTO>0)) D
54 . L +^DPT(DFNTO):10
55 . S DIE="^DPT(",DA=DFNTO,DR="991.04///@"
56 . D ^DIE K DIE,DA,DR
57 . L -^DPT(DFNTO)
58 ; set local icn flag to Y if local just got assigned
59 I $E(ICNTO,1,3)=$E($P(HOME,"^",3),1,3) D
60 . L +^DPT(DFNTO):10
61 . S DIE="^DPT(",DA=DFNTO,DR="991.04///^S X=1"
62 . D ^DIE K DIE,DA,DR
63 . L -^DPT(DFNTO)
64DEL ;Delete ICN, ICN Checksum and Locally Assigned ICN fields in FROM record
65 N DIQUIET,RGRSICN
66 S DIQUIET=1,RGRSICN=1
67 L +^DPT(DFNFRM):10
68 S DIE="^DPT(",DA=DFNFRM,DR="991.01///@;991.02///@;991.04///@"
69 D ^DIE K DIE,DA,DR
70 K ^DPT("AICN",ICN,DFNFRM)
71 L -^DPT(DFNFRM)
72DELEXC ;Delete exceptions on file for patient record being removed.
73 S EXCT=""
74 F S EXCT=$O(^RGHL7(991.1,"ADFN",EXCT)) Q:EXCT="" D
75 . I $D(^RGHL7(991.1,"ADFN",EXCT,DFNFRM)) D
76 .. S IEN=0
77 .. F S IEN=$O(^RGHL7(991.1,"ADFN",EXCT,DFNFRM,IEN)) Q:'IEN D
78 ... S IEN2=0
79 ... F S IEN2=$O(^RGHL7(991.1,"ADFN",EXCT,DFNFRM,IEN,IEN2)) Q:'IEN2 D
80 .... S NUM="" S NUM=$P(^RGHL7(991.1,IEN,1,0),"^",4)
81 .... I NUM=1 D
82 ..... L +^RGHL7(991.1,IEN):10
83 ..... S DIK="^RGHL7(991.1,",DA=IEN
84 ..... D ^DIK K DIK,DA
85 ..... L -^RGHL7(991.1,IEN)
86 .... E I NUM>1 D DELE
87 K EXCT,IEN,IEN2,NUM
88QUIT Q
89DELE ;Delete exception
90 L +^RGHL7(991.1,IEN):10
91 S DA(1)=IEN,DA=IEN2
92 S DIK="^RGHL7(991.1,"_DA(1)_",1,"
93 D ^DIK K DIK,DA
94 L -^RGHL7(991.1,IEN)
95 Q
Note: See TracBrowser for help on using the repository browser.