- XDRMERGC ;SF-CIOFO/JDS - CHECK MERGE ;06/02/99 09:10
- ;;7.3;TOOLKIT;**40**;Jun 1, 1999
- ;
- Q
- CHKFROM(FROM,FILE) ;
- ;
- ; The following code is used to identify any pairs which have a same internal number in them and to
- ; exclude any after the first occurence of the internal number from the current merge
- ; the first occurrence is that based on the lowest ien for the FROM entry and the lowest ien for a
- ; TO entry associated with it. Any other pairs involving either of these iens is then excluded.
- ;
- ; The XDRBROWSER1 device is used to capture any output generated due to exclusion of pairs and is
- ; then sent as a mail message.
- ;
- N FRA,TOA,FR,TO
- S IOP="XDRBROWSER1" D ^%ZIS
- U IO
- F FRA=0:0 S FRA=$O(@FROM@(FRA)) Q:FRA'>0 D
- . S TOA=$O(@FROM@(FRA,0))
- . 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))
- . 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)
- D ^%ZISC K ^TMP("DDB",$J,1)
- I $D(^TMP("DDB",$J)) D SENDMESG^XDRDVAL1("PAIRS EXCLUDED FROM MERGE DUE TO MULTIPLE REFERENCES","^TMP(""DDB"",$J,")
- Q
- ;
- EXCLUDE(FILE,FROM,FR,TO,WHICH,FROMREF) ;
- N VREF,VFR,VTO
- S VREF=""
- S VFR=$O(@FROM@(FR,TO,"")) I VFR="" S VFR=0,VREF=@FROM@(FR,TO)
- S VTO=$O(@FROM@(FR,TO,VFR,"")) S:VTO="" VTO=0
- I VTO>0 S VREF=@FROM@(FR,TO,VFR,VTO)
- D RMOVPAIR^XDRDVAL1(FR,TO,VREF,FROM)
- D PAIRID^XDRDVAL1(FILE,FR,TO,VREF)
- W !," Excluded as a multiple pair including ien=",WHICH,!
- I FROMREF>0,VREF>0 D RESET^XDRDPICK(VREF)
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXDRMERGC 1628 printed Feb 19, 2025@00:06:01 Page 2
- XDRMERGC ;SF-CIOFO/JDS - CHECK MERGE ;06/02/99 09:10
- +1 ;;7.3;TOOLKIT;**40**;Jun 1, 1999
- +2 ;
- +3 QUIT
- CHKFROM(FROM,FILE) ;
- +1 ;
- +2 ; The following code is used to identify any pairs which have a same internal number in them and to
- +3 ; exclude any after the first occurence of the internal number from the current merge
- +4 ; the first occurrence is that based on the lowest ien for the FROM entry and the lowest ien for a
- +5 ; TO entry associated with it. Any other pairs involving either of these iens is then excluded.
- +6 ;
- +7 ; The XDRBROWSER1 device is used to capture any output generated due to exclusion of pairs and is
- +8 ; then sent as a mail message.
- +9 ;
- +10 NEW FRA,TOA,FR,TO
- +11 SET IOP="XDRBROWSER1"
- DO ^%ZIS
- +12 USE IO
- +13 FOR FRA=0:0
- SET FRA=$ORDER(@FROM@(FRA))
- if FRA'>0
- QUIT
- Begin DoDot:1
- +14 SET TOA=$ORDER(@FROM@(FRA,0))
- +15 FOR FR=FRA,TOA
- FOR TO=0:0
- SET TO=$ORDER(@FROM@(FR,TO))
- if TO=""
- QUIT
- IF FR'=FRA!(TO'=TOA)
- DO EXCLUDE(FILE,FROM,FR,TO,FR,(TO=FRA))
- +16 FOR FR=0:0
- SET FR=$ORDER(@FROM@(FR))
- if FR'>0
- QUIT
- if $DATA(@FROM@(FR,FRA))
- DO EXCLUDE(FILE,FROM,FR,FRA,FRA,1)
- IF FR'=FRA
- if $DATA(@FROM@(FR,TOA))
- DO EXCLUDE(FILE,FROM,FR,TOA,TOA,0)
- End DoDot:1
- +17 DO ^%ZISC
- KILL ^TMP("DDB",$JOB,1)
- +18 IF $DATA(^TMP("DDB",$JOB))
- DO SENDMESG^XDRDVAL1("PAIRS EXCLUDED FROM MERGE DUE TO MULTIPLE REFERENCES","^TMP(""DDB"",$J,")
- +19 QUIT
- +20 ;
- EXCLUDE(FILE,FROM,FR,TO,WHICH,FROMREF) ;
- +1 NEW VREF,VFR,VTO
- +2 SET VREF=""
- +3 SET VFR=$ORDER(@FROM@(FR,TO,""))
- IF VFR=""
- SET VFR=0
- SET VREF=@FROM@(FR,TO)
- +4 SET VTO=$ORDER(@FROM@(FR,TO,VFR,""))
- if VTO=""
- SET VTO=0
- +5 IF VTO>0
- SET VREF=@FROM@(FR,TO,VFR,VTO)
- +6 DO RMOVPAIR^XDRDVAL1(FR,TO,VREF,FROM)
- +7 DO PAIRID^XDRDVAL1(FILE,FR,TO,VREF)
- +8 WRITE !," Excluded as a multiple pair including ien=",WHICH,!
- +9 IF FROMREF>0
- IF VREF>0
- DO RESET^XDRDPICK(VREF)
- +10 QUIT
- +11 ;
