- LRBLA2 ; IHS/DIR/AAB - BB ADM DATA 09:20 ; [ 6/21/96 ]
- ;;5.2;LR;**1002**;JUN 01, 1998
- ;;5.2;LAB SERVICE;**72**;Sep 27, 1994
- 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
- LRBLA2 ; IHS/DIR/AAB - BB ADM DATA 09:20 ; [ 6/21/96 ]
- +1 ;;5.2;LR;**1002**;JUN 01, 1998
- +2 ;;5.2;LAB SERVICE;**72**;Sep 27, 1994
- +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
