XDRDPDTI.m

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 ---XDRDPDTI   962     printed  Apr 09, 2024@21:42:37                                                                                                                                                                                                     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