- LRBLPOST ; IHS/DIR/FJE - BLOOD BANK POST-INIT 15:48 ; [ 7/23/93 ]
- ;;5.2;LR;;NOV 01, 1997
- ;
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- D END I $D(^DD(60,0,"VR")),+^DD(60,0,"VR")<5.14 W !,$C(7),"YOU MUST HAVE AT LEAST VERSION 5.2 BEFORE I CAN RUN THIS ROUTINE",! G END
- I '$D(^LAB(66.5,0)) W $C(7),!,"Need OPERATION (MSBOS) FILE (#66.5) to run this option." G END
- S A=0 F S A=$O(^ICPT(A)) Q:'A D:$O(^(A,"LR",0)) A
- D END Q
- A I '$D(^LAB(66.5,A,0)) S ^(0)=A,X=^LAB(66.5,0),^(0)=$P(X,"^",1,2)_"^"_A_"^"_($P(X,"^",1,2)+1)
- S (B,C)=0 F S B=$O(^ICPT(A,"LR",B)) Q:'B S X=^(B,0) I '$D(^LAB(66.5,A,1,B,0)) S ^(0)=X,C=C+1
- S:'$D(^LAB(66.5,A,1,0)) ^(0)="66.51PA^^" S X=^(0),X(1)=$O(^(0)),^(0)=$P(X,"^",1,2)_"^"_X(1)_"^"_($P(X,"^",4)+1) Q
- ;
- END D V^LRU Q
- LRBLPOST ; IHS/DIR/FJE - BLOOD BANK POST-INIT 15:48 ; [ 7/23/93 ]
- +1 ;;5.2;LR;;NOV 01, 1997
- +2 ;
- +3 ;;5.2;LAB SERVICE;;Sep 27, 1994
- +4 DO END
- IF $DATA(^DD(60,0,"VR"))
- IF +^DD(60,0,"VR")<5.14
- WRITE !,$CHAR(7),"YOU MUST HAVE AT LEAST VERSION 5.2 BEFORE I CAN RUN THIS ROUTINE",!
- GOTO END
- +5 IF '$DATA(^LAB(66.5,0))
- WRITE $CHAR(7),!,"Need OPERATION (MSBOS) FILE (#66.5) to run this option."
- GOTO END
- +6 SET A=0
- FOR
- SET A=$ORDER(^ICPT(A))
- IF 'A
- QUIT
- IF $ORDER(^(A,"LR",0))
- DO A
- +7 DO END
- QUIT
- A IF '$DATA(^LAB(66.5,A,0))
- SET ^(0)=A
- SET X=^LAB(66.5,0)
- SET ^(0)=$PIECE(X,"^",1,2)_"^"_A_"^"_($PIECE(X,"^",1,2)+1)
- +1 SET (B,C)=0
- FOR
- SET B=$ORDER(^ICPT(A,"LR",B))
- IF 'B
- QUIT
- SET X=^(B,0)
- IF '$DATA(^LAB(66.5,A,1,B,0))
- SET ^(0)=X
- SET C=C+1
- +2 IF '$DATA(^LAB(66.5,A,1,0))
- SET ^(0)="66.51PA^^"
- SET X=^(0)
- SET X(1)=$ORDER(^(0))
- SET ^(0)=$PIECE(X,"^",1,2)_"^"_X(1)_"^"_($PIECE(X,"^",4)+1)
- QUIT
- +3 ;
- END DO V^LRU
- QUIT
