Module

fReportsAdhocComponent1

Path

C:\CPRS\CPRS30\fReportsAdhocComponent1.pas

Last Modified

7/15/2014 3:26:38 PM

Units Used in Interface

Name Comments
fAutoSz -

Units Used in Implementation

Name Comments
fReports -
fReportsAdhocSubItem1 -
rReports -
uCore -

Classes

Name Comments
TfrmReportsAdhocComponent1 -
THSCompRec -

Procedures

Name Owner Declaration Scope Comments
btnAddComponentClick TfrmReportsAdhocComponent1 procedure btnAddComponentClick(Sender: TObject); Public/Published -
btnCancelMainClick TfrmReportsAdhocComponent1 procedure btnCancelMainClick(Sender: TObject); Public/Published -
btnEditSubitemsClick TfrmReportsAdhocComponent1 procedure btnEditSubitemsClick(Sender: TObject); Public/Published -
btnOKMainClick TfrmReportsAdhocComponent1 procedure btnOKMainClick(Sender: TObject); Public/Published -
btnRemoveAllComponentsClick TfrmReportsAdhocComponent1 procedure btnRemoveAllComponentsClick(Sender: TObject); Public/Published -
btnRemoveComponentClick TfrmReportsAdhocComponent1 procedure btnRemoveComponentClick(Sender: TObject); Public/Published -
cboICDExit TfrmReportsAdhocComponent1 procedure cboICDExit(Sender: TObject); Public/Published -
cboTimeLimitExit TfrmReportsAdhocComponent1 procedure cboTimeLimitExit(Sender: TObject); Public/Published -
ckbHospitalLocationExit TfrmReportsAdhocComponent1 procedure ckbHospitalLocationExit(Sender: TObject); Public/Published -
ckbProviderNarrativeExit TfrmReportsAdhocComponent1 procedure ckbProviderNarrativeExit(Sender: TObject); Public/Published -
edtHeaderNameExit TfrmReportsAdhocComponent1 procedure edtHeaderNameExit(Sender: TObject); Public/Published -
edtOccuranceLimitExit TfrmReportsAdhocComponent1 procedure edtOccuranceLimitExit(Sender: TObject); Public/Published -
FormClose TfrmReportsAdhocComponent1 procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormCreate TfrmReportsAdhocComponent1 procedure FormCreate(Sender: TObject); Public/Published -
FormShow TfrmReportsAdhocComponent1 procedure FormShow(Sender: TObject); Public/Published -
HideEdits TfrmReportsAdhocComponent1 procedure HideEdits; Public/Published -
LoadComponents TfrmReportsAdhocComponent1 procedure LoadComponents(Dest: TStrings); Public/Published -
ORComboBox1KeyDown TfrmReportsAdhocComponent1 procedure ORComboBox1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
ORListBox2Click TfrmReportsAdhocComponent1 procedure ORListBox2Click(Sender: TObject); Public/Published -
ORListBox2DragDrop TfrmReportsAdhocComponent1 procedure ORListBox2DragDrop(Sender, Source: TObject; X, Y: Integer); Public/Published -
ORListBox2DragOver TfrmReportsAdhocComponent1 procedure ORListBox2DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); Public/Published -
ORListBox2EndDrag TfrmReportsAdhocComponent1 procedure ORListBox2EndDrag(Sender, Target: TObject; X, Y: Integer); Public/Published -
pnl5ButtonEnter TfrmReportsAdhocComponent1 procedure pnl5ButtonEnter(Sender: TObject); Public/Published -
pnl5ButtonExit TfrmReportsAdhocComponent1 procedure pnl5ButtonExit(Sender: TObject); Public/Published -
rbtnAbbrevClick TfrmReportsAdhocComponent1 procedure rbtnAbbrevClick(Sender: TObject); Public/Published -
rbtnHeaderClick TfrmReportsAdhocComponent1 procedure rbtnHeaderClick(Sender: TObject); Public/Published -
rbtnNameClick TfrmReportsAdhocComponent1 procedure rbtnNameClick(Sender: TObject); Public/Published -
SpeedButton5Click TfrmReportsAdhocComponent1 procedure SpeedButton5Click(Sender: TObject); Public/Published -
SpeedButton6Click TfrmReportsAdhocComponent1 procedure SpeedButton6Click(Sender: TObject); Public/Published -
Splitter1CanResize TfrmReportsAdhocComponent1 procedure Splitter1CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); Public/Published -
Splitter4CanResize TfrmReportsAdhocComponent1 procedure Splitter4CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); Public/Published -
Timer1Timer TfrmReportsAdhocComponent1 procedure Timer1Timer(Sender: TObject); Public/Published -

Functions

