2 package require mclistbox
3 catch { namespace import blt::* }
4 catch { namespace import mclistbox::* }
6 namespace eval data_browser {
26 proc data_browser::reset { parent } {
28 # For programming facilities
29 upvar data_browser::widgets widgets
31 set widgets(base) "$parent"
32 set widgets(data_brw) "$parent\.data_browser"
33 set widgets(up_brw) "$parent\.data_browser.01"
34 set widgets(down_brw) "$parent\.data_browser.02"
35 set widgets(split) "$parent\.data_browser.03"
36 set widgets(up_view) "$parent\.data_browser.01.lst"
37 set widgets(down_view) "$parent\.data_browser.02.lst"
38 set widgets(up_hs) "$parent\.data_browser.01.hs"
39 set widgets(up_vs) "$parent\.data_browser.01.vs"
40 set widgets(down_hs) "$parent\.data_browser.02.hs"
41 set widgets(down_vs) "$parent\.data_browser.02.vs"
45 proc data_browser::create { parent id } {
47 # For programming facilities
48 upvar data_browser::widgets widgets
49 upvar data_browser::sel_study sel_study
50 upvar data_browser::sel_serie sel_serie
51 upvar data_browser::local_id local_id
54 data_browser::reset $parent
57 frame $widgets(data_brw) -borderwidth 1 -height 100 -relief groove -width 200
58 frame $widgets(up_brw) -borderwidth 1 -height 100 -relief groove -width 200
59 frame $widgets(down_brw) -borderwidth 1 -height 100 -relief groove -width 200
60 frame $widgets(split) -borderwidth 2 -relief raised
62 # multi-column listboxes
63 mclistbox $widgets(up_view) \
65 -highlightthickness 0 \
67 -selectborderwidth 0 \
70 -columnborderwidth 0 \
74 -selectcommand "data_browser::cb_select"
75 scrollbar $widgets(up_vs) -command "$widgets(up_view) yview"
76 scrollbar $widgets(up_hs) -command "$widgets(up_view) xview" -orient horizontal
77 $widgets(up_view) configure -xscrollcommand "$widgets(up_hs) set"
78 $widgets(up_view) configure -yscrollcommand "$widgets(up_vs) set"
80 mclistbox $widgets(down_view) \
82 -highlightthickness 0 \
84 -selectborderwidth 0 \
87 -columnborderwidth 0 \
88 -selectmode extended \
91 -selectcommand "data_browser::cb_select_serie"
92 scrollbar $widgets(down_vs) -command "$widgets(down_view) yview"
93 scrollbar $widgets(down_hs) -command "$widgets(down_view) xview" -orient horizontal
94 $widgets(down_view) configure -xscrollcommand "$widgets(down_hs) set"
95 $widgets(down_view) configure -yscrollcommand "$widgets(down_vs) set"
97 bind $widgets(down_view) <Double-Button-1> "global_window::cb_image_browse"
100 bind $widgets(split) <B1-Motion> {
101 set root [ split %W . ]
102 set nb [ llength $root ]
104 set root [ lreplace $root $nb $nb ]
105 set root [ join $root . ]
106 set height [ winfo height $root ].0
107 set val [ expr (%Y - [winfo rooty $root]) /$height ]
108 if { $val >= 0 && $val <= 1.0 } {
109 place $root.01 -relheight $val
110 place $root.03 -rely $val
111 place $root.02 -relheight [ expr 1.0 - $val ]
117 proc data_browser::positionate { } {
119 # For programming facilities
120 upvar data_browser::widgets widgets
121 upvar data_browser::local_id local_id
123 set global_window::window_shown $local_id
125 pack $widgets(data_brw) -anchor center -expand 1 -fill both -side top
126 place $widgets(up_brw) -x 0 -y 0 -relwidth 1 -height -1 -relheight 0.5 -anchor nw -bordermode ignore
127 place $widgets(down_brw) -x 0 -y 0 -rely 1 -relwidth 1 -height -1 -relheight 0.5 -anchor sw -bordermode ignore
128 pack $widgets(up_view) -anchor center -expand 1 -fill both -side top
129 pack $widgets(down_view) -anchor center -expand 1 -fill both -side top
130 place $widgets(split) -x 0 -relx 0.9 -y 0 -rely 0.5 -width 10 -height 10 -anchor e -bordermode ignore
132 grid $widgets(up_view) -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
133 grid $widgets(up_vs) -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
134 grid $widgets(up_hs) -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
136 grid rowconfig $widgets(up_brw) 0 -weight 1 -minsize 0
137 grid columnconfig $widgets(up_brw) 0 -weight 1 -minsize 0
139 grid $widgets(down_view) -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
140 grid $widgets(down_vs) -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
141 grid $widgets(down_hs) -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
143 grid rowconfig $widgets(down_brw) 0 -weight 1 -minsize 0
144 grid columnconfig $widgets(down_brw) 0 -weight 1 -minsize 0
146 data_browser::controls 0
150 proc data_browser::forget { } {
152 # For programming facilities
153 upvar data_browser::widgets widgets
155 grid forget $widgets(down_hs)
156 grid forget $widgets(down_vs)
157 grid forget $widgets(down_view)
158 grid forget $widgets(up_hs)
159 grid forget $widgets(up_vs)
160 grid forget $widgets(up_view)
161 place forget $widgets(split)
162 pack forget $widgets(down_view)
163 pack forget $widgets(up_view)
164 place forget $widgets(down_brw)
165 place forget $widgets(up_brw)
166 pack forget $widgets(data_brw)
170 proc data_browser::clean_list { } {
172 # For programming facilities
173 upvar data_browser::widgets widgets
174 upvar data_browser::sel_study sel_study
175 upvar data_browser::sel_serie sel_serie
177 catch { $widgets(up_view) column delete c08 }
178 catch { $widgets(up_view) column delete c07 }
179 catch { $widgets(up_view) column delete c06 }
180 catch { $widgets(up_view) column delete c05 }
181 catch { $widgets(up_view) column delete c04 }
182 catch { $widgets(up_view) column delete c03 }
183 catch { $widgets(up_view) column delete c02 }
184 catch { $widgets(up_view) column delete c01 }
185 catch { $widgets(up_view) column delete c00 }
187 catch { $widgets(down_view) column delete c08 }
188 catch { $widgets(down_view) column delete c07 }
189 catch { $widgets(down_view) column delete c06 }
190 catch { $widgets(down_view) column delete c05 }
191 catch { $widgets(down_view) column delete c04 }
192 catch { $widgets(down_view) column delete c03 }
193 catch { $widgets(down_view) column delete c02 }
194 catch { $widgets(down_view) column delete c01 }
195 catch { $widgets(down_view) column delete c00 }
199 proc data_browser::set_data { } {
201 # For programming facilities
202 upvar data_browser::widgets widgets
203 upvar data_browser::sel_study sel_study
204 upvar data_browser::sel_serie sel_serie
205 upvar data_browser::local_id local_id
207 data_browser::clean_list
208 $widgets(down_view) column add c00 -label "$string_table::str_serie_name" -width 20
209 $widgets(down_view) column add c01 -label "$string_table::str_serie_number" -width 10
210 $widgets(down_view) column add c02 -label "$string_table::str_serie_date" -width 15
211 $widgets(down_view) column add c03 -label "$string_table::str_serie_time" -width 10
212 $widgets(down_view) column add c04 -label "$string_table::str_serie_modality" -width 10
213 $widgets(down_view) column add c05 -label "$string_table::str_serie_bodypart" -width 10
214 $widgets(down_view) column add c06 -label "$string_table::str_serie_description" -width 100
215 $widgets(down_view) column add c07 -label "$string_table::str_serie_diagnostic" -width 100
216 $widgets(up_view) column add c00 -label "$string_table::str_patient_name" -width 20
217 $widgets(up_view) column add c01 -label "$string_table::str_patient_id" -width 10
218 $widgets(up_view) column add c02 -label "$string_table::str_study_name" -width 15
219 $widgets(up_view) column add c03 -label "$string_table::str_study_id" -width 10
220 $widgets(up_view) column add c04 -label "$string_table::str_study_date" -width 10
221 $widgets(up_view) column add c05 -label "$string_table::str_study_time" -width 10
222 $widgets(up_view) column add c06 -label "$string_table::str_institution" -width 20
223 $widgets(up_view) column add c07 -label "$string_table::str_description" -width 200
225 $widgets(up_view) label bind c00 <ButtonPress-1> "data_browser::sort_mclst $widgets(up_view) c00"
226 $widgets(up_view) label bind c01 <ButtonPress-1> "data_browser::sort_mclst $widgets(up_view) c01"
227 $widgets(up_view) label bind c02 <ButtonPress-1> "data_browser::sort_mclst $widgets(up_view) c02"
228 $widgets(up_view) label bind c03 <ButtonPress-1> "data_browser::sort_mclst $widgets(up_view) c03"
229 $widgets(up_view) label bind c04 <ButtonPress-1> "data_browser::sort_mclst $widgets(up_view) c04"
230 $widgets(up_view) label bind c05 <ButtonPress-1> "data_browser::sort_mclst $widgets(up_view) c05"
231 $widgets(up_view) label bind c06 <ButtonPress-1> "data_browser::sort_mclst $widgets(up_view) c06"
232 $widgets(up_view) label bind c07 <ButtonPress-1> "data_browser::sort_mclst $widgets(up_view) c07"
234 $widgets(down_view) label bind c00 <ButtonPress-1> "data_browser::sort_mclst $widgets(down_view) c00"
235 $widgets(down_view) label bind c01 <ButtonPress-1> "data_browser::sort_mclst $widgets(down_view) c01"
236 $widgets(down_view) label bind c02 <ButtonPress-1> "data_browser::sort_mclst $widgets(down_view) c02"
237 $widgets(down_view) label bind c03 <ButtonPress-1> "data_browser::sort_mclst $widgets(down_view) c03"
238 $widgets(down_view) label bind c04 <ButtonPress-1> "data_browser::sort_mclst $widgets(down_view) c04"
239 $widgets(down_view) label bind c05 <ButtonPress-1> "data_browser::sort_mclst $widgets(down_view) c05"
240 $widgets(down_view) label bind c06 <ButtonPress-1> "data_browser::sort_mclst $widgets(down_view) c06"
241 $widgets(down_view) label bind c07 <ButtonPress-1> "data_browser::sort_mclst $widgets(down_view) c07"
243 $widgets(up_view) delete 0 end
244 set studies [ studies_dll ]
245 foreach study $studies {
247 array set arr [ studyData_dll $study ]
248 $widgets(up_view) insert end [ list \
249 $arr(ID_Patient_Name) \
250 $arr(ID_Patient_ID) \
253 $arr(ID_Study_Date) \
254 $arr(ID_Study_Time) \
255 $arr(ID_Institution_Name) \
256 $arr(ID_Study_Description) \
261 data_browser::sort_mclst $widgets(up_view) c00
262 data_browser::controls 0
266 proc data_browser::cb_select { args } {
268 # For programming facilities
269 upvar data_browser::widgets widgets
270 upvar data_browser::sel_study sel_study
271 upvar data_browser::sel_serie sel_serie
273 if { [ string compare $args "" ] != 0 } {
275 set sel [ $widgets(up_view) get [ $widgets(up_view) curselection ] ]
276 set sel_study [ lindex $sel 2 ]
277 set series [ series_dll $sel_study ]
278 $widgets(down_view) delete 0 end
279 foreach serie $series {
281 array set arr [ serieData_dll $sel_study $serie ]
282 $widgets(down_view) insert end [ list \
284 $arr(ID_Series_Number) \
285 $arr(ID_Series_Date) \
286 $arr(ID_Series_Time) \
288 $arr(ID_Body_Part_Examined) \
289 $arr(ID_Series_Description) \
290 $arr(ID_Admitting_Diagnoses_Description) \
295 data_browser::controls 0
302 proc data_browser::sort_mclst { lst id } {
304 # For programming facilities
305 upvar data_browser::widgets widgets
306 upvar data_browser::sel_study sel_study
307 upvar data_browser::sel_serie sel_serie
309 set data [ $lst get 0 end ]
310 set index [ lsearch -exact [ $lst column names ] $id ]
311 set result [ lsort -index $index $data ]
313 eval $lst insert end $result
318 proc data_browser::cb_select_serie { args } {
320 # For programming facilities
321 upvar data_browser::widgets widgets
322 upvar data_browser::sel_study sel_study
323 upvar data_browser::sel_serie sel_serie
325 if { [ string compare $args "" ] != 0 } {
327 set sel [ $widgets(down_view) curselection ]
328 if { [ llength $sel ] == 1 } {
330 set sel_serie [ lindex [ $widgets(down_view) get $sel ] 0 ]
331 set data [ serieData_dll $sel_study $sel_serie ]
332 data_browser::controls 1
334 } elseif { [ llength $sel ] == 2 } {
336 data_browser::controls 2
340 data_browser::controls 0
348 proc data_browser::get_subdata { } {
350 # For programming facilities
351 upvar data_browser::widgets widgets
352 upvar data_browser::sel_study sel_study
353 upvar data_browser::sel_serie sel_serie
355 set sel [ $widgets(down_view) curselection ]
356 set sel_data [ $widgets(down_view) get $sel ]
357 if { [ llength $sel ] == 2 } {
359 return [ list [ lindex [ lindex $sel_data 0 ] 0 ] [ lindex [ lindex $sel_data 1 ] 0 ] ]
367 proc data_browser::controls { { id -1 } } {
371 global_window::active_controls 0
377 global_window::active_controls [ \
379 $global_window::en_params | \
380 $global_window::en_load | \
381 $global_window::en_open | \
382 $global_window::en_help | \
386 } elseif { $id == 1 } {
388 global_window::active_controls [ \
390 $global_window::en_ibrw | \
391 $global_window::en_params | \
392 $global_window::en_load | \
393 $global_window::en_open | \
394 $global_window::en_help | \
398 } elseif { $id == 2 } {
400 global_window::active_controls [ \
402 $global_window::en_subtract | \
403 $global_window::en_params | \
404 $global_window::en_load | \
405 $global_window::en_open | \
406 $global_window::en_help | \
416 # EOF - data_browser.tcl