- 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**;Dec 17 1997;Build 242
- ;
- 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 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
- 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 LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM),LN
- ;
- ; 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
- 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
- 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
- D LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM),LN
- ;
- ; New Units section
- N INDEX,UNT,ORY,I,CNT,J,K,L,M,X
- S CNT=0
- 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
- S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"Unit ID",.CCNT)_$$S^ORU4(13,CCNT,"Component",.CCNT)_$$S^ORU4(27,CCNT,"Status",.CCNT)_$$S^ORU4(42,CCNT,"Exp Date",.CCNT)_$$S^ORU4(58,CCNT,"Division",.CCNT)
- D LN
- S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"-------",.CCNT)_$$S^ORU4(13,CCNT,"---------",.CCNT)_$$S^ORU4(27,CCNT,"------",.CCNT)_$$S^ORU4(42,CCNT,"--------",.CCNT)_$$S^ORU4(58,CCNT,"--------",.CCNT)
- S I="" F S I=$O(ORY(I)) Q:I="" S J="" F S J=$O(ORY(I,J)) Q:J="" S K="" F S K=$O(ORY(I,J,K)) Q:K="" S L="" F S L=$O(ORY(I,J,K,L)) Q:L="" S M="" F S M=$O(ORY(I,J,K,L,M)) Q:M="" D LN D
- . S X=ORY(I,J,K,L,M),INDEX=$E(K,2),UNT=$S(INDEX="A":"Autologous",INDEX="D":"Directed",INDEX="C":"Crossmatched",INDEX="S":"Assigned",1:"Unknown")
- . S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,$P(X,"^"),.CCNT)_$$S^ORU4(13,CCNT,$P(X,"^",2),.CCNT)_$$S^ORU4(27,CCNT,UNT,.CCNT)_$$S^ORU4(42,CCNT,$$DATETIME($P(X,"^",4)),.CCNT)_$$S^ORU4(58,CCNT,$P(X,"^",3),.CCNT)
- 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
- 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**;Dec 17 1997;Build 242
- +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
- 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 DO LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM)
- DO LN
- +22 ;
- +23 ; Available Specimens
- +24 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT,"Lab Specimen ID",.CCNT)_$$S^ORU4(27,CCNT,"Expiration Date",.CCNT)
- +25 DO LN
- +26 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT,"----------------------",.CCNT)_$$S^ORU4(27,CCNT,"---------------",.CCNT)
- Begin DoDot:1
- +27 IF '$DATA(ORX("SPECIMEN"))
- DO LN
- SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT," none",.CCNT)
- QUIT
- +28 DO LN
- +29 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
- +30 DO LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM)
- DO LN
- +31 DO LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM)
- DO LN
- +32 ;
- +33 ; Antibodies Identified section
- +34 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT,"Antibodies Identified",.CCNT)
- +35 DO LN
- +36 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT,"---------------------",.CCNT)
- Begin DoDot:1
- +37 IF '$ORDER(ORX("ABHIS",0))
- DO LN
- SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT," none",.CCNT)
- QUIT
- +38 DO LN
- +39 SET ABFND=0
- +40 SET I=0
- FOR
- SET I=$ORDER(ORX("ABHIS",I))
- IF I<1
- QUIT
- Begin DoDot:2
- +41 SET X=ORX("ABHIS",I)
- +42 IF ABFND
- SET ^TMP("ORVBEC",$JOB,GCNT,0)=^TMP("ORVBEC",$JOB,GCNT,0)_$$S^ORU4(2,CCNT,", "_$PIECE(X,"^"),.CCNT)
- QUIT
- +43 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,$PIECE(X,"^"),.CCNT)
- SET ABFND=1
- End DoDot:2
- End DoDot:1
- +44 DO LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM)
- DO LN
- +45 DO LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM)
- DO LN
- +46 ;
- +47 ; Transfusion Requirements section
- +48 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT,"Transfusion Requirements",.CCNT)
- +49 DO LN
- +50 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT,"------------------------",.CCNT)
- Begin DoDot:1
- +51 IF '$ORDER(ORX("TRREQ",0))
- DO LN
- SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT," none",.CCNT)
- QUIT
- +52 DO LN
- +53 SET TREQFND=0
- +54 SET I=0
- FOR
- SET I=$ORDER(ORX("TRREQ",I))
- IF I<1
- QUIT
- Begin DoDot:2
- +55 SET X=ORX("TRREQ",I)
- +56 IF TREQFND
- SET ^TMP("ORVBEC",$JOB,GCNT,0)=^TMP("ORVBEC",$JOB,GCNT,0)_$$S^ORU4(2,CCNT,", "_X,.CCNT)
- QUIT
- +57 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,X,.CCNT)
- SET TREQFND=1
- End DoDot:2
- End DoDot:1
- +58 DO LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM)
- DO LN
- +59 DO LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM)
- DO LN
- +60 ;
- +61 ; Transfusion Reactions section
- +62 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT,"Transfusion Reactions",.CCNT)_$$S^ORU4(27,CCNT,"Date/Time",.CCNT)
- +63 DO LN
- +64 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT,"---------------------",.CCNT)_$$S^ORU4(27,CCNT,"---------",.CCNT)
- Begin DoDot:1
- +65 IF '$ORDER(ORX("TRHX",0))
- DO LN
- SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT," none",.CCNT)
- QUIT
- +66 SET I=0
- FOR
- SET I=$ORDER(ORX("TRHX",I))
- IF I<1
- QUIT
- Begin DoDot:2
- +67 DO LN
- +68 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
- +69 DO LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM)
- DO LN
- +70 DO LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM)
- DO LN
- +71 ;
- +72 ; New Units section
- +73 NEW INDEX,UNT,ORY,I,CNT,J,K,L,M,X
- +74 SET CNT=0
- +75 ; A:Autologous D:Directed C:Crossmatched A:Assigned
- FOR INDEX="A","D","C","S"
- IF $ORDER(ORX("UNIT",INDEX,0))
- Begin DoDot:1
- +76 SET I=0
- FOR
- SET I=$ORDER(ORX("UNIT",INDEX,I))
- IF I<1
- QUIT
- Begin DoDot:2
- +77 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
- +78 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT,"Units Available",.CCNT)
- +79 DO LN
- +80 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT,"---------------",.CCNT)
- +81 DO LN
- +82 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,"Unit ID",.CCNT)_$$S^ORU4(13,CCNT,"Component",.CCNT)_$$S^ORU4(27,CCNT,"Status",.CCNT)_$$S^ORU4(42,CCNT,"Exp Date",.CCNT)_$$S^ORU4(58,CCNT,"Division",.CCNT)
- +83 DO LN
- +84 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,"-------",.CCNT)_$$S^ORU4(13,CCNT,"---------",.CCNT)_$$S^ORU4(27,CCNT,"------",.CCNT)_$$S^ORU4(42,CCNT,"--------",.CCNT)_$$S^ORU4(58,CCNT,"--------",.CCNT)
- +85 SET I=""
- FOR
- SET I=$ORDER(ORY(I))
- IF I=""
- QUIT
- SET J=""
- FOR
- SET J=$ORDER(ORY(I,J))
- IF J=""
- QUIT
- SET K=""
- FOR
- SET K=$ORDER(ORY(I,J,K))
- IF K=""
- QUIT
- SET L=""
- FOR
- SET L=$ORDER(ORY(I,J,K,L))
- IF L=""
- QUIT
- SET M=""
- FOR
- SET M=$ORDER(ORY(I,J,K,L,M))
- IF M=""
- QUIT
- DO LN
- Begin DoDot:1
- +86 SET X=ORY(I,J,K,L,M)
- SET INDEX=$EXTRACT(K,2)
- SET UNT=$SELECT(INDEX="A":"Autologous",INDEX="D":"Directed",INDEX="C":"Crossmatched",INDEX="S":"Assigned",1:"Unknown")
- +87 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,$PIECE(X,"^"),.CCNT)_$$S^ORU4(13,CCNT,$PIECE(X,"^",2),.CCNT)_$$S^ORU4(27,CCNT,UNT,.CCNT)_$$S^ORU4(42,CCNT,$$DATETIME($PIECE(X,"^",4)),.CCNT)_$$S^ORU4(58,CCNT,$PIECE(X,"^",3)
- ,.CCNT)
- End DoDot:1
- +88 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
- SET Y=$$HL7TFM^XLFDT(X)
- SET Y=$$DATETIME^ORCHTAB(Y)
- +2 QUIT Y