ORWDXVB1 ;slc/dcm - Order dialog utilities for Blood Bank Cont.;3/2/04 09:31 ;12/7/05 17:20
;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,243,309,332**;Dec 17 1997;Build 44
;
PTINFO ;Format patient BB info
N GCNT,CCNT,GIOSL,GIOM,I,TYPE,ORUA,VBERROR,ABFND,LINE1,LINE2,NOABO,NOPAT,TREQFND
S (GCNT,NOPAT,NOABO)=0,CCNT=1,GIOSL=999999,GIOM=80
S OROOT=$NA(^TMP("ORVBEC",$J))
K ^TMP("ORVBEC",$J)
;
I +$G(ORX("ERROR")) D ERROR^ORWDXVB2("^TMP(""ORVBEC"",$J)") Q
; Patient Demographics
D LN
I '$D(ORX("PATIENT")) D Q
. D LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM),LN
. S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(10,CCNT,"There is no previous record of this patient in VBECS.",.CCNT) Q
;
S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(1,CCNT,"Name",.CCNT)_$$S^ORU4(27,CCNT,"SSN",.CCNT)_$$S^ORU4(42,CCNT,"ABO/Rh",.CCNT)
D LN
S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(1,CCNT,"----",.CCNT)_$$S^ORU4(27,CCNT,"---",.CCNT)_$$S^ORU4(42,CCNT,"------",.CCNT) D
. D LN
. S X=ORX("PATIENT"),^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(1,CCNT,$P(X,"^",3)_", "_$P(X,"^",2),.CCNT)_$$S^ORU4(27,CCNT,$P(X,"^",4),.CCNT)
. I $P(ORX("ABORH"),"^")']"" S ^TMP("ORVBEC",$J,GCNT,0)=^TMP("ORVBEC",$J,GCNT,0)_$$S^ORU4(42,CCNT,"unknown",.CCNT) Q
. S X=ORX("ABORH"),^TMP("ORVBEC",$J,GCNT,0)=^TMP("ORVBEC",$J,GCNT,0)_$$S^ORU4(42,CCNT,$$STRIP^XLFSTR($P(X,"^")," ")_" "_$S($$STRIP^XLFSTR($P(X,"^",2)," ")="P":"Pos",$$STRIP^XLFSTR($P(X,"^",2)," ")="N":"Neg",1:"unknown"),.CCNT) Q
D LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM),LN
;
; Available Specimens
S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(1,CCNT,"Lab Specimen ID",.CCNT)_$$S^ORU4(27,CCNT,"Expiration Date",.CCNT)
D LN
S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(1,CCNT,"----------------------",.CCNT)_$$S^ORU4(27,CCNT,"---------------",.CCNT) D
. I '$D(ORX("SPECIMEN")) D LN S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(1,CCNT," none",.CCNT) Q
. D LN
. S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,$P(ORX("SPECIMEN"),"^",2),.CCNT)_$$S^ORU4(27,CCNT,$$DATETIME^ORCHTAB($P(ORX("SPECIMEN"),"^")),.CCNT) Q
D LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM),LN
D UNITS
; Antibodies Identified section
S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(1,CCNT,"Antibodies Identified",.CCNT)
D LN
S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(1,CCNT,"---------------------",.CCNT) D
. I '$O(ORX("ABHIS",0)) D LN S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(1,CCNT," none",.CCNT) Q
. D LN
. S ABFND=0
. S I=0 F S I=$O(ORX("ABHIS",I)) Q:I<1 D
.. S X=ORX("ABHIS",I)
.. I ABFND S ^TMP("ORVBEC",$J,GCNT,0)=^TMP("ORVBEC",$J,GCNT,0)_$$S^ORU4(2,CCNT,", "_$P(X,"^"),.CCNT) Q
.. S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,$P(X,"^"),.CCNT),ABFND=1
D LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM),LN
;
; Transfusion Requirements section
S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(1,CCNT,"Transfusion Requirements",.CCNT)
D LN
S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(1,CCNT,"------------------------",.CCNT) D
. I '$O(ORX("TRREQ",0)) D LN S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(1,CCNT," none",.CCNT) Q
. D LN
. S TREQFND=0
. S I=0 F S I=$O(ORX("TRREQ",I)) Q:I<1 D
.. S X=ORX("TRREQ",I)
.. I TREQFND S ^TMP("ORVBEC",$J,GCNT,0)=^TMP("ORVBEC",$J,GCNT,0)_$$S^ORU4(2,CCNT,", "_X,.CCNT) Q
.. S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,X,.CCNT),TREQFND=1
D LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM),LN
;
; Transfusion Reactions section
S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(1,CCNT,"Transfusion Reactions",.CCNT)_$$S^ORU4(27,CCNT,"Date/Time",.CCNT)
D LN
S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(1,CCNT,"---------------------",.CCNT)_$$S^ORU4(27,CCNT,"---------",.CCNT) D
. I '$O(ORX("TRHX",0)) D LN S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(1,CCNT," none",.CCNT) Q
. S I=0 F S I=$O(ORX("TRHX",I)) Q:I<1 D
.. D LN
.. S X=ORX("TRHX",I),^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,$P(X,"^"),.CCNT)_$$S^ORU4(27,CCNT,$$DATETIME($P(X,"^",2)),.CCNT)
D LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM),LN
;
Q
UNITS ; New Units section
N INDEX,UNT,ORY,I,CNT,J,K,L,M,X,T,ORASSDT,OREXPDT,ORI,ID,PARAM,ORLOCAB
S CNT=0,PARAM=+$$GET^XPAR("DIV^SYS^PKG","OR VBECS AVAIL UNITS FORMAT"),ORLOCAB=0
I +$$GET^XPAR("DIV^SYS^PKG","OR VBECS LOC ABBREV BB REPORT"),PARAM'=1 S ORLOCAB=1 ;Location Abbreviation flag
K ^TMP("ORUTMP",$J)
F INDEX="A","D","C","S" I $O(ORX("UNIT",INDEX,0)) D ; A:Autologous D:Directed C:Crossmatched A:Assigned
. S I=0 F S I=$O(ORX("UNIT",INDEX,I)) Q:I<1 D
.. S X=ORX("UNIT",INDEX,I),CNT=CNT+1,ORY("~"_$P(X,"^"),"~"_$P(X,"^",2),"~"_INDEX,"~"_$P(X,"^",4),CNT)=X
S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(1,CCNT,"Units Available",.CCNT)
D LN
S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(1,CCNT,"---------------",.CCNT)
D LN
;ORM(i)=Minimum column width
D AVUNIT^VBECA4(DFN,"LRB") ;New Improved Format
I $O(^TMP("LRB",$J,0)) D
. K ^TMP("ORUTMP",$J)
. N ORI,ORL,ORDIV,ORASSDT,ORX,X,ORCNT,ORM,I,C1,C2,C3,C4,C5,C6,C7,C8,Y
. S ORM(1)=13,ORM(2)=7,ORM(3)=7,ORM(4)=9,ORM(5)=6,ORM(6)=9,ORM(7)=$S(ORLOCAB:6,1:8),ORM(8)=8
. S (ORCNT,ORI)=0 F S ORI=$O(^TMP("LRB",$J,ORI)) Q:ORI<1 S ID=^(ORI) D
.. S ORX(1)=$$FMTE^XLFDT(9999999-ORI,"5M") ;Assigned Date/Time
.. S ORX(2)=$P(ID,"^",3) ; Unit ID
.. S ORX(3)=$P(ID,"^",11) ; Product ID
.. S ORX(4)=$P(ID,"^",4) ; Component
.. S X=$S($P(ID,"^",7)="P":"Pos",$P(ID,"^",7)="N":"Neg",1:$P(ID,"^",7)) S ORX(5)=$P(ID,"^",6)_" "_X ;ABO/Rh
.. S ORX(6)=$P(ID,"^",2) ;Expiration Date
.. S ORX(7)=$P(ID,"^",10)
.. I ORLOCAB D
... S X=ORX(7)
... I $L(X) S Y=$O(^SC("B",X,0)) I Y S X=$S($L($P($G(^SC(Y,0)),"^",2)):$P(^(0),"^",2),1:$E(X,1,7)) S ORX(7)=X ;Location
... E S ORX(7)=$E(X,1,7)
.. S ORX(8)=$P(ID,"^",9) ;Division
.. S ORCNT=ORCNT+1,^TMP("ORUTMP",$J,ORCNT)=ORX(1)_"^"_ORX(2)_"^"_ORX(3)_"^"_ORX(4)_"^"_ORX(5)_"^"_ORX(6)_"^"_ORX(7)_"^"_ORX(8)
.. F I=1:1:8 I $L(ORX(I))>ORM(I) S ORM(I)=$L(ORX(I)) ;Expand column width to fit data size
. I PARAM'=1 D
.. F I=1:1:8 S ORM(I)=ORM(I)+1 ;Add 1 space between columns
.. S C1=2,C2=C1+ORM(1),C3=C2+ORM(2),C4=C3+ORM(3),C5=C4+ORM(4),C6=C5+ORM(5),C7=C6+ORM(6),C8=C7+ORM(7)
.. D LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM)
.. S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(C1,.CCNT,"Date Assigned",.CCNT)_$$S^ORU4(C2,.CCNT,"Unit ID",.CCNT)_$$S^ORU4(C3,.CCNT,"Prod ID",.CCNT)_$$S^ORU4(C4,.CCNT,"Component",.CCNT)_$$S^ORU4(C5,.CCNT,"ABO/Rh",.CCNT)
.. S ^TMP("ORVBEC",$J,GCNT,0)=^TMP("ORVBEC",$J,GCNT,0)_$$S^ORU4(C6,.CCNT,"Exp. Date",.CCNT)_$$S^ORU4(C7,.CCNT,$S(ORLOCAB:"Locale",1:"Location"),.CCNT)_$$S^ORU4(C8,.CCNT,"Division",.CCNT)
.. D LN
.. S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(C1,.CCNT,"-------------",.CCNT)_$$S^ORU4(C2,.CCNT,"-------",.CCNT)_$$S^ORU4(C3,.CCNT,"-------",.CCNT)_$$S^ORU4(C4,.CCNT,"---------",.CCNT)_$$S^ORU4(C5,.CCNT,"------",.CCNT)
.. S ^TMP("ORVBEC",$J,GCNT,0)=^TMP("ORVBEC",$J,GCNT,0)_$$S^ORU4(C6,.CCNT,"---------",.CCNT)_$$S^ORU4(C7,.CCNT,$S(ORLOCAB:"------",1:"--------"),.CCNT)_$$S^ORU4(C8,.CCNT,"--------",.CCNT)
.. D LN
. S ORI=0 F S ORI=$O(^TMP("ORUTMP",$J,ORI)) Q:'ORI S ID=^(ORI) D
.. I PARAM'=1 D
... D LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM)
... S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(C1,.CCNT,$P(ID,"^"),.CCNT)_$$S^ORU4(C2,.CCNT,$P(ID,"^",2),.CCNT)_$$S^ORU4(C3,.CCNT,$P(ID,"^",3),.CCNT)_$$S^ORU4(C4,.CCNT,$P(ID,"^",4),.CCNT)_$$S^ORU4(C5,.CCNT,$P(ID,"^",5),.CCNT)
... S ^TMP("ORVBEC",$J,GCNT,0)=^TMP("ORVBEC",$J,GCNT,0)_$$S^ORU4(C6,.CCNT,$P(ID,"^",6),.CCNT)_$$S^ORU4(C7,.CCNT,$P(ID,"^",7),.CCNT)_$$S^ORU4(C8,.CCNT,$P(ID,"^",8),.CCNT)
.. I PARAM=1 D
... D LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM)
... D LN S ^TMP("ORVBEC",$J,GCNT,0)=" Date/Time Assigned: "_$$S^ORU4(1,.CCNT,$P(ID,"^",1),.CCNT)
... D LN S ^TMP("ORVBEC",$J,GCNT,0)=" Unit ID : "_$$S^ORU4(1,.CCNT,$P(ID,"^",2),.CCNT)
... D LN S ^TMP("ORVBEC",$J,GCNT,0)=" Product ID : "_$$S^ORU4(1,.CCNT,$P(ID,"^",3),.CCNT)
... D LN S ^TMP("ORVBEC",$J,GCNT,0)=" Component : "_$$S^ORU4(1,.CCNT,$P(ID,"^",4),.CCNT)
... D LN S ^TMP("ORVBEC",$J,GCNT,0)=" ABO/Rh : "_$$S^ORU4(1,.CCNT,$P(ID,"^",5),.CCNT)
... D LN S ^TMP("ORVBEC",$J,GCNT,0)=" Expiration Date : "_$$S^ORU4(1,.CCNT,$P(ID,"^",6),.CCNT)
... D LN S ^TMP("ORVBEC",$J,GCNT,0)=" Location : "_$$S^ORU4(1,.CCNT,$P(ID,"^",7),.CCNT)
... D LN S ^TMP("ORVBEC",$J,GCNT,0)=" Division : "_$$S^ORU4(1,.CCNT,$P(ID,"^",8),.CCNT)
D LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM),LN
K ^TMP("LRB",$J),^TMP("ORUTMP",$J)
Q
LN ;Increment counts
S GCNT=GCNT+1,CCNT=1
Q
DATETIME(X) ; -- Return external form of YYYYMMDDHHNNSS date
N Y
S Y=$$HL7TFM^XLFDT(X),Y=$$DATETIME^ORCHTAB(Y)
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWDXVB1 8469 printed Apr 09, 2024@21:36:37 Page 2
ORWDXVB1 ;slc/dcm - Order dialog utilities for Blood Bank Cont.;3/2/04 09:31 ;12/7/05 17:20
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,243,309,332**;Dec 17 1997;Build 44
+2 ;
PTINFO ;Format patient BB info
+1 NEW GCNT,CCNT,GIOSL,GIOM,I,TYPE,ORUA,VBERROR,ABFND,LINE1,LINE2,NOABO,NOPAT,TREQFND
+2 SET (GCNT,NOPAT,NOABO)=0
SET CCNT=1
SET GIOSL=999999
SET GIOM=80
+3 SET OROOT=$NAME(^TMP("ORVBEC",$JOB))
+4 KILL ^TMP("ORVBEC",$JOB)
+5 ;
+6 IF +$GET(ORX("ERROR"))
DO ERROR^ORWDXVB2("^TMP(""ORVBEC"",$J)")
QUIT
+7 ; Patient Demographics
+8 DO LN
+9 IF '$DATA(ORX("PATIENT"))
Begin DoDot:1
+10 DO LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM)
DO LN
+11 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(10,CCNT,"There is no previous record of this patient in VBECS.",.CCNT)
QUIT
End DoDot:1
QUIT
+12 ;
+13 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT,"Name",.CCNT)_$$S^ORU4(27,CCNT,"SSN",.CCNT)_$$S^ORU4(42,CCNT,"ABO/Rh",.CCNT)
+14 DO LN
+15 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT,"----",.CCNT)_$$S^ORU4(27,CCNT,"---",.CCNT)_$$S^ORU4(42,CCNT,"------",.CCNT)
Begin DoDot:1
+16 DO LN
+17 SET X=ORX("PATIENT")
SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT,$PIECE(X,"^",3)_", "_$PIECE(X,"^",2),.CCNT)_$$S^ORU4(27,CCNT,$PIECE(X,"^",4),.CCNT)
+18 IF $PIECE(ORX("ABORH"),"^")']""
SET ^TMP("ORVBEC",$JOB,GCNT,0)=^TMP("ORVBEC",$JOB,GCNT,0)_$$S^ORU4(42,CCNT,"unknown",.CCNT)
QUIT
+19 SET X=ORX("ABORH")
SET ^TMP("ORVBEC",$JOB,GCNT,0)=^TMP("ORVBEC",$JOB,GCNT,0)_$$S^ORU4(42,CCNT,$$STRIP^XLFSTR($PIECE(X,"^")," ")_" "_$SELECT($$STRIP^XLFSTR($PIECE(X,"^",2)," ")="P":"Pos",$$STRIP^XLFSTR($PIECE(X,"^",2)," ")="N":"Neg",1:"unknown"),.CCNT)
QUIT
End DoDot:1
+20 DO LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM)
DO LN
+21 ;
+22 ; Available Specimens
+23 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT,"Lab Specimen ID",.CCNT)_$$S^ORU4(27,CCNT,"Expiration Date",.CCNT)
+24 DO LN
+25 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT,"----------------------",.CCNT)_$$S^ORU4(27,CCNT,"---------------",.CCNT)
Begin DoDot:1
+26 IF '$DATA(ORX("SPECIMEN"))
DO LN
SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT," none",.CCNT)
QUIT
+27 DO LN
+28 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,$PIECE(ORX("SPECIMEN"),"^",2),.CCNT)_$$S^ORU4(27,CCNT,$$DATETIME^ORCHTAB($PIECE(ORX("SPECIMEN"),"^")),.CCNT)
QUIT
End DoDot:1
+29 DO LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM)
DO LN
+30 DO UNITS
+31 ; Antibodies Identified section
+32 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT,"Antibodies Identified",.CCNT)
+33 DO LN
+34 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT,"---------------------",.CCNT)
Begin DoDot:1
+35 IF '$ORDER(ORX("ABHIS",0))
DO LN
SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT," none",.CCNT)
QUIT
+36 DO LN
+37 SET ABFND=0
+38 SET I=0
FOR
SET I=$ORDER(ORX("ABHIS",I))
if I<1
QUIT
Begin DoDot:2
+39 SET X=ORX("ABHIS",I)
+40 IF ABFND
SET ^TMP("ORVBEC",$JOB,GCNT,0)=^TMP("ORVBEC",$JOB,GCNT,0)_$$S^ORU4(2,CCNT,", "_$PIECE(X,"^"),.CCNT)
QUIT
+41 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,$PIECE(X,"^"),.CCNT)
SET ABFND=1
End DoDot:2
End DoDot:1
+42 DO LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM)
DO LN
+43 ;
+44 ; Transfusion Requirements section
+45 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT,"Transfusion Requirements",.CCNT)
+46 DO LN
+47 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT,"------------------------",.CCNT)
Begin DoDot:1
+48 IF '$ORDER(ORX("TRREQ",0))
DO LN
SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT," none",.CCNT)
QUIT
+49 DO LN
+50 SET TREQFND=0
+51 SET I=0
FOR
SET I=$ORDER(ORX("TRREQ",I))
if I<1
QUIT
Begin DoDot:2
+52 SET X=ORX("TRREQ",I)
+53 IF TREQFND
SET ^TMP("ORVBEC",$JOB,GCNT,0)=^TMP("ORVBEC",$JOB,GCNT,0)_$$S^ORU4(2,CCNT,", "_X,.CCNT)
QUIT
+54 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,X,.CCNT)
SET TREQFND=1
End DoDot:2
End DoDot:1
+55 DO LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM)
DO LN
+56 ;
+57 ; Transfusion Reactions section
+58 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT,"Transfusion Reactions",.CCNT)_$$S^ORU4(27,CCNT,"Date/Time",.CCNT)
+59 DO LN
+60 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT,"---------------------",.CCNT)_$$S^ORU4(27,CCNT,"---------",.CCNT)
Begin DoDot:1
+61 IF '$ORDER(ORX("TRHX",0))
DO LN
SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT," none",.CCNT)
QUIT
+62 SET I=0
FOR
SET I=$ORDER(ORX("TRHX",I))
if I<1
QUIT
Begin DoDot:2
+63 DO LN
+64 SET X=ORX("TRHX",I)
SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,$PIECE(X,"^"),.CCNT)_$$S^ORU4(27,CCNT,$$DATETIME($PIECE(X,"^",2)),.CCNT)
End DoDot:2
End DoDot:1
+65 DO LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM)
DO LN
+66 ;
+67 QUIT
UNITS ; New Units section
+1 NEW INDEX,UNT,ORY,I,CNT,J,K,L,M,X,T,ORASSDT,OREXPDT,ORI,ID,PARAM,ORLOCAB
+2 SET CNT=0
SET PARAM=+$$GET^XPAR("DIV^SYS^PKG","OR VBECS AVAIL UNITS FORMAT")
SET ORLOCAB=0
+3 ;Location Abbreviation flag
IF +$$GET^XPAR("DIV^SYS^PKG","OR VBECS LOC ABBREV BB REPORT")
IF PARAM'=1
SET ORLOCAB=1
+4 KILL ^TMP("ORUTMP",$JOB)
+5 ; A:Autologous D:Directed C:Crossmatched A:Assigned
FOR INDEX="A","D","C","S"
IF $ORDER(ORX("UNIT",INDEX,0))
Begin DoDot:1
+6 SET I=0
FOR
SET I=$ORDER(ORX("UNIT",INDEX,I))
if I<1
QUIT
Begin DoDot:2
+7 SET X=ORX("UNIT",INDEX,I)
SET CNT=CNT+1
SET ORY("~"_$PIECE(X,"^"),"~"_$PIECE(X,"^",2),"~"_INDEX,"~"_$PIECE(X,"^",4),CNT)=X
End DoDot:2
End DoDot:1
+8 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT,"Units Available",.CCNT)
+9 DO LN
+10 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT,"---------------",.CCNT)
+11 DO LN
+12 ;ORM(i)=Minimum column width
+13 ;New Improved Format
DO AVUNIT^VBECA4(DFN,"LRB")
+14 IF $ORDER(^TMP("LRB",$JOB,0))
Begin DoDot:1
+15 KILL ^TMP("ORUTMP",$JOB)
+16 NEW ORI,ORL,ORDIV,ORASSDT,ORX,X,ORCNT,ORM,I,C1,C2,C3,C4,C5,C6,C7,C8,Y
+17 SET ORM(1)=13
SET ORM(2)=7
SET ORM(3)=7
SET ORM(4)=9
SET ORM(5)=6
SET ORM(6)=9
SET ORM(7)=$SELECT(ORLOCAB:6,1:8)
SET ORM(8)=8
+18 SET (ORCNT,ORI)=0
FOR
SET ORI=$ORDER(^TMP("LRB",$JOB,ORI))
if ORI<1
QUIT
SET ID=^(ORI)
Begin DoDot:2
+19 ;Assigned Date/Time
SET ORX(1)=$$FMTE^XLFDT(9999999-ORI,"5M")
+20 ; Unit ID
SET ORX(2)=$PIECE(ID,"^",3)
+21 ; Product ID
SET ORX(3)=$PIECE(ID,"^",11)
+22 ; Component
SET ORX(4)=$PIECE(ID,"^",4)
+23 ;ABO/Rh
SET X=$SELECT($PIECE(ID,"^",7)="P":"Pos",$PIECE(ID,"^",7)="N":"Neg",1:$PIECE(ID,"^",7))
SET ORX(5)=$PIECE(ID,"^",6)_" "_X
+24 ;Expiration Date
SET ORX(6)=$PIECE(ID,"^",2)
+25 SET ORX(7)=$PIECE(ID,"^",10)
+26 IF ORLOCAB
Begin DoDot:3
+27 SET X=ORX(7)
+28 ;Location
IF $LENGTH(X)
SET Y=$ORDER(^SC("B",X,0))
IF Y
SET X=$SELECT($LENGTH($PIECE($GET(^SC(Y,0)),"^",2)):$PIECE(^(0),"^",2),1:$EXTRACT(X,1,7))
SET ORX(7)=X
+29 IF '$TEST
SET ORX(7)=$EXTRACT(X,1,7)
End DoDot:3
+30 ;Division
SET ORX(8)=$PIECE(ID,"^",9)
+31 SET ORCNT=ORCNT+1
SET ^TMP("ORUTMP",$JOB,ORCNT)=ORX(1)_"^"_ORX(2)_"^"_ORX(3)_"^"_ORX(4)_"^"_ORX(5)_"^"_ORX(6)_"^"_ORX(7)_"^"_ORX(8)
+32 ;Expand column width to fit data size
FOR I=1:1:8
IF $LENGTH(ORX(I))>ORM(I)
SET ORM(I)=$LENGTH(ORX(I))
End DoDot:2
+33 IF PARAM'=1
Begin DoDot:2
+34 ;Add 1 space between columns
FOR I=1:1:8
SET ORM(I)=ORM(I)+1
+35 SET C1=2
SET C2=C1+ORM(1)
SET C3=C2+ORM(2)
SET C4=C3+ORM(3)
SET C5=C4+ORM(4)
SET C6=C5+ORM(5)
SET C7=C6+ORM(6)
SET C8=C7+ORM(7)
+36 DO LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM)
+37 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(C1,.CCNT,"Date Assigned",.CCNT)_$$S^ORU4(C2,.CCNT,"Unit ID",.CCNT)_$$S^ORU4(C3,.CCNT,"Prod ID",.CCNT)_$$S^ORU4(C4,.CCNT,"Component",.CCNT)_$$S^ORU4(C5,.CCNT,"ABO/Rh",.CCNT)
+38 SET ^TMP("ORVBEC",$JOB,GCNT,0)=^TMP("ORVBEC",$JOB,GCNT,0)_$$S^ORU4(C6,.CCNT,"Exp. Date",.CCNT)_$$S^ORU4(C7,.CCNT,$SELECT(ORLOCAB:"Locale",1:"Location"),.CCNT)_$$S^ORU4(C8,.CCNT,"Division",.CCNT)
+39 DO LN
+40 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(C1,.CCNT,"-------------",.CCNT)_$$S^ORU4(C2,.CCNT,"-------",.CCNT)_$$S^ORU4(C3,.CCNT,"-------",.CCNT)_$$S^ORU4(C4,.CCNT,"---------",.CCNT)_$$S^ORU4(C5,.CCNT,"------",.CCNT)
+41 SET ^TMP("ORVBEC",$JOB,GCNT,0)=^TMP("ORVBEC",$JOB,GCNT,0)_$$S^ORU4(C6,.CCNT,"---------",.CCNT)_$$S^ORU4(C7,.CCNT,$SELECT(ORLOCAB:"------",1:"--------"),.CCNT)_$$S^ORU4(C8,.CCNT,"--------",.CCNT)
+42 DO LN
End DoDot:2
+43 SET ORI=0
FOR
SET ORI=$ORDER(^TMP("ORUTMP",$JOB,ORI))
if 'ORI
QUIT
SET ID=^(ORI)
Begin DoDot:2
+44 IF PARAM'=1
Begin DoDot:3
+45 DO LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM)
+46 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(C1,.CCNT,$PIECE(ID,"^"),.CCNT)_$$S^ORU4(C2,.CCNT,$PIECE(ID,"^",2),.CCNT)_$$S^ORU4(C3,.CCNT,$PIECE(ID,"^",3),.CCNT)_$$S^ORU4(C4,.CCNT,$PIECE(ID,"^",4),.CCNT)_$$S^ORU4(C5,.CCNT,$PIEC
E(ID,"^",5),.CCNT)
+47 SET ^TMP("ORVBEC",$JOB,GCNT,0)=^TMP("ORVBEC",$JOB,GCNT,0)_$$S^ORU4(C6,.CCNT,$PIECE(ID,"^",6),.CCNT)_$$S^ORU4(C7,.CCNT,$PIECE(ID,"^",7),.CCNT)_$$S^ORU4(C8,.CCNT,$PIECE(ID,"^",8),.CCNT)
End DoDot:3
+48 IF PARAM=1
Begin DoDot:3
+49 DO LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM)
+50 DO LN
SET ^TMP("ORVBEC",$JOB,GCNT,0)=" Date/Time Assigned: "_$$S^ORU4(1,.CCNT,$PIECE(ID,"^",1),.CCNT)
+51 DO LN
SET ^TMP("ORVBEC",$JOB,GCNT,0)=" Unit ID : "_$$S^ORU4(1,.CCNT,$PIECE(ID,"^",2),.CCNT)
+52 DO LN
SET ^TMP("ORVBEC",$JOB,GCNT,0)=" Product ID : "_$$S^ORU4(1,.CCNT,$PIECE(ID,"^",3),.CCNT)
+53 DO LN
SET ^TMP("ORVBEC",$JOB,GCNT,0)=" Component : "_$$S^ORU4(1,.CCNT,$PIECE(ID,"^",4),.CCNT)
+54 DO LN
SET ^TMP("ORVBEC",$JOB,GCNT,0)=" ABO/Rh : "_$$S^ORU4(1,.CCNT,$PIECE(ID,"^",5),.CCNT)
+55 DO LN
SET ^TMP("ORVBEC",$JOB,GCNT,0)=" Expiration Date : "_$$S^ORU4(1,.CCNT,$PIECE(ID,"^",6),.CCNT)
+56 DO LN
SET ^TMP("ORVBEC",$JOB,GCNT,0)=" Location : "_$$S^ORU4(1,.CCNT,$PIECE(ID,"^",7),.CCNT)
+57 DO LN
SET ^TMP("ORVBEC",$JOB,GCNT,0)=" Division : "_$$S^ORU4(1,.CCNT,$PIECE(ID,"^",8),.CCNT)
End DoDot:3
End DoDot:2
End DoDot:1
+58 DO LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM)
DO LN
+59 KILL ^TMP("LRB",$JOB),^TMP("ORUTMP",$JOB)
+60 QUIT
LN ;Increment counts
+1 SET GCNT=GCNT+1
SET CCNT=1
+2 QUIT
DATETIME(X) ; -- Return external form of YYYYMMDDHHNNSS date
+1 NEW Y
+2 SET Y=$$HL7TFM^XLFDT(X)
SET Y=$$DATETIME^ORCHTAB(Y)
+3 QUIT Y
