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

Last change on this file since 1641 was 793, checked in by Kevin Toppenberg, 15 years ago

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