source: cprs/trunk/CPRS-Chart/fGraphProfiles.pas@ 830

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

Upgrading to version 27
File size: 53.0 KB
Line 
1unit fGraphProfiles;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 ComCtrls, StdCtrls, ExtCtrls, CheckLst, ORCtrls, ORFn, uGraphs, rCore, uCore,
8 fBase508Form, VA508AccessibilityManager;
9
10type
11 TfrmGraphProfiles = class(TfrmBase508Form)
12 btnAdd: TButton;
13 btnAddAll: TButton;
14 btnClear: TButton;
15 btnClose: TButton;
16 btnDelete: TButton;
17 btnRemoveAll: TButton;
18 btnRemoveOne: TButton;
19 btnRename: TButton;
20 btnSave: TButton;
21 btnSavePublic: TButton;
22 bvlBase: TBevel;
23 cboAllItems: TORComboBox;
24 lblApply: TLabel;
25 lblDisplay: TLabel;
26 lblEditInfo: TLabel;
27 lblEditInfo1: TLabel;
28 lblSelectandDefine: TLabel;
29 lblSelection: TLabel;
30 lblSelectionInfo: TLabel;
31 lstActualItems: TORListBox;
32 lstDrugClass: TListBox;
33 lstItemsDisplayed: TORListBox;
34 lstItemsSelection: TORListBox;
35 lstScratch: TListBox;
36 lstTests: TListBox;
37 pnlApply: TPanel;
38 pnlSource: TPanel;
39 pnlTempData: TPanel;
40 radSourceAll: TRadioButton;
41 radSourcePat: TRadioButton;
42 radTop: TRadioButton;
43 radBottom: TRadioButton;
44 radBoth: TRadioButton;
45 radNeither: TRadioButton;
46 lblSave: TLabel;
47 lblClose: TLabel;
48 lblUser: TLabel;
49 pnlAllSources: TPanel;
50 pnlSources: TPanel;
51 lblSource: TLabel;
52 lstSources: TORListBox;
53 pnlOtherSources: TPanel;
54 pnlOtherSourcesUser: TPanel;
55 lblOtherPersons: TLabel;
56 cboUser: TORComboBox;
57 pnlOtherSourcesBottom: TPanel;
58 lstOtherSources: TORListBox;
59 btnViews: TButton;
60 btnDefinitions: TButton;
61 pnlOtherViews: TPanel;
62 lblOtherViews: TLabel;
63 lblSelectOthers: TLabel;
64 splViews: TSplitter;
65 procedure FormCreate(Sender: TObject);
66 procedure FormShow(Sender: TObject);
67 procedure FormClose(Sender: TObject; var Action: TCloseAction);
68
69 procedure btnClearClick(Sender: TObject);
70 procedure btnCloseClick(Sender: TObject);
71 procedure btnDefinitionsClick(Sender: TObject);
72 procedure btnRemoveAllClick(Sender: TObject);
73 procedure btnRemoveOneClick(Sender: TObject);
74 procedure btnViewsClick(Sender: TObject);
75 procedure cboAllItemsClick(Sender: TObject);
76 procedure cboAllItemsChange(Sender: TObject);
77 procedure cboAllItemsNeedData(Sender: TObject; const StartFrom: String;
78 Direction, InsertAt: Integer);
79 procedure cboUserClick(Sender: TObject);
80 procedure cboUserNeedData(Sender: TObject; const StartFrom: string;
81 Direction, InsertAt: Integer);
82 procedure lstItemsDisplayedChange(Sender: TObject);
83 procedure lstItemsDisplayedDblClick(Sender: TObject);
84 procedure lstSourcesChange(Sender: TObject);
85 procedure lstSourcesDblClick(Sender: TObject);
86 procedure lstSourcesEnter(Sender: TObject);
87 procedure lstSourcesExit(Sender: TObject);
88 procedure radSourceAllClick(Sender: TObject);
89
90 procedure btnDeleteClick(Sender: TObject);
91 procedure btnRenameClick(Sender: TObject);
92 procedure btnSaveClick(Sender: TObject);
93
94 procedure AddToList(aItem: string; aListBox: TORListBox);
95 procedure ArrangeList(aCheckFile, aCheckItem, aItem: string;
96 aListBox: TORListBox; var addtolist: boolean);
97 procedure AssignHints;
98 procedure AssignProfile(aList: TStrings; aProfile: string; UserNum: integer; allitems: boolean);
99 procedure AssignProfilePre(aList: TStrings; var aProfile: string; UserNum: integer);
100 procedure AssignProfilePost(aList: TStrings; var aProfile, typedata: string);
101 procedure CheckPublic;
102 procedure FillSource(aList: TORListBox);
103 function ProfileExists(aName, aType: string): boolean;
104 procedure btnAddAllClick(Sender: TObject);
105 private
106 FHintPauseTime: integer;
107 FPublicEditor: boolean;
108 procedure CheckToClear;
109 procedure QualifierDelete(line: string);
110 procedure wmNCLButtonDown(var Msg: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
111 public
112 procedure AllItemsAfter(var filetype, typedata: string);
113 procedure AllItemsBefore(var typedata: string);
114 procedure IDProfile(var profilename, proftype: string);
115 procedure ListBoxSetup(Sender: TObject);
116 procedure ComboBoxSetup(Sender: TObject);
117 procedure Report(aListBox: TORListBox);
118 function GetProfileName(infotitle, info: string; var newprofilename: string): boolean;
119 end;
120
121var
122 frmGraphProfiles: TfrmGraphProfiles;
123
124procedure DialogOptionsGraphProfiles(var actiontype: boolean);
125procedure DialogGraphProfiles(var actionOK: boolean;
126 var checkaction: boolean; aGraphSetting: TGraphSetting;
127 var aProfname, aProfilestring, aSection: string;
128 const PatientDFN: string; var aCounter: integer;
129 aSelections: string);
130
131implementation
132
133{$R *.DFM}
134
135uses
136 rGraphs, fGraphData, fGraphOthers, fRptBox, VAUtils;
137
138procedure DialogOptionsGraphProfiles(var actiontype: boolean);
139// create the form and make it modal, return an action
140var
141 FGraphSetting: TGraphSetting;
142 settings: string;
143 actionOK, checkaction: boolean;
144 counter: integer;
145 aSelections, profile, profilestring, section: string;
146begin
147 if (GtslData = nil) then
148 begin
149 ShowMsg(TXT_NOGRAPHING);
150 exit;
151 end;
152 settings := GetCurrentSetting;
153 FGraphSetting := GraphSettingsInit(settings);
154 checkaction := false;
155 actionOK := false;
156 profile := '*';
157 counter := BIG_NUMBER;
158 aSelections :='';
159 DialogGraphProfiles(actionOK, checkaction, FGraphSetting,
160 profile, profilestring, section, Patient.DFN, counter, aSelections);
161 FGraphSetting.Free;
162end;
163
164procedure DialogGraphProfiles(var actionOK: boolean;
165 var checkaction: boolean; aGraphSetting: TGraphSetting;
166 var aProfname, aProfilestring, aSection: string;
167 const PatientDFN: string; var aCounter: integer;
168 aSelections: string);
169var
170 i: integer;
171 astring, counter, profile, profileitem, profiletype, profiletext: string;
172 frmGraphProfiles: TfrmGraphProfiles;
173begin
174 frmGraphProfiles := TfrmGraphProfiles.Create(Application);
175 try
176 with frmGraphProfiles do
177 begin
178 lblSave.Hint := aProfname;
179 lblClose.Hint := PatientDFN;
180 if aCounter = BIG_NUMBER then
181 begin
182 pnlApply.Visible := false;
183 frmGraphProfiles.Caption := 'Define Views';
184 end
185 else
186 begin
187 pnlApply.Visible := true;
188 frmGraphProfiles.Caption := 'Select Items and Define Views';
189 end;
190 if length(aSelections) > 0 then
191 begin
192 if GtslViews.Count = 0 then
193 GtslViews.Insert(0, VIEW_CURRENT + '^<current selections>^' + aSelections)
194 else if Piece(GtslViews[0], '^', 1) <> VIEW_CURRENT then
195 GtslViews.Insert(0, VIEW_CURRENT + '^<current selections>^' + aSelections)
196 else if GtslViews.Count > 0 then
197 GtslViews[0] := VIEW_CURRENT + '^<current selections>^' + aSelections;
198 end;
199 ResizeAnchoredFormToFont(frmGraphProfiles);
200 ShowModal;
201 actionOK := (btnClose.Tag = 1);
202 profiletext := '';
203 aProfname := '';
204 if actionOK then
205 begin
206 aProfname := lblSave.Hint;
207 if radTop.Checked then aSection := 'top'
208 else if radBottom.Checked then aSection := 'bottom'
209 else if radBoth.Checked then aSection := 'both'
210 else aSection := 'neither';
211 profile := '';
212 with lstItemsDisplayed do
213 for i := 0 to Items.Count - 1 do
214 begin
215 astring := Items[i];
216 profiletext := profiletext + Piece(astring, '^', 3) + '^';
217 profiletype := Piece(astring, '^', 1);
218 if profiletype = '8925' then
219 profileitem := UpperCase(Piece(astring, '^', 3))
220 else
221 profileitem := Piece(astring, '^', 2);
222 profile := profile + profiletype + '~' + profileitem + '~|';
223 end;
224 if (GtslViews.Count > 0) and (Piece(GtslViews[0], '^', 1) = VIEW_CURRENT) then
225 counter := inttostr(GtslViews.Count)
226 else
227 counter := inttostr(GtslViews.Count + 1);
228 aProfileString := '<view' + counter + '>^' + profile + '^' + profiletext;
229 GtslViews.Add(aProfileString);
230 aCounter := strtointdef(counter, BIG_NUMBER);
231 with aGraphSetting do
232 begin
233 lstActualItems.Items.Clear;
234 with lstItemsDisplayed do
235 for i := 0 to Items.Count - 1 do
236 begin
237 lstActualItems.Items.Add(Piece(Items[i], '<', 1)); //get rid of <any>
238 end;
239 ItemsForDisplay := lstActualItems.Items;
240 end;
241 end;
242 end;
243 finally
244 frmGraphProfiles.Release;
245 end;
246end;
247
248procedure TfrmGraphProfiles.FormCreate(Sender: TObject);
249begin
250 FPublicEditor := GraphPublicEditor;
251end;
252
253procedure TfrmGraphProfiles.FormShow(Sender: TObject);
254begin
255 if GtslData = nil then
256 begin
257 radSourceAll.Checked := true;
258 //radSourcePat.Enabled := false;
259 end
260 else if GtslData.Count < 1 then
261 begin
262 radSourceAll.Checked := true;
263 //radSourcePat.Enabled := false;
264 end;
265 cboAllItems.Visible := radSourceAll.Checked;
266 FillSource(lstSources);
267 cboUser.InitLongList('');
268 FHintPauseTime := Application.HintHidePause;
269 Application.HintHidePause := 9000; // uses a longer hint pause time
270end;
271
272procedure TfrmGraphProfiles.FormClose(Sender: TObject; var Action: TCloseAction);
273begin
274 Application.HintHidePause := FHintPauseTime;
275end;
276
277procedure TfrmGraphProfiles.radSourceAllClick(Sender: TObject);
278var
279 dfn: string;
280begin
281 if Sender = radSourceAll then
282 begin
283 lstItemsSelection.Visible := false;
284 cboAllItems.Visible := true;
285 end
286 else
287 begin
288 if radSourcePat.Tag = 0 then
289 begin
290 dfn := lblClose.Hint;
291 FastAssign(rpcGetAllItems(dfn), lstTests.Items); // items for patient
292 FastAssign(rpcGetItems('50.605', dfn), lstDrugClass.Items);
293 radSourcePat.Tag := 1;
294 end;
295 cboAllItems.Visible := false;
296 lstItemsSelection.Visible := true;
297 end;
298 if lstSources.ItemIndex > 0 then
299 begin
300 lstSources.Tag := BIG_NUMBER;
301 lstSourcesChange(lstSources);
302 end
303 else if lstSources.ItemIndex > 0 then
304 begin
305 lstOtherSources.Tag := BIG_NUMBER;
306 lstSourcesChange(lstOtherSources);
307 end;
308end;
309
310procedure TfrmGraphProfiles.lstSourcesChange(Sender: TObject);
311var
312 UserNum: int64;
313 filetype, typedata: string;
314 aListBox, oppositeListBox: TORListBox;
315 viewselected: boolean;
316begin
317 CheckPublic;
318 aListBox := (Sender as TORListBox);
319 if aListBox = lstSources then
320 begin
321 oppositeListBox := lstOtherSources;
322 UserNum := User.DUZ;
323 end
324 else
325 begin
326 oppositeListBox := lstSources;
327 UserNum := cboUser.ItemID;
328 end;
329 if aListBox.Tag <> BIG_NUMBER then
330 exit;
331 oppositeListBox.ItemIndex := -1;
332 cboAllItems.Items.Clear;
333 cboAllItems.Text := '';
334 if aListBox.ItemIndex = -1 then exit;
335 typedata := aListBox.Items[aListBox.ItemIndex];
336 if pos(LLS_FRONT, typedata) > 0 then // <clear all selections>
337 begin
338 lstItemsSelection.Clear;
339 cboAllItems.Items.Clear;
340 cboAllItems.Text := '';
341 exit;
342 end;
343 filetype := Piece(typedata, '^', 1);
344 if (filetype = VIEW_PERSONAL)
345 or (filetype = VIEW_PUBLIC)
346 or (filetype = VIEW_LABS)
347 or (filetype = VIEW_TEMPORARY)
348 or (filetype = VIEW_CURRENT) then
349 begin
350 RadSourceAll.Checked := true;
351 RadSourcePat.Enabled := false;
352 AssignProfile(cboAllItems.Items, typedata, UserNum, false);
353 FastAssign(cboAllItems.Items, lstItemsSelection.Items);
354 viewselected := true;
355 end
356 else
357 begin
358 RadSourcePat.Enabled := true;
359 AllItemsBefore(typedata);
360 AllItemsAfter(filetype, typedata);
361 viewselected := false;
362 end;
363 lstItemsSelection.Visible := viewselected or radSourcePat.Checked;
364 cboAllItems.Visible := not lstItemsSelection.Visible;
365 cboAllItemsChange(cboAllItems);
366end;
367
368procedure TfrmGraphProfiles.lstSourcesEnter(Sender: TObject);
369begin
370 (Sender as TORListBox).Tag := BIG_NUMBER;
371end;
372
373procedure TfrmGraphProfiles.lstSourcesExit(Sender: TObject);
374begin
375 (Sender as TORListBox).Tag := 0;
376end;
377
378procedure TfrmGraphProfiles.lstSourcesDblClick(Sender: TObject);
379begin
380 if cboAllItems.Visible then
381 begin
382 if cboAllItems.Items.Count < 1 then exit;
383 cboAllItems.ItemIndex := 0;
384 cboAllItemsClick(cboAllItems);
385 end
386 else
387 begin
388 if lstItemsSelection.Items.Count < 1 then exit;
389 //lstItemsSelection.Selected[0] := true;
390 cboAllItemsClick(lstItemsSelection);
391 btnAddAllClick(self);
392 end;
393end;
394
395procedure TfrmGraphProfiles.cboUserClick(Sender: TObject);
396begin
397 FillSource(lstOtherSources);
398 if cboUser.ItemIndex <> -1 then
399 lblOtherViews.Caption := cboUser.DisplayText[cboUser.ItemIndex] + ' Views:'
400 else
401 lblOtherViews.Caption := 'Other Views:'
402end;
403
404procedure TfrmGraphProfiles.cboUserNeedData(Sender: TObject;
405 const StartFrom: string; Direction, InsertAt: Integer);
406begin
407 cboUser.ForDataUse(SubSetOfPersons(StartFrom, Direction));
408end;
409
410procedure TfrmGraphProfiles.cboAllItemsChange(Sender: TObject);
411//var
412 //astring: string;
413begin
414 if (Sender is TORListBox) then
415 btnClear.Enabled := btnSave.Enabled or ((Sender as TORListBox).Items.Count > 0)
416 else if (Sender is TORComboBox) then
417 btnClear.Enabled := btnSave.Enabled or ((Sender as TORComboBox).Items.Count > 0);
418 if lstItemsSelection.Visible then
419 begin
420 btnAddAll.Enabled := lstItemsSelection.Items.Count > 0;
421 btnAdd.Enabled := lstItemsSelection.ItemIndex > -1;
422 //if btnAdd.Enabled then
423 //astring := lstItemsSelection.Items[lstItemsSelection.ItemIndex];
424 end
425 else
426 begin
427 btnAddAll.Enabled := cboAllItems.Items.Count > 0;
428 btnAdd.Enabled := cboAllItems.ItemIndex > -1;
429 end;
430end;
431
432procedure TfrmGraphProfiles.cboAllItemsClick(Sender: TObject);
433var
434 i: integer;
435begin
436 if Sender is TButton then
437 begin
438 if lstItemsSelection.Visible then
439 begin
440 if Sender = btnAddAll then
441 begin
442 for i := 0 to lstItemsSelection.Items.Count - 1 do
443 begin
444 lstItemsSelection.Selected[i] := true;
445 lstItemsSelection.ItemIndex := i;
446 ListBoxSetup(lstItemsSelection);
447 end;
448 lstItemsSelection.Clear;
449 end
450 else
451 begin
452 lstItemsDisplayed.ItemIndex := 0;
453 ListBoxSetup(lstItemsSelection);
454 end;
455 lstItemsDisplayedChange(self);
456 CheckToClear;
457 exit;
458 end
459 else
460 begin
461 if Sender = btnAdd then
462 begin
463 ComboBoxSetup(cboAllItems);
464 lstItemsDisplayedChange(self);
465 CheckToClear;
466 exit;
467 end;
468 end;
469 end;
470 if (Sender is TORComboBox) then
471 ComboBoxSetup(Sender)
472 else if (Sender is TORListBox) then
473 ListBoxSetup(Sender)
474 else exit;
475 lstItemsDisplayedChange(self);
476 CheckToClear;
477end;
478
479procedure TfrmGraphProfiles.cboAllItemsNeedData(Sender: TObject;
480 const StartFrom: String; Direction, InsertAt: Integer);
481var
482 filetype: string;
483begin
484 if lstSources.ItemIndex = -1 then exit;
485 filetype := Piece(lstSources.Items[lstSources.ItemIndex], '^', 1);
486 cboAllItems.ForDataUse(rpcLookupItems(filetype, StartFrom, Direction));
487end;
488
489procedure TfrmGraphProfiles.lstItemsDisplayedChange(Sender: TObject);
490begin
491 btnSave.Enabled := lstItemsDisplayed.Items.Count > 0;
492 btnSavePublic.Enabled := btnSave.Enabled and FPublicEditor;
493 btnRemoveAll.Enabled := btnSave.Enabled;
494 btnAdd.Enabled := (cboAllItems.Visible and (cboAllItems.ItemIndex > -1))
495 or (lstItemsSelection.Visible and (lstItemsSelection.ItemIndex > -1));
496 btnRemoveOne.Enabled := btnSave.Enabled and (lstItemsDisplayed.ItemIndex > -1);
497 btnClear.Enabled := btnSave.Enabled or (lstItemsSelection.Items.Count > 0);
498 if btnSave.Enabled and pnlApply.Visible then btnClose.Caption := 'Close and Display'
499 else btnClose.Caption := 'Close';
500end;
501
502procedure TfrmGraphProfiles.lstItemsDisplayedDblClick(Sender: TObject);
503var
504 line: string;
505begin
506 if lstItemsDisplayed.ItemIndex < 0 then exit;
507 line := lstItemsDisplayed.Items[lstItemsDisplayed.ItemIndex];
508 lstItemsDisplayed.Items.Delete(lstItemsDisplayed.ItemIndex);
509 QualifierDelete(line);
510 lstItemsDisplayedChange(self);
511end;
512
513procedure TfrmGraphProfiles.btnAddAllClick(Sender: TObject);
514begin
515 if cboAllItems.Visible then
516 begin
517 if cboAllItems.Items.Count < 1 then exit;
518 cboAllItems.ItemIndex := 0;
519 cboAllItemsClick(cboAllItems);
520 end
521 else
522 begin
523 if lstItemsSelection.Items.Count < 1 then exit;
524 cboAllItemsClick(btnAddAll);
525 end;
526end;
527
528procedure TfrmGraphProfiles.btnRemoveOneClick(Sender: TObject);
529begin
530 lstItemsDisplayedDblClick(self);
531 CheckToClear;
532end;
533
534procedure TfrmGraphProfiles.btnRemoveAllClick(Sender: TObject);
535begin
536 lstItemsDisplayed.Clear;
537 lstItemsDisplayedChange(self);
538 CheckToClear;
539end;
540
541procedure TfrmGraphProfiles.btnDefinitionsClick(Sender: TObject);
542var
543 firstpublic, firstpersonal, firstlabs: boolean;
544 i, j: integer;
545 aLine, aProfile, filetype, aString, front, back, piece2: string;
546 aList, templist: TStringList;
547begin
548 front := Piece(LLS_FRONT, '^', 2);
549 back := Piece(LLS_BACK, '^', 1);
550 templist := TStringList.Create;
551 aList := TStringList.Create;
552 lstScratch.Clear;
553 lstScratch.Sorted := false;
554 firstpublic := true;
555 firstpersonal := true;
556 firstlabs := true;
557 for i := 0 to lstSources.Items.Count - 1 do
558 begin
559 aLine := lstSources.Items[i];
560 filetype := Piece(aLine, '^', 1);
561 aProfile := Piece(aLine, '^', 2);
562 if (filetype = VIEW_PERSONAL)
563 or (filetype = VIEW_PUBLIC)
564 or (filetype = VIEW_LABS) then
565 begin
566 if (filetype = VIEW_PUBLIC) and firstpublic then
567 begin
568 templist.Add(' ');
569 templist.Add(front + copy('Public Views' + back, 0, 60));
570 firstpublic := false;
571 end
572 else
573 if (filetype = VIEW_PERSONAL) and firstpersonal then
574 begin
575 templist.Add(' ');
576 templist.Add(front + copy('Personal Views' + back, 0, 60));
577 firstpersonal := false;
578 end
579 else
580 if (filetype = VIEW_LABS) and firstlabs then
581 begin
582 templist.Add(' ');
583 templist.Add(front + copy('Lab Groups' + back, 0, 60));
584 firstlabs := false;
585 end;
586 AssignProfile(aList, aLine, User.DUZ, true);
587 templist.Add(aProfile);
588 for j := 0 to aList.Count - 1 do
589 begin
590 aLine := aList[j];
591 piece2 := Piece(aLine, '^', 2);
592 if strtointdef(copy(piece2, 0, 1), -1) > 0 then
593 begin
594 aString := Piece(aLine, '^', 3);
595 if copy(aString, 0, 1) = '_' then
596 aString := copy(aString, 2, length(aString));
597 templist.Add(' ' + aString);
598 end
599 else
600 begin
601
602 end;
603 end;
604 end;
605 end;
606 if cboUser.ItemIndex > -1 then
607 begin
608 firstpersonal := true;
609 firstlabs := true;
610 templist.Add('');
611 templist.Add('');
612 templist.Add('Views and Lab Groups for ' + cboUser.Text);
613 for i := 0 to lstOtherSources.Items.Count - 1 do
614 begin
615 aLine := lstOtherSources.Items[i];
616 filetype := Piece(aLine, '^', 1);
617 aProfile := Piece(aLine, '^', 2);
618 if (filetype = VIEW_PERSONAL)
619 or (filetype = VIEW_LABS) then
620 begin
621 if (filetype = VIEW_PERSONAL) and firstpersonal then
622 begin
623 templist.Add(' ');
624 templist.Add(front + copy('Views' + back, 0, 60));
625 firstpersonal := false;
626 end
627 else
628 if (filetype = VIEW_LABS) and firstlabs then
629 begin
630 templist.Add(' ');
631 templist.Add(front + copy('Lab Groups' + back, 0, 60));
632 firstlabs := false;
633 end;
634 AssignProfile(aList, aLine, cboUser.ItemID, true);
635 templist.Add(aProfile);
636 for j := 0 to aList.Count - 1 do
637 begin
638 aLine := aList[j];
639 piece2 := Piece(aLine, '^', 2);
640 if strtointdef(copy(piece2, 0, 1), -1) > 0 then
641 begin
642 aString := Piece(aLine, '^', 3);
643 if copy(aString, 0, 1) = '_' then
644 aString := copy(aString, 2, length(aString));
645 templist.Add(' ' + aString);
646 end;
647 end;
648 end;
649 end;
650 end;
651 templist.Insert(0, 'Definitions of Views and Lab Groups');
652 templist.Insert(1, '');
653 templist.Insert(2,'Your Personal Views, Public Views, and Lab Groups');
654 ReportBox(templist, 'Views and Lab Groups', true);
655 templist.Free;
656 aList.Free;
657end;
658
659procedure TfrmGraphProfiles.btnClearClick(Sender: TObject);
660begin
661 lstItemsDisplayed.Items.Clear;
662 lstItemsSelection.Items.Clear;
663 cboAllItems.Items.Clear;
664 cboAllItems.Text :='';
665 lstItemsDisplayedChange(self);
666 cboAllItemsChange(self);
667 lstSources.ItemIndex := -1;
668 lstOtherSources.ItemIndex := -1;
669end;
670
671procedure TfrmGraphProfiles.btnDeleteClick(Sender: TObject);
672var
673 publicview: boolean;
674 info, profilename, profname, proftype: string;
675begin
676 if lstSources.ItemIndex < 0 then
677 begin
678 ShowMsg('You must select a valid View for deletion.');
679 exit;
680 end;
681 publicview := false;
682 profilename := '';
683 info := lstSources.Items[lstSources.ItemIndex];
684 proftype := Piece(info, '^', 1);
685 profname := Piece(info, '^', 2);
686 if proftype = VIEW_PERSONAL then
687 profilename := profname
688 else if (proftype = VIEW_PUBLIC) and FPublicEditor then
689 begin
690 profilename := profname;
691 publicview := true;
692 end
693 else
694 begin
695 ShowMsg('You must select a valid View for deletion.');
696 exit;
697 end;
698 if publicview then
699 begin
700 if MessageDlg('This is Public and may be used by others.'
701 + #13 + 'Delete ' + profilename + '?', mtConfirmation,
702 [mbYes, mbNo], 0) = mrYes then
703 begin
704 rpcDeleteGraphProfile(UpperCase(profilename), '1');
705 btnClose.Tag := 1;
706 MessageDlg('The public view, ' + profilename + ' has been deleted.',
707 mtInformation, [mbOk], 0);
708 end
709 else exit;
710 end
711 else
712 begin
713 if MessageDlg('Delete ' + profilename + '?', mtConfirmation,
714 [mbYes, mbNo], 0) = mrYes then
715 begin
716 rpcDeleteGraphProfile(UpperCase(profilename), '0');
717 btnClose.Tag := 1;
718 MessageDlg('Your personal view, ' + profilename + ' has been deleted.',
719 mtInformation, [mbOk], 0);
720 end
721 else exit;
722 end;
723 btnClearClick(self);
724 lstItemsDisplayed.Items.Clear;
725 lstItemsSelection.Items.Clear;
726 cboAllItems.Items.Clear;
727 cboAllItems.Text :='';
728 GraphDataOnUser;
729 FormShow(self);
730 lstItemsDisplayedChange(self);
731 btnDelete.Enabled := false;
732 btnRename.Enabled := false;
733 if lstSources.Count > 0 then
734 lstSources.ItemIndex := 0;
735end;
736
737procedure TfrmGraphProfiles.btnRenameClick(Sender: TObject);
738var
739 profentered, publicview: boolean;
740 i, j: integer;
741 astring, info, infotitle, newprofilename, profile, profileitem, profilename, profiletype, profname, proftype: string;
742 aList: TStrings;
743begin
744 if lstSources.ItemIndex < 0 then
745 begin
746 ShowMsg('You must select a valid View to rename.');
747 exit;
748 end;
749 publicview := false;
750 profilename := '';
751 info := lstSources.Items[lstSources.ItemIndex];
752 proftype := Piece(info, '^', 1);
753 profname := Piece(info, '^', 2);
754 if proftype = VIEW_PERSONAL then
755 profilename := profname
756 else if (proftype = VIEW_PUBLIC) and FPublicEditor then
757 begin
758 profilename := profname;
759 publicview := true;
760 end
761 else
762 begin
763 ShowMsg('You must select a valid View to rename.');
764 end;
765 btnRemoveAllClick(self);
766 lstSourcesDblClick(self);
767 if publicview then
768 begin
769 infotitle := 'Rename this Public View';
770 info := 'This is Public and may be used by others.'
771 + #13 + 'Enter a new name for ' + profilename + '.'
772 end
773 else
774 begin
775 infotitle := 'Rename your Personal View';
776 info := 'Enter a new name for ' + profilename + '.'
777 end;
778 profentered := GetProfileName(infotitle, info, newprofilename);
779 if not profentered then exit;
780 info := '';
781 if not ProfileExists(newprofilename, VIEW_PUBLIC) and publicview then
782 info := 'The Public View, ' + profilename + ', will be changed to '
783 + newprofilename + #13 + 'Is this OK?'
784 else if not ProfileExists(newprofilename, VIEW_PERSONAL) then
785 info := 'Your Personal View, ' + profilename + ', will be changed to '
786 + newprofilename + #13 + 'Is this OK?';
787 if length(info) > 0 then
788 if MessageDlg(info, mtConfirmation, [mbYes, mbNo], 0) <> mrYes then exit;
789 aList := TStringList.Create;
790 profile := '';
791 aList.Clear;
792 j := 1;
793 with lstItemsDisplayed do
794 for i := 0 to Items.Count - 1 do
795 begin
796 astring := Items[i];
797 profiletype := Piece(astring, '^', 1);
798 if profiletype = '8925' then
799 profileitem := UpperCase(Piece(astring, '^', 3))
800 else
801 profileitem := Piece(astring, '^', 2);
802 profile := profile + profiletype + '~' + profileitem + '~|';
803 j := j + 1;
804 if (j mod 10) = 0 then
805 if length(profile) > 0 then
806 begin
807 aList.Add(UpperCase(profile));
808 profile := '';
809 end;
810 end;
811 if length(profile) > 0 then
812 begin
813 aList.Add(UpperCase(profile));
814 profile := '';
815 end;
816 if publicview then
817 begin
818 proftype := VIEW_PUBLIC;
819 rpcDeleteGraphProfile(UpperCase(profilename), '1');
820 rpcSetGraphProfile(newprofilename, '1', aList);
821 btnClose.Tag := 1;
822 end
823 else
824 begin
825 proftype := VIEW_PERSONAL;
826 rpcDeleteGraphProfile(UpperCase(profilename), '0');
827 rpcSetGraphProfile(newprofilename, '0', aList);
828 btnClose.Tag := 1;
829 end;
830 aList.Free;
831 IDProfile(newprofilename, proftype);
832end;
833
834procedure TfrmGraphProfiles.btnSaveClick(Sender: TObject);
835var
836 profentered, puplicedit: boolean;
837 i, j: integer;
838 astring, info, infotitle, profile, profileitem, profilename, profiletype, profname, proftype: string;
839 aList: TStrings;
840begin
841 puplicedit := Sender = btnSavePublic;
842 if lstItemsDisplayed.Items.Count < 1 then exit;
843 profilename := '';
844 if lstSources.ItemIndex > -1 then
845 begin
846 info := lstSources.Items[lstSources.ItemIndex];
847 if pos(LLS_FRONT, info) < 1 then
848 begin
849 proftype := Piece(info, '^', 1);
850 profname := Piece(info, '^', 2);
851 profilename := profname;
852 end;
853 end;
854 if puplicedit then
855 begin
856 infotitle := 'Save this Public View';
857 info := 'Save this Public View by entering a name for it.'
858 + #13 + 'If you are editing a View, enter the View''s name to overwrite it.';
859 end
860 else
861 begin
862 infotitle := 'Save your Personal View';
863 info := 'Save your Personal View by entering a name for it.'
864 + #13 + 'If you are editing a View, enter the View''s name to overwrite it.';
865 end;
866 profentered := GetProfileName(infotitle, info, profilename);
867 if not profentered then exit;
868 info := '';
869 if ProfileExists(profilename, VIEW_PUBLIC) and FPublicEditor and puplicedit then
870 info := 'The Public View, ' + profilename + ', will be overwritten.'
871 + #13 + 'Is this OK?'
872 else if ProfileExists(profilename, VIEW_PERSONAL) and (not puplicedit) then
873 info := 'Your Personal View, ' + profilename + ', will be overwritten.'
874 + #13 + 'Is this OK?';
875 if length(info) > 0 then
876 if MessageDlg(info, mtConfirmation, [mbYes, mbNo], 0) <> mrYes then exit;
877 aList := TStringList.Create;
878 profile := '';
879 aList.Clear;
880 j := 1;
881 with lstItemsDisplayed do
882 for i := 0 to Items.Count - 1 do
883 begin
884 astring := Items[i];
885 profiletype := Piece(astring, '^', 1);
886 if profiletype = '8925' then
887 profileitem := UpperCase(Piece(astring, '^', 3))
888 else
889 profileitem := Piece(astring, '^', 2);
890 profile := profile + profiletype + '~' + profileitem + '~|';
891 j := j + 1;
892 if (j mod 10) = 0 then
893 if length(profile) > 0 then
894 begin
895 aList.Add(UpperCase(profile));
896 profile := '';
897 end;
898 end;
899 if length(profile) > 0 then
900 begin
901 aList.Add(UpperCase(profile));
902 profile := '';
903 end;
904 if puplicedit then
905 begin
906 proftype := VIEW_PUBLIC;
907 rpcSetGraphProfile(profilename, '1', aList);
908 btnClose.Tag := 1;
909 end
910 else
911 begin
912 proftype := VIEW_PERSONAL;
913 rpcSetGraphProfile(profilename, '0', aList);
914 btnClose.Tag := 1;
915 end;
916 aList.Free;
917 IDProfile(profilename, proftype);
918end;
919
920procedure TfrmGraphProfiles.btnCloseClick(Sender: TObject);
921begin
922 if lstItemsDisplayed.Items.Count > 0 then
923 btnClose.Tag := 1;
924 Close;
925end;
926
927procedure TfrmGraphProfiles.btnViewsClick(Sender: TObject);
928begin // not used
929 pnlOtherSources.Visible := not pnlOtherSources.Visible;
930 if pnlOtherSources.Visible then
931 btnViews.Caption := 'Hide other views'
932 else
933 btnViews.Caption := 'Show other views';
934 DialogGraphOthers(1);
935end;
936
937procedure TfrmGraphProfiles.CheckPublic;
938var
939 typedata: string;
940begin
941 if lstSources.ItemIndex = -1 then
942 begin
943 btnDelete.Enabled := false;
944 btnRename.Enabled := false;
945 exit;
946 end;
947 typedata := lstSources.Items[lstSources.ItemIndex];
948 btnDelete.Enabled := (Piece(typedata, '^', 1) = VIEW_PERSONAL)
949 or ((Piece(typedata, '^', 1) = VIEW_PUBLIC) and FPublicEditor);
950 btnRename.Enabled := btnDelete.Enabled;
951end;
952
953procedure TfrmGraphProfiles.ListBoxSetup(Sender: TObject);
954var
955 profileselected: boolean;
956 i: integer;
957 selection, first, profileitem: string;
958begin
959 with (Sender as TORListBox) do
960 begin
961 if ItemIndex < 0 then exit;
962 selection := Items[ItemIndex];
963 if length(Piece(selection, '_', 2)) > 0 then
964 selection := Piece(selection, '_', 1) + ' ' + Piece(selection, '_', 2);
965 first := Piece(selection, '^', 1);
966 if first = '' then exit; // line
967 profileselected := strtointdef(Piece(selection, '^', 2), 0) < 0;
968 if profileselected then
969 begin
970 for i := 2 to Items.Count - 1 do
971 begin
972 profileitem := Items[i];
973 if length(Piece(profileitem, '_', 2)) > 0 then
974 profileitem := Piece(profileitem, '_', 1) + ' ' + Piece(profileitem, '_', 2); //*****???? ^
975 AddToList(profileitem, lstItemsDisplayed);
976 end;
977 end
978 else
979 AddToList(selection, lstItemsDisplayed);
980 //if ItemIndex = 0 then Clear; //profile or type <any>
981 ItemIndex := -1;
982 end;
983end;
984
985procedure TfrmGraphProfiles.ComboBoxSetup(Sender: TObject);
986var
987 profileselected: boolean;
988 i: integer;
989 selection, first, profileitem, subtype: string;
990begin
991 with (Sender as TORComboBox) do
992 begin
993 if ItemIndex < 0 then exit;
994 selection := Items[ItemIndex];
995 subtype := Piece(Items[0], '^', 3);
996 subtype := Piece(subtype, ':', 2);
997 subtype := copy(subtype, 2, length(subtype));
998 subtype := Piece(subtype, ' ', 1);
999 if UpperCase(copy(selection, 1, 5)) = '63AP;' then
1000 selection := copy(selection, 1, 4) + '^A;' + copy(selection, 6, 1) + ';'
1001 + Piece(selection, '^', 2) + '^' + subtype + ': ' + Piece(selection, '^', 3)
1002 else if UpperCase(copy(selection, 1, 5)) = '63MI;' then
1003 selection := copy(selection, 1, 4) + '^M;' + copy(selection, 6, 1) + ';'
1004 + Piece(selection, '^', 2) + '^' + subtype + ': ' + Piece(selection, '^', 3);
1005 if length(Piece(selection, '_', 2)) > 0 then
1006 selection := Piece(selection, '_', 1) + ' ' + Piece(selection, '_', 2);
1007 first := Piece(selection, '^', 1);
1008 if first = '' then exit; // line
1009 profileselected := strtointdef(Piece(selection, '^', 2), 0) < 0;
1010 if profileselected then
1011 begin
1012 for i := 2 to Items.Count - 1 do
1013 begin
1014 profileitem := Items[i];
1015 if length(Piece(profileitem, '_', 2)) > 0 then
1016 profileitem := Piece(profileitem, '_', 1) + ' ' + Piece(profileitem, '_', 2); //*****???? ^
1017 AddToList(profileitem, lstItemsDisplayed);
1018 end;
1019 end
1020 else
1021 AddToList(selection, lstItemsDisplayed);
1022 if ItemIndex = 0 then Clear; //profile or type <any>
1023 ItemIndex := -1;
1024 end;
1025end;
1026
1027procedure TfrmGraphProfiles.Report(aListBox: TORListBox);
1028var
1029 profileselected: boolean;
1030 i: integer;
1031 selection, first, profileitem, subtype: string;
1032begin
1033 with aListBox do
1034 begin
1035 if ItemIndex < 0 then exit;
1036 selection := Items[ItemIndex];
1037 subtype := Piece(Items[0], '^', 3);
1038 subtype := Piece(subtype, ':', 2);
1039 subtype := copy(subtype, 2, length(subtype));
1040 subtype := Piece(subtype, ' ', 1);
1041 if UpperCase(copy(selection, 1, 5)) = '63AP;' then
1042 selection := copy(selection, 1, 4) + '^A;' + copy(selection, 6, 1) + ';'
1043 + Piece(selection, '^', 2) + '^' + subtype + ': ' + Piece(selection, '^', 3)
1044 else if UpperCase(copy(selection, 1, 5)) = '63MI;' then
1045 selection := copy(selection, 1, 4) + '^M;' + copy(selection, 6, 1) + ';'
1046 + Piece(selection, '^', 2) + '^' + subtype + ': ' + Piece(selection, '^', 3);
1047 if length(Piece(selection, '_', 2)) > 0 then
1048 selection := Piece(selection, '_', 1) + ' ' + Piece(selection, '_', 2);
1049 first := Piece(selection, '^', 1);
1050 if first = '' then exit; // line
1051 profileselected := strtointdef(Piece(selection, '^', 2), 0) < 0;
1052 if profileselected then
1053 begin
1054 for i := 2 to Items.Count - 1 do
1055 begin
1056 profileitem := Items[i];
1057 if length(Piece(profileitem, '_', 2)) > 0 then
1058 profileitem := Piece(profileitem, '_', 1) + ' ' + Piece(profileitem, '_', 2); //*****???? ^
1059 AddToList(profileitem, lstItemsDisplayed);
1060 end;
1061 end
1062 else
1063 AddToList(selection, lstItemsDisplayed);
1064 if ItemIndex = 0 then Clear; //profile or type <any>
1065 ItemIndex := -1;
1066 end;
1067end;
1068
1069procedure TfrmGraphProfiles.CheckToClear;
1070begin
1071 if (cboAllItems.Visible and (cboAllItems.Items.Count = 0))
1072 or (lstItemsSelection.Visible and (lstItemsSelection.Items.Count = 0)) then
1073 begin
1074 lstSources.ItemIndex := -1;
1075 lstOtherSources.ItemIndex := -1;
1076 btnAdd.Enabled := false;
1077 btnAddAll.Enabled := false;
1078 end;
1079end;
1080
1081procedure TfrmGraphProfiles.QualifierDelete(line: string);
1082var
1083 i: integer;
1084 filenum: string;
1085begin
1086 if Piece(line, '^', 1) <> '0' then exit;
1087 filenum := Piece(line, '^', 2);
1088 if strtointdef(filenum, 0) < 0 then exit;
1089 if (filenum = '52') or (filenum = '55') or (filenum = '55NVAE')
1090 or (filenum = '55NVA') or (filenum = '53.79') then
1091 with lstItemsDisplayed do
1092 for i := 0 to Items.Count - 1 do
1093 if (Piece(Items[i], '^', 2) = '50.605') and (Piece(Items[i], '^', 1) = '0') then
1094 begin
1095 Items.Delete(i);
1096 break;
1097 end;
1098end;
1099
1100procedure TfrmGraphProfiles.AllItemsBefore(var typedata: string);
1101var
1102 i: integer;
1103begin
1104 with cboAllItems.Items do
1105 begin
1106 Clear;
1107 cboAllItems.InitLongList('');
1108 typedata := '0^' + Piece(typedata, '^', 1) + '^ ' + Piece(typedata, '^', 2) + ' <any>';
1109 Insert(0, typedata);
1110 Insert(1, '^' + LLS_LINE);
1111 if Piece(typedata, '^', 2) = '63AP' then
1112 begin
1113 for i := 0 to lstSources.Items.Count - 1 do
1114 if copy(lstSources.Items[i], 1, 5) = '63AP;' then
1115 begin
1116 typedata := lstSources.Items[i];
1117 typedata := '0^' + Piece(typedata, '^', 1) + '^ ' + Piece(typedata, '^', 2) + ' <any>';
1118 Add(typedata);
1119 end;
1120 end
1121 else if Piece(typedata, '^', 2) ='63MI' then
1122 begin
1123 for i := 0 to lstSources.Items.Count - 1 do
1124 if copy(lstSources.Items[i], 1, 5) = '63MI;' then
1125 begin
1126 typedata := lstSources.Items[i];
1127 typedata := '0^' + Piece(typedata, '^', 1) + '^ ' + Piece(typedata, '^', 2) + ' <any>';
1128 Add(typedata);
1129 end;
1130 end;
1131 end;
1132end;
1133
1134procedure TfrmGraphProfiles.AllItemsAfter(var filetype, typedata: string);
1135var
1136 i: integer;
1137 itemdata, itemname: string;
1138begin
1139 with lstItemsSelection.Items do
1140 begin
1141 Clear;
1142 lstItemsSelection.Sorted := true;
1143 itemname := Piece(typedata, '^', 3);
1144 if copy(itemname, 1, 1) = ' ' then
1145 begin
1146 itemname := copy(itemname, 2, length(itemname)); // strip preceding space
1147 typedata := '0^' + Piece(typedata, '^', 2) + '^ ' + itemname;
1148 end
1149 else
1150 typedata := '0^' + Piece(typedata, '^', 1) + '^ ' + itemname;
1151 Insert(0, typedata);
1152 Insert(1, '^' + LLS_LINE);
1153 if filetype = '63AP' then // finish subitems ***********
1154 begin
1155 lstItemsSelection.Sorted := false;
1156 for i := 0 to lstSources.Items.Count - 1 do
1157 if copy(lstSources.Items[i], 1, 5) = '63AP;' then
1158 begin
1159 typedata := lstSources.Items[i];
1160 typedata := '0^' + Piece(typedata, '^', 1) + '^ ' + Piece(typedata, '^', 2) + ' <any>';
1161 Add(typedata);
1162 end;
1163 end
1164 else if filetype ='63MI' then
1165 begin
1166 lstItemsSelection.Sorted := false;
1167 for i := 0 to lstSources.Items.Count - 1 do
1168 if copy(lstSources.Items[i], 1, 5) = '63MI;' then
1169 begin
1170 typedata := lstSources.Items[i];
1171 typedata := '0^' + Piece(typedata, '^', 1) + '^ ' + Piece(typedata, '^', 2) + ' <any>';
1172 Add(typedata);
1173 end;
1174 end
1175 else if filetype = '50.605' then
1176 for i := 0 to lstDrugClass.Items.Count - 1 do
1177 begin
1178 itemdata := lstDrugClass.Items[i];
1179 if filetype = Piece(itemdata, '^', 1) then
1180 Add(itemdata);
1181 end
1182 else if copy(filetype, 1, 5) = '63AP;' then
1183 begin
1184 filetype := copy(filetype, 1, 4) + '^A;' + copy(filetype, 6, 1) + ';';
1185 for i := 0 to lstTests.Items.Count - 1 do
1186 begin
1187 itemdata := lstTests.Items[i];
1188 if filetype = UpperCase(copy(itemdata, 1, 9)) then
1189 Add(itemdata);
1190 end;
1191 end
1192 else if copy(filetype, 1, 5) = '63MI;' then
1193 begin
1194 filetype := copy(filetype, 1, 4) + '^M;' + copy(filetype, 6, 1) + ';';
1195 for i := 0 to lstTests.Items.Count - 1 do
1196 begin
1197 itemdata := lstTests.Items[i];
1198 if filetype = UpperCase(copy(itemdata, 1, 9)) then
1199 Add(itemdata);
1200 end;
1201 end
1202 else if filetype <> '405' then
1203 for i := 0 to lstTests.Items.Count - 1 do
1204 begin
1205 itemdata := lstTests.Items[i];
1206 if filetype = UpperCase(Piece(itemdata, '^', 1)) then
1207 Add(itemdata);
1208 end;
1209 cboAllItemsChange(lstItemsSelection);
1210 end;
1211end;
1212
1213procedure TfrmGraphProfiles.AddToList(aItem: string; aListBox: TORListBox);
1214var
1215 addtolist: boolean;
1216 checkfile, checkitem: string;
1217begin
1218 aItem := UpperCase(Pieces(aItem, '^', 1, 2)) + '^' + Piece(aItem, '^', 3);
1219 checkfile := Piece(aItem, '^', 1);
1220 checkitem := Piece(aItem, '^', 2);
1221 if checkfile = '0' then
1222 begin
1223 checkfile := checkitem; // if drug class any - 52,0;55,0
1224 checkitem := '0'; // if drug class item - go thru meds
1225 end;
1226 ArrangeList(checkfile, checkitem, aItem, aListBox, addtolist);
1227 if addtolist then aListBox.Items.Add(aItem);
1228 if (checkfile = '50.605') and (checkitem = '0') then
1229 begin
1230 checkfile := '52';
1231 aItem := '0^52^ Medication,Outpatitent <any>';
1232 ArrangeList(checkfile, checkitem, aItem, aListBox, addtolist);
1233 if addtolist then aListBox.Items.Add(aItem);
1234 checkfile := '55';
1235 aItem := '0^55^ Medication,Inpatitent <any>';
1236 ArrangeList(checkfile, checkitem, aItem, aListBox, addtolist);
1237 if addtolist then aListBox.Items.Add(aItem);
1238 checkfile := '53.79';
1239 aItem := '0^53.79^ Medication,BCMA <any>';
1240 ArrangeList(checkfile, checkitem, aItem, aListBox, addtolist);
1241 if addtolist then aListBox.Items.Add(aItem);
1242 {checkfile := '55NVAE'; // nonvameds as events is not used
1243 aItem := '0^55NVAE^ Medication,Non-VA-Event <any>';
1244 ArrangeList(checkfile, checkitem, aItem, aListBox, addtolist);
1245 if addtolist then aListBox.Items.Add(aItem);}
1246 checkfile := '55NVA';
1247 aItem := '0^55NVA^ Medication,Non-VA <any>';
1248 ArrangeList(checkfile, checkitem, aItem, aListBox, addtolist);
1249 if addtolist then aListBox.Items.Add(aItem);
1250 end;
1251end;
1252
1253procedure TfrmGraphProfiles.ArrangeList(aCheckFile, aCheckItem, aItem: string;
1254 aListBox: TORListBox; var addtolist: boolean);
1255var
1256 i: integer;
1257 listfile, listitem: string;
1258begin
1259 addtolist := true;
1260 with aListBox do
1261 for i := Items.Count - 1 downto 0 do
1262 begin
1263 listfile := Piece(Items[i], '^', 1);
1264 listitem := Piece(Items[i], '^', 2);
1265 if listfile = '0' then
1266 begin
1267 listfile := listitem;
1268 listitem := '0';
1269 end;
1270 if (aCheckItem = listitem) and (aCheckFile = listfile) then
1271 begin
1272 addtolist := false;
1273 break;
1274 end
1275 else
1276 if (listitem = '0') and (aCheckFile = listfile) then
1277 begin
1278 addtolist := false;
1279 break;
1280 end
1281 else
1282 if listitem = '0' then
1283 begin
1284 if aCheckFile = Piece(listfile, ';', 1) then
1285 if Piece(aCheckItem, ';', 2) = Piece(listfile, ';', 2) then
1286 begin
1287 addtolist := false;
1288 break;
1289 end;
1290 end
1291 else
1292 if (aCheckItem = '0') and (aCheckFile = listfile) then
1293 Items.Delete(i);
1294 end;
1295end;
1296
1297procedure TfrmGraphProfiles.AssignProfile(aList: TStrings; aProfile: string; UserNum: integer; allitems: boolean);
1298var
1299 i, k: integer;
1300 preprofile, typedata, typepart, typeone, typetwo, testname, teststring: string;
1301 itempart, itempart1, itempart2, itemnums, itemname, itemtest: string;
1302begin
1303 preprofile := aProfile;
1304 aList.Clear;
1305 if Piece(aProfile, '^', 1) = VIEW_TEMPORARY then
1306 begin
1307 typedata := Piece(aProfile, '^', 3);
1308 for i := 1 to BIG_NUMBER do
1309 begin
1310 typepart := Piece(typedata, '|', i);
1311 if typepart = '' then
1312 break;
1313 testname := Piece(aProfile, '^', i + 3);
1314 typeone := Piece(typepart, '~', 1);
1315 typetwo := Piece(typepart, '~', 2);
1316 aList.Add(typeone + '^' + typetwo + '^' + testname);
1317 end;
1318 typedata := '0^' + Piece(aProfile, '^', 1) + '^ ' + Piece(aProfile, '^', 2);
1319 aList.Insert(0, typedata);
1320 aList.Insert(1, '^' + LLS_LINE);
1321 exit;
1322 end;
1323 if Piece(aProfile, '^', 1) = VIEW_CURRENT then // current selection on list
1324 begin
1325 typedata := '0^-1^ ' + Piece(aProfile, '^', 2);
1326 aProfile := Piece(aProfile, '^', 3);
1327 aList.Add(typedata);
1328 aList.Add('^' + LLS_LINE);
1329 for i := 1 to BIG_NUMBER do
1330 begin
1331 itempart := Piece(aProfile, '|', i);
1332 if itempart = '' then exit;
1333 itempart1 := Piece(itempart, '~', 1);
1334 itempart2 := Piece(itempart, '~', 2);
1335 itemnums := itempart1 + '^' + itempart2;
1336 itemname := '';
1337 for k := 0 to GtslItems.Count - 1 do
1338 begin
1339 itemtest := UpperCase(Pieces(GtslItems[k], '^', 1, 2));
1340 if Piece(itemtest, '^', 1) = '63' then
1341 itemtest := Piece(itemtest, '.', 1); // works ok but could also remove spec parens on name
1342 if itemtest = itemnums then
1343 begin
1344 itemname := Piece(GtslItems[k], '^', 4);
1345 itemnums := itemnums + '^' + itemname;
1346 aList.Add(itemnums);
1347 break;
1348 end;
1349 end;
1350 end;
1351 typedata := '0^' + Piece(aProfile, '^', 1) + '^ ' + Piece(aProfile, '^', 2);
1352 aList.Insert(0, typedata);
1353 aList.Insert(1, '^' + LLS_LINE);
1354 exit;
1355 end;
1356 if radSourceAll.Checked or allitems then
1357 begin
1358 AssignProfilePre(aList, aProfile, UserNum);
1359 for i := 0 to aList.Count - 1 do
1360 begin
1361 teststring := aList[i];
1362 if Piece(teststring, '^', 1) = '0' then
1363 aList[i] := '0^' + Piece(teststring, '^', 2) + '^_' + Piece(teststring, '^', 3);
1364 end;
1365 exit;
1366 end;
1367 if Piece(aProfile, '^', 1) = VIEW_LABS then
1368 begin
1369 lstScratch.Items.Clear;
1370 FastAssign(GetATestGroup(strtointdef(Piece(Piece(aProfile, '^', 2), ')', 1), -1), UserNum), aList);
1371 for i := 0 to aList.Count - 1 do
1372 aList[i] := '63^' + aList[i];
1373 end
1374 else
1375 if Piece(aProfile, '^', 1) = VIEW_PUBLIC then
1376 begin
1377 FastAssign(GetGraphProfiles(UpperCase(Piece(aProfile, '^', 2)), '1', 0, 0), lstScratch.Items);
1378 typedata := '0^-1^ ' + Piece(aProfile, '^', 2);
1379 end
1380 else
1381 begin
1382 FastAssign(GetGraphProfiles(UpperCase(Piece(aProfile, '^', 2)), '0', 0, UserNum), lstScratch.Items);
1383 typedata := '0^' + Piece(aProfile, '^', 1) + '^ ' + Piece(aProfile, '^', 2);
1384 end;
1385 if Piece(aProfile, '^', 1) = VIEW_LABS then
1386 exit;
1387 for i := 0 to lstScratch.Items.Count - 1 do
1388 aProfile := aProfile + lstScratch.Items[i];
1389 aProfile := Piece(aProfile, '^', 3);
1390 AssignProfilePost(aList, aProfile, typedata);
1391end;
1392
1393procedure TfrmGraphProfiles.AssignProfilePre(aList: TStrings; var aProfile: string; UserNum: integer);
1394var
1395 i: integer;
1396begin
1397 if Piece(aProfile, '^', 1) = VIEW_LABS then
1398 begin
1399 FastAssign(GetATestGroup(strtointdef(Piece(Piece(aProfile, '^', 2), ')', 1), -1), UserNum), aList);
1400 for i := 0 to aList.Count - 1 do
1401 aList[i] := '63^' + aList[i];
1402 end
1403 else
1404 if Piece(aProfile, '^', 1) = VIEW_PUBLIC then
1405 FastAssign(GetGraphProfiles(UpperCase(Piece(aProfile, '^', 2)), '1', 1, 0), aList)
1406 else
1407 if Piece(aProfile, '^', 1) = VIEW_PERSONAL then
1408 FastAssign(GetGraphProfiles(UpperCase(Piece(aProfile, '^', 2)), '0', 1, UserNum), aList)
1409 else
1410 FastAssign(GetGraphProfiles(UpperCase(Piece(aProfile, '^', 2)), '0', 1, UserNum), aList);
1411end;
1412
1413procedure TfrmGraphProfiles.AssignProfilePost(aList: TStrings; var aProfile, typedata: string);
1414var
1415 stop: boolean;
1416 i, j, k: integer;
1417 itempart, itempart1, itempart2, itemnums, itemname, itemtest: string;
1418begin
1419 aList.Clear;
1420 aList.Add(typedata);
1421 aList.Add('^' + LLS_LINE);
1422 for i := 1 to BIG_NUMBER do
1423 begin
1424 itempart := Piece(aProfile, '|', i);
1425 if itempart = '' then exit;
1426 itempart1 := Piece(itempart, '~', 1);
1427 itempart2 := Piece(itempart, '~', 2);
1428 itemnums := itempart1 + '^' + itempart2;
1429 itemname := '';
1430 if itempart1 = '0' then
1431 begin
1432 for j := 0 to lstSources.Items.Count - 1 do
1433 if itempart2 = Piece(lstSources.Items[j], '^', 1) then
1434 begin
1435 itemname := Piece(lstSources.Items[j], '^', 2);
1436 break;
1437 end;
1438 typedata := '0^' + itempart2 + '^_' + itemname + ' <any>';
1439 aList.Add(typedata);
1440 end
1441 else
1442 if (itempart1 <> '0') then //DRUG CLASS NOT INCLUDED
1443 begin
1444 stop := false;
1445 for k := 0 to lstTests.Items.Count - 1 do
1446 begin
1447 itemtest := UpperCase(Pieces(lstTests.Items[k], '^', 1, 2));
1448 if itemtest = itemnums then
1449 begin
1450 itemname := Piece(lstTests.Items[k], '^', 3);
1451 itemnums := itemnums + '^' + itemname;
1452 aList.Add(itemnums);
1453 stop := true;
1454 break;
1455 end;
1456 end;
1457 if not stop then
1458 for k := 0 to lstDrugClass.Items.Count - 1 do
1459 begin
1460 itemtest := UpperCase(Pieces(lstDrugClass.Items[k], '^', 1, 2));
1461 if itemtest = itemnums then
1462 begin
1463 itemname := Piece(lstDrugClass.Items[k], '^', 3);
1464 itemnums := itemnums + '^' + itemname;
1465 aList.Add(itemnums);
1466 break;
1467 end;
1468 end;
1469 end;
1470 end;
1471end;
1472
1473procedure TfrmGraphProfiles.FillSource(aList: TORListBox);
1474var
1475 i, UserNum: integer;
1476 dfntype, firstline, listline: string;
1477begin
1478 with aList do
1479 begin
1480 Clear;
1481 firstline := '';
1482 Sorted := true;
1483 OnClick := OnChange; // turn off onchange event when loading
1484 OnChange := nil;
1485 if aList = lstSources then // user
1486 begin
1487 FastAssign(rpcGetTypes('0', true), Items); //*** use GtslAllTypes ???
1488 for i := 0 to Items.Count - 1 do
1489 begin
1490 listline := Items[i];
1491 dfntype := UpperCase(Piece(listline, '^', 1));
1492 SetPiece(listline, '^', 1, dfntype);
1493 Items[i] := listline;
1494 end;
1495 Sorted := false;
1496 Items.Insert(0, LLS_FRONT + copy('Types' + LLS_BACK, 0, 30) + '^0');
1497 UserNum := User.DUZ;
1498 if GtslViews.Count > 0 then
1499 begin
1500 Items.Add(LLS_FRONT + copy('Temporary Views' + LLS_BACK, 0, 30) + '^0');
1501 for i := 0 to GtslViews.Count - 1 do
1502 begin
1503 listline := GtslViews[i];
1504 if Piece(listline, '^', 1) = VIEW_CURRENT then
1505 Items.Add(listline)
1506 else
1507 Items.Add(VIEW_TEMPORARY + '^' + listline + '^');
1508 end;
1509 end;
1510 end
1511 else // other user
1512 begin
1513 UserNum := cboUser.ItemIEN;
1514 Sorted := false;
1515 end;
1516 FastAssign(GetGraphProfiles('1', '0', 0, UserNum), lstScratch.Items);
1517 lstScratch.Sorted := true;
1518 if lstScratch.Items.Count > 0 then
1519 begin
1520 Items.Add(LLS_FRONT + copy('Personal Views' + LLS_BACK, 0, 30) + '^0');
1521 for i := 0 to lstScratch.Items.Count - 1 do
1522 Items.Add(VIEW_PERSONAL + '^' + lstScratch.Items[i] + '^');
1523 end;
1524 FastAssign(GetGraphProfiles('1', '1', 0, 0), lstScratch.Items);
1525 lstScratch.Sorted := true;
1526 if (lstScratch.Items.Count > 0) and (aList = lstSources) then
1527 begin
1528 Items.Add(LLS_FRONT + copy('Public Views' + LLS_BACK, 0, 30) + '^0');
1529 for i := 0 to lstScratch.Items.Count - 1 do
1530 Items.Add(VIEW_PUBLIC + '^' + lstScratch.Items[i] + '^');
1531 end;
1532 FastAssign(rpcTestGroups(UserNum), lstScratch.Items);
1533 lstScratch.Sorted := true;
1534 if lstScratch.Items.Count > 0 then
1535 begin
1536 Items.Add(LLS_FRONT + copy('Lab Groups' + LLS_BACK, 0, 30) + '^0');
1537 for i := 0 to lstScratch.Items.Count - 1 do
1538 Items.Add(VIEW_LABS + '^' + Piece(lstScratch.Items[i], '^', 2) + '^' + Piece(lstScratch.Items[i], '^', 1));
1539 end;
1540 OnChange := OnClick;
1541 OnClick := nil;
1542 end;
1543end;
1544
1545function TfrmGraphProfiles.ProfileExists(aName, aType: string): boolean;
1546var
1547 i: integer;
1548 info, sourcetype, profilename: string;
1549begin
1550 Result := false;
1551 aName := UpperCase(aName);
1552 for i := lstSources.Items.Count - 1 downto 0 do
1553 begin
1554 info := lstSources.Items[i];
1555 profilename := Piece(info, '^', 2);
1556 sourcetype := Piece(info, '^', 1);
1557 if (UpperCase(profilename) = aName) and (aType = sourcetype) then
1558 begin
1559 Result := true;
1560 break;
1561 end;
1562 end;
1563end;
1564
1565procedure TfrmGraphProfiles.AssignHints;
1566var
1567 i: integer;
1568begin // text defined in uGraphs
1569 for i := 0 to ControlCount - 1 do with Controls[i] do
1570 Controls[i].ShowHint := true;
1571 RadSourcePat.Hint := HINT_PAT_SOURCE;
1572 RadSourceAll.Hint := HINT_ALL_SOURCE;
1573 lblSelectionInfo.Hint := HINT_SELECTION_INFO;
1574 lblSource.Hint := HINT_SOURCE;
1575 lstSources.Hint := HINT_SOURCE;
1576 pnlSources.Hint := HINT_SOURCE;
1577 pnlAllSources.Hint := HINT_SOURCE;
1578 splViews.Hint := HINT_SOURCE;
1579 lblSelectOthers.Hint := HINT_OTHER_SOURCE;
1580 lblOtherViews.Hint := HINT_OTHER_SOURCE;
1581 lstOtherSources.Hint := HINT_OTHER_SOURCE;
1582 pnlOtherSources.Hint := HINT_OTHER_SOURCE;
1583 pnlOtherSourcesBottom.Hint := HINT_OTHER_SOURCE;
1584 pnlOtherViews.Hint := HINT_OTHER_SOURCE;
1585 lblOtherViews.Hint := HINT_OTHER_SOURCE;
1586 lblSelectOthers.Hint := HINT_OTHER_SOURCE;
1587 lblOtherPersons.Hint := HINT_OTHERS;
1588 cboUser.Hint := HINT_OTHERS;
1589 pnlOtherSourcesUser.Hint := HINT_OTHERS;
1590 btnDefinitions.Hint := HINT_BTN_DEFINITION;
1591 lblSelection.Hint := HINT_SELECTION;
1592 lstItemsSelection.Hint := HINT_SELECTION;
1593 cboAllItems.Hint := HINT_SELECTION;
1594 lblDisplay.Hint := HINT_DISPLAY;
1595 lstItemsDisplayed.Hint := HINT_DISPLAY;
1596 btnAddAll.Hint := HINT_BTN_ADDALL;
1597 btnAdd.Hint := HINT_BTN_ADD1;
1598 btnRemoveOne.Hint := HINT_BTN_REMOVE1;
1599 btnRemoveAll.Hint := HINT_BTN_REMOVEALL;
1600 btnClear.Hint := HINT_BTN_CLEAR;
1601 btnDelete.Hint := HINT_BTN_DELETE;
1602 btnRename.Hint := HINT_BTN_RENAME;
1603 btnSave.Hint := HINT_BTN_SAVE;
1604 btnSavePublic.Hint := HINT_BTN_SAVE_PUB;
1605 pnlApply.Hint := HINT_APPLY;
1606 btnClose.Hint := HINT_BTN_CLOSE;
1607end;
1608
1609procedure TfrmGraphProfiles.wmNCLButtonDown(var Msg: TWMNCLButtonDown);
1610begin // clicking the ? button will have controls show hints
1611 if Msg.HitTest = HTHELP then
1612 begin
1613 Msg.Result := 0; // ignore biHelp border icon
1614 AssignHints;
1615 ShowMsg('Help is now available.' + #13 +
1616 'By pausing over a list or control, hints will appear.');
1617 end
1618 else
1619 inherited;
1620end;
1621
1622function TfrmGraphProfiles.GetProfileName(infotitle, info: string; var newprofilename: string): boolean;
1623begin
1624 Result := InputQuery(infotitle, info, newprofilename);
1625 if not Result then exit;
1626 if newprofilename = '' then
1627 begin
1628 Result := false;
1629 exit;
1630 end;
1631 if (length(newprofilename) < 3)
1632 or (length(newprofilename) > 30)
1633 or (Pos('^', newprofilename) > 0)
1634 or (Pos('|', newprofilename) > 0)
1635 or (Pos('~', newprofilename) > 0) then
1636 begin
1637 ShowMsg('Not accepted - names of views must be 3-30 characters.');
1638 Result := false;
1639 exit;
1640 end;
1641end;
1642
1643procedure TfrmGraphProfiles.IDProfile(var profilename, proftype: string);
1644var
1645 i, match: integer;
1646 info, aName, aType: string;
1647begin
1648 if length(profilename) > 0 then
1649 lblSave.Hint := profilename;
1650 //btnClearClick(self);
1651 lstScratch.Items.Clear;
1652 lstSources.Items.Clear;
1653 GraphDataOnUser;
1654 FormShow(btnSave);
1655 match := -1;
1656 profilename := UpperCase(profilename);
1657 for i := lstSources.Items.Count - 1 downto 0 do
1658 begin
1659 info := lstSources.Items[i];
1660 aType := Piece(info, '^', 1);
1661 aName := Piece(info, '^', 2);
1662 if (UpperCase(aName) = profilename) and (aType = proftype) then
1663 begin
1664 match := i;
1665 break;
1666 end;
1667 end;
1668 if match = -1 then exit;
1669 lstSources.ItemIndex := match;
1670 lstSources.Tag := BIG_NUMBER;
1671 lstSourcesChange(lstSources);
1672end;
1673
1674end.
Note: See TracBrowser for help on using the repository browser.