source: cprs/branches/tmg-cprs/m_files/TMGSDAVS.m@ 1547

Last change on this file since 1547 was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload

File size: 27.8 KB
Line 
1TMGSDAVS ;TMG/kst/Set Schedule Availability API ;12/08/08
2 ;;1.0;TMG-LIB;**1**;12/08/08
3 ;
4 ;"TMG SCHEDULING AVAILIBILITY SETTING
5 ;"Kevin Toppenberg MD
6 ;"GNU General Public License (GPL) applies
7 ;"12/22/08
8 ;
9 ;"NOTE: Much of this code originated from SDB*.m
10 ;
11 ;"Called into from TMGRPC5
12 ;"
13 ;"=======================================================================
14 ;" API -- Public Functions.
15 ;"=======================================================================
16 ;"SETAVAIL(TMGIEN,TMGPATRN,TMGFLAGS,TMGMSG) -- API to set availability for a given clinic
17 ;
18 ;"=======================================================================
19 ;" Private Functions.
20 ;"=======================================================================
21 ;"ONEDAY(TMGIEN,TMG1DATE,TMGLIMDT,TMGFLAGS,PARRAY,TMGMSG) -- set the pattern for a date or date range
22 ;"AVLSTR(TMGIEN,TMG1DATE) -- return an availability string showing appts.
23 ;"MOV1DATE(OLDDATE,NEWDATE) -- Move 1 "T" node, and any linked OST nodes
24 ;"FILTEMPL(TMIEN,TMG1DATE,TMGLIMDT,AVAILSTR) -- fill in Tx nodes (TEMPLATE) subfiles
25 ;"MAKTMPL(TMGIEN,TMGLIMDT,AVAILSTR) -- Store the Tx node
26 ;"KILTMPL(TMGIEN,DATE,DOW) -- Kill the Tx node for given date.
27 ;"FIL1SPL(TMGIEN,TMG1DATE,AVAILSTR) -- Fill in 1 specified date, into "OST" nodes
28 ;"KILLSPL(TMGIEN,TMG1DATE,TMGLIMDT) -- delete "OST" nodes for date range (and any linked "ST" nodes), only on same day of week.
29 ;"Function below no longer used...
30 ;"FIXPATRN(AVAILSTR,TMG1DATE,TMGLIMDT) Sets ST (PATTERN) and OST nodes, based on existing appts. (what else?)
31 ;"
32 ;"=======================================================================
33 ;"Dependancies
34 ;"=======================================================================
35 ;" XLFSTR, %DTC
36 ;" TMGSDAU,TMGSDAU1,
37 ;"=======================================================================
38 ;
39SETAVAIL(TMGIEN,TMGPATRN,TMGFLAGS,TMGMSG) ;
40 ;"Purpose: API to set availability for a given clinic
41 ;"Input: TMGIEN -- IEN in HOSPITAL LOCATION file.
42 ;" TMGPATRN -- PASS BY REFERENCE. Array Format:
43 ;" TMGPATRN(ADate_"^"_EndDate,ExtTime)=ApptsPerSlot
44 ;" TMGPATRN(ADate_"^"_EndDate,ExtTime)=ApptsPerSlot
45 ;" NOTE: Dates can be in external date format or FM Format
46 ;" ADate -- the date for appts, or beginning of date span
47 ;" ADate=0 indicates an earliest possible date range start
48 ;" EndDate -- (OPTIONAL) The date to STOP the slots. (see below)
49 ;" If LimitDate="I", then the date range has no end
50 ;" If LimitDate=0 or "", then slots are set up for just 1 day
51 ;" ExtTime -- External Time range for slots (Military time format). E.g. 0830-1145
52 ;" IMPORTANT NOTES: If ADate is a MONDAY (for example), and the EndDate
53 ;" is for 6 months later, then the slots will be applied
54 ;" to *MONDAYS* during this interval, NOT all days during the
55 ;" date range. Also, the date range includes EndDate.
56 ;" Example: To set up a one day with multiple times as folows:
57 ;" 0800-0810 2 appt/slot (2 appts both schedulable at 0800)
58 ;" 0830-0850 1 appt/slot (if 10 min slots ==> 2 appts)
59 ;" 0900-0930 1 appt/slot (==> 3 appts)
60 ;" 1000-1140 1 appt/slot (==> 10 appts)
61 ;" For the above schedule, pass the following data:
62 ;" TMGPATRN("ADate^I","0800-0810")=2
63 ;" TMGPATRN("ADate^I","0830-0850")=1
64 ;" TMGPATRN("ADate^I","0900-0930")=1
65 ;" TMGPATRN("ADate^I","1000-1140")=1
66 ;" This result in a availability entry something like below:
67 ;" | 2 1 1 | 1 1 1 | 1 1 1 1 1 1 | 1 1 1 1 |
68 ;" TMGFLAGS -- "D" = Delete appts (if not present then appts are SET)
69 ;" "I" = Ignore existing appts when changing slots (TO BE IMPLEMENTED)
70 ;" TMGMSG -- PASS BY REFERENCE, an OUT PARAMETER. Format:
71 ;" TMGMSG(FMDate)=Err#^Message
72 ;" TMGMSG(FMDate)=Err#^Message
73 ;" Errors#:
74 ;" 1 - IEN in file 44 no provided
75 ;" 2 - Type of clinic (field 3) is not CLINIC
76 ;" 3 - OOS clinics (field 50.01) not supported by this API
77 ;" 4 - Fields 1912-1918 not setup for clinic"
78 ;" 5 - Clinic is inactive as of DATE, or Clinic is inactive from DATE to DATE
79 ;" 6 - Time [SomeTime] invalid.'
80 ;" 7 - Time [SomeTime] invalid. Must schedule appts on 5 minute boundries"
81 ;" 8 - Time [SomeTime] invalid. Cannot be earlier than clinic start time (StartTime)"
82 ;" 9 - Time [SomeTime] invalid. Must begin after last ending time (SomeTime)."
83 ;" 10 - Time [SomeTime] invalid. Must end after begin time (SomeTime)."
84 ;" 11 - TIME SPAN ENTERED NOT CONSISTENT WITH "_TMGSDUR_" MIN APPT LENGTH"
85 ;" 12 - No Appts/Slot specified for '"_TMGTIMES_"'"
86 ;" 13 - Time [SomeTime] invalid. "_H1_M1_" is > "_H2_M2_"."
87 ;" 14 - Time [SomeTime] invalid."
88 ;" //15 - Invalid Mode ("_TMGMODE_"). Must be 1,2,11, or 12"
89 ;" 16 - "$$EXTDAT(TMG1DATE)_" HAS PENDING APPTS - CAN NOT ALTER SLOTS UNLESS 'I' FLAG SET"
90 ;" 17 - "$$EXTDAT(TMG1DATE)_" is a holiday, but File 44, Field 1918.5 doesn't allow scheduling."
91 ;" 18 - Clinic is inactive from "_$$EXTDAT((TMGINACT)_" to "_$$EXTDAT(TMGREACT1)
92 ;
93 ;"Result: 1 = Success or
94 ;" -1 = error
95 ;" 0 = Intermediate success
96 ;
97 ;"---Setup vars etc---
98 NEW TMGRESULT SET TMGRESULT=1 ;"Default to success
99 SET TMGIEN=+TMGIEN
100 IF TMGIEN'>0 DO GOTO SAVDONE
101 . SET TMGMSG(0)="1^IEN in file 44 no provided"
102 . SET TMGRESULT=-1
103 IF $PIECE($GET(^SC(TMGIEN,0)),"^",3)'="C" DO GOTO SAVDONE
104 . SET TMGMSG(0)="2^Type of clinic (field 3) is not CLINIC"
105 . SET TMGRESULT=-1
106 IF $GET(^SC(TMGIEN,"OOS"))'="" DO GOTO SAVDONE
107 . SET TMGMSG(0)="3^OOS clinics (field 50.01) not supported by this API"
108 . SET TMGRESULT=-1
109 NEW TMGDATE ;"TMGDATE=Start of date range
110 NEW TMGLIMDT ;"TMGLIMDT=Limiting end of date range. Will be specified EndDate+1
111 NEW TMGABORT SET TMGABORT=0
112 SET TMGFLAGS=$GET(TMGFLAGS)
113 NEW TMGSLNOD SET TMGSLNOD=$GET(^SC(TMGIEN,"SL")) ;"^SC(IEN,"SL", SL node
114 IF TMGSLNOD="" DO GOTO SAVDONE
115 . SET TMGMSG(0)="4^Fields 1912-1918 are not setup for clinic (File 44)"
116 . SET TMGRESULT=-1
117 ;
118 ;"Ensure subfile data structure
119 IF '$D(^SC(TMGIEN,"T",0)) SET ^SC(TMGIEN,"T",0)="^44.002D"
120 ;
121 ;"---Loop through provided date ranges and process each sequentially
122 NEW TMGDTRNG SET TMGDTRNG="" ;"DATE RANGE
123 FOR SET TMGDTRNG=$ORDER(TMGPATRN(TMGDTRNG)) QUIT:(TMGDTRNG="")!TMGABORT DO
124 . NEW TEMPFLGS SET TEMPFLGS=TMGFLAGS
125 . SET TMGABORT=$$SPLITDTS^TMGSDAU1(TMGDTRNG,.TMG1DATE,.TMGLIMDT,.TEMPFLGS,.TMGRESULT,.TMGMSG)
126 . IF TMGABORT QUIT
127 . LOCK +^SC(TMGIEN):10 ;"LOCK HERE
128 . ELSE DO QUIT
129 . . SET TMGMSG(TMG1DATE_"^"_TMGLIMDT)="Unable to get lock on ^SC("_TMGIEN_")."
130 . . SET TMGRESULT=-1,TMGABORT=1
131 . NEW TEMP
132 . SET TEMP=$$ONEDAY(TMGIEN,TMG1DATE,TMGLIMDT,TEMPFLGS,$NAME(TMGPATRN(TMGDTRNG)),.TMGMSG)
133 . LOCK -^SC(TMGIEN) ;"RELEASE LOCK...
134 . IF TEMP=-1 SET TMGRESULT=0 ;"Continue processing despite error encountered.
135SAVDONE ;
136 QUIT TMGRESULT
137 ;
138 ;
139ONEDAY(TMGIEN,TMG1DATE,TMGLIMDT,TMGFLAGS,PARRAY,TMGMSG)
140 ;"Purpose: To set the pattern for a date or date range
141 ;"Input: TMGIEN -- IEN of clinic to edit, in file 44
142 ;" TMG1DATE -- FM-format Date of reference
143 ;" TMGLIMDT -- FM-format *limit* date for appointments date range
144 ;" TMGFLAGS -- "D" = Delete appts (if not present then appts are SET)
145 ;" "R" = Work on range from TMG1DATE up to, but not
146 ;" including, limit date TMGLIMDT
147 ;" "I" = Ignore existing appts when changing slots
148 ;" PARRAY -- PASS BY NAME. FORMAT:
149 ;" -- ExtTime is external time: e.g. 0800-1315
150 ;" @PARRAY@(ExtTime)=#Appts/Slot
151 ;" @PARRAY@(ExtTime)=#Appts/Slot
152 ;" TMGMSG -- PASS BY REFERENCE. An OUT PARAMETER. See format above.
153 ;"Globally-scoped vars used: ...
154 ;"Note: It is presumed record locking has already occured
155 ;"Example: To set up a one day with multiple times as folows:
156 ;" TMGFLAGS=""
157 ;" 0800-0810 2 appt/slot (2 appts both schedulable at 0800)
158 ;" 0830-0850 1 appt/slot (if 10 min slots ==> 2 appts)
159 ;" 0900-0930 1 appt/slot (==> 3 appts)
160 ;" 1000-1140 1 appt/slot (==> 10 appts)
161 ;" For the above schedule, pass the following data:
162 ;" @PARRAY@("0800-0810")=2
163 ;" @PARRAY@("0830-0850")=1
164 ;" @PARRAY@("0900-0930")=1
165 ;" @PARRAY@("1000-1140")=1
166 ;" This result in a availability entry something like below:
167 ;" | 2 1 1 | 1 1 1 | 1 1 1 1 1 1 | 1 1 1 1 |
168 ;"Output: ^SC(IEN,... is modified.
169 ;"Result: 1 = Success or
170 ;" -1 = error
171 ;
172 NEW TMGRESULT SET TMGRESULT=1
173 NEW AVAILSTR
174 NEW TMGERR SET TMGERR=0 ;"Clear Error flag
175 ;
176 ;"--Validate user input, including check for inactivation etc etc
177 DO VALDATES^TMGSDAU1(TMGIEN,PARRAY,TMG1DATE,TMGLIMDT,TMGFLAGS,.TMGERR,.TMGMSG)
178 IF TMGERR SET TMGRESULT=-1 GOTO ONEDDONE ;"(Error details set in VALDATES)
179 ;
180 ;"Delete any SPECIAL PATTERNS ("OST") entries during same date.
181 DO KILLSPL(TMGIEN,TMG1DATE,TMGLIMDT)
182 ;
183 ;"Delete AVAILABILITY ("T") node, and any linked "ST" and "OST" nodes.
184 DO KILLAVAL^TMGSDAU2(TMGIEN,TMG1DATE,TMGLIMDT,TMGFLAGS)
185 ;
186 ;" -- If just deleting, then kill Avail and quit
187 IF TMGFLAGS["D" DO GOTO ONEDDONE
188 . DO KILTMPL(TMGIEN,TMGLIMDT) ;"Kill the Tx node for given date.
189 ;
190 ;"Load AVAILABILITY subfile ("T" node), specifying num of Pts allowed in each slot
191 DO FILLAVAL^TMGSDAU2(TMGIEN,PARRAY,TMG1DATE,TMGLIMDT,.TMGERR,.TMGMSG)
192 IF TMGERR GOTO OD2 ;"(Error details set in FILLAVL)
193 ;
194 SET AVAILSTR=$$AVLSTR(TMGIEN,TMG1DATE)
195 IF TMGFLAGS'["R" DO ;"I.e for 1 date, NOT RANGE
196 . DO FIL1SPL(TMGIEN,TMG1DATE,AVAILSTR) ;"Fill in 1 specified date, into "OST" nodes
197 . SET TMGRESULT=$$MAKE1ST^TMGSDAU(TMGIEN,TMG1DATE,.TMGMSG) ;"make/remake a "ST" node
198 IF TMGFLAGS["R" DO ;"I.e. for date RANGE
199 . ;"Fill template Tx nodes, also sets ST and OST nodes, based on existing appts. (what else?)
200 . DO FILTEMPL(TMGIEN,TMG1DATE,TMGLIMDT,AVAILSTR)
201 . SET TMGRESULT=$$FRSH7ST^TMGSDAU(TMGIEN,TMG1DATE,.TMGMSG) ;"Fill in 7 ST nodes.
202 ;
203 ;"Note: there was some code here to trigger auto-rebook.. Will cut out for now.
204ONEDDONE;
205 Q TMGRESULT
206 ;
207 ;"-----------------------------------------------------------------------------
208 ;" Support functions
209 ;"-----------------------------------------------------------------------------
210AVLSTR(TMGIEN,TMG1DATE)
211 ;"Purpose: to return an availability string showing appts slots
212 ;"Input: TMGIEN -- IEN of clinic in file 44
213 ;" TMG1DATE -- date to get string for
214 ;"Create Y(pos) array to represent one line of availability. (Will utimately result in something like below)
215 ;" | 2 1 1 | 1 1 1 | 1 1 1 1 1 1 | 1 1 1 1 |
216 ;
217 NEW HSI ;" ?? meaning.. <something> slot increments (slots/hr)
218 NEW TMGSPH ;" display slots/hr
219 NEW TMGSLNOD SET TMGSLNOD=$GET(^SC(TMGIEN,"SL")) ;"^SC(IEN,"SL", SL node
220 NEW TMGSDUR SET TMGSDUR=+TMGSLNOD ;"SL;1 = field 1912 LENGTH OF APP'T
221 NEW STARTDAY SET STARTDAY=+$P(TMGSLNOD,U,3) ;"SL;3=HR CLINIC DISPLAY BEGINS
222 IF STARTDAY'>0 SET STARTDAY=8 ;"Default to start at 8 am
223 SET TMGSPH=+$P(TMGSLNOD,U,6) ;"SL;6 = DISPLAY INCREMENTS PER HOUR (Slots per Hr)
224 IF TMGSPH'>0 SET TMGSPH=4 ;"Default to 4 slots/hr
225 SET HSI=TMGSPH
226 IF TMGSPH=1 SET TMGSPH=4,HSI=1
227 IF TMGSPH=2 SET TMGSPH=4,HSI=2
228 ;
229 NEW AVLARRAY,COUNT,Y,POS
230 NEW RESULT SET RESULT=""
231 SET DH=TMGSDUR*TMGSPH\60 ;"Minutes/slot * Slots/hr = Minutes/hr ; \60 ==> 1 if all even.
232 SET COUNT=0
233 FOR SET COUNT=+$ORDER(^SC(TMGIEN,"T",TMG1DATE,2,COUNT)) Q:COUNT'>0 DO
234 . SET Y=^SC(TMGIEN,"T",TMG1DATE,2,COUNT,0) ;"0 node holds fields .01,1; +Y=time of slot,
235 . FOR D=1:1:DH DO
236 . . NEW MIN,HR
237 . . SET MIN=Y#100
238 . . SET HR=Y\100
239 . . SET POS=MIN*TMGSPH\60+(HR*TMGSPH)-(STARTDAY*TMGSPH)+D
240 . . NEW NUMPAT SET NUMPAT=+$PIECE(Y,U,2)
241 . . SET AVLARRAY(POS)=$E("0123456789jklmnopqrstuvwxyz",NUMPAT+1) ;"code to show how many patients in slot.
242 IF $DATA(AVLARRAY)=0 DO GOTO AVSDONE
243 . ;"SET SDEL=1 --> SOMETHING NEEDS TO BE CLEARED OUT?
244 IF $DATA(HSI) DO
245 . IF (HSI'=1)&(HSI'=2) QUIT
246 . ;"Remove elements of Y array that don't fall in increments of HSI
247 . NEW X,INC,DONE,TEMPY
248 . SET INC=$SELECT(HSI=1:4,1:2)
249 . SET DONE=0
250 . FOR X=$ORDER(Y(-1)):INC Q:(X>41)!DONE DO
251 . . IF $DATA(Y(X)) SET TEMPY(X)="" QUIT
252 . . IF $ORDER(Y(X))'>0 SET DONE=1 QUIT
253 . . SET X=$ORDER(Y(X-1))-INC
254 . SET X=0
255 . FOR SET X=$ORDER(Y(X)) Q:X'>0 DO
256 . . IF '$DATA(TEMPY(X)) KILL Y(X)
257 NEW DNOW,DLAST,VALUE
258 SET (DNOW,DLAST)=0,Y=1,VALUE=" "
259 FOR POS=1:1 DO IF 'DNOW,$ORDER(AVLARRAY(POS))'>0 QUIT
260 . SET DNOW=$DATA(AVLARRAY(POS))
261 . SET VALUE=$GET(AVLARRAY(POS)," ")
262 . IF ('DNOW)&(DLAST) SET SYM="]"
263 . ELSE IF (DNOW)&('DLAST) SET SYM="["
264 . ELSE IF POS#TMGSPH=1 SET SYM="|"
265 . ELSE SET SYM=" "
266 . SET RESULT=RESULT_SYM_VALUE
267 . SET DLAST=DNOW
268AVSDONE
269 QUIT RESULT
270 ;
271 ;
272MOV1DATE(OLDDATE,NEWDATE) ;"Unused??
273 ;"Purpose: Move 1 "T" node, and any linked OST nodes
274 ;"Input: OLDDATE
275 ;" NEWDATE
276 ;"Globally-scoped vars used: TMGIEN
277 ;"Note: It is presumed record locking has already occured
278 NEW TEMP MERGE TEMP=^SC(TMGIEN,"T",OLDDATE)
279 NEW TEMP2 MERGE TEMP2=^SC(TMGIEN,"OST",OLDDATE)
280 DO KILL1DATE^TMGSDAU2(OLDDATE,1)
281 MERGE ^SC(TMGIEN,"T",NEWDATE)=TEMP
282 SET ^SC(TMGIEN,"T",NEWDATE,0)=NEWDATE
283 IF $DATA(TEMP2) DO
284 . SET ^SC(TMGIEN,"OST",NEWDATE)=TEMP2
285 . SET ^SC(TMGIEN,"OST",NEWDATE,0)=NEWDATE
286 QUIT
287 ;
288 ;
289FILTEMPL(TMIEN,TMG1DATE,TMGLIMDT,AVAILSTR)
290 ;"Purpose: To fill in Tx nodes (TEMPLATE) subfiles
291 ;"Input: TMGIEN -- IEN in file 44
292 ;" TMG1DATE -- Start of date range. Use 0 for earliest possible
293 ;" TMGLIMDT -- Limit of date range (range is up to BUT NOT INCLUDINGE this date)
294 ;" AVAILSTR
295 ;"Globally scoped vars used: ..
296 ;"Result: none
297 ;"Note: It is presumed record locking has already occured
298 ;
299 ;"Note: I am not going to screen for clinic inactivation. If a TEMPLATE
300 ;" is set today for the next year, and then the clinic inactivation
301 ;" is specified to occur in 6 months, I don't know how to handle that.
302 ;" There was some code to see if there was an exact match between
303 ;" some of the dates here, and clinic inactivation dates. But I don't
304 ;" why I should check particular days, when we are dealing with *ranges*
305 ;
306 ;"EXAMPLES OF POSSIBLE PATTERNS...
307 ;"================================
308 ;"Imagine that there exists four patterns A,B,C,E, with LIMIT
309 ;"dates of LA,LB,LC,99999999
310 ;"A timeline will be shown with the various limits
311 ;">--------------------------------------------------99999999
312 ;"E.g. LA LB LC LE
313 ;">------>--------->--------->------------->---------99999999
314 ;"And then the ranges will be filled with the letters for that range (see below)
315 ;
316 ;
317 ;" ----------------------Example -----------------------------
318 ;"And we add a new range from Start-->End (named D)
319 ;"(New range overrides range 1+ another range)
320 ;" LA LB LC 9999999
321 ;" >aaaaaa>bbbbbbbbbb>cccccccccc>eeeeeeeeeeeee>
322 ;" +======================>D-End
323 ;"Should result in...
324 ;" LA LB LD 9999999
325 ;" >aaaaaa>bbb>dddddddddddddddddddddd>eeeeeeeee>
326 ;"The following must happen:
327 ;" Range AB is shortened so that B is at D-Start
328 ;" (i.e. next limit occuring after D-Start is changed so that
329 ;" limit is the same as D-Start)
330 ;" Any LIMIT entries before D-End are removed
331 ;" D-End is stored as limit of last
332 ;
333 ;" ----------------------Example -----------------------------
334 ;"New range is entirely inside another range (dividing it into 2 parts)
335 ;" LA LB LC 9999999
336 ;" >aaaaaa>bbbb>cccccccccccccccccc>eeeeeeeeeeeee>
337 ;" +=========>D-End
338 ;"Should result in...
339 ;" LA LB LC1 LD LC2 9999999
340 ;" >aaaaaa>bbbbb>cc>dddddddddd>ccc>eeeeeeeeeeeeee>
341 ;" Next limit occuring after D-Start is changed so that
342 ;" limit is the same as D-Start, UNLESS it is also occurs
343 ;" after D-End. In that case it is left in place and copied
344 ;" instead.
345
346 ;" ----------------------Example -----------------------------
347 ;"New Range preceeds other ranges
348 ;" LA LB LC 9999999
349 ;" >aaaaaaaaaaaaaaa>bbbbbbbbbbbbbb>ccccccccccc>eeeeeeeee>
350 ;" +=======>D-End
351 ;"Should result in...
352 ;" LA LD LA LB LC 9999999
353 ;" >aaaddddddddd>aa>bbbbbbbbbbbbbb>ccccccccccc>eeeeeeeee>
354 ;" Next limit occuring after D-Start is changed so that
355 ;" limit is the same as D-Start, UNLESS it is also occurs
356 ;" after D-End. In that case it is left in place and copied
357 ;" instead. UNLESS there is no prior limit
358
359 ;" ----------------------Example -----------------------------
360 ;"New Range should be the new ending range
361 ;" LA LB LC 9999999
362 ;" >aa>bbbbb>ccccccc>eeeeeeeeeeeeeeeeeeeeeeeee>
363 ;" +==========================>D-End
364 ;"Should result in...
365 ;" LA LB LC LE 9999999
366 ;" >aa>bbbbb>ccccccc>eee+dddddddddddddddddddddddddd>
367 ;" Next limit occuring after D-Start is changed so that
368 ;" limit is the same as D-Start, UNLESS it is also occurs
369 ;" after D-End. In that case it is left in place and copied
370 ;" instead. UNLESS there is no prior limit.
371 ;"
372
373 ;"RULES TO HANDLE ABOVE.
374 ;" 1. Does new start date=0 ?
375 ;" if YES, then there is no earlier start dates.
376 ;" skip step 3
377 ;" if NO, then treat at others.
378 ;" 2. Get next limit after start date
379 ;" Is this next date AFTER end date?
380 ;" If YES, then new range is inside another. BEGIN
381 ;" create a new, extra, entry, with limit date=start date
382 ;" Done.
383 ;" if NO, then begin
384 ;" is there already an entry with LIMIT same as start date?
385 ;" if NO: Move this to new start date. (i.e. make it's limit to equal New Start Date)
386 ;" IF YES, then is prior limit date same as this start date?
387 ;" IF NO, then just delete this entry ?????
388 ;" if YES, needs split... FINISH...?????
389 ;" 3. Cycle through each limit after step 2, and delete all
390 ;" that occur before OR AT (i.e. <= ) new end date reached.
391 ;" 4. Create new entry with limit date of End date.
392 ;
393 NEW DOW SET DOW=$$DOW^XLFDT(TMG1DATE,1) ;"DOW=Day of Week (0-6)
394 NEW NEXT SET NEXT=$ORDER(^SC(TMGIEN,"T"_DOW,TMG1DATE))
395 IF TMGLIMDT=0 GOTO FT2
396 IF NEXT>TMGLIMDT DO GOTO FT3
397 . DO MAKTMPL(TMGIEN,TMG1DATE,$GET(^SC(TMGIEN,"T"_DOW,NEXT,1)))
398 ELSE IF +NEXT>0 DO
399 . IF $DATA(^SC(TMGIEN,"T"_DOW,TMG1DATE)) DO QUIT
400 . . DO KILTMPL(TMGIEN,NEXT,DOW) ;"Kill the Tx node for given date.
401 . DO MAKTMPL(TMGIEN,TMG1DATE,$GET(^SC(TMGIEN,"T"_DOW,NEXT,1)))
402 . DO KILTMPL(TMGIEN,NEXT,DOW) ;"Kill the Tx node for given date.
403FT2 FOR SET NEXT=$ORDER(^SC(TMGIEN,"T"_DOW,NEXT)) QUIT:(+NEXT'>0)!(+NEXT>TMGLIMDT) DO
404 . DO KILTMPL(TMGIEN,NEXT,DOW) ;"Kill the Tx node for given date.
405FT3 DO MAKTMPL(TMGIEN,TMGLIMDT,AVAILSTR)
406 ;"Ensure header.
407 IF '$DATA(^SC(TMGIEN,"T"_DOW,0)) DO
408 . SET ^SC(TMGIEN,"T"_DOW,0)="^44.0"_$S(DOW<4:DOW+6,DOW<6:"0"_DOW+4,1:"001")_"A^^"
409 ;
410 QUIT
411 ;
412 ;
413MAKTMPL(TMGIEN,TMGLIMDT,AVAILSTR)
414 ;"Purpose: Store the Tx node
415 ;"Check for clinic inactivation should have already taken place during validation
416 ;"Note: It is presumed record locking has already occured
417 NEW DOW SET DOW=$$DOW^XLFDT(TMG1DATE,1) ;"DOW=Day of Week (0-6)
418 SET ^SC(TMGIEN,"T"_DOW,TMGLIMDT,1)=AVAILSTR
419 SET ^SC(TMGIEN,"T"_DOW,TMGLIMDT,0)=TMGLIMDT
420 QUIT
421 ;
422 ;
423KILTMPL(TMGIEN,DATE,DOW)
424 ;"Purpose: Kill the Tx node for given date.
425 ;"Input: TMGIEN
426 ;" DATE
427 ;" DOW -- Optional. Day of week that DATE falls on (0-6)
428 ;"Check for existing appts should have already taken place during validation
429 ;"Note: It is presumed record locking has already occured
430 SET DOW=$GET(DOW)
431 IF (DOW="")!(+DOW>6)!(+DOW<0) SET DOW=$$DOW^XLFDT(DATE,1) ;"DOW=Day of Week (0-6)
432 KILL ^SC(TMGIEN,"T"_DOW,DATE)
433 QUIT
434 ;
435 ;
436FIL1SPL(TMGIEN,TMG1DATE,AVAILSTR)
437 ;"Purpose: Fill in 1 specified date, into "OST" nodes
438 ;"Note: It is presumed record locking has already occured
439 NEW STR SET STR=$$SPECPAT^TMGSDAU(TMGIEN,TMG1DATE,AVAILSTR)
440 IF STR'="" DO
441 . SET ^SC(TMGIEN,"ST",TMG1DATE,0)=TMG1DATE
442 . SET ^SC(TMGIEN,"ST",TMG1DATE,1)=STR
443 . IF '$DATA(^SC(TMGIEN,"ST",0)) SET ^(0)="^44.005DA^^"
444 . SET ^SC(TMGIEN,"ST",TMG1DATE,9)=TMGIEN ;"9 node --> use OST node for special availability
445 . SET ^SC(TMGIEN,"OST",TMG1DATE,0)=TMG1DATE
446 . SET ^SC(TMGIEN,"OST",TMG1DATE,1)=STR
447 . IF '$DATA(^SC(TMGIEN,"OST",0)) SET ^(0)="^44.0002DA^^"
448 IF $GET(^SC(TMGIEN,"ST",0))="" SET ^SC(TMGIEN,"ST",0)="^44.005DA^^"
449 ;
450 QUIT
451 ;
452 ;
453KILLSPL(TMGIEN,TMG1DATE,TMGLIMDT)
454 ;"Purpose: To delete "OST" nodes for date range (and any linked "ST" nodes), only on same day of week.
455 ;"Note: It is presumed record locking has already occured
456 NEW DATE SET DATE=TMG1DATE
457 NEW DOW SET DOW=$$DOW^XLFDT(DATE,1)
458 FOR DO SET DATE=$ORDER(^SC(TMGIEN,"OST",DATE)) QUIT:(+DATE'>0)!(DATE'<TMGLIMDT)!(DATE'<DT+50000)
459 . IF $$DOW^XLFDT(DATE,1)'=DOW QUIT
460 . KILL ^SC(TMGIEN,"ST",DATE)
461 . KILL ^SC(TMGIEN,"OST",DATE)
462 QUIT
463 ;
464 ;
465 ;"Function below no longer used...
466FIXPATRN(AVAILSTR,TMG1DATE,TMGLIMDT) ;"Used to be B1^SDB1
467 ;"Purpose: Sets ST (PATTERN) and OST nodes, based on existing appts. (what else?)
468 ;"Input: AVAILSTR=PATTERN (was DH)
469 ;" TMG1DATE=START DATE (was X)
470 ;" TMGLIMDT=EXPIRATION DATE
471 ;"Globally scoped vars used: TMGIEN, DT(standard environ var)
472 ;"Note: It is presumed record locking has already occured
473 ;
474 NEW TMGSPH
475 SET TMGSPH=+$P($GET(^SC(TMGIEN,"SL")),"^",6) ;"SL;6 = DISPLAY INCS PER HOUR (Slots per Hr)
476 IF TMGSPH'>0 SET TMGSPH=4 ;"Default to 4 slots/hr
477 NEW STARTDAY SET STARTDAY=+$P($GET(^SC(TMGIEN,"SL")),"^",3) ;"SL;3=HR CLINIC DISPLAY BEGINS
478 NEW NXTAPPT SET NXTAPPT=0
479 NEW SB SET SB=(STARTDAY-1)/100 ;"Eg 8 --> .07
480 NEW STR SET STR="{}&%?#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
481 NEW SDONE SET SDONE=1
482 NEW TEMPPAT SET TEMPPAT=""
483 NEW SDPAT SET SDPAT=""
484 NEW HSI SET HSI=$S('TMGSPH:4,TMGSPH<3:8/TMGSPH,1:2)
485 NEW SI SET SI=+TMGSPH
486 IF SI=0 SET SI=4
487 NEW SDSI SET SDSI=SI
488 IF (SI=1)!(SI=2) SET SI=4
489 ;
490 ;"--Start loop---
491 NEW DONE SET DONE=0
492 SET DATE=TMG1DATE
493 FOR DO SET DATE=$$ADD2DATE^TMGSDAU1(DATE,7) QUIT:(DATE'<TMGLIMDT)!DONE!(DATE'<(DT+50000))
494 . NEW SKIP SET SKIP=0
495 . SET TEMPPAT=$GET(^SC(TMGIEN,"ST",DATE,1))
496 . IF TEMPPAT["**CANCELLED**"!(TEMPPAT["X") DO
497 . . SET ^TMP("SDAVAIL",$J,DATE)=TEMPPAT
498 . SET NXTAPPT=+$ORDER(^SC(TMGIEN,"S",DATE)) ;"Get DateTime of next appt
499 . IF $DATA(^SC(TMGIEN,"ST",DATE,9)) DO ;"Does flag for special OST node exist?
500 . . SET NXTAPPT=DATE,SDSAV=0
501 . ELSE DO QUIT:(SKIP=1)
502 . . KILL ^SC(TMGIEN,"ST",DATE) ;"Del PATTERN subfile entry for start date
503 . . IF NXTAPPT'>0,'$ORDER(^SC(TMGIEN,"ST",DATE)) DO QUIT
504 . . . SET DONE=1
505 . . . SET SKIP=1
506 . . IF DATE+1<NXTAPPT DO QUIT
507 . . . SET DATE=$$ADD2DATE^TMGSDAU1(DATE,7)
508 . . . SET SKIP=1
509 . . SET SDSAV=0
510 . . IF (NXTAPPT\1)'=DATE DO QUIT ;"If next appt is on different day then keep scanning
511 . . . SET DATE=$$ADD2DATE^TMGSDAU1(DATE,7)
512 . . . SET SKIP=1
513 . ;"-- Fix for entries on same day as new pattern supplied --
514 . SET SM=$$SPECPAT^TMGSDAU(TMGIEN,DATE,AVAILSTR)
515 . IF 'SDSAV SET SDSAV=1,SDPAT=SM
516 . FOR DO SET NXTAPPT=+$ORDER(^SC(TMGIEN,"S",NXTAPPT)) QUIT:(NXTAPPT\1'=DATE)
517 . . NEW I SET I=(NXTAPPT#1-SB)*100
518 . . SET I=I#1*SI\.6+(I\1*SI)*2
519 . . NEW S SET S=$EXTRACT(SM,I,999)
520 . . SET SM=$EXTRACT(SM,1,I-1)
521 . . SET Y=0
522 . . FOR SET Y=$ORDER(^SC(TMGIEN,"S",NXTAPPT,1,Y)) Q:Y'>0 DO
523 . . . IF $PIECE(^(Y,0),"^",9)["C" QUIT ;"ignore if appt cancelled
524 . . . SET SDSL=$PIECE(^(0),"^",2)/TMGSDUR*(TMGSDUR\(60/SDSI))*HSI-HSI
525 . . . FOR I=0:HSI:SDSL DO
526 . . . . SET ST=$EXTRACT(S,I+2)
527 . . . . IF ST="" SET ST=" "
528 . . . . SET S=$E(S,1,I+2-1)_$E(STR,$F(STR,ST)-2)_$E(S,I+3,999)
529 . . . . DO ;"WAS D OB in old code
530 . . . . . SET SDSLOT=$EXTRACT(STR,$F(STR,ST)-2)
531 . . . . . IF (SDSLOT?1P),(SDSLOT'?1" ") DO QUIT
532 . . . . . . SET ^SC(TMGIEN,"S",NXTAPPT,1,Y,"OB")="O" ;"OB = overbook field
533 . . . . . . KILL SDSLOT
534 . . . . . KILL ^SC(TMGIEN,"S",NXTAPPT,1,Y,"OB")
535 . . . . . KILL SDSLOT
536 . . SET SM=SM_S
537 . IF $L(SM)>SM DO
538 . . SET ^SC(TMGIEN,"ST",DATE,0)=DATE
539 . . SET ^SC(TMGIEN,"ST",DATE,1)=SM
540 . . IF '$D(^SC(TMGIEN,"ST",0)) SET ^(0)="^44.005DA^^"
541 . . IF $D(^SC(TMGIEN,"ST",DATE,9)) DO
542 . . . SET ^SC(TMGIEN,"OST",DATE,0)=DATE
543 . . . SET ^SC(TMGIEN,"OST",DATE,1)=SDPAT
544 . . . IF '$D(^SC(TMGIEN,"OST",0)) SET ^(0)="^44.0002DA^^"
545 . SET SDCAN=DATE
546 . FOR SET SDCAN=$O(^SC(TMGIEN,"SDCAN",SDCAN)) Q:(SDCAN\1-(DATE\1))!'SDCAN DO
547 . . KILL ^SC(TMGIEN,"SDCAN",SDCAN)
548 ;
549FPTNDONE ;
550 QUIT
551 ;
552 ;
Note: See TracBrowser for help on using the repository browser.