- LRDPA2 ;AVAMC/REG - PT BLOOD BANK LOOKUP ;12/14/92 10:47 ;
- ;;5.2;LR;**310,1022**;September 20, 2007
- ;;
- ; VA Patch 310 is included in IHS LAB PATCH 1022
- ;;
- K ^TMP($J) I '$D(IOM) S IOP="HOME" D ^%ZIS
- S:IOM="" IOM=80
- S DIWR=IOM-5,DIWL=5,DIWF="W"
- S A=0 F B=0:1 S A=$O(^LR(LRDFN,3,A)) Q:'A W:'B $C(7),! S X=^(A,0) D ^DIWP
- D:B ^DIWW K R S A=0 F B=0:1 S A=$O(^LR(LRDFN,1.7,A)) Q:'A W:'B $C(7),!,"Antibody present:" W:B ! S X=^LAB(61.3,A,0) W ?18,$P(X,"^") S:$P(X,"^",4) R($P(X,"^",4))=$P(X,"^")
- W ! S (LR("Q"),A)=0,A(1)=12
- S C=0 F B=0:1 S C=$O(^LR("AB",LRDFN,C)) Q:'C!(LR("Q")) F A=0:0 S A=$O(^LR("AB",LRDFN,C,A)) Q:'A!(LR("Q")) D R
- S A=0 W ! F B=0:1 S A=$O(^LR(LRDFN,1.9,A)) Q:'A!(LR("Q")) S LR(1.9)=^(A,0) W:'B !,"TRANSFUSION REACTIONS WITHOUT UNIT IDENTIFIED:" S Y=+LR(1.9),A(1)=A(1)+1 D D^LRU W !,Y,?21,$P($G(^LAB(65.4,+$P(LR(1.9),U,2),0)),U) D W
- S LR("Q")=0 Q
- W D:A(1)#22=0 M^LRU Q:LR("Q") F B=0:0 S B=$O(^LR(LRDFN,1.9,A,1,B)) Q:'B!(LR("Q")) S A(1)=A(1)+1 W !,^(B,0) D:A(1)#22=0 M^LRU
- Q
- R S LR(1.9)=$G(^LR(LRDFN,1.6,A,0)) I LR(1.9)="" K ^LR("AB",LRDFN,C,A) Q
- S A(1)=A(1)+1,Y=+LR(1.9) D D^LRU
- W:A(1)=13 !,"TRANSFUSION REACTIONS WITH UNIT IDENTIFIED",?51,"UNIT ID",?66,"COMPONENT" W !,Y,?21,$P($G(^LAB(65.4,C,0)),U),?51,$P(LR(1.9),U,3),?69,$P($G(^LAB(66,+$P(LR(1.9),U,2),0)),U,2) D:A(1)#22=0 M^LRU
- Q:LR("Q") F B(1)=0:0 S B(1)=$O(^LR(LRDFN,1.6,A,1,B(1))) Q:'B(1)!(LR("Q")) S B(2)=^(B(1),0),A(1)=A(1)+1 D:A(1)#22=0 M^LRU Q:LR("Q") W !,B(2)
- Q
- LRDPA2 ;AVAMC/REG - PT BLOOD BANK LOOKUP ;12/14/92 10:47 ;
- +1 ;;5.2;LR;**310,1022**;September 20, 2007
- +2 ;;
- +3 ; VA Patch 310 is included in IHS LAB PATCH 1022
- +4 ;;
- +5 KILL ^TMP($JOB)
- IF '$DATA(IOM)
- SET IOP="HOME"
- DO ^%ZIS
- +6 IF IOM=""
- SET IOM=80
- +7 SET DIWR=IOM-5
- SET DIWL=5
- SET DIWF="W"
- +8 SET A=0
- FOR B=0:1
- SET A=$ORDER(^LR(LRDFN,3,A))
- IF 'A
- QUIT
- IF 'B
- WRITE $CHAR(7),!
- SET X=^(A,0)
- DO ^DIWP
- +9 IF B
- DO ^DIWW
- KILL R
- SET A=0
- FOR B=0:1
- SET A=$ORDER(^LR(LRDFN,1.7,A))
- IF 'A
- QUIT
- IF 'B
- WRITE $CHAR(7),!,"Antibody present:"
- IF B
- WRITE !
- SET X=^LAB(61.3,A,0)
- WRITE ?18,$PIECE(X,"^")
- IF $PIECE(X,"^",4)
- SET R($PIECE(X,"^",4))=$PIECE(X,"^")
- +10 WRITE !
- SET (LR("Q"),A)=0
- SET A(1)=12
- +11 SET C=0
- FOR B=0:1
- SET C=$ORDER(^LR("AB",LRDFN,C))
- IF 'C!(LR("Q"))
- QUIT
- FOR A=0:0
- SET A=$ORDER(^LR("AB",LRDFN,C,A))
- IF 'A!(LR("Q"))
- QUIT
- DO R
- +12 SET A=0
- WRITE !
- FOR B=0:1
- SET A=$ORDER(^LR(LRDFN,1.9,A))
- IF 'A!(LR("Q"))
- QUIT
- SET LR(1.9)=^(A,0)
- IF 'B
- WRITE !,"TRANSFUSION REACTIONS WITHOUT UNIT IDENTIFIED:"
- SET Y=+LR(1.9)
- SET A(1)=A(1)+1
- DO D^LRU
- WRITE !,Y,?21,$PIECE($GET(^LAB(65.4,+$PIECE(LR(1.9),U,2),0)),U)
- DO W
- +13 SET LR("Q")=0
- QUIT
- W IF A(1)#22=0
- DO M^LRU
- IF LR("Q")
- QUIT
- FOR B=0:0
- SET B=$ORDER(^LR(LRDFN,1.9,A,1,B))
- IF 'B!(LR("Q"))
- QUIT
- SET A(1)=A(1)+1
- WRITE !,^(B,0)
- IF A(1)#22=0
- DO M^LRU
- +1 QUIT
- R SET LR(1.9)=$GET(^LR(LRDFN,1.6,A,0))
- IF LR(1.9)=""
- KILL ^LR("AB",LRDFN,C,A)
- QUIT
- +1 SET A(1)=A(1)+1
- SET Y=+LR(1.9)
- DO D^LRU
- +2 IF A(1)=13
- WRITE !,"TRANSFUSION REACTIONS WITH UNIT IDENTIFIED",?51,"UNIT ID",?66,"COMPONENT"
- WRITE !,Y,?21,$PIECE($GET(^LAB(65.4,C,0)),U),?51,$PIECE(LR(1.9),U,3),?69,$PIECE($GET(^LAB(66,+$PIECE(LR(1.9),U,2),0)),U,2)
- IF A(1)#22=0
- DO M^LRU
- +3 IF LR("Q")
- QUIT
- FOR B(1)=0:0
- SET B(1)=$ORDER(^LR(LRDFN,1.6,A,1,B(1)))
- IF 'B(1)!(LR("Q"))
- QUIT
- SET B(2)=^(B(1),0)
- SET A(1)=A(1)+1
- IF A(1)#22=0
- DO M^LRU
- IF LR("Q")
- QUIT
- WRITE !,B(2)
- +4 QUIT
