source: FOIAVistA/tag/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OR3CONV.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 8.8 KB
Line 
1OR3CONV ;SLC/MLI-OE/RR v3 conversion entry points ;8/11/06 13:31
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**14,215,260**;Dec 17, 1997;Build 26
3 ;
4 ; This routine contains the entry points to convert orders from
5 ; all package (OE/RR, pharmacy, dietetics, etc.).
6 ;
7 ; Entry points exist for:
8 ; A. background conversion of orders (steps described in tag): (BGJ)
9 ; B. on-the-fly conversion if record is accessed before background
10 ; conversion gets to it. (OTF)
11 ;
12 ; Only OTF is a supported call. Remaining calls in routine are
13 ; only called from within this routine (no external calls made in).
14 ;
15 ; Supporting calls exist in OR3CONV1 as follows:
16 ; A. stop conversion process cleanly once in bgj (STOP)
17 ; B. restarting background process if it did not complete. (RESTART)
18 ; C. check status of conversion process (STATUS)
19 ;
20 Q
21 ;
22QUEUE ; queue background process to run. DO NOT CALL MANUALLY!
23 ; called from OR3POST and RESTART^OR3CONV1
24 ;
25 ; check entry...disallow calling tag once conversion has begun
26 N X
27 S X=$G(^ORD(100.99,1,"CONV"))
28 I '$D(ZTSAVE("ORESTART")),$P(X,"^",1) W !!,"Conversion already done!" Q
29 I '$D(ZTSAVE("ORESTART")),($P(X,"^",10)]"") D Q
30 . W !,"The conversion has already started."
31 . W !,"Please call RESTART^OR3CONV1 to restart the conversion!"
32 . Q
33 ;
34 ; if restart, ZTSAVE("ORESTART") set on entry - ask time to queue
35 S ZTIO="",ZTRTN="BGJ^OR3CONV"
36 I '$D(ZTSAVE("ORESTART")) S ZTDTH=$$NOW^XLFDT()
37 S ZTDESC="OE/RR v3 orders conversion...use STATUS^OR3CONV1 to track progress"
38 ;S:$D(ZTSAVE("ORESTART")) ORESTART=ZTSAVE("ORESTART") D BGJ^OR3CONV ; *****for testing only*****
39 D ^%ZTLOAD
40 I $G(ZTSK) D
41 . D BMES^XPDUTL("Orders conversion tasked - #"_ZTSK)
42 . D SET(10,ZTSK)
43 E D
44 . D BMES^XPDUTL("***Problem encountered queuing conversion***")
45 . D MES^XPDUTL(" D QUEUE^OR3CONV to start manually.")
46 K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
47 Q
48 ;
49BGJ ; process via background job in order below
50 ; if restart, set ORPROCES = to step last on, call BGJ1
51 ; 0. initialize list of patients to convert, then convert orders for:
52 ; 1. current inpatients
53 ; 2. patients with future scheduled admissions
54 ; 3. patients on waiting list
55 ; 4. patients with discharges in last 4 weeks
56 ; 5. patients with appointments in last 4 weeks or next 4 weeks
57 ; 6. everyone else (loop through DPT for remaining patients)
58 ; 7. orders associated with entities not in the PATIENT file
59 ;
60 I '$D(ZTQUEUED) W !,"Use RESTART^OR3CONV1!!!" Q ; prevent calling tag
61 ;
62 N ORPROCES,ORSTOP
63 S ORSTOP=0 D SET(11,0) ; reset stop conversion parameter to no
64 I $D(ORESTART) D
65 . S ORPROCES=+$P(^ORD(100.99,1,"CONV"),"^",8)
66 E D
67 . S ORPROCES=0
68 . D SET(6,$$NOW^XLFDT())
69 F Q:ORPROCES>7 D Q:ORSTOP
70 . D SET(8,ORPROCES) ; update process currently on
71 . D @ORPROCES Q:ORSTOP
72 . S ORPROCES=ORPROCES+1
73 I ORSTOP D SET(10,"") ; delete out task job
74 Q
75 ;
760 ; populate list of patients to convert
77 I '$D(ORESTART) D SET(1,0)
78 D PTCONV^OR3CONV1
79 Q
80 ;
811 ; order conversion for inpatients
82 N DFN,ORWARD,X
83 S ORWARD=$S($D(ORESTART):ORESTART,1:"") K ORESTART
84 F S ORWARD=$O(^DPT("CN",ORWARD)) Q:ORWARD']""!ORSTOP D
85 . D SET(4,ORWARD)
86 . F DFN=0:0 S DFN=$O(^DPT("CN",ORWARD,DFN)) Q:'DFN!ORSTOP D
87 . . D SET(5,DFN)
88 . . S X=$$CONVERT(DFN,1)
89 . D SET(9,ORWARD)
90 D SET(3,$$NOW^XLFDT())
91 Q
92 ;
93 ;
942 ; patients with future scheduled admissions
95 N ORDATE,ORIEN,X
96 S ORDATE=$S($G(ORESTART):ORESTART,1:$$NOW^XLFDT()) K ORESTART
97 F S ORDATE=$O(^DGS(41.1,"C",ORDATE)) Q:'ORDATE!ORSTOP D
98 . F ORIEN=0:0 S ORIEN=$O(^DGS(41.1,"C",ORDATE,ORIEN)) Q:'ORIEN!ORSTOP D
99 . . S X=$G(^DGS(41.1,ORIEN,0))
100 . . I X']"" Q
101 . . S X=$$CONVERT(+X,1)
102 . . D SET(9,ORDATE)
103 Q
104 ;
105 ;
1063 ; patients on waiting list
107 N DFN,ORIEN,ORIEN1,ORFLAG,X
108 S DFN=+$G(ORESTART) K ORESTART
109 F S DFN=$O(^DGWAIT("C",DFN)) Q:'DFN!ORSTOP D
110 . S ORFLAG=0
111 . F ORIEN=0:0 S ORIEN=$O(^DGWAIT("C",DFN,ORIEN)) Q:'ORIEN D Q:ORFLAG
112 . . F ORIEN1=0:0 S ORIEN1=$O(^DGWAIT("C",DFN,ORIEN,ORIEN1)) Q:'ORIEN1 D
113 . . . I $G(^DGWAIT(ORIEN,"P",ORIEN1,"ADM")) Q ; no longer active
114 . . . S X=$$CONVERT(DFN,1),ORFLAG=1
115 . . . D SET(9,DFN)
116 Q
117 ;
118 ;
1194 ; patients with discharges in last 4 weeks
120 N DFN,ORDISCH,X
121 S ORDISCH=$S($G(ORESTART):ORESTART,1:$$FMADD^XLFDT(DT,-29)) K ORESTART
122 F S ORDISCH=$O(^DGPM("AMV3",ORDISCH)) Q:'ORDISCH!(ORDISCH>DT)!ORSTOP D
123 . F DFN=0:0 S DFN=$O(^DGPM("AMV3",ORDISCH,DFN)) Q:'DFN D
124 . . S X=$$CONVERT(DFN,1)
125 . . D SET(9,ORDISCH)
126 Q
127 ;
128 ;
1295 ; patients with appointments past 4 weeks through next 4 weeks
130 ; this call is no longer used
131 N DFN,OREND,ORERR,ORI,ORLOC,ORSTART,X
132 S ORSTART=$$FMADD^XLFDT(DT,-29),OREND=$$FMADD^XLFDT(DT,+29)
133 S ORLOC=+$G(ORESTART) K ORESTART
134 K ^TMP($J,"SDAMA202","GETPLIST")
135 F S ORLOC=$O(^SC(ORLOC)) Q:'ORLOC!ORSTOP D
136 . D GETPLIST^SDAMA202(ORLOC,"4","",ORSTART,OREND)
137 . S ORERR=$$CLINERR^ORQRY01
138 . I $L(ORERR) W !,ORERR S ORSTOP=1 Q
139 . S ORI=0
140 . F S ORI=$O(^TMP($J,"SDAMA202","GETPLIST",ORI)) Q:ORI<1 D
141 .. S DFN=+$G(^TMP($J,"SDAMA202","GETPLIST",ORI,4))
142 .. I DFN S X=$$CONVERT(DFN,1)
143 . D SET(9,ORLOC)
144 K ^TMP($J,"SDAMA202","GETPLIST")
145 Q
146 ;
147 ;
1486 ; rest of patients
149 N DFN,X
150 S DFN=+$G(ORESTART) K ORESTART
151 F S DFN=$O(^ORD(100.99,1,"PTCONV",DFN)) Q:'DFN!ORSTOP D
152 . S X=$$CONVERT(DFN,1)
153 . D SET(9,DFN)
154 Q
155 ;
156 ;
1577 ; orders not associated with DPT entries
158 N ORVP
159 S ORVP=$S($G(ORESTART):ORESTART,1:"") K ORESTART
160 F S ORVP=$O(^OR(100,"AO",ORVP)) Q:ORVP=""!ORSTOP D
161 . D ORDERS^OR3C100(ORVP)
162 . D EN^LR7OV2(ORVP,0)
163 I ORSTOP Q
164 D SET(7,$$NOW^XLFDT())
165 D CLEANUP^OR3CONV1
166 Q
167 ;
168 ;
169OTF(DFN,ORQUIET) ; on-the-fly conversion
170 ;
171 ; *** Supported entry point for package to call to see if orders ***
172 ; *** for patient have been converted and convert if not done yet ***
173 ;
174 ; Input: DFN as IEN of PATIENT file entry to convert orders for
175 ; ORQUIET as 1 conversion should be silent
176 ;
177 ; Output: -1^error message if problem encountered
178 ; 0 if patient already converted prior to call
179 ; 1 if patient was successfully converted as part of call
180 ;
181 S DFN=$G(DFN),ORQUIET=+$G(ORQUIET)
182 I $$ALLDONE() Q 0 ; conversion already complete
183 I DFN'=+DFN!'$D(^DPT(+DFN,0)) Q "-1^Error in DFN passed to OTF^OR3CONV"
184 Q $$CONVERT(DFN,ORQUIET,1) ; convert orders for patient
185 ;
186 ;
187CONVERT(DFN,ORQUIET,OROTF) ; convert orders by patient, set flag when done
188 ;
189 ; Input - DFN as IEN of PATIENT file
190 ; ORQUIET as 1 if conversion to be quiet
191 ; OROTF as 1 if conversion called on-the-fly
192 ; Output - -1^error message if problem encountered
193 ; 1 if patient successfully converted
194 ;
195 ; new variables from bgj calls to ensure not reset during conv calls
196 N ORDATE,ORDATE,ORDISCH,OREND,ORIEN,ORIEN1,ORLOC,ORPROCES,ORSTART,ORWARD
197 ;
198 N ORERRMSG,ORPTLK,ORVP
199 S ORVP=DFN_";DPT("
200 S OROTF=+$G(OROTF)
201 I 'OROTF,$$STOP() D ; field set to request stop of bgj
202 . S ORSTOP=1
203 . D SET(10,"")
204 I $$PTDONE(DFN) Q 0 ; patient already converted
205 S ORPTLK=$$LOCK^ORX2(DFN)
206 I 'ORPTLK D Q ORERRMSG ; record is locked
207 . I 'ORQUIET W !!,$P(ORPTLK,U,2) H 1
208 . S ORERRMSG="-1^"_$P(ORPTLK,U,2)
209 ;
210 I $$ORCONV(ORVP) D
211 . N DFN
212 . I 'ORQUIET D WRITE(+ORVP,"OE/RR")
213 . D ORDERS^OR3C100(ORVP)
214 I $$PSCONV(DFN) D
215 . I 'ORQUIET D WRITE(DFN,"pharmacy")
216 . D EN1^PSOHLUP(+DFN,'ORQUIET)
217 I $$LRCONV() D
218 . N DFN
219 . I 'ORQUIET D WRITE(+ORVP,"lab")
220 . D EN^LR7OV2(ORVP,'ORQUIET)
221 D UNLOCK^ORX2(+DFN)
222 D DONE(DFN)
223 Q 1
224 ;
225ORCONV(ORVP) ; return 1 if OR orders need to be converted, otherwise 0
226 I $O(^OR(100,"AO",ORVP,0)) Q 1
227 Q 0
228 ;
229PSCONV(DFN) ; return 1 to convert pharmacy orders for patient, otherwise 0
230 I $P($G(^PS(55,DFN,0)),U,6)'=2!'$P($G(^(5.1)),U,11) Q 1
231 Q 0
232 ;
233LRCONV() ; return 1 to convert
234 Q 1
235 ;
236WRITE(DFN,TYPE) ; write converting message
237 W !,"Converting ",TYPE," orders for ",$P($G(^DPT(DFN,0)),"^",1)
238 Q
239 ;
240ALLDONE() ; return 1 if conversion done, otherwise 0
241 Q $G(^ORD(100.99,1,"CONV"))
242 ;
243PTDONE(DFN) ; return 1 if patient already converted or PTCONV mult not done
244 I $D(^ORD(100.99,1,"PTCONV",DFN)) Q 0
245 I +$P($G(^ORD(100.99,1,"CONV")),"^",8)=0 Q 0
246 Q 1
247 ;
248STOP() ; check stop conversion flag
249 Q $P($G(^ORD(100.99,1,"CONV")),"^",11)
250 ;
251SET(PIECE,VALUE) ; update order parameter file field with value
252 N X
253 S X=$G(^ORD(100.99,1,"CONV"))
254 S $P(X,"^",PIECE)=VALUE
255 I PIECE=1 S $P(X,"^",2)=$$NOW^XLFDT()
256 I PIECE=3 S $P(X,"^",4,5)="^"
257 I PIECE=7 S $P(X,"^",1)=1,$P(X,"^",8,10)="^^"
258 I PIECE=8 S $P(X,"^",9)=""
259 S ^ORD(100.99,1,"CONV")=X
260 Q
261 ;
262DONE(DFN) ; remove entry from multiple
263 N COUNT,NODE,LAST,X
264 S X=$G(^ORD(100.99,1,"PTCONV",0)) Q:X']"" ; not done step 0
265 K ^ORD(100.99,1,"PTCONV",DFN),^ORD(100.99,1,"PTCONV","B",DFN)
266LOCK L +^ORD(100.99,1,"PTCONV",0):5 I '$T G LOCK
267 S COUNT=$P(X,"^",4)-1,LAST=$O(^ORD(100.99,1,"PTCONV","A"),-1)
268 S $P(^ORD(100.99,1,"PTCONV",0),"^",3,4)=LAST_"^"_$S(COUNT>0:COUNT,1:0)
269 L -^ORD(100.99,1,"PTCONV",0)
270 S $P(^("CONV"),"^",12)=$P(^ORD(100.99,1,"CONV"),"^",12)+1
271 Q
Note: See TracBrowser for help on using the repository browser.