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 ---[H[J[2J[HXDRDDATA 899 printed Dec 13, 2024@02:38:59 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
