source: cprs/branches/tmg-cprs/CPRS-Chart/Encounter/fExam.pas@ 1620

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

Initial upload of TMG-CPRS 1.0.26.69

File size: 2.5 KB
Line 
1//kt -- Modified with SourceScanner on 8/8/2007
2unit fExam;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 fPCEBase, StdCtrls, ORCtrls, CheckLst, ExtCtrls, Buttons, uPCE, rPCE, ORFn,
9 fPCELex, fPCEOther, ComCtrls, fPCEBaseMain, DKLang;
10
11type
12 TfrmExams = class(TfrmPCEBaseMain)
13 lblExamResults: TLabel;
14 cboExamResults: TORComboBox;
15 procedure cboExamResultsChange(Sender: TObject);
16 procedure FormCreate(Sender: TObject);
17 private
18 protected
19 procedure UpdateNewItemStr(var x: string); override;
20 procedure UpdateControls; override;
21 public
22 end;
23
24var
25 frmExams: TfrmExams;
26
27implementation
28
29{$R *.DFM}
30
31uses
32 fEncounterFrame;
33
34procedure TfrmExams.cboExamResultsChange(Sender: TObject);
35var
36 i: integer;
37
38begin
39 if(NotUpdating) and (cboExamResults.Text <> '') then
40 begin
41 for i := 0 to lbGrid.Items.Count-1 do
42 if(lbGrid.Selected[i]) then
43 TPCEExams(lbGrid.Items.Objects[i]).Results := cboExamResults.ItemID;
44 GridChanged;
45 end;
46end;
47
48procedure TfrmExams.FormCreate(Sender: TObject);
49begin
50 inherited;
51 FTabName := CT_XamNm;
52 FPCEListCodesProc := ListExamsCodes;
53 FPCEItemClass := TPCEExams;
54 FPCECode := 'XAM';
55 PCELoadORCombo(cboExamResults);
56end;
57
58procedure TfrmExams.UpdateNewItemStr(var x: string);
59begin
60 SetPiece(x, U, pnumExamResults, NoPCEValue);
61end;
62
63procedure TfrmExams.UpdateControls;
64var
65 ok, First: boolean;
66 SameR: boolean;
67 i: integer;
68 Res: string;
69 Obj: TPCEExams;
70
71begin
72 inherited;
73 if(NotUpdating) then
74 begin
75 BeginUpdate;
76 try
77 ok := (lbGrid.SelCount > 0);
78 lblExamResults.Enabled := ok;
79 cboExamResults.Enabled := ok;
80 if(ok) then
81 begin
82 First := TRUE;
83 SameR := TRUE;
84 Res := NoPCEValue;
85 for i := 0 to lbGrid.Items.Count-1 do
86 begin
87 if lbGrid.Selected[i] then
88 begin
89 Obj := TPCEExams(lbGrid.Items.Objects[i]);
90 if(First) then
91 begin
92 First := FALSE;
93 Res := Obj.Results;
94 end
95 else
96 begin
97 if(SameR) then
98 SameR := (Res = Obj.Results);
99 end;
100 end;
101 end;
102 if(SameR) then
103 cboExamResults.SelectByID(Res)
104 else
105 cboExamResults.Text := '';
106 end
107 else
108 begin
109 cboExamResults.Text := '';
110 end;
111 finally
112 EndUpdate;
113 end;
114 end;
115end;
116
117end.
118
Note: See TracBrowser for help on using the repository browser.