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 ---[H[J[2J[HLRBLUL 597 printed Dec 13, 2024@02:12:25 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
