XDRMERGC.m

XDRMERGC ;SF-CIOFO/JDS - CHECK MERGE ;06/02/99  09:10 [ 04/02/2003   8:47 AM ]

 ;;7.3;TOOLKIT;**1001**;APR 1, 2003

 ;;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

 ;

XDRMERGC  ;SF-CIOFO/JDS - CHECK MERGE ;06/02/99  09:10 [ 04/02/2003   8:47 AM ]

 +1       ;;7.3;TOOLKIT;**1001**;APR 1, 2003

 +2       ;;7.3;TOOLKIT;**40**;Jun 1, 1999

 +3       ;

 +4        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      ;