XDRDPDTI ;IHS/OHPRD/JCM - CHECKS POTENTIAL DUPLICATES IF THRESHOLD RAISED; [ 08/13/92 09:50 AM ]
;;7.3;TOOLKIT;;Apr 25, 1995
START ;
I '$D(^VA(15,"APOT",$P(XDRGL,U,2))) G END
S (XDRDPDTI,XDRD("NOADD"))=""
S XDRDPAIR=$S($D(^VA(15.1,XDRFL,"APDTI")):^VA(15.1,XDRFL,"APDTI"),1:0)
F XDRDI=0:0 S XDRDPAIR=$O(^VA(15,"APOT",$P(XDRGL,U,2),XDRDPAIR)) Q:XDRDPAIR=""!($P(^VA(15.1,XDRFL,0),U,2)="h") S XDRDPDA=$O(^VA(15,"APOT",$P(XDRGL,U,2),XDRDPAIR,"")) I $D(^VA(15,XDRDPDA,0)),$P(^(0),U,18) D CHECK
K XDRDI
I XDRDPAIR]"" S ^VA(15.1,XDRFL,"APDTI")=XDRDPAIR
E K ^VA(15.1,XDRFL,"APDTI")
END D EOJ
Q
;
CHECK ;
D EN^XDRDUP
I XDRD("DUPSCORE")<XDRDSCOR("PDT") D DELETE I 1
E D DIE
Q
;
DELETE ;
S DIK="^VA(15,",DA=XDRDPDA D ^DIK K DIK,DA,DIC
Q
DIE ;
S DIE="^VA(15,",DA=XDRDPDA,DR=".17////"_XDRDSCOR("PDT%")
D ^DIE K DIE,DA,DR
Q
;
EOJ ;
K:'$D(XDRDPAIR) ^VA(15.1,XDRFL,"APDTI")
K XDRDPAIR,XDRDPDA,XDRDPDTI,XDRD("NOADD")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXDRDPDTI 962 printed Oct 16, 2024@18:39:45 Page 2
XDRDPDTI ;IHS/OHPRD/JCM - CHECKS POTENTIAL DUPLICATES IF THRESHOLD RAISED; [ 08/13/92 09:50 AM ]
+1 ;;7.3;TOOLKIT;;Apr 25, 1995
START ;
+1 IF '$DATA(^VA(15,"APOT",$PIECE(XDRGL,U,2)))
GOTO END
+2 SET (XDRDPDTI,XDRD("NOADD"))=""
+3 SET XDRDPAIR=$SELECT($DATA(^VA(15.1,XDRFL,"APDTI")):^VA(15.1,XDRFL,"APDTI"),1:0)
+4 FOR XDRDI=0:0
SET XDRDPAIR=$ORDER(^VA(15,"APOT",$PIECE(XDRGL,U,2),XDRDPAIR))
if XDRDPAIR=""!($PIECE(^VA(15.1,XDRFL,0),U,2)="h")
QUIT
SET XDRDPDA=$ORDER(^VA(15,"APOT",$PIECE(XDRGL,U,2),XDRDPAIR,""))
IF $DATA(^VA(15,XDRDPDA,0))
IF $PIECE(^(0),U,18)
DO CHECK
+5 KILL XDRDI
+6 IF XDRDPAIR]""
SET ^VA(15.1,XDRFL,"APDTI")=XDRDPAIR
+7 IF '$TEST
KILL ^VA(15.1,XDRFL,"APDTI")
END DO EOJ
+1 QUIT
+2 ;
CHECK ;
+1 DO EN^XDRDUP
+2 IF XDRD("DUPSCORE")<XDRDSCOR("PDT")
DO DELETE
IF 1
+3 IF '$TEST
DO DIE
+4 QUIT
+5 ;
DELETE ;
+1 SET DIK="^VA(15,"
SET DA=XDRDPDA
DO ^DIK
KILL DIK,DA,DIC
+2 QUIT
DIE ;
+1 SET DIE="^VA(15,"
SET DA=XDRDPDA
SET DR=".17////"_XDRDSCOR("PDT%")
+2 DO ^DIE
KILL DIE,DA,DR
+3 QUIT
+4 ;
EOJ ;
+1 if '$DATA(XDRDPAIR)
KILL ^VA(15.1,XDRFL,"APDTI")
+2 KILL XDRDPAIR,XDRDPDA,XDRDPDTI,XDRD("NOADD")
+3 QUIT
