XDRPREL1.m

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 ---XDRPREL1   635     printed  Apr 09, 2024@21:44:23                                                                                                                                                                                                     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