- 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 Jan 18, 2025@03:40:15 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