source: cprs/branches/tmg-cprs/CPRS-Chart/fGraphProfiles.pas@ 1681

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

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