LRBLDL1 ;AVAMC/REG - BLOOD DONOR LABELS ; 10/23/88 15:45 ;
;;5.2;LAB SERVICE;**247**;Sep 27, 1994
;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
U IO S P=P(1) F A=0:1 S P=$O(^LRE("B",P)) G:P=""!(P]P(2)) END F I=0:0 S I=$O(^LRE("B",P,I)) Q:'I S W=$O(^LRE(I,5,0)) I W>LRSDT S W=^(W,0) D W
END D V^LRU,END^LRUTL Q
;
W Q:$P(^LRE(I,0),"^",10) S W(7)=$P(W,"^",7) I LR,W(7)'=LR,'$D(^LRE(I,2,LR)) Q
S C=1 W $P(P,",",2)_" "_$P(P,",",1)
I $D(^LRE(I,1)) S X=^(1) D A
F B=C:1:LR(1) W !
Q
A F B=1:1:3 I $P(X,"^",B)]"" S C=C+1 W !,$P(X,"^",B)
S C=C+1 W !,$P(X,"^",4) W:$P(X,"^",5) ", ",$P(^DIC(5,$P(X,"^",5),0),"^",2) W " ",$P(X,"^",6) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRBLDL1 692 printed Nov 22, 2024@17:20:41 Page 2
LRBLDL1 ;AVAMC/REG - BLOOD DONOR LABELS ; 10/23/88 15:45 ;
+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 USE IO
SET P=P(1)
FOR A=0:1
SET P=$ORDER(^LRE("B",P))
if P=""!(P]P(2))
GOTO END
FOR I=0:0
SET I=$ORDER(^LRE("B",P,I))
if 'I
QUIT
SET W=$ORDER(^LRE(I,5,0))
IF W>LRSDT
SET W=^(W,0)
DO W
END DO V^LRU
DO END^LRUTL
QUIT
+1 ;
W if $PIECE(^LRE(I,0),"^",10)
QUIT
SET W(7)=$PIECE(W,"^",7)
IF LR
IF W(7)'=LR
IF '$DATA(^LRE(I,2,LR))
QUIT
+1 SET C=1
WRITE $PIECE(P,",",2)_" "_$PIECE(P,",",1)
+2 IF $DATA(^LRE(I,1))
SET X=^(1)
DO A
+3 FOR B=C:1:LR(1)
WRITE !
+4 QUIT
A FOR B=1:1:3
IF $PIECE(X,"^",B)]""
SET C=C+1
WRITE !,$PIECE(X,"^",B)
+1 SET C=C+1
WRITE !,$PIECE(X,"^",4)
if $PIECE(X,"^",5)
WRITE ", ",$PIECE(^DIC(5,$PIECE(X,"^",5),0),"^",2)
WRITE " ",$PIECE(X,"^",6)
QUIT
