source: cprs/branches/tmg-cprs/m_files/TMGSDAU2.m@ 1099

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

Initial upload
File size: 13.0 KB
Line 
1TMGSDAU2 ;TMG/kst/Schedule Availability Utilities 2;12/22/08
2 ;;1.0;TMG-LIB;**1**;12/22/08
3 ;
4 ;"TMG SCHEDULING UTILITIES 2
5 ;"Kevin Toppenberg MD
6 ;"GNU General Public License (GPL) applies
7 ;"01/12/09
8 ;
9 ;"=======================================================================
10 ;" API -- Public Functions.
11 ;"=======================================================================
12 ;"GETDFN(PATIENT) -- return DFN value for patient
13 ;"GETCLIEN(CLINIC) - return Clinics IEN value for patient
14 ;"GETDATE(APPT) - return a FM Date-time formated value
15 ;"FILLAVAL(TMGIEN,PARRAY,TMG1DATE,TMGLIMDT,TMGERR,TMGMSG) --Fill in AVAILABILITY subfile ("T" node)
16 ;"KILLAVAL(TMGIEN,TMG1DATE,TMGLIMDT,TMGFLAGS) -- Delete AVAILABILITY ("T") node, and any linked "ST" and "OST" nodes.
17 ;"KILL1DATE(TMGIEN,TMG1DATE,FULL) -- remove 1 "T" node, and any linked ST and OST nodes
18 ;"STR2PAT(TMGIEN,STR,PARRAY) -- Convert a template pattern into an array of times.
19 ;"FRAC2TIM(TIME,HRS,MINS) -- Convert Fractional time --> Hrs & Min e.g. 3.75 --> 3 & 45 (i.e. 3:45)
20 ;"CH2NAVAL(CH)-- convert a given availability character into number of slots there.
21 ;
22 ;"=======================================================================
23 ;"Dependancies
24 ;"=======================================================================
25 ;
26 ;"=======================================================================
27 ;
28GETDFN(PATIENT)
29 ;"Purpose: return DFN value for patient
30 ;" This is a much simpler function that TMGGDFN, different purpose
31 ;"Input: PATIENT. Either a patient name (must be unique) or IEN
32 ;"Results: IEN in PATIENT file, or -101^Message
33 ;
34 NEW RESULT SET RESULT=0
35 SET PATIENT=$GET(PATIENT)
36 IF PATIENT="" DO GOTO GDDONE
37 . SET RESULT="-101^Patient not specified."
38 IF +PATIENT=PATIENT SET RESULT=PATIENT
39 ELSE DO
40 . NEW TMG2MSG
41 . DO FIND^DIC(2,,".01","MP",ANAME,"*","","","","TMG2MSG")
42 . NEW NUM SET NUM=+$GET(TMG2MSG("DILIST",0))
43 . IF NUM=0 DO QUIT
44 . . SET RESULT="-101^Patient name: '"_PATIENT_"' NOT FOUND"
45 . IF NUM>1 DO QUIT
46 . . SET TMGMSG(TMGMSG)="-101^Name: "_PATIENT_" Not specific. Multiple patients with this name exist."
47 . SET RESULT=+$GET(TMG2MSG("DILIST",1,0))
48GDDONE ;
49 QUIT RESULT
50 ;
51 ;
52GETCLIEN(CLINIC)
53 ;"Purpose: return Clinics IEN value for patient
54 ;"Input: CLINIC -- Name, or IEN, of Clinic for appt (file 44)
55 ;"Results: IEN in HOSPITAL LOCATION (44), or -102^Message
56 NEW RESULT
57 SET CLINIC=$GET(CLINIC)
58 IF CLINIC="" DO GOTO GCLDONE
59 . SET RESULT="-102^Clinic location not provided."
60 IF +CLINIC=CLINIC SET RESULT=CLINIC
61 ELSE DO
62 . NEW DIC,X,Y
63 . SET DIC=44,DIC(0)="M"
64 . SET X=CLINIC DO ^DIC
65 . IF +Y>0 SET RESULT=+Y
66 . ELSE SET RESULT="-102^'"_CLINIC_"' clinic location NOT FOUND."
67GCLDONE ;
68 QUIT RESULT
69 ;
70 ;
71GETDATE(APPT)
72 ;"Purpose: return a FM Date-time formated value
73 ;"Input: APPT -- Desired Appointment Date & Time -- External, or FM format
74 ;"Results: FM Date-Time entry or -1^Message
75 ;
76 NEW RESULT
77 SET APPT=$GET(APPT)
78 IF APPT="" DO GOTO GAPDONE
79 . SET RESULT="-1^Date and time not provided"
80 IF +APPT=APPT SET RESULT=APPT
81 ELSE DO
82 . DO DT^DILF("T",APPT,.RESULT)
83 . IF RESULT=-1 SET RESULT="-1^'"_APPT_"' is not a valid Date-Time"
84GAPDONE ;
85 QUIT RESULT
86 ;
87 ;
88FILLAVAL(TMGIEN,PARRAY,TMG1DATE,TMGLIMDT,TMGERR,TMGMSG)
89 ;"Purpose: Fill in AVAILABILITY subfile ("T" node), specifying number
90 ;" of patients allowed in each slot
91 ;" Note: This creates entries for each slot, 1 for each time slot.
92 ;" The T node does not store an ending date for the pattern.
93 ;" It appears to apply until a next date is encountered (if any)
94 ;" Also, this is set for cases where set days are being specified
95 ;" as well as when date ranges are specified.
96 ;"Input: TMGIEN -- IEN in HOSPITAL LOCATION file.
97 ;" PARRAY -- PASS BY NAME. Array containing time data. e.g.:
98 ;" @PARRAY@("0800-0810")=2
99 ;" @PARRAY@("0830-0850")=1
100 ;" @PARRAY@("0900-0930")=1
101 ;" @PARRAY@("1000-1140")=1
102 ;" TMG1DATE -- Starting date of a range to put entry into
103 ;" TMGLIMDT -- Limit date of date range.
104 ;" TMGERR -- PASS BY REFERANCE
105 ;" TMGMSG -- PASS BY REFERANCE
106 ;"Globally Scoped vars used: ...
107 ;"Result: NONE
108 ;"Note: It is presumed record locking has already occured
109 ;"Note: It is assumed that prior "T" nodes are gone,
110 ;" which may be achieved by DO KILLAVAL(TMG1DATE,TMGLIMDT,TMGFLAGS)
111 ;
112 NEW STARTDAY SET STARTDAY=+$P($GET(^SC(TMGIEN,"SL")),"^",3) ;"SL;3=HR CLINIC DISPLAY BEGINS
113 IF STARTDAY'>0 SET STARTDAY=8 ;"Default to start at 8 am
114 ;
115 ;"--Delete all preexisting T nodes in new date range-- SHOULD ALREADY BE DONE VIA KILLAVAL
116 ;
117FA1 ;" -- Set up T nodes for new date range --
118 NEW LASTTIME SET LASTTIME=STARTDAY*100
119 NEW COUNT SET COUNT=0
120 NEW TMGTIMES SET TMGTIMES=""
121 FOR SET TMGTIMES=$ORDER(@PARRAY@(TMGTIMES)) QUIT:(TMGTIMES="")!TMGERR DO
122 . NEW T1,T2,MIN,H1,H2,M1,M2
123 . SET T1=$P(TMGTIMES,"-",1)
124 . SET T2=$P(TMGTIMES,"-",2)
125 . ;"process individual times.
126 . NEW APTSPER SET APTSPER=+$GET(@PARRAY@(TMGTIMES))
127 . SET LASTTIME=T2
128 . DO MILSUB^TMGSDAU1(.T2,TMGSDUR,.H2,.M2)
129 . DO MILADD^TMGSDAU1(.T1,0,.H1,.M1)
130 . FOR DO QUIT:(T1>T2)
131 . . SET COUNT=COUNT+1
132 . . ;"Store Time^#ApptsInSlot in "T" node
133 . . SET ^SC(TMGIEN,"T",TMG1DATE,2,COUNT,0)=H1_M1_"^"_APTSPER
134 . . DO MILADD^TMGSDAU1(.T1,TMGSDUR,.H1,.M1)
135 SET ^SC(TMGIEN,"T",TMG1DATE,0)=TMG1DATE
136 ;" -- Set subsubfile header --
137 SET ^SC(TMGIEN,"T",TMG1DATE,2,0)="^44.004A^"_COUNT_"^"_COUNT
138 ;
139 ;" -- Set subfile header --
140 NEW DATE SET DATE=0
141 NEW COUNT SET COUNT=0
142 NEW LAST SET LAST=0
143 FOR SET DATE=+$ORDER(^SC(TMGIEN,"T",DATE)) QUIT:(DATE'>0) DO
144 . SET LAST=DATE
145 . SET COUNT=COUNT+1
146 SET $PIECE(^SC(TMGIEN,"T",0),"^",3)=LAST
147 SET $PIECE(^SC(TMGIEN,"T",0),"^",4)=COUNT
148 ;
149 QUIT
150 ;
151 ;
152KILLAVAL(TMGIEN,TMG1DATE,TMGLIMDT,TMGFLAGS)
153 ;"Purpose: Delete AVAILABILITY ("T") node, and any linked "ST" and "OST" nodes.
154 ;"Input: TMGIEN -- IEN in HOSPITAL LOCATION file.
155 ;" TMG1DATE -- Starting date of a range to put entry into
156 ;" TMGLIMDT -- Limit date of date range.
157 ;" TMGFLAGS -- flags
158 ;"Globally Scoped vars used: ...
159 ;"Note: It is presumed record locking has already occured
160 ;
161 ;"Only delete "2" subnode. Leave "0" node in place to prevent extending
162 ;"date range of entry occuring before this one.
163 ;"Only delete entries falling on same day of week as TMG1DATE
164 ;
165 IF TMGFLAGS["R" DO
166 . NEW DATE SET DATE=TMG1DATE
167 . FOR DO SET DATE=$$ADD2DATE^TMGSDAU1(DATE,7) QUIT:(DATE'<TMGLIMDT)!(DATE'<DT+50000)
168 . . DO KILL1DATE(TMGIEN,DATE)
169 ELSE DO
170 . DO KILL1DATE(TMGIEN,TMG1DATE)
171 QUIT
172 ;
173 ;
174KILL1DATE(TMGIEN,TMG1DATE,FULL)
175 ;"Purpose: To remove 1 "T" node, and any linked ST and OST nodes
176 ;"Input: TMGIEN -- IEN in HOSPITAL LOCATION file.
177 ;" TMG1DATE -- the date to remove
178 ;" FULL -- OPTIONAL. if 1 then entire T node removed, otherwise 0 node is left.
179 ;"Globally-scoped var used: ...
180 ;"Note: It is presumed record locking has already occured
181 KILL ^SC(TMGIEN,"T",DATE,2)
182 IF $DATA(^SC(TMGIEN,"ST",DATE)) DO
183 . IF $DATA(^SC(TMGIEN,"ST",DATE,9)) DO
184 . . KILL ^SC(TMGIEN,"OST",DATE)
185 . KILL ^SC(TMGIEN,"ST",DATE)
186 IF $GET(FULL)=1 KILL ^SC(TMGIEN,"T",DATE)
187 QUIT
188 ;
189 ;
190AVAIL4DAT(TMGIEN,TMG1DATE,PARRAY)
191 ;"Purpose: To generage an array with slot time data for a given date, based on templates
192 ;" This PARRAY could be suitable for generating a "T" node entry
193 ;"Input: TMGIEN -- IEN in HOSPITAL LOCATION file.
194 ;" TMG1DATE -- the appointment date to look up. Don't pass by reference
195 ;" PARRAY -- PASS BY NAME. An OUT PARAMETER (prior contents killed)
196 ;" Output format: Array containing time data. e.g.:
197 ;" @PARRAY@("0800-0810")=2
198 ;" @PARRAY@("0830-0850")=1
199 ;" @PARRAY@("0900-0930")=1
200 ;" @PARRAY@("1000-1140")=1
201 ;"Results: 1=success, -1^Msg=error
202 ;"Output: @PARRAY is filled as above
203 ;
204 NEW TMGRESULT SET TMGRESULT=1 ;"Default to success
205 SET TMG1DATE=TMG1DATE\1
206 KILL @PARRAY
207 ;
208 ;"First see if a Special pattern exists for date in "OST" note
209 NEW STR SET STR=$GET(^SC(TMGIEN,"OST",TMG1DATE,1))
210 IF STR'="" DO GOTO A4DDONE
211 . SET STR=$PIECE(STR,"|",2,999)
212 . DO STR2PAT(TMGIEN,STR,PARRAY)
213 ;
214 ;"FIND APPLICABLE TEMPLATE (Tx NODE)
215 NEW DOW SET DOW=$$DOW^XLFDT(TMG1DATE,1) ;"DOW=Day of Week (0-6)
216 NEW DATE SET DATE=TMG1DATE
217 SET DATE=$ORDER(^SC(TMGIEN,"T"_DOW,TMG1DATE))
218 IF DATE="" DO GOTO A4DDONE
219 . SET TMGRESULT="-1^NO TEMPLATE FOUND FOR DATE"
220 SET STR=$GET(^SC(TMGIEN,"T"_DOW,DATE,1))
221 IF STR="" DO GOTO A4DDONE
222 . SET TMGRESULT="-1^NO VALID TEMPLATE FOUND FOR DATE"
223 DO STR2PAT(TMGIEN,STR,PARRAY)
224 ;
225A4DDONE QUIT TMGRESULT
226 ;
227 ;
228STR2PAT(TMGIEN,STR,PARRAY)
229 ;"Purpose: Convert a template pattern into an array of times.
230 ;"Input: TMGIEN -- IEN in file 44
231 ;" STR -- Template pattern (Note that DAY DATE is *NOT* at beginning of line)
232 ;" E.g. | [1] [1 1 1 1 1] [1 1 1 1 1] | | [1] [1 1] [1 1 1 1 1] [1 1 1 1 1] [1 1 1] "
233 ;" PARRAY -- PASS BY NAME. An OUT PARAMETER (prior contents killed)
234 ;" Output format: Array containing time data. e.g.:
235 ;" @PARRAY@("0800-0810")=2
236 ;" @PARRAY@("0830-0850")=1
237 ;" @PARRAY@("0900-0930")=1
238 ;" @PARRAY@("1000-1140")=1
239 ;"Globally-scoped vars used: ...
240 ;"Result: 1 if OK, -1 if error
241 ;
242 NEW TMGRESULT SET TMGRESULT=1 ;"Default to success
243 SET STR=$GET(STR) IF STR="" SET TMGRESULT=-1 GOTO S2PDONE
244 SET PARRAY=$GET(PARRAY) IF PARRAY="" SET TMGRESULT=-1 GOTO S2PDONE
245 ;
246 NEW TMGSPH SET TMGSPH=+$P($GET(^SC(TMGIEN,"SL")),"^",6) ;"SL;6 = DISPLAY INCS PER HOUR (Slots per Hr)
247 IF TMGSPH'>0 SET TMGSPH=4 ;"Default to 4 slots/hr
248 NEW APTLEN SET APTLEN=60\TMGSPH ;"Minutes length of each slot
249 NEW STARTDAY SET STARTDAY=+$P($GET(^SC(TMGIEN,"SL")),"^",3) ;"SL;3=HR CLINIC DISPLAY BEGINS
250 SET STARTDAY=STARTDAY_"00" ;"Make into military time, e.g. 8am --> 0800
251 FOR QUIT:$LENGTH(STARTDAY)'<4 SET STARTDAY="0"_STARTDAY
252 NEW STRLEN SET STRLEN=$LENGTH(STR)
253 NEW IDX FOR IDX=2:2:STRLEN DO
254 . NEW TIME1,TIME2,HRS,MINS,CH,NUMAVAIL
255 . SET CH=$EXTRACT(STR,IDX)
256 . IF (CH="")!(CH=" ") QUIT
257 . ;"CONVERT CH INFO NUMAVAIL
258 . SET NUMAVAIL=$$CH2NAVAL(CH)
259 . IF NUMAVAIL'>0 QUIT
260 . SET TIME1=((IDX-2)/2)/TMGSPH
261 . SET TIME1=$$FRAC2TIM(TIME1)
262 . SET TIME1=$$MILADD2^TMGSDAU1(TIME1,STARTDAY) ;"add 2 times
263 . DO MILADD^TMGSDAU1(TIME1,APTLEN,.HRS,.MINS) ;"add time + mins
264 . NEW TEMP SET TEMP=TIME1_"-"_HRS_MINS
265 . SET @PARRAY@(TEMP)=NUMAVAIL
266 ;
267S2PDONE ;
268 QUIT TMGRESULT
269 ;
270 ;
271FRAC2TIM(TIME,HRS,MINS)
272 ;"Purpose: Convert Fractional time --> Hrs & Min e.g. 3.75 --> 3 & 45 (i.e. 3:45)
273 ;"Input: TIME: Time in fractional format. E.g. 3.75
274 ;" HRS -- PASS BY REFERENCE. An OUT PARAMETER. Set to be resulting hours
275 ;" will ensure length it 2 digits. i.e. 1 --> 01
276 ;" MINS -- PASS BY REFERENCE. An OUT PARAMETER. Set to be minutes minutes
277 ;" will ensure length it 2 digits. i.e. 1 --> 01
278 ;"Result: result in military format
279 SET HRS=TIME\1 ;"Get just hrs part
280 SET MINS=TIME#1 ;"Get just minutes part, e.g. 0.3 (i.e. 30 minutes)
281 SET MINS=(MINS*0.6)*100 ;"convert .75 -> .45, * 100 = 45 minutes
282 FOR QUIT:$LENGTH(MINS)>1 SET MINS="0"_MINS
283 FOR QUIT:$LENGTH(HRS)>1 SET HRS="0"_HRS
284 ;
285 QUIT HRS_MINS
286 ;
287 ;
288CH2NAVAL(CH)
289 ;"Purpose: convert a given availability character into number of slots there.
290 NEW CODES SET CODES="{}&%?#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
291 QUIT $FIND(CODES,CH)-$FIND(CODES,"0")
292 ;
293 ;
Note: See TracBrowser for help on using the repository browser.