- 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 Feb 19, 2025@00:02:39 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