source: FOIAVistA/tag/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGDRM02.m@ 1495

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

initial load of FOIAVistA 6/30/08 version

File size: 2.1 KB
Line 
1RGDRM02 ;BAY/ALS-MPI/PD AWARE DUPLICATE RECORD MERGE ;03/10/00
2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**6,42**;30 Apr 99
3MRGTF(DFNFRM,DFNTO) ; Merge Treating Facility entries
4 I '$D(DFNFRM)!'$D(DFNTO) Q
5 Q:'$D(^DGCN(391.91,"APAT",DFNFRM))
6 ; Add Treating Facilities in FROM record to Treating
7 ; Facility List for TO record
8 S INST=0
9 F S INST=$O(^DGCN(391.91,"APAT",DFNFRM,INST)) Q:'INST D
10 . I '$D(^DGCN(391.91,"APAT",DFNTO,INST)) DO
11 .. ;S STANUM=0
12 .. ;S STANUM=$P($$NS^XUAF4(INST),"^",2)
13 .. D FILE^VAFCTFU(DFNTO,INST,1) ;**42
14 .. I '$D(^DGCN(391.91,"APAT",DFNTO,INST)) D
15 ... D START^RGHLLOG($G(HLMTIEN)),EXC^RGHLLOG(212,"Treating Facility Add failed for DFN: "_DFNTO_", Treating Facility: "_INST,DFNTO),STOP^RGHLLOG(0) Q
16 . ;Delete FROM record Treating Facility data
17 . S IEN=0
18 . F S IEN=$O(^DGCN(391.91,"APAT",DFNFRM,INST,IEN)) Q:'IEN D
19 .. S DA=IEN,DIK="^DGCN(391.91,"
20 .. D ^DIK K DIK,DA
21 K INST,STANUM,IEN
22 Q
23MRGSUB(DFNFRM,DFNTO) ; Merge Subscription entries.
24 I '$D(DFNFRM)!'$D(DFNTO) Q
25 N SUBFRM,SUBTO
26 S SUBFRM=$$SUBNUM^MPIFAPI(DFNFRM)
27 Q:SUBFRM<0 ;No subscriptions in FRM record, quit
28 S SUBTO=$$SUBNUM^MPIFAPI(DFNTO)
29 I SUBTO<0 S SUBTO=$$GETSCN^RGJCREC(DFNTO)
30 S ENTRYF=0,ENTRYT=0
31 D GET^HLSUB(SUBFRM,0,"",.FROM)
32 D GET^HLSUB(SUBTO,0,"",.TO)
33 F S ENTRYF=$O(FROM("LINKS",ENTRYF)) Q:'ENTRYF D
34 . S LINKF=$P(FROM("LINKS",ENTRYF),"^",2)
35 . S MATCH=0
36 . F S ENTRYT=$O(TO("LINKS",ENTRYT)) Q:'ENTRYT D
37 .. S LINKT=$P(TO("LINKS",ENTRYT),"^",2)
38 .. I LINKF=LINKT S MATCH=1 Q
39 . I MATCH=0 D
40 .. S TYPE=0
41 .. D UPD^HLSUB(SUBTO,LINKF,TYPE,"","","",.ER)
42 .. K TO
43 .. D GET^HLSUB(SUBTO,0,"",.TO) ; get new list
44 .. S L=0,LINK="",ADD=0
45 .. F S L=$O(TO("LINKS",L)) Q:'L D
46 ... S LINK=$P(TO("LINKS",L),"^",2) I LINK=LINKF S ADD=1
47 .. I ADD=0 D
48 ... D START^RGHLLOG($G(HLMTIEN)),EXC^RGHLLOG(224,"Subscription Add Failed for DFN: "_DFNTO_", Subscriber: "_LINKF,DFNTO),STOP^RGHLLOG(0) Q
49 ; Delete FROM record subscription data and pointer to subscription file
50 N RGARR,RGERR
51 S RGARR(991.05)="@"
52 S RGERR=$$UPDATE^MPIFAPI(DFNFRM,"RGARR")
53 K ENTRYF,ENTRYT,LINKF,LINKT,TO,MATCH,FROM,LNAME,LIEN,TYPE,ER,ADD,L,LINK
54 Q
Note: See TracBrowser for help on using the repository browser.