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

Last change on this file since 730 was 456, checked in by Kevin Toppenberg, 16 years ago

Initial Upload of Official WV CPRS 1.0.26.76
File size: 38.6 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, uCore;
8
9type
10 TfrmGraphProfiles = class(TForm)
11 btnAdd: TButton;
12 btnAddAll: TButton;
13 btnClear: TButton;
14 btnClose: TButton;
15 btnDelete: TButton;
16 btnRemoveAll: TButton;
17 btnRemoveOne: TButton;
18 btnRename: TButton;
19 btnSave: TButton;
20 btnSavePublic: TButton;
21 bvlBase: TBevel;
22 cboAllItems: TORComboBox;
23 lblApply: TLabel;
24 lblDisplay: TLabel;
25 lblEditInfo: TLabel;
26 lblEditInfo1: TLabel;
27 lblSelectandDefine: TLabel;
28 lblSelection: TLabel;
29 lblSelectionInfo: TLabel;
30 lblSource: TLabel;
31 lstActualItems: TORListBox;
32 lstDrugClass: TListBox;
33 lstItemsDisplayed: TORListBox;
34 lstItemsTopSelection: TORListBox;
35 lstScratch: TListBox;
36 lstSource: TORListBox;
37 lstTests: TListBox;
38 pnlApply: TPanel;
39 pnlSource: TPanel;
40 pnlTempData: TPanel;
41 radSourceAll: TRadioButton;
42 radSourcePat: TRadioButton;
43 radTop: TRadioButton;
44 radBottom: TRadioButton;
45 radBoth: TRadioButton;
46 radNeither: TRadioButton;
47 lblSave: TLabel;
48 lblClose: TLabel;
49 procedure FormCreate(Sender: TObject);
50 procedure FormShow(Sender: TObject);
51 procedure FormClose(Sender: TObject; var Action: TCloseAction);
52
53 procedure btnClearClick(Sender: TObject);
54 procedure btnDeleteClick(Sender: TObject);
55 procedure btnCloseClick(Sender: TObject);
56 procedure btnRemoveClick(Sender: TObject);
57 procedure btnRemoveAllClick(Sender: TObject);
58 procedure btnRemoveOneClick(Sender: TObject);
59 procedure btnRenameClick(Sender: TObject);
60 procedure btnSaveClick(Sender: TObject);
61
62 procedure radSourceAllClick(Sender: TObject);
63
64 procedure cboAllItemsClick(Sender: TObject);
65 procedure cboAllItemsChange(Sender: TObject);
66 procedure cboAllItemsNeedData(Sender: TObject; const StartFrom: String;
67 Direction, InsertAt: Integer);
68 procedure lstItemsDisplayedChange(Sender: TObject);
69 procedure lstItemsDisplayedDblClick(Sender: TObject);
70 procedure lstSourceChange(Sender: TObject);
71 procedure lstSourceDblClick(Sender: TObject);
72
73 procedure AddToList(aItem: string; aListBox: TORListBox);
74 procedure ArrangeList(aCheckFile, aCheckItem, aItem: string;
75 aListBox: TORListBox; var addtolist: boolean);
76 procedure AssignHints;
77 procedure AssignProfile(aList: TStrings; aProfile: string);
78 procedure CheckPublic;
79 procedure FillSource;
80
81 function ProfileExists(aName: string; aType: integer): boolean;
82 private
83 { Private declarations }
84 FHintPauseTime: integer;
85 FPublicEditor: boolean;
86 procedure CheckToClear;
87 procedure QualifierDelete(line: string);
88 procedure wmNCLButtonDown(var Msg: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
89 public
90 { Public declarations }
91 end;
92
93var
94 frmGraphProfiles: TfrmGraphProfiles;
95
96procedure DialogOptionsGraphProfiles(topvalue, leftvalue, fontsize: integer;
97 var actiontype: boolean);
98procedure DialogGraphProfiles(fontsize: integer; var actionOK: boolean;
99 var checkaction: boolean; aGraphSetting: TGraphSetting;
100 var aProfname, aProfilestring, aSection: string;
101 const PatientDFN: string; var aCounter: integer;
102 aSelections: string);
103
104implementation
105
106{$R *.DFM}
107
108uses
109 rGraphs;
110
111procedure DialogOptionsGraphProfiles(topvalue, leftvalue, fontsize: integer;
112 var actiontype: boolean);
113// create the form and make it modal, return an action
114var
115 FGraphSetting: TGraphSetting;
116 aList, AllTypes: TStrings;
117 dfntype, listline, settings, settings1, t1, t2: string;
118 actionOK, checkaction: boolean;
119 counter, i: integer;
120 aSelections, profile, profilestring, section: string;
121begin
122 aList := TStringList.Create;
123 FastAssign(rpcGetGraphSettings, aList);
124 if aList.Count < 1 then
125 begin
126 showmessage('CPRS is not configured for graphing.');
127 aList.Free;
128 exit;
129 end;
130 t1 := aList[0]; t2 := aList[1]; // t1 are personal, t2 public settings
131 if length(t1) > 0 then settings := t1
132 else settings := t2;
133 SetPiece(settings, '|', 8, Piece(t2, '|', 8));
134 settings1 := Piece(settings, '|', 1);
135 Alltypes := TStringList.Create;
136 FastAssign(rpcGetTypes('0', true), AllTypes);
137 for i := 0 to AllTypes.Count - 1 do
138 begin
139 listline := AllTypes[i];
140 dfntype := UpperCase(Piece(listline, '^', 1));
141 SetPiece(listline, '^', 1, dfntype);
142 AllTypes[i] := listline;
143 end;
144 FGraphSetting := GraphSettingsInit(settings);
145 checkaction := false;
146 actionOK := false;
147 profile := '*';
148 counter := BIG_NUMBER;
149 aSelections :='';
150 DialogGraphProfiles(fontsize, actionOK, checkaction, FGraphSetting,
151 profile, profilestring, section, Patient.DFN, counter, aSelections);
152 FGraphSetting.Free;
153 aList.Free;
154end;
155
156procedure DialogGraphProfiles(fontsize: integer; var actionOK: boolean;
157 var checkaction: boolean; aGraphSetting: TGraphSetting;
158 var aProfname, aProfilestring, aSection: string;
159 const PatientDFN: string; var aCounter: integer;
160 aSelections: string);
161var
162 i: integer;
163 counter, profile, profileitem, profiletype: string;
164 frmGraphProfiles: TfrmGraphProfiles;
165begin
166 frmGraphProfiles := TfrmGraphProfiles.Create(Application);
167 try
168 with frmGraphProfiles do
169 begin
170 lblSave.Hint := aProfname;
171 lblClose.Hint := PatientDFN;
172 if aCounter = BIG_NUMBER then
173 begin
174 pnlApply.Visible := false;
175 frmGraphProfiles.Caption := 'Define Views';
176 end
177 else
178 begin
179 pnlApply.Visible := true;
180 frmGraphProfiles.Caption := 'Select Items and Define Views';
181 end;
182 if length(aSelections) > 0 then
183 lstSource.Items.Insert(0, '-3^<current selections>^' + aSelections);
184 ResizeAnchoredFormToFont(frmGraphProfiles);
185 ShowModal;
186 actionOK := (btnClose.Tag = 1);
187 aProfname := '';
188 if actionOK then
189 begin
190 aProfname := lblSave.Hint;
191 if radTop.Checked then aSection := 'top'
192 else if radBottom.Checked then aSection := 'bottom'
193 else if radBoth.Checked then aSection := 'both'
194 else aSection := 'neither';
195 profile := '';
196 with lstItemsDisplayed do
197 for i := 0 to Items.Count - 1 do
198 begin
199 profiletype := Piece(Items[i], '^', 1);
200 profileitem := Piece(Items[i], '^', 2);
201 profile := profile + profiletype + '~' + profileitem + '~|';
202 end;
203 aCounter := aCounter + 1;
204 counter := inttostr(aCounter);
205 aProfileString := '^<view' + counter + '>^' + profile;
206 with aGraphSetting do
207 begin
208 lstActualItems.Items.Clear;
209 with lstItemsDisplayed do
210 for i := 0 to Items.Count - 1 do
211 begin
212 lstActualItems.Items.Add(Piece(Items[i], '<', 1)); //get rid of <any>
213 end;
214 ItemsForDisplay := lstActualItems.Items;
215 end;
216 end;
217 end;
218 finally
219 frmGraphProfiles.Release;
220 end;
221end;
222
223procedure TfrmGraphProfiles.FormCreate(Sender: TObject);
224begin
225 FillSource;
226 FPublicEditor := rpcPublicEdit;
227end;
228
229procedure TfrmGraphProfiles.FormShow(Sender: TObject);
230begin
231 cboAllItems.Visible := radSourceAll.Checked;
232 FHintPauseTime := Application.HintHidePause;
233 Application.HintHidePause := 9000; // uses a longer hint pause time
234end;
235
236procedure TfrmGraphProfiles.btnClearClick(Sender: TObject);
237begin
238 lstItemsDisplayed.Items.Clear;
239 lstItemsTopSelection.Items.Clear;
240 cboAllItems.Items.Clear;
241 cboAllItems.Text :='';
242 lstItemsDisplayedChange(self);
243 cboAllItemsChange(self);
244 lstSource.ItemIndex := -1;
245end;
246
247procedure TfrmGraphProfiles.btnDeleteClick(Sender: TObject);
248var
249 publicview: boolean;
250 info, profilename, profname, proftype: string;
251begin
252 if lstSource.ItemIndex < 0 then
253 begin
254 showmessage('You must select a valid View for deletion.');
255 exit;
256 end;
257 publicview := false;
258 profilename := '';
259 info := lstSource.Items[lstSource.ItemIndex];
260 proftype := Piece(info, '^', 1);
261 profname := Piece(info, '^', 2);
262 if proftype = '-1' then
263 profilename := profname
264 else if (proftype = '-2') and FPublicEditor then
265 begin
266 profilename := profname;
267 publicview := true;
268 end
269 else
270 begin
271 showmessage('You must select a valid View for deletion.');
272 exit;
273 end;
274 if publicview then
275 begin
276 if MessageDlg('This is Public and may be used by others.'
277 + #13 + 'Delete ' + profilename + '?', mtConfirmation,
278 [mbYes, mbNo], 0) = mrYes then
279 begin
280 rpcDeleteGraphProfile(UpperCase(profilename), '1');
281 btnClose.Tag := 1;
282 MessageDlg('The public view, ' + profilename + ' has been deleted.',
283 mtInformation, [mbOk], 0);
284 end
285 else exit;
286 end
287 else
288 begin
289 if MessageDlg('Delete ' + profilename + '?', mtConfirmation,
290 [mbYes, mbNo], 0) = mrYes then
291 begin
292 rpcDeleteGraphProfile(UpperCase(profilename), '0');
293 btnClose.Tag := 1;
294 MessageDlg('Your personal view, ' + profilename + ' has been deleted.',
295 mtInformation, [mbOk], 0);
296 end
297 else exit;
298 end;
299 btnClearClick(self);
300 lstItemsDisplayed.Items.Clear;
301 lstItemsTopSelection.Items.Clear;
302 cboAllItems.Items.Clear;
303 cboAllItems.Text :='';
304 FormCreate(self);
305 lstItemsDisplayedChange(self);
306 btnDelete.Enabled := false;
307 btnRename.Enabled := false;
308end;
309
310procedure TfrmGraphProfiles.btnRenameClick(Sender: TObject);
311var
312 profentered, publicview: boolean;
313 i, match: integer;
314 aName, aType, info, infotitle: string;
315 newprofilename, profilename, profname, proftype: string;
316begin
317 if lstSource.ItemIndex < 0 then
318 begin
319 showmessage('You must select a valid View to rename.');
320 exit;
321 end;
322 publicview := false;
323 profilename := '';
324 info := lstSource.Items[lstSource.ItemIndex];
325 proftype := Piece(info, '^', 1);
326 profname := Piece(info, '^', 2);
327 if proftype = '-1' then
328 profilename := profname
329 else if (proftype = '-2') and FPublicEditor then
330 begin
331 profilename := profname;
332 publicview := true;
333 end
334 else
335 begin
336 showmessage('You must select a valid View to rename.');
337 end;
338 btnRemoveAllClick(self);
339 lstSourceDblClick(self);
340 if publicview then
341 begin
342 infotitle := 'Rename this Public View';
343 info := 'This is Public and may be used by others.'
344 + #13 + 'Enter a new name for ' + profilename + '.'
345 end
346 else
347 begin
348 infotitle := 'Rename your Personal View';
349 info := 'Enter a new name for ' + profilename + '.'
350 end;
351 profentered := InputQuery(infotitle, info, newprofilename);
352 if not profentered then exit;
353 if newprofilename = '' then exit;
354 info := '';
355 if not ProfileExists(newprofilename, -2) and publicview then
356 info := 'The Public View, ' + profilename + ', will be changed to '
357 + newprofilename + #13 + 'Is this OK?'
358 else if not ProfileExists(newprofilename, -1) then
359 info := 'Your Personal View, ' + profilename + ', will be changed to '
360 + newprofilename + #13 + 'Is this OK?';
361 if length(info) > 0 then
362 begin
363 if MessageDlg(info, mtConfirmation, [mbYes, mbNo], 0) <> mrYes then exit;
364 if publicview then
365 begin
366 FastAssign(rpcGetGraphProfiles(UpperCase(profilename), '1', 1), lstScratch.Items);
367 rpcDeleteGraphProfile(UpperCase(profilename), '1');
368 rpcSetGraphProfile(newprofilename, '1', lstScratch.Items);
369 btnClose.Tag := 1;
370 proftype := '-2';
371 end
372 else
373 begin
374 FastAssign(rpcGetGraphProfiles(UpperCase(profilename), '0', 1), lstScratch.Items);
375 rpcDeleteGraphProfile(UpperCase(profilename), '0');
376 rpcSetGraphProfile(newprofilename, '0', lstScratch.Items);
377 btnClose.Tag := 1;
378 proftype := '-1';
379 end;
380 end;
381 if length(newprofilename) > 0 then
382 lblSave.Hint := newprofilename;
383 btnClearClick(self);
384 lstScratch.Items.Clear;
385 lstSource.Items.Clear;
386 FormCreate(btnSave);
387 match := -1;
388 profilename := UpperCase(newprofilename);
389 for i := lstSource.Items.Count - 1 downto 0 do
390 begin
391 info := lstSource.Items[i];
392 aType := Piece(info, '^', 1);
393 aName := Piece(info, '^', 2);
394 if (UpperCase(aName) = newprofilename) and (aType = proftype) then
395 begin
396 match := i;
397 break;
398 end;
399 end;
400 if match = -1 then exit;
401 lstSource.ItemIndex := match;
402 lstSourceChange(self);
403end;
404
405procedure TfrmGraphProfiles.btnCloseClick(Sender: TObject);
406begin
407 if lstItemsDisplayed.Items.Count > 0 then
408 btnClose.Tag := 1;
409 Close;
410end;
411
412procedure TfrmGraphProfiles.btnRemoveClick(Sender: TObject);
413begin
414 if lstItemsDisplayed.ItemIndex < 0 then exit;
415 lstItemsDisplayed.Items.Delete(lstItemsDisplayed.ItemIndex);
416 CheckToClear;
417end;
418
419procedure TfrmGraphProfiles.btnRemoveAllClick(Sender: TObject);
420begin
421 lstItemsDisplayed.Clear;
422 lstItemsDisplayedChange(self);
423 CheckToClear;
424end;
425
426procedure TfrmGraphProfiles.btnRemoveOneClick(Sender: TObject);
427begin
428 lstItemsDisplayedDblClick(self);
429 CheckToClear;
430end;
431
432procedure TfrmGraphProfiles.CheckToClear;
433begin
434 if cboAllItems.Visible and (cboAllItems.Items.Count = 0) then
435 lstSource.ItemIndex := -1
436 else if lstItemsTopSelection.Visible and (lstItemsTopSelection.Items.Count = 0) then
437 lstSource.ItemIndex := -1;
438 if lstSource.ItemIndex = -1 then
439 begin
440 btnAdd.Enabled := false;
441 btnAddAll.Enabled := false;
442 end;
443end;
444
445procedure TfrmGraphProfiles.btnSaveClick(Sender: TObject);
446var
447 profentered, puplicedit: boolean;
448 i, j, match: integer;
449 aName, aType, info, infotitle, profile, profileitem, profilename, profiletype, profname, proftype: string;
450 aList: TStrings;
451begin
452 puplicedit := Sender = btnSavePublic;
453 if lstItemsDisplayed.Items.Count < 1 then exit;
454 profilename := '';
455 if lstSource.ItemIndex > -1 then
456 begin
457 info := lstSource.Items[lstSource.ItemIndex];
458 proftype := Piece(info, '^', 1);
459 profname := Piece(info, '^', 2);
460 profilename := profname;
461 end;
462 if puplicedit then
463 begin
464 infotitle := 'Save this Public View';
465 info := 'Save this Public View by entering a name for it.'
466 + #13 + 'If you are editing a View, enter the View''s name to overwrite it.';
467 end
468 else
469 begin
470 infotitle := 'Save your Personal View';
471 info := 'Save your Personal View by entering a name for it.'
472 + #13 + 'If you are editing a View, enter the View''s name to overwrite it.';
473 end;
474 profentered := InputQuery(infotitle, info, profilename);
475 if not profentered then exit;
476 if profilename = '' then exit;
477 if (length(profilename) < 3) or (length(profilename) > 30) then
478 begin
479 showmessage('Not accepted - names of views must be 3-30 characters.');
480 exit;
481 end;
482 info := '';
483 if ProfileExists(profilename, -2) and FPublicEditor and puplicedit then
484 info := 'The Public View, ' + profilename + ', will be overwritten.'
485 + #13 + 'Is this OK?'
486 else if ProfileExists(profilename, -1) and (not puplicedit) then
487 info := 'Your Personal View, ' + profilename + ', will be overwritten.'
488 + #13 + 'Is this OK?';
489 if length(info) > 0 then
490 if MessageDlg(info, mtConfirmation, [mbYes, mbNo], 0) <> mrYes then exit;
491 aList := TStringList.Create;
492 profile := '';
493 aList.Clear;
494 j := 1;
495 with lstItemsDisplayed do
496 for i := 0 to Items.Count - 1 do
497 begin
498 profiletype := Piece(Items[i], '^', 1);
499 profileitem := Piece(Items[i], '^', 2);
500 profile := profile + profiletype + '~' + profileitem + '~|';
501 j := j +1;
502 if (j mod 10) = 0 then
503 if length(profile) > 0 then
504 begin
505 aList.Add(UpperCase(profile));
506 profile := '';
507 end;
508 end;
509 if length(profile) > 0 then
510 begin
511 aList.Add(UpperCase(profile));
512 profile := '';
513 end;
514 if puplicedit then
515 begin
516 proftype := '-2';
517 rpcSetGraphProfile(profilename, '1', aList);
518 btnClose.Tag := 1;
519 end
520 else
521 begin
522 proftype := '-1';
523 rpcSetGraphProfile(profilename, '0', aList);
524 btnClose.Tag := 1;
525 end;
526 if length(profilename) > 0 then
527 lblSave.Hint := profilename;
528 btnClearClick(self);
529 lstScratch.Items.Clear;
530 lstSource.Items.Clear;
531 FormCreate(btnSave);
532 match := -1;
533 profilename := UpperCase(profilename);
534 for i := lstSource.Items.Count - 1 downto 0 do
535 begin
536 info := lstSource.Items[i];
537 aType := Piece(info, '^', 1);
538 aName := Piece(info, '^', 2);
539 if (UpperCase(aName) = profilename) and (aType = proftype) then
540 begin
541 match := i;
542 break;
543 end;
544 end;
545 aList.Free;
546 if match = -1 then exit;
547 lstSource.ItemIndex := match;
548 lstSourceChange(self);
549end;
550
551procedure TfrmGraphProfiles.CheckPublic;
552var
553 typedata: string;
554begin
555 if lstSource.ItemIndex = -1 then
556 begin
557 btnDelete.Enabled := false;
558 btnRename.Enabled := false;
559 exit;
560 end;
561 typedata := lstSource.Items[lstSource.ItemIndex];
562 btnDelete.Enabled := (Piece(typedata, '^', 1) = '-1')
563 or ((Piece(typedata, '^', 1) = '-2') and FPublicEditor);
564 btnRename.Enabled := btnDelete.Enabled;
565end;
566
567procedure TfrmGraphProfiles.radSourceAllClick(Sender: TObject);
568var
569 dfn: string;
570begin
571 if Sender = radSourceAll then
572 begin
573 lstItemsTopSelection.Visible := false;
574 cboAllItems.Visible := true;
575 end
576 else
577 begin
578 if radSourcePat.Tag = 0 then
579 begin
580 dfn := lblClose.Hint;
581 FastAssign(rpcGetAllItems(dfn), lstTests.Items); //*** using a DFN, get all items
582 FastAssign(rpcGetItems('50.605', dfn), lstDrugClass.Items);
583 radSourcePat.Tag := 1;
584 end;
585 cboAllItems.Visible := false;
586 lstItemsTopSelection.Visible := true;
587 end;
588 lstSourceChange(self);
589end;
590
591procedure TfrmGraphProfiles.cboAllItemsClick(Sender: TObject);
592var
593 profileselected: boolean;
594 i: integer;
595 first, profileitem, selection, subtype: string;
596begin
597 if Sender is TButton then
598 begin
599 if lstItemsTopSelection.Visible then
600 begin
601 if Sender = btnAddAll then
602 lstItemsTopSelection.ItemIndex := 0;
603 Sender := lstItemsTopSelection;
604 end
605 else
606 begin
607 if Sender = btnAddAll then
608 cboAllItems.ItemIndex := 0;
609 Sender := cboAllItems;
610 end;
611 end;
612 if Sender is TORListBox then
613 with (Sender as TORListBox) do
614 begin
615 if ItemIndex < 0 then exit;
616 selection := Items[ItemIndex];
617 if length(Piece(selection, '_', 2)) > 0 then
618 selection := Piece(selection, '_', 1) + ' ' + Piece(selection, '_', 2);
619 first := Piece(selection, '^', 1);
620 if first = '' then exit; // line
621 profileselected := strtointdef(Piece(selection, '^', 2), 0) < 0;
622 if profileselected then
623 begin
624 for i := 2 to Items.Count - 1 do
625 begin
626 profileitem := Items[i];
627 if length(Piece(profileitem, '_', 2)) > 0 then
628 profileitem := Piece(profileitem, '_', 1) + ' ' + Piece(profileitem, '_', 2); //*****???? ^
629 AddToList(profileitem, lstItemsDisplayed);
630 end;
631 end
632 else
633 AddToList(selection, lstItemsDisplayed);
634 if ItemIndex = 0 then Clear; //profile or type <any>
635 ItemIndex := -1;
636 end
637 else if Sender is TORComboBox then
638 with (Sender as TORComboBox) do
639 begin
640 if ItemIndex < 0 then exit;
641 selection := Items[ItemIndex];
642 subtype := Piece(Items[0], '^', 3);
643 subtype := Piece(subtype, ':', 2);
644 subtype := copy(subtype, 2, length(subtype));
645 subtype := Piece(subtype, ' ', 1);
646 if UpperCase(copy(selection, 1, 5)) = '63AP;' then
647 selection := copy(selection, 1, 4) + '^A;' + copy(selection, 6, 1) + ';'
648 + Piece(selection, '^', 2) + '^' + subtype + ': ' + Piece(selection, '^', 3)
649 else if UpperCase(copy(selection, 1, 5)) = '63MI;' then
650 selection := copy(selection, 1, 4) + '^M;' + copy(selection, 6, 1) + ';'
651 + Piece(selection, '^', 2) + '^' + subtype + ': ' + Piece(selection, '^', 3);
652 if length(Piece(selection, '_', 2)) > 0 then
653 selection := Piece(selection, '_', 1) + ' ' + Piece(selection, '_', 2);
654 first := Piece(selection, '^', 1);
655 if first = '' then exit; // line
656 profileselected := strtointdef(Piece(selection, '^', 2), 0) < 0;
657 if profileselected then
658 begin
659 for i := 2 to Items.Count - 1 do
660 begin
661 profileitem := Items[i];
662 if length(Piece(profileitem, '_', 2)) > 0 then
663 profileitem := Piece(profileitem, '_', 1) + ' ' + Piece(profileitem, '_', 2); //*****???? ^
664 AddToList(profileitem, lstItemsDisplayed);
665 end;
666 end
667 else
668 AddToList(selection, lstItemsDisplayed);
669 if ItemIndex = 0 then Clear; //profile or type <any>
670 ItemIndex := -1;
671 end
672 else exit;
673 lstItemsDisplayedChange(self);
674 CheckToClear;
675end;
676
677procedure TfrmGraphProfiles.cboAllItemsChange(Sender: TObject);
678begin
679 if (Sender is TORListBox) then
680 btnClear.Enabled := btnSave.Enabled or ((Sender as TORListBox).Items.Count > 0)
681 else if (Sender is TORComboBox) then
682 btnClear.Enabled := btnSave.Enabled or ((Sender as TORComboBox).Items.Count > 0);
683 if lstItemsTopSelection.Visible then
684 begin
685 btnAddAll.Enabled := lstItemsTopSelection.Items.Count > 0;
686 btnAdd.Enabled := lstItemsTopSelection.ItemIndex > -1;
687 end
688 else
689 begin
690 btnAddAll.Enabled := cboAllItems.Items.Count > 0;
691 btnAdd.Enabled := cboAllItems.ItemIndex > -1;
692 end;
693end;
694
695procedure TfrmGraphProfiles.cboAllItemsNeedData(Sender: TObject;
696 const StartFrom: String; Direction, InsertAt: Integer);
697var
698 filetype: string;
699begin
700 if lstSource.ItemIndex = -1 then exit;
701 filetype := Piece(lstSource.Items[lstSource.ItemIndex], '^', 1);
702 cboAllItems.ForDataUse(rpcLookupItems(filetype, StartFrom, Direction));
703end;
704
705procedure TfrmGraphProfiles.lstItemsDisplayedChange(Sender: TObject);
706begin
707 btnSave.Enabled := lstItemsDisplayed.Items.Count > 0;
708 btnSavePublic.Enabled := btnSave.Enabled and FPublicEditor;
709 btnRemoveAll.Enabled := btnSave.Enabled;
710 btnAdd.Enabled := (cboAllItems.Visible and (cboAllItems.ItemIndex > -1))
711 or (lstItemsTopSelection.Visible and (lstItemsTopSelection.ItemIndex > -1));
712 btnRemoveOne.Enabled := btnSave.Enabled and (lstItemsDisplayed.ItemIndex > -1);
713 btnClear.Enabled := btnSave.Enabled or (lstItemsTopSelection.Items.Count > 0);
714 if btnSave.Enabled and pnlApply.Visible then btnClose.Caption := 'Close and Display'
715 else btnClose.Caption := 'Close';
716end;
717
718procedure TfrmGraphProfiles.lstItemsDisplayedDblClick(Sender: TObject);
719var
720 line: string;
721begin
722 if lstItemsDisplayed.ItemIndex < 0 then exit;
723 line := lstItemsDisplayed.Items[lstItemsDisplayed.ItemIndex];
724 lstItemsDisplayed.Items.Delete(lstItemsDisplayed.ItemIndex);
725 QualifierDelete(line);
726 lstItemsDisplayedChange(self);
727end;
728
729procedure TfrmGraphProfiles.QualifierDelete(line: string);
730var
731 i: integer;
732 filenum: string;
733begin
734 if Piece(line, '^', 1) <> '0' then exit;
735 filenum := Piece(line, '^', 2);
736 if strtointdef(filenum, 0) < 0 then exit;
737 if (filenum = '52') or (filenum = '55') or (filenum = '55NVAE')
738 or (filenum = '55NVA') or (filenum = '53.79') then
739 with lstItemsDisplayed do
740 for i := 0 to Items.Count - 1 do
741 if (Piece(Items[i], '^', 2) = '50.605') and (Piece(Items[i], '^', 1) = '0') then
742 begin
743 Items.Delete(i);
744 break;
745 end;
746end;
747
748procedure TfrmGraphProfiles.lstSourceChange(Sender: TObject);
749var
750 i: integer;
751 filetype, itemdata, typedata: string;
752begin
753 cboAllItems.Items.Clear;
754 cboAllItems.Text := '';
755 CheckPublic;
756 if lstSource.ItemIndex = -1 then exit;
757 typedata := lstSource.Items[lstSource.ItemIndex];
758 if typedata = LLS_LINE then
759 begin
760 cboAllItems.Items.Clear;
761 cboAllItems.Text := '';
762 exit;
763 end;
764 filetype := Piece(typedata, '^', 1);
765 if filetype = '-1' then
766 AssignProfile(cboAllItems.Items, typedata)
767 else
768 if filetype = '-2' then
769 AssignProfile(cboAllItems.Items, typedata)
770 else
771 if filetype = '-3' then // current selections
772 begin
773 AssignProfile(cboAllItems.Items, typedata);
774 end
775 else
776 with cboAllItems.Items do
777 begin
778 Clear;
779 cboAllItems.InitLongList('');
780 typedata := '0^' + Piece(typedata, '^', 1) + '^ ' + Piece(typedata, '^', 2) + ' <any>';
781 Insert(0, typedata);
782 Insert(1, '^' + LLS_LINE);
783 if Piece(typedata, '^', 2) = '63AP' then
784 begin
785 for i := 0 to lstSource.Items.Count - 1 do
786 if copy(lstSource.Items[i], 1, 5) = '63AP;' then
787 begin
788 typedata := lstSource.Items[i];
789 typedata := '0^' + Piece(typedata, '^', 1) + '^ ' + Piece(typedata, '^', 2) + ' <any>';
790 Add(typedata);
791 end;
792 end
793 else if Piece(typedata, '^', 2) ='63MI' then
794 begin
795 for i := 0 to lstSource.Items.Count - 1 do
796 if copy(lstSource.Items[i], 1, 5) = '63MI;' then
797 begin
798 typedata := lstSource.Items[i];
799 typedata := '0^' + Piece(typedata, '^', 1) + '^ ' + Piece(typedata, '^', 2) + ' <any>';
800 Add(typedata);
801 end;
802 end;
803 end;
804 cboAllItemsChange(cboAllItems);
805 CheckPublic;
806 if lstSource.ItemIndex = -1 then exit;
807 typedata := lstSource.Items[lstSource.ItemIndex];
808 if typedata = LLS_LINE then
809 begin
810 lstItemsTopSelection.Clear;
811 exit;
812 end;
813 filetype := Piece(typedata, '^', 1);
814 if filetype = '-1' then
815 AssignProfile(lstItemsTopSelection.Items, typedata)
816 else
817 if filetype = '-2' then
818 AssignProfile(lstItemsTopSelection.Items, typedata)
819 else
820 if filetype = '-3' then
821 begin
822 AssignProfile(lstItemsTopSelection.Items, typedata);
823 end
824 else
825 with lstItemsTopSelection.Items do
826 begin
827 Clear;
828 lstItemsTopSelection.Sorted := true;
829 typedata := '0^' + Piece(typedata, '^', 1) + '^ ' + Piece(typedata, '^', 2) + ' <any>';
830 Insert(0, typedata);
831 Insert(1, '^' + LLS_LINE);
832 if filetype = '63AP' then
833 begin
834 lstItemsTopSelection.Sorted := false;
835 for i := 0 to lstSource.Items.Count - 1 do
836 if copy(lstSource.Items[i], 1, 5) = '63AP;' then
837 begin
838 typedata := lstSource.Items[i];
839 typedata := '0^' + Piece(typedata, '^', 1) + '^ ' + Piece(typedata, '^', 2) + ' <any>';
840 Add(typedata);
841 end;
842 end
843 else if filetype ='63MI' then
844 begin
845 lstItemsTopSelection.Sorted := false;
846 for i := 0 to lstSource.Items.Count - 1 do
847 if copy(lstSource.Items[i], 1, 5) = '63MI;' then
848 begin
849 typedata := lstSource.Items[i];
850 typedata := '0^' + Piece(typedata, '^', 1) + '^ ' + Piece(typedata, '^', 2) + ' <any>';
851 Add(typedata);
852 end;
853 end
854 else if filetype = '50.605' then
855 for i := 0 to lstDrugClass.Items.Count - 1 do
856 begin
857 itemdata := lstDrugClass.Items[i];
858 if filetype = Piece(itemdata, '^', 1) then
859 Add(itemdata);
860 end
861 else if copy(filetype, 1, 5) = '63AP;' then
862 begin
863 filetype := copy(filetype, 1, 4) + '^A;' + copy(filetype, 6, 1) + ';';
864 for i := 0 to lstTests.Items.Count - 1 do
865 begin
866 itemdata := lstTests.Items[i];
867 if filetype = UpperCase(copy(itemdata, 1, 9)) then
868 Add(itemdata);
869 end;
870 end
871 else if copy(filetype, 1, 5) = '63MI;' then
872 begin
873 filetype := copy(filetype, 1, 4) + '^M;' + copy(filetype, 6, 1) + ';';
874 for i := 0 to lstTests.Items.Count - 1 do
875 begin
876 itemdata := lstTests.Items[i];
877 if filetype = UpperCase(copy(itemdata, 1, 9)) then
878 Add(itemdata);
879 end;
880 end
881 else if filetype <> '405' then
882 for i := 0 to lstTests.Items.Count - 1 do
883 begin
884 itemdata := lstTests.Items[i];
885 if filetype = UpperCase(Piece(itemdata, '^', 1)) then
886 Add(itemdata);
887 end;
888 cboAllItemsChange(lstItemsTopSelection);
889 end;
890end;
891
892procedure TfrmGraphProfiles.lstSourceDblClick(Sender: TObject);
893begin
894 if cboAllItems.Visible then
895 begin
896 if cboAllItems.Items.Count < 1 then exit;
897 cboAllItems.ItemIndex := 0;
898 cboAllItemsClick(cboAllItems);
899 end
900 else
901 begin
902 if lstItemsTopSelection.Items.Count < 1 then exit;
903 lstItemsTopSelection.Selected[0] := true;
904 cboAllItemsClick(lstItemsTopSelection);
905 end;
906end;
907
908procedure TfrmGraphProfiles.AddToList(aItem: string; aListBox: TORListBox);
909var
910 addtolist: boolean;
911 checkfile, checkitem: string;
912begin
913 aItem := UpperCase(Pieces(aItem, '^', 1, 2)) + '^' + Piece(aItem, '^', 3);
914 checkfile := Piece(aItem, '^', 1);
915 checkitem := Piece(aItem, '^', 2);
916 if checkfile = '0' then
917 begin
918 checkfile := checkitem; // if drug class any - 52,0;55,0
919 checkitem := '0'; // if drug class item - go thru meds
920 end;
921 ArrangeList(checkfile, checkitem, aItem, aListBox, addtolist);
922 if addtolist then aListBox.Items.Add(aItem);
923 if (checkfile = '50.605') and (checkitem = '0') then
924 begin
925 checkfile := '52';
926 aItem := '0^52^ Medication,Outpatitent <any>';
927 ArrangeList(checkfile, checkitem, aItem, aListBox, addtolist);
928 if addtolist then aListBox.Items.Add(aItem);
929 checkfile := '55';
930 aItem := '0^55^ Medication,Inpatitent <any>';
931 ArrangeList(checkfile, checkitem, aItem, aListBox, addtolist);
932 if addtolist then aListBox.Items.Add(aItem);
933 checkfile := '53.79';
934 aItem := '0^53.79^ Medication,BCMA <any>';
935 ArrangeList(checkfile, checkitem, aItem, aListBox, addtolist);
936 if addtolist then aListBox.Items.Add(aItem);
937 {checkfile := '55NVAE'; // nonvameds as events is not used
938 aItem := '0^55NVAE^ Medication,Non-VA-Event <any>';
939 ArrangeList(checkfile, checkitem, aItem, aListBox, addtolist);
940 if addtolist then aListBox.Items.Add(aItem);}
941 checkfile := '55NVA';
942 aItem := '0^55NVA^ Medication,Non-VA <any>';
943 ArrangeList(checkfile, checkitem, aItem, aListBox, addtolist);
944 if addtolist then aListBox.Items.Add(aItem);
945 end;
946end;
947
948procedure TfrmGraphProfiles.ArrangeList(aCheckFile, aCheckItem, aItem: string;
949 aListBox: TORListBox; var addtolist: boolean);
950var
951 i: integer;
952 listfile, listitem: string;
953begin
954 addtolist := true;
955 with aListBox do
956 for i := Items.Count - 1 downto 0 do
957 begin
958 listfile := Piece(Items[i], '^', 1);
959 listitem := Piece(Items[i], '^', 2);
960 if listfile = '0' then
961 begin
962 listfile := listitem;
963 listitem := '0';
964 end;
965 if (aCheckItem = listitem) and (aCheckFile = listfile) then
966 begin
967 addtolist := false;
968 break;
969 end
970 else
971 if (listitem = '0') and (aCheckFile = listfile) then
972 begin
973 addtolist := false;
974 break;
975 end
976 else
977 if listitem = '0' then
978 begin
979 if aCheckFile = Piece(listfile, ';', 1) then
980 if Piece(aCheckItem, ';', 2) = Piece(listfile, ';', 2) then
981 begin
982 addtolist := false;
983 break;
984 end;
985 end
986 else
987 if (aCheckItem = '0') and (aCheckFile = listfile) then
988 Items.Delete(i);
989 end;
990end;
991
992procedure TfrmGraphProfiles.AssignProfile(aList: TStrings; aProfile: string);
993var
994 ext, stop: boolean;
995 i, j, k: integer;
996 dfn, itemname, itemnums, itempart, itempart1, itempart2, itemtest, typedata, teststring: string;
997begin
998 ext := radSourceAll.Checked;
999 if ext then
1000 begin
1001 if Piece(aProfile, '^', 1) = '-2' then
1002 FastAssign(rpcGetGraphProfiles(UpperCase(Piece(aProfile, '^', 2)), '1', 1), aList)
1003 else
1004
1005 if Piece(aProfile, '^', 1) = '-3' then // current selection on list
1006 begin
1007 if radSourcePat.Tag = 0 then
1008 begin
1009 dfn := lblClose.Hint;
1010 FastAssign(rpcGetAllItems(dfn), lstTests.Items); //*** using a DFN, get all items
1011 FastAssign(rpcGetItems('50.605', dfn), lstDrugClass.Items);
1012 radSourcePat.Tag := 1;
1013 end;
1014 typedata := '0^-1^ ' + Piece(aProfile, '^', 2);
1015 aProfile := Piece(aProfile, '^', 3);
1016 aList.Clear;
1017 aList.Add(typedata);
1018 aList.Add('^' + LLS_LINE);
1019 for i := 1 to BIG_NUMBER do
1020 begin
1021 itempart := Piece(aProfile, '|', i);
1022 if itempart = '' then exit;
1023 itempart1 := Piece(itempart, '~', 1);
1024 itempart2 := Piece(itempart, '~', 2);
1025 itemnums := itempart1 + '^' + itempart2;
1026 itemname := '';
1027 for k := 0 to lstTests.Items.Count - 1 do
1028 begin
1029 itemtest := UpperCase(Pieces(lstTests.Items[k], '^', 1, 2));
1030 if itemtest = itemnums then
1031 begin
1032 itemname := Piece(lstTests.Items[k], '^', 3);
1033 itemnums := itemnums + '^' + itemname;
1034 aList.Add(itemnums);
1035 break;
1036 end;
1037 end;
1038 end;
1039 end
1040
1041 else
1042 FastAssign(rpcGetGraphProfiles(UpperCase(Piece(aProfile, '^', 2)), '0', 1), aList);
1043 for i := 0 to aList.Count -1 do
1044 begin
1045 teststring := aList[i];
1046 if Piece(teststring, '^', 1) = '0' then
1047 aList[i] := '0^' + Piece(teststring, '^', 2) + '^_' + Piece(teststring, '^', 3);
1048 end;
1049 typedata := '0^' + Piece(aProfile, '^', 1) + '^ ' + Piece(aProfile, '^', 2);
1050 aList.Insert(0, typedata);
1051 aList.Insert(1, '^' + LLS_LINE);
1052 exit;
1053 end;
1054 if Piece(aProfile, '^', 1) = '-2' then
1055 begin
1056 FastAssign(rpcGetGraphProfiles(UpperCase(Piece(aProfile, '^', 2)), '1', 0), lstScratch.Items);
1057 typedata := '0^-1^ ' + Piece(aProfile, '^', 2);
1058 end
1059 else
1060 if Piece(aProfile, '^', 1) = '-3' then // current selection on list
1061 begin
1062 lstScratch.Items.Clear;
1063 lstScratch.Items.Add(Piece(aProfile, '^', 3));
1064 typedata := '0^-1^ ' + Piece(aProfile, '^', 2);
1065 aProfile := '-1^' + Piece(aProfile, '^', 2) + '^';
1066 end
1067 else
1068 begin
1069 FastAssign(rpcGetGraphProfiles(UpperCase(Piece(aProfile, '^', 2)), '0', 0), lstScratch.Items);
1070 typedata := '0^' + Piece(aProfile, '^', 1) + '^ ' + Piece(aProfile, '^', 2);
1071 end;
1072 for i := 0 to lstScratch.Items.Count - 1 do
1073 aProfile := aProfile + lstScratch.Items[i];
1074 aProfile := Piece(aProfile, '^', 3);
1075 aList.Clear;
1076 aList.Add(typedata);
1077 aList.Add('^' + LLS_LINE);
1078 for i := 1 to BIG_NUMBER do
1079 begin
1080 itempart := Piece(aProfile, '|', i);
1081 if itempart = '' then exit;
1082 itempart1 := Piece(itempart, '~', 1);
1083 itempart2 := Piece(itempart, '~', 2);
1084 itemnums := itempart1 + '^' + itempart2;
1085 itemname := '';
1086 if itempart1 = '0' then
1087 begin
1088 for j := 0 to lstSource.Items.Count - 1 do
1089 if itempart2 = Piece(lstSource.Items[j], '^', 1) then
1090 begin
1091 itemname := Piece(lstSource.Items[j], '^', 2);
1092 break;
1093 end;
1094 typedata := '0^' + itempart2 + '^_' + itemname + ' <any>';
1095 aList.Add(typedata);
1096 end
1097 else
1098 if (itempart1 <> '0') then //DRUG CLASS NOT INCLUDED
1099 begin
1100 stop := false;
1101 for k := 0 to lstTests.Items.Count - 1 do
1102 begin
1103 itemtest := UpperCase(Pieces(lstTests.Items[k], '^', 1, 2));
1104 if itemtest = itemnums then
1105 begin
1106 itemname := Piece(lstTests.Items[k], '^', 3);
1107 itemnums := itemnums + '^' + itemname;
1108 aList.Add(itemnums);
1109 stop := true;
1110 break;
1111 end;
1112 end;
1113 if not stop then
1114 for k := 0 to lstDrugClass.Items.Count - 1 do
1115 begin
1116 itemtest := UpperCase(Pieces(lstDrugClass.Items[k], '^', 1, 2));
1117 if itemtest = itemnums then
1118 begin
1119 itemname := Piece(lstDrugClass.Items[k], '^', 3);
1120 itemnums := itemnums + '^' + itemname;
1121 aList.Add(itemnums);
1122 break;
1123 end;
1124 end;
1125 end;
1126 end;
1127end;
1128
1129procedure TfrmGraphProfiles.FillSource;
1130var
1131 i: integer;
1132 dfntype, listline: string;
1133begin
1134 with lstSource do
1135 begin
1136 Sorted := true;
1137 OnClick := OnChange; // turn off onchange event when loading
1138 OnChange := nil;
1139 FastAssign(rpcGetTypes('0', true), Items);
1140 for i := 0 to Items.Count - 1 do
1141 begin
1142 listline := Items[i];
1143 dfntype := UpperCase(Piece(listline, '^', 1));
1144 SetPiece(listline, '^', 1, dfntype);
1145 Items[i] := listline;
1146 end;
1147 //Items.Add('50.605^Drug Class');
1148 OnChange := OnClick;
1149 OnClick := nil;
1150 Sorted := false;
1151 FastAssign(rpcGetGraphProfiles('1', '0', 0), lstScratch.Items);
1152 if lstScratch.Items.Count > 0 then
1153 begin
1154 Items.Add(LLS_LINE);
1155 for i := 0 to lstScratch.Items.Count - 1 do
1156 Items.Add('-1^' + lstScratch.Items[i] + '^');
1157 end;
1158 FastAssign(rpcGetGraphProfiles('1', '1', 0), lstScratch.Items);
1159 if lstScratch.Items.Count > 0 then
1160 begin
1161 Items.Add(LLS_LINE);
1162 for i := 0 to lstScratch.Items.Count - 1 do
1163 Items.Add('-2^' + lstScratch.Items[i] + '^');
1164 end;
1165 end;
1166end;
1167
1168function TfrmGraphProfiles.ProfileExists(aName: string; aType: integer): boolean;
1169var
1170 i, sourcetype: integer;
1171 info, profilename: string;
1172begin
1173 Result := false;
1174 aName := UpperCase(aName);
1175 for i := lstSource.Items.Count - 1 downto 0 do
1176 begin
1177 info := lstSource.Items[i];
1178 profilename := Piece(info, '^', 2);
1179 sourcetype := strtointdef(Piece(info, '^', 1), 0);
1180 if (UpperCase(profilename) = aName) and (aType = sourcetype) then
1181 begin
1182 Result := true;
1183 break;
1184 end;
1185 end;
1186end;
1187
1188procedure TfrmGraphProfiles.AssignHints;
1189var
1190 i: integer;
1191begin // text defined in uGraphs
1192 for i := 0 to ControlCount - 1 do with Controls[i] do
1193 Controls[i].ShowHint := true;
1194 RadSourcePat.Hint := HINT_PAT_SOURCE;
1195 RadSourceAll.Hint := HINT_ALL_SOURCE;
1196 lblSelectionInfo.Hint := HINT_SELECTION_INFO;
1197 lblSource.Hint := HINT_SOURCE;
1198 lstSource.Hint := HINT_SOURCE;
1199 lblSelection.Hint := HINT_SELECTION;
1200 lstItemsTopSelection.Hint := HINT_SELECTION;
1201 cboAllItems.Hint := HINT_SELECTION;
1202 lblDisplay.Hint := HINT_DISPLAY;
1203 lstItemsDisplayed.Hint := HINT_DISPLAY;
1204 btnAddAll.Hint := HINT_BTN_ADDALL;
1205 btnAdd.Hint := HINT_BTN_ADD1;
1206 btnRemoveOne.Hint := HINT_BTN_REMOVE1;
1207 btnRemoveAll.Hint := HINT_BTN_REMOVEALL;
1208 btnClear.Hint := HINT_BTN_CLEAR;
1209 btnDelete.Hint := HINT_BTN_DELETE;
1210 btnRename.Hint := HINT_BTN_RENAME;
1211 btnSave.Hint := HINT_BTN_SAVE;
1212 btnSavePublic.Hint := HINT_BTN_SAVE_PUB;
1213 pnlApply.Hint := HINT_APPLY;
1214 btnClose.Hint := HINT_BTN_CLOSE;
1215end;
1216
1217procedure TfrmGraphProfiles.wmNCLButtonDown(var Msg: TWMNCLButtonDown);
1218begin // clicking the ? button will have controls show hints
1219 if Msg.HitTest = HTHELP then
1220 begin
1221 Msg.Result := 0; // ignore biHelp border icon
1222 AssignHints;
1223 ShowMessage('Help is now available.' + #13 +
1224 'By pausing over a list or control, hints will appear.');
1225 end
1226 else
1227 inherited;
1228end;
1229
1230procedure TfrmGraphProfiles.FormClose(Sender: TObject;
1231 var Action: TCloseAction);
1232begin
1233 Application.HintHidePause := FHintPauseTime;
1234end;
1235
1236end.
Note: See TracBrowser for help on using the repository browser.