source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/fReportsAdhocComponent1.pas@ 1679

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

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