ORCDVBEC ;SLC/MKB-Utility functions for VBECS dialogs ;2/11/08 11:04
;;3.0;ORDER ENTRY/RESULTS REPORTING;**212,309,332**;Dec 17, 1997;Build 44
;
; External References:
; OEAPI^VBECA3 #4766
; RR^LR7OR1 #2503
; GCOM^LR7OR3 #2428
; $$SITE^VASITE #10112
; $$HL7TFM^XLFDT #10103
; $$UP^XLFSTR #10104
;
PTR(X) ; -- Returns pointer to #101.41 of prompt OR GTX X
Q +$O(^ORD(101.41,"AB","OR GTX "_X,0))
;
EN ; -- entry action
I '$L($T(OEAPI^VBECA3)) W $C(7),!!,"Blood Bank orders are not available yet!" H 2 S ORQUIT=1 Q
N DIV,ORSTN,C,N,X S DIV=+$P($G(^SC(+$G(ORL),0)),U,15)
S ORSTN=$P($$SITE^VASITE(DT,DIV),U,3)
I $G(ORTYPE)'="Z" D OEAPI^VBECA3(.ORVB,+ORVP,ORSTN),PTINFO^ORCDVBC1
I $G(OREVENT) S ORVB("SPECIMEN")="" ;assume no specimen if delayed
S C=0 F S C=$O(ORVB(C)) Q:C<1 S N=0 F S N=$O(ORVB(C,"MSBOS",N)) Q:N<1 S X=$G(ORVB(C,"MSBOS",N)),ORMSBOS(C,$P(X,U))=$P(X,U,2) ;sort
;get initial state: ORCOMP/ORTEST = id^id^ ^id, ORTAS = 1 or 0:
S (ORCOMP,ORTEST,ORTAS)="" I $D(OREDIT)!$G(OREWRITE) D
. N P,I,X,X0 S P=$$PTR("ORDERABLE ITEM")
. S I=0 F S I=$O(ORDIALOG(P,I)) Q:I<1 S X=+$G(ORDIALOG(P,I)) D
.. S X0=$G(^ORD(101.43,X,"VB")),X=+$P($G(^(0)),U,2)
.. I $P(X0,U) S ORCOMP=ORCOMP_$S($L(ORCOMP):U,1:"")_X Q
.. S ORTEST=ORTEST_$S($L(ORTEST):U,1:"")_X
Q
;
EX ; -- exit action
K ORITM,ORCOMP,ORTEST,ORTAS,ORMSBOS,ORTIME,ORIMTIME,ORDIV,ORCOLLCT,ORVB,ORASK,ORSURG
I $G(ORXL) S ORL=ORXL K ORXL
Q
;
XHELP ; -- display OI's in groups
N INDEX,CNT,SCREEN,X,Y,SYN,Y0,D,Z,DONE
S CNT=1,SCREEN=$G(ORDIALOG(PROMPT,"S"))
F INDEX="S.VBC","S.VBT" D Q:$G(DONE)
. W !!,$S(INDEX["C":"Choose from Blood Components:",1:"or Diagnostic Tests:")
. S X="" F S X=$O(^ORD(101.43,INDEX,X)) Q:X="" S Y=0 D Q:$G(DONE)
.. F S Y=$O(^ORD(101.43,INDEX,X,Y)) Q:Y'>0 S SYN=$G(^(Y)) I 'SYN D Q:$G(DONE)
... S Y0=$G(^ORD(101.43,Y,0)),D=INDEX X:$L(SCREEN) SCREEN Q:'$T
... W !," "_X ;W:SYN " "_$P(SYN,U,4) ; echo .01 if synonym
... S CNT=CNT+1 Q:CNT'>(IOSL-5) S CNT=0
... W !," '^' TO STOP: " R Z:DTIME S:'$T!(Z["^") DONE=1
W !
Q
;
PSAOI ; -- set ORASK flags or show GenWrdInstructions for OI instance
I $$DUP^ORCD(PROMPT,ORI) K DONE W $C(7),!,"This component or test has already been selected!",! Q
N X0,NAME,ORT,ORWRD,WRD,I
S ORASK=+$G(^ORD(101.43,+$G(Y),"VB")),X0=$G(^(0)) ;VBEC OI
Q:ORASK Q:$G(ORESET)=+$G(Y) ;get ward instr for new tests
S NAME=$P(X0,U,8),ORT=+$$TEST^ORCSEND2(NAME) ;corresponding Lab OI
S ORT=+$P($G(^ORD(101.43,ORT,0)),U,2) ;#60 ien
D GCOM^LR7OR3(ORT,.ORWRD) S WRD="GenWardInstructions"
I $O(ORWRD(WRD,0)) W !! S I=0 F S I=$O(ORWRD(WRD,I)) Q:I'>0 W ORWRD(WRD,I,0),!
Q
;
MOD ; -- get allowable modifier values
Q:$G(ORDIALOG(PROMPT,"LIST")) N ORX,I,X
D GETLST^XPAR(.ORX,"ALL","OR VBECS MODIFIERS","Q")
S I=0 F S I=$O(ORX(I)) Q:I<1 D
. S X=$P($G(ORX(I)),U,2) Q:'$L(X)
. S ORDIALOG(PROMPT,"LIST",I)=X_U_X
. S ORDIALOG(PROMPT,"LIST","B",$$UP^XLFSTR(X))=X
S:ORX ORDIALOG(PROMPT,"LIST")=ORX_"^1"
Q
;
PSAMT ; -- Post-Selection Action for Amount, to validate and format
; only allow numeric entry for now, until GUI can accept volume
N X,X1,X2
I +Y'=Y W !,$C(7),"Enter the number of units needed, from 1-99." K DONE Q
S X=$$UP^XLFSTR(Y),X1=+X ;,X2=$$STRIP($P(X,X1,2))
;I X2="ML" S ORDIALOG(PROMPT,ORI)=X1_"ml" Q
I (X1<1)!(X1>99) W !,$C(7),"Enter the number of units needed, from 1-99." K DONE Q ;!("UNITS"'[X2)
S ORDIALOG(PROMPT,ORI)=X1 ;_" unit"_$S(X1>1:"s",1:"")
Q
;
SPCSTS ; -- set Specimen Status by component [Entry Action]
I '$G(ORASK) K ORDIALOG(PROMPT,INST) Q ;not a component
N OI,X S OI=+$G(ORDIALOG($$PTR("ORDERABLE ITEM"),INST))
S X=+$P($G(^ORD(101.43,OI,0)),U,2)
S ORDIALOG(PROMPT,INST)=$G(ORVB(X,"SPECIMEN"))_U_$G(ORVB("SPECIMEN"))
Q
;
EXOI ; -- setup dialog parameters for selected items
N ORI,X,X0,TEST,COMP
S (ORTAS,TEST,COMP)="" K ORASK
S ORI=0 F S ORI=$O(ORDIALOG(PROMPT,ORI)) Q:ORI<1 D
. S X=+$G(ORDIALOG(PROMPT,ORI)),X0=$G(^ORD(101.43,X,"VB")),X=+$P($G(^(0)),U,2)
. I $P(X0,U) S COMP=COMP_$S($L(COMP):U,1:"")_X Q
. S TEST=TEST_$S($L(TEST):U,1:"")_X S:$P(X0,U,2)>1 ORTAS=1
I ORTEST'=TEST S ORTEST=TEST K ORTEST("Lab CollSamp")
I ORCOMP'=COMP S ORCOMP=COMP D CHANGED:'FIRST,COMP:COMP
I ORCOMP,U[$G(ORVB("ABORH")),'ORTAS,$G(ORTYPE)'="Z" D ADDTAS
Q
;
COMP ; -- Handle component-specific tasks [from EXOI]
; Uses ORCOMP, ORVB(comp)
Q:$G(ORTYPE)="Z" ;QO editor
N ORP,ORI,ORT,ORTST,ORTMP,ORTDT,ORZ,ORHDR,OROOT,N
F ORI=1:1:$L(ORCOMP,U) S ORC=$P(ORCOMP,U,ORI) D
. S N=0 F S N=$O(ORVB(ORC,"TEST",N)) Q:N<1 S ORT=+$G(ORVB(ORC,"TEST",N)),ORTST(ORT)=""
. I $G(ORVB(ORC,"SPECIMEN")),$P($G(ORVB("SPECIMEN")),U,2)="",'ORTAS D ADDTAS
C1 S ORP=$$PTR("RESULTS"),(ORI,ORT)=0 F S ORT=+$O(ORTST(ORT)) Q:ORT<1 D
. K ^TMP("LRRR",$J) D RR^LR7OR1(+ORVP,,,,,ORT,,1)
. ;S ORTMP="^TMP(""LRRR"",$J,+ORVP)",ORTMP=$Q(@ORTMP)
. ;Q:$P(ORTMP,",",1,3)'=("^TMP(""LRRR"","_$J_","_+ORVP)
. S ORTMP=$$FIRST(+ORVP,ORT) Q:'$L(ORTMP)
. S ORTDT=9999999-+$P(ORTMP,",",5),ORZ=@ORTMP
. S ORI=ORI+1,ORDIALOG(ORP,ORI)=$P(ORZ,U,1,6)_U_ORTDT
. W:'$G(ORHDR) !!,"RECENT LAB RESULTS:",!,"Test Result Units Range Collected Accession Sts"
. W:'$G(ORHDR) !,"---- ------ ----- ----- --------- --------- ---"
. W !,$$PAD^ORCHTAB($P(ORZ,U,15),8)_$J($P(ORZ,U,2),9)_" "_$$PAD^ORCHTAB($P(ORZ,U,3),3)_$$PAD^ORCHTAB($P(ORZ,U,4),11)_$$PAD^ORCHTAB($P(ORZ,U,5),10)_$$DATETIME^ORCHTAB(ORTDT)_" "_$$PAD^ORCHTAB($P(ORZ,U,16),15)_$P(ORZ,U,6)
. S ORHDR=1,OROOT=$P(ORTMP,",",1,5)_",""N""" ;ck for comments
. F S ORTMP=$Q(@ORTMP) Q:$P(ORTMP,",",1,6)'=OROOT W !," "_@ORTMP
W:$G(ORHDR) ! K ^TMP("LRRR",$J)
W !!,"NOTE: The nursing blood administration order must be entered separately."
Q
;
FIRST(DFN,TEST) ; -- returns array reference to first data node
; in ^TMP("LRRR",$J,DFN) for TEST
N Y,IDT,DA S Y=""
S IDT=0 F S IDT=$O(^TMP("LRRR",$J,DFN,"CH",IDT)) Q:IDT<1 D Q:Y
. S DA=0 F S DA=$O(^TMP("LRRR",$J,DFN,"CH",IDT,DA)) Q:DA<1 I +$G(^(DA))=TEST S Y=1 Q
I Y S Y=$NA(^TMP("LRRR",$J,DFN,"CH",IDT,DA))
Q Y
;
ADDTAS ; -- adds T&S to order, sets ORTAS=1
; Expects PROMPT=OI, ORTEST
N ORI S ORI=$O(ORDIALOG(PROMPT,"?"),-1),ORI=ORI+1
S ORDIALOG(PROMPT,ORI)=+$O(^ORD(101.43,"ID","1;99VBC",0))
W !!,"Type & Screen added for new specimen."
S ORTAS=1,ORTEST=$G(ORTEST)_$S($L($G(ORTEST)):U,1:"")_"1"
Q
;
CHANGED ; -- Kill dependent values when Component changes
N PTR,I,J
F I="FREE TEXT","RESULTS" S PTR=$$PTR(I) I PTR D
. S J=0 F S J=$O(ORDIALOG(PTR,J)) Q:J<1 K ORDIALOG(PTR,J)
. K ORDIALOG(PTR,"LIST")
Q
;
DTW ; -- Comp D/T Wanted to specimen exp d/t for TAS [DTW Exit Action]
Q:'$G(ORVB("SPECIMEN")) Q:$G(ORTYPE)="Z"
N X,Y,%DT,EXP,OK
S X=$G(ORDIALOG(PROMPT,INST)),%DT="T" D ^%DT Q:Y<1
S EXP=$$HL7TFM^XLFDT(+$G(ORVB("SPECIMEN"))),OK=1
I EXP<Y D:'$G(ORTAS) ADDTAS S OK=0
D UID(OK) ;[re]set Specimen UID
Q
;
UID(OK) ; -- [re]set the Specimen UID if DTW changes
N SPCSTS,I,X
S SPCSTS=$$PTR("SPECIMEN STATUS")
S I=0 F S I=$O(ORDIALOG(SPCSTS,I)) Q:I<1 D
. S X=$P(ORDIALOG(SPCSTS,I),U)_U_$S($G(OK):$G(ORVB("SPECIMEN")),1:"^")
. S ORDIALOG(SPCSTS,I)=X
Q
;
REASON ; -- get allowable reasons
Q:$G(ORDIALOG(PROMPT,"LIST")) N ORX,I,X
D GETLST^XPAR(.ORX,"ALL","OR VBECS REASON FOR REQUEST","Q")
S I=0 F S I=$O(ORX(I)) Q:I<1 D
. S X=$P($G(ORX(I)),U,2) Q:'$L(X)
. S ORDIALOG(PROMPT,"LIST",I)=X_U_X
. S ORDIALOG(PROMPT,"LIST","B",$$UP^XLFSTR(X))=X
S:ORX ORDIALOG(PROMPT,"LIST")=ORX ;_"^1"
Q
;
ENTYPE ; -- set up Coll Type
I '$D(ORTEST("Lab CollSamp")) D
. N I,V,T,LC S LC=1
. F I=1:1:$L(ORTEST,U) S V=+$P(ORTEST,U,I) D Q:'LC ;no LC samp
.. S T=$$LAB60(V) ;VBECS ID -> #60 ien
.. I '$P($G(^LAB(60,T,0)),U,9) S LC=0 Q
. S ORTEST("Lab CollSamp")=LC
I '$D(ORTIME),'$D(ORIMTIME) D GETIMES^ORCDLR1
Q
;
LAB60(X) ; -- Return file 60 ien for VBECS OI ID
N Y,I,NM
S I=$O(^ORD(101.43,"ID",+X_";99VBC",0)),NM=$P($G(^ORD(101.43,+I,0)),U)_" - LAB"
S Y=+$O(^LAB(60,"B",NM,0))
Q Y
;
ENSURG ; -- Get list of surgeries from ORVB("SURGERY")
S:$P($G(^ORD(101.42,+$$VAL^ORCD("URGENCY"),0)),U,2)="P" REQD=1
Q:$G(ORDIALOG(PROMPT,"LIST")) K ORSURG
N I,CNT,X S (I,CNT)=0
F S I=$O(ORVB("SURGERY",I)) Q:I'>0 S X=$G(ORVB("SURGERY",I)) D
. S ORSURG($P(X,U))=$P(X,U,2),X=$P(X,U) ;ORSURG(name)=NoBloodReqd
. S CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=X_U_X
. S ORDIALOG(PROMPT,"LIST","B",$$UP^XLFSTR(X))=X
S:CNT ORDIALOG(PROMPT,"LIST")=CNT_"^1"
Q
;
CKMSBOS ; -- check if MSBOS limit exists, was exceeded [from PSA]
Q:'$L($G(Y)) N OI,AMT,I,X,COMP,LIMIT
I ORCOMP,$G(ORSURG($P(Y,U))) W !," >> No blood is required for this procedure!",! Q
S OI=$$PTR("ORDERABLE ITEM"),AMT=$$PTR("AMOUNT")
S I=0 F S I=$O(ORDIALOG(OI,I)) Q:I<1 D
. S X=ORDIALOG(OI,I),COMP=+$P($G(^ORD(101.43,+X,0)),U,2)
. S LIMIT=$G(ORMSBOS(COMP,$P(Y,U))) Q:LIMIT=""
. Q:$G(ORDIALOG(AMT,I))'>LIMIT
. W !," >> Requested #units of "_$P($G(^ORD(101.43,+X,0)),U)_" exceeds MSBOS limit of "_LIMIT_"!",!
Q
;
ENURG ; -- Get list of urgencies from #101.42, parameter
Q:$G(ORDIALOG(PROMPT,"LIST")) N I,CNT,X S CNT=0
S X="" F S X=$O(^ORD(101.42,"S.VBEC",X)) Q:X="" D
. ;I X="STAT" Q:'$$GET^XPAR("ALL","OR VBECS STAT USER")
. ;I X="STAT",'$D(^XUSEC("ORES",DUZ)),'$D(^XUSEC("ORELSE",DUZ)) Q
. S I=0 F S I=$O(^ORD(101.42,"S.VBEC",X,I)) Q:I<1 D
.. S CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=I_U_X
.. S ORDIALOG(PROMPT,"LIST","B",$$UP^XLFSTR(X))=I
S:CNT ORDIALOG(PROMPT,"LIST")=CNT_"^1"
Q
;
ASKURG() ; -- ask unless PreOp, set default
N Y S Y=1
I FIRST,'$D(ORDIALOG(PROMPT,INST)),$G(ORTYPE)'="Z" D
. I $$PREOP S ORDIALOG(PROMPT,INST)=+$O(^ORD(101.42,"C","P",0)),Y=0 Q
. S ORDIALOG(PROMPT,INST)=9 ;default
Q Y
;
PREOP() ; -- Returns 1 or 0, if order is for pre-op
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
S DIR(0)="YAO",DIR("A")="Is this order for pre-op? "
S DIR("?")="If YES, the urgency will be set to PRE-OP and a surgery name will be required"
S DIR("B")="NO" D ^DIR S:$D(DTOUT)!($D(DUOUT)) ORQUIT=1
Q +Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCDVBEC 10230 printed Dec 13, 2024@02:28:17 Page 2
ORCDVBEC ;SLC/MKB-Utility functions for VBECS dialogs ;2/11/08 11:04
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**212,309,332**;Dec 17, 1997;Build 44
+2 ;
+3 ; External References:
+4 ; OEAPI^VBECA3 #4766
+5 ; RR^LR7OR1 #2503
+6 ; GCOM^LR7OR3 #2428
+7 ; $$SITE^VASITE #10112
+8 ; $$HL7TFM^XLFDT #10103
+9 ; $$UP^XLFSTR #10104
+10 ;
PTR(X) ; -- Returns pointer to #101.41 of prompt OR GTX X
+1 QUIT +$ORDER(^ORD(101.41,"AB","OR GTX "_X,0))
+2 ;
EN ; -- entry action
+1 IF '$LENGTH($TEXT(OEAPI^VBECA3))
WRITE $CHAR(7),!!,"Blood Bank orders are not available yet!"
HANG 2
SET ORQUIT=1
QUIT
+2 NEW DIV,ORSTN,C,N,X
SET DIV=+$PIECE($GET(^SC(+$GET(ORL),0)),U,15)
+3 SET ORSTN=$PIECE($$SITE^VASITE(DT,DIV),U,3)
+4 IF $GET(ORTYPE)'="Z"
DO OEAPI^VBECA3(.ORVB,+ORVP,ORSTN)
DO PTINFO^ORCDVBC1
+5 ;assume no specimen if delayed
IF $GET(OREVENT)
SET ORVB("SPECIMEN")=""
+6 ;sort
SET C=0
FOR
SET C=$ORDER(ORVB(C))
if C<1
QUIT
SET N=0
FOR
SET N=$ORDER(ORVB(C,"MSBOS",N))
if N<1
QUIT
SET X=$GET(ORVB(C,"MSBOS",N))
SET ORMSBOS(C,$PIECE(X,U))=$PIECE(X,U,2)
+7 ;get initial state: ORCOMP/ORTEST = id^id^ ^id, ORTAS = 1 or 0:
+8 SET (ORCOMP,ORTEST,ORTAS)=""
IF $DATA(OREDIT)!$GET(OREWRITE)
Begin DoDot:1
+9 NEW P,I,X,X0
SET P=$$PTR("ORDERABLE ITEM")
+10 SET I=0
FOR
SET I=$ORDER(ORDIALOG(P,I))
if I<1
QUIT
SET X=+$GET(ORDIALOG(P,I))
Begin DoDot:2
+11 SET X0=$GET(^ORD(101.43,X,"VB"))
SET X=+$PIECE($GET(^(0)),U,2)
+12 IF $PIECE(X0,U)
SET ORCOMP=ORCOMP_$SELECT($LENGTH(ORCOMP):U,1:"")_X
QUIT
+13 SET ORTEST=ORTEST_$SELECT($LENGTH(ORTEST):U,1:"")_X
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
EX ; -- exit action
+1 KILL ORITM,ORCOMP,ORTEST,ORTAS,ORMSBOS,ORTIME,ORIMTIME,ORDIV,ORCOLLCT,ORVB,ORASK,ORSURG
+2 IF $GET(ORXL)
SET ORL=ORXL
KILL ORXL
+3 QUIT
+4 ;
XHELP ; -- display OI's in groups
+1 NEW INDEX,CNT,SCREEN,X,Y,SYN,Y0,D,Z,DONE
+2 SET CNT=1
SET SCREEN=$GET(ORDIALOG(PROMPT,"S"))
+3 FOR INDEX="S.VBC","S.VBT"
Begin DoDot:1
+4 WRITE !!,$SELECT(INDEX["C":"Choose from Blood Components:",1:"or Diagnostic Tests:")
+5 SET X=""
FOR
SET X=$ORDER(^ORD(101.43,INDEX,X))
if X=""
QUIT
SET Y=0
Begin DoDot:2
+6 FOR
SET Y=$ORDER(^ORD(101.43,INDEX,X,Y))
if Y'>0
QUIT
SET SYN=$GET(^(Y))
IF 'SYN
Begin DoDot:3
+7 SET Y0=$GET(^ORD(101.43,Y,0))
SET D=INDEX
if $LENGTH(SCREEN)
XECUTE SCREEN
if '$TEST
QUIT
+8 ;W:SYN " "_$P(SYN,U,4) ; echo .01 if synonym
WRITE !," "_X
+9 SET CNT=CNT+1
if CNT'>(IOSL-5)
QUIT
SET CNT=0
+10 WRITE !," '^' TO STOP: "
READ Z:DTIME
if '$TEST!(Z["^")
SET DONE=1
End DoDot:3
if $GET(DONE)
QUIT
End DoDot:2
if $GET(DONE)
QUIT
End DoDot:1
if $GET(DONE)
QUIT
+11 WRITE !
+12 QUIT
+13 ;
PSAOI ; -- set ORASK flags or show GenWrdInstructions for OI instance
+1 IF $$DUP^ORCD(PROMPT,ORI)
KILL DONE
WRITE $CHAR(7),!,"This component or test has already been selected!",!
QUIT
+2 NEW X0,NAME,ORT,ORWRD,WRD,I
+3 ;VBEC OI
SET ORASK=+$GET(^ORD(101.43,+$GET(Y),"VB"))
SET X0=$GET(^(0))
+4 ;get ward instr for new tests
if ORASK
QUIT
if $GET(ORESET)=+$GET(Y)
QUIT
+5 ;corresponding Lab OI
SET NAME=$PIECE(X0,U,8)
SET ORT=+$$TEST^ORCSEND2(NAME)
+6 ;#60 ien
SET ORT=+$PIECE($GET(^ORD(101.43,ORT,0)),U,2)
+7 DO GCOM^LR7OR3(ORT,.ORWRD)
SET WRD="GenWardInstructions"
+8 IF $ORDER(ORWRD(WRD,0))
WRITE !!
SET I=0
FOR
SET I=$ORDER(ORWRD(WRD,I))
if I'>0
QUIT
WRITE ORWRD(WRD,I,0),!
+9 QUIT
+10 ;
MOD ; -- get allowable modifier values
+1 if $GET(ORDIALOG(PROMPT,"LIST"))
QUIT
NEW ORX,I,X
+2 DO GETLST^XPAR(.ORX,"ALL","OR VBECS MODIFIERS","Q")
+3 SET I=0
FOR
SET I=$ORDER(ORX(I))
if I<1
QUIT
Begin DoDot:1
+4 SET X=$PIECE($GET(ORX(I)),U,2)
if '$LENGTH(X)
QUIT
+5 SET ORDIALOG(PROMPT,"LIST",I)=X_U_X
+6 SET ORDIALOG(PROMPT,"LIST","B",$$UP^XLFSTR(X))=X
End DoDot:1
+7 if ORX
SET ORDIALOG(PROMPT,"LIST")=ORX_"^1"
+8 QUIT
+9 ;
PSAMT ; -- Post-Selection Action for Amount, to validate and format
+1 ; only allow numeric entry for now, until GUI can accept volume
+2 NEW X,X1,X2
+3 IF +Y'=Y
WRITE !,$CHAR(7),"Enter the number of units needed, from 1-99."
KILL DONE
QUIT
+4 ;,X2=$$STRIP($P(X,X1,2))
SET X=$$UP^XLFSTR(Y)
SET X1=+X
+5 ;I X2="ML" S ORDIALOG(PROMPT,ORI)=X1_"ml" Q
+6 ;!("UNITS"'[X2)
IF (X1<1)!(X1>99)
WRITE !,$CHAR(7),"Enter the number of units needed, from 1-99."
KILL DONE
QUIT
+7 ;_" unit"_$S(X1>1:"s",1:"")
SET ORDIALOG(PROMPT,ORI)=X1
+8 QUIT
+9 ;
SPCSTS ; -- set Specimen Status by component [Entry Action]
+1 ;not a component
IF '$GET(ORASK)
KILL ORDIALOG(PROMPT,INST)
QUIT
+2 NEW OI,X
SET OI=+$GET(ORDIALOG($$PTR("ORDERABLE ITEM"),INST))
+3 SET X=+$PIECE($GET(^ORD(101.43,OI,0)),U,2)
+4 SET ORDIALOG(PROMPT,INST)=$GET(ORVB(X,"SPECIMEN"))_U_$GET(ORVB("SPECIMEN"))
+5 QUIT
+6 ;
EXOI ; -- setup dialog parameters for selected items
+1 NEW ORI,X,X0,TEST,COMP
+2 SET (ORTAS,TEST,COMP)=""
KILL ORASK
+3 SET ORI=0
FOR
SET ORI=$ORDER(ORDIALOG(PROMPT,ORI))
if ORI<1
QUIT
Begin DoDot:1
+4 SET X=+$GET(ORDIALOG(PROMPT,ORI))
SET X0=$GET(^ORD(101.43,X,"VB"))
SET X=+$PIECE($GET(^(0)),U,2)
+5 IF $PIECE(X0,U)
SET COMP=COMP_$SELECT($LENGTH(COMP):U,1:"")_X
QUIT
+6 SET TEST=TEST_$SELECT($LENGTH(TEST):U,1:"")_X
if $PIECE(X0,U,2)>1
SET ORTAS=1
End DoDot:1
+7 IF ORTEST'=TEST
SET ORTEST=TEST
KILL ORTEST("Lab CollSamp")
+8 IF ORCOMP'=COMP
SET ORCOMP=COMP
if 'FIRST
DO CHANGED
if COMP
DO COMP
+9 IF ORCOMP
IF U[$GET(ORVB("ABORH"))
IF 'ORTAS
IF $GET(ORTYPE)'="Z"
DO ADDTAS
+10 QUIT
+11 ;
COMP ; -- Handle component-specific tasks [from EXOI]
+1 ; Uses ORCOMP, ORVB(comp)
+2 ;QO editor
if $GET(ORTYPE)="Z"
QUIT
+3 NEW ORP,ORI,ORT,ORTST,ORTMP,ORTDT,ORZ,ORHDR,OROOT,N
+4 FOR ORI=1:1:$LENGTH(ORCOMP,U)
SET ORC=$PIECE(ORCOMP,U,ORI)
Begin DoDot:1
+5 SET N=0
FOR
SET N=$ORDER(ORVB(ORC,"TEST",N))
if N<1
QUIT
SET ORT=+$GET(ORVB(ORC,"TEST",N))
SET ORTST(ORT)=""
+6 IF $GET(ORVB(ORC,"SPECIMEN"))
IF $PIECE($GET(ORVB("SPECIMEN")),U,2)=""
IF 'ORTAS
DO ADDTAS
End DoDot:1
C1 SET ORP=$$PTR("RESULTS")
SET (ORI,ORT)=0
FOR
SET ORT=+$ORDER(ORTST(ORT))
if ORT<1
QUIT
Begin DoDot:1
+1 KILL ^TMP("LRRR",$JOB)
DO RR^LR7OR1(+ORVP,,,,,ORT,,1)
+2 ;S ORTMP="^TMP(""LRRR"",$J,+ORVP)",ORTMP=$Q(@ORTMP)
+3 ;Q:$P(ORTMP,",",1,3)'=("^TMP(""LRRR"","_$J_","_+ORVP)
+4 SET ORTMP=$$FIRST(+ORVP,ORT)
if '$LENGTH(ORTMP)
QUIT
+5 SET ORTDT=9999999-+$PIECE(ORTMP,",",5)
SET ORZ=@ORTMP
+6 SET ORI=ORI+1
SET ORDIALOG(ORP,ORI)=$PIECE(ORZ,U,1,6)_U_ORTDT
+7 if '$GET(ORHDR)
WRITE !!,"RECENT LAB RESULTS:",!,"Test Result Units Range Collected Accession Sts"
+8 if '$GET(ORHDR)
WRITE !,"---- ------ ----- ----- --------- --------- ---"
+9 WRITE !,$$PAD^ORCHTAB($PIECE(ORZ,U,15),8)_$JUSTIFY($PIECE(ORZ,U,2),9)_" "_$$PAD^ORCHTAB($PIECE(ORZ,U,3),3)_$$PAD^ORCHTAB($PIECE(ORZ,U,4),11)_$$PAD^ORCHTAB($PIECE(ORZ,U,5),10)_$$DATETIME^ORCHTAB(ORTDT)_" "_$$PAD^ORCHTAB($PIECE(ORZ,U,16),
15)_...
... $PIECE(ORZ,U,6)
+10 ;ck for comments
SET ORHDR=1
SET OROOT=$PIECE(ORTMP,",",1,5)_",""N"""
+11 FOR
SET ORTMP=$QUERY(@ORTMP)
if $PIECE(ORTMP,",",1,6)'=OROOT
QUIT
WRITE !," "_@ORTMP
End DoDot:1
+12 if $GET(ORHDR)
WRITE !
KILL ^TMP("LRRR",$JOB)
+13 WRITE !!,"NOTE: The nursing blood administration order must be entered separately."
+14 QUIT
+15 ;
FIRST(DFN,TEST) ; -- returns array reference to first data node
+1 ; in ^TMP("LRRR",$J,DFN) for TEST
+2 NEW Y,IDT,DA
SET Y=""
+3 SET IDT=0
FOR
SET IDT=$ORDER(^TMP("LRRR",$JOB,DFN,"CH",IDT))
if IDT<1
QUIT
Begin DoDot:1
+4 SET DA=0
FOR
SET DA=$ORDER(^TMP("LRRR",$JOB,DFN,"CH",IDT,DA))
if DA<1
QUIT
IF +$GET(^(DA))=TEST
SET Y=1
QUIT
End DoDot:1
if Y
QUIT
+5 IF Y
SET Y=$NAME(^TMP("LRRR",$JOB,DFN,"CH",IDT,DA))
+6 QUIT Y
+7 ;
ADDTAS ; -- adds T&S to order, sets ORTAS=1
+1 ; Expects PROMPT=OI, ORTEST
+2 NEW ORI
SET ORI=$ORDER(ORDIALOG(PROMPT,"?"),-1)
SET ORI=ORI+1
+3 SET ORDIALOG(PROMPT,ORI)=+$ORDER(^ORD(101.43,"ID","1;99VBC",0))
+4 WRITE !!,"Type & Screen added for new specimen."
+5 SET ORTAS=1
SET ORTEST=$GET(ORTEST)_$SELECT($LENGTH($GET(ORTEST)):U,1:"")_"1"
+6 QUIT
+7 ;
CHANGED ; -- Kill dependent values when Component changes
+1 NEW PTR,I,J
+2 FOR I="FREE TEXT","RESULTS"
SET PTR=$$PTR(I)
IF PTR
Begin DoDot:1
+3 SET J=0
FOR
SET J=$ORDER(ORDIALOG(PTR,J))
if J<1
QUIT
KILL ORDIALOG(PTR,J)
+4 KILL ORDIALOG(PTR,"LIST")
End DoDot:1
+5 QUIT
+6 ;
DTW ; -- Comp D/T Wanted to specimen exp d/t for TAS [DTW Exit Action]
+1 if '$GET(ORVB("SPECIMEN"))
QUIT
if $GET(ORTYPE)="Z"
QUIT
+2 NEW X,Y,%DT,EXP,OK
+3 SET X=$GET(ORDIALOG(PROMPT,INST))
SET %DT="T"
DO ^%DT
if Y<1
QUIT
+4 SET EXP=$$HL7TFM^XLFDT(+$GET(ORVB("SPECIMEN")))
SET OK=1
+5 IF EXP<Y
if '$GET(ORTAS)
DO ADDTAS
SET OK=0
+6 ;[re]set Specimen UID
DO UID(OK)
+7 QUIT
+8 ;
UID(OK) ; -- [re]set the Specimen UID if DTW changes
+1 NEW SPCSTS,I,X
+2 SET SPCSTS=$$PTR("SPECIMEN STATUS")
+3 SET I=0
FOR
SET I=$ORDER(ORDIALOG(SPCSTS,I))
if I<1
QUIT
Begin DoDot:1
+4 SET X=$PIECE(ORDIALOG(SPCSTS,I),U)_U_$SELECT($GET(OK):$GET(ORVB("SPECIMEN")),1:"^")
+5 SET ORDIALOG(SPCSTS,I)=X
End DoDot:1
+6 QUIT
+7 ;
REASON ; -- get allowable reasons
+1 if $GET(ORDIALOG(PROMPT,"LIST"))
QUIT
NEW ORX,I,X
+2 DO GETLST^XPAR(.ORX,"ALL","OR VBECS REASON FOR REQUEST","Q")
+3 SET I=0
FOR
SET I=$ORDER(ORX(I))
if I<1
QUIT
Begin DoDot:1
+4 SET X=$PIECE($GET(ORX(I)),U,2)
if '$LENGTH(X)
QUIT
+5 SET ORDIALOG(PROMPT,"LIST",I)=X_U_X
+6 SET ORDIALOG(PROMPT,"LIST","B",$$UP^XLFSTR(X))=X
End DoDot:1
+7 ;_"^1"
if ORX
SET ORDIALOG(PROMPT,"LIST")=ORX
+8 QUIT
+9 ;
ENTYPE ; -- set up Coll Type
+1 IF '$DATA(ORTEST("Lab CollSamp"))
Begin DoDot:1
+2 NEW I,V,T,LC
SET LC=1
+3 ;no LC samp
FOR I=1:1:$LENGTH(ORTEST,U)
SET V=+$PIECE(ORTEST,U,I)
Begin DoDot:2
+4 ;VBECS ID -> #60 ien
SET T=$$LAB60(V)
+5 IF '$PIECE($GET(^LAB(60,T,0)),U,9)
SET LC=0
QUIT
End DoDot:2
if 'LC
QUIT
+6 SET ORTEST("Lab CollSamp")=LC
End DoDot:1
+7 IF '$DATA(ORTIME)
IF '$DATA(ORIMTIME)
DO GETIMES^ORCDLR1
+8 QUIT
+9 ;
LAB60(X) ; -- Return file 60 ien for VBECS OI ID
+1 NEW Y,I,NM
+2 SET I=$ORDER(^ORD(101.43,"ID",+X_";99VBC",0))
SET NM=$PIECE($GET(^ORD(101.43,+I,0)),U)_" - LAB"
+3 SET Y=+$ORDER(^LAB(60,"B",NM,0))
+4 QUIT Y
+5 ;
ENSURG ; -- Get list of surgeries from ORVB("SURGERY")
+1 if $PIECE($GET(^ORD(101.42,+$$VAL^ORCD("URGENCY"),0)),U,2)="P"
SET REQD=1
+2 if $GET(ORDIALOG(PROMPT,"LIST"))
QUIT
KILL ORSURG
+3 NEW I,CNT,X
SET (I,CNT)=0
+4 FOR
SET I=$ORDER(ORVB("SURGERY",I))
if I'>0
QUIT
SET X=$GET(ORVB("SURGERY",I))
Begin DoDot:1
+5 ;ORSURG(name)=NoBloodReqd
SET ORSURG($PIECE(X,U))=$PIECE(X,U,2)
SET X=$PIECE(X,U)
+6 SET CNT=CNT+1
SET ORDIALOG(PROMPT,"LIST",CNT)=X_U_X
+7 SET ORDIALOG(PROMPT,"LIST","B",$$UP^XLFSTR(X))=X
End DoDot:1
+8 if CNT
SET ORDIALOG(PROMPT,"LIST")=CNT_"^1"
+9 QUIT
+10 ;
CKMSBOS ; -- check if MSBOS limit exists, was exceeded [from PSA]
+1 if '$LENGTH($GET(Y))
QUIT
NEW OI,AMT,I,X,COMP,LIMIT
+2 IF ORCOMP
IF $GET(ORSURG($PIECE(Y,U)))
WRITE !," >> No blood is required for this procedure!",!
QUIT
+3 SET OI=$$PTR("ORDERABLE ITEM")
SET AMT=$$PTR("AMOUNT")
+4 SET I=0
FOR
SET I=$ORDER(ORDIALOG(OI,I))
if I<1
QUIT
Begin DoDot:1
+5 SET X=ORDIALOG(OI,I)
SET COMP=+$PIECE($GET(^ORD(101.43,+X,0)),U,2)
+6 SET LIMIT=$GET(ORMSBOS(COMP,$PIECE(Y,U)))
if LIMIT=""
QUIT
+7 if $GET(ORDIALOG(AMT,I))'>LIMIT
QUIT
+8 WRITE !," >> Requested #units of "_$PIECE($GET(^ORD(101.43,+X,0)),U)_" exceeds MSBOS limit of "_LIMIT_"!",!
End DoDot:1
+9 QUIT
+10 ;
ENURG ; -- Get list of urgencies from #101.42, parameter
+1 if $GET(ORDIALOG(PROMPT,"LIST"))
QUIT
NEW I,CNT,X
SET CNT=0
+2 SET X=""
FOR
SET X=$ORDER(^ORD(101.42,"S.VBEC",X))
if X=""
QUIT
Begin DoDot:1
+3 ;I X="STAT" Q:'$$GET^XPAR("ALL","OR VBECS STAT USER")
+4 ;I X="STAT",'$D(^XUSEC("ORES",DUZ)),'$D(^XUSEC("ORELSE",DUZ)) Q
+5 SET I=0
FOR
SET I=$ORDER(^ORD(101.42,"S.VBEC",X,I))
if I<1
QUIT
Begin DoDot:2
+6 SET CNT=CNT+1
SET ORDIALOG(PROMPT,"LIST",CNT)=I_U_X
+7 SET ORDIALOG(PROMPT,"LIST","B",$$UP^XLFSTR(X))=I
End DoDot:2
End DoDot:1
+8 if CNT
SET ORDIALOG(PROMPT,"LIST")=CNT_"^1"
+9 QUIT
+10 ;
ASKURG() ; -- ask unless PreOp, set default
+1 NEW Y
SET Y=1
+2 IF FIRST
IF '$DATA(ORDIALOG(PROMPT,INST))
IF $GET(ORTYPE)'="Z"
Begin DoDot:1
+3 IF $$PREOP
SET ORDIALOG(PROMPT,INST)=+$ORDER(^ORD(101.42,"C","P",0))
SET Y=0
QUIT
+4 ;default
SET ORDIALOG(PROMPT,INST)=9
End DoDot:1
+5 QUIT Y
+6 ;
PREOP() ; -- Returns 1 or 0, if order is for pre-op
+1 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+2 SET DIR(0)="YAO"
SET DIR("A")="Is this order for pre-op? "
+3 SET DIR("?")="If YES, the urgency will be set to PRE-OP and a surgery name will be required"
+4 SET DIR("B")="NO"
DO ^DIR
if $DATA(DTOUT)!($DATA(DUOUT))
SET ORQUIT=1
+5 QUIT +Y
