LRBLPR1 ;AVAMC/REG - BLOOD BANK PT RECORD-COND'T ;9/11/95 07:30 ;
;;5.2;LAB SERVICE;**1,72,247**;Sep 27, 1994
;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
D E S LR(9)=0 F LRZ=0:1 S LR(9)=$O(^LR(LRDFN,3,LR(9))) Q:'LR(9)!(LR("Q")) D:$Y>(IOSL-6) H^LRBLPR,H Q:LR("Q") S X=^LR(LRDFN,3,LR(9),0) D ^DIWP
Q:LR("Q") D:LRZ ^DIWW
D S Q:LR("Q")
I $O(^LR(LRDFN,1.7,0)) W !?4,"Antibodies identified: " F LR(9)=0:0 S LR(9)=$O(^LR(LRDFN,1.7,LR(9))) Q:'LR(9)!(LR("Q")) D:$Y>(IOSL-6) H1 Q:LR("Q") W:$X>(IOM-15) !?4 W " ",$P(^LAB(61.3,LR(9),0),"^")
Q:LR("Q") I $D(^LR(LRDFN,LRSS)),LR(8) D V
W ! Q
;
V W !,"Accession Number",?24,"Date/time",?40,"ABO",?44,"Rh",?48,"AHG(D)",?55,"AHG(I)"
S LRI=0 F A=1:1 S LRI=$O(^LR(LRDFN,LRSS,LRI)) Q:'LRI!(A>LR(8))!(LR("Q")) S LR(5)=^(LRI,0) D:$Y>(IOSL-6) H2 Q:LR("Q") S T=+LR(5) D T W !,$J($P(LR(5),"^",6),15),?24,T D W
Q
W S LR(10)=$S($D(^LR(LRDFN,LRSS,LRI,10)):^(10),1:""),LR(11)=$S($D(^(11)):^(11),1:""),LR(0)=$S($D(^(2)):^(2),1:""),LR(6)=$S($D(^(6)):^(6),1:"")
W ?41,$J($P(LR(10),"^"),2),?44,$P(LR(11),"^"),?51,$P(LR(0),"^",9),?58,$P(LR(6),"^")
F E=10,11 I $P(LR(E),"^",3)]"" D:$Y>(IOSL-6) H2 Q:LR("Q") S X=$P(LR(E),"^",3) W !?20,$E(X,1,59) I $L(X)>59 W !?40,$E(X,60,80)
Q:LR("Q") D:$Y>(IOSL-6) H2 Q:LR("Q") S X=$P(LR(0),"^",10) I X]"" W !?20,$E(X,1,59) W:$L(X)>59 !?40,$E(X,60,80)
F E=0:0 S E=$O(^LR(LRDFN,LRSS,LRI,4,E)) Q:'E!(LR("Q")) D:$Y>(IOSL-6) H2 Q:LR("Q") S X=^LR(LRDFN,LRSS,LRI,4,E,0) W !?20,$E(X,1,59) W:$L(X)>59 !?40,$E(X,60,80)
Q:LR("Q") F E=0:0 S E=$O(^LR(LRDFN,LRSS,LRI,5,E)) Q:'E!(LR("Q")) D:$Y>(IOSL-6) H2 Q:LR("Q") S X=+^LR(LRDFN,LRSS,LRI,5,E,0) I X,$D(^LAB(61.3,X,0)) W !?20,"Serum antibody: ",$P(^(0),"^")
Q:LR("Q") F E=0:0 S E=$O(^LR(LRDFN,LRSS,LRI,"EA",E)) Q:'E!(LR("Q")) D:$Y>(IOSL-6) H2 Q:LR("Q") W !?20,"Eluate antibody: ",$P(^LAB(61.3,E,0),"^")
Q:LR("Q") F E=0:0 S E=$O(^LR(LRDFN,LRSS,LRI,99,E)) Q:'E!(LR("Q")) S LRE=^(E,0) D:$Y>(IOSL-6) H2 Q:LR("Q") W !?8,LRE
Q
T S T=T_"000",T=$E(T,4,5)_"/"_$E(T,6,7)_"/"_$E(T,2,3)_$S(T[".":" "_$E(T,9,10)_":"_$E(T,11,12),1:"") Q
E K ^UTILITY($J) S DIWR=IOM-5,DIWL=5,DIWF="W" Q
H Q:LR("Q") W !,LRP,?31,$P(LR(4),"^",2),?42,"[See previous page (Pg ",LRQ-1,")]" Q
H1 D H^LRBLPR,H Q:LR("Q") W !?4,"Antibodies identified (cond't): " Q
H2 D H^LRBLPR,H Q:LR("Q") W !?4,"Date/time",?20,"ABO",?24,"Rh",?28,"AHG(D)",?35,"AHG(I)" Q
H3 D H^LRBLPR,H Q:LR("Q") W !,"TRANSFUSION REACTIONS WITH UNIT IDENTIFIED",?51,"UNIT ID",?66,"COMPONENT" Q
H4 D H^LRBLPR,H Q:LR("Q") W !,"TRANSFUSION REACTIONS WITHOUT UNIT IDENTIFIED" Q
S S (C,LRA)=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
Q:LR("Q") 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) D D^LRU W !,Y,?21,$P($G(^LAB(65.4,+$P(LR(1.9),U,2),0)),U) D A
Q
A D:$Y>(IOSL-6) H4 Q:LR("Q") F B=0:0 S B=$O(^LR(LRDFN,1.9,A,1,B)) Q:'B!(LR("Q")) S B(1)=^(B,0) D:$Y>(IOSL-6) H4 Q:LR("Q") W !,B(1)
Q
R S LR(1.9)=$G(^LR(LRDFN,1.6,A,0)),Y=+LR(1.9) I LR(1.9)="" K ^LR("AB",LRDFN,C,A) Q
D D^LRU W:'LRA !,"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) S LRA=LRA+1
D:$Y>(IOSL-6) H3 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) D:$Y>(IOSL-6) H3 Q:LR("Q") W !,B(2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRBLPR1 3535 printed Dec 13, 2024@02:11:59 Page 2
LRBLPR1 ;AVAMC/REG - BLOOD BANK PT RECORD-COND'T ;9/11/95 07:30 ;
+1 ;;5.2;LAB SERVICE;**1,72,247**;Sep 27, 1994
+2 ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
+3 DO E
SET LR(9)=0
FOR LRZ=0:1
SET LR(9)=$ORDER(^LR(LRDFN,3,LR(9)))
if 'LR(9)!(LR("Q"))
QUIT
if $Y>(IOSL-6)
DO H^LRBLPR
DO H
if LR("Q")
QUIT
SET X=^LR(LRDFN,3,LR(9),0)
DO ^DIWP
+4 if LR("Q")
QUIT
if LRZ
DO ^DIWW
+5 DO S
if LR("Q")
QUIT
+6 IF $ORDER(^LR(LRDFN,1.7,0))
WRITE !?4,"Antibodies identified: "
FOR LR(9)=0:0
SET LR(9)=$ORDER(^LR(LRDFN,1.7,LR(9)))
if 'LR(9)!(LR("Q"))
QUIT
if $Y>(IOSL-6)
DO H1
if LR("Q")
QUIT
if $X>(IOM-15)
WRITE !?4
WRITE " ",$PIECE(^LAB(61.3,LR(9),0),"^")
+7 if LR("Q")
QUIT
IF $DATA(^LR(LRDFN,LRSS))
IF LR(8)
DO V
+8 WRITE !
QUIT
+9 ;
V WRITE !,"Accession Number",?24,"Date/time",?40,"ABO",?44,"Rh",?48,"AHG(D)",?55,"AHG(I)"
+1 SET LRI=0
FOR A=1:1
SET LRI=$ORDER(^LR(LRDFN,LRSS,LRI))
if 'LRI!(A>LR(8))!(LR("Q"))
QUIT
SET LR(5)=^(LRI,0)
if $Y>(IOSL-6)
DO H2
if LR("Q")
QUIT
SET T=+LR(5)
DO T
WRITE !,$JUSTIFY($PIECE(LR(5),"^",6),15),?24,T
DO W
+2 QUIT
W SET LR(10)=$SELECT($DATA(^LR(LRDFN,LRSS,LRI,10)):^(10),1:"")
SET LR(11)=$SELECT($DATA(^(11)):^(11),1:"")
SET LR(0)=$SELECT($DATA(^(2)):^(2),1:"")
SET LR(6)=$SELECT($DATA(^(6)):^(6),1:"")
+1 WRITE ?41,$JUSTIFY($PIECE(LR(10),"^"),2),?44,$PIECE(LR(11),"^"),?51,$PIECE(LR(0),"^",9),?58,$PIECE(LR(6),"^")
+2 FOR E=10,11
IF $PIECE(LR(E),"^",3)]""
if $Y>(IOSL-6)
DO H2
if LR("Q")
QUIT
SET X=$PIECE(LR(E),"^",3)
WRITE !?20,$EXTRACT(X,1,59)
IF $LENGTH(X)>59
WRITE !?40,$EXTRACT(X,60,80)
+3 if LR("Q")
QUIT
if $Y>(IOSL-6)
DO H2
if LR("Q")
QUIT
SET X=$PIECE(LR(0),"^",10)
IF X]""
WRITE !?20,$EXTRACT(X,1,59)
if $LENGTH(X)>59
WRITE !?40,$EXTRACT(X,60,80)
+4 FOR E=0:0
SET E=$ORDER(^LR(LRDFN,LRSS,LRI,4,E))
if 'E!(LR("Q"))
QUIT
if $Y>(IOSL-6)
DO H2
if LR("Q")
QUIT
SET X=^LR(LRDFN,LRSS,LRI,4,E,0)
WRITE !?20,$EXTRACT(X,1,59)
if $LENGTH(X)>59
WRITE !?40,$EXTRACT(X,60,80)
+5 if LR("Q")
QUIT
FOR E=0:0
SET E=$ORDER(^LR(LRDFN,LRSS,LRI,5,E))
if 'E!(LR("Q"))
QUIT
if $Y>(IOSL-6)
DO H2
if LR("Q")
QUIT
SET X=+^LR(LRDFN,LRSS,LRI,5,E,0)
IF X
IF $DATA(^LAB(61.3,X,0))
WRITE !?20,"Serum antibody: ",$PIECE(^(0),"^")
+6 if LR("Q")
QUIT
FOR E=0:0
SET E=$ORDER(^LR(LRDFN,LRSS,LRI,"EA",E))
if 'E!(LR("Q"))
QUIT
if $Y>(IOSL-6)
DO H2
if LR("Q")
QUIT
WRITE !?20,"Eluate antibody: ",$PIECE(^LAB(61.3,E,0),"^")
+7 if LR("Q")
QUIT
FOR E=0:0
SET E=$ORDER(^LR(LRDFN,LRSS,LRI,99,E))
if 'E!(LR("Q"))
QUIT
SET LRE=^(E,0)
if $Y>(IOSL-6)
DO H2
if LR("Q")
QUIT
WRITE !?8,LRE
+8 QUIT
T SET T=T_"000"
SET T=$EXTRACT(T,4,5)_"/"_$EXTRACT(T,6,7)_"/"_$EXTRACT(T,2,3)_$SELECT(T[".":" "_$EXTRACT(T,9,10)_":"_$EXTRACT(T,11,12),1:"")
QUIT
E KILL ^UTILITY($JOB)
SET DIWR=IOM-5
SET DIWL=5
SET DIWF="W"
QUIT
H if LR("Q")
QUIT
WRITE !,LRP,?31,$PIECE(LR(4),"^",2),?42,"[See previous page (Pg ",LRQ-1,")]"
QUIT
H1 DO H^LRBLPR
DO H
if LR("Q")
QUIT
WRITE !?4,"Antibodies identified (cond't): "
QUIT
H2 DO H^LRBLPR
DO H
if LR("Q")
QUIT
WRITE !?4,"Date/time",?20,"ABO",?24,"Rh",?28,"AHG(D)",?35,"AHG(I)"
QUIT
H3 DO H^LRBLPR
DO H
if LR("Q")
QUIT
WRITE !,"TRANSFUSION REACTIONS WITH UNIT IDENTIFIED",?51,"UNIT ID",?66,"COMPONENT"
QUIT
H4 DO H^LRBLPR
DO H
if LR("Q")
QUIT
WRITE !,"TRANSFUSION REACTIONS WITHOUT UNIT IDENTIFIED"
QUIT
S SET (C,LRA)=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
+1 if LR("Q")
QUIT
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)
DO D^LRU
WRITE !,Y,?21,$PIECE($GET(^LAB(65.4,+$PIECE(LR(1.9),U,2),0)),U)
DO A
+2 QUIT
A if $Y>(IOSL-6)
DO H4
if LR("Q")
QUIT
FOR B=0:0
SET B=$ORDER(^LR(LRDFN,1.9,A,1,B))
if 'B!(LR("Q"))
QUIT
SET B(1)=^(B,0)
if $Y>(IOSL-6)
DO H4
if LR("Q")
QUIT
WRITE !,B(1)
+1 QUIT
R SET LR(1.9)=$GET(^LR(LRDFN,1.6,A,0))
SET Y=+LR(1.9)
IF LR(1.9)=""
KILL ^LR("AB",LRDFN,C,A)
QUIT
+1 DO D^LRU
if 'LRA
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)
SET LRA=LRA+1
+2 if $Y>(IOSL-6)
DO H3
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)
if $Y>(IOSL-6)
DO H3
if LR("Q")
QUIT
WRITE !,B(2)
+3 QUIT
