source: cprs/branches/tmg-cprs/m_files/TMGSDAU1.m@ 1709

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

Initial upload
File size: 14.9 KB
Line 
1TMGSDAU1 ;TMG/kst/Schedule Availability Utilities 1;12/22/08
2 ;;1.0;TMG-LIB;**1**;12/22/08
3 ;
4 ;"TMG SCHEDULING AVAILIBILITY UTILITIES 1
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 ;"=======================================================================
12 ;" API -- Public Functions.
13 ;"=======================================================================
14 ;"SPLITDTS(TMGDTRNG,TMG1DATE,TMGLIMDT,TMGFLAGS,TMGRESULT,TMGMSG) -- Split a date range string into separate vars, and validate
15 ;"VALDATES(TMGIEN,PARRAY,TMG1DATE,TMGERR,TMGMSG) -- Validate specified input times
16 ;"APPTCHK(TMGIEN,TMG1DATE,TMGLIMDT,ST,ET) -- Check if active appts on DATE/Time
17 ;"EXTDAT(TMGADATE) -- Get external time display
18 ;"MILADD(TIME,ADDMIN,HR,MIN) -- Add time to TIME (in military format) and also return hours (HR) and minutes (MIN)
19 ;"MILADD2(TIME,TIME2,HR,MIN) -- Add TIME2 to TIME (in military format) and also return hours (HR) and minutes (MIN)
20 ;"MILSUB(TIME,SUBMIN,HR,MIN) -- Subtract time from TIME (in military format) and also return hours (HR) and minutes (MIN)
21 ;"VALIDMIL(TMGDATE,TIME,TMGERR,TMGMSG) -- Validate time
22 ;"MILDELTA(T1,T2) -- number of minutes T2-T1 (Military format)
23 ;"MILSUB2(TIME,SUBTIME,HR,MIN) --TIME-SUBTIME=RESULT (Result returned in HR and Min)
24 ;"GFMDATE(EXTDATE) -- return FM date from external date
25 ;"ADD2DATE(FMDATE,INCNUM) -- return FMDate + added IncNum
26 ;
27 ;"=======================================================================
28 ;"Dependancies
29 ;"=======================================================================
30 ;
31 ;"=======================================================================
32 ;
33SPLITDTS(TMGDTRNG,TMG1DATE,TMGLIMDT,TMGFLAGS,TMGRESULT,TMGMSG)
34 ;"Purpose: Split a date range string into separate vars, and validate
35 ;"Input: TMGDTRNG -- Date range, as specified by user
36 ;" TMG1DATE -- PASS BY REFERENCE. An OUT Var. Returned FM Format date
37 ;" TMGLIMDT -- PASS BY REFERENCE. An OUT Var. Returned FM Format date
38 ;" TMGFLAGS -- PASS BY REFERENCE.
39 ;" TMGERR -- Pass by REFERENCE. An OUT Var. A result flag
40 ;" TMGMSG -- Pass by REFERENCE --An output Message array
41 ;"Result: 0 if OK, 1 if ERROR.
42 ;"Note: TMGLIMDT will be set to an appropriate date, even if a RANGE
43 ;" is not planned. But 'R' flag will not be set.
44 ;
45 NEW TMGABORT SET TMGABORT=0
46 SET TMG1DATE=$$GFMDATE($PIECE(TMGDTRNG,"^",1))
47 IF TMG1DATE=-1 DO GOTO SDDONE
48 . SET TMGMSG(TMGDTRNG)="6^Invalid date: "_TMGDTRNG
49 . SET TMGRESULT=-1
50 NEW TMGENDDT SET TMGENDDT=$PIECE(TMGDTRNG,"^",2) ;"get ending date from range
51 IF TMGENDDT="I" DO
52 . SET TMGLIMDT=9999999 ;"Specify indefinite ending date
53 . IF TMGFLAGS'["R" SET TMGFLAGS=TMGFLAGS_"R" ;"Specify a date range
54 ELSE DO QUIT:(TMGABORT)
55 . IF +TMGENDDT=0 DO
56 . . SET TMGENDDT=TMG1DATE ;"One day only
57 . . IF TMGFLAGS["R" SET TMGFLAGS=$TRANSLATE(TMGFLAGS,"R","") ;"remove flag
58 . . IF TMGFLAGS'["1" SET TMGFLAGS=TMGFLAGS_"1" ;"Flag to not add range flag later
59 . ELSE DO
60 . . SET TMGENDDT=$$GFMDATE(TMGENDDT) ;"get ending date from range
61 . . IF TMGFLAGS'["R" SET TMGFLAGS=TMGFLAGS_"R" ;"Specify a date range
62 . SET TMGLIMDT=$$ADD2DATE(TMGENDDT,1) ;"*Limit* date is EndingDate+1
63 . IF TMGLIMDT'>0 DO QUIT
64 . . SET TMGMSG(TMGDATE)="6^Invalid date: "_TMGENDDT
65 . . SET TMGRESULT=-1,TMGABORT=1
66 IF (+TMGENDDT>0)&(TMGFLAGS'["R")&(TMGFLAGS'["1") SET TMGFLAGS=TMGFLAGS_"R" ;"Specify a date range
67SDDONE ;
68 QUIT TMGABORT
69 ;
70 ;
71VALDATES(TMGIEN,PARRAY,TMG1DATE,TMGLIMDT,TMGFLAGS,TMGERR,TMGMSG)
72 ;"Purpose: Validate specified input dates and times
73 ;" Checks for clinic inactivation during range
74 ;" Checks for existing appts at specified times (unless "I" flag set)
75 ;"Input: TMGIEN -- IEN in file 44 to deal with.
76 ;" PARRAY -- Pass by NAME. Name of Array containing time data
77 ;" TMG1DATE -- the 1 date to check in Array
78 ;" TMGLIMDT -- FM-format *limit* date for appointments date range
79 ;" TMGFLAGS -- "R" = Work on range from TMG1DATE up to, but not
80 ;" including, limit date TMGLIMDT
81 ;" "I" = Ignore existing appts when changing slots
82 ;" TMGERR -- Pass by REFERENCE. A result flag
83 ;" TMGMSG -- Pass by REFERENCE -- An output Message array
84 ;"Globally scoped vars used: ...
85 ;"Result: NONE
86 ;
87 NEW STARTDAY SET STARTDAY=+$P($GET(^SC(TMGIEN,"SL")),"^",3) ;"SL;3=HR CLINIC DISPLAY BEGINS
88 NEW STRTTIME,LASTTIME
89 SET (STRTTIME,LASTTIME)=STARTDAY*100
90 NEW COUNT SET COUNT=0
91 NEW TMGSLNOD SET TMGSLNOD=$GET(^SC(TMGIEN,"SL")) ;"^SC(IEN,"SL", SL node
92 SET TMGSDUR=+TMGSLNOD ;"SL;1 = field 1912 LENGTH OF APP'T
93 NEW TMGSOH SET TMGSOH=($PIECE(TMGSLNOD,"^",8)="Y") ;"SOH=Schedule On Holidays.
94 ;
95 ;"--Check for clinic innactivation dates.
96 NEW TMGINACT,TMGREACT ;"inactivation date / reactivation date
97 IF +$GET(^SC(TMGIEN,"I"))>0 DO
98 . SET TMGINACT=$PIECE(^SC(TMGIEN,"I"),"^",1)
99 . SET TMGREACT=$PIECE(^SC(TMGIEN,"I"),"^",2)
100 ELSE SET (TMGINACT,TMGREACT)=0
101 SET TMGERR=0
102 DO GOTO:(TMGERR>0) VDDONE
103 . IF TMGINACT=0 QUIT
104 . IF TMGINACT'<TMGLIMDT QUIT ;"i.e. if InactDate >= LimitDate quit
105 . IF TMGREACT<TMG1DATE QUIT ;"i.e. if ReactDate < StartDate quit
106 . SET TMGERR=1
107 . NEW STR SET STR="Clinic is inactive"
108 . SET STR=STR_$S(TMGREACT:" from ",1:" as of ")_$$EXTDAT(TMGINACT)
109 . SET STR=STR_$S(TMGREACT:" to ",1:"")_$$EXTDAT(TMGREACT)
110 . SET STR=STR_". CONFLICTS WITH GIVEN DATE RANGE."
111 . SET TMGMSG(TMG1DATE_"^"_TMGLIMDT)="5^"_STR
112 ;
113 ;" -- Check for scheduling on holidays, if not allowed --
114 IF TMGSOH=0 DO
115 . NEW DATE SET DATE=TMG1DATE
116 . FOR DO SET DATE=$$ADD2DATE(DATE,7) QUIT:(DATE'<TMGLIMDT)!(DATE>(DT+5000))!TMGERR ;"Only check vacations up to +5 yrs
117 . . IF $DATA(^HOLIDAY(DATE,0))=0 QUIT
118 . . SET TMGMSG(TMG1DATE_"^"_TMGLIMDT)="17^"_$$EXTDAT(DATE)_" is a holiday, and Location settings don't allow scheduling."
119 . . SET TMGERR=1
120 ;
121 NEW TMGTIMES SET TMGTIMES=""
122 FOR SET TMGTIMES=$ORDER(@PARRAY@(TMGTIMES)) QUIT:(TMGTIMES="")!TMGERR DO
123 . IF TMGTIMES'?4N1"-"4N DO QUIT
124 . . SET TMGMSG(TMG1DATE)="6^Time ["_X_"] invalid. Expected format e.g. '0800-1200.'"
125 . . SET TMGRESULT=-1,TMGERR=1
126 . NEW T1,T2,MIN
127 . SET T1=$P(TMGTIMES,"-",1)
128 . SET T2=$P(TMGTIMES,"-",2)
129 . ;"---- Validate input times ------
130 . DO VALIDMIL(TMG1DATE,T1,.TMGERR,.TMGMSG) QUIT:TMGERR
131 . DO VALIDMIL(TMG1DATE,T2,.TMGERR,.TMGMSG) QUIT:TMGERR
132 . IF T1<STRTTIME DO QUIT
133 . . SET TMGMSG(TMG1DATE)="8^Time ["_T1_"] invalid. Cannot be earlier than clinic start time ("_STRTTIME_")."
134 . . SET TMGRESULT=-1,TMGERR=1
135 . IF T1<LASTTIME DO QUIT
136 . . SET TMGMSG(TMG1DATE)="9^Time ["_T1_"] invalid. Must begin after last ending time ("_LASTTIME_")."
137 . . SET TMGRESULT=-1,TMGERR=1
138 . IF T2'>T1 DO SET TMGERR=1 QUIT
139 . . SET TMGMSG(TMG1DATE)="10^Time ["_TMGTIMES_"] invalid. Must end after begin time ("_T2_")."
140 . . SET TMGRESULT=-1,TMGERR=1
141 . SET MIN=$$MILDELTA(T1,T2)
142 . IF (MIN\TMGSDUR)*TMGSDUR'=+MIN DO QUIT
143 . . SET TMGMSG(TMG1DATE)="11^TIME SPAN ENTERED NOT CONSISTENT WITH "_TMGSDUR_" MIN APPT LENGTH"
144 . . SET TMGRESULT=-1,TMGERR=1
145 . ;"-- check for conflicting pre-existing appts...
146 . IF TMGFLAGS'["I" DO QUIT:TMGERR
147 . . IF $$APPTCHK(TMGIEN,TMG1DATE,TMGLIMDT,T1,T2)=0 QUIT
148 . . NEW STR SET STR="16^"_$$EXTDAT(TMG1DATE)
149 . . SET TMGMSG(TMG1DATE_"^"_TMGLIMDT)=STR_" HAS PENDING APPT(S) - CAN NOT ALTER SLOTS UNLESS 'I' FLAG SET"
150 . . SET TMGERR=1
151 . ;"process individual times.
152 . NEW APTSPER SET APTSPER=+$GET(@PARRAY@(TMGTIMES))
153 . IF APTSPER'>0 DO QUIT
154 . . SET TMGMSG(TMG1DATE)="12^No Appts/Slot # specified for '"_TMGTIMES_"'"
155 . . SET TMGRESULT=-1,TMGERR=1
156 ;
157VDDONE QUIT
158 ;
159 ;
160APPTCHK(TMGIEN,TMG1DATE,TMGLIMDT,ST,ET)
161 ;"Purpose: Ensure appts are all CANCELLED in DATE RANGE
162 ;"Input: TMGIEN -- the IEN in 44 of clinic
163 ;" TMG1DATE -- the starting date of date range to check
164 ;" TMGLIMDT -- the ending date of the date range to check
165 ;" ST -- OPTIONAL. The start time of time range (in date range)
166 ;" ET -- OPTIONAL. The end time of time range (in date range)
167 ;" ET should be specified if ST is specified
168 ;"Result: 1 if any non-cancelled appts are found
169 NEW ADATE SET ADATE=TMG1DATE
170 SET ST=+$GET(ST) SET ET=+$GET(ET)
171 NEW CONFLICT SET CONFLICT=0
172 FOR SET ADATE=+$ORDER(^SC(TMGIEN,"S",ADATE)) QUIT:(ADATE'>0)!(ADATE'<TMGLIMDT) DO
173 . NEW SKIP SET SKIP=0
174 . IF (ST>0)&(ET>0) DO QUIT:SKIP ;"If times provided, skip if out of range.
175 . . NEW TEMPST,TEMPET
176 . . SET TEMPST=(ADATE\1)_"."_ST
177 . . SET TEMPET=(ADATE\1)_"."_ET
178 . . IF (ADATE<TEMPST)!(ADATE>TEMPET) SET SKIP=1 QUIT
179 . NEW APPT SET APPT=0
180 . FOR SET APPT=+$ORDER(^SC(TMGIEN,"S",ADATE,1,APPT)) QUIT:(APPT'>0)!CONFLICT DO
181 . . IF $P(^SC(TMGIEN,"S",ADATE,1,APPT,0),"^",9)'["C" SET CONFLICT=1
182 QUIT CONFLICT
183 ;
184 ;
185EXTDAT(TMGADATE)
186 ;" Get external time display
187 IF +TMGADATE'>0 QUIT ""
188 QUIT $TR($$FMTE^XLFDT(TMGADATE,"5DF")," ","0")
189 ;
190 ;
191MILADD(TIME,ADDMIN,HR,MIN)
192 ;"Purpose: Add time to TIME (in military format) and also return hours (HR) and minutes (MIN)
193 ;"Input: TIME -- If passed by reference, will be changed to new time
194 ;" ADDMIN -- minutes to add to TIME
195 ;" HR -- PASS BY REFERENCE, the hours of the resulting time.
196 ;" MIN -- PASS BY REFERENCE, the minutes of the resulting time.
197 ;"Results: none
198 NEW H1,M1
199 SET HR=$E(TIME,1,2)
200 SET MIN=$E(TIME,3,4)
201 SET MIN=MIN+ADDMIN
202 FOR QUIT:(MIN'>59) SET MIN=MIN-60,HR=HR+1
203 FOR QUIT:(HR'>24) SET HR=HR-24
204 IF MIN?1N SET MIN="0"_MIN
205 IF HR?1N SET HR="0"_HR
206 SET TIME=HR_MIN
207 QUIT
208 ;
209 ;
210MILADD2(TIME,TIME2,HR,MIN)
211 ;"Purpose: Add TIME2 to TIME (in military format) and also return hours (HR) and minutes (MIN)
212 ;"Input: TIME -- If passed by reference, will be changed to new time
213 ;" TIME2 -- Time to add to TIME (both in military format, .e.g. 0845)
214 ;" HR -- PASS BY REFERENCE, the hours of the resulting time.
215 ;" MIN -- PASS BY REFERENCE, the minutes of the resulting time.
216 ;"Results: Returns resulting added time.
217 NEW HR1,MIN1,HR2,MIN2
218 SET HR1=$E(TIME,1,2)
219 SET MIN1=$E(TIME,3,4)
220 SET HR2=$E(TIME2,1,2)
221 SET MIN2=$E(TIME2,3,4)
222 SET HR=HR1+HR2
223 SET MIN=MIN1+MIN2
224 FOR QUIT:(MIN'>59) SET MIN=MIN-60,HR=HR+1
225 FOR QUIT:(HR'>24) SET HR=HR-24
226 IF MIN?1N SET MIN="0"_MIN
227 IF HR?1N SET HR="0"_HR
228 SET TIME=HR_MIN
229 QUIT TIME
230 ;
231 ;
232MILSUB(TIME,SUBMIN,HR,MIN)
233 ;"Purpose: Subtract minutes from TIME (in military format) and also return hours (HR) and minutes (MIN)
234 ;"Input: TIME -- If passed by reference, will be changed to new time. E.g. 0800
235 ;" SUBMIN -- minutes to subtract from TIME
236 ;" HR -- PASS BY REFERENCE, the hours of the resulting time.
237 ;" MIN -- PASS BY REFERENCE, the minutes of the resulting time.
238 ;"Results: none
239 NEW H1,M1
240 SET HR=$E(TIME,1,2)
241 SET MIN=$E(TIME,3,4)
242 SET MIN=MIN-SUBMIN
243 FOR QUIT:(MIN>0) SET MIN=MIN+60,HR=HR-1
244 FOR QUIT:(HR>0) SET HR=HR+24
245 IF MIN?1N SET MIN="0"_MIN
246 IF HR?1N SET HR="0"_HR
247 SET TIME=HR_MIN
248 QUIT
249 ;
250 ;
251MILSUB2(TIME,SUBTIME,HR,MIN) ;"Unused
252 ;"Purpose: Subtract minutes from TIME (in military format) and also return hours (HR) and minutes (MIN)
253 ;" TIME-SUBTIME=RESULT (Result returned in HR and Min)
254 ;"Input: TIME -- If passed by reference, will be changed to new time. E.g. 1000
255 ;" SUBtime -- minutes to subtract from TIME. E.g. 0800
256 ;" HR -- PASS BY REFERENCE, the hours of the resulting time.
257 ;" MIN -- PASS BY REFERENCE, the minutes of the resulting time.
258 ;"Results: none
259 NEW H1,M1
260 NEW HR1,HR2
261 NEW MIN1,MIN2
262 SET HR1=$E(TIME,1,2)
263 SET HR2=$E(SUBTIME,1,2)
264 SET HR=HR1-HR2
265 SET MIN1=$E(TIME,3,4)
266 SET MIN2=$E(SUBTIME,3,4)
267 SET MIN=MIN-1
268 FOR QUIT:(MIN>0) SET MIN=MIN+60,HR=HR-1
269 FOR QUIT:(HR>0) SET HR=HR+24
270 IF MIN?1N SET MIN="0"_MIN
271 IF HR?1N SET HR="0"_HR
272 SET TIME=HR_MIN
273 QUIT
274 ;
275 ;
276VALIDMIL(TMGDATE,TIME,TMGERR,TMGMSG)
277 ;"Purpose: Validate time
278 ;"Input: TMGDATE -- A date to use for error reporting
279 ;" TIME -- time to validate. E.g. 0815
280 ;" TMGERR -- PASS BY REFERENCE. Flag for error
281 ;" TMGMSG -- PASS BY REFERENCE. An array for error messages.
282 ;
283 NEW HR,MIN
284 SET HR=$E(TIME,1,2)
285 SET MIN=$E(TIME,3,4)
286 IF (TIME'?4N)!(MIN>59)!(TIME>2400)!(+TIME=0) DO SET TMGERR=1 QUIT
287 . SET TMGMSG(TMGDATE)="6^Time ["_TIME_"] is not a valid time in MILITARY TIME format."
288 . SET TMGRESULT=-1,TMGERR=1
289 IF MIN\5*5'=+MIN DO QUIT
290 . SET TMGMSG(TMGDATE)="7^Time ["_TIME_"] invalid. Must schedule appts on 5 minute boundries."
291 . SET TMGRESULT=-1,TMGERR=1
292 QUIT
293 ;
294 ;
295MILDELTA(T1,T2)
296 ;"Purpose: number of minutes T2-T1
297 NEW H1,H2,M1,M2,MIN
298 S H1=$E(T1,1,2),H2=$E(T2,1,2)
299 SET M1=$E(T1,3,4) IF M1=0 SET M1=60
300 SET M2=$E(T2,3,4) IF M2=0 SET M2=60
301 IF M2=60 SET H2=H2-1
302 IF M1=60 SET H1=H1-1
303 SET MIN=M2-M1+((H2-H1)*60)
304 QUIT MIN
305 ;
306 ;
307GFMDATE(EXTDATE)
308 ;"Purpose: return FM date from external date (no time)
309 ;" OR, if already FM date, then just strip time.
310 IF +EXTDATE=EXTDATE QUIT EXTDATE\1
311 NEW %DT,X,Y
312 SET %DT="X",X=EXTDATE
313 DO ^%DT
314 QUIT Y\1 ;"not sure if this \1 is needed or not...
315 ;
316ADD2DATE(FMDATE,INCNUM)
317 ;"Purpose: return FMDate + added IncNum
318 ;"Note: Perhaps this could be speeded up by not using C^%DTC for some dates...
319 NEW X,X1,X2 SET X1=FMDATE,X2=INCNUM
320 DO C^%DTC ;"returns X (equals X1+X2)
321 QUIT X
322 ;
323 ;
Note: See TracBrowser for help on using the repository browser.