source: cprs/branches/tmg-cprs/CPRS-Chart/Encounter/fSkinTest.pas@ 1742

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

Initial upload of TMG-CPRS 1.0.26.69

File size: 6.4 KB
Line 
1//kt -- Modified with SourceScanner on 8/8/2007
2unit fSkinTest;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 fPCEBase, ORCtrls, StdCtrls, ComCtrls, CheckLst, ExtCtrls, Buttons, uPCE, rPCE, ORFn,
9 fPCELex, fPCEOther, rCore, fPCEBaseMain, DKLang;
10
11type
12 TfrmSkinTests = class(TfrmPCEBaseMain)
13 lblSkinResults: TLabel;
14 lblDTRead: TLabel;
15 lblReading: TLabel;
16 lblDTGiven: TLabel;
17 UpDnReading: TUpDown;
18 EdtReading: TCaptionEdit;
19 edtDtRead: TCaptionEdit;
20 edtDTGiven: TCaptionEdit;
21 cboSkinResults: TORComboBox;
22 procedure cboSkinResultsChange(Sender: TObject);
23 procedure EdtReadingChange(Sender: TObject);
24 procedure edtDtReadChange(Sender: TObject);
25 procedure edtDTGivenChange(Sender: TObject);
26 procedure FormCreate(Sender: TObject);
27 procedure UpDnReadingChanging(Sender: TObject;
28 var AllowChange: Boolean);
29 private
30 protected
31 procedure UpdateNewItemStr(var x: string); override;
32 procedure UpdateControls; override;
33 public
34 end;
35
36var
37 frmSkinTests: TfrmSkinTests;
38
39implementation
40
41{$R *.DFM}
42
43uses
44 fEncounterFrame;
45
46procedure TfrmSkinTests.cboSkinResultsChange(Sender: TObject);
47var
48 i: integer;
49
50begin
51 if(NotUpdating) and (cboSkinResults.Text <> '') then
52 begin
53 for i := 0 to lbGrid.Items.Count-1 do
54 if(lbGrid.Selected[i]) then
55 TPCESkin(lbGrid.Items.Objects[i]).Results := cboSkinResults.ItemID;
56 GridChanged;
57 end;
58end;
59
60{///////////////////////////////////////////////////////////////////////////////
61//Name:procedure TfrmSkinTests.EdtReadingChange(Sender: TObject);
62//Created: Jan 1999
63//By: Robert Bott
64//Location: ISL
65//Description:Change the reading assigned to the skin test.
66///////////////////////////////////////////////////////////////////////////////}
67procedure TfrmSkinTests.EdtReadingChange(Sender: TObject);
68var
69 x, i: integer;
70
71begin
72 if(NotUpdating) then
73 begin
74 x := StrToIntDef(EdtReading.Text, 0);
75 for i := 0 to lbGrid.Items.Count-1 do
76 if(lbGrid.Selected[i]) then
77 TPCESkin(lbGrid.Items.Objects[i]).Reading := x;
78 GridChanged;
79 end;
80end;
81
82procedure TfrmSkinTests.edtDtReadChange(Sender: TObject);
83begin
84end;
85(*
86var
87 DtRead: TFMDateTime;
88 ASkinTest: TPCESkin;
89begin
90 inherited;
91 if lstSkinSelect.ItemIndex < 0 then Exit;
92
93 with lstSkinSelect do ASkinTest := TPCESkin(Items.Objects[ItemIndex]);
94 DtRead := StrToFMDateTime(edtReading.text);
95 with lstSkinSelect do if (ItemIndex > -1) then
96 begin
97 ASkinTest.DTRead := DTRead;
98 Items[ItemIndex] := ASkinTest.ItemStr;
99 end;
100end;
101*)
102
103procedure TfrmSkinTests.edtDTGivenChange(Sender: TObject);
104begin
105end;
106(*
107var
108 DtGiven: TFMDateTime;
109 ASkinTest: TPCESkin;
110begin
111 inherited;
112 if lstSkinSelect.ItemIndex < 0 then Exit;
113
114 with lstSkinSelect do ASkinTest := TPCESkin(Items.Objects[ItemIndex]);
115 DtGiven := StrToFMDateTime(edtDTGiven.text);
116 with lstSkinSelect do if (ItemIndex > -1) then
117 begin
118 ASkinTest.DTGiven := DTGIven;
119 Items[ItemIndex] := ASkinTest.ItemStr;
120 end;
121end;
122*)
123(*
124procedure TfrmSkinTests.CheckSkinRules;
125begin
126 //Results must be between 0 and 40
127 if StrToInt(EdtReading.Text) < 0 then EdtReading.text := '0';
128 if StrToInt(EdtReading.Text) > 40 then EdtReading.text := '40';
129
130(* //if reading >10, result must be "positive"
131 if (StrToInt(EdtReading.Text) > 9) and
132 (CompareText(Piece(cboSkinResults.items[cboSkinResults.itemindex],U,1),'P') <> 0) then
133 begin
134 if (Piece(cboSkinResults.items[cboSkinResults.itemindex],U,1) = '@') then // not selected
135 begin
136 cboSkinResults.SelectById('P');
137 end
138 else
139 begin
140// Showmessage('If the reading is over 9, the results are required to be positive.'); <-- original line. //kt 8/8/2007
141 Showmessage(DKLangConstW('fSkinTest_If_the_reading_is_over_9x_the_results_are_required_to_be_positivex')); //kt added 8/8/2007
142 cboSkinResults.SelectById('P');
143 end;
144 end;
145end;
146*)
147
148procedure TfrmSkinTests.FormCreate(Sender: TObject);
149begin
150 inherited;
151 FTabName := CT_SkinNm;
152 FPCEListCodesProc := ListSkinCodes;
153 FPCEItemClass := TPCESkin;
154 FPCECode := 'SK';
155 PCELoadORCombo(cboSkinResults);
156end;
157
158procedure TfrmSkinTests.UpdateNewItemStr(var x: string);
159begin
160 SetPiece(x, U, pnumSkinResults, NoPCEValue);
161 SetPiece(x, U, pnumSkinReading, '0');
162// SetPiece(x, U, pnumSkinDTRead);
163// SetPiece(x, U, pnumSkinDTGiven);
164end;
165
166procedure TfrmSkinTests.UpdateControls;
167var
168 ok, First: boolean;
169 SameRes, SameRead: boolean;
170 i: integer;
171 Res: string;
172 Read: integer;
173 Obj: TPCESkin;
174
175begin
176 inherited;
177 if(NotUpdating) then
178 begin
179 BeginUpdate;
180 try
181 ok := (lbGrid.SelCount > 0);
182 lblSkinResults.Enabled := ok;
183 lblReading.Enabled := ok;
184 cboSkinResults.Enabled := ok;
185 EdtReading.Enabled := ok;
186 UpDnReading.Enabled := ok;
187 if(ok) then
188 begin
189 First := TRUE;
190 SameRes := TRUE;
191 SameRead := TRUE;
192 Res := NoPCEValue;
193 Read := 0;
194 for i := 0 to lbGrid.Items.Count-1 do
195 begin
196 if lbGrid.Selected[i] then
197 begin
198 Obj := TPCESkin(lbGrid.Items.Objects[i]);
199 if(First) then
200 begin
201 First := FALSE;
202 Res := Obj.Results;
203 Read := Obj.Reading;
204 end
205 else
206 begin
207 if(SameRes) then
208 SameRes := (Res = Obj.Results);
209 if(SameRead) then
210 SameRead := (Read = Obj.Reading);
211 end;
212 end;
213 end;
214 if(SameRes) then
215 cboSkinResults.SelectByID(Res)
216 else
217 cboSkinResults.Text := '';
218 if(SameRead) then
219 begin
220 UpDnReading.Position := Read;
221 EdtReading.Text := IntToStr(Read);
222 EdtReading.SelStart := length(EdtReading.Text);
223 end
224 else
225 begin
226 UpDnReading.Position := 0;
227 EdtReading.Text := '';
228 end;
229 end
230 else
231 begin
232 cboSkinResults.Text := '';
233 EdtReading.Text := '';
234 end;
235 finally
236 EndUpdate;
237 end;
238 end;
239end;
240
241procedure TfrmSkinTests.UpDnReadingChanging(Sender: TObject;
242 var AllowChange: Boolean);
243begin
244 inherited;
245 if(UpDnReading.Position = 0) then
246 EdtReadingChange(Sender);
247end;
248
249end.
250
Note: See TracBrowser for help on using the repository browser.