OREVNT ; SLC/MKB - Event delayed orders ;3/31/04 13:42 [4/9/04 10:20am]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**141,177,195**;Dec 17, 1997
;
EN ; -- view/add EVOs
N X,ORP,ORQUIT S VALMBCK=""
I $G(OREVENT) D Q:$G(ORQUIT)
. S X=$$ACTIVE I X D EX S ORQUIT=1 Q ;return to Active Orders
. I X="^" S ORQUIT=1 Q
D FULL^VALM1 S VALMBCK="R"
W !!,$$CURRENT
S:'$G(ORL) ORL=$$LOCATION^ORCMENU1 Q:ORL="^"
S ORP=$$PTEVENT(+ORVP) Q:ORP="^"
S $P(^TMP("OR",$J,"ORDERS",0),U,3,4)=";;;;;;;"_+ORP_U,OREVENT=+ORP
D TAB^ORCHART(ORTAB,1) ;redisplay new order sheet/view
Q
;
EX ; -- Back to Active Orders
I +$G(OREVENT),'$G(^ORE(100.2,OREVENT,1)),$$EMPTY^OREVNTX(OREVENT) D CANCEL^OREVNTX(OREVENT) ;cancel empty events
K OREVENT S $P(^TMP("OR",$J,"ORDERS",0),U,3,4)="^1" ;default view
D TAB^ORCHART(ORTAB,1)
Q
;
ED ; -- Change delay event
N ORI,NMBR,IDX,ORIFN,ORLK,ORDERS,OREVT,ORQUIT,X,EVT
I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("change the delay event") Q:'ORNMBR
D FREEZE^ORCMENU S VALMBCK="R" K OREBUILD
F ORI=1:1:$L(ORNMBR) S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)
. S IDX=$G(^TMP("OR",$J,ORTAB,"IDX",NMBR)),ORIFN=$P(IDX,U)
. Q:'ORIFN S:'$P(ORIFN,";",2) ORIFN=+ORIFN_";1" ;unsign/unrel only
. I '$$VALID^ORCACT0(ORIFN,"EV",.ORERR) W !!,$$ORDITEM^ORCACT(ORIFN)_" invalid.",!," >> "_ORERR H 1 Q
. S ORLK=$$LOCK1^ORX2(+ORIFN) I 'ORLK W !!,$$ORDITEM^ORCACT(ORIFN)_" invalid.",!," >> "_$P(ORLK,U,2) H 1 Q
. S ORDERS(+ORIFN)=""
ED1 Q:'$O(ORDERS(0)) I $$DELAYED D Q:$G(ORQUIT) G:$G(OREBUILD) ED3
. S X=$$NODELAY ;remove event?
. I X="^" W !,"Nothing changed!" D UNLOCK S ORQUIT=1 H 1 Q
. Q:'X W !!,"Removing release event ..."
. S ORIFN=0 F S ORIFN=$O(ORDERS(ORIFN)) Q:ORIFN<1 D
.. S EVT=+$P($G(^OR(100,ORIFN,0)),U,17),OREVT(EVT)=""
.. D CHGEVT^OREVNTX(ORIFN,""),UNLK1^ORX2(ORIFN) W "."
. W " done." S OREBUILD=1
ED2 W !!,$$CURRENT S ORP=$$PTEVENT(+ORVP,1)
I ORP="^" W !,"Nothing changed!" D UNLOCK H 1 Q
W !!,"Setting release event to "_$P(ORP,U,2)_" ..."
S ORIFN=0 F S ORIFN=$O(ORDERS(ORIFN)) Q:ORIFN<1 D
. S EVT=+$P($G(^OR(100,ORIFN,0)),U,17) Q:EVT=+ORP S OREVT(EVT)=""
. D CHGEVT^OREVNTX(ORIFN,+ORP),UNLK1^ORX2(ORIFN) W "."
W " done." S OREBUILD=1
ED3 S EVT=0 F S EVT=$O(OREVT(EVT)) Q:EVT<1 D ;terminate any events?
. Q:$G(^ORE(100.2,EVT,1)) Q:'$$EMPTY^OREVNTX(EVT) ;active,empty
. ;W !!,$P($$NAME^OREVNTX(EVT)," ",2,99)_" has no more delayed orders."
. ;S DIR(0)="YA",DIR("A")="Do you want to cancel this event? "
. ;S DIR("?")="Enter NO if you wish to enter new delayed orders for this event, otherwise enter YES to terminate it."
. ;S DIR("B")="YES" D ^DIR I $D(DTOUT)!$D(DUOUT) S ORQUIT=1 Q
. D CANCEL^OREVNTX(EVT) S X=$P($$NAME^OREVNTX(EVT)," ",2,99)
. W !," ... "_X_" event cancelled." H 1
. D:$G(OREVENT) EX ;Change view back to Active
Q
;
ACTIVE() ; -- Return to Active orders?
N X,Y,DIR S DIR(0)="YA"
S DIR("A")="Return to viewing Active Orders? ",DIR("B")="YES"
S DIR("?")="Enter NO to select another delayed order sheet to view, or YES to exit delayed mode and return to your default Orders view."
D ^DIR S:$D(DTOUT)!$D(DUOUT) Y="^"
Q Y
;
DELAYED() ; -- Return 1 or 0, if current view=EDOs
I $G(OREVENT) Q 1
N X,Y S X=$P($G(^TMP("OR",$J,ORTAB,0)),U,3),X=$P(X,";",3)
S Y=$S("^15^16^17^24^25^"[(U_X_U):1,1:0)
Q Y
;
NODELAY() ; -- Return 1 or 0, if event should be removed
N X,Y,DIR S DIR(0)="YA"
S DIR("A")="Remove the release event from these orders? ",DIR("B")="NO"
S DIR("?")="Enter YES to allow these orders to be released immediately upon signature, or NO to continue and keep this event or select another."
D ^DIR S:$D(DTOUT)!$D(DUOUT) Y="^"
Q Y
;
UNLOCK ; -- Unlock orders after ^
F S ORIFN=$O(ORDERS(ORIFN)) Q:ORIFN'>0 D UNLK1^ORX2(+ORIFN)
Q
;
CURRENT() ; -- Display current patient data
N Y S Y=ORPNM_" is currently"_$S('$G(ORWARD):" not",1:"")_" admitted"_$S($G(ORWARD)&$G(ORTS):" to "_$P($G(^DIC(45.7,+ORTS,0)),U),1:"")_"."
Q Y
;
PTEVENT(DFN,DLGONLY) ; -- Select Patient Event [or create new one]
; Pass in DLGONLY=1 to skip new event's Order Set (from Copy, Xfer)
; Returns Pt Evt ien ^ Event name
I '$G(DFN)!'$D(^DPT(+$G(DFN),0)) Q "^" ;invalid patient
N ORPTEVT,OREVT,X,Y,DIR,DTOUT,DUOUT,ORDIV,DOMAIN,OREV0,ORDAD,ORDIALOG,ORDSET,ORIFN,ORPTLK,OREBUILD,OREVENT
I $D(^ORE(100.2,"AE",DFN)) D ;pending events
. N CNT,EVT S (CNT,EVT)=0,DOMAIN=100.2 K ORPTEVT,DIR
. F S EVT=+$O(^ORE(100.2,"AE",DFN,EVT)) Q:EVT'>0 S Y=+$O(^(EVT,0)) D
.. Q:$G(^ORE(100.2,Y,1)) Q:$$LAPSED^OREVNTX(Y) Q:$D(^ORE(100.2,"DAD",Y))
.. S X=$P($G(^ORD(100.5,EVT,0)),U,8),CNT=CNT+1,ORPTEVT(CNT)=Y_U_X
.. S X=$$UP^XLFSTR(X),ORPTEVT("B",X)=Y
. Q:CNT'>0 S DIR("A",1)="Delayed orders exist for "_ORPNM_" for the following events:"
. F I=1:1:CNT S DIR("A",I+1)=$J(I,5)_" "_$P(ORPTEVT(I),U,2)
. S DIR("A",CNT+2)="To review or add delayed orders, select from (1-"_CNT_") or enter a new event."
S X=+$$GET^XPAR("ALL","OREVNT DEFAULT")
I X S Y=$P($G(^ORD(100.5,X,0)),U,8),DIR("B")=$$UP^XLFSTR(Y)
PT1 S I=0 F S I=+$O(DIR("A",I)) Q:I<1 W !,DIR("A",I)
W !,"Select RELEASE EVENT: "_$S($L($G(DIR("B"))):DIR("B")_"//",1:"")
R X:DTIME I '$T!(X["^")!(X=""&'$D(DIR("B"))) Q "^"
S:X="" X=$G(DIR("B")) I X["?" D HELP^OREVNT(X) G PT1
I $O(DIR("A",0)) S ORPTEVT=$$FIND^ORCDLG2("ORPTEVT",X) G:$L(ORPTEVT) PTQ
S OREVT="" D I OREVT<1 G PT1 ;reask
. N DIC,DIR,D S DIC="^ORD(100.5,",DIC(0)="EQZS",D="C",DIC("W")=""
. S DIC("S")="I '$D(^ORD(100.5,""DAD"",Y))"
. ;S:'$G(ORWARD) DIC("S")="I $P(^(0),U,2)=""A"""
. D IX^DIC S:Y>0 OREVT=+Y_U_$P(Y(0),U,8)
I $$MATCH(DFN,+OREVT),'$$CONT G PT1 ;reask
S OREV0=$G(^ORD(100.5,+OREVT,0)),ORDAD=+$P(OREV0,U,12)
S ORDIALOG=+$P(OREV0,U,4),ORDSET=+$P(OREV0,U,5)
I 'ORDIALOG,'ORDSET!$G(DLGONLY),'ORDAD S ORPTEVT=$$NEW(DFN,+OREVT) S:ORPTEVT<1 ORPTEVT="^" G PTQ
PT2 S ORPTLK=$$LOCK^ORX2(DFN) I 'ORPTLK W !!,$C(7),$P(ORPTLK,U,2) H 2 Q "^"
S ORNP=$$PROVIDER^ORCMENU1 I ORNP="^" Q "^"
I ORDAD D I $G(ORIFN)="^" Q "^" ;parent
. N OREVT S OREVT=ORDAD,ORDIALOG=+$P($G(^ORD(100.5,ORDAD,0)),U,4)
. I ORDIALOG S ORIFN=+$$ORDER^ORCDLG(ORDIALOG) I ORIFN<1 S ORIFN="^" Q
. S ORPTEVT=$$NEW(DFN,ORDAD,$G(ORIFN)),ORDIALOG="" K ORIFN
I ORDIALOG S ORIFN=+$$ORDER^ORCDLG(ORDIALOG) I ORIFN<1 Q "^"
S ORPTEVT=$$NEW(DFN,+OREVT,$G(ORIFN)) I ORPTEVT<1 Q "^"
I ORDSET,'$G(DLGONLY) S OREVENT=+ORPTEVT D EN^ORCDLG(ORDSET) K ^TMP("ORECALL",$J)
D:'$D(^TMP("ORNEW",$J)) UNLOCK^ORX2(DFN) ;unlock if no new orders
PTQ Q ORPTEVT
;
HELP(RSP) ; -- ?help for DIR Event lookup
N X,Y,Z,CNT,DONE
W !,"Select the release event for which you wish to delay orders."
W !,"Choose from:" S CNT=1
S X="" F S X=$O(^ORD(100.5,"C",X)) Q:X="" D Q:$G(DONE)
. S Y=0 F S Y=$O(^ORD(100.5,"C",X,Y)) Q:Y<1 D Q:$G(DONE)
.. Q:$O(^ORD(100.5,"DAD",Y,0)) ;Parent event
.. S TYPE=$P($G(^ORD(100.5,Y,0)),U,2)
.. I RSP="?" Q:TYPE="A"&$G(ORWARD) Q:TYPE'="A"&'$G(ORWARD)
.. W !," "_X S CNT=CNT+1 Q:CNT'>(IOSL-3) S CNT=0
.. W !," '^' TO STOP: " R Z:DTIME S:'$T!(Z["^") DONE=1
Q
;
NEW(DFN,EVT,IFN) ; -- Create new Patient Event in #100.2
I '$G(DFN) Q "^"
N I,HDR,LAST,TOTAL,DA,ADM,DAD,X0
F I=1:1:10 L +^ORE(100.2,0):1 Q:$T H 2
I '$T Q "^"
S HDR=$G(^ORE(100.2,0)),TOTAL=+$P(HDR,U,4),LAST=$O(^ORE(100.2,"?"),-1)
S I=LAST F I=(I+1):1 Q:'$D(^ORE(100.2,I,0))
S DA=I,$P(HDR,U,3,4)=DA_U_(TOTAL+1),DFN=+DFN
S ^ORE(100.2,0)=HDR ;195 Moved unlock to later in code
S X0=$G(^ORD(100.5,+$G(EVT),0)) I $P(X0,U,12) D ;link to parent event
. S DAD=+$P(X0,U,12),$P(X0,U,2)=$P($G(^ORD(100.5,DAD,0)),U,2)
. S DAD=+$O(^ORE(100.2,"AE",DFN,DAD,0)) Q:DAD<1
. S $P(^ORE(100.2,DA,1),U,5)=DAD,^ORE(100.2,"DAD",DAD,DA)=""
S ADM=$S('$G(EVT):$G(VAIP(13)),$P(X0,U,2)="A":"",$P(X0,U,2)="T"&$$NHCU(EVT):"",1:+$G(^DPT(DFN,.105)))
S ^ORE(100.2,"B",DFN,DA)="" S:$G(IFN) IFN=+IFN
S ^ORE(100.2,DA,0)=DFN_U_$G(EVT)_U_ADM_U_$G(IFN)_U_+$E($$NOW^XLFDT,1,12)_U_$G(DUZ)
S:$G(EVT) ^ORE(100.2,"E",EVT,DA)="",^ORE(100.2,"AE",DFN,EVT,DA)=""
I $G(IFN) S ^ORE(100.2,"AO",IFN,DA)="",$P(^OR(100,IFN,0),U,17)=DA,^OR(100,"AEVNT",DFN_";DPT(",DA,IFN)=""
L -^ORE(100.2,0) ;195 Unlock after global is set
Q DA
;
NHCU(OREVT) ; -- Returns 1 or 0, if EVT is to NHCU
N ORI,ORX,ORY S (ORI,ORY)=0
F S ORI=$O(^ORD(100.5,+$G(OREVT),"TS",ORI)) Q:ORI<1 S ORX=+$G(^(ORI,0)) I $$GET1^DIQ(45.7,ORX_",","SPECIALTY:SERVICE")="NHCU" S ORY=1 Q ;DBIA #1154
Q ORY
;
DELETE(DA) ; -- Delete Patient Event
N DIK S DIK="^ORE(100.2," D:$G(DA) ^DIK
Q
;
MATCH(DFN,EVT) ; -- Does Pt's current data match selected Event?
N X0,Y,LOC,WD,TS,PEVT ;177 This section updated to account for child events
S PEVT=$P($G(^ORD(100.5,EVT,0)),U,12) ;177 Is this a child event?
S X0=$G(^ORD(100.5,$S($G(PEVT):PEVT,1:EVT),0)),Y=1 ;177
I "^D^O^M^"[(U_$P(X0,U,2)_U) S Y=0 G MQ
S LOC=$S($G(ORL):+ORL,1:+$$CURRLOC(DFN)),WD=+$G(^SC(LOC,42))
I $$DIV^ORMEVNT(LOC)'=$P(X0,U,3) S Y=0 G MQ
S TS=$S($G(ORTS):+ORTS,1:+$G(^DPT(DFN,.103)))
I $O(^ORD(100.5,$S($G(PEVT):PEVT,1:EVT),"TS",0)),'$D(^("B",TS)) S Y=0 G MQ ;177
I $O(^ORD(100.5,$S($G(PEVT):PEVT,1:EVT),"LOC",0)),'$D(^("B",WD)) S Y=0 G MQ ;177
MQ Q Y
;
CURRLOC(DFN) ; -- Return current Hospital Location (ptr to #44) of patient DFN
N X,Y S X=$P($G(^DPT(DFN,.1)),U),Y=""
I $L(X) S X=+$O(^DIC(42,"B",X,0)),Y=+$G(^DIC(42,X,44))
Q Y
;
CONT() ; -- ok to continue?
N X,Y,DIR
S DIR("A",1)=ORPNM_" is already assigned to "_$P($G(^DIC(45.7,+$G(ORTS),0)),U)_" on "_$P($G(^SC(+$G(ORL),0)),U)_"!"
S DIR(0)="YA",DIR("A")="Do you still want to add future orders? "
S DIR("?")="Enter YES to add orders that will be delayed until this event occurs in the future, or NO to quit."
S DIR("B")="NO" W ! D ^DIR S:$D(DTOUT)!$D(DUOUT) Y="^"
Q Y
OREVNT ; SLC/MKB - Event delayed orders ;3/31/04 13:42 [4/9/04 10:20am]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141,177,195**;Dec 17, 1997
+2 ;
EN ; -- view/add EVOs
+1 NEW X,ORP,ORQUIT
SET VALMBCK=""
+2 IF $GET(OREVENT)
Begin DoDot:1
+3 ;return to Active Orders
SET X=$$ACTIVE
IF X
DO EX
SET ORQUIT=1
QUIT
+4 IF X="^"
SET ORQUIT=1
QUIT
End DoDot:1
IF $GET(ORQUIT)
QUIT
+5 DO FULL^VALM1
SET VALMBCK="R"
+6 WRITE !!,$$CURRENT
+7 IF '$GET(ORL)
SET ORL=$$LOCATION^ORCMENU1
IF ORL="^"
QUIT
+8 SET ORP=$$PTEVENT(+ORVP)
IF ORP="^"
QUIT
+9 SET $PIECE(^TMP("OR",$JOB,"ORDERS",0),U,3,4)=";;;;;;;"_+ORP_U
SET OREVENT=+ORP
+10 ;redisplay new order sheet/view
DO TAB^ORCHART(ORTAB,1)
+11 QUIT
+12 ;
EX ; -- Back to Active Orders
+1 ;cancel empty events
IF +$GET(OREVENT)
IF '$GET(^ORE(100.2,OREVENT,1))
IF $$EMPTY^OREVNTX(OREVENT)
DO CANCEL^OREVNTX(OREVENT)
+2 ;default view
KILL OREVENT
SET $PIECE(^TMP("OR",$JOB,"ORDERS",0),U,3,4)="^1"
+3 DO TAB^ORCHART(ORTAB,1)
+4 QUIT
+5 ;
ED ; -- Change delay event
+1 NEW ORI,NMBR,IDX,ORIFN,ORLK,ORDERS,OREVT,ORQUIT,X,EVT
+2 IF '$GET(ORNMBR)
SET ORNMBR=$$ORDERS^ORCHART("change the delay event")
IF 'ORNMBR
QUIT
+3 DO FREEZE^ORCMENU
SET VALMBCK="R"
KILL OREBUILD
+4 FOR ORI=1:1:$LENGTH(ORNMBR)
SET NMBR=$PIECE(ORNMBR,",",ORI)
IF NMBR
Begin DoDot:1
+5 SET IDX=$GET(^TMP("OR",$JOB,ORTAB,"IDX",NMBR))
SET ORIFN=$PIECE(IDX,U)
+6 ;unsign/unrel only
IF 'ORIFN
QUIT
IF '$PIECE(ORIFN,";",2)
SET ORIFN=+ORIFN_";1"
+7 IF '$$VALID^ORCACT0(ORIFN,"EV",.ORERR)
WRITE !!,$$ORDITEM^ORCACT(ORIFN)_" invalid.",!," >> "_ORERR
HANG 1
QUIT
+8 SET ORLK=$$LOCK1^ORX2(+ORIFN)
IF 'ORLK
WRITE !!,$$ORDITEM^ORCACT(ORIFN)_" invalid.",!," >> "_$PIECE(ORLK,U,2)
HANG 1
QUIT
+9 SET ORDERS(+ORIFN)=""
End DoDot:1
IF $DATA(ORQUIT)
QUIT
ED1 IF '$ORDER(ORDERS(0))
QUIT
IF $$DELAYED
Begin DoDot:1
+1 ;remove event?
SET X=$$NODELAY
+2 IF X="^"
WRITE !,"Nothing changed!"
DO UNLOCK
SET ORQUIT=1
HANG 1
QUIT
+3 IF 'X
QUIT
WRITE !!,"Removing release event ..."
+4 SET ORIFN=0
FOR
SET ORIFN=$ORDER(ORDERS(ORIFN))
IF ORIFN<1
QUIT
Begin DoDot:2
+5 SET EVT=+$PIECE($GET(^OR(100,ORIFN,0)),U,17)
SET OREVT(EVT)=""
+6 DO CHGEVT^OREVNTX(ORIFN,"")
DO UNLK1^ORX2(ORIFN)
WRITE "."
End DoDot:2
+7 WRITE " done."
SET OREBUILD=1
End DoDot:1
IF $GET(ORQUIT)
QUIT
IF $GET(OREBUILD)
GOTO ED3
ED2 WRITE !!,$$CURRENT
SET ORP=$$PTEVENT(+ORVP,1)
+1 IF ORP="^"
WRITE !,"Nothing changed!"
DO UNLOCK
HANG 1
QUIT
+2 WRITE !!,"Setting release event to "_$PIECE(ORP,U,2)_" ..."
+3 SET ORIFN=0
FOR
SET ORIFN=$ORDER(ORDERS(ORIFN))
IF ORIFN<1
QUIT
Begin DoDot:1
+4 SET EVT=+$PIECE($GET(^OR(100,ORIFN,0)),U,17)
IF EVT=+ORP
QUIT
SET OREVT(EVT)=""
+5 DO CHGEVT^OREVNTX(ORIFN,+ORP)
DO UNLK1^ORX2(ORIFN)
WRITE "."
End DoDot:1
+6 WRITE " done."
SET OREBUILD=1
ED3 ;terminate any events?
SET EVT=0
FOR
SET EVT=$ORDER(OREVT(EVT))
IF EVT<1
QUIT
Begin DoDot:1
+1 ;active,empty
IF $GET(^ORE(100.2,EVT,1))
QUIT
IF '$$EMPTY^OREVNTX(EVT)
QUIT
+2 ;W !!,$P($$NAME^OREVNTX(EVT)," ",2,99)_" has no more delayed orders."
+3 ;S DIR(0)="YA",DIR("A")="Do you want to cancel this event? "
+4 ;S DIR("?")="Enter NO if you wish to enter new delayed orders for this event, otherwise enter YES to terminate it."
+5 ;S DIR("B")="YES" D ^DIR I $D(DTOUT)!$D(DUOUT) S ORQUIT=1 Q
+6 DO CANCEL^OREVNTX(EVT)
SET X=$PIECE($$NAME^OREVNTX(EVT)," ",2,99)
+7 WRITE !," ... "_X_" event cancelled."
HANG 1
+8 ;Change view back to Active
IF $GET(OREVENT)
DO EX
End DoDot:1
+9 QUIT
+10 ;
ACTIVE() ; -- Return to Active orders?
+1 NEW X,Y,DIR
SET DIR(0)="YA"
+2 SET DIR("A")="Return to viewing Active Orders? "
SET DIR("B")="YES"
+3 SET DIR("?")="Enter NO to select another delayed order sheet to view, or YES to exit delayed mode and return to your default Orders view."
+4 DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET Y="^"
+5 QUIT Y
+6 ;
DELAYED() ; -- Return 1 or 0, if current view=EDOs
+1 IF $GET(OREVENT)
QUIT 1
+2 NEW X,Y
SET X=$PIECE($GET(^TMP("OR",$JOB,ORTAB,0)),U,3)
SET X=$PIECE(X,";",3)
+3 SET Y=$SELECT("^15^16^17^24^25^"[(U_X_U):1,1:0)
+4 QUIT Y
+5 ;
NODELAY() ; -- Return 1 or 0, if event should be removed
+1 NEW X,Y,DIR
SET DIR(0)="YA"
+2 SET DIR("A")="Remove the release event from these orders? "
SET DIR("B")="NO"
+3 SET DIR("?")="Enter YES to allow these orders to be released immediately upon signature, or NO to continue and keep this event or select another."
+4 DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET Y="^"
+5 QUIT Y
+6 ;
UNLOCK ; -- Unlock orders after ^
+1 FOR
SET ORIFN=$ORDER(ORDERS(ORIFN))
IF ORIFN'>0
QUIT
DO UNLK1^ORX2(+ORIFN)
+2 QUIT
+3 ;
CURRENT() ; -- Display current patient data
+1 NEW Y
SET Y=ORPNM_" is currently"_$SELECT('$GET(ORWARD):" not",1:"")_" admitted"_$SELECT($GET(ORWARD)&$GET(ORTS):" to "_$PIECE($GET(^DIC(45.7,+ORTS,0)),U),1:"")_"."
+2 QUIT Y
+3 ;
PTEVENT(DFN,DLGONLY) ; -- Select Patient Event [or create new one]
+1 ; Pass in DLGONLY=1 to skip new event's Order Set (from Copy, Xfer)
+2 ; Returns Pt Evt ien ^ Event name
+3 ;invalid patient
IF '$GET(DFN)!'$DATA(^DPT(+$GET(DFN),0))
QUIT "^"
+4 NEW ORPTEVT,OREVT,X,Y,DIR,DTOUT,DUOUT,ORDIV,DOMAIN,OREV0,ORDAD,ORDIALOG,ORDSET,ORIFN,ORPTLK,OREBUILD,OREVENT
+5 ;pending events
IF $DATA(^ORE(100.2,"AE",DFN))
Begin DoDot:1
+6 NEW CNT,EVT
SET (CNT,EVT)=0
SET DOMAIN=100.2
KILL ORPTEVT,DIR
+7 FOR
SET EVT=+$ORDER(^ORE(100.2,"AE",DFN,EVT))
IF EVT'>0
QUIT
SET Y=+$ORDER(^(EVT,0))
Begin DoDot:2
+8 IF $GET(^ORE(100.2,Y,1))
QUIT
IF $$LAPSED^OREVNTX(Y)
QUIT
IF $DATA(^ORE(100.2,"DAD",Y))
QUIT
+9 SET X=$PIECE($GET(^ORD(100.5,EVT,0)),U,8)
SET CNT=CNT+1
SET ORPTEVT(CNT)=Y_U_X
+10 SET X=$$UP^XLFSTR(X)
SET ORPTEVT("B",X)=Y
End DoDot:2
+11 IF CNT'>0
QUIT
SET DIR("A",1)="Delayed orders exist for "_ORPNM_" for the following events:"
+12 FOR I=1:1:CNT
SET DIR("A",I+1)=$JUSTIFY(I,5)_" "_$PIECE(ORPTEVT(I),U,2)
+13 SET DIR("A",CNT+2)="To review or add delayed orders, select from (1-"_CNT_") or enter a new event."
End DoDot:1
+14 SET X=+$$GET^XPAR("ALL","OREVNT DEFAULT")
+15 IF X
SET Y=$PIECE($GET(^ORD(100.5,X,0)),U,8)
SET DIR("B")=$$UP^XLFSTR(Y)
PT1 SET I=0
FOR
SET I=+$ORDER(DIR("A",I))
IF I<1
QUIT
WRITE !,DIR("A",I)
+1 WRITE !,"Select RELEASE EVENT: "_$SELECT($LENGTH($GET(DIR("B"))):DIR("B")_"//",1:"")
+2 READ X:DTIME
IF '$TEST!(X["^")!(X=""&'$DATA(DIR("B")))
QUIT "^"
+3 IF X=""
SET X=$GET(DIR("B"))
IF X["?"
DO HELP^OREVNT(X)
GOTO PT1
+4 IF $ORDER(DIR("A",0))
SET ORPTEVT=$$FIND^ORCDLG2("ORPTEVT",X)
IF $LENGTH(ORPTEVT)
GOTO PTQ
+5 ;reask
SET OREVT=""
Begin DoDot:1
+6 NEW DIC,DIR,D
SET DIC="^ORD(100.5,"
SET DIC(0)="EQZS"
SET D="C"
SET DIC("W")=""
+7 SET DIC("S")="I '$D(^ORD(100.5,""DAD"",Y))"
+8 ;S:'$G(ORWARD) DIC("S")="I $P(^(0),U,2)=""A"""
+9 DO IX^DIC
IF Y>0
SET OREVT=+Y_U_$PIECE(Y(0),U,8)
End DoDot:1
IF OREVT<1
GOTO PT1
+10 ;reask
IF $$MATCH(DFN,+OREVT)
IF '$$CONT
GOTO PT1
+11 SET OREV0=$GET(^ORD(100.5,+OREVT,0))
SET ORDAD=+$PIECE(OREV0,U,12)
+12 SET ORDIALOG=+$PIECE(OREV0,U,4)
SET ORDSET=+$PIECE(OREV0,U,5)
+13 IF 'ORDIALOG
IF 'ORDSET!$GET(DLGONLY)
IF 'ORDAD
SET ORPTEVT=$$NEW(DFN,+OREVT)
IF ORPTEVT<1
SET ORPTEVT="^"
GOTO PTQ
PT2 SET ORPTLK=$$LOCK^ORX2(DFN)
IF 'ORPTLK
WRITE !!,$CHAR(7),$PIECE(ORPTLK,U,2)
HANG 2
QUIT "^"
+1 SET ORNP=$$PROVIDER^ORCMENU1
IF ORNP="^"
QUIT "^"
+2 ;parent
IF ORDAD
Begin DoDot:1
+3 NEW OREVT
SET OREVT=ORDAD
SET ORDIALOG=+$PIECE($GET(^ORD(100.5,ORDAD,0)),U,4)
+4 IF ORDIALOG
SET ORIFN=+$$ORDER^ORCDLG(ORDIALOG)
IF ORIFN<1
SET ORIFN="^"
QUIT
+5 SET ORPTEVT=$$NEW(DFN,ORDAD,$GET(ORIFN))
SET ORDIALOG=""
KILL ORIFN
End DoDot:1
IF $GET(ORIFN)="^"
QUIT "^"
+6 IF ORDIALOG
SET ORIFN=+$$ORDER^ORCDLG(ORDIALOG)
IF ORIFN<1
QUIT "^"
+7 SET ORPTEVT=$$NEW(DFN,+OREVT,$GET(ORIFN))
IF ORPTEVT<1
QUIT "^"
+8 IF ORDSET
IF '$GET(DLGONLY)
SET OREVENT=+ORPTEVT
DO EN^ORCDLG(ORDSET)
KILL ^TMP("ORECALL",$JOB)
+9 ;unlock if no new orders
IF '$DATA(^TMP("ORNEW",$JOB))
DO UNLOCK^ORX2(DFN)
PTQ QUIT ORPTEVT
+1 ;
HELP(RSP) ; -- ?help for DIR Event lookup
+1 NEW X,Y,Z,CNT,DONE
+2 WRITE !,"Select the release event for which you wish to delay orders."
+3 WRITE !,"Choose from:"
SET CNT=1
+4 SET X=""
FOR
SET X=$ORDER(^ORD(100.5,"C",X))
IF X=""
QUIT
Begin DoDot:1
+5 SET Y=0
FOR
SET Y=$ORDER(^ORD(100.5,"C",X,Y))
IF Y<1
QUIT
Begin DoDot:2
+6 ;Parent event
IF $ORDER(^ORD(100.5,"DAD",Y,0))
QUIT
+7 SET TYPE=$PIECE($GET(^ORD(100.5,Y,0)),U,2)
+8 IF RSP="?"
IF TYPE="A"&$GET(ORWARD)
QUIT
IF TYPE'="A"&'$GET(ORWARD)
QUIT
+9 WRITE !," "_X
SET CNT=CNT+1
IF CNT'>(IOSL-3)
QUIT
SET CNT=0
+10 WRITE !," '^' TO STOP: "
READ Z:DTIME
IF '$TEST!(Z["^")
SET DONE=1
End DoDot:2
IF $GET(DONE)
QUIT
End DoDot:1
IF $GET(DONE)
QUIT
+11 QUIT
+12 ;
NEW(DFN,EVT,IFN) ; -- Create new Patient Event in #100.2
+1 IF '$GET(DFN)
QUIT "^"
+2 NEW I,HDR,LAST,TOTAL,DA,ADM,DAD,X0
+3 FOR I=1:1:10
LOCK +^ORE(100.2,0):1
IF $TEST
QUIT
HANG 2
+4 IF '$TEST
QUIT "^"
+5 SET HDR=$GET(^ORE(100.2,0))
SET TOTAL=+$PIECE(HDR,U,4)
SET LAST=$ORDER(^ORE(100.2,"?"),-1)
+6 SET I=LAST
FOR I=(I+1):1
IF '$DATA(^ORE(100.2,I,0))
QUIT
+7 SET DA=I
SET $PIECE(HDR,U,3,4)=DA_U_(TOTAL+1)
SET DFN=+DFN
+8 ;195 Moved unlock to later in code
SET ^ORE(100.2,0)=HDR
+9 ;link to parent event
SET X0=$GET(^ORD(100.5,+$GET(EVT),0))
IF $PIECE(X0,U,12)
Begin DoDot:1
+10 SET DAD=+$PIECE(X0,U,12)
SET $PIECE(X0,U,2)=$PIECE($GET(^ORD(100.5,DAD,0)),U,2)
+11 SET DAD=+$ORDER(^ORE(100.2,"AE",DFN,DAD,0))
IF DAD<1
QUIT
+12 SET $PIECE(^ORE(100.2,DA,1),U,5)=DAD
SET ^ORE(100.2,"DAD",DAD,DA)=""
End DoDot:1
+13 SET ADM=$SELECT('$GET(EVT):$GET(VAIP(13)),$PIECE(X0,U,2)="A":"",$PIECE(X0,U,2)="T"&$$NHCU(EVT):"",1:+$GET(^DPT(DFN,.105)))
+14 SET ^ORE(100.2,"B",DFN,DA)=""
IF $GET(IFN)
SET IFN=+IFN
+15 SET ^ORE(100.2,DA,0)=DFN_U_$GET(EVT)_U_ADM_U_$GET(IFN)_U_+$EXTRACT($$NOW^XLFDT,1,12)_U_$GET(DUZ)
+16 IF $GET(EVT)
SET ^ORE(100.2,"E",EVT,DA)=""
SET ^ORE(100.2,"AE",DFN,EVT,DA)=""
+17 IF $GET(IFN)
SET ^ORE(100.2,"AO",IFN,DA)=""
SET $PIECE(^OR(100,IFN,0),U,17)=DA
SET ^OR(100,"AEVNT",DFN_";DPT(",DA,IFN)=""
+18 ;195 Unlock after global is set
LOCK -^ORE(100.2,0)
+19 QUIT DA
+20 ;
NHCU(OREVT) ; -- Returns 1 or 0, if EVT is to NHCU
+1 NEW ORI,ORX,ORY
SET (ORI,ORY)=0
+2 ;DBIA #1154
FOR
SET ORI=$ORDER(^ORD(100.5,+$GET(OREVT),"TS",ORI))
IF ORI<1
QUIT
SET ORX=+$GET(^(ORI,0))
IF $$GET1^DIQ(45.7,ORX_",","SPECIALTY:SERVICE")="NHCU"
SET ORY=1
QUIT
+3 QUIT ORY
+4 ;
DELETE(DA) ; -- Delete Patient Event
+1 NEW DIK
SET DIK="^ORE(100.2,"
IF $GET(DA)
DO ^DIK
+2 QUIT
+3 ;
MATCH(DFN,EVT) ; -- Does Pt's current data match selected Event?
+1 ;177 This section updated to account for child events
NEW X0,Y,LOC,WD,TS,PEVT
+2 ;177 Is this a child event?
SET PEVT=$PIECE($GET(^ORD(100.5,EVT,0)),U,12)
+3 ;177
SET X0=$GET(^ORD(100.5,$SELECT($GET(PEVT):PEVT,1:EVT),0))
SET Y=1
+4 IF "^D^O^M^"[(U_$PIECE(X0,U,2)_U)
SET Y=0
GOTO MQ
+5 SET LOC=$SELECT($GET(ORL):+ORL,1:+$$CURRLOC(DFN))
SET WD=+$GET(^SC(LOC,42))
+6 IF $$DIV^ORMEVNT(LOC)'=$PIECE(X0,U,3)
SET Y=0
GOTO MQ
+7 SET TS=$SELECT($GET(ORTS):+ORTS,1:+$GET(^DPT(DFN,.103)))
+8 ;177
IF $ORDER(^ORD(100.5,$SELECT($GET(PEVT):PEVT,1:EVT),"TS",0))
IF '$DATA(^("B",TS))
SET Y=0
GOTO MQ
+9 ;177
IF $ORDER(^ORD(100.5,$SELECT($GET(PEVT):PEVT,1:EVT),"LOC",0))
IF '$DATA(^("B",WD))
SET Y=0
GOTO MQ
MQ QUIT Y
+1 ;
CURRLOC(DFN) ; -- Return current Hospital Location (ptr to #44) of patient DFN
+1 NEW X,Y
SET X=$PIECE($GET(^DPT(DFN,.1)),U)
SET Y=""
+2 IF $LENGTH(X)
SET X=+$ORDER(^DIC(42,"B",X,0))
SET Y=+$GET(^DIC(42,X,44))
+3 QUIT Y
+4 ;
CONT() ; -- ok to continue?
+1 NEW X,Y,DIR
+2 SET DIR("A",1)=ORPNM_" is already assigned to "_$PIECE($GET(^DIC(45.7,+$GET(ORTS),0)),U)_" on "_$PIECE($GET(^SC(+$GET(ORL),0)),U)_"!"
+3 SET DIR(0)="YA"
SET DIR("A")="Do you still want to add future orders? "
+4 SET DIR("?")="Enter YES to add orders that will be delayed until this event occurs in the future, or NO to quit."
+5 SET DIR("B")="NO"
WRITE !
DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET Y="^"
+6 QUIT Y
