XDRDDATA.m

XDRDDATA ;SF-IRMFO.SEA/JLI - LIST BASIC DATA ON POTENTIAL DUPLICATES ;12/2/96  11:21

 ;;7.3;TOOLKIT;**23**;Apr 25, 1995

 ;;

EN ;

 S DIC="^VA(15.1,",DIC(0)="AEQM" D ^DIC G:Y'>0 EXIT S XDRFL=+Y

 S XDRFL=$P(^DIC(XDRFL,0,"GL"),U,2)

 S %ZIS="QN" D ^%ZIS Q:POP  I $D(IO("Q")) G QUEIT

 S IOP="BROWSER" D ^%ZIS Q:POP

 G DQ

 ;

QUEIT ;

 S ZTRTN="DQ^XDRDDATA",ZTDESC="LIST POTENTIAL DUPLICATES - XDRDDATA",ZTSAVE("XDRFL")="" D ^%ZTLOAD Q

 ;

DQ ;

 U IO

 S XL=0

 ;S IPAIR="" F  S IPAIR=$O(^VA(15,"APOT",XDRFL,IPAIR)) Q:IPAIR=""  D

 W !!!!

 F I=0:0 S I=$O(^VA(15,I)) Q:I'>0  S IPAIR=^(I,0) D

 . I $P(IPAIR,U,3)'="P" Q

 . I $P($P(IPAIR,U),";",2)'=XDRFL Q

 . S X1=+IPAIR,X2=+$P(IPAIR,U,2)

 . I X1'=XL W !!!,$G(@(U_XDRFL_X1_",0)")) S XL=X1

 . W !,$G(@(U_XDRFL_X2_",0)"))

 D ^%ZISC

 I $D(ZTQUEUED) Q

 ;

DISP ;

 Q

 ;

 ;. S X2=+$P(IPAIR,U,2)

 D ^%ZISC

 I $D(ZTQUEUED) Q

 ;

EXIT ;

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---XDRDDATA   899     printed  Mar 13, 2025@21:44:02                                                                                                                                                                                                     Page 2

XDRDDATA  ;SF-IRMFO.SEA/JLI - LIST BASIC DATA ON POTENTIAL DUPLICATES ;12/2/96  11:21

 +1       ;;7.3;TOOLKIT;**23**;Apr 25, 1995

 +2       ;;

EN        ;

 +1        SET DIC="^VA(15.1,"

           SET DIC(0)="AEQM"

           DO ^DIC

           if Y'>0

               GOTO EXIT

           SET XDRFL=+Y

 +2        SET XDRFL=$PIECE(^DIC(XDRFL,0,"GL"),U,2)

 +3        SET %ZIS="QN"

           DO ^%ZIS

           if POP

               QUIT 

           IF $DATA(IO("Q"))

               GOTO QUEIT

 +4        SET IOP="BROWSER"

           DO ^%ZIS

           if POP

               QUIT 

 +5        GOTO DQ

 +6       ;

QUEIT     ;

 +1        SET ZTRTN="DQ^XDRDDATA"

           SET ZTDESC="LIST POTENTIAL DUPLICATES - XDRDDATA"

           SET ZTSAVE("XDRFL")=""

           DO ^%ZTLOAD

           QUIT 

 +2       ;

DQ        ;

 +1        USE IO

 +2        SET XL=0

 +3       ;S IPAIR="" F  S IPAIR=$O(^VA(15,"APOT",XDRFL,IPAIR)) Q:IPAIR=""  D

 +4        WRITE !!!!

 +5        FOR I=0:0

               SET I=$ORDER(^VA(15,I))

               if I'>0

                   QUIT 

               SET IPAIR=^(I,0)

               Begin DoDot:1

 +6                IF $PIECE(IPAIR,U,3)'="P"

                       QUIT 

 +7                IF $PIECE($PIECE(IPAIR,U),";",2)'=XDRFL

                       QUIT 

 +8                SET X1=+IPAIR

                   SET X2=+$PIECE(IPAIR,U,2)

 +9                IF X1'=XL

                       WRITE !!!,$GET(@(U_XDRFL_X1_",0)"))

                       SET XL=X1

 +10               WRITE !,$GET(@(U_XDRFL_X2_",0)"))

               End DoDot:1

 +11       DO ^%ZISC

 +12       IF $DATA(ZTQUEUED)

               QUIT 

 +13      ;

DISP      ;

 +1        QUIT 

 +2       ;

 +3       ;. S X2=+$P(IPAIR,U,2)

 +4        DO ^%ZISC

 +5        IF $DATA(ZTQUEUED)

               QUIT 

 +6       ;

EXIT      ;

 +1        QUIT