LRBLUL.m

LRBLUL ;AVAMC/REG - BB UTIL ;4/13/93  07:17 ;

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

 ;Per VHA Directive 97-033 this routine should not be modified.  Medical Device # BK970021

 ;from input transform 65,.01

 S X(1)=+$P($G(^LRD(65,DA,0)),"^",4),X(2)=0 F  S X(2)=$O(^LRD(65,"B",X,X(2))) Q:'X(2)  I $P(^LRD(65,X(2),0),"^",4)=X(1) D W Q

 Q

C ; from input transform 65,.04

 S X(1)=$P(^LRD(65,DA,0),U),X(2)=0 F  S X(2)=$O(^LRD(65,"B",X(1),X(2))) Q:'X(2)  I $P(^LRD(65,X(2),0),"^",4)=X D W Q

 Q

 ;

W W $C(7),!,$P(^LAB(66,$P(^LRD(65,X(2),0),U,4),0),U)," unit already exists in inventory" K X Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRBLUL   597     printed  Apr 09, 2024@21:16:04                                                                                                                                                                                                       Page 2

LRBLUL    ;AVAMC/REG - BB UTIL ;4/13/93  07:17 ;

 +1       ;;5.2;LAB SERVICE;**247**;Sep 27, 1994

 +2       ;Per VHA Directive 97-033 this routine should not be modified.  Medical Device # BK970021

 +3       ;from input transform 65,.01

 +4        SET X(1)=+$PIECE($GET(^LRD(65,DA,0)),"^",4)

           SET X(2)=0

           FOR 

               SET X(2)=$ORDER(^LRD(65,"B",X,X(2)))

               if 'X(2)

                   QUIT 

               IF $PIECE(^LRD(65,X(2),0),"^",4)=X(1)

                   DO W

                   QUIT 

 +5        QUIT 

C         ; from input transform 65,.04

 +1        SET X(1)=$PIECE(^LRD(65,DA,0),U)

           SET X(2)=0

           FOR 

               SET X(2)=$ORDER(^LRD(65,"B",X(1),X(2)))

               if 'X(2)

                   QUIT 

               IF $PIECE(^LRD(65,X(2),0),"^",4)=X

                   DO W

                   QUIT 

 +2        QUIT 

 +3       ;

W          WRITE $CHAR(7),!,$PIECE(^LAB(66,$PIECE(^LRD(65,X(2),0),U,4),0),U)," unit already exists in inventory"

           KILL X

           QUIT