- LRBLDL1 ; IHS/DIR/FJE - BLOOD DONOR LABELS 10/23/88 15:45 ;
- ;;5.2;LR;;NOV 01, 1997
- ;
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- 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
- LRBLDL1 ; IHS/DIR/FJE - BLOOD DONOR LABELS 10/23/88 15:45 ;
- +1 ;;5.2;LR;;NOV 01, 1997
- +2 ;
- +3 ;;5.2;LAB SERVICE;;Sep 27, 1994
- +4 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
