LRBLA2 ;AVAMC/REG/CYM - BB ADM DATA ;6/21/96 09:20
;;5.2;LAB SERVICE;**72,247**;Sep 27, 1994
;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
W !,"|",?30,"BLOOD DONOR DATA",?70,"| Total",?79,"|",!,LR("%"),!,"|No donation",?70,"|",$J(^TMP("LR",$J,"N"),6),?79,"|"
W !,LR("%"),!,"|",?3,"Temporary deferrals",?70,"|",$J(^TMP("LR",$J,"N","T"),6),?79,"|"
W !,LR("%"),!,"|",?3,"Permanent deferrals",?70,"|",$J(^TMP("LR",$J,"N","P"),6),?79,"|" I IOST?1"C".E W !,LR("%") D M Q:LR("Q")
D H W !,LR("%"),!,"|WHOLE BLOOD" S X=25,Y=0 F LRB="WH","WD","WA","WT" D P
D B W !,"|",?2,"COLLECTION DISCARDED" S X=25,Y=0 F LRB="WH","WD","WA","WT" D P1
N NAME D B,A F LRA=12:1:20 W !,"|",?3 D FIELD^DID(65.54,LRA,"","LABEL","NAME") S NAME=NAME("LABEL") W NAME S V="W",X=25,Y=0 D W
S V="W" D C,B W !,LR("%") I IOST?1"C".E D M Q:LR("Q") D H W !,LR("%")
W !,"|PLASMAPHERESIS" S X=25,Y=0 F LRB="PH","PD","PA","PT" D P
D B W !,"|",?2,"COLLECTION DISCARDED" S X=25,Y=0 F LRB="PH","PD","PA","PT" D P1
N NAME D B,A F LRA=12:1:20 W !,"|",?3 D FIELD^DID(65.54,LRA,"","LABEL","NAME") S NAME=NAME("LABEL") W NAME S V="P",X=25,Y=0 D W
S V="P" D C,B W !,LR("%") I IOST?1"C".E D M Q:LR("Q") D H W !,LR("%")
W !,"|CYTAPHERESIS" S X=25,Y=0 F LRB="CH","CD","CA","CT" D P
D B W !,"|",?2,"COLLECTION DISCARDED" S X=25,Y=0 F LRB="CH","CD","CA","CT" D P
N NAME D B,A F LRA=12:1:20 W !,"|",?3 D FIELD^DID(65.54,LRA,"","LABEL","NAME") S NAME=NAME("LABEL") W NAME S V="C",X=25,Y=0 D W
S V="C" D C,B W !,LR("%") Q
;
B W ?70,"|",$J(Y,6),?79,"|" Q
W F LRB=V_"H",V_"D",V_"A",V_"T" D P2
D B Q
C W !,"| MULTIPLE POSITIVE TESTS" S X=25,Y=0 F LRB=V_"H",V_"D",V_"A",V_"T" D P3
Q
P S Z=^TMP("LR",$J,LRB) W ?X,"|",$J(Z,6) S X=X+11,Y=Y+Z Q
P1 S Z=^TMP("LR",$J,LRB,"D") W ?X,"|",$J(Z,6) S X=X+11,Y=Y+Z Q
P2 S Z=^TMP("LR",$J,"Y",LRA,LRB) W ?X,"|",$J(Z,6) S X=X+11,Y=Y+Z Q
P3 S Z=^TMP("LR",$J,"Y",LRB) W ?X,"|",$J(Z,6) S X=X+11,Y=Y+Z Q
;
A W !,"|",?2,"POSITIVE TESTS",?25,"|",?36,"|",?47,"|",?58,"|",?70,"|",?79,"|" Q
;
H W !,LR("%"),!,"|DONATIONS",?25,"|Homologous",?34,"|Directed",?47,"|Autologous",?57,"|Therapeutic",?70,"| Total",?79,"|" Q
M D M^LRU Q:LR("Q") W @IOF Q
;
R ;Set transfusion reaction type
S:'$D(^TMP("LR",$J,LRB,"C",F,B)) ^(B)=0 S ^(B)=^(B)+1
S:'$D(^TMP("LR",$J,"S","C",F,B)) ^(B)=0 S ^(B)=^(B)+1 Q
S ;Ck transfusion reactions
F B=0:0 S B=$O(^TMP("LR",$J,LRB,"C",A,B)) Q:'B S ^TMP($J,A,B)=^(B)
S ^TMP($J,A)=^TMP("LR",$J,LRB,"C",A) Q
D W !,LRB(LRB)," Transfusion Reactions:" F A=0:0 S A=$O(^TMP($J,A)) Q:'A!(LR("Q")) S X=^(A) W !?3,LRA(A)," (",X," Transfusion",$S(X>1:"s",1:""),")" D:$Y>(IOSL-6) F Q:LR("Q") D E
K ^TMP($J) Q
E F B=0:0 S B=$O(^TMP($J,A,B)) Q:'B!(LR("Q")) S B(1)=^(B) W !?6,$P(^LAB(65.4,B,0),"^"),?40,$J(B(1),4) D:$Y>(IOSL-6) F
Q
F S LRF=1 D H^LRBLA1 Q:LR("Q") S LRF=0 W !,LRB(LRB)," Transfusion Reactions:",!?3,LRA(A) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRBLA2 2917 printed Nov 22, 2024@17:20:14 Page 2
LRBLA2 ;AVAMC/REG/CYM - BB ADM DATA ;6/21/96 09:20
+1 ;;5.2;LAB SERVICE;**72,247**;Sep 27, 1994
+2 ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
+3 WRITE !,"|",?30,"BLOOD DONOR DATA",?70,"| Total",?79,"|",!,LR("%"),!,"|No donation",?70,"|",$JUSTIFY(^TMP("LR",$JOB,"N"),6),?79,"|"
+4 WRITE !,LR("%"),!,"|",?3,"Temporary deferrals",?70,"|",$JUSTIFY(^TMP("LR",$JOB,"N","T"),6),?79,"|"
+5 WRITE !,LR("%"),!,"|",?3,"Permanent deferrals",?70,"|",$JUSTIFY(^TMP("LR",$JOB,"N","P"),6),?79,"|"
IF IOST?1"C".E
WRITE !,LR("%")
DO M
if LR("Q")
QUIT
+6 DO H
WRITE !,LR("%"),!,"|WHOLE BLOOD"
SET X=25
SET Y=0
FOR LRB="WH","WD","WA","WT"
DO P
+7 DO B
WRITE !,"|",?2,"COLLECTION DISCARDED"
SET X=25
SET Y=0
FOR LRB="WH","WD","WA","WT"
DO P1
+8 NEW NAME
DO B
DO A
FOR LRA=12:1:20
WRITE !,"|",?3
DO FIELD^DID(65.54,LRA,"","LABEL","NAME")
SET NAME=NAME("LABEL")
WRITE NAME
SET V="W"
SET X=25
SET Y=0
DO W
+9 SET V="W"
DO C
DO B
WRITE !,LR("%")
IF IOST?1"C".E
DO M
if LR("Q")
QUIT
DO H
WRITE !,LR("%")
+10 WRITE !,"|PLASMAPHERESIS"
SET X=25
SET Y=0
FOR LRB="PH","PD","PA","PT"
DO P
+11 DO B
WRITE !,"|",?2,"COLLECTION DISCARDED"
SET X=25
SET Y=0
FOR LRB="PH","PD","PA","PT"
DO P1
+12 NEW NAME
DO B
DO A
FOR LRA=12:1:20
WRITE !,"|",?3
DO FIELD^DID(65.54,LRA,"","LABEL","NAME")
SET NAME=NAME("LABEL")
WRITE NAME
SET V="P"
SET X=25
SET Y=0
DO W
+13 SET V="P"
DO C
DO B
WRITE !,LR("%")
IF IOST?1"C".E
DO M
if LR("Q")
QUIT
DO H
WRITE !,LR("%")
+14 WRITE !,"|CYTAPHERESIS"
SET X=25
SET Y=0
FOR LRB="CH","CD","CA","CT"
DO P
+15 DO B
WRITE !,"|",?2,"COLLECTION DISCARDED"
SET X=25
SET Y=0
FOR LRB="CH","CD","CA","CT"
DO P
+16 NEW NAME
DO B
DO A
FOR LRA=12:1:20
WRITE !,"|",?3
DO FIELD^DID(65.54,LRA,"","LABEL","NAME")
SET NAME=NAME("LABEL")
WRITE NAME
SET V="C"
SET X=25
SET Y=0
DO W
+17 SET V="C"
DO C
DO B
WRITE !,LR("%")
QUIT
+18 ;
B WRITE ?70,"|",$JUSTIFY(Y,6),?79,"|"
QUIT
W FOR LRB=V_"H",V_"D",V_"A",V_"T"
DO P2
+1 DO B
QUIT
C WRITE !,"| MULTIPLE POSITIVE TESTS"
SET X=25
SET Y=0
FOR LRB=V_"H",V_"D",V_"A",V_"T"
DO P3
+1 QUIT
P SET Z=^TMP("LR",$JOB,LRB)
WRITE ?X,"|",$JUSTIFY(Z,6)
SET X=X+11
SET Y=Y+Z
QUIT
P1 SET Z=^TMP("LR",$JOB,LRB,"D")
WRITE ?X,"|",$JUSTIFY(Z,6)
SET X=X+11
SET Y=Y+Z
QUIT
P2 SET Z=^TMP("LR",$JOB,"Y",LRA,LRB)
WRITE ?X,"|",$JUSTIFY(Z,6)
SET X=X+11
SET Y=Y+Z
QUIT
P3 SET Z=^TMP("LR",$JOB,"Y",LRB)
WRITE ?X,"|",$JUSTIFY(Z,6)
SET X=X+11
SET Y=Y+Z
QUIT
+1 ;
A WRITE !,"|",?2,"POSITIVE TESTS",?25,"|",?36,"|",?47,"|",?58,"|",?70,"|",?79,"|"
QUIT
+1 ;
H WRITE !,LR("%"),!,"|DONATIONS",?25,"|Homologous",?34,"|Directed",?47,"|Autologous",?57,"|Therapeutic",?70,"| Total",?79,"|"
QUIT
M DO M^LRU
if LR("Q")
QUIT
WRITE @IOF
QUIT
+1 ;
R ;Set transfusion reaction type
+1 if '$DATA(^TMP("LR",$JOB,LRB,"C",F,B))
SET ^(B)=0
SET ^(B)=^(B)+1
+2 if '$DATA(^TMP("LR",$JOB,"S","C",F,B))
SET ^(B)=0
SET ^(B)=^(B)+1
QUIT
S ;Ck transfusion reactions
+1 FOR B=0:0
SET B=$ORDER(^TMP("LR",$JOB,LRB,"C",A,B))
if 'B
QUIT
SET ^TMP($JOB,A,B)=^(B)
+2 SET ^TMP($JOB,A)=^TMP("LR",$JOB,LRB,"C",A)
QUIT
D WRITE !,LRB(LRB)," Transfusion Reactions:"
FOR A=0:0
SET A=$ORDER(^TMP($JOB,A))
if 'A!(LR("Q"))
QUIT
SET X=^(A)
WRITE !?3,LRA(A)," (",X," Transfusion",$SELECT(X>1:"s",1:""),")"
if $Y>(IOSL-6)
DO F
if LR("Q")
QUIT
DO E
+1 KILL ^TMP($JOB)
QUIT
E FOR B=0:0
SET B=$ORDER(^TMP($JOB,A,B))
if 'B!(LR("Q"))
QUIT
SET B(1)=^(B)
WRITE !?6,$PIECE(^LAB(65.4,B,0),"^"),?40,$JUSTIFY(B(1),4)
if $Y>(IOSL-6)
DO F
+1 QUIT
F SET LRF=1
DO H^LRBLA1
if LR("Q")
QUIT
SET LRF=0
WRITE !,LRB(LRB)," Transfusion Reactions:",!?3,LRA(A)
QUIT
