ORWDXM4 ; SLC/KCM - Order Dialogs, Menus;05/09/17 ;Jun 21, 2022@14:26:46
;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,215,296,280,394,350,434,569**;Dec 17, 1997;Build 23
;
SETUP ; -- setup dialog (continued from ORWDXM1)
; if xfer med order, setup ORDIALOG differently
I ORWMODE,$$ISMED(ORIT),$$CHGSTS(ORCAT,ORIT) D MEDXFER Q
; get base dialog (based on display group) & location of responses
I ORWMODE D
. S ORDG=$P(^OR(100,+ORIT,0),U,11),ORDIALOG=+$P(^(0),U,5)
. S RSPREF="^OR(100,"_+ORIT_",4.5)"
E D
. N X0 S X0=$G(^ORD(101.41,ORIT,0))
. S ORDIALOG=$S($P(X0,U,4)="D":ORIT,1:0)
. S ORDG=$P(X0,U,5) Q:'ORDG
. I 'ORDIALOG S ORDIALOG=+$$DEFDLG^ORWDXQ(ORDG)
. S RSPREF="^ORD(101.41,"_ORIT_",6)"
; setup the ORDIALOG array
D GETDLG^ORCD(ORDIALOG)
D GETORDER^ORCD(RSPREF)
Q
SETUPS ; -- setup for specific types of dialogs (continued from ORWDXM1)
; pharmacy uses ORCAT to know order package
I ORDIALOG=$O(^ORD(101.41,"B","PSO OERR",0)) S ORCAT="O"
I ORDIALOG=$O(^ORD(101.41,"B","PSJ OR PAT OE",0)) D
. I ORCAT="O",'ORIMO S ORWPSWRG="" ; not auto-ack, pt not inpt
. S ORCAT="I"
I ORCAT="O",$D(OREVENT("EFFECTIVE")),(ORDG=+$O(^ORD(100.98,"B","O RX",0))) D
. S ORDIALOG($O(^ORD(101.41,"B",X,0)),1)=OREVENT("EFFECTIVE")
;p394 force interactive dialog for imaging QO for female of child-bearing age.
N ORRAORD S ORRAORD=0 ;set is radiology flag to false (0)
I ORDIALOG=$O(^ORD(101.41,"B","RA OERR EXAM",0)) D
. N ORPRMPT1,ORPRMPT2,ORCODE S ORRAORD=1
. Q:($G(ORTYPE)'="Q")!($G(ORSEX)'="F")
. S ORPRMPT1=$O(^ORD(101.41,"B","OR GTX PREGNANT",0)),ORPRMPT2=$P($G(ORDIALOG(ORPRMPT1)),"^")
. S ORCODE=$G(^ORD(101.41,ORDIALOG,10,ORPRMPT2,7)) N Y S Y="Y" X ORCODE K ORCODE
. S:Y="Y" ORWPSWRG="" ;
I ORRAORD D RA^ORWDXM2 G XENV
I ORDIALOG=$O(^ORD(101.41,"B","LR OTHER LAB TESTS",0)) D LR^ORWDXM2 G XENV
I ORDIALOG=$O(^ORD(101.41,"B","LR OTHER LAB AP TESTS",0)) D LR^ORWDXM2 G XENV
I ORDIALOG=$O(^ORD(101.41,"B","FHW1",0)) D DO^ORWDXM2 G XENV
I ORDIALOG=$O(^ORD(101.41,"B","FHW2",0)) D EL^ORWDXM2 G XENV
I ORDIALOG=$O(^ORD(101.41,"B","PSJ OR PAT OE",0)) D UD^ORWDXM2 G XENV
I ORDIALOG=$O(^ORD(101.41,"B","PSJ OR CLINIC OE",0)) D UD^ORWDXM2 G XENV
I ORDIALOG=$O(^ORD(101.41,"B","PSJI OR PAT FLUID OE",0)) D IV^ORWDXM2 G XENV
I ORDIALOG=$O(^ORD(101.41,"B","CLINIC OR PAT FLUID OE",0)) D IV^ORWDXM2 G XENV
I ORDIALOG=$O(^ORD(101.41,"B","PSO OERR",0)) D OP^ORWDXM2 G XENV
I ORDIALOG=$O(^ORD(101.41,"B","PSO SUPPLY",0)) D OP^ORWDXM2 G XENV
I ORDIALOG=$O(^ORD(101.41,"B","PS MEDS",0)) D PS^ORWDPS3 G XENV
I ORDIALOG=$O(^ORD(101.41,"B","VBEC BLOOD BANK",0)) D VB^ORWDXM4 G XENV
I ORDIALOG=$O(^ORD(101.41,"B","SD RTC",0)) D RTC^ORWDSD1 G XENV
I ORDIALOG=$O(^ORD(101.41,"B","GMRAOR ALLERGY ENTER/EDIT",0)) S ORQUIT=1
XENV ; end case
Q
MEDXFER ; -- setup ORDIALOG for a med that is transferred (from SETUP)
;
; use ORWDPS3 if OR*3*94 installed
I ORWP94 G MEDXFER^ORWDPS3
;
N UDLG,FDLG,ODLG,DLG,OI K ^TMP("PS",$J)
S UDLG=$O(^ORD(101.41,"AB","PSJ OR PAT OE",0))
S FDLG=$O(^ORD(101.41,"AB","PSJI OR PAT FLUID OE",0))
S ODLG=$O(^ORD(101.41,"AB","PSO OERR",0))
S DLG=$P($G(^OR(100,+ORIT,0)),U,5)
S ORDIALOG=$S(+DLG=UDLG:ODLG,+DLG=ODLG:UDLG,+DLG=FDLG:FDLG,1:0)
I 'ORDIALOG D SETERR(ORIT,"Incomplete Order Record") Q
S ORDG=+$P(^ORD(101.41,ORDIALOG,0),U,5)
D GETDLG^ORCD(ORDIALOG)
D GETORDER^ORCD("^OR(100,"_+ORIT_",4.5)")
S OI=$$VAL^ORCD("MEDICATION")
I '$$MEDOK(OI,ORCAT) D SETERR(ORIT,"This may not be ordered as an "_$S(ORCAT="I":"in",1:"out")_"patient drug.") Q
I $G(^ORD(101.43,OI,.1)),(^(.1)<$$NOW^XLFDT) D SETERR(ORIT,"This may no longer be ordered.") Q
K ORDIALOG($$PTR("DISPENSE DRUG"),1)
K ORDIALOG($$PTR("WORD PROCESSING 1"),1)
I ORDIALOG=ODLG D IN2OUT ; could call IN^ORCMED except for writes
I ORDIALOG=UDLG D OUT2IN ; could call OUT^ORCMED except for writes
Q
IN2OUT ; -- make inpatient responses into outpatient
N I,DDRUG,PKGID,DOSE
S DOSE=$G(ORDIALOG($$PTR("INSTRUCTIONS"),1))
F I="INSTRUCTIONS","UNITS/DOSE","FREE TEXT","DISPENSE DRUG" K ORDIALOG($$PTR(I),1)
S PKGID=$G(^OR(100,+ORIT,4))_";"_$P(^(0),U,12)
D OEL^PSOORRL(+ORVP,PKGID) S DDRUG=$G(^TMP("PS",$J,"DD",1,0))
I $P(DDRUG,U,3) S ORDIALOG($$PTR("DISPENSE DRUG"),1)=$P(DDRUG,U,3)
; keep instructions if IV med, otherwise use units returned
I $P($G(^ORD(101.43,OI,"PS")),U)=2 S ORDIALOG($$PTR("INSTRUCTIONS"),1)=DOSE
E S:$P(DDRUG,U,2) ORDIALOG($$PTR("INSTRUCTIONS"),1)=$P(DDRUG,U,2)
; change orderable item if new orderable item returned
I $P(DDRUG,U,4),$P(DDRUG,U,4)'=+$P($G(^ORD(101.43,OI,0)),U,2) D
. S OI=+$O(^ORD(101.43,"ID",+$P(DDRUG,U,4)_";99PSP",0))
. S:OI ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI
Q
OUT2IN ; make outpatient responses into inpatient
N ORP,ORI,PROMPT,PKGID,DDRUG,ONE
D CHANGED^ORCDPS("XFR") ; Kill extra values not in inpt dialog
S PKGID=$G(^OR(100,+ORIT,4))_";"_$P(^(0),U,12)
D OEL^PSOORRL(+ORVP,PKGID) S DDRUG=$G(^TMP("PS",$J,"DD",1,0))
S:$P(DDRUG,U,3) ORDIALOG($$PTR("DISPENSE DRUG"),1)=$P(DDRUG,U,3)
I $P(DDRUG,U,4),$P(DDRUG,U,4)'=+$P($G(^ORD(101.43,+OI,0)),U,2) D
. S OI=+$O(^ORD(101.43,"ID",+$P(DDRUG,U,4)_";99PSP",0))
. S:OI ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI
S ONE=$O(ORDIALOG($$PTR("INSTRUCTIONS"),0)) ; first inst
F ORP="ROUTE","SCHEDULE" D
. S ORI=0,PROMPT=$$PTR(ORP)
. F S ORI=$O(ORDIALOG(PROMPT,ORI)) Q:ORI'>0 I ORDIALOG(PROMPT,ORI)=""!(ORI>ONE) K ORDIALOG(PROMPT,ORI)
Q
PTR(NAME) ; -- Returns pointer to OR GTX NAME (copied from ORCMED)
Q +$O(^ORD(101.41,"AB",$E("OR GTX "_NAME,1,63),0))
;
MEDOK(OI,CAT) ; return 1 if med may be ordered for this patient category
N P S P=$S(CAT="I":1,1:2)
Q $P($G(^ORD(101.43,+OI,"PS")),U,P)
;
CHGSTS(ECAT,IFN) ; return 1 if out to in or in to out
N OCAT
S OCAT=$P($G(^OR(100,+IFN,0)),U,12)
Q OCAT'=ECAT
;
ISMED(IFN) ; return 1 if this is a pharmacy order
N PKG S PKG=$P($G(^OR(100,+IFN,0)),U,14)
Q $$NMSP^ORCD(PKG)="PS"
SETERR(ID,X) ; sets LST to rejection with error message
D GETTXT^ORWORR(.LST,ID)
S LST(0)="8^0",LST(.5)=X,LST(.6)=""
Q
VB ; setup environment for VBECS
; -- setup ORTIME, ORIMTIME arrays
D GETIMES^ORCDLR1
; -- setup ORCOMP, ORTEST, and ORTAS
S (ORCOMP,ORTEST,ORTAS)=""
N P,PROMPT,I,X,X0
S P=+$O(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM",0))
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
. I X=2 S ORTAS=1
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^ORCDVBEC(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
S PROMPT=$O(^ORD(101.41,"B","OR GTX COLLECTION TYPE",0))
I $D(ORDIALOG(PROMPT,1)) S ORCOLLCT=ORDIALOG(PROMPT,1) I 1
E S EDITONLY=0,ORCOLLCT=$$COLLTYPE^ORCDLR1
I ORCOLLCT="I" D
. S PROMPT=$O(^ORD(101.41,"B","OR GTX START DATE/TIME",0))
. D LRICTMOK^ORWDXM2
Q
VBASK(I) ; set the ORASK variable for child component prompts in VBECS order
I ORDIALOG'=$O(^ORD(101.41,"B","VBEC BLOOD BANK",0)) Q
N P S P=+$O(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM",0))
N OI S OI=+$G(ORDIALOG(P,I))
I +$G(^ORD(101.43,+$G(OI),"VB")) S ORASK=1
Q
VBQO(IFN) ;Check to see if it's a good VBECS QO
;regular order treated as good QO
;
I $P($G(^ORD(101.41,IFN,0)),U,4)'="Q" Q 1
N ODP,ODG,RESULT,P,TNS,I
S RESULT=0
S ODP=+$P($G(^ORD(101.41,IFN,0)),U,7),ODG=+$P($G(^(0)),U,5)
S ODP=$$GET1^DIQ(9.4,+ODP_",",1),ODG=$P($G(^ORD(100.98,ODG,0)),U,3)
I ODP'["VBEC" Q 1
Q RESULT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWDXM4 7872 printed Oct 16, 2024@18:36:36 Page 2
ORWDXM4 ; SLC/KCM - Order Dialogs, Menus;05/09/17 ;Jun 21, 2022@14:26:46
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,215,296,280,394,350,434,569**;Dec 17, 1997;Build 23
+2 ;
SETUP ; -- setup dialog (continued from ORWDXM1)
+1 ; if xfer med order, setup ORDIALOG differently
+2 IF ORWMODE
IF $$ISMED(ORIT)
IF $$CHGSTS(ORCAT,ORIT)
DO MEDXFER
QUIT
+3 ; get base dialog (based on display group) & location of responses
+4 IF ORWMODE
Begin DoDot:1
+5 SET ORDG=$PIECE(^OR(100,+ORIT,0),U,11)
SET ORDIALOG=+$PIECE(^(0),U,5)
+6 SET RSPREF="^OR(100,"_+ORIT_",4.5)"
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 NEW X0
SET X0=$GET(^ORD(101.41,ORIT,0))
+9 SET ORDIALOG=$SELECT($PIECE(X0,U,4)="D":ORIT,1:0)
+10 SET ORDG=$PIECE(X0,U,5)
if 'ORDG
QUIT
+11 IF 'ORDIALOG
SET ORDIALOG=+$$DEFDLG^ORWDXQ(ORDG)
+12 SET RSPREF="^ORD(101.41,"_ORIT_",6)"
End DoDot:1
+13 ; setup the ORDIALOG array
+14 DO GETDLG^ORCD(ORDIALOG)
+15 DO GETORDER^ORCD(RSPREF)
+16 QUIT
SETUPS ; -- setup for specific types of dialogs (continued from ORWDXM1)
+1 ; pharmacy uses ORCAT to know order package
+2 IF ORDIALOG=$ORDER(^ORD(101.41,"B","PSO OERR",0))
SET ORCAT="O"
+3 IF ORDIALOG=$ORDER(^ORD(101.41,"B","PSJ OR PAT OE",0))
Begin DoDot:1
+4 ; not auto-ack, pt not inpt
IF ORCAT="O"
IF 'ORIMO
SET ORWPSWRG=""
+5 SET ORCAT="I"
End DoDot:1
+6 IF ORCAT="O"
IF $DATA(OREVENT("EFFECTIVE"))
IF (ORDG=+$ORDER(^ORD(100.98,"B","O RX",0)))
Begin DoDot:1
+7 SET ORDIALOG($ORDER(^ORD(101.41,"B",X,0)),1)=OREVENT("EFFECTIVE")
End DoDot:1
+8 ;p394 force interactive dialog for imaging QO for female of child-bearing age.
+9 ;set is radiology flag to false (0)
NEW ORRAORD
SET ORRAORD=0
+10 IF ORDIALOG=$ORDER(^ORD(101.41,"B","RA OERR EXAM",0))
Begin DoDot:1
+11 NEW ORPRMPT1,ORPRMPT2,ORCODE
SET ORRAORD=1
+12 if ($GET(ORTYPE)'="Q")!($GET(ORSEX)'="F")
QUIT
+13 SET ORPRMPT1=$ORDER(^ORD(101.41,"B","OR GTX PREGNANT",0))
SET ORPRMPT2=$PIECE($GET(ORDIALOG(ORPRMPT1)),"^")
+14 SET ORCODE=$GET(^ORD(101.41,ORDIALOG,10,ORPRMPT2,7))
NEW Y
SET Y="Y"
XECUTE ORCODE
KILL ORCODE
+15 ;
if Y="Y"
SET ORWPSWRG=""
End DoDot:1
+16 IF ORRAORD
DO RA^ORWDXM2
GOTO XENV
+17 IF ORDIALOG=$ORDER(^ORD(101.41,"B","LR OTHER LAB TESTS",0))
DO LR^ORWDXM2
GOTO XENV
+18 IF ORDIALOG=$ORDER(^ORD(101.41,"B","LR OTHER LAB AP TESTS",0))
DO LR^ORWDXM2
GOTO XENV
+19 IF ORDIALOG=$ORDER(^ORD(101.41,"B","FHW1",0))
DO DO^ORWDXM2
GOTO XENV
+20 IF ORDIALOG=$ORDER(^ORD(101.41,"B","FHW2",0))
DO EL^ORWDXM2
GOTO XENV
+21 IF ORDIALOG=$ORDER(^ORD(101.41,"B","PSJ OR PAT OE",0))
DO UD^ORWDXM2
GOTO XENV
+22 IF ORDIALOG=$ORDER(^ORD(101.41,"B","PSJ OR CLINIC OE",0))
DO UD^ORWDXM2
GOTO XENV
+23 IF ORDIALOG=$ORDER(^ORD(101.41,"B","PSJI OR PAT FLUID OE",0))
DO IV^ORWDXM2
GOTO XENV
+24 IF ORDIALOG=$ORDER(^ORD(101.41,"B","CLINIC OR PAT FLUID OE",0))
DO IV^ORWDXM2
GOTO XENV
+25 IF ORDIALOG=$ORDER(^ORD(101.41,"B","PSO OERR",0))
DO OP^ORWDXM2
GOTO XENV
+26 IF ORDIALOG=$ORDER(^ORD(101.41,"B","PSO SUPPLY",0))
DO OP^ORWDXM2
GOTO XENV
+27 IF ORDIALOG=$ORDER(^ORD(101.41,"B","PS MEDS",0))
DO PS^ORWDPS3
GOTO XENV
+28 IF ORDIALOG=$ORDER(^ORD(101.41,"B","VBEC BLOOD BANK",0))
DO VB^ORWDXM4
GOTO XENV
+29 IF ORDIALOG=$ORDER(^ORD(101.41,"B","SD RTC",0))
DO RTC^ORWDSD1
GOTO XENV
+30 IF ORDIALOG=$ORDER(^ORD(101.41,"B","GMRAOR ALLERGY ENTER/EDIT",0))
SET ORQUIT=1
XENV ; end case
+1 QUIT
MEDXFER ; -- setup ORDIALOG for a med that is transferred (from SETUP)
+1 ;
+2 ; use ORWDPS3 if OR*3*94 installed
+3 IF ORWP94
GOTO MEDXFER^ORWDPS3
+4 ;
+5 NEW UDLG,FDLG,ODLG,DLG,OI
KILL ^TMP("PS",$JOB)
+6 SET UDLG=$ORDER(^ORD(101.41,"AB","PSJ OR PAT OE",0))
+7 SET FDLG=$ORDER(^ORD(101.41,"AB","PSJI OR PAT FLUID OE",0))
+8 SET ODLG=$ORDER(^ORD(101.41,"AB","PSO OERR",0))
+9 SET DLG=$PIECE($GET(^OR(100,+ORIT,0)),U,5)
+10 SET ORDIALOG=$SELECT(+DLG=UDLG:ODLG,+DLG=ODLG:UDLG,+DLG=FDLG:FDLG,1:0)
+11 IF 'ORDIALOG
DO SETERR(ORIT,"Incomplete Order Record")
QUIT
+12 SET ORDG=+$PIECE(^ORD(101.41,ORDIALOG,0),U,5)
+13 DO GETDLG^ORCD(ORDIALOG)
+14 DO GETORDER^ORCD("^OR(100,"_+ORIT_",4.5)")
+15 SET OI=$$VAL^ORCD("MEDICATION")
+16 IF '$$MEDOK(OI,ORCAT)
DO SETERR(ORIT,"This may not be ordered as an "_$SELECT(ORCAT="I":"in",1:"out")_"patient drug.")
QUIT
+17 IF $GET(^ORD(101.43,OI,.1))
IF (^(.1)<$$NOW^XLFDT)
DO SETERR(ORIT,"This may no longer be ordered.")
QUIT
+18 KILL ORDIALOG($$PTR("DISPENSE DRUG"),1)
+19 KILL ORDIALOG($$PTR("WORD PROCESSING 1"),1)
+20 ; could call IN^ORCMED except for writes
IF ORDIALOG=ODLG
DO IN2OUT
+21 ; could call OUT^ORCMED except for writes
IF ORDIALOG=UDLG
DO OUT2IN
+22 QUIT
IN2OUT ; -- make inpatient responses into outpatient
+1 NEW I,DDRUG,PKGID,DOSE
+2 SET DOSE=$GET(ORDIALOG($$PTR("INSTRUCTIONS"),1))
+3 FOR I="INSTRUCTIONS","UNITS/DOSE","FREE TEXT","DISPENSE DRUG"
KILL ORDIALOG($$PTR(I),1)
+4 SET PKGID=$GET(^OR(100,+ORIT,4))_";"_$PIECE(^(0),U,12)
+5 DO OEL^PSOORRL(+ORVP,PKGID)
SET DDRUG=$GET(^TMP("PS",$JOB,"DD",1,0))
+6 IF $PIECE(DDRUG,U,3)
SET ORDIALOG($$PTR("DISPENSE DRUG"),1)=$PIECE(DDRUG,U,3)
+7 ; keep instructions if IV med, otherwise use units returned
+8 IF $PIECE($GET(^ORD(101.43,OI,"PS")),U)=2
SET ORDIALOG($$PTR("INSTRUCTIONS"),1)=DOSE
+9 IF '$TEST
if $PIECE(DDRUG,U,2)
SET ORDIALOG($$PTR("INSTRUCTIONS"),1)=$PIECE(DDRUG,U,2)
+10 ; change orderable item if new orderable item returned
+11 IF $PIECE(DDRUG,U,4)
IF $PIECE(DDRUG,U,4)'=+$PIECE($GET(^ORD(101.43,OI,0)),U,2)
Begin DoDot:1
+12 SET OI=+$ORDER(^ORD(101.43,"ID",+$PIECE(DDRUG,U,4)_";99PSP",0))
+13 if OI
SET ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI
End DoDot:1
+14 QUIT
OUT2IN ; make outpatient responses into inpatient
+1 NEW ORP,ORI,PROMPT,PKGID,DDRUG,ONE
+2 ; Kill extra values not in inpt dialog
DO CHANGED^ORCDPS("XFR")
+3 SET PKGID=$GET(^OR(100,+ORIT,4))_";"_$PIECE(^(0),U,12)
+4 DO OEL^PSOORRL(+ORVP,PKGID)
SET DDRUG=$GET(^TMP("PS",$JOB,"DD",1,0))
+5 if $PIECE(DDRUG,U,3)
SET ORDIALOG($$PTR("DISPENSE DRUG"),1)=$PIECE(DDRUG,U,3)
+6 IF $PIECE(DDRUG,U,4)
IF $PIECE(DDRUG,U,4)'=+$PIECE($GET(^ORD(101.43,+OI,0)),U,2)
Begin DoDot:1
+7 SET OI=+$ORDER(^ORD(101.43,"ID",+$PIECE(DDRUG,U,4)_";99PSP",0))
+8 if OI
SET ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI
End DoDot:1
+9 ; first inst
SET ONE=$ORDER(ORDIALOG($$PTR("INSTRUCTIONS"),0))
+10 FOR ORP="ROUTE","SCHEDULE"
Begin DoDot:1
+11 SET ORI=0
SET PROMPT=$$PTR(ORP)
+12 FOR
SET ORI=$ORDER(ORDIALOG(PROMPT,ORI))
if ORI'>0
QUIT
IF ORDIALOG(PROMPT,ORI)=""!(ORI>ONE)
KILL ORDIALOG(PROMPT,ORI)
End DoDot:1
+13 QUIT
PTR(NAME) ; -- Returns pointer to OR GTX NAME (copied from ORCMED)
+1 QUIT +$ORDER(^ORD(101.41,"AB",$EXTRACT("OR GTX "_NAME,1,63),0))
+2 ;
MEDOK(OI,CAT) ; return 1 if med may be ordered for this patient category
+1 NEW P
SET P=$SELECT(CAT="I":1,1:2)
+2 QUIT $PIECE($GET(^ORD(101.43,+OI,"PS")),U,P)
+3 ;
CHGSTS(ECAT,IFN) ; return 1 if out to in or in to out
+1 NEW OCAT
+2 SET OCAT=$PIECE($GET(^OR(100,+IFN,0)),U,12)
+3 QUIT OCAT'=ECAT
+4 ;
ISMED(IFN) ; return 1 if this is a pharmacy order
+1 NEW PKG
SET PKG=$PIECE($GET(^OR(100,+IFN,0)),U,14)
+2 QUIT $$NMSP^ORCD(PKG)="PS"
SETERR(ID,X) ; sets LST to rejection with error message
+1 DO GETTXT^ORWORR(.LST,ID)
+2 SET LST(0)="8^0"
SET LST(.5)=X
SET LST(.6)=""
+3 QUIT
VB ; setup environment for VBECS
+1 ; -- setup ORTIME, ORIMTIME arrays
+2 DO GETIMES^ORCDLR1
+3 ; -- setup ORCOMP, ORTEST, and ORTAS
+4 SET (ORCOMP,ORTEST,ORTAS)=""
+5 NEW P,PROMPT,I,X,X0
+6 SET P=+$ORDER(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM",0))
+7 SET I=0
FOR
SET I=$ORDER(ORDIALOG(P,I))
if I<1
QUIT
SET X=+$GET(ORDIALOG(P,I))
Begin DoDot:1
+8 SET X0=$GET(^ORD(101.43,X,"VB"))
SET X=+$PIECE($GET(^(0)),U,2)
+9 IF $PIECE(X0,U)
SET ORCOMP=ORCOMP_$SELECT($LENGTH(ORCOMP):U,1:"")_X
QUIT
+10 SET ORTEST=ORTEST_$SELECT($LENGTH(ORTEST):U,1:"")_X
+11 IF X=2
SET ORTAS=1
End DoDot:1
+12 IF '$DATA(ORTEST("Lab CollSamp"))
Begin DoDot:1
+13 NEW I,V,T,LC
SET LC=1
+14 ;no LC samp
FOR I=1:1:$LENGTH(ORTEST,U)
SET V=+$PIECE(ORTEST,U,I)
Begin DoDot:2
+15 ;VBECS ID -> #60 ien
SET T=$$LAB60^ORCDVBEC(V)
+16 IF '$PIECE($GET(^LAB(60,T,0)),U,9)
SET LC=0
QUIT
End DoDot:2
if 'LC
QUIT
+17 SET ORTEST("Lab CollSamp")=LC
End DoDot:1
+18 IF '$DATA(ORTIME)
IF '$DATA(ORIMTIME)
DO GETIMES^ORCDLR1
+19 SET PROMPT=$ORDER(^ORD(101.41,"B","OR GTX COLLECTION TYPE",0))
+20 IF $DATA(ORDIALOG(PROMPT,1))
SET ORCOLLCT=ORDIALOG(PROMPT,1)
IF 1
+21 IF '$TEST
SET EDITONLY=0
SET ORCOLLCT=$$COLLTYPE^ORCDLR1
+22 IF ORCOLLCT="I"
Begin DoDot:1
+23 SET PROMPT=$ORDER(^ORD(101.41,"B","OR GTX START DATE/TIME",0))
+24 DO LRICTMOK^ORWDXM2
End DoDot:1
+25 QUIT
VBASK(I) ; set the ORASK variable for child component prompts in VBECS order
+1 IF ORDIALOG'=$ORDER(^ORD(101.41,"B","VBEC BLOOD BANK",0))
QUIT
+2 NEW P
SET P=+$ORDER(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM",0))
+3 NEW OI
SET OI=+$GET(ORDIALOG(P,I))
+4 IF +$GET(^ORD(101.43,+$GET(OI),"VB"))
SET ORASK=1
+5 QUIT
VBQO(IFN) ;Check to see if it's a good VBECS QO
+1 ;regular order treated as good QO
+2 ;
+3 IF $PIECE($GET(^ORD(101.41,IFN,0)),U,4)'="Q"
QUIT 1
+4 NEW ODP,ODG,RESULT,P,TNS,I
+5 SET RESULT=0
+6 SET ODP=+$PIECE($GET(^ORD(101.41,IFN,0)),U,7)
SET ODG=+$PIECE($GET(^(0)),U,5)
+7 SET ODP=$$GET1^DIQ(9.4,+ODP_",",1)
SET ODG=$PIECE($GET(^ORD(100.98,ODG,0)),U,3)
+8 IF ODP'["VBEC"
QUIT 1
+9 QUIT RESULT
