LRAPPRE.m

LRAPPRE ; IHS/DIR/FJE - ANATOMIC PATH PRE-INIT 12:29 ; [ 10/6/90 ]

 ;;5.2;LR;;NOV 01, 1997

 ;

 ;;5.2;LAB SERVICE;;Sep 27, 1994

 ;Added to LRPRE1

 F A=0:0 S A=$O(^LR("AAUA",A)) Q:'A  F B=0:0 S B=$O(^LR("AAUA",A,B)) Q:'B  S LRDFN=+$O(^LR("AAUA",A,B,0)),E=$P($G(^LR(LRDFN,"AU")),"^",3) I E S $P(^("AU"),"^",15)=E

 Q

LRAPPRE   ; IHS/DIR/FJE - ANATOMIC PATH PRE-INIT 12:29 ; [ 10/6/90 ]

 +1       ;;5.2;LR;;NOV 01, 1997

 +2       ;

 +3       ;;5.2;LAB SERVICE;;Sep 27, 1994

 +4       ;Added to LRPRE1

 +5        FOR A=0:0

               SET A=$ORDER(^LR("AAUA",A))

               IF 'A

                   QUIT 

               FOR B=0:0

                   SET B=$ORDER(^LR("AAUA",A,B))

                   IF 'B

                       QUIT 

                   SET LRDFN=+$ORDER(^LR("AAUA",A,B,0))

                   SET E=$PIECE($GET(^LR(LRDFN,"AU")),"^",3)

                   IF E

                       SET $PIECE(^("AU"),"^",15)=E

 +6        QUIT