source: Scheduling/trunk/kids/sd0530_11310.k@ 614

Last change on this file since 614 was 614, checked in by Sam Habiel, 14 years ago

Initial committ of scheduling package
File size: 11.1 KB
Line 
1KIDS Distribution saved on Jul 25, 2009@19:02:20
2Modified SDAMEVT routine to enable BSDX scheduling
3**KIDS**:SD*5.3*11310^
4
5**INSTALL NAME**
6SD*5.3*11310
7"BLD",7417,0)
8SD*5.3*11310^SCHEDULING^0^3090725^n
9"BLD",7417,4,0)
10^9.64PA^^
11"BLD",7417,6.3)
122
13"BLD",7417,"KRN",0)
14^9.67PA^8989.52^19
15"BLD",7417,"KRN",.4,0)
16.4
17"BLD",7417,"KRN",.401,0)
18.401
19"BLD",7417,"KRN",.402,0)
20.402
21"BLD",7417,"KRN",.403,0)
22.403
23"BLD",7417,"KRN",.5,0)
24.5
25"BLD",7417,"KRN",.84,0)
26.84
27"BLD",7417,"KRN",3.6,0)
283.6
29"BLD",7417,"KRN",3.8,0)
303.8
31"BLD",7417,"KRN",9.2,0)
329.2
33"BLD",7417,"KRN",9.8,0)
349.8
35"BLD",7417,"KRN",9.8,"NM",0)
36^9.68A^1^1
37"BLD",7417,"KRN",9.8,"NM",1,0)
38SDAMEVT^^0^B29013195
39"BLD",7417,"KRN",9.8,"NM","B","SDAMEVT",1)
40
41"BLD",7417,"KRN",19,0)
4219
43"BLD",7417,"KRN",19.1,0)
4419.1
45"BLD",7417,"KRN",101,0)
46101
47"BLD",7417,"KRN",409.61,0)
48409.61
49"BLD",7417,"KRN",771,0)
50771
51"BLD",7417,"KRN",870,0)
52870
53"BLD",7417,"KRN",8989.51,0)
548989.51
55"BLD",7417,"KRN",8989.52,0)
568989.52
57"BLD",7417,"KRN",8994,0)
588994
59"BLD",7417,"KRN","B",.4,.4)
60
61"BLD",7417,"KRN","B",.401,.401)
62
63"BLD",7417,"KRN","B",.402,.402)
64
65"BLD",7417,"KRN","B",.403,.403)
66
67"BLD",7417,"KRN","B",.5,.5)
68
69"BLD",7417,"KRN","B",.84,.84)
70
71"BLD",7417,"KRN","B",3.6,3.6)
72
73"BLD",7417,"KRN","B",3.8,3.8)
74
75"BLD",7417,"KRN","B",9.2,9.2)
76
77"BLD",7417,"KRN","B",9.8,9.8)
78
79"BLD",7417,"KRN","B",19,19)
80
81"BLD",7417,"KRN","B",19.1,19.1)
82
83"BLD",7417,"KRN","B",101,101)
84
85"BLD",7417,"KRN","B",409.61,409.61)
86
87"BLD",7417,"KRN","B",771,771)
88
89"BLD",7417,"KRN","B",870,870)
90
91"BLD",7417,"KRN","B",8989.51,8989.51)
92
93"BLD",7417,"KRN","B",8989.52,8989.52)
94
95"BLD",7417,"KRN","B",8994,8994)
96
97"MBREQ")
980
99"PKG",48,-1)
1001^1
101"PKG",48,0)
102SCHEDULING^SD^APPOINTMENTS,PROFILES,LETTERS,AMIS REPORTS
103"PKG",48,22,0)
104^9.49I^1^1
105"PKG",48,22,1,0)
1065.3^3040324^2960613
107"PKG",48,22,1,"PAH",1,0)
10811310^3090725
109"QUES","XPF1",0)
110Y
111"QUES","XPF1","??")
112^D REP^XPDH
113"QUES","XPF1","A")
114Shall I write over your |FLAG| File
115"QUES","XPF1","B")
116YES
117"QUES","XPF1","M")
118D XPF1^XPDIQ
119"QUES","XPF2",0)
120Y
121"QUES","XPF2","??")
122^D DTA^XPDH
123"QUES","XPF2","A")
124Want my data |FLAG| yours
125"QUES","XPF2","B")
126YES
127"QUES","XPF2","M")
128D XPF2^XPDIQ
129"QUES","XPI1",0)
130YO
131"QUES","XPI1","??")
132^D INHIBIT^XPDH
133"QUES","XPI1","A")
134Want KIDS to INHIBIT LOGONs during the install
135"QUES","XPI1","B")
136NO
137"QUES","XPI1","M")
138D XPI1^XPDIQ
139"QUES","XPM1",0)
140PO^VA(200,:EM
141"QUES","XPM1","??")
142^D MG^XPDH
143"QUES","XPM1","A")
144Enter the Coordinator for Mail Group '|FLAG|'
145"QUES","XPM1","B")
146
147"QUES","XPM1","M")
148D XPM1^XPDIQ
149"QUES","XPO1",0)
150Y
151"QUES","XPO1","??")
152^D MENU^XPDH
153"QUES","XPO1","A")
154Want KIDS to Rebuild Menu Trees Upon Completion of Install
155"QUES","XPO1","B")
156NO
157"QUES","XPO1","M")
158D XPO1^XPDIQ
159"QUES","XPZ1",0)
160Y
161"QUES","XPZ1","??")
162^D OPT^XPDH
163"QUES","XPZ1","A")
164Want to DISABLE Scheduled Options, Menu Options, and Protocols
165"QUES","XPZ1","B")
166NO
167"QUES","XPZ1","M")
168D XPZ1^XPDIQ
169"QUES","XPZ2",0)
170Y
171"QUES","XPZ2","??")
172^D RTN^XPDH
173"QUES","XPZ2","A")
174Want to MOVE routines to other CPUs
175"QUES","XPZ2","B")
176NO
177"QUES","XPZ2","M")
178D XPZ2^XPDIQ
179"RTN")
1801
181"RTN","SDAMEVT")
1820^1^B29013195
183"RTN","SDAMEVT",1,0)
184SDAMEVT ;ALB/MJK - Appt Event Driver Utilities ; 12/1/91 [ 09/19/96 1:39 PM ]
185"RTN","SDAMEVT",2,0)
186 ;;5.3;Scheduling;**15,132,443,local**;Aug 13, 1993;Build 2
187"RTN","SDAMEVT",3,0)
188 ; localmods by WV/SMH;
189"RTN","SDAMEVT",4,0)
190 ;
191"RTN","SDAMEVT",5,0)
192BEFORE(SDATA,DFN,SDT,SDCL,SDDA,SDHDL) ; -- get before values
193"RTN","SDAMEVT",6,0)
194 K ^TMP("SDAMEVT",$J)
195"RTN","SDAMEVT",7,0)
196 D CAPTURE("BEFORE",.SDATA,.DFN,.SDT,.SDCL,.SDDA,.SDHDL)
197"RTN","SDAMEVT",8,0)
198 Q
199"RTN","SDAMEVT",9,0)
200 ;
201"RTN","SDAMEVT",10,0)
202AFTER(SDATA,DFN,SDT,SDCL,SDDA,SDHDL) ; -- get after values
203"RTN","SDAMEVT",11,0)
204 D CAPTURE("AFTER",.SDATA,.DFN,.SDT,.SDCL,.SDDA,.SDHDL)
205"RTN","SDAMEVT",12,0)
206 Q
207"RTN","SDAMEVT",13,0)
208 ;
209"RTN","SDAMEVT",14,0)
210HANDLE(SDORG) ; -- get evt handle
211"RTN","SDAMEVT",15,0)
212 ; SDORG = originating process (1=appt , 2=a/e , 3=disp)
213"RTN","SDAMEVT",16,0)
214 S (Y,^($J))=$G(^TMP("SDEVT HANDLE",$J))+1
215"RTN","SDAMEVT",17,0)
216 Q Y
217"RTN","SDAMEVT",18,0)
218 ;
219"RTN","SDAMEVT",19,0)
220CLEAN(SDHDL) ;
221"RTN","SDAMEVT",20,0)
222 K ^TMP("SDEVT",$J,SDHDL)
223"RTN","SDAMEVT",21,0)
224 Q
225"RTN","SDAMEVT",22,0)
226 ;
227"RTN","SDAMEVT",23,0)
228HDLKILL ; -- kill off handle data
229"RTN","SDAMEVT",24,0)
230 K SDHDL,^TMP("SDEVT HANDLE",$J),^TMP("SDEVT",$J)
231"RTN","SDAMEVT",25,0)
232 Q
233"RTN","SDAMEVT",26,0)
234 ;
235"RTN","SDAMEVT",27,0)
236CAPTURE(SDCAP,SDATA,DFN,SDT,SDCL,SDDA,SDHDL) ;
237"RTN","SDAMEVT",28,0)
238 N Z
239"RTN","SDAMEVT",29,0)
240 S (Z,^TMP("SDAMEVT",$J,SDCAP,"DPT"),^TMP("SDEVT",$J,SDHDL,1,"DPT",0,SDCAP))=$G(^DPT(DFN,"S",SDT,0))
241"RTN","SDAMEVT",30,0)
242 S (^TMP("SDAMEVT",$J,SDCAP,"SC"),^TMP("SDEVT",$J,SDHDL,1,"SC",0,SDCAP))=$G(^SC(SDCL,"S",SDT,1,+SDDA,0))
243"RTN","SDAMEVT",31,0)
244 S (^TMP("SDAMEVT",$J,SDCAP,"STATUS"),SDATA(SDCAP,"STATUS"))=$TR($$STATUS^SDAM1(DFN,SDT,SDCL,Z,SDDA),";","^")
245"RTN","SDAMEVT",32,0)
246 D:$P(Z,U,20) OE(.SDCAP,1,$P(Z,U,20),.SDHDL)
247"RTN","SDAMEVT",33,0)
248 Q
249"RTN","SDAMEVT",34,0)
250 ;
251"RTN","SDAMEVT",35,0)
252 ;
253"RTN","SDAMEVT",36,0)
254EVT(SDATA,SDAMEVT,SDMODE,SDHDL) ; -- calls the sdam event protocol
255"RTN","SDAMEVT",37,0)
256 N OROLD
257"RTN","SDAMEVT",38,0)
258 K DTOUT,DIROUT
259"RTN","SDAMEVT",39,0)
260 I $G(SDATA("BEFORE","STATUS"))=$G(SDATA("AFTER","STATUS")),'$$COMP^SDAMEVT4(SDHDL,SDAMEVT) G EVTQ ; SD*5.3*443
261"RTN","SDAMEVT",40,0)
262 S:$P(SDATA,U,3) $P(SDATA,U,5)=$$REQ^SDM1A(+$P(SDATA,U,3))
263"RTN","SDAMEVT",41,0)
264 S X=+$O(^ORD(101,"B","SDAM APPOINTMENT EVENTS",0))_";ORD(101,"
265"RTN","SDAMEVT",42,0)
266 D EN^XQOR
267"RTN","SDAMEVT",43,0)
268EVTQ K XQORPOP,X,^TMP("SDAMEVT",$J) D CLEAN(SDHDL) Q
269"RTN","SDAMEVT",44,0)
270 ;
271"RTN","SDAMEVT",45,0)
272 ;
273"RTN","SDAMEVT",46,0)
274MAKE(DFN,SDT,SDCL,SDDA,SDMODE) ; -- make appt event #1
275"RTN","SDAMEVT",47,0)
276 N SDATA,%,SDMKHDL,SDHDL K ^TMP("SDAMEVT",$J)
277"RTN","SDAMEVT",48,0)
278 S SDMKHDL=$$HANDLE(1)
279"RTN","SDAMEVT",49,0)
280 S (^TMP("SDAMEVT",$J,"BEFORE","DPT"),^TMP("SDAMEVT",$J,"BEFORE","SC"),SDATA("BEFORE","STATUS"),^TMP("SDAMEVT",$J,"BEFORE","STATUS"),^TMP("SDEVT",$J,SDMKHDL,1,"DPT",0,"BEFORE"),^TMP("SDEVT",$J,SDMKHDL,1,"SC",0,"BEFORE"))=""
281"RTN","SDAMEVT",50,0)
282 D AFTER(.SDATA,DFN,SDT,SDCL,SDDA,SDMKHDL)
283"RTN","SDAMEVT",51,0)
284 S SDATA=SDDA_U_DFN_U_SDT_U_SDCL
285"RTN","SDAMEVT",52,0)
286 ; D EVT(.SDATA,1,+$G(SDAMODE),SDMKHDL) ; wrong line
287"RTN","SDAMEVT",53,0)
288 D EVT(.SDATA,1,+$G(SDMODE),SDMKHDL) ; //smh SDMODE was misspelt
289"RTN","SDAMEVT",54,0)
290 ; -- if appt d/t is less than NOW then check-in
291"RTN","SDAMEVT",55,0)
292 D NOW^%DTC
293"RTN","SDAMEVT",56,0)
294 ; I SDT<% W:'$G(SDMODE) ! D //smh
295"RTN","SDAMEVT",57,0)
296 I SDT<%,$G(SDMODE)<2 D ; but only ask if you are in interactive mode. If SDMODE=2, don't ask.
297"RTN","SDAMEVT",58,0)
298 .N SDACT,SDCOQUIT
299"RTN","SDAMEVT",59,0)
300 .S SDDA=+SDATA,DFN=$P(SDATA,U,2),SDT=$P(SDATA,U,3),SDCL=$P(SDATA,U,4) K SDATA
301"RTN","SDAMEVT",60,0)
302 .I $$REQ^SDM1A(SDT)="CO",'$G(SDCOACT) D
303"RTN","SDAMEVT",61,0)
304 ..S SDACT=$S(SDT<DT:"CO",1:$$ASK^SDAMEX) I SDACT']"" S SDCOQUIT=1 Q
305"RTN","SDAMEVT",62,0)
306 ..I SDACT="CO" D CO^SDCO1(DFN,SDT,SDCL,SDDA,0,SDT)
307"RTN","SDAMEVT",63,0)
308 .I '$G(SDCOQUIT),$G(SDACT)'="CO" D ONE^SDAM2(DFN,SDCL,SDT,SDDA,0,SDT)
309"RTN","SDAMEVT",64,0)
310 Q
311"RTN","SDAMEVT",65,0)
312 ;
313"RTN","SDAMEVT",66,0)
314 ;
315"RTN","SDAMEVT",67,0)
316CANCEL(SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDHDL) ; -- cancel event #2
317"RTN","SDAMEVT",68,0)
318 D AFTER(.SDATA,DFN,SDT,SDCL,SDDA,SDHDL)
319"RTN","SDAMEVT",69,0)
320 I "^5^7^9^10^"[("^"_+SDATA("AFTER","STATUS")_"^"),$P($G(^DPT(DFN,"S",SDT,0)),"^",20) D EN^SDCODEL(+$P(^(0),"^",20),0,SDHDL),OENUL^SDAMEVT1("AFTER",SDHDL)
321"RTN","SDAMEVT",70,0)
322 S SDATA=SDDA_U_DFN_U_SDT_U_SDCL
323"RTN","SDAMEVT",71,0)
324 D EVT(.SDATA,2,0,SDHDL)
325"RTN","SDAMEVT",72,0)
326 Q
327"RTN","SDAMEVT",73,0)
328 ;
329"RTN","SDAMEVT",74,0)
330 ;
331"RTN","SDAMEVT",75,0)
332NOSHOW(SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDHDL) ; -- no-show event #3
333"RTN","SDAMEVT",76,0)
334 D AFTER(.SDATA,DFN,SDT,SDCL,SDDA,SDHDL)
335"RTN","SDAMEVT",77,0)
336 I "^4^6^"[("^"_+SDATA("AFTER","STATUS")_"^"),$P($G(^DPT(DFN,"S",SDT,0)),"^",20) D EN^SDCODEL(+$P(^(0),"^",20),0,SDHDL),OENUL^SDAMEVT1("AFTER",SDHDL)
337"RTN","SDAMEVT",78,0)
338 S SDATA=SDDA_U_DFN_U_SDT_U_SDCL
339"RTN","SDAMEVT",79,0)
340 D EVT(.SDATA,3,0,SDHDL)
341"RTN","SDAMEVT",80,0)
342 Q
343"RTN","SDAMEVT",81,0)
344 ;
345"RTN","SDAMEVT",82,0)
346OE(SDCAP,SDORG,SDOE,SDHDL) ; -- set up encounter data
347"RTN","SDAMEVT",83,0)
348 N I,OP,FILE,X,SDKID
349"RTN","SDAMEVT",84,0)
350 ;
351"RTN","SDAMEVT",85,0)
352 ; -- set up 'OP'posite variable
353"RTN","SDAMEVT",86,0)
354 S OP=$S(SDCAP="BEFORE":"AFTER",1:"BEFORE")
355"RTN","SDAMEVT",87,0)
356 ;
357"RTN","SDAMEVT",88,0)
358 ; -- set zero of oe
359"RTN","SDAMEVT",89,0)
360 S X=$G(^SCE(SDOE,0))
361"RTN","SDAMEVT",90,0)
362 S ^TMP("SDEVT",$J,SDHDL,SDORG,"SDOE",SDOE,0,SDCAP)=X
363"RTN","SDAMEVT",91,0)
364 S:'$D(^TMP("SDEVT",$J,SDHDL,SDORG,"SDOE",SDOE,0,OP)) ^(OP)=""
365"RTN","SDAMEVT",92,0)
366 ;
367"RTN","SDAMEVT",93,0)
368 ; -- save other data
369"RTN","SDAMEVT",94,0)
370 S FILE=409.42
371"RTN","SDAMEVT",95,0)
372 S I=0 F S I=$O(^SDD(FILE,"OE",SDOE,I)) Q:'I D
373"RTN","SDAMEVT",96,0)
374 . S X=$G(^SDD(FILE,I,0))
375"RTN","SDAMEVT",97,0)
376 . S ^TMP("SDEVT",$J,SDHDL,SDORG,"SDOE",SDOE,"CL",I,0,SDCAP)=X
377"RTN","SDAMEVT",98,0)
378 . S:'$D(^TMP("SDEVT",$J,SDHDL,SDORG,"SDOE",SDOE,"CL",I,0,OP)) ^(OP)=""
379"RTN","SDAMEVT",99,0)
380 ;
381"RTN","SDAMEVT",100,0)
382 IF SDORG'=1,SDORG'=3 G OEQ
383"RTN","SDAMEVT",101,0)
384 ;
385"RTN","SDAMEVT",102,0)
386 ; -- gets children oe's
387"RTN","SDAMEVT",103,0)
388 S SDKID=0
389"RTN","SDAMEVT",104,0)
390 F S SDKID=$O(^SCE("APAR",SDOE,SDKID)) Q:'SDKID D
391"RTN","SDAMEVT",105,0)
392 . S X=$G(^SCE(SDKID,0))
393"RTN","SDAMEVT",106,0)
394 . IF $P(X,U,8)'=4 Q ; -- must be a credit stop encounter
395"RTN","SDAMEVT",107,0)
396 . S ^TMP("SDEVT",$J,SDHDL,4,"SDOE",SDKID,0,SDCAP)=X
397"RTN","SDAMEVT",108,0)
398 . S:'$D(^TMP("SDEVT",$J,SDHDL,4,"SDOE",SDKID,0,OP)) ^(OP)=""
399"RTN","SDAMEVT",109,0)
400OEQ Q
401"RTN","SDAMEVT",110,0)
402 ;
403"RTN","SDAMEVT",111,0)
404OECHG(SDORG,SDHDL) ; -- compare befores and afters
405"RTN","SDAMEVT",112,0)
406 N Y,I,SDOE S (Y,SDOE)=0
407"RTN","SDAMEVT",113,0)
408 F S SDOE=$O(^TMP("SDEVT",$J,SDHDL,SDORG,"SDOE",SDOE)) Q:'SDOE D Q:Y
409"RTN","SDAMEVT",114,0)
410 . S I=0
411"RTN","SDAMEVT",115,0)
412 . F S I=$O(^TMP("SDEVT",$J,SDHDL,SDORG,"SDOE",SDOE,"CL",I)) Q:'I I $G(^(I,0,"BEFORE"))='$G(^("AFTER")) S Y=1 Q
413"RTN","SDAMEVT",116,0)
414 Q Y
415"RTN","SDAMEVT",117,0)
416 ;
417"RTN","SDAMEVT",118,0)
418OEVT(SDOE,SDCAP,SDHDL,SDATA,SDOE0) ; -- event driver calls by oe
419"RTN","SDAMEVT",119,0)
420 ; SDATA only required for appts
421"RTN","SDAMEVT",120,0)
422 ; SDOE0 only required for check out deletion AFTER
423"RTN","SDAMEVT",121,0)
424 ;
425"RTN","SDAMEVT",122,0)
426 N SD0,SDORG,SDT,DFN,SDDA,SDCL,SDOEP
427"RTN","SDAMEVT",123,0)
428 S SD0=$S($D(^SCE(SDOE,0)):^(0),1:$G(SDOE0)),SDOEP=$P(SD0,U,6)
429"RTN","SDAMEVT",124,0)
430 I SD0']""!(SDOEP) G OEVTQ
431"RTN","SDAMEVT",125,0)
432 S SDT=+SD0,DFN=+$P(SD0,U,2),SDCL=+$P(SD0,U,4),SDORG=+$P(SD0,U,8),SDDA=$P(SD0,U,9)
433"RTN","SDAMEVT",126,0)
434 I SDCAP="BEFORE" D
435"RTN","SDAMEVT",127,0)
436 .I SDORG=1 D BEFORE(.SDATA,DFN,SDT,SDCL,SDDA,SDHDL) Q
437"RTN","SDAMEVT",128,0)
438 .I SDORG=2 D BEFORE^SDAMEVT2(SDOE,SDHDL) Q
439"RTN","SDAMEVT",129,0)
440 .I SDORG=3 D BEFORE^SDAMEVT3(DFN,SDT,9,SDHDL)
441"RTN","SDAMEVT",130,0)
442 I SDCAP="AFTER" D
443"RTN","SDAMEVT",131,0)
444 .I SDORG=1 S SDATA=SDDA_"^"_DFN_"^"_SDT_"^"_SDCL D AFTER(.SDATA,DFN,SDT,SDCL,SDDA,SDHDL),EVT(.SDATA,5,0,SDHDL) Q
445"RTN","SDAMEVT",132,0)
446 .I SDORG=2 D EVT^SDAMEVT2(SDOE,7,SDHDL) Q
447"RTN","SDAMEVT",133,0)
448 .I SDORG=3 D EVT^SDAMEVT3(DFN,SDT,9,SDHDL)
449"RTN","SDAMEVT",134,0)
450OEVTQ Q
451"RTN","SDAMEVT",135,0)
452 ;
453"RTN","SDAMEVT",136,0)
454 ; -- SEE SDAMEVT0 FOR DOC ON VARIABLES
455"VER")
4568.0^22.0
457**END**
458**END**
Note: See TracBrowser for help on using the repository browser.