ORWLR2 ; slc/dcm - VBEC Blood Bank Report ;01/16/03 15:02
;;3.0;ORDER ENTRY/RESULTS REPORTING;**172**;Dec 17, 1997
;from ORWLR1 - Re-write of ^LR7OSBR1
EN ;
N %DT,A,B,C,CMT,H,ID,J,ORI,T,X,X0,Y,PARENT
D H
;
;Get Antibodies
D ABID^VBECA1(PATID,PATNAM,PATDOB,.PARENT,.ARR)
I $O(ARR("ABID",0)) D
. D LN
. S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(4,.CCNT,"Antibodies identified: ",.CCNT),ID=0
. F S ID=$O(ARR("ABID",ID)) Q:'ID D
.. I CCNT>(GIOM-15) D LN S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(1,.CCNT," ",.CCNT)
.. S ^TMP("ORLRC",$J,GCNT,0)=^TMP("ORLRC",$J,GCNT,0)_$$S^ORU4(CCNT,.CCNT,$P(ARR("ABID",ID),"^"),.CCNT)_$$S^ORU4(CCNT,.CCNT," : "_$P(ARR("ABID",ID),"^",2),.CCNT)
;
;Get Transfusion reactions
;Note TRRX API there's no way to differentiate between reactions with or without units identified.
D TRRX^VBECA1(PATID,PATNAM,PATDOB,.PARENT,.ARR)
I $O(ARR("TRRX",0)) D
. D LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM),LN
. S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(0,.CCNT,"TRANSFUSION REACTIONS",.CCNT)_$$S^ORU4(51,.CCNT,"UNIT ID",.CCNT)_$$S^ORU4(66,.CCNT,"COMPONENT",.CCNT)
. S ID=0 F S ID=$O(ARR("TRRX",ID)) Q:'ID S X=ARR("TRRX",ID) D
.. S Y=$TR($$FMTE^XLFDT(+X,"M"),"@"," ")
.. D LN
.. S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(0,.CCNT,Y,.CCNT)_$$S^ORU4(21,.CCNT,$P(X,U,2),.CCNT)_$$S^ORU4(51,.CCNT,$P(X,U,4),.CCNT)_$$S^ORU4(69,.CCNT,$P(X,U,3),.CCNT)
.. I $O(ARR("TRRX",ID,0)) D
... S CMT=0 F S CMT=$O(ARR("TRRX",ID,CMT)) Q:'CMT S C=ARR("TRRX",ID,CMT) D
.... D LN
.... S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(0,.CCNT," "_C,.CCNT)
D LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
;
;Get Xmatched units, Component requests, AHG
K ^TMP("BBD",$J)
D DFN^VBECA3A(DFN),CPRS^VBECA3B
D CX,C,TRAN,AHG
;
;Get Specimen Tests
I '$O(^TMP("BBD",$J,"SPECIMEN",0)) Q
S ORI=""
F S ORI=$O(^TMP("BBD",$J,"SPECIMEN",ORI),-1) Q:ORI="" D
. S ID=^TMP("BBD",$J,"SPECIMEN",ORI)
. Q:'$L($P(ID,"^"))
. S T=ORI
. D T,LN
. S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(4,.CCNT,T,.CCNT)
. D W
K ^TMP("BBD",$J)
Q
W ;
S ^(0)=^TMP("ORLRC",$J,GCNT,0)_$$S^ORU4(21,.CCNT,$J($P(ID,"^",3),2),.CCNT)
S ^(0)=^TMP("ORLRC",$J,GCNT,0)_$$S^ORU4(24,.CCNT,$E($P(ID,"^",9),1,3),.CCNT)
F H=5,6,7,8,10 S Y=$P(ID,"^",H) S ^(0)=^TMP("ORLRC",$J,GCNT,0)_$$S^ORU4((30+$S(H=6:5,H=7:10,H=8:15,H=10:32,1:0)),.CCNT,$E(Y,1,3),.CCNT)
F X=10.3,11.3,2.91 I $D(^TMP("BBD",$J,"SPECIMEN",ORI,X)) S J=0 D
. I $D(^TMP("BBD",$J,"SPECIMEN",ORI,X))#2 D LN S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(1,.CCNT,ORN(X)_":"_^TMP("BBD",$J,"SPECIMEN",ORI,X),.CCNT)
I $D(^TMP("BBD",$J,"SPECIMEN",ORI,"63.012,.01")) S J=0 F S J=$O(^TMP("BBD",$J,"SPECIMEN",ORI,"63.012,.01",J)) Q:'J D
. S X=^TMP("BBD",$J,"SPECIMEN",ORI,"63.012,.01",J)
. D LN
. S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(1,.CCNT,"ELUATE ANTIBODY: "_X,.CCNT)
;
I $D(^TMP("BBD",$J,"SPECIMEN",ORI,"63.46,.01")) S J=0 F S J=$O(^TMP("BBD",$J,"SPECIMEN",ORI,"63.46,.01",J)) Q:'J D
. S X=^TMP("BBD",$J,"SPECIMEN",ORI,"63.46,.01",J)
. D LN
. S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(1,.CCNT,"SERUM ANTIBODY IDENTIFIED: "_X,.CCNT)
;
I $D(^TMP("BBD",$J,"SPECIMEN",ORI,"63.01,8")) S J=0 F S J=$O(^TMP("BBD",$J,"SPECIMEN",ORI,"63.01,8",J)) Q:'J D
. S X=^TMP("BBD",$J,"SPECIMEN",ORI,"63.01,8",J)
. D LN
. S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(1,.CCNT,"ANTIBODY SCREEN COMMENT: "_X,.CCNT)
;
I $D(^TMP("BBD",$J,"SPECIMEN",ORI,"63.48,.01")) S J=0 F S J=$O(^TMP("BBD",$J,"SPECIMEN",ORI,"63.48,.01",J)) Q:'J D
. S X=^TMP("BBD",$J,"SPECIMEN",ORI,"63.48,.01",J)
. D LN
. S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(1,.CCNT,"ANTIBODY SCREEN COMMENT: "_X,.CCNT)
;
I $D(^TMP("BBD",$J,"SPECIMEN",ORI,"63.199,.01")) S J=0 F S J=$O(^TMP("BBD",$J,"SPECIMEN",ORI,"63.199,.01",J)) Q:'J D
. S X=^TMP("BBD",$J,"SPECIMEN",ORI,"63.199,.01",J)
. D LN
. S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(8,.CCNT,X,.CCNT)
Q
T ;Set Date/time format
S T=$$FMTE^XLFDT(T,2)
Q
CX ;Crossmatch
N A,CNT,F,LOCAT
I '$O(^TMP("BBD",$J,"CROSSMATCH",0)) D Q
. D LN
. S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(1,.CCNT,"No UNITS assigned/xmatched",.CCNT)
. D LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
D LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM),LN
S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(6,.CCNT,"Unit assigned/xmatched:",.CCNT)_$$S^ORU4(46,.CCNT,"Exp date",.CCNT)_$$S^ORU4(64,.CCNT,"Loc",.CCNT)
S (CNT,A)=0 F S A=$O(^TMP("BBD",$J,"CROSSMATCH",A)) Q:'A D
. S F=^TMP("BBD",$J,"CROSSMATCH",A),CNT=CNT+1,LOCAT=$S($L($P(F,"^",7)):$P(F,"^",7),1:"BB-"_$P(F,"^",6))
. D LN
. S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(1,.CCNT,$J(CNT,2)_")",.CCNT)_$$S^ORU4(6,.CCNT,$P(F,"^"),.CCNT)_$$S^ORU4(17,.CCNT,$E($P(F,"^",2),1,19),.CCNT)_$$S^ORU4(38,.CCNT,$P(F,"^",3)_" "_$E($P(F,"^",4),1,3),.CCNT)
. S ^(0)=^TMP("ORLRC",$J,GCNT,0)_$$S^ORU4(45,.CCNT,$P(F,"^",5),.CCNT)_$$S^ORU4(64,.CCNT,LOCAT,.CCNT)
D LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
Q
C ;Component Request
N %DT,A,F,T,X,Y
I '$O(^TMP("BBD",$J,"COMPONENT REQUEST",0)) D Q
. D LN S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(1,.CCNT,"No component requests",.CCNT)
D LN
S X="Component requests"
S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(1,.CCNT,X,.CCNT)_$$S^ORU4(26,.CCNT,"Units",.CCNT)_$$S^ORU4(32,.CCNT,"Request date",.CCNT)_$$S^ORU4(49,.CCNT,"Date wanted",.CCNT)_$$S^ORU4(65,.CCNT,"Requestor",.CCNT)_$$S^ORU4(77,.CCNT,"By",.CCNT)
S A=0 F S A=$O(^TMP("BBD",$J,"COMPONENT REQUEST",A)) Q:'A D
. S F=^TMP("BBD",$J,"COMPONENT REQUEST",A),T="",%DT="T",X=$P(F,"^",3),Y=-1
. I $L(X) D ^%DT
. I Y'=-1 S T=Y D T
. D LN
. S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(1,.CCNT,$E($P(F,"^"),1,25),.CCNT)_$$S^ORU4(26,.CCNT,$J($P(F,"^",2),3),.CCNT)_$$S^ORU4(32,.CCNT,T,.CCNT)
. S T="",%DT="T",X=$P(F,"^",4),Y=-1
. I $L(X) D ^%DT
. I Y'=-1 S T=Y D T
. S X=$S($P(F,"^",6):$P(F,"^",6)_",",1:""),X=$S($L(X):$$GET1^DIQ(200,X,1),1:$P(F,"^",6))
. S ^TMP("ORLRC",$J,GCNT,0)=^TMP("ORLRC",$J,GCNT,0)_$$S^ORU4(49,.CCNT,T,.CCNT)_$$S^ORU4(65,.CCNT,$E($P(F,"^",5),1,10),.CCNT)_$$S^ORU4(77,.CCNT,X,.CCNT)
Q
TRAN ;Transfusion Data
K ^TMP("TRAN",$J)
D TRAN^VBECA4(DFN,"TRAN")
Q:'$O(^TMP("TRAN",$J,0))
N ID,GMR,GMA,TD,C,BPN
D LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM),LN
S X="Transfused Units ",^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(1,.CCNT,X,.CCNT),ID=0
D LN
F S ID=$O(^TMP("TRAN",$J,ID)) Q:'ID S GMR=^(ID) D
. D PARSE^ORWLR1,WRT
I $O(^TMP("TRAN",$J,"A"))'="" D
. D LN
. S X=" Blood Product Key: ",^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(1,.CCNT,X,.CCNT)
S GMI="A",C=0
F S GMI=$O(^TMP("TRAN",$J,GMI)) Q:GMI="" D
. S X=GMI_" = "_$G(^TMP("TRAN",$J,GMI))
. I C>0 D LN
. S C=C+1,^TMP("ORLRC",$J,GCNT,0)=$G(^TMP("ORLRC",$J,GCNT,0))_$$S^ORU4(21,.CCNT,X,.CCNT)
K ^TMP("TRAN",$J)
Q
WRT ; Sets the Transfusion Record for each day
N GML,GMI1,GMI2,GMM,GMJ,CL
S GMM=$S(BPN#4:1,1:0),GML=BPN\4+GMM
D LN
S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(1,.CCNT,TD,.CCNT)
F GMI1=1:1:GML D
. F GMI2=1:1:($S((GMI1=GML)&(BPN#4):BPN#4,1:4)) D
.. S GMJ=((GMI1-1)*4)+GMI2,CL=(((GMI2-1)*15)+14)
.. S ^TMP("ORLRC",$J,GCNT,0)=$G(^TMP("ORLRC",$J,GCNT,0))_$$S^ORU4(CL,.CCNT,GMA(GMJ),.CCNT)
.. I $S(GMI2#4=0:1,GMI2=BPN:1,GMI2+(4*(GMI1-1))=BPN:1,1:0) D LN
Q
H ;Header
N X
D LN
S X=GIOM/2-(10/2+5),^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(X,.CCNT,"---- BLOOD BANK ----",.CCNT)
D LN
S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(1,.CCNT,"ABO Rh: "_ORABORH,.CCNT)
Q
AHG ;AHG Data
D LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM),LN
S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(30,.CCNT,"|---",.CCNT)_$$S^ORU4(39,.CCNT,"AHG(direct)",.CCNT)_$$S^ORU4(55,.CCNT,"---|",.CCNT)_$$S^ORU4(62,.CCNT,"|-AHG(indirect)-|",.CCNT)
D LN
S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(4,.CCNT,"Date/time",.CCNT)_$$S^ORU4(20,.CCNT,"ABO",.CCNT)_$$S^ORU4(24,.CCNT,"Rh",.CCNT)_$$S^ORU4(30,.CCNT,"POLY",.CCNT)_$$S^ORU4(35,.CCNT,"IgG",.CCNT)_$$S^ORU4(40,.CCNT,"C3",.CCNT)
S ^(0)=^TMP("ORLRC",$J,GCNT,0)_$$S^ORU4(45,.CCNT,"Interpretation",.CCNT)_$$S^ORU4(62,.CCNT,"(Antibody screen)",.CCNT)
D LN
S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(4,.CCNT,"---------",.CCNT)_$$S^ORU4(20,.CCNT,"---",.CCNT)_$$S^ORU4(24,.CCNT,"--",.CCNT)_$$S^ORU4(30,.CCNT,"----",.CCNT)_$$S^ORU4(35,.CCNT,"---",.CCNT)
S ^(0)=^TMP("ORLRC",$J,GCNT,0)_$$S^ORU4(40,.CCNT,"---",.CCNT)_$$S^ORU4(45,.CCNT,"--------------",.CCNT)_$$S^ORU4(62,.CCNT,"-----------------",.CCNT)
Q
LN ;Increment counts
S GCNT=GCNT+1,CCNT=1
Q
ORWLR2 ; slc/dcm - VBEC Blood Bank Report ;01/16/03 15:02
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**172**;Dec 17, 1997
+2 ;from ORWLR1 - Re-write of ^LR7OSBR1
EN ;
+1 NEW %DT,A,B,C,CMT,H,ID,J,ORI,T,X,X0,Y,PARENT
+2 DO H
+3 ;
+4 ;Get Antibodies
+5 DO ABID^VBECA1(PATID,PATNAM,PATDOB,.PARENT,.ARR)
+6 IF $ORDER(ARR("ABID",0))
Begin DoDot:1
+7 DO LN
+8 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(4,.CCNT,"Antibodies identified: ",.CCNT)
SET ID=0
+9 FOR
SET ID=$ORDER(ARR("ABID",ID))
IF 'ID
QUIT
Begin DoDot:2
+10 IF CCNT>(GIOM-15)
DO LN
SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(1,.CCNT," ",.CCNT)
+11 SET ^TMP("ORLRC",$JOB,GCNT,0)=^TMP("ORLRC",$JOB,GCNT,0)_$$S^ORU4(CCNT,.CCNT,$PIECE(ARR("ABID",ID),"^"),.CCNT)_$$S^ORU4(CCNT,.CCNT," : "_$PIECE(ARR("ABID",ID),"^",2),.CCNT)
End DoDot:2
End DoDot:1
+12 ;
+13 ;Get Transfusion reactions
+14 ;Note TRRX API there's no way to differentiate between reactions with or without units identified.
+15 DO TRRX^VBECA1(PATID,PATNAM,PATDOB,.PARENT,.ARR)
+16 IF $ORDER(ARR("TRRX",0))
Begin DoDot:1
+17 DO LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
DO LN
+18 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(0,.CCNT,"TRANSFUSION REACTIONS",.CCNT)_$$S^ORU4(51,.CCNT,"UNIT ID",.CCNT)_$$S^ORU4(66,.CCNT,"COMPONENT",.CCNT)
+19 SET ID=0
FOR
SET ID=$ORDER(ARR("TRRX",ID))
IF 'ID
QUIT
SET X=ARR("TRRX",ID)
Begin DoDot:2
+20 SET Y=$TRANSLATE($$FMTE^XLFDT(+X,"M"),"@"," ")
+21 DO LN
+22 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(0,.CCNT,Y,.CCNT)_$$S^ORU4(21,.CCNT,$PIECE(X,U,2),.CCNT)_$$S^ORU4(51,.CCNT,$PIECE(X,U,4),.CCNT)_$$S^ORU4(69,.CCNT,$PIECE(X,U,3),.CCNT)
+23 IF $ORDER(ARR("TRRX",ID,0))
Begin DoDot:3
+24 SET CMT=0
FOR
SET CMT=$ORDER(ARR("TRRX",ID,CMT))
IF 'CMT
QUIT
SET C=ARR("TRRX",ID,CMT)
Begin DoDot:4
+25 DO LN
+26 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(0,.CCNT," "_C,.CCNT)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+27 DO LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
+28 ;
+29 ;Get Xmatched units, Component requests, AHG
+30 KILL ^TMP("BBD",$JOB)
+31 DO DFN^VBECA3A(DFN)
DO CPRS^VBECA3B
+32 DO CX
DO C
DO TRAN
DO AHG
+33 ;
+34 ;Get Specimen Tests
+35 IF '$ORDER(^TMP("BBD",$JOB,"SPECIMEN",0))
QUIT
+36 SET ORI=""
+37 FOR
SET ORI=$ORDER(^TMP("BBD",$JOB,"SPECIMEN",ORI),-1)
IF ORI=""
QUIT
Begin DoDot:1
+38 SET ID=^TMP("BBD",$JOB,"SPECIMEN",ORI)
+39 IF '$LENGTH($PIECE(ID,"^"))
QUIT
+40 SET T=ORI
+41 DO T
DO LN
+42 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(4,.CCNT,T,.CCNT)
+43 DO W
End DoDot:1
+44 KILL ^TMP("BBD",$JOB)
+45 QUIT
W ;
+1 SET ^(0)=^TMP("ORLRC",$JOB,GCNT,0)_$$S^ORU4(21,.CCNT,$JUSTIFY($PIECE(ID,"^",3),2),.CCNT)
+2 SET ^(0)=^TMP("ORLRC",$JOB,GCNT,0)_$$S^ORU4(24,.CCNT,$EXTRACT($PIECE(ID,"^",9),1,3),.CCNT)
+3 FOR H=5,6,7,8,10
SET Y=$PIECE(ID,"^",H)
SET ^(0)=^TMP("ORLRC",$JOB,GCNT,0)_$$S^ORU4((30+$SELECT(H=6:5,H=7:10,H=8:15,H=10:32,1:0)),.CCNT,$EXTRACT(Y,1,3),.CCNT)
+4 FOR X=10.3,11.3,2.91
IF $DATA(^TMP("BBD",$JOB,"SPECIMEN",ORI,X))
SET J=0
Begin DoDot:1
+5 IF $DATA(^TMP("BBD",$JOB,"SPECIMEN",ORI,X))#2
DO LN
SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(1,.CCNT,ORN(X)_":"_^TMP("BBD",$JOB,"SPECIMEN",ORI,X),.CCNT)
End DoDot:1
+6 IF $DATA(^TMP("BBD",$JOB,"SPECIMEN",ORI,"63.012,.01"))
SET J=0
FOR
SET J=$ORDER(^TMP("BBD",$JOB,"SPECIMEN",ORI,"63.012,.01",J))
IF 'J
QUIT
Begin DoDot:1
+7 SET X=^TMP("BBD",$JOB,"SPECIMEN",ORI,"63.012,.01",J)
+8 DO LN
+9 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(1,.CCNT,"ELUATE ANTIBODY: "_X,.CCNT)
End DoDot:1
+10 ;
+11 IF $DATA(^TMP("BBD",$JOB,"SPECIMEN",ORI,"63.46,.01"))
SET J=0
FOR
SET J=$ORDER(^TMP("BBD",$JOB,"SPECIMEN",ORI,"63.46,.01",J))
IF 'J
QUIT
Begin DoDot:1
+12 SET X=^TMP("BBD",$JOB,"SPECIMEN",ORI,"63.46,.01",J)
+13 DO LN
+14 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(1,.CCNT,"SERUM ANTIBODY IDENTIFIED: "_X,.CCNT)
End DoDot:1
+15 ;
+16 IF $DATA(^TMP("BBD",$JOB,"SPECIMEN",ORI,"63.01,8"))
SET J=0
FOR
SET J=$ORDER(^TMP("BBD",$JOB,"SPECIMEN",ORI,"63.01,8",J))
IF 'J
QUIT
Begin DoDot:1
+17 SET X=^TMP("BBD",$JOB,"SPECIMEN",ORI,"63.01,8",J)
+18 DO LN
+19 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(1,.CCNT,"ANTIBODY SCREEN COMMENT: "_X,.CCNT)
End DoDot:1
+20 ;
+21 IF $DATA(^TMP("BBD",$JOB,"SPECIMEN",ORI,"63.48,.01"))
SET J=0
FOR
SET J=$ORDER(^TMP("BBD",$JOB,"SPECIMEN",ORI,"63.48,.01",J))
IF 'J
QUIT
Begin DoDot:1
+22 SET X=^TMP("BBD",$JOB,"SPECIMEN",ORI,"63.48,.01",J)
+23 DO LN
+24 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(1,.CCNT,"ANTIBODY SCREEN COMMENT: "_X,.CCNT)
End DoDot:1
+25 ;
+26 IF $DATA(^TMP("BBD",$JOB,"SPECIMEN",ORI,"63.199,.01"))
SET J=0
FOR
SET J=$ORDER(^TMP("BBD",$JOB,"SPECIMEN",ORI,"63.199,.01",J))
IF 'J
QUIT
Begin DoDot:1
+27 SET X=^TMP("BBD",$JOB,"SPECIMEN",ORI,"63.199,.01",J)
+28 DO LN
+29 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(8,.CCNT,X,.CCNT)
End DoDot:1
+30 QUIT
T ;Set Date/time format
+1 SET T=$$FMTE^XLFDT(T,2)
+2 QUIT
CX ;Crossmatch
+1 NEW A,CNT,F,LOCAT
+2 IF '$ORDER(^TMP("BBD",$JOB,"CROSSMATCH",0))
Begin DoDot:1
+3 DO LN
+4 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(1,.CCNT,"No UNITS assigned/xmatched",.CCNT)
+5 DO LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
End DoDot:1
QUIT
+6 DO LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
DO LN
+7 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(6,.CCNT,"Unit assigned/xmatched:",.CCNT)_$$S^ORU4(46,.CCNT,"Exp date",.CCNT)_$$S^ORU4(64,.CCNT,"Loc",.CCNT)
+8 SET (CNT,A)=0
FOR
SET A=$ORDER(^TMP("BBD",$JOB,"CROSSMATCH",A))
IF 'A
QUIT
Begin DoDot:1
+9 SET F=^TMP("BBD",$JOB,"CROSSMATCH",A)
SET CNT=CNT+1
SET LOCAT=$SELECT($LENGTH($PIECE(F,"^",7)):$PIECE(F,"^",7),1:"BB-"_$PIECE(F,"^",6))
+10 DO LN
+11 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(1,.CCNT,$JUSTIFY(CNT,2)_")",.CCNT)_$$S^ORU4(6,.CCNT,$PIECE(F,"^"),.CCNT)_$$S^ORU4(17,.CCNT,$EXTRACT($PIECE(F,"^",2),1,19),.CCNT)_$$S^ORU4(38,.CCNT,$PIECE(F,"^",3)_" "_$EXTRACT($PIECE(F,"^",4),1,3),
.CCNT)
+12 SET ^(0)=^TMP("ORLRC",$JOB,GCNT,0)_$$S^ORU4(45,.CCNT,$PIECE(F,"^",5),.CCNT)_$$S^ORU4(64,.CCNT,LOCAT,.CCNT)
End DoDot:1
+13 DO LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
+14 QUIT
C ;Component Request
+1 NEW %DT,A,F,T,X,Y
+2 IF '$ORDER(^TMP("BBD",$JOB,"COMPONENT REQUEST",0))
Begin DoDot:1
+3 DO LN
SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(1,.CCNT,"No component requests",.CCNT)
End DoDot:1
QUIT
+4 DO LN
+5 SET X="Component requests"
+6 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(1,.CCNT,X,.CCNT)_$$S^ORU4(26,.CCNT,"Units",.CCNT)_$$S^ORU4(32,.CCNT,"Request date",.CCNT)_$$S^ORU4(49,.CCNT,"Date wanted",.CCNT)_$$S^ORU4(65,.CCNT,"Requestor",.CCNT)_$$S^ORU4(77,.CCNT,"By",.CCNT)
+7 SET A=0
FOR
SET A=$ORDER(^TMP("BBD",$JOB,"COMPONENT REQUEST",A))
IF 'A
QUIT
Begin DoDot:1
+8 SET F=^TMP("BBD",$JOB,"COMPONENT REQUEST",A)
SET T=""
SET %DT="T"
SET X=$PIECE(F,"^",3)
SET Y=-1
+9 IF $LENGTH(X)
DO ^%DT
+10 IF Y'=-1
SET T=Y
DO T
+11 DO LN
+12 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(1,.CCNT,$EXTRACT($PIECE(F,"^"),1,25),.CCNT)_$$S^ORU4(26,.CCNT,$JUSTIFY($PIECE(F,"^",2),3),.CCNT)_$$S^ORU4(32,.CCNT,T,.CCNT)
+13 SET T=""
SET %DT="T"
SET X=$PIECE(F,"^",4)
SET Y=-1
+14 IF $LENGTH(X)
DO ^%DT
+15 IF Y'=-1
SET T=Y
DO T
+16 SET X=$SELECT($PIECE(F,"^",6):$PIECE(F,"^",6)_",",1:"")
SET X=$SELECT($LENGTH(X):$$GET1^DIQ(200,X,1),1:$PIECE(F,"^",6))
+17 SET ^TMP("ORLRC",$JOB,GCNT,0)=^TMP("ORLRC",$JOB,GCNT,0)_$$S^ORU4(49,.CCNT,T,.CCNT)_$$S^ORU4(65,.CCNT,$EXTRACT($PIECE(F,"^",5),1,10),.CCNT)_$$S^ORU4(77,.CCNT,X,.CCNT)
End DoDot:1
+18 QUIT
TRAN ;Transfusion Data
+1 KILL ^TMP("TRAN",$JOB)
+2 DO TRAN^VBECA4(DFN,"TRAN")
+3 IF '$ORDER(^TMP("TRAN",$JOB,0))
QUIT
+4 NEW ID,GMR,GMA,TD,C,BPN
+5 DO LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
DO LN
+6 SET X="Transfused Units "
SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(1,.CCNT,X,.CCNT)
SET ID=0
+7 DO LN
+8 FOR
SET ID=$ORDER(^TMP("TRAN",$JOB,ID))
IF 'ID
QUIT
SET GMR=^(ID)
Begin DoDot:1
+9 DO PARSE^ORWLR1
DO WRT
End DoDot:1
+10 IF $ORDER(^TMP("TRAN",$JOB,"A"))'=""
Begin DoDot:1
+11 DO LN
+12 SET X=" Blood Product Key: "
SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(1,.CCNT,X,.CCNT)
End DoDot:1
+13 SET GMI="A"
SET C=0
+14 FOR
SET GMI=$ORDER(^TMP("TRAN",$JOB,GMI))
IF GMI=""
QUIT
Begin DoDot:1
+15 SET X=GMI_" = "_$GET(^TMP("TRAN",$JOB,GMI))
+16 IF C>0
DO LN
+17 SET C=C+1
SET ^TMP("ORLRC",$JOB,GCNT,0)=$GET(^TMP("ORLRC",$JOB,GCNT,0))_$$S^ORU4(21,.CCNT,X,.CCNT)
End DoDot:1
+18 KILL ^TMP("TRAN",$JOB)
+19 QUIT
WRT ; Sets the Transfusion Record for each day
+1 NEW GML,GMI1,GMI2,GMM,GMJ,CL
+2 SET GMM=$SELECT(BPN#4:1,1:0)
SET GML=BPN\4+GMM
+3 DO LN
+4 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(1,.CCNT,TD,.CCNT)
+5 FOR GMI1=1:1:GML
Begin DoDot:1
+6 FOR GMI2=1:1:($SELECT((GMI1=GML)&(BPN#4):BPN#4,1:4))
Begin DoDot:2
+7 SET GMJ=((GMI1-1)*4)+GMI2
SET CL=(((GMI2-1)*15)+14)
+8 SET ^TMP("ORLRC",$JOB,GCNT,0)=$GET(^TMP("ORLRC",$JOB,GCNT,0))_$$S^ORU4(CL,.CCNT,GMA(GMJ),.CCNT)
+9 IF $SELECT(GMI2#4=0:1,GMI2=BPN:1,GMI2+(4*(GMI1-1))=BPN:1,1:0)
DO LN
End DoDot:2
End DoDot:1
+10 QUIT
H ;Header
+1 NEW X
+2 DO LN
+3 SET X=GIOM/2-(10/2+5)
SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(X,.CCNT,"---- BLOOD BANK ----",.CCNT)
+4 DO LN
+5 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(1,.CCNT,"ABO Rh: "_ORABORH,.CCNT)
+6 QUIT
AHG ;AHG Data
+1 DO LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
DO LN
+2 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(30,.CCNT,"|---",.CCNT)_$$S^ORU4(39,.CCNT,"AHG(direct)",.CCNT)_$$S^ORU4(55,.CCNT,"---|",.CCNT)_$$S^ORU4(62,.CCNT,"|-AHG(indirect)-|",.CCNT)
+3 DO LN
+4 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(4,.CCNT,"Date/time",.CCNT)_$$S^ORU4(20,.CCNT,"ABO",.CCNT)_$$S^ORU4(24,.CCNT,"Rh",.CCNT)_$$S^ORU4(30,.CCNT,"POLY",.CCNT)_$$S^ORU4(35,.CCNT,"IgG",.CCNT)_$$S^ORU4(40,.CCNT,"C3",.CCNT)
+5 SET ^(0)=^TMP("ORLRC",$JOB,GCNT,0)_$$S^ORU4(45,.CCNT,"Interpretation",.CCNT)_$$S^ORU4(62,.CCNT,"(Antibody screen)",.CCNT)
+6 DO LN
+7 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(4,.CCNT,"---------",.CCNT)_$$S^ORU4(20,.CCNT,"---",.CCNT)_$$S^ORU4(24,.CCNT,"--",.CCNT)_$$S^ORU4(30,.CCNT,"----",.CCNT)_$$S^ORU4(35,.CCNT,"---",.CCNT)
+8 SET ^(0)=^TMP("ORLRC",$JOB,GCNT,0)_$$S^ORU4(40,.CCNT,"---",.CCNT)_$$S^ORU4(45,.CCNT,"--------------",.CCNT)_$$S^ORU4(62,.CCNT,"-----------------",.CCNT)
+9 QUIT
LN ;Increment counts
+1 SET GCNT=GCNT+1
SET CCNT=1
+2 QUIT
