- LRBLJPA2 ; IHS/DIR/AAB - UNIT FINAL DISPOSITION 6/20/96 07:13 ;
- ;;5.2;LR;**1002**;JUN 01, 1998
- ;;5.2;LAB SERVICE;**72**;Sep 27, 1994
- I $D(^LRD(65,LRI,10)) S X=^(10),Y=$P(X,U)_":",Z=$P(X,U,2),X(3)=$P(X,U,3) S:Y=":" Y=0 W !,"ABO interp: ",$P($P(LRTABO,Y,2),";",1)," Tech: ",$S('Z:Z,$D(^VA(200,Z,0)):$P(^(0),U),1:Z)," ",X(3)
- I $D(^LRD(65,LRI,11)) S X=^(11),Y=$P(X,U)_":",Z=$P(X,U,2),X(3)=$P(X,U,3) S:Y=":" Y=0 W !,"Rh interp: ",$P($P(LRTRH,Y,2),";",1)," Tech: ",$S('Z:Z,$D(^VA(200,Z,0)):$P(^(0),U),1:Z)," ",X(3)
- D H Q:LR("Q")
- F LRA=60,70,80,90 I $O(^LRD(65,LRI,LRA,0)) D H1 Q:LR("Q") F A=0:0 S A=$O(^LRD(65,LRI,LRA,A)) Q:'A!(LR("Q")) S A(1)=^(A,0) D H Q:LR("Q") W !?3,$S($D(^LAB(61.3,A,0)):$P(^(0),"^"),1:A) W:$P(A(1),"^",2)]"" " (",$P(A(1),"^",2),")"
- D H Q:LR("Q") I $O(^LRD(65,LRI,9,0)) W !,"Modified to/from:" D D Q:LR("Q")
- D H Q:LR("Q") I $O(^LRD(65,LRI,2,0)) W !,"Patient xmatched/assigned:" F A=0:0 S A=$O(^LRD(65,LRI,2,A)) Q:'A!(LR("Q")) S A(1)=^(A,0) D:$Y>(IOSL-6) H3 Q:LR("Q") D A
- D H Q:LR("Q") I $O(^LRD(65,LRI,3,0)) W !,"Date unit relocated:" F A=0:0 S A=$O(^LRD(65,LRI,3,A)) Q:'A!(LR("Q")) S A(1)=^(A,0) D:$Y>(IOSL-6) H6 Q:LR("Q") D C
- Q
- C S Y=+A(1),X=$P(A(1),"^",2)_":",X(3)=$P(A(1),"^",3) D Y^LRBLJPA1 W !,Y," Inspect:",$P($P(LRTINS,X,2),";")," Tech:",$S('X(3):X(3),$D(^VA(200,X(3),0)):$P(^(0),"^"),1:X(3))," ",$P(A(1),"^",4)
- W !?2,"Issued to/rec'd from:",$P(A(1),"^",5)," For patient:",$P(A(1),"^",6) W:$P(A(1),"^",7) " (",$P(A(1),"^",7),")"
- Q
- A ;S X=A D P^LRBLJPA1 W !,$P(Y,"^")," ssn:",$P(Y,"^",9)," ",$P(X(1),"^",5)," ",$P(X(1),"^",6)," Date assigned:" S Y=$P(A(1),"^",2) D Y^LRBLJPA1 W Y
- S X=A D P^LRBLJPA1 W !,$P(Y,"^")," HRCN:",HRCN," ",$P(X(1),"^",5)," ",$P(X(1),"^",6)," Date assigned:" S Y=$P(A(1),"^",2) D Y^LRBLJPA1 W Y ;IHS/ANMC/CLS 11/1/95
- F B=0:0 S B=$O(^LRD(65,LRI,2,A,1,B)) Q:'B!(LR("Q")) S B(1)=^(B,0) D:$Y>(IOSL-6) H4 Q:LR("Q") S Y=$P(B(1),"^") D Y^LRBLJPA1 D B
- Q
- B W !,Y," ",$P(B(1),"^",6)," ",$P(B(1),"^",2) W:$P(B(1),"^",7) "(",$P(B(1),"^",7),")" W " ",$P(B(1),"^",3) W:$P(B(1),"^",8) "(",$P(B(1),"^",8),")"
- S X=$P(B(1),"^",5),Y=$P(B(1),"^",4)_":" W !,"Xmatch tech:",$S('X:X,$D(^VA(200,X,0)):$P(^(0),"^"),1:X)," Result:",$P($P(LRT,Y,2),";",1)
- F C=0:0 S C=$O(^LRD(65,LRI,2,A,1,B,3,C)) Q:'C!(LR("Q")) S C(1)=^(C,0) D:$Y>(IOSL-6) H5 Q:LR("Q") W !,C(1)
- Q
- D F A=0:0 S A=$O(^LRD(65,LRI,9,A)) Q:'A!(LR("Q")) S A(1)=^(A,0) D:$Y>(IOSL-6) H2 Q:LR("Q") W !?3,$J(A,2),") ",$P(A(1),"^",2) S X=$P(A(1),"^") W ?20,$S('X:X,$D(^LAB(66,X,0)):$P(^(0),"^"),1:X)
- Q
- H D:$Y>(IOSL-6) H1^LRBLJPA1 Q
- H1 Q:LR("Q") W !,$S(LRA=60:"RBC antigen present",LRA=70:"RBC antigen absent",LRA=80:"HLA antigen present",1:"HLA antigen absent"),":" Q
- H2 D H1^LRBLJPA1 Q:LR("Q") W !,"Modified to/from:" Q
- H3 D H1^LRBLJPA1 Q:LR("Q") W !,"Patient xmatched/assigned:" Q
- H4 D H1^LRBLJPA1 Q
- H5 D H4 Q:LR("Q") W !,"Crossmatch comment:" Q
- H6 D H4 Q:LR("Q") W !,"Date unit relocated:" Q
- LRBLJPA2 ; IHS/DIR/AAB - UNIT FINAL DISPOSITION 6/20/96 07:13 ;
- +1 ;;5.2;LR;**1002**;JUN 01, 1998
- +2 ;;5.2;LAB SERVICE;**72**;Sep 27, 1994
- +3 IF $DATA(^LRD(65,LRI,10))
- SET X=^(10)
- SET Y=$PIECE(X,U)_":"
- SET Z=$PIECE(X,U,2)
- SET X(3)=$PIECE(X,U,3)
- IF Y="
- SET Y=0
- WRITE !,"ABO interp: ",$PIECE($PIECE(LRTABO,Y,2),";",1)," Tech: ",$SELECT('Z:Z,$DATA(^VA(200,Z,0)):$PIECE(^(0),U),1:Z)," ",X(3)
- +4 IF $DATA(^LRD(65,LRI,11))
- SET X=^(11)
- SET Y=$PIECE(X,U)_":"
- SET Z=$PIECE(X,U,2)
- SET X(3)=$PIECE(X,U,3)
- IF Y="
- SET Y=0
- WRITE !,"Rh interp: ",$PIECE($PIECE(LRTRH,Y,2),";",1)," Tech: ",$SELECT('Z:Z,$DATA(^VA(200,Z,0)):$PIECE(^(0),U),1:Z)," ",X(3)
- +5 DO H
- IF LR("Q")
- QUIT
- +6 FOR LRA=60,70,80,90
- IF $ORDER(^LRD(65,LRI,LRA,0))
- DO H1
- IF LR("Q")
- QUIT
- FOR A=0:0
- SET A=$ORDER(^LRD(65,LRI,LRA,A))
- IF 'A!(LR("Q"))
- QUIT
- SET A(1)=^(A,0)
- DO H
- IF LR("Q")
- QUIT
- WRITE !?3,$SELECT($DATA(^LAB(61.3,A,0)):$PIECE(^(0),"^"),1:A)
- IF $PIECE(A(1),"^",2)]""
- WRITE " (",$PIECE(A(1),"^",2),")"
- +7 DO H
- IF LR("Q")
- QUIT
- IF $ORDER(^LRD(65,LRI,9,0))
- WRITE !,"Modified to/from:"
- DO D
- IF LR("Q")
- QUIT
- +8 DO H
- IF LR("Q")
- QUIT
- IF $ORDER(^LRD(65,LRI,2,0))
- WRITE !,"Patient xmatched/assigned:"
- FOR A=0:0
- SET A=$ORDER(^LRD(65,LRI,2,A))
- IF 'A!(LR("Q"))
- QUIT
- SET A(1)=^(A,0)
- IF $Y>(IOSL-6)
- DO H3
- IF LR("Q")
- QUIT
- DO A
- +9 DO H
- IF LR("Q")
- QUIT
- IF $ORDER(^LRD(65,LRI,3,0))
- WRITE !,"Date unit relocated:"
- FOR A=0:0
- SET A=$ORDER(^LRD(65,LRI,3,A))
- IF 'A!(LR("Q"))
- QUIT
- SET A(1)=^(A,0)
- IF $Y>(IOSL-6)
- DO H6
- IF LR("Q")
- QUIT
- DO C
- +10 QUIT
- C SET Y=+A(1)
- SET X=$PIECE(A(1),"^",2)_":"
- SET X(3)=$PIECE(A(1),"^",3)
- DO Y^LRBLJPA1
- WRITE !,Y," Inspect:",$PIECE($PIECE(LRTINS,X,2),";")," Tech:",$SELECT('X(3):X(3),$DATA(^VA(200,X(3),0)):$PIECE(^(0),"^"),1:X(3))," ",$PIECE(A(1),"^",4)
- +1 WRITE !?2,"Issued to/rec'd from:",$PIECE(A(1),"^",5)," For patient:",$PIECE(A(1),"^",6)
- IF $PIECE(A(1),"^",7)
- WRITE " (",$PIECE(A(1),"^",7),")"
- +2 QUIT
- A ;S X=A D P^LRBLJPA1 W !,$P(Y,"^")," ssn:",$P(Y,"^",9)," ",$P(X(1),"^",5)," ",$P(X(1),"^",6)," Date assigned:" S Y=$P(A(1),"^",2) D Y^LRBLJPA1 W Y
- +1 ;IHS/ANMC/CLS 11/1/95
- SET X=A
- DO P^LRBLJPA1
- WRITE !,$PIECE(Y,"^")," HRCN:",HRCN," ",$PIECE(X(1),"^",5)," ",$PIECE(X(1),"^",6)," Date assigned:"
- SET Y=$PIECE(A(1),"^",2)
- DO Y^LRBLJPA1
- WRITE Y
- +2 FOR B=0:0
- SET B=$ORDER(^LRD(65,LRI,2,A,1,B))
- IF 'B!(LR("Q"))
- QUIT
- SET B(1)=^(B,0)
- IF $Y>(IOSL-6)
- DO H4
- IF LR("Q")
- QUIT
- SET Y=$PIECE(B(1),"^")
- DO Y^LRBLJPA1
- DO B
- +3 QUIT
- B WRITE !,Y," ",$PIECE(B(1),"^",6)," ",$PIECE(B(1),"^",2)
- IF $PIECE(B(1),"^",7)
- WRITE "(",$PIECE(B(1),"^",7),")"
- WRITE " ",$PIECE(B(1),"^",3)
- IF $PIECE(B(1),"^",8)
- WRITE "(",$PIECE(B(1),"^",8),")"
- +1 SET X=$PIECE(B(1),"^",5)
- SET Y=$PIECE(B(1),"^",4)_":"
- WRITE !,"Xmatch tech:",$SELECT('X:X,$DATA(^VA(200,X,0)):$PIECE(^(0),"^"),1:X)," Result:",$PIECE($PIECE(LRT,Y,2),";",1)
- +2 FOR C=0:0
- SET C=$ORDER(^LRD(65,LRI,2,A,1,B,3,C))
- IF 'C!(LR("Q"))
- QUIT
- SET C(1)=^(C,0)
- IF $Y>(IOSL-6)
- DO H5
- IF LR("Q")
- QUIT
- WRITE !,C(1)
- +3 QUIT
- D FOR A=0:0
- SET A=$ORDER(^LRD(65,LRI,9,A))
- IF 'A!(LR("Q"))
- QUIT
- SET A(1)=^(A,0)
- IF $Y>(IOSL-6)
- DO H2
- IF LR("Q")
- QUIT
- WRITE !?3,$JUSTIFY(A,2),") ",$PIECE(A(1),"^",2)
- SET X=$PIECE(A(1),"^")
- WRITE ?20,$SELECT('X:X,$DATA(^LAB(66,X,0)):$PIECE(^(0),"^"),1:X)
- +1 QUIT
- H IF $Y>(IOSL-6)
- DO H1^LRBLJPA1
- QUIT
- H1 IF LR("Q")
- QUIT
- WRITE !,$SELECT(LRA=60:"RBC antigen present",LRA=70:"RBC antigen absent",LRA=80:"HLA antigen present",1:"HLA antigen absent"),":"
- QUIT
- H2 DO H1^LRBLJPA1
- IF LR("Q")
- QUIT
- WRITE !,"Modified to/from:"
- QUIT
- H3 DO H1^LRBLJPA1
- IF LR("Q")
- QUIT
- WRITE !,"Patient xmatched/assigned:"
- QUIT
- H4 DO H1^LRBLJPA1
- QUIT
- H5 DO H4
- IF LR("Q")
- QUIT
- WRITE !,"Crossmatch comment:"
- QUIT
- H6 DO H4
- IF LR("Q")
- QUIT
- WRITE !,"Date unit relocated:"
- QUIT
