- LRBLUL ; IHS/DIR/FJE - BB UTIL 4/13/93 07:17 ;
- ;;5.2;LR;;NOV 01, 1997
- ;
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- ;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
- LRBLUL ; IHS/DIR/FJE - BB UTIL 4/13/93 07:17 ;
- +1 ;;5.2;LR;;NOV 01, 1997
- +2 ;
- +3 ;;5.2;LAB SERVICE;;Sep 27, 1994
- +4 ;from input transform 65,.01
- +5 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
- +6 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