source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OREVNT1.m@ 1046

Last change on this file since 1046 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 6.9 KB
Line 
1OREVNT1 ;SLC/MKB - Release delayed orders ;3/31/04 09:08
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141,195**;Dec 17, 1997
3 ;
4EN ; -- start here
5 I '$$CANREL^OREV3() W !,"Insufficient privilege!" H 1 Q
6 N ORPTLK,ORLR,ORACT,ORNATR,ORI,NMBR,IDX,ORDER,ORIFN,ORDA,ORQUIT,ORES,ORWAIT,ORSIG,OREL,ORPRNT,ORPRINT,ORCHART,ORWORK,ORLAB,OR0,ORA0,ORERR,ORCL,OREVT,OREVENT,J ;195
7 S ORPTLK=$$LOCK^ORX2(+ORVP) I 'ORPTLK W !!,$C(7),$P(ORPTLK,U,2) H 2 Q
8 I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("") G:'ORNMBR ENQ
9 D FREEZE^ORCMENU S VALMBCK="R" K OREBUILD
10 S ORL=$$LOCATION^ORCMENU1 G:ORL="^" ENQ ;I '$G(ORL)
11 S ORLR=+$O(^DIC(9.4,"C","LR",0)),(ORACT,ORNATR)=""
12 I $$NEEDSIG S ORACT=$S($D(^XUSEC("ORES",DUZ)):"ES",$D(^XUSEC("OREMAS",DUZ)):"OC",$D(^XUSEC("ORELSE",DUZ)):$$SELSIG^ORCSIGN,1:"^") G:ORACT="^" ENQ
13 F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) I NMBR D
14 . S IDX=$G(^TMP("OR",$J,ORTAB,"IDX",NMBR)),ORDER=$P(IDX,U)
15 . Q:'ORDER S:'$P(ORDER,";",2) ORDER=+ORDER_";1"
16 . S ORIFN=+ORDER,ORDA=+$P(ORDER,";",2) K ORQUIT
17 . D VALID Q:$G(ORQUIT) S ORES(ORDER)=""
18 . S:$P($G(^OR(100,ORIFN,0)),U,14)=ORLR ORES("LAB")=1
19EN1 G:'$O(ORES(0)) ENQ K ORQUIT,ORWAIT
20 ;D ORDCHK^ORCMENU1 G:'$O(ORES(0)) ENQ0
21 ;I $G(ORQUIT) D UNLOCK G ENQ ;quit - ^ at override reason
22 S ORSIG=$S($G(ORES("ES")):2,1:""),OREL=$S(ORSIG:0,1:1)
23 I ORSIG D I ORSIG=2,'OREL W !,"Nothing signed or released!" D UNLOCK H 2 G ENQ
24 . I ORACT="ES" S:$$ESIG^ORCSIGN ORSIG=1,OREL=1 Q
25 . I ORACT="OC" S:$$ONCHART^ORCSIGN ORSIG=0,OREL=1,ORNATR="W" Q
26 . S ORNATR=$$NATURE^ORCSIGN Q:ORNATR="^" ;ORACT="RS"
27 . W:ORNATR'="I" !!,"A signature is required to RELEASE these orders; the responsible provider will",!,"be alerted to electronically sign them."
28 . S:$$ESIG^ORCSIGN ORSIG=$S(ORNATR="I":1,1:$$SIGSTS^ORX1(ORNATR)),OREL=1
29 S ORPRNT=$$GET^XPAR("ALL","ORPF PRINT CHART COPY WHEN")
30 S (ORPRINT,ORCHART,ORWORK,ORLAB)=0
31 I '$D(^XUSEC("ORES",DUZ))!$$GET^XPAR("ALL","ORPF SHOW LAB #") S ORLAB=ORLR ;show Lab# when released
32 W !!,"Processing orders ..." D:$G(ORES("LAB")) BHS^ORMBLD(ORVP)
33EN2 S ORDER=0 F S ORDER=$O(ORES(ORDER)) Q:ORDER'>0 D
34 . S OR0=$G(^OR(100,+ORDER,0)),ORA0=$G(^(8,+$P(ORDER,";",2),0))
35 . I '$$LCKEVT^ORX2($P(OR0,U,17)) S EVENT($P(OR0,U,17))="" Q ;195 Don't process if event locked
36 . N ORNP S ORNP=$P(ORA0,U,3),ORIFN=+ORDER,ORDA=+$P(ORDER,";",2)
37 . S:$G(ORL) $P(^OR(100,ORIFN,0),U,10)=ORL ;set location
38 . S:$G(ORTS) $P(^OR(100,ORIFN,0),U,13)=ORTS ;set specialty
39 . D EN2^ORCSEND(ORDER,ORSIG,ORNATR,.ORERR),UNLK1^ORX2(ORIFN)
40 . I $D(^TMP("ORNEW",$J,ORIFN,ORDA)) K ^(ORDA) D UNLK1^ORX2(ORIFN)
41 . I $G(ORERR) D S ORWAIT=1 Q
42 . . W !!,$$ORDITEM^ORCACT(ORDER)_" "_$$STATUS^ORCSIGN(ORDER)
43 . . W:$L($P($G(ORERR),U,2)) !," >> "_$P(ORERR,U,2)
44 . I $P(OR0,U,14)=ORLAB,$G(^OR(100,ORIFN,4)) W !,$$ORDITEM^ORCACT(ORIFN)_" (LB #"_+^OR(100,ORIFN,4)_")" S ORWAIT=1
45 . S ORV=+$P(OR0,U,17),OREVT(ORV)="" D SETPRINT(ORNATR)
46 . D:$$TYPE^OREVNTX(ORV)="M" SAVE^ORMEVNT1(ORIFN,ORV,2) W "."
47 D:$G(ORES("LAB")) BTS^ORMBLD(ORVP)
48EN3 I $O(ORCHART(0))!$O(ORPRINT(0)) S ORCL=$$LOC^ORMEVNT I ORCL,ORCL'=ORL D
49 . N X,Y,DIR S DIR(0)="YA",DIR("B")="YES"
50 . S DIR("A",1)="This patient's location has been changed to "_$P($G(^SC(+ORCL,0)),U)_"."
51 . S DIR("A")="Should the orders be printed using the new location? "
52 . S DIR("?")="Enter NO to continue using "_$P($G(^SC(+ORL,0)),U)_" for ordering and printing, or YES to switch to the patient's current location instead"
53 . D ^DIR S:Y ORL=ORCL
54 D:$O(ORCHART(0)) PRINT^ORPR02(ORVP,.ORCHART,,ORL,"1^0^0^0^0")
55 D:$O(ORPRINT(0)) PRINT^ORPR02(ORVP,.ORPRINT,,ORL,"0^1^1^1^0")
56 D:$O(ORWORK(0)) PRINT^ORPR02(ORVP,.ORWORK,,ORL,"0^0^0^0^1")
57ENQ0 D UNOTIF^ORCSIGN,EMPTY S OREBUILD=1
58ENQ D:'$D(^TMP("ORNEW",$J)) UNLOCK^ORX2(+ORVP) D:$G(ORWAIT) READ ;output
59 I $D(EVENT) W !!,"Orders not released >> Delayed event being processed by another user!" D READ S J=0 F S J=$O(EVENT(J)) Q:'+J D UNLEVT^ORX2(J) ;195
60 Q
61 ;
62SETPRINT(NATR) ; -- Set print arrays
63 S:'$L(NATR)!($P(ORA0,U,4)'=2) NATR=$P(ORA0,U,12)
64 S ORPRINT=ORPRINT+1,ORPRINT(ORPRINT)=ORDER
65 I ("R"[ORPRNT)!(ORPRNT="S"&($P(ORA0,U,4)=2)&(ORSIG'=2)),$$CHART^ORX1(NATR) S ORCHART=ORCHART+1,ORCHART(ORCHART)=ORDER
66 S:$$WORK(NATR) ORWORK=ORWORK+1,ORWORK(ORWORK)=ORDER
67 Q
68 ;
69WORK(NATR) ; -- Returns 1 or 0, to print work copies for NATR
70 S:$G(NATR)="" NATR="E" S:'NATR NATR=+$O(^ORD(100.02,"C",NATR,0))
71 Q +$P($G(^ORD(100.02,NATR,1)),U,5)
72 ;
73NEEDSIG() ; -- Return 1 or 0, if any selected orders need ES
74 N ORI,NMBR,ORIFN,ORDA,Y S Y=0
75 F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) I NMBR D Q:Y
76 . S ORIFN=$P($G(^TMP("OR",$J,ORTAB,"IDX",NMBR)),U) Q:'ORIFN
77 . S ORDA=+$P(ORIFN,";",2),ORIFN=+ORIFN S:'ORDA ORDA=1
78 . S:$P($G(^OR(100,ORIFN,8,ORDA,0)),U,4)=2 ORES("ES")=1,Y=1
79 Q Y
80 ;
81VALID ; -- validate ORDER for signature/release
82 I '$$VALID^ORCACT0(ORDER,"MN",.ORERR) W !!,"Cannot release "_$$ORDITEM^ORCACT(ORDER),!," >> "_ORERR S (ORQUIT,ORWAIT)=1 Q
83 I $L(ORACT),$P($G(^OR(100,ORIFN,8,ORDA,0)),U,4)=2,'$$VALID^ORCACT0(ORDER,ORACT,.ORERR,ORNATR) W !!,"Cannot sign "_$$ORDITEM^ORCACT(ORDER),!," >> "_ORERR S (ORQUIT,ORWAIT)=1 Q
84 N ORLK,ORDIALOG S ORLK=$$LOCK1^ORX2(ORIFN)
85 I 'ORLK W !!,"Cannot release "_$$ORDITEM^ORCACT(ORDER),!," >> "_$P(ORLK,U,2) S (ORQUIT,ORWAIT)=1 Q ;order locked
86 S ORDIALOG=+$P($G(^OR(100,ORIFN,0)),U,5)
87 I $L($G(^ORD(101.41,ORDIALOG,7))) X ^(7) D:$G(ORQUIT) UNLK1^ORX2(ORIFN)
88 Q
89 ;
90EMPTY ; -- check if no more orders for events in OREVT()
91 N EVT,X
92 S EVT=0 F S EVT=$O(OREVT(EVT)) Q:EVT<1 D ;terminate any events?
93 . Q:$G(^ORE(100.2,EVT,1)) Q:'$$EMPTY^OREVNTX(EVT) ;active,empty
94 . ;W !!,$P($$NAME^OREVNTX(EVT)," ",2,99)_" has no more delayed orders."
95 . ;S DIR(0)="YA",DIR("A")="Do you want to terminate this event? "
96 . ;S DIR("?")="Enter NO if you wish to enter new delayed orders for this event, otherwise enter YES to terminate it."
97 . ;S DIR("B")="YES" D ^DIR I $D(DTOUT)!$D(DUOUT) S ORQUIT=1 Q
98 . D DONE^OREVNTX(EVT),ACTLOG^OREVNTX(EVT,"MN")
99 . S X=$P($$NAME^OREVNTX(EVT)," ",2,99)
100 . W !," ... "_X_" event completed." H 1
101 . D:$G(OREVENT) EX^OREVNT ;return view to Active
102 Q
103 ;
104UNLOCK ; -- Unlock orders in ORES(ORDER)
105 N ORIFN S ORIFN=0
106 F S ORIFN=$O(ORES(ORIFN)) Q:ORIFN'>0 D UNLK1^ORX2(+ORIFN)
107 Q
108 ;
109READ ; -- Press return to continue
110 N X,Y,DIR
111 S DIR(0)="EA",DIR("A")="Press <return> to continue ..."
112 D ^DIR
113 Q
114 ;
115DONE() ; -- OREVENT done?
116 Q:'$G(^ORE(100.2,+$G(OREVENT),1)) 0 ;not done yet
117 D FULL^VALM1
118 W !!,"The event "_$$NAME^OREVNTX(OREVENT)_" has occurred since"
119 W !,"you started writing delayed orders. The orders that were signed have now been"
120 W !,"released; any unsigned orders will be released immediately upon signature."
121 W !!,"To write new delayed orders for this event you must select the Delayed Orders"
122 W !,"action and this release event again. Orders delayed to this same event will"
123 W !,"remain delayed until the event occurs again."
124 W !!,"The Orders tab will now be refreshed in the Active Orders view; you may then"
125 W !,"write active orders for this patient as usual."
126 D READ S XQORQUIT=1 D EX^OREVNT ;return view to Active
127 Q 1
Note: See TracBrowser for help on using the repository browser.