source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OREVNT.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 9.4 KB
Line 
1OREVNT ; SLC/MKB - Event delayed orders ;3/31/04 13:42 [4/9/04 10:20am]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141,177,195**;Dec 17, 1997
3 ;
4EN ; -- view/add EVOs
5 N X,ORP,ORQUIT S VALMBCK=""
6 I $G(OREVENT) D Q:$G(ORQUIT)
7 . S X=$$ACTIVE I X D EX S ORQUIT=1 Q ;return to Active Orders
8 . I X="^" S ORQUIT=1 Q
9 D FULL^VALM1 S VALMBCK="R"
10 W !!,$$CURRENT
11 S:'$G(ORL) ORL=$$LOCATION^ORCMENU1 Q:ORL="^"
12 S ORP=$$PTEVENT(+ORVP) Q:ORP="^"
13 S $P(^TMP("OR",$J,"ORDERS",0),U,3,4)=";;;;;;;"_+ORP_U,OREVENT=+ORP
14 D TAB^ORCHART(ORTAB,1) ;redisplay new order sheet/view
15 Q
16 ;
17EX ; -- Back to Active Orders
18 I +$G(OREVENT),'$G(^ORE(100.2,OREVENT,1)),$$EMPTY^OREVNTX(OREVENT) D CANCEL^OREVNTX(OREVENT) ;cancel empty events
19 K OREVENT S $P(^TMP("OR",$J,"ORDERS",0),U,3,4)="^1" ;default view
20 D TAB^ORCHART(ORTAB,1)
21 Q
22 ;
23ED ; -- Change delay event
24 N ORI,NMBR,IDX,ORIFN,ORLK,ORDERS,OREVT,ORQUIT,X,EVT
25 I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("change the delay event") Q:'ORNMBR
26 D FREEZE^ORCMENU S VALMBCK="R" K OREBUILD
27 F ORI=1:1:$L(ORNMBR) S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)
28 . S IDX=$G(^TMP("OR",$J,ORTAB,"IDX",NMBR)),ORIFN=$P(IDX,U)
29 . Q:'ORIFN S:'$P(ORIFN,";",2) ORIFN=+ORIFN_";1" ;unsign/unrel only
30 . I '$$VALID^ORCACT0(ORIFN,"EV",.ORERR) W !!,$$ORDITEM^ORCACT(ORIFN)_" invalid.",!," >> "_ORERR H 1 Q
31 . S ORLK=$$LOCK1^ORX2(+ORIFN) I 'ORLK W !!,$$ORDITEM^ORCACT(ORIFN)_" invalid.",!," >> "_$P(ORLK,U,2) H 1 Q
32 . S ORDERS(+ORIFN)=""
33ED1 Q:'$O(ORDERS(0)) I $$DELAYED D Q:$G(ORQUIT) G:$G(OREBUILD) ED3
34 . S X=$$NODELAY ;remove event?
35 . I X="^" W !,"Nothing changed!" D UNLOCK S ORQUIT=1 H 1 Q
36 . Q:'X W !!,"Removing release event ..."
37 . S ORIFN=0 F S ORIFN=$O(ORDERS(ORIFN)) Q:ORIFN<1 D
38 .. S EVT=+$P($G(^OR(100,ORIFN,0)),U,17),OREVT(EVT)=""
39 .. D CHGEVT^OREVNTX(ORIFN,""),UNLK1^ORX2(ORIFN) W "."
40 . W " done." S OREBUILD=1
41ED2 W !!,$$CURRENT S ORP=$$PTEVENT(+ORVP,1)
42 I ORP="^" W !,"Nothing changed!" D UNLOCK H 1 Q
43 W !!,"Setting release event to "_$P(ORP,U,2)_" ..."
44 S ORIFN=0 F S ORIFN=$O(ORDERS(ORIFN)) Q:ORIFN<1 D
45 . S EVT=+$P($G(^OR(100,ORIFN,0)),U,17) Q:EVT=+ORP S OREVT(EVT)=""
46 . D CHGEVT^OREVNTX(ORIFN,+ORP),UNLK1^ORX2(ORIFN) W "."
47 W " done." S OREBUILD=1
48ED3 S EVT=0 F S EVT=$O(OREVT(EVT)) Q:EVT<1 D ;terminate any events?
49 . Q:$G(^ORE(100.2,EVT,1)) Q:'$$EMPTY^OREVNTX(EVT) ;active,empty
50 . ;W !!,$P($$NAME^OREVNTX(EVT)," ",2,99)_" has no more delayed orders."
51 . ;S DIR(0)="YA",DIR("A")="Do you want to cancel this event? "
52 . ;S DIR("?")="Enter NO if you wish to enter new delayed orders for this event, otherwise enter YES to terminate it."
53 . ;S DIR("B")="YES" D ^DIR I $D(DTOUT)!$D(DUOUT) S ORQUIT=1 Q
54 . D CANCEL^OREVNTX(EVT) S X=$P($$NAME^OREVNTX(EVT)," ",2,99)
55 . W !," ... "_X_" event cancelled." H 1
56 . D:$G(OREVENT) EX ;Change view back to Active
57 Q
58 ;
59ACTIVE() ; -- Return to Active orders?
60 N X,Y,DIR S DIR(0)="YA"
61 S DIR("A")="Return to viewing Active Orders? ",DIR("B")="YES"
62 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."
63 D ^DIR S:$D(DTOUT)!$D(DUOUT) Y="^"
64 Q Y
65 ;
66DELAYED() ; -- Return 1 or 0, if current view=EDOs
67 I $G(OREVENT) Q 1
68 N X,Y S X=$P($G(^TMP("OR",$J,ORTAB,0)),U,3),X=$P(X,";",3)
69 S Y=$S("^15^16^17^24^25^"[(U_X_U):1,1:0)
70 Q Y
71 ;
72NODELAY() ; -- Return 1 or 0, if event should be removed
73 N X,Y,DIR S DIR(0)="YA"
74 S DIR("A")="Remove the release event from these orders? ",DIR("B")="NO"
75 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."
76 D ^DIR S:$D(DTOUT)!$D(DUOUT) Y="^"
77 Q Y
78 ;
79UNLOCK ; -- Unlock orders after ^
80 F S ORIFN=$O(ORDERS(ORIFN)) Q:ORIFN'>0 D UNLK1^ORX2(+ORIFN)
81 Q
82 ;
83CURRENT() ; -- Display current patient data
84 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:"")_"."
85 Q Y
86 ;
87PTEVENT(DFN,DLGONLY) ; -- Select Patient Event [or create new one]
88 ; Pass in DLGONLY=1 to skip new event's Order Set (from Copy, Xfer)
89 ; Returns Pt Evt ien ^ Event name
90 I '$G(DFN)!'$D(^DPT(+$G(DFN),0)) Q "^" ;invalid patient
91 N ORPTEVT,OREVT,X,Y,DIR,DTOUT,DUOUT,ORDIV,DOMAIN,OREV0,ORDAD,ORDIALOG,ORDSET,ORIFN,ORPTLK,OREBUILD,OREVENT
92 I $D(^ORE(100.2,"AE",DFN)) D ;pending events
93 . N CNT,EVT S (CNT,EVT)=0,DOMAIN=100.2 K ORPTEVT,DIR
94 . F S EVT=+$O(^ORE(100.2,"AE",DFN,EVT)) Q:EVT'>0 S Y=+$O(^(EVT,0)) D
95 .. Q:$G(^ORE(100.2,Y,1)) Q:$$LAPSED^OREVNTX(Y) Q:$D(^ORE(100.2,"DAD",Y))
96 .. S X=$P($G(^ORD(100.5,EVT,0)),U,8),CNT=CNT+1,ORPTEVT(CNT)=Y_U_X
97 .. S X=$$UP^XLFSTR(X),ORPTEVT("B",X)=Y
98 . Q:CNT'>0 S DIR("A",1)="Delayed orders exist for "_ORPNM_" for the following events:"
99 . F I=1:1:CNT S DIR("A",I+1)=$J(I,5)_" "_$P(ORPTEVT(I),U,2)
100 . S DIR("A",CNT+2)="To review or add delayed orders, select from (1-"_CNT_") or enter a new event."
101 S X=+$$GET^XPAR("ALL","OREVNT DEFAULT")
102 I X S Y=$P($G(^ORD(100.5,X,0)),U,8),DIR("B")=$$UP^XLFSTR(Y)
103PT1 S I=0 F S I=+$O(DIR("A",I)) Q:I<1 W !,DIR("A",I)
104 W !,"Select RELEASE EVENT: "_$S($L($G(DIR("B"))):DIR("B")_"//",1:"")
105 R X:DTIME I '$T!(X["^")!(X=""&'$D(DIR("B"))) Q "^"
106 S:X="" X=$G(DIR("B")) I X["?" D HELP^OREVNT(X) G PT1
107 I $O(DIR("A",0)) S ORPTEVT=$$FIND^ORCDLG2("ORPTEVT",X) G:$L(ORPTEVT) PTQ
108 S OREVT="" D I OREVT<1 G PT1 ;reask
109 . N DIC,DIR,D S DIC="^ORD(100.5,",DIC(0)="EQZS",D="C",DIC("W")=""
110 . S DIC("S")="I '$D(^ORD(100.5,""DAD"",Y))"
111 . ;S:'$G(ORWARD) DIC("S")="I $P(^(0),U,2)=""A"""
112 . D IX^DIC S:Y>0 OREVT=+Y_U_$P(Y(0),U,8)
113 I $$MATCH(DFN,+OREVT),'$$CONT G PT1 ;reask
114 S OREV0=$G(^ORD(100.5,+OREVT,0)),ORDAD=+$P(OREV0,U,12)
115 S ORDIALOG=+$P(OREV0,U,4),ORDSET=+$P(OREV0,U,5)
116 I 'ORDIALOG,'ORDSET!$G(DLGONLY),'ORDAD S ORPTEVT=$$NEW(DFN,+OREVT) S:ORPTEVT<1 ORPTEVT="^" G PTQ
117PT2 S ORPTLK=$$LOCK^ORX2(DFN) I 'ORPTLK W !!,$C(7),$P(ORPTLK,U,2) H 2 Q "^"
118 S ORNP=$$PROVIDER^ORCMENU1 I ORNP="^" Q "^"
119 I ORDAD D I $G(ORIFN)="^" Q "^" ;parent
120 . N OREVT S OREVT=ORDAD,ORDIALOG=+$P($G(^ORD(100.5,ORDAD,0)),U,4)
121 . I ORDIALOG S ORIFN=+$$ORDER^ORCDLG(ORDIALOG) I ORIFN<1 S ORIFN="^" Q
122 . S ORPTEVT=$$NEW(DFN,ORDAD,$G(ORIFN)),ORDIALOG="" K ORIFN
123 I ORDIALOG S ORIFN=+$$ORDER^ORCDLG(ORDIALOG) I ORIFN<1 Q "^"
124 S ORPTEVT=$$NEW(DFN,+OREVT,$G(ORIFN)) I ORPTEVT<1 Q "^"
125 I ORDSET,'$G(DLGONLY) S OREVENT=+ORPTEVT D EN^ORCDLG(ORDSET) K ^TMP("ORECALL",$J)
126 D:'$D(^TMP("ORNEW",$J)) UNLOCK^ORX2(DFN) ;unlock if no new orders
127PTQ Q ORPTEVT
128 ;
129HELP(RSP) ; -- ?help for DIR Event lookup
130 N X,Y,Z,CNT,DONE
131 W !,"Select the release event for which you wish to delay orders."
132 W !,"Choose from:" S CNT=1
133 S X="" F S X=$O(^ORD(100.5,"C",X)) Q:X="" D Q:$G(DONE)
134 . S Y=0 F S Y=$O(^ORD(100.5,"C",X,Y)) Q:Y<1 D Q:$G(DONE)
135 .. Q:$O(^ORD(100.5,"DAD",Y,0)) ;Parent event
136 .. S TYPE=$P($G(^ORD(100.5,Y,0)),U,2)
137 .. I RSP="?" Q:TYPE="A"&$G(ORWARD) Q:TYPE'="A"&'$G(ORWARD)
138 .. W !," "_X S CNT=CNT+1 Q:CNT'>(IOSL-3) S CNT=0
139 .. W !," '^' TO STOP: " R Z:DTIME S:'$T!(Z["^") DONE=1
140 Q
141 ;
142NEW(DFN,EVT,IFN) ; -- Create new Patient Event in #100.2
143 I '$G(DFN) Q "^"
144 N I,HDR,LAST,TOTAL,DA,ADM,DAD,X0
145 F I=1:1:10 L +^ORE(100.2,0):1 Q:$T H 2
146 I '$T Q "^"
147 S HDR=$G(^ORE(100.2,0)),TOTAL=+$P(HDR,U,4),LAST=$O(^ORE(100.2,"?"),-1)
148 S I=LAST F I=(I+1):1 Q:'$D(^ORE(100.2,I,0))
149 S DA=I,$P(HDR,U,3,4)=DA_U_(TOTAL+1),DFN=+DFN
150 S ^ORE(100.2,0)=HDR ;195 Moved unlock to later in code
151 S X0=$G(^ORD(100.5,+$G(EVT),0)) I $P(X0,U,12) D ;link to parent event
152 . S DAD=+$P(X0,U,12),$P(X0,U,2)=$P($G(^ORD(100.5,DAD,0)),U,2)
153 . S DAD=+$O(^ORE(100.2,"AE",DFN,DAD,0)) Q:DAD<1
154 . S $P(^ORE(100.2,DA,1),U,5)=DAD,^ORE(100.2,"DAD",DAD,DA)=""
155 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)))
156 S ^ORE(100.2,"B",DFN,DA)="" S:$G(IFN) IFN=+IFN
157 S ^ORE(100.2,DA,0)=DFN_U_$G(EVT)_U_ADM_U_$G(IFN)_U_+$E($$NOW^XLFDT,1,12)_U_$G(DUZ)
158 S:$G(EVT) ^ORE(100.2,"E",EVT,DA)="",^ORE(100.2,"AE",DFN,EVT,DA)=""
159 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)=""
160 L -^ORE(100.2,0) ;195 Unlock after global is set
161 Q DA
162 ;
163NHCU(OREVT) ; -- Returns 1 or 0, if EVT is to NHCU
164 N ORI,ORX,ORY S (ORI,ORY)=0
165 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
166 Q ORY
167 ;
168DELETE(DA) ; -- Delete Patient Event
169 N DIK S DIK="^ORE(100.2," D:$G(DA) ^DIK
170 Q
171 ;
172MATCH(DFN,EVT) ; -- Does Pt's current data match selected Event?
173 N X0,Y,LOC,WD,TS,PEVT ;177 This section updated to account for child events
174 S PEVT=$P($G(^ORD(100.5,EVT,0)),U,12) ;177 Is this a child event?
175 S X0=$G(^ORD(100.5,$S($G(PEVT):PEVT,1:EVT),0)),Y=1 ;177
176 I "^D^O^M^"[(U_$P(X0,U,2)_U) S Y=0 G MQ
177 S LOC=$S($G(ORL):+ORL,1:+$$CURRLOC(DFN)),WD=+$G(^SC(LOC,42))
178 I $$DIV^ORMEVNT(LOC)'=$P(X0,U,3) S Y=0 G MQ
179 S TS=$S($G(ORTS):+ORTS,1:+$G(^DPT(DFN,.103)))
180 I $O(^ORD(100.5,$S($G(PEVT):PEVT,1:EVT),"TS",0)),'$D(^("B",TS)) S Y=0 G MQ ;177
181 I $O(^ORD(100.5,$S($G(PEVT):PEVT,1:EVT),"LOC",0)),'$D(^("B",WD)) S Y=0 G MQ ;177
182MQ Q Y
183 ;
184CURRLOC(DFN) ; -- Return current Hospital Location (ptr to #44) of patient DFN
185 N X,Y S X=$P($G(^DPT(DFN,.1)),U),Y=""
186 I $L(X) S X=+$O(^DIC(42,"B",X,0)),Y=+$G(^DIC(42,X,44))
187 Q Y
188 ;
189CONT() ; -- ok to continue?
190 N X,Y,DIR
191 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)_"!"
192 S DIR(0)="YA",DIR("A")="Do you still want to add future orders? "
193 S DIR("?")="Enter YES to add orders that will be delayed until this event occurs in the future, or NO to quit."
194 S DIR("B")="NO" W ! D ^DIR S:$D(DTOUT)!$D(DUOUT) Y="^"
195 Q Y
Note: See TracBrowser for help on using the repository browser.