ORCDVBC1 ;SLC/MKB-Utility functions for VBECS dialogs cont ;2/11/08 11:03
;;3.0;ORDER ENTRY/RESULTS REPORTING;**212,309**;Dec 17, 1997;Build 26
;
PTINFO ; -- Show patient data [from EN^ORCDVBEC]
; Expects ORPNM, ORVB(attribute) from OEAPI^VBECA3
N I,X,TYPE,ORUA
W !!,"CURRENT DATA FOR "_$G(ORPNM)_":" ;I '$L($G(ORVB("ABORH"))) W " none",! Q
W !!,"ABO/Rh: "_$TR($G(ORVB("ABORH")),"^"," "),!
W !,"Antibodies Identified:" D
. I '$O(ORVB("ABHIS",0)) W "none",! Q
. S I=0 F S I=$O(ORVB("ABHIS",I)) Q:I<1 W ?27,$G(ORVB("ABHIS",I)),!
W !,"Units Available",?36,"Expiration D/T Division"
W !,"---------------",?36,"-------------- --------"
F TYPE="A^Autologous","D^Directed","C^Crossmatched","S^Assigned" D
. Q:'$O(ORVB("UNIT",$P(TYPE,U),0)) S ORUA=1
. W !,$P(TYPE,U,2)_" Units:" S TYPE=$P(TYPE,U)
. S I=0 F S I=$O(ORVB("UNIT",TYPE,I)) Q:I<1 S X=$G(ORVB("UNIT",TYPE,I)) W !," "_$$PAD^ORCHTAB($P(X,U),15)_$$PAD^ORCHTAB($P(X,U,2),19)_$$DATETIME($P(X,U,4))_" "_$P(X,U,3)
I '$G(ORUA) W !," none"
W !!,"Transfusion Reactions",?36,"Date/Time"
W !,"---------------------",?36,"---------"
I '$O(ORVB("TRHX",0)) W !," none"
E S I=0 F S I=$O(ORVB("TRHX",I)) Q:I<1 S X=$G(ORVB("TRHX",I)) W !," "_$P(X,U),?36,$$DATETIME($P(X,U,2))
W !
Q
;
DATETIME(X) ; -- Return external form of YYYYMMDDHHNNSS date
N Y S Y=$$HL7TFM^XLFDT(X),Y=$$DATETIME^ORCHTAB(Y)
Q Y
;
OI ; -- Edit VBECS orderable item names
; Option = ORCM VBECS OI EDIT
N X,Y,D,DA,DR,DIE,DIC
F D Q:Y<1 W !
. S DIC("A")="Select VBECS ORDERABLE ITEM: "
. S DIC("W")="W:$P(^(0),U)'=$P(^(0),U,8) "" "",$P(^(0),U,8)"
. S DIC="^ORD(101.43,",DIC(0)="AEQSZ",D="S.VBEC" D IX^DIC Q:Y<1
. S X=$$NAME(Y(0,0)) Q:X="^"
. S DIE=DIC,DA=+Y,DR=".01///"_X D ^DIE S Y=1
Q
;
NAME(DFLT) ; Enter/edit orderable item text (no lookup)
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
S DIR(0)="FAO^3:63^K:X["";""!(X[""^"") X"
S DIR("A")="NAME: " S:$L(DFLT) DIR("B")=DFLT
S DIR("?",1)="Answer must be 3-63 characters in length and cannot contain a semicolon (;)"
S DIR("?")="or an up-arrow (^)."
NM1 D ^DIR S:$D(DTOUT)!(X="^") Y="^" S:'$L(DFLT)&(X="") Y="^"
I X="@" W $C(7),!!,"Orderable items may not be deleted!",! G NM1
Q Y
;
STRIP(X) ; -- remove leading spaces
N I,Y S Y=""
F I=1:1:$L(X) I $E(X,I)'=" " S Y=$E(X,I,$L(X)) Q
Q Y
;
LB(ORDER) ; -- Return Lab order number for specimen collection
; [Additional Text field #19 -- expects ORIFN from TEXT^ORQ12]
N I,LR,NUM
S NUM="",LR=+$$PKG^ORMPS1("LR")
S I=0 F S I=+$O(^OR(100,+$G(ORDER),2,I)) Q:I<1 I $P($G(^OR(100,I,0)),U,14)=LR,$G(^(4)) S NUM=+^(4) Q
Q NUM
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCDVBC1 2646 printed Apr 09, 2024@21:26:01 Page 2
ORCDVBC1 ;SLC/MKB-Utility functions for VBECS dialogs cont ;2/11/08 11:03
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**212,309**;Dec 17, 1997;Build 26
+2 ;
PTINFO ; -- Show patient data [from EN^ORCDVBEC]
+1 ; Expects ORPNM, ORVB(attribute) from OEAPI^VBECA3
+2 NEW I,X,TYPE,ORUA
+3 ;I '$L($G(ORVB("ABORH"))) W " none",! Q
WRITE !!,"CURRENT DATA FOR "_$GET(ORPNM)_":"
+4 WRITE !!,"ABO/Rh: "_$TRANSLATE($GET(ORVB("ABORH")),"^"," "),!
+5 WRITE !,"Antibodies Identified:"
Begin DoDot:1
+6 IF '$ORDER(ORVB("ABHIS",0))
WRITE "none",!
QUIT
+7 SET I=0
FOR
SET I=$ORDER(ORVB("ABHIS",I))
if I<1
QUIT
WRITE ?27,$GET(ORVB("ABHIS",I)),!
End DoDot:1
+8 WRITE !,"Units Available",?36,"Expiration D/T Division"
+9 WRITE !,"---------------",?36,"-------------- --------"
+10 FOR TYPE="A^Autologous","D^Directed","C^Crossmatched","S^Assigned"
Begin DoDot:1
+11 if '$ORDER(ORVB("UNIT",$PIECE(TYPE,U),0))
QUIT
SET ORUA=1
+12 WRITE !,$PIECE(TYPE,U,2)_" Units:"
SET TYPE=$PIECE(TYPE,U)
+13 SET I=0
FOR
SET I=$ORDER(ORVB("UNIT",TYPE,I))
if I<1
QUIT
SET X=$GET(ORVB("UNIT",TYPE,I))
WRITE !," "_$$PAD^ORCHTAB($PIECE(X,U),15)_$$PAD^ORCHTAB($PIECE(X,U,2),19)_$$DATETIME($PIECE(X,U,4))_" "_$PIECE(X,U,3)
End DoDot:1
+14 IF '$GET(ORUA)
WRITE !," none"
+15 WRITE !!,"Transfusion Reactions",?36,"Date/Time"
+16 WRITE !,"---------------------",?36,"---------"
+17 IF '$ORDER(ORVB("TRHX",0))
WRITE !," none"
+18 IF '$TEST
SET I=0
FOR
SET I=$ORDER(ORVB("TRHX",I))
if I<1
QUIT
SET X=$GET(ORVB("TRHX",I))
WRITE !," "_$PIECE(X,U),?36,$$DATETIME($PIECE(X,U,2))
+19 WRITE !
+20 QUIT
+21 ;
DATETIME(X) ; -- Return external form of YYYYMMDDHHNNSS date
+1 NEW Y
SET Y=$$HL7TFM^XLFDT(X)
SET Y=$$DATETIME^ORCHTAB(Y)
+2 QUIT Y
+3 ;
OI ; -- Edit VBECS orderable item names
+1 ; Option = ORCM VBECS OI EDIT
+2 NEW X,Y,D,DA,DR,DIE,DIC
+3 FOR
Begin DoDot:1
+4 SET DIC("A")="Select VBECS ORDERABLE ITEM: "
+5 SET DIC("W")="W:$P(^(0),U)'=$P(^(0),U,8) "" "",$P(^(0),U,8)"
+6 SET DIC="^ORD(101.43,"
SET DIC(0)="AEQSZ"
SET D="S.VBEC"
DO IX^DIC
if Y<1
QUIT
+7 SET X=$$NAME(Y(0,0))
if X="^"
QUIT
+8 SET DIE=DIC
SET DA=+Y
SET DR=".01///"_X
DO ^DIE
SET Y=1
End DoDot:1
if Y<1
QUIT
WRITE !
+9 QUIT
+10 ;
NAME(DFLT) ; Enter/edit orderable item text (no lookup)
+1 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+2 SET DIR(0)="FAO^3:63^K:X["";""!(X[""^"") X"
+3 SET DIR("A")="NAME: "
if $LENGTH(DFLT)
SET DIR("B")=DFLT
+4 SET DIR("?",1)="Answer must be 3-63 characters in length and cannot contain a semicolon (;)"
+5 SET DIR("?")="or an up-arrow (^)."
NM1 DO ^DIR
if $DATA(DTOUT)!(X="^")
SET Y="^"
if '$LENGTH(DFLT)&(X="")
SET Y="^"
+1 IF X="@"
WRITE $CHAR(7),!!,"Orderable items may not be deleted!",!
GOTO NM1
+2 QUIT Y
+3 ;
STRIP(X) ; -- remove leading spaces
+1 NEW I,Y
SET Y=""
+2 FOR I=1:1:$LENGTH(X)
IF $EXTRACT(X,I)'=" "
SET Y=$EXTRACT(X,I,$LENGTH(X))
QUIT
+3 QUIT Y
+4 ;
LB(ORDER) ; -- Return Lab order number for specimen collection
+1 ; [Additional Text field #19 -- expects ORIFN from TEXT^ORQ12]
+2 NEW I,LR,NUM
+3 SET NUM=""
SET LR=+$$PKG^ORMPS1("LR")
+4 SET I=0
FOR
SET I=+$ORDER(^OR(100,+$GET(ORDER),2,I))
if I<1
QUIT
IF $PIECE($GET(^OR(100,I,0)),U,14)=LR
IF $GET(^(4))
SET NUM=+^(4)
QUIT
+5 QUIT NUM
