source: cprs/branches/tmg-cprs/CPRS-Chart/fReportsAdhocComponent1.pas@ 466

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

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