Name Owner Declaration Scope Comments
ExecuteAdhoc1 - function ExecuteAdhoc1: Boolean; Interfaced -

Global Variables

Name Type Declaration Comments
frmReportsAdhocComponent1 TfrmReportsAdhocComponent1 frmReportsAdhocComponent1: TfrmReportsAdhocComponent1; -
HSCompCtr Integer HSCompCtr: integer; Component ID
uComponents TStringList uComponents: TStringList; {This is what is built as SubItems are
This is what is built as SubItems are
                                selected.  It is identified by segment
                                and is ordered in the order that the items
                                have been selected or moved by the user.
                                Segment^file #^ifn of file^zero node of file
uCurrentComponent Integer uCurrentComponent: Integer; Pointer to current Component ID
uFile UnicodeString uFile: String; Mumps file Number of Subitems
uLimit Integer uLimit: Integer; HS Component Subitem Selection limit
uLimitCount Integer uLimitCount: Integer; Count of current Subitem Selections


Module Source

1     unit fReportsAdhocComponent1;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       ExtCtrls, StdCtrls, Grids, ORCtrls, ORfn, Buttons, fAutoSz,
8       VA508AccessibilityManager;
9     
10    type
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    
93    var
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   
108   implementation
109   
110   uses fReportsAdhocSubItem1, fReports, uCore, rReports;
111   
112   {$R *.DFM}
113   type
114   PHSCompRec = ^THSCompRec;
115   THSCompRec = 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   
127   end;
128   
129   function ExecuteAdhoc1: Boolean;
130   begin
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;
141   end;
142   
143   procedure TfrmReportsAdhocComponent1.FormCreate(Sender: TObject);
144   
145   begin
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;
160   end;
161   
162   procedure TfrmReportsAdhocComponent1.FormShow(Sender: TObject);
163   begin
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);
169   end;
170   
171   procedure TfrmReportsAdhocComponent1.btnCancelMainClick(Sender: TObject);
172   begin
173     Close;
174   end;
175   
176   procedure TfrmReportsAdhocComponent1.btnOKMainClick(Sender: TObject);
177   var
178     i,j: integer;
179   begin
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);
217   end;
218   
219   procedure TfrmReportsAdhocComponent1.FormClose(Sender: TObject; var Action: TCloseAction);
220   var
221     aParam: integer;
222   begin
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;
232   end;
233   
234   procedure TfrmReportsAdhocComponent1.HideEdits;
235   begin
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 := '';
253   end;
254   
255   procedure TfrmReportsAdhocComponent1.ORListBox2Click(Sender: TObject);
256   var
257     i: integer;
258     a: string;
259     uHSCompFiles: TStringList;
260   begin
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;
336   end;
337   
338   procedure TfrmReportsAdhocComponent1.btnRemoveComponentClick(Sender: TObject);
339   var
340     i: integer;
341     chk: integer;
342   begin
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;
375   end;
376   
377   procedure TfrmReportsAdhocComponent1.btnRemoveAllComponentsClick(Sender: TObject);
378   
379   var
380     i: integer;
381   begin
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;
405   end;
406   
407   procedure TfrmReportsAdhocComponent1.Splitter4CanResize(Sender: TObject; var NewSize: Integer;
408     var Accept: Boolean);
409   begin
410     if NewSize < 50 then
411       NewSize := 50;
412   end;
413   
414   procedure TfrmReportsAdhocComponent1.Splitter1CanResize(Sender: TObject; var NewSize: Integer;
415     var Accept: Boolean);
416   begin
417     if NewSize < 50 then
418       NewSize := 50;
419   end;
420   
421   procedure TfrmReportsAdhocComponent1.btnAddComponentClick(Sender: TObject);
422   var
423     HSCompPtr: PHSCompRec;
424     i: Integer;
425     uHSCompFiles: TStringList;
426     uCompSubs: TStringList;
427   begin
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;
552   end;
553   
554   procedure TfrmReportsAdhocComponent1.SpeedButton5Click(Sender: TObject);
555   var
556     i:integer;
557   begin
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;
566   end;
567   
568   procedure TfrmReportsAdhocComponent1.SpeedButton6Click(Sender: TObject);
569   var
570     i : Integer;
571   begin
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;
581   end;
582   
583   procedure TfrmReportsAdhocComponent1.ORListBox2DragOver(Sender, Source: TObject; X, Y: Integer;
584     State: TDragState; var Accept: Boolean);
585   begin
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;
601   end;
602   
603   procedure TfrmReportsAdhocComponent1.ORListBox2DragDrop(Sender, Source: TObject; X,
604     Y: Integer);
605   var
606     NuPos: Integer;
607   begin
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;
615   end;
616   
617   procedure TfrmReportsAdhocComponent1.ORListBox2EndDrag(Sender, Target: TObject; X, Y: Integer);
618   begin
619     if (Sender = ORListBox2) and (Target = ORComboBox1) then
620       btnRemoveComponentClick(nil);
621     Timer1.Enabled := False;
622   end;
623   
624   procedure TfrmReportsAdhocComponent1.Timer1Timer(Sender: TObject);
625   begin
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;
633   end;
634   
635   procedure TfrmReportsAdhocComponent1.btnEditSubitemsClick(Sender: TObject);
636   var
637     i: integer;
638   begin
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;
654   end;
655   
656   procedure TfrmReportsAdhocComponent1.edtHeaderNameExit(Sender: TObject);
657   var
658     i: integer;
659   begin
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;
664   end;
665   
666   procedure TfrmReportsAdhocComponent1.edtOccuranceLimitExit(
667     Sender: TObject);
668   var
669     i: integer;
670   begin
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;
675   end;
676   
677   procedure TfrmReportsAdhocComponent1.cboTimeLimitExit(Sender: TObject);
678   var
679     i: integer;
680   begin
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;
687   end;
688   
689   procedure TfrmReportsAdhocComponent1.ckbHospitalLocationExit(
690     Sender: TObject);
691   var
692     i: integer;
693   begin
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';
700   end;
701   
702   procedure TfrmReportsAdhocComponent1.ckbProviderNarrativeExit(
703     Sender: TObject);
704   var
705     i: integer;
706   begin
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';
713   end;
714   
715   procedure TfrmReportsAdhocComponent1.cboICDExit(Sender: TObject);
716   var
717     i: integer;
718   begin
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;
722   end;
723   
724   procedure TfrmReportsAdhocComponent1.ORComboBox1KeyDown(Sender: TObject;
725     var Key: Word; Shift: TShiftState);
726   begin
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;
738   end;
739   
740   procedure TfrmReportsAdhocComponent1.LoadComponents(Dest: TStrings);
741   var
742     sComponents: TStringList;
743     i: integer;
744     s: string;
745   begin
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;
779   end;
780   
781   procedure TfrmReportsAdhocComponent1.rbtnAbbrevClick(Sender: TObject);
782   begin
783     inherited;
784     uListState := 1;
785     ORComboBox1.Clear;
786     LoadComponents(ORComboBox1.Items);
787     ORComboBox1.SetFocus;
788   end;
789   
790   procedure TfrmReportsAdhocComponent1.rbtnNameClick(Sender: TObject);
791   begin
792     inherited;
793     uListState := 0;
794     ORComboBox1.Clear;
795     LoadComponents(ORComboBox1.Items);
796     ORComboBox1.SetFocus;
797   end;
798   
799   procedure TfrmReportsAdhocComponent1.rbtnHeaderClick(Sender: TObject);
800   begin
801     inherited;
802     uListState := 2;
803     ORComboBox1.Clear;
804     LoadComponents(ORComboBox1.Items);
805     ORComboBox1.SetFocus;
806   end;
807   
808   procedure TfrmReportsAdhocComponent1.pnl5ButtonEnter(Sender: TObject);
809   begin
810     inherited;
811     (Sender as TPanel).BevelOuter := bvRaised;
812   end;
813   
814   procedure TfrmReportsAdhocComponent1.pnl5ButtonExit(Sender: TObject);
815   begin
816     inherited;
817     (Sender as TPanel).BevelOuter := bvNone;
818   end;
819   
820   end.

Module Calls (2 levels)


fReportsAdhocComponent1
 ├fAutoSz
 │ └fBase508Form
 ├fReportsAdhocSubItem1
 │ ├fAutoSz...
 │ ├fReportsAdhocComponent1...
 │ └rReports
 ├fReports
 │ ├fHSplit
 │ ├uConst
 │ ├rECS
 │ ├fBase508Form...
 │ ├rCore
 │ ├rReports...
 │ ├fFrame
 │ ├uCore
 │ ├uReports
 │ ├fReportsPrint
 │ ├fReportsAdhocComponent1...
 │ ├dShared
 │ ├fGraphs
 │ └fGraphData
 └rReports...

Module Called-By (2 levels)


       fReportsAdhocComponent1
                    fReports┤ 
                    fFrame┤ │ 
                    fProbs┤ │ 
             fReportsPrint┤ │ 
fReportsAdhocComponent1...┤ │ 
                   fGraphs┤ │ 
     fOptionsReportsCustom┤ │ 
    fOptionsReportsDefault┘ │ 
       fReportsAdhocSubItem1┘ 
fReportsAdhocComponent1...┘