ORCDLG ;SLC/MKB-Order dialogs ; 08 May 2002 2:12 PM
;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,7,46,60,79,94,141**;Dec 17, 1997
;
EN(ORDIALOG) ; -- process ORDIALOG
Q:'ORDIALOG N TITLE,TYPE,MSG K ^TMP("ORWORD",$J)
S TITLE=$G(^ORD(101.41,ORDIALOG,0)),TYPE=$P(TITLE,U,4),MSG=$P(TITLE,U,3),TITLE=$P(TITLE,U,2)
W !!,?(36-($L(TITLE)\2)),"-- "_TITLE_" --"
I $L(MSG) W $C(7),!!,MSG H 2 Q ;disabled
D SET:TYPE="O",MENU:TYPE="M",ADD:(TYPE="D")!(TYPE="Q")!(TYPE="A")
K ^TMP("ORWORD",$J)
Q
;
SET ; -- prompt for new order set
N ORSET,ORSEQ,ORSITM,ORSTOP,ORPARENT,ORCHLD,ORS0,ORSIFN,ORPIFN,ORLAST,ORSLOG,X,OREV0
S ORSET=+ORDIALOG Q:'ORSET Q:'$D(^ORD(101.41,ORSET))
I $G(OREVENT) S X=+$P($G(^ORE(100.2,OREVENT,0)),U,2),OREV0=$G(^ORD(100.5,X,0))
X:$D(^ORD(101.41,ORSET,3)) ^(3) ; Entry action
S ORPARENT=$P($G(^ORD(101.41,ORSET,5)),U,6) ;,ORHDR=$P($G(^(5)),U,7)
S ORSLOG=+$E($$NOW^XLFDT,1,12) D:ORPARENT SET^ORCSAVE(+ORDIALOG) ;Parent
S1 S ORSEQ=0 F S ORSEQ=$O(^ORD(101.41,ORSET,10,"B",ORSEQ)) Q:ORSEQ'>0!($G(ORSTOP)) S ORSITM=0 F S ORSITM=$O(^ORD(101.41,ORSET,10,"B",ORSEQ,ORSITM)) Q:'ORSITM D Q:$G(ORSTOP)
. S ORS0=$G(^ORD(101.41,ORSET,10,ORSITM,0)) K ORSIFN
. I $G(OREVENT),$G(ORDSET),+$P(ORS0,U,2)=+$P(OREV0,U,4) Q ;Evt Ord Dlg
. D:$P(ORS0,U,2) EN(+$P(ORS0,U,2))
. I $G(ORSTOP) Q:$G(DIROUT) K:$$CONT ORSTOP Q
. I ORPARENT,$G(ORSIFN) S ORCHLD=+$G(ORCHLD)+1,ORCHLD(ORSIFN,0)=ORSIFN,ORLAST=ORSIFN
S2 I $G(ORSTOP) D G SQ ; delete orders
. N DA,DIK
. S DA=0 F S DA=$O(ORCHLD(DA)) Q:DA'>0 S DIK="^OR(100," D ^DIK
. W !?10,"... orders cancelled.",! H 1
I ORPARENT,$G(ORCHLD) M ^OR(100,ORPIFN,2)=ORCHLD S ^OR(100,ORPIFN,2,0)="^100.002PA^"_ORLAST_U_ORCHLD
;W !?10,"... orders placed.",! H 1
SQ X:$D(^ORD(101.41,ORSET,4)) ^(4) ; Exit action
Q
;
N ORI,ORY,XQORM
S ORI=$$LOCK^ORDD41(ORDIALOG) I 'ORI W !!,$P(ORI,U,2) H 2 Q
X:$D(^ORD(101.41,ORDIALOG,3)) ^(3) G:$G(ORQUIT) MNQ ;Entry action
S XQORM("W")="W $S($P(X,U,5)=""H"":IOUON,1:"""")_$P(X,U,3)_IOUOFF"
S ORI=$G(^ORD(101.41,ORDIALOG,5)) S:$P(ORI,U,2) XQORM("M")=$P(ORI,U,2)
S XQORM=ORDIALOG_";ORD(101.41,",XQORM(0)="AD" D EN^XQORM
I Y'>0 S:$G(ORSET)&(X["^") ORSTOP=1 G MNQ
M ORY=Y S ORI=0 F S ORI=$O(ORY(ORI)) Q:ORI'>0 D EN(+$P(ORY(ORI),U,2))
MNQ X:$D(^ORD(101.41,ORDIALOG,4)) ^(4) ;Exit action
D UNLOCK^ORDD41(ORDIALOG)
Q
;
ORDER(ORDIALOG) ; -- Execute ORDIALOG, return ORIFN or ^ if unsuccessful
K ^TMP("ORWORD",$J) Q:'$G(ORDIALOG) "^"
N TITLE,TYPE,MSG,NODE0,FIRST,ORDG,ORQUIT,VERIFY,ACTION,ASK,AUTO,ORIFN,ORTYPE,ORCHECK,ORNMSP,ORDUZ,ORLOG
S TITLE=$G(^ORD(101.41,ORDIALOG,0)),TYPE=$P(TITLE,U,4),MSG=$P(TITLE,U,3),TITLE=$P(TITLE,U,2)
W !!,?(36-($L(TITLE)\2)),"-- "_TITLE_" --"
I $L(MSG) W $C(7),!!,MSG H 2 Q "^" ;disabled
I TYPE'="D",TYPE'="Q" W $C(7),!!,"Invalid order dialog!" H 2 Q "^"
D ADD0 S:'$G(ORIFN) ORIFN="^"
K ^TMP("ORWORD",$J)
Q ORIFN
;
ADD ; -- prompt for new order
; Requires: ORDIALOG = Order Dialog ifn
; ORNP = Ordering Provider (ifn in #200)
; ORVP = Patient (vptr to #2)
; Optional: ORL = Patient Location (vptr to #44)
; ORTS = Treating Specialty (ifn in #45.7)
; ORSET = Order Set (ifn in #101.41, from SET)
; $$ORDER enters at ADD0 to be able to return ORIFN
;
N NODE0,FIRST,ORDG,ORQUIT,VERIFY,ACTION,ASK,AUTO,ORIFN,ORTYPE,ORCHECK,ORNMSP,ORDUZ,ORLOG
ADD0 S VALMBCK="R",FIRST=1 Q:'ORDIALOG
S NODE0=$G(^ORD(101.41,ORDIALOG,0)),AUTO=$P($G(^(5)),U,8)
S ORTYPE=$P(NODE0,U,4),ORDG=+$P(NODE0,U,5),ORDUZ=DUZ
S ORLOG=+$$NOW,VERIFY=$P(NODE0,U,8),ASK=$P(NODE0,U,9)
D @("GET"_$S(ORTYPE="Q":"Q",1:"")_"DLG^ORCD(+ORDIALOG)")
I ORDIALOG'>0 W $C(7),!!,"Invalid dialog - cannot place order!" H 1 Q
S ORNMSP=$P($G(^ORD(101.41,ORDIALOG,0)),U,7),ORNMSP=$$NMSP^ORCD(ORNMSP)
I '$$ACTIVE W $C(7),!!,"Inactive orderable item(s) - cannot place order!" H 1 Q
X:$D(^ORD(101.41,+ORDIALOG,3)) ^(3) G:$G(ORQUIT) ADDQ ; entry action
G:ORTYPE="A" ADDQ ; action only
D DISPLAY^ORCHECK ; pkg order check
ADD1 D DIALOG ; Loop thru prompts or components
I $G(ORQUIT) S:$G(ORSET) ORSTOP=1 G:$G(ORSTOP)!$G(DIROUT)!FIRST ADDQ K ORQUIT
D ACCEPT^ORCHECK() S ACTION="P"
I $G(OREVENT),$G(^ORE(100.2,+OREVENT,1)) D ;event occurred
. W !!,"This release event has occurred since you started writing delayed orders."
. W !,"The orders that were signed have now been released; this and any other"
. W !,"unsigned orders will be released immediately upon signature. The Orders"
. W !,"tab will be refreshed in the Active Orders view when finished."
. K OREVENT S $P(^TMP("OR",$J,"ORDERS",0),U,3,4)="^1" ;default view
. N X W !!,"Press <return> to continue ..." R X:DTIME
I VERIFY!$G(ORCHECK) D DISPLAY S ACTION=$$OK G:ACTION="^" ADDQ
I ACTION="E" S FIRST=0 K ORCHECK G ADD1
I ACTION="C" W !?10,"... order cancelled.",! ;G ADDQ
I ACTION="P" D EN^ORCSAVE D
. I '$G(ORIFN) W !?10,"... ERROR - unable to place order.",! H 1 Q
. S ^TMP("ORNEW",$J,ORIFN,1)="" S:$G(ORSET) ORSIFN=ORIFN
. I '$D(^TMP("ORECALL",$J,ORDIALOG)) M ^(ORDIALOG)=ORDIALOG M:$D(^TMP("ORWORD",$J)) ^TMP("ORECALL",$J,ORDIALOG)=^TMP("ORWORD",$J) ;1st values
. W !?10,"... order placed.",!
I ASK,$$ANOTHER D KVALUES S FIRST=1,ORLOG=+$$NOW G ADD1
ADDQ X:$D(^ORD(101.41,+ORDIALOG,4)) ^(4) ; exit action
Q
;
DIALOG ; -- loop through prompts in dialog
N SEQ,DA K ORQUIT
I $G(ORTYPE)'="A" S SEQ=0 F S SEQ=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ)) Q:SEQ'>0!($G(ORQUIT)) S DA=0 F S DA=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ,DA)) Q:'DA D Q:$G(ORQUIT)
. Q:$P(^ORD(101.41,+ORDIALOG,10,DA,0),U,11) ; child
. D EN^ORCDLG1(DA)
Q
;
ANOTHER() ; -- Add another order?
I ASK>1 Q 1 ; Don't ask, go right to another order
N X,Y,DIR
S DIR("A")="Add another "_$P(^ORD(101.41,+ORDIALOG,0),U,2)_" order? "
S DIR(0)="YA",DIR("B")="NO" D ^DIR
Q +Y
;
CONT() ; -- continue w/set?
N X,Y,DIR
S DIR(0)="YA",DIR("A")="Do you want to continue with this order set? "
S DIR("?")="Enter NO if you wish to cancel the entire order set; YES will cancel only this one order."
S DIR("B")="YES" D ^DIR
Q +Y
;
DISPLAY ; -- Display new order on screen
N SEQ,DA,X,PROMPT,MULT,I,TITLE
W !!,$$REPEAT^XLFSTR("-",79)
S SEQ=0 F S SEQ=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ)) Q:SEQ'>0 S DA=0 F S DA=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ,DA)) Q:'DA D
. S X=$G(^ORD(101.41,+ORDIALOG,10,DA,0)) Q:$P(X,U,11) ;child
. S PROMPT=$P(X,U,2),MULT=$P(X,U,7) Q:$P(X,U,9)["*" ;hide
. Q:'PROMPT S I=$O(ORDIALOG(PROMPT,0)) Q:'I ; no values
. S TITLE=$S($L($G(ORDIALOG(PROMPT,"TTL"))):ORDIALOG(PROMPT,"TTL"),1:ORDIALOG(PROMPT,"A"))
. W !,$J(TITLE,30)
. I $E(ORDIALOG(PROMPT,0))="W" W $E($G(^TMP("ORWORD",$J,PROMPT,I,1,0)),1,40)_$S($L($G(^(0)))>40:" ...",$O(^TMP("ORWORD",$J,PROMPT,I,1)):" ...",1:"") Q
. W $$ITEM(PROMPT,I) Q:'MULT Q:'$O(ORDIALOG(PROMPT,I)) ; done
. F S I=$O(ORDIALOG(PROMPT,I)) Q:I'>0 W !?30,$$ITEM(PROMPT,I)
W !,$$REPEAT^XLFSTR("-",79),!
I $G(ORCHECK) W "Order Checks:" D LIST^ORCHECK("NEW")
Q
;
ITEM(P,I) ; -- Display each item in dialog
N ITEM,SEQ,DA,IFN,X,ORDTXT
S ITEM=$$EXT^ORCD(P,I) I $E(ORDIALOG(P,0))="R",$G(ORTYPE)'="Z",'$G(OREVENT) S X=ORDIALOG(P,I) S:'X ITEM=ITEM_$$DATE(X)
I $D(^ORD(101.41,+ORDIALOG,10,"DAD",P)) S SEQ=0 F S SEQ=$O(^ORD(101.41,+ORDIALOG,10,"DAD",P,SEQ)) Q:SEQ'>0 S DA=$O(^(SEQ,0)) D
. S IFN=$P(^ORD(101.41,+ORDIALOG,10,DA,0),U,2),ORDTXT=$G(^(2)) Q:$P(^(0),U,9)["*"
. Q:'$D(ORDIALOG(IFN,I)) Q:$E(ORDIALOG(IFN,0))="W"
. S X=$$EXT^ORCD(IFN,I) Q:'$L(X)
. S:$L($P(ORDTXT,U,4)) X=$$GETXT^ORCSAVE1($P(ORDTXT,U,4))_" "_X
. S:$L($P(ORDTXT,U,5)) X=X_" "_$$GETXT^ORCSAVE1($P(ORDTXT,U,5))
. S ITEM=ITEM_" "_X
Q ITEM
;
DATE(X) ; -- Returns resolved date
N Y,%DT S %DT="T"
D AM^ORCSAVE2:X="AM",NEXT^ORCSAVE2:X="NEXT"
D ADMIN^ORCSAVE2("NEXT"):X="NEXTA",ADMIN^ORCSAVE2("CLOSEST"):X="CLOSEST"
D ^%DT S:Y'>0 Y="" I Y>0 S Y=" ("_$$FMTE^XLFDT(Y,2)_")"
Q Y
;
OK() ; -- Ready to save?
N X,Y,DIR
S DIR(0)="SA^P:PLACE;E:EDIT;C:CANCEL;",DIR("A")="(P)lace, (E)dit, or (C)ancel this order? ",DIR("B")="PLACE"
S DIR("?")="Enter P to place this order, or E to change any of the displayed values; enter C to quit without placing this order"
D ^DIR S:$D(DTOUT) Y="^"
Q Y
;
KVALUES ; -- kill ORDIALOG("ORDERABLE ITEM",#) value nodes
N PTR,INST K ORIFN,ORCHECK,^TMP("ORWORD",$J)
S PTR=0 F S PTR=$O(ORDIALOG(PTR)) Q:PTR'>0 D
. K ORDIALOG(PTR,"LIST") S INST=0
. F S INST=$O(ORDIALOG(PTR,INST)) Q:INST'>0 K ORDIALOG(PTR,INST)
Q
;
NOW() ; -- Returns current Date Ordered for new order
N Y I $G(ORSLOG) S Y=ORSLOG ; timestamp for order set
E S Y=+$E($$NOW^XLFDT,1,12)
Q Y
;
ACTIVE() ; -- Returns 1 or 0, if orderable item(s) are active
; [Uses ORDIALOG(),ORDG,ORNMSP]
N OI,NOW,I,ITM,X,Y
S OI=+$$PTR^ORCD("OR GTX ORDERABLE ITEM"),NOW=$$NOW^XLFDT,Y=1
S I=0 F S I=+$O(ORDIALOG(OI,I)) Q:I'>0 D Q:'Y
. S ITM=+$G(ORDIALOG(OI,I)) Q:ITM'>0
. S X=$G(^ORD(101.43,ITM,.1)) I X,X<NOW S Y=0 Q ;inactive
I 'Y,ORNMSP?1"PS".E D ;ck for new OI, if PS
. Q:$P($G(^ORD(100.98,+$G(ORDG),0)),U,3)="IV RX" ;skip fluids
. Q:$G(ORCAT)="I"&$G(ORENEW) ;skip Inpt renewals
. N DD,J,DRUG,PSOI S DD=+$$PTR^ORCD("OR GTX DISPENSE DRUG")
. S J=+$O(ORDIALOG(DD,0)),DRUG=+$G(ORDIALOG(DD,J)) ;first one
. S PSOI=+$P($G(^ORD(101.43,+$G(ORDIALOG(OI,1)),0)),U,2)
. S X=$$ITEM^PSSUTIL1(PSOI,DRUG) Q:X'>0
. S ITM=+$O(^ORD(101.43,"ID",+$P(X,U,2)_";99PSP",0)) Q:ITM'>0
. S X=$G(^ORD(101.43,ITM,.1)) I X,X<NOW Q ;just checking
. S ORDIALOG(OI,1)=ITM,Y=1
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCDLG 9652 printed Sep 23, 2025@20:04:18 Page 2
ORCDLG ;SLC/MKB-Order dialogs ; 08 May 2002 2:12 PM
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,7,46,60,79,94,141**;Dec 17, 1997
+2 ;
EN(ORDIALOG) ; -- process ORDIALOG
+1 if 'ORDIALOG
QUIT
NEW TITLE,TYPE,MSG
KILL ^TMP("ORWORD",$JOB)
+2 SET TITLE=$GET(^ORD(101.41,ORDIALOG,0))
SET TYPE=$PIECE(TITLE,U,4)
SET MSG=$PIECE(TITLE,U,3)
SET TITLE=$PIECE(TITLE,U,2)
+3 WRITE !!,?(36-($LENGTH(TITLE)\2)),"-- "_TITLE_" --"
+4 ;disabled
IF $LENGTH(MSG)
WRITE $CHAR(7),!!,MSG
HANG 2
QUIT
+5 if TYPE="O"
DO SET
if TYPE="M"
DO MENU
if (TYPE="D")!(TYPE="Q")!(TYPE="A")
DO ADD
+6 KILL ^TMP("ORWORD",$JOB)
+7 QUIT
+8 ;
SET ; -- prompt for new order set
+1 NEW ORSET,ORSEQ,ORSITM,ORSTOP,ORPARENT,ORCHLD,ORS0,ORSIFN,ORPIFN,ORLAST,ORSLOG,X,OREV0
+2 SET ORSET=+ORDIALOG
if 'ORSET
QUIT
if '$DATA(^ORD(101.41,ORSET))
QUIT
+3 IF $GET(OREVENT)
SET X=+$PIECE($GET(^ORE(100.2,OREVENT,0)),U,2)
SET OREV0=$GET(^ORD(100.5,X,0))
+4 ; Entry action
if $DATA(^ORD(101.41,ORSET,3))
XECUTE ^(3)
+5 ;,ORHDR=$P($G(^(5)),U,7)
SET ORPARENT=$PIECE($GET(^ORD(101.41,ORSET,5)),U,6)
+6 ;Parent
SET ORSLOG=+$EXTRACT($$NOW^XLFDT,1,12)
if ORPARENT
DO SET^ORCSAVE(+ORDIALOG)
S1 SET ORSEQ=0
FOR
SET ORSEQ=$ORDER(^ORD(101.41,ORSET,10,"B",ORSEQ))
if ORSEQ'>0!($GET(ORSTOP))
QUIT
SET ORSITM=0
FOR
SET ORSITM=$ORDER(^ORD(101.41,ORSET,10,"B",ORSEQ,ORSITM))
if 'ORSITM
QUIT
Begin DoDot:1
+1 SET ORS0=$GET(^ORD(101.41,ORSET,10,ORSITM,0))
KILL ORSIFN
+2 ;Evt Ord Dlg
IF $GET(OREVENT)
IF $GET(ORDSET)
IF +$PIECE(ORS0,U,2)=+$PIECE(OREV0,U,4)
QUIT
+3 if $PIECE(ORS0,U,2)
DO EN(+$PIECE(ORS0,U,2))
+4 IF $GET(ORSTOP)
if $GET(DIROUT)
QUIT
if $$CONT
KILL ORSTOP
QUIT
+5 IF ORPARENT
IF $GET(ORSIFN)
SET ORCHLD=+$GET(ORCHLD)+1
SET ORCHLD(ORSIFN,0)=ORSIFN
SET ORLAST=ORSIFN
End DoDot:1
if $GET(ORSTOP)
QUIT
S2 ; delete orders
IF $GET(ORSTOP)
Begin DoDot:1
+1 NEW DA,DIK
+2 SET DA=0
FOR
SET DA=$ORDER(ORCHLD(DA))
if DA'>0
QUIT
SET DIK="^OR(100,"
DO ^DIK
+3 WRITE !?10,"... orders cancelled.",!
HANG 1
End DoDot:1
GOTO SQ
+4 IF ORPARENT
IF $GET(ORCHLD)
MERGE ^OR(100,ORPIFN,2)=ORCHLD
SET ^OR(100,ORPIFN,2,0)="^100.002PA^"_ORLAST_U_ORCHLD
+5 ;W !?10,"... orders placed.",! H 1
SQ ; Exit action
if $DATA(^ORD(101.41,ORSET,4))
XECUTE ^(4)
+1 QUIT
+2 ;
+1 NEW ORI,ORY,XQORM
+2 SET ORI=$$LOCK^ORDD41(ORDIALOG)
IF 'ORI
WRITE !!,$PIECE(ORI,U,2)
HANG 2
QUIT
+3 ;Entry action
if $DATA(^ORD(101.41,ORDIALOG,3))
XECUTE ^(3)
if $GET(ORQUIT)
GOTO MNQ
+4 SET XQORM("W")="W $S($P(X,U,5)=""H"":IOUON,1:"""")_$P(X,U,3)_IOUOFF"
+5 SET ORI=$GET(^ORD(101.41,ORDIALOG,5))
if $PIECE(ORI,U,2)
SET XQORM("M")=$PIECE(ORI,U,2)
+6 SET XQORM=ORDIALOG_";ORD(101.41,"
SET XQORM(0)="AD"
DO EN^XQORM
+7 IF Y'>0
if $GET(ORSET)&(X["^")
SET ORSTOP=1
GOTO MNQ
+8 MERGE ORY=Y
SET ORI=0
FOR
SET ORI=$ORDER(ORY(ORI))
if ORI'>0
QUIT
DO EN(+$PIECE(ORY(ORI),U,2))
MNQ ;Exit action
if $DATA(^ORD(101.41,ORDIALOG,4))
XECUTE ^(4)
+1 DO UNLOCK^ORDD41(ORDIALOG)
+2 QUIT
+3 ;
ORDER(ORDIALOG) ; -- Execute ORDIALOG, return ORIFN or ^ if unsuccessful
+1 KILL ^TMP("ORWORD",$JOB)
if '$GET(ORDIALOG)
QUIT "^"
+2 NEW TITLE,TYPE,MSG,NODE0,FIRST,ORDG,ORQUIT,VERIFY,ACTION,ASK,AUTO,ORIFN,ORTYPE,ORCHECK,ORNMSP,ORDUZ,ORLOG
+3 SET TITLE=$GET(^ORD(101.41,ORDIALOG,0))
SET TYPE=$PIECE(TITLE,U,4)
SET MSG=$PIECE(TITLE,U,3)
SET TITLE=$PIECE(TITLE,U,2)
+4 WRITE !!,?(36-($LENGTH(TITLE)\2)),"-- "_TITLE_" --"
+5 ;disabled
IF $LENGTH(MSG)
WRITE $CHAR(7),!!,MSG
HANG 2
QUIT "^"
+6 IF TYPE'="D"
IF TYPE'="Q"
WRITE $CHAR(7),!!,"Invalid order dialog!"
HANG 2
QUIT "^"
+7 DO ADD0
if '$GET(ORIFN)
SET ORIFN="^"
+8 KILL ^TMP("ORWORD",$JOB)
+9 QUIT ORIFN
+10 ;
ADD ; -- prompt for new order
+1 ; Requires: ORDIALOG = Order Dialog ifn
+2 ; ORNP = Ordering Provider (ifn in #200)
+3 ; ORVP = Patient (vptr to #2)
+4 ; Optional: ORL = Patient Location (vptr to #44)
+5 ; ORTS = Treating Specialty (ifn in #45.7)
+6 ; ORSET = Order Set (ifn in #101.41, from SET)
+7 ; $$ORDER enters at ADD0 to be able to return ORIFN
+8 ;
+9 NEW NODE0,FIRST,ORDG,ORQUIT,VERIFY,ACTION,ASK,AUTO,ORIFN,ORTYPE,ORCHECK,ORNMSP,ORDUZ,ORLOG
ADD0 SET VALMBCK="R"
SET FIRST=1
if 'ORDIALOG
QUIT
+1 SET NODE0=$GET(^ORD(101.41,ORDIALOG,0))
SET AUTO=$PIECE($GET(^(5)),U,8)
+2 SET ORTYPE=$PIECE(NODE0,U,4)
SET ORDG=+$PIECE(NODE0,U,5)
SET ORDUZ=DUZ
+3 SET ORLOG=+$$NOW
SET VERIFY=$PIECE(NODE0,U,8)
SET ASK=$PIECE(NODE0,U,9)
+4 DO @("GET"_$SELECT(ORTYPE="Q":"Q",1:"")_"DLG^ORCD(+ORDIALOG)")
+5 IF ORDIALOG'>0
WRITE $CHAR(7),!!,"Invalid dialog - cannot place order!"
HANG 1
QUIT
+6 SET ORNMSP=$PIECE($GET(^ORD(101.41,ORDIALOG,0)),U,7)
SET ORNMSP=$$NMSP^ORCD(ORNMSP)
+7 IF '$$ACTIVE
WRITE $CHAR(7),!!,"Inactive orderable item(s) - cannot place order!"
HANG 1
QUIT
+8 ; entry action
if $DATA(^ORD(101.41,+ORDIALOG,3))
XECUTE ^(3)
if $GET(ORQUIT)
GOTO ADDQ
+9 ; action only
if ORTYPE="A"
GOTO ADDQ
+10 ; pkg order check
DO DISPLAY^ORCHECK
ADD1 ; Loop thru prompts or components
DO DIALOG
+1 IF $GET(ORQUIT)
if $GET(ORSET)
SET ORSTOP=1
if $GET(ORSTOP)!$GET(DIROUT)!FIRST
GOTO ADDQ
KILL ORQUIT
+2 DO ACCEPT^ORCHECK()
SET ACTION="P"
+3 ;event occurred
IF $GET(OREVENT)
IF $GET(^ORE(100.2,+OREVENT,1))
Begin DoDot:1
+4 WRITE !!,"This release event has occurred since you started writing delayed orders."
+5 WRITE !,"The orders that were signed have now been released; this and any other"
+6 WRITE !,"unsigned orders will be released immediately upon signature. The Orders"
+7 WRITE !,"tab will be refreshed in the Active Orders view when finished."
+8 ;default view
KILL OREVENT
SET $PIECE(^TMP("OR",$JOB,"ORDERS",0),U,3,4)="^1"
+9 NEW X
WRITE !!,"Press <return> to continue ..."
READ X:DTIME
End DoDot:1
+10 IF VERIFY!$GET(ORCHECK)
DO DISPLAY
SET ACTION=$$OK
if ACTION="^"
GOTO ADDQ
+11 IF ACTION="E"
SET FIRST=0
KILL ORCHECK
GOTO ADD1
+12 ;G ADDQ
IF ACTION="C"
WRITE !?10,"... order cancelled.",!
+13 IF ACTION="P"
DO EN^ORCSAVE
Begin DoDot:1
+14 IF '$GET(ORIFN)
WRITE !?10,"... ERROR - unable to place order.",!
HANG 1
QUIT
+15 SET ^TMP("ORNEW",$JOB,ORIFN,1)=""
if $GET(ORSET)
SET ORSIFN=ORIFN
+16 ;1st values
IF '$DATA(^TMP("ORECALL",$JOB,ORDIALOG))
MERGE ^(ORDIALOG)=ORDIALOG
if $DATA(^TMP("ORWORD",$JOB))
MERGE ^TMP("ORECALL",$JOB,ORDIALOG)=^TMP("ORWORD",$JOB)
+17 WRITE !?10,"... order placed.",!
End DoDot:1
+18 IF ASK
IF $$ANOTHER
DO KVALUES
SET FIRST=1
SET ORLOG=+$$NOW
GOTO ADD1
ADDQ ; exit action
if $DATA(^ORD(101.41,+ORDIALOG,4))
XECUTE ^(4)
+1 QUIT
+2 ;
DIALOG ; -- loop through prompts in dialog
+1 NEW SEQ,DA
KILL ORQUIT
+2 IF $GET(ORTYPE)'="A"
SET SEQ=0
FOR
SET SEQ=$ORDER(^ORD(101.41,+ORDIALOG,10,"B",SEQ))
if SEQ'>0!($GET(ORQUIT))
QUIT
SET DA=0
FOR
SET DA=$ORDER(^ORD(101.41,+ORDIALOG,10,"B",SEQ,DA))
if 'DA
QUIT
Begin DoDot:1
+3 ; child
if $PIECE(^ORD(101.41,+ORDIALOG,10,DA,0),U,11)
QUIT
+4 DO EN^ORCDLG1(DA)
End DoDot:1
if $GET(ORQUIT)
QUIT
+5 QUIT
+6 ;
ANOTHER() ; -- Add another order?
+1 ; Don't ask, go right to another order
IF ASK>1
QUIT 1
+2 NEW X,Y,DIR
+3 SET DIR("A")="Add another "_$PIECE(^ORD(101.41,+ORDIALOG,0),U,2)_" order? "
+4 SET DIR(0)="YA"
SET DIR("B")="NO"
DO ^DIR
+5 QUIT +Y
+6 ;
CONT() ; -- continue w/set?
+1 NEW X,Y,DIR
+2 SET DIR(0)="YA"
SET DIR("A")="Do you want to continue with this order set? "
+3 SET DIR("?")="Enter NO if you wish to cancel the entire order set; YES will cancel only this one order."
+4 SET DIR("B")="YES"
DO ^DIR
+5 QUIT +Y
+6 ;
DISPLAY ; -- Display new order on screen
+1 NEW SEQ,DA,X,PROMPT,MULT,I,TITLE
+2 WRITE !!,$$REPEAT^XLFSTR("-",79)
+3 SET SEQ=0
FOR
SET SEQ=$ORDER(^ORD(101.41,+ORDIALOG,10,"B",SEQ))
if SEQ'>0
QUIT
SET DA=0
FOR
SET DA=$ORDER(^ORD(101.41,+ORDIALOG,10,"B",SEQ,DA))
if 'DA
QUIT
Begin DoDot:1
+4 ;child
SET X=$GET(^ORD(101.41,+ORDIALOG,10,DA,0))
if $PIECE(X,U,11)
QUIT
+5 ;hide
SET PROMPT=$PIECE(X,U,2)
SET MULT=$PIECE(X,U,7)
if $PIECE(X,U,9)["*"
QUIT
+6 ; no values
if 'PROMPT
QUIT
SET I=$ORDER(ORDIALOG(PROMPT,0))
if 'I
QUIT
+7 SET TITLE=$SELECT($LENGTH($GET(ORDIALOG(PROMPT,"TTL"))):ORDIALOG(PROMPT,"TTL"),1:ORDIALOG(PROMPT,"A"))
+8 WRITE !,$JUSTIFY(TITLE,30)
+9 IF $EXTRACT(ORDIALOG(PROMPT,0))="W"
WRITE $EXTRACT($GET(^TMP("ORWORD",$JOB,PROMPT,I,1,0)),1,40)_$SELECT($LENGTH($GET(^(0)))>40:" ...",$ORDER(^TMP("ORWORD",$JOB,PROMPT,I,1)):" ...",1:"")
QUIT
+10 ; done
WRITE $$ITEM(PROMPT,I)
if 'MULT
QUIT
if '$ORDER(ORDIALOG(PROMPT,I))
QUIT
+11 FOR
SET I=$ORDER(ORDIALOG(PROMPT,I))
if I'>0
QUIT
WRITE !?30,$$ITEM(PROMPT,I)
End DoDot:1
+12 WRITE !,$$REPEAT^XLFSTR("-",79),!
+13 IF $GET(ORCHECK)
WRITE "Order Checks:"
DO LIST^ORCHECK("NEW")
+14 QUIT
+15 ;
ITEM(P,I) ; -- Display each item in dialog
+1 NEW ITEM,SEQ,DA,IFN,X,ORDTXT
+2 SET ITEM=$$EXT^ORCD(P,I)
IF $EXTRACT(ORDIALOG(P,0))="R"
IF $GET(ORTYPE)'="Z"
IF '$GET(OREVENT)
SET X=ORDIALOG(P,I)
if 'X
SET ITEM=ITEM_$$DATE(X)
+3 IF $DATA(^ORD(101.41,+ORDIALOG,10,"DAD",P))
SET SEQ=0
FOR
SET SEQ=$ORDER(^ORD(101.41,+ORDIALOG,10,"DAD",P,SEQ))
if SEQ'>0
QUIT
SET DA=$ORDER(^(SEQ,0))
Begin DoDot:1
+4 SET IFN=$PIECE(^ORD(101.41,+ORDIALOG,10,DA,0),U,2)
SET ORDTXT=$GET(^(2))
if $PIECE(^(0),U,9)["*"
QUIT
+5 if '$DATA(ORDIALOG(IFN,I))
QUIT
if $EXTRACT(ORDIALOG(IFN,0))="W"
QUIT
+6 SET X=$$EXT^ORCD(IFN,I)
if '$LENGTH(X)
QUIT
+7 if $LENGTH($PIECE(ORDTXT,U,4))
SET X=$$GETXT^ORCSAVE1($PIECE(ORDTXT,U,4))_" "_X
+8 if $LENGTH($PIECE(ORDTXT,U,5))
SET X=X_" "_$$GETXT^ORCSAVE1($PIECE(ORDTXT,U,5))
+9 SET ITEM=ITEM_" "_X
End DoDot:1
+10 QUIT ITEM
+11 ;
DATE(X) ; -- Returns resolved date
+1 NEW Y,%DT
SET %DT="T"
+2 if X="AM"
DO AM^ORCSAVE2
if X="NEXT"
DO NEXT^ORCSAVE2
+3 if X="NEXTA"
DO ADMIN^ORCSAVE2("NEXT")
if X="CLOSEST"
DO ADMIN^ORCSAVE2("CLOSEST")
+4 DO ^%DT
if Y'>0
SET Y=""
IF Y>0
SET Y=" ("_$$FMTE^XLFDT(Y,2)_")"
+5 QUIT Y
+6 ;
OK() ; -- Ready to save?
+1 NEW X,Y,DIR
+2 SET DIR(0)="SA^P:PLACE;E:EDIT;C:CANCEL;"
SET DIR("A")="(P)lace, (E)dit, or (C)ancel this order? "
SET DIR("B")="PLACE"
+3 SET DIR("?")="Enter P to place this order, or E to change any of the displayed values; enter C to quit without placing this order"
+4 DO ^DIR
if $DATA(DTOUT)
SET Y="^"
+5 QUIT Y
+6 ;
KVALUES ; -- kill ORDIALOG("ORDERABLE ITEM",#) value nodes
+1 NEW PTR,INST
KILL ORIFN,ORCHECK,^TMP("ORWORD",$JOB)
+2 SET PTR=0
FOR
SET PTR=$ORDER(ORDIALOG(PTR))
if PTR'>0
QUIT
Begin DoDot:1
+3 KILL ORDIALOG(PTR,"LIST")
SET INST=0
+4 FOR
SET INST=$ORDER(ORDIALOG(PTR,INST))
if INST'>0
QUIT
KILL ORDIALOG(PTR,INST)
End DoDot:1
+5 QUIT
+6 ;
NOW() ; -- Returns current Date Ordered for new order
+1 ; timestamp for order set
NEW Y
IF $GET(ORSLOG)
SET Y=ORSLOG
+2 IF '$TEST
SET Y=+$EXTRACT($$NOW^XLFDT,1,12)
+3 QUIT Y
+4 ;
ACTIVE() ; -- Returns 1 or 0, if orderable item(s) are active
+1 ; [Uses ORDIALOG(),ORDG,ORNMSP]
+2 NEW OI,NOW,I,ITM,X,Y
+3 SET OI=+$$PTR^ORCD("OR GTX ORDERABLE ITEM")
SET NOW=$$NOW^XLFDT
SET Y=1
+4 SET I=0
FOR
SET I=+$ORDER(ORDIALOG(OI,I))
if I'>0
QUIT
Begin DoDot:1
+5 SET ITM=+$GET(ORDIALOG(OI,I))
if ITM'>0
QUIT
+6 ;inactive
SET X=$GET(^ORD(101.43,ITM,.1))
IF X
IF X<NOW
SET Y=0
QUIT
End DoDot:1
if 'Y
QUIT
+7 ;ck for new OI, if PS
IF 'Y
IF ORNMSP?1"PS".E
Begin DoDot:1
+8 ;skip fluids
if $PIECE($GET(^ORD(100.98,+$GET(ORDG),0)),U,3)="IV RX"
QUIT
+9 ;skip Inpt renewals
if $GET(ORCAT)="I"&$GET(ORENEW)
QUIT
+10 NEW DD,J,DRUG,PSOI
SET DD=+$$PTR^ORCD("OR GTX DISPENSE DRUG")
+11 ;first one
SET J=+$ORDER(ORDIALOG(DD,0))
SET DRUG=+$GET(ORDIALOG(DD,J))
+12 SET PSOI=+$PIECE($GET(^ORD(101.43,+$GET(ORDIALOG(OI,1)),0)),U,2)
+13 SET X=$$ITEM^PSSUTIL1(PSOI,DRUG)
if X'>0
QUIT
+14 SET ITM=+$ORDER(^ORD(101.43,"ID",+$PIECE(X,U,2)_";99PSP",0))
if ITM'>0
QUIT
+15 ;just checking
SET X=$GET(^ORD(101.43,ITM,.1))
IF X
IF X<NOW
QUIT
+16 SET ORDIALOG(OI,1)=ITM
SET Y=1
End DoDot:1
+17 QUIT Y
