- 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 Mar 13, 2025@21:44:43 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
