XDRPREL1 ;SF-IRMFO.SEA/JLI - IDENTIFY PROBLEM ENTRIES WHICH ARE **NOT** POINTED TO ;
;;7.3;TOOLKIT;**23**;Apr 25, 1995
;;
;;
EN ;
M ^TMP("XDRPREL1",$J,2)=^TMP("XDRDPREL",$J,2)
S NODE=""
F S NODE=$O(^TMP("XDRPREL1",$J,2,NODE)) Q:NODE="" D
. M ^TMP("XDRPREL1",$J,"BB")=^TMP("XDRPREL1",$J,2,NODE)
S XDRXFLG=1
D EN^XDRMERG(2,$NA(^TMP("XDRPREL1",$J,"BB")))
S NODE=""
F S NODE=$O(^TMP("XDRPREL1",$J,2,NODE)) Q:NODE="" D
. F J=0:0 S J=$O(^TMP("XDRPREL1",$J,2,NODE,J)) Q:J'>0 D
. . I '$D(^TMP("XDRPREL1",$J,"BB",J)) K ^TMP("XDRPREL1",$J,2,NODE,J) Q
. . S $P(^(NODE),U,2)=$P(^TMP("XDRPREL1",$J,2,NODE),U,2)+1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXDRPREL1 635 printed Dec 13, 2024@02:39:40 Page 2
XDRPREL1 ;SF-IRMFO.SEA/JLI - IDENTIFY PROBLEM ENTRIES WHICH ARE **NOT** POINTED TO ;
+1 ;;7.3;TOOLKIT;**23**;Apr 25, 1995
+2 ;;
+3 ;;
EN ;
+1 MERGE ^TMP("XDRPREL1",$JOB,2)=^TMP("XDRDPREL",$JOB,2)
+2 SET NODE=""
+3 FOR
SET NODE=$ORDER(^TMP("XDRPREL1",$JOB,2,NODE))
if NODE=""
QUIT
Begin DoDot:1
+4 MERGE ^TMP("XDRPREL1",$JOB,"BB")=^TMP("XDRPREL1",$JOB,2,NODE)
End DoDot:1
+5 SET XDRXFLG=1
+6 DO EN^XDRMERG(2,$NAME(^TMP("XDRPREL1",$JOB,"BB")))
+7 SET NODE=""
+8 FOR
SET NODE=$ORDER(^TMP("XDRPREL1",$JOB,2,NODE))
if NODE=""
QUIT
Begin DoDot:1
+9 FOR J=0:0
SET J=$ORDER(^TMP("XDRPREL1",$JOB,2,NODE,J))
if J'>0
QUIT
Begin DoDot:2
+10 IF '$DATA(^TMP("XDRPREL1",$JOB,"BB",J))
KILL ^TMP("XDRPREL1",$JOB,2,NODE,J)
QUIT
+11 SET $PIECE(^(NODE),U,2)=$PIECE(^TMP("XDRPREL1",$JOB,2,NODE),U,2)+1
End DoDot:2
End DoDot:1
