source: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XDRMERGC.m@ 1259

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

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1XDRMERGC ;SF-CIOFO/JDS - CHECK MERGE ;06/02/99 09:10
2 ;;7.3;TOOLKIT;**40**;Jun 1, 1999
3 ;
4 Q
5CHKFROM(FROM,FILE) ;
6 ;
7 ; The following code is used to identify any pairs which have a same internal number in them and to
8 ; exclude any after the first occurence of the internal number from the current merge
9 ; the first occurrence is that based on the lowest ien for the FROM entry and the lowest ien for a
10 ; TO entry associated with it. Any other pairs involving either of these iens is then excluded.
11 ;
12 ; The XDRBROWSER1 device is used to capture any output generated due to exclusion of pairs and is
13 ; then sent as a mail message.
14 ;
15 N FRA,TOA,FR,TO
16 S IOP="XDRBROWSER1" D ^%ZIS
17 U IO
18 F FRA=0:0 S FRA=$O(@FROM@(FRA)) Q:FRA'>0 D
19 . S TOA=$O(@FROM@(FRA,0))
20 . F FR=FRA,TOA F TO=0:0 S TO=$O(@FROM@(FR,TO)) Q:TO="" I FR'=FRA!(TO'=TOA) D EXCLUDE(FILE,FROM,FR,TO,FR,(TO=FRA))
21 . F FR=0:0 S FR=$O(@FROM@(FR)) Q:FR'>0 D:$D(@FROM@(FR,FRA)) EXCLUDE(FILE,FROM,FR,FRA,FRA,1) I FR'=FRA D:$D(@FROM@(FR,TOA)) EXCLUDE(FILE,FROM,FR,TOA,TOA,0)
22 D ^%ZISC K ^TMP("DDB",$J,1)
23 I $D(^TMP("DDB",$J)) D SENDMESG^XDRDVAL1("PAIRS EXCLUDED FROM MERGE DUE TO MULTIPLE REFERENCES","^TMP(""DDB"",$J,")
24 Q
25 ;
26EXCLUDE(FILE,FROM,FR,TO,WHICH,FROMREF) ;
27 N VREF,VFR,VTO
28 S VREF=""
29 S VFR=$O(@FROM@(FR,TO,"")) I VFR="" S VFR=0,VREF=@FROM@(FR,TO)
30 S VTO=$O(@FROM@(FR,TO,VFR,"")) S:VTO="" VTO=0
31 I VTO>0 S VREF=@FROM@(FR,TO,VFR,VTO)
32 D RMOVPAIR^XDRDVAL1(FR,TO,VREF,FROM)
33 D PAIRID^XDRDVAL1(FILE,FR,TO,VREF)
34 W !," Excluded as a multiple pair including ien=",WHICH,!
35 I FROMREF>0,VREF>0 D RESET^XDRDPICK(VREF)
36 Q
37 ;
Note: See TracBrowser for help on using the repository browser.