source: cprs/branches/foia-cprs/CPRS-Chart/fReportsAdhocComponent1.pas@ 1375

Last change on this file since 1375 was 459, checked in by Kevin Toppenberg, 17 years ago

Adding foia-cprs branch
File size: 26.1 KB
Line 
1unit fReportsAdhocComponent1;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 ExtCtrls, StdCtrls, Grids, ORCtrls, ORfn, Buttons, fAutoSz;
8
9type
10 TfrmReportsAdhocComponent1 = class(TfrmAutoSz)
11 ORComboBox1: TORComboBox;
12 Splitter1: TSplitter;
13 Panel2: TPanel;
14 Panel3: TPanel;
15 btnCancelMain: TButton;
16 btnOKMain: TButton;
17 Panel1: TPanel;
18 ORListBox2: TORListBox;
19 Panel6: TPanel;
20 btnRemoveComponent: TButton;
21 btnRemoveAllComponents: TButton;
22 Splitter4: TSplitter;
23 Panel7: TPanel;
24 lblHeaderName: TLabel;
25 edtHeaderName: TCaptionEdit;
26 lblOccuranceLimit: TLabel;
27 edtOccuranceLimit: TCaptionEdit;
28 lblTimeLimit: TLabel;
29 cboTimeLimit: TCaptionComboBox;
30 gpbDisplay: TGroupBox;
31 ckbHospitalLocation: TCheckBox;
32 ckbProviderNarrative: TCheckBox;
33 cboICD: TCaptionComboBox;
34 lblICD: TLabel;
35 btnAddComponent: TButton;
36 pnl5Button: TKeyClickPanel;
37 SpeedButton5: TSpeedButton;
38 pnl6Button: TKeyClickPanel;
39 SpeedButton6: TSpeedButton;
40 Timer1: TTimer;
41 ORListBox1: TORListBox;
42 lblItems: TLabel;
43 btnEditSubitems: TButton;
44 GroupBox1: TGroupBox;
45 rbtnHeader: TRadioButton;
46 rbtnAbbrev: TRadioButton;
47 rbtnName: TRadioButton;
48 procedure FormCreate(Sender: TObject);
49 procedure btnCancelMainClick(Sender: TObject);
50 procedure btnOKMainClick(Sender: TObject);
51 procedure FormClose(Sender: TObject; var Action: TCloseAction);
52 procedure HideEdits;
53 procedure ORListBox2Click(Sender: TObject);
54 procedure btnRemoveComponentClick(Sender: TObject);
55 procedure btnRemoveAllComponentsClick(Sender: TObject);
56 procedure Splitter4CanResize(Sender: TObject; var NewSize: Integer;
57 var Accept: Boolean);
58 procedure Splitter1CanResize(Sender: TObject; var NewSize: Integer;
59 var Accept: Boolean);
60 procedure btnAddComponentClick(Sender: TObject);
61 procedure SpeedButton5Click(Sender: TObject);
62 procedure SpeedButton6Click(Sender: TObject);
63 procedure ORListBox2DragOver(Sender, Source: TObject; X, Y: Integer;
64 State: TDragState; var Accept: Boolean);
65 procedure ORListBox2DragDrop(Sender, Source: TObject; X, Y: Integer);
66 procedure ORListBox2EndDrag(Sender, Target: TObject; X, Y: Integer);
67 procedure Timer1Timer(Sender: TObject);
68 procedure btnEditSubitemsClick(Sender: TObject);
69 procedure edtHeaderNameExit(Sender: TObject);
70 procedure edtOccuranceLimitExit(Sender: TObject);
71 procedure cboTimeLimitExit(Sender: TObject);
72 procedure ckbHospitalLocationExit(Sender: TObject);
73 procedure ckbProviderNarrativeExit(Sender: TObject);
74 procedure cboICDExit(Sender: TObject);
75 procedure LoadComponents(Dest: TStrings);
76 procedure FormShow(Sender: TObject);
77 procedure rbtnAbbrevClick(Sender: TObject);
78 procedure rbtnNameClick(Sender: TObject);
79 procedure rbtnHeaderClick(Sender: TObject);
80 procedure pnl5ButtonEnter(Sender: TObject);
81 procedure pnl5ButtonExit(Sender: TObject);
82 procedure ORComboBox1KeyDown(Sender: TObject; var Key: Word;
83 Shift: TShiftState);
84 private
85 { Private declarations }
86 GoingUp: Boolean;
87 OKPressed: Boolean;
88 public
89 { Public declarations }
90 end;
91
92var
93 frmReportsAdhocComponent1: TfrmReportsAdhocComponent1;
94 uComponents: TStringList; {This is what is built as SubItems are
95 selected. It is identified by segment
96 and is ordered in the order that the items
97 have been selected or moved by the user.
98 Segment^file #^ifn of file^zero node of file}
99 uCurrentComponent: Integer; //Pointer to current Component ID
100 HSCompCtr: integer; //Component ID
101 uFile: String; //Mumps file Number of Subitems
102 uLimit: Integer; //HS Component Subitem Selection limit
103 uLimitCount: Integer; //Count of current Subitem Selections
104
105 function ExecuteAdhoc1: Boolean;
106
107implementation
108
109uses fReportsAdhocSubItem1, fReports, uCore, rReports;
110
111{$R *.DFM}
112type
113PHSCompRec = ^THSCompRec;
114THSCompRec = object
115 ID: integer;
116 Segment: string;
117 Name: string;
118 OccuranceLimit: string;
119 TimeLimit: string;
120 Header: string;
121 HospitalLocation: string;
122 ICDText: string;
123 ProviderNarrative: string;
124
125
126end;
127
128function ExecuteAdhoc1: Boolean;
129begin
130 Result := False;
131 frmReportsAdhocComponent1 := TfrmReportsAdhocComponent1.Create(Application);
132 try
133 ResizeFormToFont(TForm(frmReportsAdhocComponent1));
134 frmReportsAdhocComponent1.ShowModal;
135 if frmReportsAdhocComponent1.OKPressed then
136 Result := True;
137 finally
138 frmReportsAdhocComponent1.Release;
139 end;
140end;
141
142procedure TfrmReportsAdhocComponent1.FormCreate(Sender: TObject);
143
144begin
145 HideEdits;
146 HSCompCtr := 0;
147 uFile := '';
148 uLimit := 0;
149 uLimitCount := 1;
150 uComponents := TStringList.Create;
151 Splitter1.Left := ORComboBox1.Left + ORComboBox1.Width + 1;
152 Splitter1.Align := ORComboBox1.Align;
153 Panel6.Left := Splitter1.Left + Splitter1.Width;
154 Panel6.Align := Splitter1.Align;
155 ORListBox2.Left := Panel6.Left + Panel6.Width;
156 ORListBox2.Align := Panel6.Align;
157 Splitter4.Left := ORListBox2.Left + ORListBox2.Width + 1;
158 Splitter4.Align := ORListBox2.Align;
159end;
160
161procedure TfrmReportsAdhocComponent1.FormShow(Sender: TObject);
162begin
163 inherited;
164 if uListState = 1 then rbtnAbbrev.Checked := true;
165 if uListState = 0 then rbtnName.Checked := true;
166 if uListState = 2 then rbtnHeader.Checked := true;
167 LoadComponents(ORComboBox1.Items);
168end;
169
170procedure TfrmReportsAdhocComponent1.btnCancelMainClick(Sender: TObject);
171begin
172 Close;
173end;
174
175procedure TfrmReportsAdhocComponent1.btnOKMainClick(Sender: TObject);
176var
177 i,j: integer;
178begin
179 OKPressed := True;
180 with ORListBox2 do
181 begin
182 if Items.Count > 0 then
183 begin
184 for i := 0 to Items.Count - 1 do
185 begin
186 uHSComponents.Add(PHSCompRec(Items.Objects[i])^.Segment + '^' +
187 PHSCompRec(Items.Objects[i])^.OccuranceLimit + '^' +
188 PHSCompRec(Items.Objects[i])^.TimeLimit + '^' +
189 PHSCompRec(Items.Objects[i])^.Header + '^' +
190 PHSCompRec(Items.Objects[i])^.HospitalLocation + '^' +
191 PHSCompRec(Items.Objects[i])^.ICDText + '^' +
192 PHSCompRec(Items.Objects[i])^.ProviderNarrative);
193 for j := 0 to uComponents.Count-1 do
194 if StrToInt(piece(uComponents[j],'^',1)) =
195 PHSCompRec(Items.Objects[i])^.ID then
196 uHSComponents.Add(PHSCompRec(Items.Objects[i])^.Segment + '^' +
197 PHSCompRec(Items.Objects[i])^.OccuranceLimit + '^' +
198 PHSCompRec(Items.Objects[i])^.TimeLimit + '^' +
199 PHSCompRec(Items.Objects[i])^.Header + '^' +
200 PHSCompRec(Items.Objects[i])^.HospitalLocation + '^' +
201 PHSCompRec(Items.Objects[i])^.ICDText + '^' +
202 PHSCompRec(Items.Objects[i])^.ProviderNarrative + '^' +
203 uComponents[j]);
204 end;
205 end;
206 end;
207 if uHSComponents.Count > 0 then
208 begin
209 HSReportText(uLocalReportData, uHSComponents);
210 Close;
211 end
212 else
213 Application.MessageBox(
214 'Sorry, no Components have been selected',
215 'Selection Error',MB_OK + MB_DEFBUTTON1);
216end;
217
218procedure TfrmReportsAdhocComponent1.FormClose(Sender: TObject; var Action: TCloseAction);
219var
220 aParam: integer;
221begin
222 aParam := 1;
223 if rbtnName.Checked = true then
224 aParam := 0
225 else if rbtnAbbrev.Checked = true then
226 aParam := 1
227 else if rbtnHeader.Checked = true then
228 aParam := 2;
229 SetAdhocLookup(aParam);
230 uComponents.Free;
231end;
232
233procedure TfrmReportsAdhocComponent1.HideEdits;
234begin
235 lblTimeLimit.Enabled := False;
236 lblOccuranceLimit.Enabled := False;
237 cboTimeLimit.Enabled := False;
238 edtOccuranceLimit.Enabled := False;
239 gpbDisplay.Enabled := False;
240 ckbHospitalLocation.Enabled := False;
241 ckbProviderNarrative.Enabled := False;
242 lblICD.Enabled := False;
243 cboICD.Enabled := False;
244 lblItems.Enabled := False;
245 ORListBox1.Enabled := False;
246 btnEditSubitems.Enabled := False;
247 cboTimeLimit.Text := '';
248 edtOccuranceLimit.Text := '';
249 ckbHospitalLocation.Checked := False;
250 ckbProviderNarrative.Checked := False;
251 cboICD.Text := '';
252end;
253
254procedure TfrmReportsAdhocComponent1.ORListBox2Click(Sender: TObject);
255var
256 i: integer;
257 a: string;
258 uHSCompFiles: TStringList;
259begin
260 HideEdits;
261 with ORListBox2 do
262 a := PHSCompRec(Items.Objects[ItemIndex])^.Segment;
263 uHSCompFiles := TStringList.Create;
264 HSComponentFiles(uHSCompFiles,Piece(a,';',2));
265 If uHSCompFiles.Count > 0 then
266 begin
267 uFile := Piece(uHSCompFiles.Strings[0],'^',3);
268 If Length(uFile) > 0 then
269 begin
270 lblItems.Enabled := True;
271 ORListBox1.Enabled := True;
272 btnEditSubItems.Enabled := True;
273 end;
274 end;
275 uHSCompFiles.Free;
276 with ORListBox2 do
277 begin
278 if length(Piece(Items[ItemIndex],'^',5))>0 then
279 begin
280 edtHeaderName.Text := PHSCompRec(Items.Objects[ItemIndex])^.Header;
281 edtHeaderName.Enabled := True;
282 lblHeaderName.Enabled := True;
283 end;
284 if length(Piece(Items[ItemIndex],'^',3))>0 then
285 begin
286 edtOccuranceLimit.Text :=
287 PHSCompRec(Items.Objects[ItemIndex])^.OccuranceLimit;
288 edtOccuranceLimit.Enabled := True;
289 lblOccuranceLimit.Enabled := True;
290 end;
291 if length(Piece(Items[ItemIndex],'^',4))>0 then
292 begin
293 cboTimeLimit.Text :=
294 PHSCompRec(Items.Objects[ItemIndex])^.TimeLimit;
295 cboTimeLimit.Enabled := True;
296 lblTimeLimit.Enabled := True;
297 end;
298 if length(Piece(Items[ItemIndex],'^',6))>0 then
299 begin
300 gpbDisplay.Enabled := True;
301 ckbHospitalLocation.Enabled := True;
302 if PHSCompRec(Items.Objects[ItemIndex])^.HospitalLocation = 'Y'
303 then ckbHospitalLocation.Checked := True
304 else
305 ckbHospitalLocation.Checked := False;
306 end;
307 if length(Piece(Items[ItemIndex],'^',7))>0 then
308 begin
309 gpbDisplay.Enabled := True;
310 lblICD.Enabled := True;
311 cboICD.Enabled := True;
312 cboICD.Text := PHSCompRec(Items.Objects[ItemIndex])^.ICDText;
313 end;
314 if length(Piece(Items[ItemIndex],'^',8))>0 then
315 begin
316 gpbDisplay.Enabled := True;
317 ckbProviderNarrative.Enabled := True;
318 if PHSCompRec(Items.Objects[ItemIndex])^.ProviderNarrative = 'Y'
319 then ckbProviderNarrative.Checked := True
320 else
321 ckbProviderNarrative.Checked := False;
322 end;
323 uCurrentComponent := PHSCompRec(Items.Objects[ItemIndex])^.ID;
324 end;
325 ORListBox1.Clear;
326 for i := 0 to uComponents.Count-1 do
327 if piece(uComponents[i],'^',1) = IntToStr(uCurrentComponent) then
328 ORListBox1.Items.Add(Pieces(uComponents[i],'^',3,10));
329 if ORListBox1.Items.Count > 0 then
330 begin
331 lblItems.Enabled := True;
332 ORListBox1.Enabled := True;
333 btnEditSubItems.Enabled := True;
334 end;
335end;
336
337procedure TfrmReportsAdhocComponent1.btnRemoveComponentClick(Sender: TObject);
338var
339 i: integer;
340 chk: integer;
341begin
342 HideEdits;
343 edtHeaderName.Text := '';
344 edtHeaderName.Enabled := False;
345 lblHeaderName.Enabled := False;
346 chk := 0;
347 ORListBox1.Clear;
348 If ORListBox2.Items.Count < 1 then
349 begin
350 InfoBox('There are no items to remove.', 'Information', MB_OK or MB_ICONINFORMATION);
351 Exit;
352 end
353 else
354 for i := 0 to ORListBox2.Items.Count - 1 do
355 if ORListBox2.Selected[i] then
356 chk := 1;
357 if chk = 0 then
358 begin
359 InfoBox('Please select the item you wish to remove', 'Information', MB_OK or MB_ICONINFORMATION);
360 Exit;
361 end;
362 With ORListBox2 do
363 begin
364 for i := uComponents.Count-1 downto 0 do
365 if piece(uComponents[i],'^',1) = IntToStr(uCurrentComponent) then
366 uComponents.Delete(i);
367 Items.Delete(ItemIndex);
368 if Items.Count < 1 then
369 begin
370 SpeedButton5.Enabled := false;
371 SpeedButton6.Enabled := false;
372 end;
373 end;
374end;
375
376procedure TfrmReportsAdhocComponent1.btnRemoveAllComponentsClick(Sender: TObject);
377
378var
379 i: integer;
380begin
381 HideEdits;
382 edtHeaderName.Text := '';
383 edtHeaderName.Enabled := False;
384 lblHeaderName.Enabled := False;
385 ORListBox1.Clear;
386 If ORListBox2.Items.Count < 1 then
387 begin
388 InfoBox('There are no items to remove.', 'Information', MB_OK or MB_ICONINFORMATION);
389 Exit;
390 end;
391 if InfoBox('This button will remove all selected components. OK?',
392 'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then
393 begin
394 With ORListBox2 do
395 begin
396 for i := uComponents.Count-1 downto 0 do
397 uComponents.Delete(i);
398 for i := Items.Count-1 downto 0 do
399 Items.Delete(i);
400 end;
401 SpeedButton5.Enabled := false;
402 SpeedButton6.Enabled := false;
403 end;
404end;
405
406procedure TfrmReportsAdhocComponent1.Splitter4CanResize(Sender: TObject; var NewSize: Integer;
407 var Accept: Boolean);
408begin
409 if NewSize < 50 then
410 NewSize := 50;
411end;
412
413procedure TfrmReportsAdhocComponent1.Splitter1CanResize(Sender: TObject; var NewSize: Integer;
414 var Accept: Boolean);
415begin
416 if NewSize < 50 then
417 NewSize := 50;
418end;
419
420procedure TfrmReportsAdhocComponent1.btnAddComponentClick(Sender: TObject);
421var
422 HSCompPtr: PHSCompRec;
423 i: Integer;
424 uHSCompFiles: TStringList;
425 uCompSubs: TStringList;
426begin
427 If ORComboBox1.ItemIndex < 0 then
428 begin
429 InfoBox('Please select a component to Add.', 'Information', MB_OK or MB_ICONINFORMATION);
430 Exit;
431 end;
432 ORListBox1.Clear;
433 HideEdits;
434 New(HSCompPtr);
435 HSCompCtr := HSCompCtr + 1;
436 HSCompPtr^.ID := HSCompCtr;
437 uLimit := 0;
438 with ORComboBox1 do
439 begin
440 HSCompPtr^.Segment := Piece(Items[ItemIndex],'^',1);
441 HSCompPtr^.Name := Piece(Items[ItemIndex],'^',2);
442 HSCompPtr^.OccuranceLimit := Piece(Items[ItemIndex],'^',3);
443 HSCompPtr^.TimeLimit := UpperCase(Piece(Items[ItemIndex],'^',4));
444 HSCompPtr^.Header := Piece(Items[ItemIndex],'^',5);
445 HSCompPtr^.HospitalLocation := Piece(Items[ItemIndex],'^',6);
446 HSCompPtr^.ICDText := Piece(Items[ItemIndex],'^',7);
447 HSCompPtr^.ProviderNarrative := Piece(Items[ItemIndex],'^',8);
448 uCurrentComponent := HSCompCtr;
449 end;
450 with ORListBox2 do
451 begin
452 Items.AddObject(
453 ORComboBox1.Items[ORComboBox1.ItemIndex],TObject(HSCompPtr));
454 ItemIndex := Items.Count-1;
455 SpeedButton5.Enabled := true;
456 SpeedButton6.Enabled := true;
457 end;
458 uHSCompFiles := TStringList.Create;
459 uCompSubs := TStringList.Create;
460 HSComponentFiles(uHSCompFiles, Piece(HSCompPtr^.Segment,';',2));
461 If uHSCompFiles.Count > 0 then
462 begin
463 uFile := Piece(uHSCompFiles.Strings[0],'^',3);
464 If Length(Piece(uHSCompFiles.Strings[0],'^',4)) > 0 then
465 uLimit := StrToInt(Piece(uHSCompFiles.Strings[0],'^',4));
466 If Length(uFile) > 0 then
467 begin
468 lblItems.Enabled := True;
469 ORListBox1.Enabled := True;
470 btnEditSubItems.Enabled := True;
471 HSComponentSubs(uCompSubs, Piece(HSCompPtr^.Segment,';',1));
472 If uCompSubs.Count > 0 then
473 begin
474 ORListBox1.Clear;
475 ORListBox1.Items.Assign(uCompSubs);
476 for i := 0 to uCompSubs.Count-1 do
477 uComponents.Add(IntToStr(uCurrentComponent) + '^' + uFile +
478 '^' + uCompSubs[i]);
479 end
480 Else
481 If ExecuteForm2 = True then
482 begin
483 ORListBox1.Clear;
484 for i := 0 to uComponents.Count-1 do
485 if piece(uComponents[i],'^',1) = IntToStr(uCurrentComponent) then
486 ORListBox1.Items.Add(Pieces(uComponents[i],'^',3,10));
487 if ORListBox1.Items.Count < 1 then
488 begin
489 InfoBox('No sub-items were selected', 'Information', MB_OK or MB_ICONINFORMATION);
490 end;
491 end
492 else
493 begin
494 InfoBox('No sub-items were selected', 'Information', MB_OK or MB_ICONINFORMATION);
495 end;
496 end;
497 end;
498 with ORComboBox1 do
499 begin
500 if length(Piece(Items[ItemIndex],'^',5))>0 then
501 begin
502 edtHeaderName.Text := Piece(Items[ItemIndex],'^',5);
503 edtHeaderName.Enabled := True;
504 lblHeaderName.Enabled := True;
505 end;
506 if length(Piece(Items[ItemIndex],'^',3))>0 then
507 begin
508 edtOccuranceLimit.Text := Piece(Items[ItemIndex],'^',3);
509 edtOccuranceLimit.Enabled := True;
510 lblOccuranceLimit.Enabled := True;
511 end;
512 if length(Piece(Items[ItemIndex],'^',4))>0 then
513 begin
514 cboTimeLimit.Text := Piece(Items[ItemIndex],'^',4);
515 cboTimeLimit.Enabled := True;
516 lblTimeLimit.Enabled := True;
517 end;
518 if length(Piece(Items[ItemIndex],'^',6))>0 then
519 begin
520 gpbDisplay.Enabled := True;
521 ckbHospitalLocation.Enabled := True;
522 if Piece(Items[ItemIndex],'^',6) = 'Y' then
523 ckbHospitalLocation.Checked := True;
524 end;
525 if length(Piece(Items[ItemIndex],'^',7))>0 then
526 begin
527 gpbDisplay.Enabled := True;
528 lblICD.Enabled := True;
529 cboICD.Enabled := True;
530 if Piece(Items[ItemIndex],'^',7) = 'L' then
531 cboICD.Text := 'Long text';
532 if Piece(Items[ItemIndex],'^',7) = 'S' then
533 cboICD.Text := 'Short text';
534 if Piece(Items[ItemIndex],'^',7) = 'C' then
535 cboICD.Text := 'Code only';
536 if Piece(Items[ItemIndex],'^',7) = 'T' then
537 cboICD.Text := 'Text only';
538 if Piece(Items[ItemIndex],'^',7) = 'N' then
539 cboICD.Text := 'None';
540 end;
541 if length(Piece(Items[ItemIndex],'^',8))>0 then
542 begin
543 gpbDisplay.Enabled := True;
544 ckbProviderNarrative.Enabled := True;
545 if Piece(Items[ItemIndex],'^',8) = 'Y' then
546 ckbProviderNarrative.Checked := True;
547 end;
548 end;
549 uHSCompFiles.Free;
550 uCompSubs.Free;
551end;
552
553procedure TfrmReportsAdhocComponent1.SpeedButton5Click(Sender: TObject);
554var
555 i:integer;
556begin
557 if SpeedButton5.Enabled then
558 with ORListBox2 do
559 if ItemIndex > 0 then
560 begin
561 i := ItemIndex;
562 Items.Move(i, i-1);
563 ItemIndex := i-1;
564 end;
565end;
566
567procedure TfrmReportsAdhocComponent1.SpeedButton6Click(Sender: TObject);
568var
569 i : Integer;
570begin
571 if SpeedButton6.Enabled then
572 with ORListbox2 do
573 if (ItemIndex < Items.Count-1) and
574 (ItemIndex <> -1) then
575 begin
576 i := ItemIndex;
577 Items.Move(i, i+1);
578 ItemIndex := i+1;
579 end;
580end;
581
582procedure TfrmReportsAdhocComponent1.ORListBox2DragOver(Sender, Source: TObject; X, Y: Integer;
583 State: TDragState; var Accept: Boolean);
584begin
585 Accept := (Sender = Source) and
586 (TORListBox(Sender).ItemAtPos(Point(x,y), False) >= 0);
587 if Accept then
588 with Sender as TORListbox do
589 if Y > Height - ItemHeight then
590 begin
591 GoingUp := False;
592 Timer1.Enabled := True;
593 end
594 else if Y < ItemHeight then
595 begin
596 GoingUp := True;
597 Timer1.Enabled := True;
598 end
599 else Timer1.Enabled := False;
600end;
601
602procedure TfrmReportsAdhocComponent1.ORListBox2DragDrop(Sender, Source: TObject; X,
603 Y: Integer);
604var
605 NuPos: Integer;
606begin
607 with Sender as TORListbox do
608 begin
609 NuPos := ItemAtPos(Point(X,Y),False);
610 If NuPos >= Items.Count then Dec(NuPos);
611 Items.Move(ItemIndex, NuPos);
612 ItemIndex := NuPos;
613 end;
614end;
615
616procedure TfrmReportsAdhocComponent1.ORListBox2EndDrag(Sender, Target: TObject; X, Y: Integer);
617begin
618 if (Sender = ORListBox2) and (Target = ORComboBox1) then
619 btnRemoveComponentClick(nil);
620 Timer1.Enabled := False;
621end;
622
623procedure TfrmReportsAdhocComponent1.Timer1Timer(Sender: TObject);
624begin
625 with ORListBox2 do
626 if GoingUp then
627 if TopIndex > 0 then TopIndex := TopIndex - 1
628 else Timer1.Enabled := False
629 else
630 if TopIndex < Items.Count - 1 then TopIndex := TopIndex + 1
631 else Timer1.Enabled := False;
632end;
633
634procedure TfrmReportsAdhocComponent1.btnEditSubitemsClick(Sender: TObject);
635var
636 i: integer;
637begin
638 If ExecuteForm2 = True then
639 begin
640 lblItems.Enabled := False;
641 ORListBox1.Enabled := False;
642 ORListBox1.Clear;
643 for i := 0 to uComponents.Count-1 do
644 if piece(uComponents[i],'^',1) = IntToStr(uCurrentComponent) then
645 ORListBox1.Items.Add(Pieces(uComponents[i],'^',3,10));
646 if ORListBox1.Items.Count > 0 then
647 begin
648 lblItems.Enabled := True;
649 ORListBox1.Enabled := True;
650 btnEditSubItems.Enabled := True;
651 end;
652 end;
653end;
654
655procedure TfrmReportsAdhocComponent1.edtHeaderNameExit(Sender: TObject);
656var
657 i: integer;
658begin
659 for i := 0 to ORListBox2.Items.Count - 1 do
660 if PHSCompRec(ORListBox2.Items.Objects[i])^.ID = uCurrentComponent then
661 PHSCompRec(ORListBox2.Items.Objects[i])^.Header :=
662 edtHeaderName.Text;
663end;
664
665procedure TfrmReportsAdhocComponent1.edtOccuranceLimitExit(
666 Sender: TObject);
667var
668 i: integer;
669begin
670 for i := 0 to ORListBox2.Items.Count - 1 do
671 if PHSCompRec(ORListBox2.Items.Objects[i])^.ID = uCurrentComponent then
672 PHSCompRec(ORListBox2.Items.Objects[i])^.OccuranceLimit :=
673 edtOccuranceLimit.Text;
674end;
675
676procedure TfrmReportsAdhocComponent1.cboTimeLimitExit(Sender: TObject);
677var
678 i: integer;
679begin
680 if cboTimeLimit.Text = 'No Limit' then
681 cboTimeLimit.Text := '99Y';
682 for i := 0 to ORListBox2.Items.Count - 1 do
683 if PHSCompRec(ORListBox2.Items.Objects[i])^.ID = uCurrentComponent then
684 PHSCompRec(ORListBox2.Items.Objects[i])^.TimeLimit :=
685 cboTimeLimit.Text;
686end;
687
688procedure TfrmReportsAdhocComponent1.ckbHospitalLocationExit(
689 Sender: TObject);
690var
691 i: integer;
692begin
693 for i := 0 to ORListBox2.Items.Count - 1 do
694 if PHSCompRec(ORListBox2.Items.Objects[i])^.ID = uCurrentComponent then
695 if ckbHospitalLocation.Checked = True then
696 PHSCompRec(ORListBox2.Items.Objects[i])^.HospitalLocation := 'Y'
697 else
698 PHSCompRec(ORListBox2.Items.Objects[i])^.HospitalLocation := 'N';
699end;
700
701procedure TfrmReportsAdhocComponent1.ckbProviderNarrativeExit(
702 Sender: TObject);
703var
704 i: integer;
705begin
706 for i := 0 to ORListBox2.Items.Count - 1 do
707 if PHSCompRec(ORListBox2.Items.Objects[i])^.ID = uCurrentComponent then
708 if ckbProviderNarrative.Checked = True then
709 PHSCompRec(ORListBox2.Items.Objects[i])^.ProviderNarrative := 'Y'
710 else
711 PHSCompRec(ORListBox2.Items.Objects[i])^.ProviderNarrative := 'N';
712end;
713
714procedure TfrmReportsAdhocComponent1.cboICDExit(Sender: TObject);
715var
716 i: integer;
717begin
718 for i := 0 to ORListBox2.Items.Count - 1 do
719 if PHSCompRec(ORListBox2.Items.Objects[i])^.ID = uCurrentComponent then
720 PHSCompRec(ORListBox2.Items.Objects[i])^.ICDText := cboICD.Text;
721end;
722
723procedure TfrmReportsAdhocComponent1.ORComboBox1KeyDown(Sender: TObject;
724 var Key: Word; Shift: TShiftState);
725begin
726 //This used to be a KeyUp. I changed it because it can call up the component
727 //selection screen, which can be left with a return. Leaving the component
728 //screen happens on key down, so this screen gets focused and receives the key
729 //up message, so it pops up tyhe component screen again.
730 If Key = 13 then
731 with ORComboBox1 do
732 if (Text <> '') and (Items.IndexOf (Text) >= 0) then
733 begin
734 ItemIndex := Items.IndexOf(Text);
735 btnAddComponentClick(nil);
736 end;
737end;
738
739procedure TfrmReportsAdhocComponent1.LoadComponents(Dest: TStrings);
740var
741 sComponents: TStringList;
742 i: integer;
743 s: string;
744begin
745 sComponents := TStringList.Create;
746 if uListState = 0 then
747 begin
748 HSComponents(sComponents);
749 for i := 0 to sComponents.Count - 1 do
750 begin
751 s := sComponents.Strings[i];
752 s := MixedCase(piece(s,'[',1)) + '[' + piece(s,'[',2);
753 sComponents.Strings[i] := s;
754 end;
755 end
756 else if uListState = 1 then
757 begin
758 HSABVComponents(sComponents);
759 for i := 0 to sComponents.Count - 1 do
760 begin
761 s := sComponents.Strings[i];
762 s := piece(s,'-',1) + '-' + MixedCase(piece(s,'-',2));
763 sComponents.Strings[i] := s;
764 end;
765 end
766 else if uListState = 2 then
767 begin
768 HSDispComponents(sComponents);
769 for i := 0 to sComponents.Count - 1 do
770 begin
771 s := sComponents.Strings[i];
772 s := MixedCase(piece(s,'[',1)) + '[' + piece(s,'[',2);
773 sComponents.Strings[i] := s;
774 end;
775 end;
776 QuickCopy(sComponents,Dest);
777 sComponents.Free;
778end;
779
780procedure TfrmReportsAdhocComponent1.rbtnAbbrevClick(Sender: TObject);
781begin
782 inherited;
783 uListState := 1;
784 ORComboBox1.Clear;
785 LoadComponents(ORComboBox1.Items);
786 ORComboBox1.SetFocus;
787end;
788
789procedure TfrmReportsAdhocComponent1.rbtnNameClick(Sender: TObject);
790begin
791 inherited;
792 uListState := 0;
793 ORComboBox1.Clear;
794 LoadComponents(ORComboBox1.Items);
795 ORComboBox1.SetFocus;
796end;
797
798procedure TfrmReportsAdhocComponent1.rbtnHeaderClick(Sender: TObject);
799begin
800 inherited;
801 uListState := 2;
802 ORComboBox1.Clear;
803 LoadComponents(ORComboBox1.Items);
804 ORComboBox1.SetFocus;
805end;
806
807procedure TfrmReportsAdhocComponent1.pnl5ButtonEnter(Sender: TObject);
808begin
809 inherited;
810 (Sender as TPanel).BevelOuter := bvRaised;
811end;
812
813procedure TfrmReportsAdhocComponent1.pnl5ButtonExit(Sender: TObject);
814begin
815 inherited;
816 (Sender as TPanel).BevelOuter := bvNone;
817end;
818
819end.
Note: See TracBrowser for help on using the repository browser.