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

Last change on this file since 1737 was 1679, checked in by healthsevak, 10 years ago

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