source: cprs/trunk/CPRS-Chart/Encounter/fSkinTest.pas@ 1637

Last change on this file since 1637 was 829, checked in by Kevin Toppenberg, 14 years ago

Upgrade to version 27

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