LRBLXREF.m

LRBLXREF ; IHS/DIR/FJE - SET BLOOD INVENTORY XREF 9/17/88 17:32 ;

 ;;5.2;LR;;NOV 01, 1997

 ;

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

 Q:$D(^LRD(65,"AB"))

 F A=0:0 S A=$O(^LRD(65,A)) Q:'A  I $D(^LRD(65,A,4)) S X=$P(^(4),"^",2) S:X ^LRD(65,"AB",X,A)=""

LRBLXREF  ; IHS/DIR/FJE - SET BLOOD INVENTORY XREF 9/17/88 17:32 ;

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

 +2       ;

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

 +4        IF $DATA(^LRD(65,"AB"))

               QUIT 

 +5        FOR A=0:0

               SET A=$ORDER(^LRD(65,A))

               IF 'A

                   QUIT 

               IF $DATA(^LRD(65,A,4))

                   SET X=$PIECE(^(4),"^",2)

                   IF X

                       SET ^LRD(65,"AB",X,A)=""