- 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 Mar 13, 2025@21:33:13 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
