source: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XDRPREL1.m@ 1150

Last change on this file since 1150 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 619 bytes
RevLine 
[613]1XDRPREL1 ;SF-IRMFO.SEA/JLI - IDENTIFY PROBLEM ENTRIES WHICH ARE **NOT** POINTED TO ;
2 ;;7.3;TOOLKIT;**23**;Apr 25, 1995
3 ;;
4 ;;
5EN ;
6 M ^TMP("XDRPREL1",$J,2)=^TMP("XDRDPREL",$J,2)
7 S NODE=""
8 F S NODE=$O(^TMP("XDRPREL1",$J,2,NODE)) Q:NODE="" D
9 . M ^TMP("XDRPREL1",$J,"BB")=^TMP("XDRPREL1",$J,2,NODE)
10 S XDRXFLG=1
11 D EN^XDRMERG(2,$NA(^TMP("XDRPREL1",$J,"BB")))
12 S NODE=""
13 F S NODE=$O(^TMP("XDRPREL1",$J,2,NODE)) Q:NODE="" D
14 . F J=0:0 S J=$O(^TMP("XDRPREL1",$J,2,NODE,J)) Q:J'>0 D
15 . . I '$D(^TMP("XDRPREL1",$J,"BB",J)) K ^TMP("XDRPREL1",$J,2,NODE,J) Q
16 . . S $P(^(NODE),U,2)=$P(^TMP("XDRPREL1",$J,2,NODE),U,2)+1
Note: See TracBrowser for help on using the repository browser.