1 | //kt -- Modified with SourceScanner on 8/8/2007
|
---|
2 | unit fODLab;
|
---|
3 |
|
---|
4 | interface
|
---|
5 |
|
---|
6 | uses
|
---|
7 | SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
|
---|
8 | Forms, Dialogs, StdCtrls, ORCtrls, ORfn, fODBase, ExtCtrls, ComCtrls, uConst,
|
---|
9 | ORDtTm, Buttons, Menus, DKLang;
|
---|
10 |
|
---|
11 | type
|
---|
12 | TfrmODLab = class(TfrmODBase)
|
---|
13 | lblAvailTests: TLabel;
|
---|
14 | cboAvailTest: TORComboBox;
|
---|
15 | lblCollTime: TLabel;
|
---|
16 | cboFrequency: TORComboBox;
|
---|
17 | lblTestName: TLabel;
|
---|
18 | lblCollSamp: TLabel;
|
---|
19 | cboCollSamp: TORComboBox;
|
---|
20 | lblSpecimen: TLabel;
|
---|
21 | cboSpecimen: TORComboBox;
|
---|
22 | lblUrgency: TLabel;
|
---|
23 | cboUrgency: TORComboBox;
|
---|
24 | lblAddlComment: TLabel;
|
---|
25 | txtAddlComment: TCaptionEdit;
|
---|
26 | txtDays: TCaptionEdit;
|
---|
27 | bvlTestName: TBevel;
|
---|
28 | lblFrequency: TLabel;
|
---|
29 | pnlHide: TORAutoPanel;
|
---|
30 | pnlOrderComment: TORAutoPanel;
|
---|
31 | lblOrderComment: TOROffsetLabel;
|
---|
32 | pnlAntiCoagulation: TORAutoPanel;
|
---|
33 | lblAntiCoagulant: TOROffsetLabel;
|
---|
34 | txtAntiCoagulant: TCaptionEdit;
|
---|
35 | pnlUrineVolume: TORAutoPanel;
|
---|
36 | lblUrineVolume: TOROffsetLabel;
|
---|
37 | txtUrineVolume: TCaptionEdit;
|
---|
38 | pnlPeakTrough: TORAutoPanel;
|
---|
39 | lblPeakTrough: TOROffsetLabel;
|
---|
40 | grpPeakTrough: TRadioGroup;
|
---|
41 | lblReqComment: TOROffsetLabel;
|
---|
42 | pnlDoseDraw: TORAutoPanel;
|
---|
43 | lblDose: TOROffsetLabel;
|
---|
44 | lblDraw: TOROffsetLabel;
|
---|
45 | txtDoseTime: TCaptionEdit;
|
---|
46 | txtDrawTime: TCaptionEdit;
|
---|
47 | txtOrderComment: TCaptionEdit;
|
---|
48 | FLabCommonCombo: TORListBox;
|
---|
49 | lblHowManyDays: TLabel;
|
---|
50 | cboCollTime: TORComboBox;
|
---|
51 | lblCollType: TLabel;
|
---|
52 | pnlCollTimeButton: TKeyClickPanel;
|
---|
53 | cboCollType: TORComboBox;
|
---|
54 | calCollTime: TORDateBox;
|
---|
55 | dlgLabCollTime: TORDateTimeDlg;
|
---|
56 | txtImmedColl: TCaptionEdit;
|
---|
57 | cmdImmedColl: TSpeedButton;
|
---|
58 | MessagePopup: TPopupMenu;
|
---|
59 | ViewinReportWindow1: TMenuItem;
|
---|
60 | procedure FormCreate(Sender: TObject);
|
---|
61 | procedure ControlChange(Sender: TObject);
|
---|
62 | procedure cboAvailTestNeedData(Sender: TObject;
|
---|
63 | const StartFrom: string; Direction, InsertAt: Integer);
|
---|
64 | procedure cboAvailTestSelect(Sender: TObject);
|
---|
65 | procedure cboCollSampChange(Sender: TObject);
|
---|
66 | procedure cboUrgencyChange(Sender: TObject);
|
---|
67 | procedure cboSpecimenChange(Sender: TObject);
|
---|
68 | procedure txtAddlCommentExit(Sender: TObject);
|
---|
69 | procedure cboCollTimeChange(Sender: TObject);
|
---|
70 | procedure cboFrequencyChange(Sender: TObject);
|
---|
71 | procedure cboCollTypeChange(Sender: TObject);
|
---|
72 | procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
---|
73 | procedure txtOrderCommentExit(Sender: TObject);
|
---|
74 | procedure txtAntiCoagulantExit(Sender: TObject);
|
---|
75 | procedure txtUrineVolumeExit(Sender: TObject);
|
---|
76 | procedure grpPeakTroughClick(Sender: TObject);
|
---|
77 | procedure txtDoseTimeExit(Sender: TObject);
|
---|
78 | procedure txtDrawTimeExit(Sender: TObject);
|
---|
79 | procedure DisableCommentPanels;
|
---|
80 | procedure cboAvailTestExit(Sender: TObject);
|
---|
81 | procedure cboCollSampKeyPause(Sender: TObject);
|
---|
82 | procedure cboCollSampMouseClick(Sender: TObject);
|
---|
83 | procedure cboCollTimeExit(Sender: TObject);
|
---|
84 | procedure cboSpecimenMouseClick(Sender: TObject);
|
---|
85 | procedure cboSpecimenKeyPause(Sender: TObject);
|
---|
86 | procedure cmdImmedCollClick(Sender: TObject);
|
---|
87 | procedure pnlCollTimeButtonEnter(Sender: TObject);
|
---|
88 | procedure pnlCollTimeButtonExit(Sender: TObject);
|
---|
89 | procedure ViewinReportWindow1Click(Sender: TObject);
|
---|
90 | protected
|
---|
91 | FCmtTypes: TStringList ;
|
---|
92 | procedure InitDialog; override;
|
---|
93 | procedure Validate(var AnErrMsg: string); override;
|
---|
94 | function ValidCollTime(UserEntry: string): string;
|
---|
95 | procedure DoseDrawComment;
|
---|
96 | procedure GetAllCollSamples(AComboBox: TORComboBox);
|
---|
97 | procedure GetAllSpecimens(AComboBox: TORComboBox);
|
---|
98 | procedure SetupCollTimes(CollType: string);
|
---|
99 | procedure LoadCollType(AComboBox:TORComboBox);
|
---|
100 | private
|
---|
101 | FLastCollType: string;
|
---|
102 | FLastCollTime: string;
|
---|
103 | FLastLabCollTime: string;
|
---|
104 | FLastLabID: string;
|
---|
105 | FLastItemID: string;
|
---|
106 | FEvtDelayLoc: integer;
|
---|
107 | FEvtDivision: integer;
|
---|
108 | procedure ReadServerVariables;
|
---|
109 | public
|
---|
110 | procedure SetupDialog(OrderAction: Integer; const ID: string); override;
|
---|
111 | procedure LoadRequiredComment(CmtType: integer);
|
---|
112 | procedure DetermineCollectionDefaults(Responses: TResponses);
|
---|
113 | property EvtDelayLoc: integer read FEvtDelayLoc write FEvtDelayLoc;
|
---|
114 | property EvtDivision: integer read FEvtDivision write FEvtDivision;
|
---|
115 | end;
|
---|
116 |
|
---|
117 | type
|
---|
118 | TCollSamp = class(TObject)
|
---|
119 | CollSampID: Integer; { IEN of CollSamp }
|
---|
120 | CollSampName: string; { Name of CollSamp }
|
---|
121 | SpecimenID: Integer; { IEN of default specimen }
|
---|
122 | SpecimenName: string; { Name of the specimen }
|
---|
123 | TubeColor: string; { TubeColor (text) }
|
---|
124 | MinInterval: Integer; { Minimum days between orders }
|
---|
125 | MaxPerDay: Integer; { Maximum orders per day }
|
---|
126 | LabCanCollect: Boolean; { True if lab can collect }
|
---|
127 | SampReqComment: string; { Name of required comment }
|
---|
128 | WardComment: TStringList; { CollSamp specific comment }
|
---|
129 | end;
|
---|
130 |
|
---|
131 | TLabTest = class(TObject)
|
---|
132 | TestID: Integer; { IEN of Lab Test }
|
---|
133 | TestName: string; { Name of Lab Test }
|
---|
134 | LabSubscript: string ; { which section of Lab? }
|
---|
135 | CollSamp: Integer; { index into CollSampList }
|
---|
136 | Specimen: Integer; { IEN of specimen }
|
---|
137 | Urgency: Integer; { IEN of urgency }
|
---|
138 | Comment: TStringList; { text of comment }
|
---|
139 | TestReqComment: string; { Name of required comment }
|
---|
140 | CurReqComment: string; { name of required comment }
|
---|
141 | CurWardComment: TStringList; { WP of Ward Comment }
|
---|
142 | UniqueCollSamp: Boolean; { true if not prompt CollSamp }
|
---|
143 | CollSampList: TList; { collection sample objects }
|
---|
144 | CollSampCount: integer; { count of original contents of CollSampList}
|
---|
145 | SpecimenList: TStringList; { Strings: IEN^Specimen Name }
|
---|
146 | SpecListCount: integer; { count of original contents of SpecimenList}
|
---|
147 | UrgencyList: TStringList; { Strings: IEN^Urgency Name }
|
---|
148 | ForceUrgency: Boolean; { true if not prompt Urgency }
|
---|
149 | QuickOrderResponses: TResponses; { if created as a result of a quick order selection}
|
---|
150 | { functions & procedures }
|
---|
151 | constructor Create(const LabTestIEN: string; Responses: TResponses);
|
---|
152 | destructor Destroy; override ;
|
---|
153 | function IndexOfCollSamp(CollSampIEN: Integer): Integer;
|
---|
154 | procedure FillCollSampList(LoadData: TStringList; DfltCollSamp: Integer);
|
---|
155 | procedure LoadAllSamples;
|
---|
156 | procedure SetCollSampDflts;
|
---|
157 | procedure ChangeCollSamp(CollSampIEN: Integer);
|
---|
158 | procedure ChangeSpecimen(const SpecimenIEN: string);
|
---|
159 | procedure ChangeUrgency(const UrgencyIEN: string);
|
---|
160 | procedure ChangeComment(const CommentText: string);
|
---|
161 | function LabCanCollect: Boolean;
|
---|
162 | procedure LoadCollSamp(AComboBox: TORComboBox);
|
---|
163 | procedure LoadSpecimen(AComboBox: TORComboBox);
|
---|
164 | procedure LoadUrgency(CollType: string; AComboBox:TORComboBox);
|
---|
165 | function NameOfCollSamp: string;
|
---|
166 | function NameOfSpecimen: string;
|
---|
167 | function NameOfUrgency: string;
|
---|
168 | function ObtainCollSamp: Boolean;
|
---|
169 | function ObtainSpecimen: Boolean;
|
---|
170 | function ObtainUrgency: Boolean;
|
---|
171 | function ObtainComment: Boolean;
|
---|
172 | end;
|
---|
173 |
|
---|
174 | const
|
---|
175 | CmtType: array[0..6] of string = ('ANTICOAGULATION','DOSE/DRAW TIMES','ORDER COMMENT',
|
---|
176 | 'ORDER COMMENT MODIFIED','TDM (PEAK-TROUGH)',
|
---|
177 | 'TRANSFUSION','URINE VOLUME');
|
---|
178 |
|
---|
179 | implementation
|
---|
180 |
|
---|
181 | {$R *.DFM}
|
---|
182 |
|
---|
183 | uses rODBase, rODLab, uCore, rCore, fODLabOthCollSamp, fODLabOthSpec, fODLabImmedColl, fLabCollTimes,
|
---|
184 | rOrders, uODBase, fRptBox, fFrame;
|
---|
185 |
|
---|
186 | var
|
---|
187 | uDfltUrgency: Integer;
|
---|
188 | uDfltCollType: string;
|
---|
189 | ALabTest: TLabTest;
|
---|
190 | UserHasLRLABKey: boolean;
|
---|
191 | LRFZX : string; //the default collection type (LC,WC,SP,I)
|
---|
192 | LRFSAMP : string; //the default sample (ptr)
|
---|
193 | LRFSPEC : string; //the default specimen (ptr)
|
---|
194 | LRFDATE : string; //the default collection time (NOW,NEXT,AM,PM,T...)
|
---|
195 | LRFURG : string; //the default urgency (number) TRY '2'
|
---|
196 | LRFSCH : string; //the default schedule? (ONE TIME, QD, ...)
|
---|
197 |
|
---|
198 | //const
|
---|
199 | //TX_NO_TEST = 'A Lab Test must be specified.' ; <-- original line. //kt 8/8/2007
|
---|
200 | //TX_NO_IMMED = 'Immediate collect is not available for this test/sample'; <-- original line. //kt 8/8/2007
|
---|
201 | //TX_NO_IMMED_CAP = 'Invalid Collection Type'; <-- original line. //kt 8/8/2007
|
---|
202 |
|
---|
203 | { base form procedures shared by all dialogs ------------------------------------------------ }
|
---|
204 |
|
---|
205 | var
|
---|
206 | TX_NO_TEST : string; //kt
|
---|
207 | TX_NO_IMMED : string; //kt
|
---|
208 | TX_NO_IMMED_CAP : string; //kt
|
---|
209 |
|
---|
210 | procedure SetupVars;
|
---|
211 | begin
|
---|
212 | TX_NO_TEST := DKLangConstW('fODLab_A_Lab_Test_must_be_specifiedx') ; //kt added 8/8/2007
|
---|
213 | TX_NO_IMMED := DKLangConstW('fODLab_Immediate_collect_is_not_available_for_this_testxsample'); //kt added 8/8/2007
|
---|
214 | TX_NO_IMMED_CAP := DKLangConstW('fODLab_Invalid_Collection_Type'); //kt added 8/8/2007
|
---|
215 | end;
|
---|
216 |
|
---|
217 |
|
---|
218 | procedure TfrmODLab.FormCreate(Sender: TObject);
|
---|
219 | var
|
---|
220 | i, n: integer;
|
---|
221 | AList: TStringList;
|
---|
222 | begin
|
---|
223 | frmFrame.pnlVisit.Enabled := false;
|
---|
224 | AutoSizeDisabled := True;
|
---|
225 | inherited;
|
---|
226 | AList := TStringList.Create;
|
---|
227 | try
|
---|
228 | LRFZX := '';
|
---|
229 | LRFSAMP := '';
|
---|
230 | LRFSPEC := '';
|
---|
231 | LRFDATE := '';
|
---|
232 | LRFURG := '';
|
---|
233 | LRFSCH := '';
|
---|
234 | FLastColltime := '';
|
---|
235 | FLastLabCollTime := '';
|
---|
236 | FLastItemID := '';
|
---|
237 | uDfltCollType := '';
|
---|
238 | FillerID := 'LR';
|
---|
239 | FEvtDelayLoc := 0;
|
---|
240 | FEvtDivision := 0;
|
---|
241 | UserHasLRLABKey := User.HasKey('LRLAB');
|
---|
242 | AllowQuickOrder := True;
|
---|
243 | // StatusText('Loading Dialog Definition'); <-- original line. //kt 8/8/2007
|
---|
244 | StatusText(DKLangConstW('fODLab_Loading_Dialog_Definition')); //kt added 8/8/2007
|
---|
245 | pnlHide.BringToFront;
|
---|
246 | lblReqComment.Visible := False ;
|
---|
247 | FCmtTypes := TStringList.Create;
|
---|
248 | for i := 0 to 6 do FCmtTypes.Add(CmtType[i]) ;
|
---|
249 | Responses.Dialog := 'LR OTHER LAB TESTS'; // loads formatting info
|
---|
250 | // StatusText('Loading Default Values'); <-- original line. //kt 8/8/2007
|
---|
251 | StatusText(DKLangConstW('fODLab_Loading_Default_Values')); //kt added 8/8/2007
|
---|
252 | if Self.EvtID > 0 then
|
---|
253 | begin
|
---|
254 | EvtDelayLoc := StrToIntDef(GetEventLoc1(IntToStr(Self.EvtID)),0);
|
---|
255 | EvtDivision := StrToIntDef(GetEventDiv1(IntToStr(Self.EvtID)),0);
|
---|
256 | if EvtDelayLoc>0 then
|
---|
257 | AList.Assign(ODForLab(EvtDelayLoc,EvtDivision))
|
---|
258 | else
|
---|
259 | AList.Assign(ODForLab(Encounter.Location,EvtDivision));
|
---|
260 | end else
|
---|
261 | AList.Assign(ODForLab(Encounter.Location)); // ODForLab returns TStrings with defaults
|
---|
262 | CtrlInits.LoadDefaults(AList);
|
---|
263 | InitDialog;
|
---|
264 | with CtrlInits do
|
---|
265 | begin
|
---|
266 | // SetControl(cboCollType, 'Collection Types'); <-- original line. //kt 8/8/2007
|
---|
267 | SetControl(cboCollType, DKLangConstW('fODLab_Collection_Types')); //kt added 8/8/2007
|
---|
268 | // uDfltCollType := ExtractDefault(AList, 'Collection Types'); <-- original line. //kt 8/8/2007
|
---|
269 | uDfltCollType := ExtractDefault(AList, DKLangConstW('fODLab_Collection_Types')); //kt added 8/8/2007
|
---|
270 | if uDfltCollType <> '' then
|
---|
271 | cboCollType.SelectByID(uDfltCollType)
|
---|
272 | else if OrderForInpatient then
|
---|
273 | cboCollType.SelectByID('LC')
|
---|
274 | else
|
---|
275 | cboCollType.SelectByID('SP');
|
---|
276 | SetupCollTimes(cboCollType.ItemID);
|
---|
277 | // StatusText('Initializing List of Tests'); <-- original line. //kt 8/8/2007
|
---|
278 | StatusText(DKLangConstW('fODLab_Initializing_List_of_Tests')); //kt added 8/8/2007
|
---|
279 | // SetControl(cboAvailTest, 'ShortList'); <-- original line. //kt 8/8/2007
|
---|
280 | SetControl(cboAvailTest, DKLangConstW('fODLab_ShortList')); //kt added 8/8/2007
|
---|
281 | if cboAvailTest.Items.Count > 0 then cboAvailTest.InsertSeparator;
|
---|
282 | cboAvailTest.InitLongList('');
|
---|
283 | // SetControl(cboFrequency, 'Schedules'); <-- original line. //kt 8/8/2007
|
---|
284 | SetControl(cboFrequency, DKLangConstW('fODLab_Schedules')); //kt added 8/8/2007
|
---|
285 | with cboFrequency do
|
---|
286 | begin
|
---|
287 | if ItemIndex < 0 then ItemIndex := Items.IndexOf('ONE TIME');
|
---|
288 | if ItemIndex < 0 then ItemIndex := Items.IndexOf('ONCE');
|
---|
289 | end;
|
---|
290 | lblHowManyDays.Enabled := False; { have this call change event in case }
|
---|
291 | // txtDays.Enabled := False; { the default is not 'one time'? } <-- original line. //kt 8/8/2007
|
---|
292 | txtDays.Enabled := False; { the default is not DKLangConstW('fODLab_one_time')? } //kt added 8/8/2007
|
---|
293 | end;
|
---|
294 | if EvTDelayLoc>0 then
|
---|
295 | n := MaxDays(EvtDelayLoc, 0)
|
---|
296 | else
|
---|
297 | n := MaxDays(Encounter.Location, 0);
|
---|
298 | if n < 0 then with cboFrequency do
|
---|
299 | begin
|
---|
300 | ItemIndex := Items.IndexOf('ONE TIME');
|
---|
301 | if ItemIndex = -1 then ItemIndex := Items.IndexOf('ONCE');
|
---|
302 | Enabled := False;
|
---|
303 | Font.Color := clGrayText;
|
---|
304 | lblFrequency.Enabled := False;
|
---|
305 | end;
|
---|
306 | PreserveControl(cboAvailTest);
|
---|
307 | PreserveControl(cboCollType);
|
---|
308 | PreserveControl(cboCollTime);
|
---|
309 | PreserveControl(calCollTime);
|
---|
310 | PreserveControl(cboFrequency);
|
---|
311 | PreserveControl(txtDays);
|
---|
312 | StatusText('');
|
---|
313 | finally
|
---|
314 | AList.Free;
|
---|
315 | end;
|
---|
316 | end;
|
---|
317 |
|
---|
318 | procedure TfrmODLab.InitDialog;
|
---|
319 | begin
|
---|
320 | inherited;
|
---|
321 | Changing := True;
|
---|
322 | if ALabTest <> nil then
|
---|
323 | begin
|
---|
324 | ALabTest.Destroy;
|
---|
325 | ALabTest := nil;
|
---|
326 | end;
|
---|
327 | with CtrlInits do
|
---|
328 | begin
|
---|
329 | // SetControl(cboUrgency, 'Default Urgency') ; <-- original line. //kt 8/8/2007
|
---|
330 | SetControl(cboUrgency, DKLangConstW('fODLab_Default_Urgency')) ; //kt added 8/8/2007
|
---|
331 | uDfltUrgency := StrToInt(Piece(cboUrgency.Items[0],U,1));
|
---|
332 | end;
|
---|
333 | lblTestName.Caption := '';
|
---|
334 | DisableCommentPanels;
|
---|
335 | cboAvailTest.SelectByID(FLastItemID);
|
---|
336 | ActiveControl := cboAvailTest;
|
---|
337 | cboAvailTest.ItemIndex := -1;
|
---|
338 | StatusText('');
|
---|
339 | Changing := False ;
|
---|
340 | end;
|
---|
341 |
|
---|
342 | procedure TfrmODLab.SetupDialog(OrderAction: Integer; const ID: string);
|
---|
343 | var
|
---|
344 | tmpResp: TResponse;
|
---|
345 | i: integer;
|
---|
346 | begin
|
---|
347 | inherited;
|
---|
348 | ReadServerVariables;
|
---|
349 | if LRFZX <> '' then
|
---|
350 | begin
|
---|
351 | cboCollType.SelectByID(LRFZX);
|
---|
352 | if cboCollType.ItemIndex > -1 then SetupCollTimes(LRFZX);
|
---|
353 | end;
|
---|
354 | if (LRFSCH <> '') and (cboFrequency.Enabled) then
|
---|
355 | begin
|
---|
356 | cboFrequency.ItemIndex := cboFrequency.Items.IndexOf(LRFSCH);
|
---|
357 | cboFrequencyChange(Self);
|
---|
358 | end;
|
---|
359 | if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses, ALabTest do
|
---|
360 | begin
|
---|
361 | SetControl(cboAvailTest, 'ORDERABLE', 1);
|
---|
362 | cboAvailTestSelect(Self);
|
---|
363 | if ALabTest = nil then Exit; // Causes access violation in FillCollSampleList
|
---|
364 | Changing := True;
|
---|
365 | SetControl(cboFrequency, 'SCHEDULE', 1);
|
---|
366 | SetControl(txtDays, 'DAYS', 1);
|
---|
367 | tmpResp := FindResponseByName('SAMPLE' ,1);
|
---|
368 | if (tmpResp <> nil) and (tmpResp.IValue <> '') then with cboCollSamp do
|
---|
369 | begin
|
---|
370 | SelectByID(tmpResp.IValue);
|
---|
371 | if ItemIndex < 0 then
|
---|
372 | begin
|
---|
373 | LoadAllSamples;
|
---|
374 | Items.Insert(0, tmpResp.IValue + U + tmpResp.EValue);
|
---|
375 | ItemIndex := 0 ;
|
---|
376 | end;
|
---|
377 | end;
|
---|
378 | cboCollSampChange(Self);
|
---|
379 | DetermineCollectionDefaults(Responses);
|
---|
380 | tmpResp := FindResponseByName('SPECIMEN' ,1);
|
---|
381 | if (tmpResp <> nil) and (tmpResp.IValue <> '') then with cboSpecimen do
|
---|
382 | begin
|
---|
383 | SelectByID(tmpResp.IValue);
|
---|
384 | if ItemIndex < 0 then
|
---|
385 | begin
|
---|
386 | if ALabTest <> nil then
|
---|
387 | ALabTest.SpecimenList.Add(tmpResp.IValue + U + tmpResp.EValue);
|
---|
388 | Items.Insert(0, tmpResp.IValue + U + tmpResp.EValue);
|
---|
389 | ItemIndex := 0 ;
|
---|
390 | end;
|
---|
391 | end
|
---|
392 | else
|
---|
393 | if (LRFSPEC <> '') then cboSpecimen.SelectByID(LRFSPEC);
|
---|
394 | if ALabTest <> nil then Specimen := cboSpecimen.ItemIEN;
|
---|
395 | if ALabTest <> nil then AlabTest.LoadUrgency(cboCollType.ItemID, cboUrgency);
|
---|
396 | SetControl(cboUrgency, 'URGENCY', 1);
|
---|
397 | if cboUrgency.ItemIEN = 0 then
|
---|
398 | begin
|
---|
399 | if StrToIntDef(LRFURG, 0) > 0 then
|
---|
400 | cboUrgency.SelectByID(LRFURG)
|
---|
401 | else if (ALabTest <> nil) and (Urgency = 0) and (cboUrgency.Items.Count = 1) then
|
---|
402 | cboUrgency.ItemIndex := 0;
|
---|
403 | end;
|
---|
404 | if ALabTest <> nil then Urgency := cboUrgency.ItemIEN;
|
---|
405 | i := 1 ;
|
---|
406 | tmpResp := Responses.FindResponseByName('COMMENT',i);
|
---|
407 | while tmpResp <> nil do
|
---|
408 | begin
|
---|
409 | Comment.Add(tmpResp.EValue);
|
---|
410 | Inc(i);
|
---|
411 | tmpResp := Responses.FindResponseByName('COMMENT',i);
|
---|
412 | end ;
|
---|
413 | with cboFrequency do
|
---|
414 | if not Enabled then
|
---|
415 | begin
|
---|
416 | ItemIndex := Items.IndexOf('ONE TIME');
|
---|
417 | if ItemIndex = -1 then ItemIndex := Items.IndexOf('ONCE');
|
---|
418 | end;
|
---|
419 | cboFrequencyChange(Self);
|
---|
420 | Changing := False;
|
---|
421 | ControlChange(Self);
|
---|
422 | end;
|
---|
423 | end;
|
---|
424 |
|
---|
425 | { dialog specific event procedures follow here ---------------------------------------------- }
|
---|
426 |
|
---|
427 | constructor TLabTest.Create(const LabTestIEN: string; Responses: TResponses);
|
---|
428 | var
|
---|
429 | LoadData, OneSamp: TStringList;
|
---|
430 | DfltCollSamp: Integer;
|
---|
431 | x: string;
|
---|
432 | tmpResp: TResponse;
|
---|
433 | begin
|
---|
434 | LoadData := TStringList.Create;
|
---|
435 | try
|
---|
436 | LoadLabTestData(LoadData, LabTestIEN) ;
|
---|
437 | with LoadData do
|
---|
438 | begin
|
---|
439 | QuickOrderResponses := Responses;
|
---|
440 | TestID := StrToInt(LabTestIEN);
|
---|
441 | // TestName := Piece(ExtractDefault(LoadData, 'Test Name'),U,1); <-- original line. //kt 8/8/2007
|
---|
442 | TestName := Piece(ExtractDefault(LoadData, DKLangConstW('fODLab_Test_Name')),U,1); //kt added 8/8/2007
|
---|
443 | // LabSubscript := Piece(ExtractDefault(LoadData, 'Item ID'),U,2); <-- original line. //kt 8/8/2007
|
---|
444 | LabSubscript := Piece(ExtractDefault(LoadData, DKLangConstW('fODLab_Item_ID')),U,2); //kt added 8/8/2007
|
---|
445 | // TestReqComment := ExtractDefault(LoadData, 'ReqCom'); <-- original line. //kt 8/8/2007
|
---|
446 | TestReqComment := ExtractDefault(LoadData, DKLangConstW('fODLab_ReqCom')); //kt added 8/8/2007
|
---|
447 | // if Length(ExtractDefault(LoadData, 'Unique CollSamp')) > 0 then UniqueCollSamp := True; <-- original line. //kt 8/8/2007
|
---|
448 | if Length(ExtractDefault(LoadData, DKLangConstW('fODLab_Unique_CollSamp'))) > 0 then UniqueCollSamp := True; //kt added 8/8/2007
|
---|
449 | // x := ExtractDefault(LoadData, 'Unique CollSamp'); <-- original line. //kt 8/8/2007
|
---|
450 | x := ExtractDefault(LoadData, DKLangConstW('fODLab_Unique_CollSamp')); //kt added 8/8/2007
|
---|
451 | // if Length(x) = 0 then x := ExtractDefault(LoadData, 'Lab CollSamp'); <-- original line. //kt 8/8/2007
|
---|
452 | if Length(x) = 0 then x := ExtractDefault(LoadData, DKLangConstW('fODLab_Lab_CollSamp')); //kt added 8/8/2007
|
---|
453 | // if Length(x) = 0 then x := ExtractDefault(LoadData, 'Default CollSamp'); <-- original line. //kt 8/8/2007
|
---|
454 | if Length(x) = 0 then x := ExtractDefault(LoadData, DKLangConstW('fODLab_Default_CollSamp')); //kt added 8/8/2007
|
---|
455 | if Length(x) = 0 then x := '-1';
|
---|
456 | DfltCollSamp := StrToInt(x);
|
---|
457 | SpecimenList := TStringList.Create;
|
---|
458 | // ExtractItems(SpecimenList, LoadData, 'Specimens'); <-- original line. //kt 8/8/2007
|
---|
459 | ExtractItems(SpecimenList, LoadData, DKLangConstW('fODLab_Specimens')); //kt added 8/8/2007
|
---|
460 | if LRFSPEC <> '' then SpecimenList.Add(GetOneSpecimen(StrToInt(LRFSPEC)));
|
---|
461 | UrgencyList := TStringList.Create;
|
---|
462 | // if Length(ExtractDefault(LoadData, 'Default Urgency')) > 0 then { forced urgency } <-- original line. //kt 8/8/2007
|
---|
463 | if Length(ExtractDefault(LoadData, DKLangConstW('fODLab_Default_Urgency'))) > 0 then { forced urgency } //kt added 8/8/2007
|
---|
464 | begin
|
---|
465 | ForceUrgency := True;
|
---|
466 | // UrgencyList.Add(ExtractDefault(LoadData, 'Default Urgency')); <-- original line. //kt 8/8/2007
|
---|
467 | UrgencyList.Add(ExtractDefault(LoadData, DKLangConstW('fODLab_Default_Urgency'))); //kt added 8/8/2007
|
---|
468 | // Urgency := StrToInt(Piece(ExtractDefault(LoadData, 'Default Urgency'), '^', 1)); <-- original line. //kt 8/8/2007
|
---|
469 | Urgency := StrToInt(Piece(ExtractDefault(LoadData, DKLangConstW('fODLab_Default_Urgency')), '^', 1)); //kt added 8/8/2007
|
---|
470 | uDfltUrgency := Urgency;
|
---|
471 | end
|
---|
472 | else
|
---|
473 | begin { list of urgencies }
|
---|
474 | // ExtractItems(UrgencyList, LoadData, 'Urgencies'); <-- original line. //kt 8/8/2007
|
---|
475 | ExtractItems(UrgencyList, LoadData, DKLangConstW('fODLab_Urgencies')); //kt added 8/8/2007
|
---|
476 | if StrToIntDef(LRFURG, 0) > 0 then
|
---|
477 | Urgency := StrToInt(LRFURG)
|
---|
478 | else
|
---|
479 | Urgency := uDfltUrgency;
|
---|
480 | end;
|
---|
481 | Comment := TStringList.Create ;
|
---|
482 | CurWardComment := TStringList.Create;
|
---|
483 | // ExtractText(CurWardComment, LoadData, 'GenWardInstructions'); <-- original line. //kt 8/8/2007
|
---|
484 | ExtractText(CurWardComment, LoadData, DKLangConstW('fODLab_GenWardInstructions')); //kt added 8/8/2007
|
---|
485 | CollSamp := 0;
|
---|
486 | CollSampList := TList.Create;
|
---|
487 | FillCollSampList(LoadData, DfltCollSamp);
|
---|
488 | with QuickOrderResponses do tmpResp := FindResponseByName('SAMPLE' ,1);
|
---|
489 | if (LRFSAMP <> '') and (IndexOfCollSamp(StrToInt(LRFSAMP)) < 0) and
|
---|
490 | (not UniqueCollSamp) and (tmpResp = nil) then
|
---|
491 | begin
|
---|
492 | OneSamp := TStringList.Create;
|
---|
493 | try
|
---|
494 | OneSamp.Assign(GetOneCollSamp(StrToInt(LRFSAMP)));
|
---|
495 | FillCollSampList(OneSamp, CollSampList.Count);
|
---|
496 | finally
|
---|
497 | OneSamp.Free;
|
---|
498 | end;
|
---|
499 | end;
|
---|
500 | if (not UniqueCollSamp) and (CollSampList.Count = 0) then LoadAllSamples;
|
---|
501 | CollSampCount := CollSampList.Count;
|
---|
502 | end;
|
---|
503 | finally
|
---|
504 | LoadData.Free;
|
---|
505 | end;
|
---|
506 | SetCollSampDflts;
|
---|
507 | end;
|
---|
508 |
|
---|
509 | destructor TLabTest.Destroy;
|
---|
510 | var
|
---|
511 | i: Integer;
|
---|
512 | begin
|
---|
513 | if CollSampList <> nil then
|
---|
514 | with CollSampList do for i := 0 to Count - 1 do
|
---|
515 | with TCollSamp(Items[i]) do
|
---|
516 | begin
|
---|
517 | WardComment.Free;
|
---|
518 | Free;
|
---|
519 | end;
|
---|
520 | CollSampList.Free;
|
---|
521 | SpecimenList.Free;
|
---|
522 | UrgencyList.Free;
|
---|
523 | CurWardComment.Free;
|
---|
524 | Comment.Free;
|
---|
525 | inherited Destroy;
|
---|
526 | end;
|
---|
527 |
|
---|
528 | function TLabTest.IndexOfCollSamp(CollSampIEN: Integer): Integer;
|
---|
529 | var
|
---|
530 | i: Integer;
|
---|
531 | begin
|
---|
532 | Result := -1;
|
---|
533 | with CollSampList do for i := 0 to Count - 1 do with TCollSamp(Items[i]) do
|
---|
534 | if CollSampIEN = CollSampID then
|
---|
535 | begin
|
---|
536 | Result := i;
|
---|
537 | break;
|
---|
538 | end;
|
---|
539 | end;
|
---|
540 |
|
---|
541 | procedure TLabTest.LoadAllSamples;
|
---|
542 | var
|
---|
543 | LoadList, SpecList: TStringList;
|
---|
544 | i: Integer;
|
---|
545 | begin
|
---|
546 | LoadList := TStringList.Create;
|
---|
547 | SpecList := TStringList.Create;
|
---|
548 | try
|
---|
549 | LoadSamples(LoadList) ;
|
---|
550 | FillCollSampList(LoadList, 0);
|
---|
551 | // ExtractItems(SpecList, LoadList, 'Specimens'); <-- original line. //kt 8/8/2007
|
---|
552 | ExtractItems(SpecList, LoadList, DKLangConstW('fODLab_Specimens')); //kt added 8/8/2007
|
---|
553 | with SpecList do for i := 0 to Count - 1 do
|
---|
554 | if SpecimenList.IndexOf(Strings[i]) = -1 then SpecimenList.Add(Strings[i]);
|
---|
555 | finally
|
---|
556 | LoadList.Free;
|
---|
557 | SpecList.Free;
|
---|
558 | end;
|
---|
559 | end;
|
---|
560 |
|
---|
561 | procedure TLabTest.FillCollSampList(LoadData: TStringList; DfltCollSamp: Integer);
|
---|
562 | {1 2 3 4 5 6 7 8 9 10 }
|
---|
563 | {n^IEN^CollSampName^SpecIEN^TubeTop^MinInterval^MaxPerDay^LabCollect^SampReqCommentIEN;name^SpecName}
|
---|
564 | var
|
---|
565 | i, LastListItem, AnIndex: Integer;
|
---|
566 | ACollSamp: TCollSamp;
|
---|
567 | LabCollSamp: Integer;
|
---|
568 | begin
|
---|
569 | i := -1;
|
---|
570 | if CollSampList = nil then CollSampList := TList.Create;
|
---|
571 | LastListItem := CollSampList.Count ;
|
---|
572 | //LabCollSamp := StrToIntDef(ExtractDefault(LoadData, 'Lab CollSamp'), 0); <-- original line. //kt 8/8/2007
|
---|
573 | LabCollSamp := StrToIntDef(ExtractDefault(LoadData, DKLangConstW('fODLab_Lab_CollSamp')), 0); //kt added 8/8/2007
|
---|
574 | //repeat Inc(i) until (i = LoadData.Count) or (LoadData[i] = '~CollSamp'); <-- original line. //kt 8/8/2007
|
---|
575 | repeat Inc(i) until (i = LoadData.Count) or (LoadData[i] = DKLangConstW('fODLab_xCollSamp')); //kt added 8/8/2007
|
---|
576 | Inc(i);
|
---|
577 | if i < LoadData.Count then repeat
|
---|
578 | if LoadData[i][1] = 'i' then
|
---|
579 | begin
|
---|
580 | ACollSamp := TCollSamp.Create;
|
---|
581 | with ACollSamp do
|
---|
582 | begin
|
---|
583 | AnIndex := StrToIntDef(Copy(Piece(LoadData[i], '^', 1), 2, 999), -1);
|
---|
584 | CollSampID := StrToInt(Piece(LoadData[i], '^', 2));
|
---|
585 | CollSampName := Piece(LoadData[i], '^', 3);
|
---|
586 | SpecimenID := StrToIntDef(Piece(LoadData[i], '^', 4), 0);
|
---|
587 | SpecimenName := Piece(LoadData[i], '^', 10);
|
---|
588 | TubeColor := Piece(LoadData[i], '^', 5);
|
---|
589 | MinInterval := StrToIntDef(Piece(LoadData[i], '^', 6), 0);
|
---|
590 | MaxPerDay := StrToIntDef(Piece(LoadData[i], '^', 7), 0);
|
---|
591 | LabCanCollect := AnIndex = LabCollSamp;
|
---|
592 | SampReqComment := Piece(LoadData[i], '^', 9);
|
---|
593 | WardComment := TStringList.Create;
|
---|
594 | if CollSampID = StrToIntDef(LRFSAMP, 0) then
|
---|
595 | CollSamp := CollSampID
|
---|
596 | else if AnIndex = DfltCollSamp then
|
---|
597 | CollSamp := CollSampID;
|
---|
598 | end; {with}
|
---|
599 | LastListItem := CollSampList.Add(ACollSamp);
|
---|
600 | end; {if}
|
---|
601 | if (LoadData[i][1] = 't') then
|
---|
602 | TCollSamp(CollSampList.Items[LastListItem]).WardComment.Add(Copy(LoadData[i], 2, 255));
|
---|
603 | Inc(i);
|
---|
604 | until (i = LoadData.Count) or (LoadData[i][1] = '~');
|
---|
605 | end;
|
---|
606 |
|
---|
607 | procedure TLabTest.SetCollSampDflts;
|
---|
608 | var
|
---|
609 | tmpResp: TResponse;
|
---|
610 | begin
|
---|
611 | Specimen := 0;
|
---|
612 | Comment.Clear;
|
---|
613 | CurReqComment := TestReqComment;
|
---|
614 | if CollSamp = 0 then Exit;
|
---|
615 | with QuickOrderResponses do tmpResp := FindResponseByName('SPECIMEN' ,1);
|
---|
616 | if (LRFSPEC <> '') and (tmpResp = nil) then
|
---|
617 | ChangeSpecimen(LRFSPEC)
|
---|
618 | else with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
|
---|
619 | begin
|
---|
620 | Specimen := SpecimenID;
|
---|
621 | if SampReqcomment <> '' then CurReqComment := SampReqComment;
|
---|
622 | end;
|
---|
623 | end;
|
---|
624 |
|
---|
625 | procedure TLabTest.ChangeCollSamp(CollSampIEN: Integer);
|
---|
626 | begin
|
---|
627 | CollSamp := CollSampIEN;
|
---|
628 | SetCollSampDflts;
|
---|
629 | end;
|
---|
630 |
|
---|
631 | procedure TLabTest.ChangeSpecimen(const SpecimenIEN: string);
|
---|
632 | begin
|
---|
633 | Specimen := StrToIntDef(SpecimenIEN,0);
|
---|
634 | end;
|
---|
635 |
|
---|
636 | procedure TLabTest.ChangeUrgency(const UrgencyIEN: string);
|
---|
637 | begin
|
---|
638 | Urgency := StrToIntDef(UrgencyIEN,0);
|
---|
639 | end;
|
---|
640 |
|
---|
641 | procedure TLabTest.ChangeComment(const CommentText: string);
|
---|
642 | begin
|
---|
643 | Comment.Add(CommentText);
|
---|
644 | end;
|
---|
645 |
|
---|
646 | function TLabTest.LabCanCollect: Boolean;
|
---|
647 | var
|
---|
648 | i: Integer;
|
---|
649 | begin
|
---|
650 | Result := False;
|
---|
651 | i := IndexOfCollSamp(CollSamp);
|
---|
652 | if i > -1 then with TCollSamp(CollSampList.Items[i]) do Result := LabCanCollect;
|
---|
653 | end;
|
---|
654 |
|
---|
655 | procedure TLabTest.LoadCollSamp(AComboBox: TORComboBox);
|
---|
656 | { loads the collection sample combo box, expects CollSamp to already be set to default }
|
---|
657 | var
|
---|
658 | i: Integer;
|
---|
659 | x: string;
|
---|
660 | begin
|
---|
661 | AComboBox.Clear;
|
---|
662 | with CollSampList do for i := 0 to Count - 1 do with TCollSamp(Items[i]) do
|
---|
663 | begin
|
---|
664 | x := IntToStr(CollSampID) + '^' + CollSampName;
|
---|
665 | if Length(TubeColor) <> 0 then x := x + ' (' + TubeColor + ')';
|
---|
666 | AComboBox.Items.Add(x);
|
---|
667 | if CollSamp = CollSampID then AComboBox.ItemIndex := i;
|
---|
668 | end;
|
---|
669 | if ((ALabTest.LabSubscript = 'CH') and (not UserHasLRLABKey)) then
|
---|
670 | begin
|
---|
671 | // do not add 'Other' (coded this way for clarity)
|
---|
672 | end
|
---|
673 | else
|
---|
674 | with AComboBox do
|
---|
675 | begin
|
---|
676 | // Items.Add('0^Other...'); <-- original line. //kt 8/8/2007
|
---|
677 | Items.Add('0^'+DKLangConstW('fODLab_Otherxxx')); //kt added 8/8/2007
|
---|
678 | // if ItemIndex < 0 then ItemIndex := Items.IndexOf('Other...'); <-- original line. //kt 8/8/2007
|
---|
679 | if ItemIndex < 0 then ItemIndex := Items.IndexOf(DKLangConstW('fODLab_Otherxxx')); //kt added 8/8/2007
|
---|
680 | end;
|
---|
681 | end;
|
---|
682 |
|
---|
683 | procedure TLabTest.LoadSpecimen(AComboBox: TORComboBox);
|
---|
684 | { loads specimen combo box, if SpecimenList is empty, use 'E' xref on 61 ?? }
|
---|
685 | var
|
---|
686 | i: Integer;
|
---|
687 | tmpResp: TResponse;
|
---|
688 | begin
|
---|
689 | AComboBox.Clear;
|
---|
690 | if ObtainSpecimen then
|
---|
691 | begin
|
---|
692 | if SpecimenList.Count = 0 then LoadSpecimens(SpecimenList) ;
|
---|
693 | AComboBox.Items.Assign(SpecimenList);
|
---|
694 | // AComboBox.Items.Add('0^Other...'); <-- original line. //kt 8/8/2007
|
---|
695 | AComboBox.Items.Add(DKLangConstW('fODLab_0xOtherxxx')); //kt added 8/8/2007
|
---|
696 | with QuickOrderResponses do tmpResp := FindResponseByName('SPECIMEN' ,1);
|
---|
697 | if (LRFSPEC <> '') and (tmpResp = nil) then
|
---|
698 | AComboBox.SelectByID(LRFSPEC)
|
---|
699 | else if Specimen > 0 then
|
---|
700 | AComboBox.SelectByIEN(Specimen)
|
---|
701 | else
|
---|
702 | // AComboBox.ItemIndex := AComboBox.Items.IndexOf('Other...'); <-- original line. //kt 8/8/2007
|
---|
703 | AComboBox.ItemIndex := AComboBox.Items.IndexOf(DKLangConstW('fODLab_Otherxxx')); //kt added 8/8/2007
|
---|
704 | end
|
---|
705 | else
|
---|
706 | begin
|
---|
707 | i := IndexOfCollSamp(CollSamp);
|
---|
708 | if i < CollSampList.Count then with TCollSamp(CollSampList.Items[i]) do
|
---|
709 | begin
|
---|
710 | AComboBox.Items.Add(IntToStr(SpecimenID) + '^' + SpecimenName);
|
---|
711 | AComboBox.ItemIndex := 0;
|
---|
712 | end;
|
---|
713 | with QuickOrderResponses do tmpResp := FindResponseByName('SPECIMEN' ,1);
|
---|
714 | if (LRFSPEC <> '') and (tmpResp = nil) then
|
---|
715 | begin
|
---|
716 | AComboBox.Items.Add(GetOneSpecimen(StrToInt(LRFSPEC)));
|
---|
717 | AComboBox.SelectByID(LRFSPEC);
|
---|
718 | end;
|
---|
719 | end;
|
---|
720 | ChangeSpecimen(AComboBox.ItemID);
|
---|
721 | end;
|
---|
722 |
|
---|
723 | procedure TfrmODLab.LoadCollType(AComboBox:TORComboBox);
|
---|
724 | var
|
---|
725 | i: integer;
|
---|
726 | begin
|
---|
727 | with CtrlInits, cboCollType do
|
---|
728 | begin
|
---|
729 | // SetControl(cboCollType, 'Collection Types'); <-- original line. //kt 8/8/2007
|
---|
730 | SetControl(cboCollType, DKLangConstW('fODLab_Collection_Types')); //kt added 8/8/2007
|
---|
731 | if not ALabTest.LabCanCollect then
|
---|
732 | begin
|
---|
733 | i := SelectByID('LC');
|
---|
734 | if i > -1 then Items.Delete(i);
|
---|
735 | i := SelectByID('I');
|
---|
736 | if i > -1 then Items.Delete(i);
|
---|
737 | end ;
|
---|
738 | if LRFZX <> '' then
|
---|
739 | begin
|
---|
740 | if (LRFZX = 'LC') or (LRFZX = 'I') then
|
---|
741 | begin
|
---|
742 | if ALabTest.LabCanCollect then
|
---|
743 | cboCollType.SelectByID(LRFZX)
|
---|
744 | else
|
---|
745 | cboCollType.SelectByID('WC');
|
---|
746 | end
|
---|
747 | else
|
---|
748 | cboCollType.SelectByID(LRFZX);
|
---|
749 | end
|
---|
750 | else if FLastCollType <> '' then
|
---|
751 | begin
|
---|
752 | if (FLastCollType = 'LC') or (FLastCollType = 'I') then
|
---|
753 | begin
|
---|
754 | if ALabTest.LabCanCollect then
|
---|
755 | cboCollType.SelectByID(FLastCollType)
|
---|
756 | else
|
---|
757 | cboCollType.SelectByID('WC');
|
---|
758 | end
|
---|
759 | else
|
---|
760 | cboCollType.SelectByID(FLastCollType);
|
---|
761 | end
|
---|
762 | else if uDfltCollType <> '' then
|
---|
763 | begin
|
---|
764 | if (uDfltCollType = 'LC') or (uDfltCollType = 'I') then
|
---|
765 | begin
|
---|
766 | if ALabTest.LabCanCollect then
|
---|
767 | cboCollType.SelectByID(uDfltCollType)
|
---|
768 | else
|
---|
769 | cboCollType.SelectByID('WC');
|
---|
770 | end
|
---|
771 | else
|
---|
772 | cboCollType.SelectByID(uDfltCollType);
|
---|
773 | end
|
---|
774 | else if OrderForInpatient then
|
---|
775 | begin
|
---|
776 | if ALabTest.LabCanCollect then
|
---|
777 | cboCollType.SelectByID('LC')
|
---|
778 | else
|
---|
779 | SelectByID('WC');
|
---|
780 | end
|
---|
781 | else
|
---|
782 | cboCollType.SelectByID('SP');
|
---|
783 | end;
|
---|
784 | SetupCollTimes(cboCollType.ItemID);
|
---|
785 | end;
|
---|
786 |
|
---|
787 | procedure TLabTest.LoadUrgency(CollType: string; AComboBox:TORComboBox);
|
---|
788 | var
|
---|
789 | i: integer;
|
---|
790 | begin
|
---|
791 | with AComboBox do
|
---|
792 | begin
|
---|
793 | Clear;
|
---|
794 | for i := 0 to UrgencyList.Count - 1 do
|
---|
795 | if (CollType = 'LC') and (Piece(UrgencyList[i], U, 3) = '') then
|
---|
796 | Continue
|
---|
797 | else
|
---|
798 | Items.Add(UrgencyList[i]);
|
---|
799 | if (LRFURG <> '') and (ALabTest.ObtainUrgency) then
|
---|
800 | SelectByID(LRFURG)
|
---|
801 | else
|
---|
802 | SelectByIEN(uDfltUrgency);
|
---|
803 | Urgency := AComboBox.ItemIEN;
|
---|
804 | end;
|
---|
805 | end;
|
---|
806 |
|
---|
807 | function TLabTest.NameOfCollSamp: string;
|
---|
808 | var
|
---|
809 | i: Integer;
|
---|
810 | begin
|
---|
811 | Result := '';
|
---|
812 | i := IndexOfCollSamp(CollSamp);
|
---|
813 | if i > -1 then with TCollSamp(CollSampList.Items[i]) do Result := CollSampName;
|
---|
814 | end;
|
---|
815 |
|
---|
816 | function TLabTest.NameOfSpecimen: string;
|
---|
817 | var
|
---|
818 | i: Integer;
|
---|
819 | begin
|
---|
820 | Result := '';
|
---|
821 | if CollSamp > 0 then with TCollSamp(CollSampList[IndexOfCollSamp(CollSamp)]) do
|
---|
822 | if (Specimen > 0) and (Specimen = SpecimenID) then Result := SpecimenName;
|
---|
823 | if (Length(Result) = 0) and (Specimen > 0) then with SpecimenList do
|
---|
824 | for i := 0 to Count - 1 do if Specimen = StrToInt(Piece(Strings[i], '^', 1)) then
|
---|
825 | begin
|
---|
826 | Result := Piece(Strings[i], '^', 2);
|
---|
827 | break;
|
---|
828 | end;
|
---|
829 | end;
|
---|
830 |
|
---|
831 | function TLabTest.NameOfUrgency: string;
|
---|
832 | var
|
---|
833 | i: Integer;
|
---|
834 | begin
|
---|
835 | Result := '';
|
---|
836 | with UrgencyList do for i := 0 to Count - 1 do
|
---|
837 | begin
|
---|
838 | if StrToInt(Piece(Strings[i], '^', 1)) = Urgency
|
---|
839 | then Result := Piece(Strings[i], '^', 2);
|
---|
840 | break;
|
---|
841 | end;
|
---|
842 | end;
|
---|
843 |
|
---|
844 | function TLabTest.ObtainCollSamp: Boolean;
|
---|
845 | begin
|
---|
846 | Result := (not UniqueCollSamp);
|
---|
847 | end;
|
---|
848 |
|
---|
849 | function TLabTest.ObtainSpecimen: Boolean;
|
---|
850 | var
|
---|
851 | i: Integer;
|
---|
852 | begin
|
---|
853 | Result := True;
|
---|
854 | i := IndexOfCollSamp(CollSamp);
|
---|
855 | if (i > -1) and (i < CollSampList.Count) then with TCollSamp(CollSampList.Items[i]) do
|
---|
856 | if SpecimenID > 0 then Result := False;
|
---|
857 | end;
|
---|
858 |
|
---|
859 | function TLabTest.ObtainUrgency: Boolean;
|
---|
860 | begin
|
---|
861 | Result := not ForceUrgency;
|
---|
862 | end;
|
---|
863 |
|
---|
864 | function TLabTest.ObtainComment: Boolean;
|
---|
865 | begin
|
---|
866 | Result := Length(CurReqComment) > 0;
|
---|
867 | end;
|
---|
868 |
|
---|
869 | { end of TLabTest object }
|
---|
870 |
|
---|
871 | procedure TfrmODLab.ControlChange(Sender: TObject);
|
---|
872 | var
|
---|
873 | AResponse: TResponse;
|
---|
874 | AVisitStr: string;
|
---|
875 | begin
|
---|
876 | inherited;
|
---|
877 | if Changing or (ALabTest = nil) then Exit;
|
---|
878 | AResponse := Responses.FindResponseByName('VISITSTR', 1);
|
---|
879 | if AResponse <> nil then
|
---|
880 | AVisitStr := AResponse.EValue;
|
---|
881 | Responses.Clear;
|
---|
882 | with ALabTest do
|
---|
883 | begin
|
---|
884 | if TestID > 0 then Responses.Update('ORDERABLE', 1, IntToStr(TestID), TestName);
|
---|
885 | if CollSamp > 0 then Responses.Update('SAMPLE', 1, IntToStr(CollSamp), NameOfCollSamp)
|
---|
886 | else Responses.Update('SAMPLE', 1, '', '');
|
---|
887 | if Specimen > 0 then Responses.Update('SPECIMEN', 1, IntToStr(Specimen), NameOfSpecimen)
|
---|
888 | else Responses.Update('SPECIMEN', 1, '', '');
|
---|
889 | if Urgency > 0 then Responses.Update('URGENCY', 1, IntToStr(Urgency), NameOfUrgency);
|
---|
890 | if Length(Comment.Text) > 0 then Responses.Update('COMMENT', 1, TX_WPTYPE, Comment.Text);
|
---|
891 | with cboCollType do if Length(ItemID) > 0 then
|
---|
892 | begin
|
---|
893 | Responses.Update('COLLECT', 1, ItemID, ItemID) ;
|
---|
894 | FLastCollType := ItemID;
|
---|
895 | end;
|
---|
896 | end;
|
---|
897 | if cboCollType.ItemID = 'LC' then
|
---|
898 | begin
|
---|
899 | with cboCollTime do
|
---|
900 | if Length(ItemID) > 0 then
|
---|
901 | begin
|
---|
902 | Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
|
---|
903 | FLastLabCollTime := ItemID + U + Text;
|
---|
904 | end
|
---|
905 | else if Length(Text) > 0 then
|
---|
906 | begin
|
---|
907 | Responses.Update('START', 1, ValidCollTime(Text), Text) ;
|
---|
908 | FLastLabCollTime := ValidCollTime(Text);
|
---|
909 | end;
|
---|
910 | end
|
---|
911 | else
|
---|
912 | begin
|
---|
913 | with calCollTime do
|
---|
914 | if FMDateTime > 0 then
|
---|
915 | begin
|
---|
916 | Responses.Update('START', 1, ValidCollTime(Text), Text);
|
---|
917 | FLastColltime := ValidCollTime(Text);
|
---|
918 | end
|
---|
919 | else
|
---|
920 | begin
|
---|
921 | Responses.Update('START', 1, '', '') ;
|
---|
922 | FLastCollTime := '';
|
---|
923 | end;
|
---|
924 | end;
|
---|
925 | with cboFrequency do if Length(ItemID) > 0
|
---|
926 | then Responses.Update('SCHEDULE', 1, ItemID, Text);
|
---|
927 | with txtDays do if Enabled then Responses.Update('DAYS', 1, Text, Text);
|
---|
928 | { worry about stop date later }
|
---|
929 | if AVisitStr <> '' then Responses.Update('VISITSTR', 1, AVisitStr, AVisitStr);
|
---|
930 | memOrder.Text := Responses.OrderText;
|
---|
931 | end;
|
---|
932 |
|
---|
933 | procedure TfrmODLab.Validate(var AnErrMsg: string);
|
---|
934 |
|
---|
935 | procedure SetError(const x: string);
|
---|
936 | begin
|
---|
937 | if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
|
---|
938 | AnErrMsg := AnErrMsg + x;
|
---|
939 | end;
|
---|
940 |
|
---|
941 | var
|
---|
942 | CmtType,DaysofFuturePast, y: integer;
|
---|
943 | (*Hours, *)DayMax, (*Daily, *)NoOfTimes, (*DayFreq,*) Minutes: integer;
|
---|
944 | d1, d2: TDateTime;
|
---|
945 | Days, MsgTxt: Double;
|
---|
946 | x: string;
|
---|
947 |
|
---|
948 | //const
|
---|
949 | //TX_NO_TIME = 'Collection Time is required.' ; <-- original line. //kt 8/8/2007
|
---|
950 | //TX_NO_TCOLLTYPE = 'Collection Type is required.' ; <-- original line. //kt 8/8/2007
|
---|
951 | //TX_NO_TESTS = 'A Lab Test or tests must be selected.' ; <-- original line. //kt 8/8/2007
|
---|
952 | //TX_BAD_TIME = 'Collection times must be chosen from the drop down list or entered as valid' + <-- original line. //kt 8/8/2007
|
---|
953 | // ' Fileman date/times (T@1700, T+1@0800, etc.).' ; <-- original line. //kt 8/8/2007
|
---|
954 | //TX_PAST_TIME = 'Collection times in the past are not allowed.'; <-- original line. //kt 8/8/2007
|
---|
955 | //TX_NO_DAYS = 'A number of days must be entered for continuous orders.'; <-- original line. //kt 8/8/2007
|
---|
956 | //TX_NO_TIMES = 'A number of times must be entered for continuous orders.'; <-- original line. //kt 8/8/2007
|
---|
957 | //TX_NO_STOP_DATE = 'Could not calculate the stop date for the order. Check "for n Days".'; <-- original line. //kt 8/8/2007
|
---|
958 | //TX_TOO_MANY_DAYS = 'Maximum number of days allowed is '; <-- original line. //kt 8/8/2007
|
---|
959 | //TX_TOO_MANY_TIMES = 'For this frequency, the maximum number of times allowed is: X'; <-- original line. //kt 8/8/2007
|
---|
960 | //TX_NO_COMMENT = 'A comment is required for this test and collection sample.';
|
---|
961 | //TX_NUMERIC_REQD = 'A numeric value is required for urine volume.'; <-- original line. //kt 8/8/2007
|
---|
962 | //TX_DOSEDRAW_REQD = 'Both DOSE and DRAW times are required for this order.'; <-- original line. //kt 8/8/2007
|
---|
963 | //TX_TDM_REQD = 'A value for LEVEL is required for this order.'; <-- original line. //kt 8/8/2007
|
---|
964 | //TX_ANTICOAG_REQD = 'You must specify an anticoagulant on this order.' ;
|
---|
965 | //TX_NO_COLLSAMPLE = 'A collection sample MUST be specified.'; <-- original line. //kt 8/8/2007
|
---|
966 | //TX_NO_SPECIMEN = 'A specimen MUST be specified.'; <-- original line. //kt 8/8/2007
|
---|
967 | //TX_NO_URGENCY = 'An urgency MUST be specified.'; <-- original line. //kt 8/8/2007
|
---|
968 | //TX_NO_FREQUENCY = 'A collection frequency MUST be specified.'; <-- original line. //kt 8/8/2007
|
---|
969 | //TX_NOT_LAB_COLL_TIME = ' is not a routine lab collection time.'; <-- original line. //kt 8/8/2007
|
---|
970 | //TX_NO_ALPHA = 'For continuous orders, enter a number of days, or an "X" followed by a number of times.'; <-- original line. //kt 8/8/2007
|
---|
971 | //TX_BADTIME_CAP = 'Invalid Immediate Collect Time'; <-- original line. //kt 8/8/2007
|
---|
972 |
|
---|
973 | var
|
---|
974 | TX_NO_TIME : string; //kt
|
---|
975 | TX_NO_TCOLLTYPE : string; //kt
|
---|
976 | TX_NO_TESTS : string; //kt
|
---|
977 | TX_BAD_TIME : string; //kt
|
---|
978 | TX_PAST_TIME : string; //kt
|
---|
979 | TX_NO_DAYS : string; //kt
|
---|
980 | TX_NO_TIMES : string; //kt
|
---|
981 | TX_NO_STOP_DATE : string; //kt
|
---|
982 | TX_TOO_MANY_DAYS : string; //kt
|
---|
983 | TX_TOO_MANY_TIMES : string; //kt
|
---|
984 | TX_NUMERIC_REQD : string; //kt
|
---|
985 | TX_DOSEDRAW_REQD : string; //kt
|
---|
986 | TX_TDM_REQD : string; //kt
|
---|
987 | TX_NO_COLLSAMPLE : string; //kt
|
---|
988 | TX_NO_SPECIMEN : string; //kt
|
---|
989 | TX_NO_URGENCY : string; //kt
|
---|
990 | TX_NO_FREQUENCY : string; //kt
|
---|
991 | TX_NOT_LAB_COLL_TIME : string; //kt
|
---|
992 | TX_NO_ALPHA : string; //kt
|
---|
993 | TX_BADTIME_CAP : string; //kt
|
---|
994 |
|
---|
995 | begin
|
---|
996 | inherited;
|
---|
997 |
|
---|
998 | TX_NO_TIME := DKLangConstW('fODLab_Collection_Time_is_requiredx') ; //kt added 8/8/2007
|
---|
999 | TX_NO_TCOLLTYPE := DKLangConstW('fODLab_Collection_Type_is_requiredx') ; //kt added 8/8/2007
|
---|
1000 | TX_NO_TESTS := DKLangConstW('fODLab_A_Lab_Test_or_tests_must_be_selectedx') ; //kt added 8/8/2007
|
---|
1001 | TX_BAD_TIME := DKLangConstW('fODLab_Collection_times_must_be_chosen_from_the_drop_down_list_or_entered_as_valid') + //kt added 8/8/2007
|
---|
1002 | DKLangConstW('fODLab_Fileman_datextimes_xTx1700x_Tx1x0800x_etcxxx') ; //kt added 8/8/2007
|
---|
1003 | TX_PAST_TIME := DKLangConstW('fODLab_Collection_times_in_the_past_are_not_allowedx'); //kt added 8/8/2007
|
---|
1004 | TX_NO_DAYS := DKLangConstW('fODLab_A_number_of_days_must_be_entered_for_continuous_ordersx'); //kt added 8/8/2007
|
---|
1005 | TX_NO_TIMES := DKLangConstW('fODLab_A_number_of_times_must_be_entered_for_continuous_ordersx'); //kt added 8/8/2007
|
---|
1006 | TX_NO_STOP_DATE := DKLangConstW('fODLab_Could_not_calculate_the_stop_date_for_the_orderx__Check_xfor_n_Daysxx'); //kt added 8/8/2007
|
---|
1007 | TX_TOO_MANY_DAYS := DKLangConstW('fODLab_Maximum_number_of_days_allowed_is'); //kt added 8/8/2007
|
---|
1008 | TX_TOO_MANY_TIMES := DKLangConstW('fODLab_For_this_frequencyx_the_maximum_number_of_times_allowed_isx__X'); //kt added 8/8/2007
|
---|
1009 | TX_NUMERIC_REQD := DKLangConstW('fODLab_A_numeric_value_is_required_for_urine_volumex'); //kt added 8/8/2007
|
---|
1010 | TX_DOSEDRAW_REQD := DKLangConstW('fODLab_Both_DOSE_and_DRAW_times_are_required_for_this_orderx'); //kt added 8/8/2007
|
---|
1011 | TX_TDM_REQD := DKLangConstW('fODLab_A_value_for_LEVEL_is_required_for_this_orderx'); //kt added 8/8/2007
|
---|
1012 | TX_NO_COLLSAMPLE := DKLangConstW('fODLab_A_collection_sample_MUST_be_specifiedx'); //kt added 8/8/2007
|
---|
1013 | TX_NO_SPECIMEN := DKLangConstW('fODLab_A_specimen_MUST_be_specifiedx'); //kt added 8/8/2007
|
---|
1014 | TX_NO_URGENCY := DKLangConstW('fODLab_An_urgency_MUST_be_specifiedx'); //kt added 8/8/2007
|
---|
1015 | TX_NO_FREQUENCY := DKLangConstW('fODLab_A_collection_frequency_MUST_be_specifiedx'); //kt added 8/8/2007
|
---|
1016 | TX_NOT_LAB_COLL_TIME := DKLangConstW('fODLab_is_not_a_routine_lab_collection_timex'); //kt added 8/8/2007
|
---|
1017 | TX_NO_ALPHA := DKLangConstW('fODLab_For_continuous_ordersx_enter_a_number_of_daysx_or_an_xXx_followed_by_a_number_of_timesx'); //kt added 8/8/2007
|
---|
1018 | TX_BADTIME_CAP := DKLangConstW('fODLab_Invalid_Immediate_Collect_Time'); //kt added 8/8/2007
|
---|
1019 |
|
---|
1020 | { need to go thru list and make sure everything is filled in }
|
---|
1021 | with cboAvailTest do if ItemIEN <= 0 then SetError(TX_NO_TESTS);
|
---|
1022 |
|
---|
1023 | if ALabTest <> nil then
|
---|
1024 | if (cboCollType.ItemID = 'I') and (not ALabTest.LabCanCollect) then
|
---|
1025 | begin
|
---|
1026 | SetError(TX_NO_IMMED);
|
---|
1027 | cboCollType.ItemIndex := -1;
|
---|
1028 | end;
|
---|
1029 |
|
---|
1030 | if cboCollType.ItemID = '' then
|
---|
1031 | SetError(TX_NO_TCOLLTYPE)
|
---|
1032 | else if cboCollType.ItemID = 'LC' then
|
---|
1033 | begin
|
---|
1034 | if Length(cboCollTime.Text) = 0 then SetError(TX_NO_TIME);
|
---|
1035 | with cboCollTime do if (Length(Text) > 0) and (ItemIndex = -1) then
|
---|
1036 | begin
|
---|
1037 | if StrToFMDateTime(Text) < 0 then
|
---|
1038 | SetError(TX_BAD_TIME)
|
---|
1039 | else if StrToFMDateTime(Text) < FMNow then
|
---|
1040 | SetError(TX_PAST_TIME)
|
---|
1041 | else if OrderForInpatient then
|
---|
1042 | begin
|
---|
1043 | d1 := FMDateTimeToDateTime(Trunc(StrToFMDateTime(cboColltime.Text)));
|
---|
1044 | d2 := FMDateTimeToDateTime(FMToday);
|
---|
1045 | if EvtDelayLoc > 0 then
|
---|
1046 | DaysofFuturePast := LabCollectFutureDays(EvtDelayLoc,EvtDivision)
|
---|
1047 | else
|
---|
1048 | DaysofFuturePast := LabCollectFutureDays(Encounter.Location);
|
---|
1049 | if DaysofFuturePast = 0 then DaysofFuturePast := 7;
|
---|
1050 | if ((d1 - d2) > DaysofFuturePast) then
|
---|
1051 | // SetError('A lab collection cannot be ordered more than ' <-- original line. //kt 8/8/2007
|
---|
1052 | SetError(DKLangConstW('fODLab_A_lab_collection_cannot_be_ordered_more_than') //kt added 8/8/2007
|
---|
1053 | // + IntToStr(DaysofFuturePast) + ' days in advance'); <-- original line. //kt 8/8/2007
|
---|
1054 | + IntToStr(DaysofFuturePast) + DKLangConstW('fODLab_days_in_advance')); //kt added 8/8/2007
|
---|
1055 | end
|
---|
1056 | else if EvtDelayLoc > 0 then
|
---|
1057 | begin
|
---|
1058 | if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), EvtDelayLoc)) then
|
---|
1059 | SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME);
|
---|
1060 | end
|
---|
1061 | else if EvtDelayLoc <= 0 then
|
---|
1062 | begin
|
---|
1063 | if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), Encounter.Location)) then
|
---|
1064 | SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME);
|
---|
1065 | end;
|
---|
1066 | end;
|
---|
1067 | end
|
---|
1068 | else
|
---|
1069 | begin
|
---|
1070 | if cboCollType.ItemID = 'I' then
|
---|
1071 | begin
|
---|
1072 | calCollTime.Text := txtImmedColl.Text;
|
---|
1073 | x := ValidImmCollTime(calCollTime.FMDateTime);
|
---|
1074 | if (Piece(x, U, 1) <> '1') then
|
---|
1075 | SetError(Piece(x, U, 2));
|
---|
1076 | end;
|
---|
1077 |
|
---|
1078 | with calColltime do
|
---|
1079 | begin
|
---|
1080 | if FMDateTime = 0 then SetError(TX_BAD_TIME)
|
---|
1081 | else
|
---|
1082 | begin
|
---|
1083 | // date only was entered
|
---|
1084 | if (FMDateTime - Trunc(FMDateTime) = 0) then
|
---|
1085 | begin
|
---|
1086 | if (Trunc(FMDateTime) < FMToday) then SetError(TX_PAST_TIME);
|
---|
1087 | end
|
---|
1088 | // date/time was entered
|
---|
1089 | else
|
---|
1090 | begin
|
---|
1091 | if (UpperCase(Text) <> 'NOW') and (FMDateTime < FMNow) then SetError(TX_PAST_TIME);
|
---|
1092 | end;
|
---|
1093 | end;
|
---|
1094 | end;
|
---|
1095 | end;
|
---|
1096 |
|
---|
1097 | with cboCollSamp do
|
---|
1098 | if ItemIndex < 0 then
|
---|
1099 | SetError(TX_NO_COLLSAMPLE)
|
---|
1100 | else if (ItemIndex >= 0) and (ItemIEN = 0) then
|
---|
1101 | begin
|
---|
1102 | if ALabTest <> nil then
|
---|
1103 | GetAllCollSamples(cboCollSamp);
|
---|
1104 | if ItemIEN = 0 then SetError(TX_NO_COLLSAMPLE);
|
---|
1105 | end;
|
---|
1106 |
|
---|
1107 | with cboSpecimen do
|
---|
1108 | if ItemIndex < 0 then
|
---|
1109 | SetError(TX_NO_SPECIMEN)
|
---|
1110 | else if (ItemIndex >= 0) and (ItemIEN = 0) then
|
---|
1111 | begin
|
---|
1112 | if (ALabTest <> nil) and (cboCollSamp.ItemIEN > 0) then
|
---|
1113 | GetAllSpecimens(cboSpecimen);
|
---|
1114 | if ItemIEN = 0 then SetError(TX_NO_SPECIMEN);
|
---|
1115 | end;
|
---|
1116 |
|
---|
1117 | with cboUrgency do if ItemIEN <= 0 then SetError(TX_NO_URGENCY);
|
---|
1118 | with cboFrequency do if ItemIEN <= 0 then SetError(TX_NO_FREQUENCY);
|
---|
1119 |
|
---|
1120 | if ALabTest <> nil then
|
---|
1121 | begin
|
---|
1122 | CmtType := FCmtTypes.IndexOf(ALabTest.CurReqComment) ;
|
---|
1123 | with ALabTest do
|
---|
1124 | case CmtType of
|
---|
1125 | 0 : {ANTICOAGULATION} {if (Pos('ANTICOAGULANT',Comment.Text)=0) then
|
---|
1126 | SetError(TX_ANTICOAG_REQD)};
|
---|
1127 | // 1 : {DOSE/DRAW TIMES} if (Pos('Last dose:',Comment.Text)=0) or <-- original line. //kt 8/8/2007
|
---|
1128 | 1 : {DOSE/DRAW TIMES} if (Pos(DKLangConstW('fODLab_Last_dosex'),Comment.Text)=0) or //kt added 8/8/2007
|
---|
1129 | // (Pos('draw time:',Comment.Text)=0) then <-- original line. //kt 8/8/2007
|
---|
1130 | (Pos(DKLangConstW('fODLab_draw_timex'),Comment.Text)=0) then //kt added 8/8/2007
|
---|
1131 | SetError(TX_DOSEDRAW_REQD);
|
---|
1132 | 2 : {ORDER COMMENT} {if (Length(Comment.Text)=0) then
|
---|
1133 | SetError(TX_NO_COMMENT)};
|
---|
1134 | 3 : {ORDER COMMENT MODIFIED} {if (Length(Comment.Text)=0) then
|
---|
1135 | SetError(TX_NO_COMMENT)};
|
---|
1136 | // 4 : {TDM (PEAK-TROUGH} if (Pos('Dose is expected',Comment.Text)=0) then <-- original line. //kt 8/8/2007
|
---|
1137 | 4 : {TDM (PEAK-TROUGH} if (Pos(DKLangConstW('fODLab_Dose_is_expected'),Comment.Text)=0) then //kt added 8/8/2007
|
---|
1138 | SetError(TX_TDM_REQD);
|
---|
1139 | 5 : {TRANSFUSION} {if (Length(Comment.Text)=0) then
|
---|
1140 | SetError(TX_NO_COMMENT)};
|
---|
1141 | 6 : {URINE VOLUME} if (Length(Comment.Text)>0) and
|
---|
1142 | (ExtractInteger(Comment.Text)<=0) then
|
---|
1143 | Comment.Text := '?';
|
---|
1144 | {SetError(TX_NUMERIC_REQD);}
|
---|
1145 | { else
|
---|
1146 | if (Length(CurReqComment)>0) and (Length(Comment.Text)=0) then
|
---|
1147 | SetError(TX_NO_COMMENT); }
|
---|
1148 | end;
|
---|
1149 | end;
|
---|
1150 |
|
---|
1151 | with txtDays do if Enabled then
|
---|
1152 | begin
|
---|
1153 | DayMax := 0;
|
---|
1154 | if (cboCollType.ItemID = 'LC') or (cboCollType.ItemID = 'I') then
|
---|
1155 | begin
|
---|
1156 | if EvtDelayLoc > 0 then
|
---|
1157 | DayMax := LabCollectFutureDays(EvtDelayLoc,EvtDivision)
|
---|
1158 | else
|
---|
1159 | DayMax := LabCollectFutureDays(Encounter.Location);
|
---|
1160 | end;
|
---|
1161 | if DayMax = 0 then
|
---|
1162 | begin
|
---|
1163 | if EvtDelayLoc > 0 then
|
---|
1164 | DayMax := MaxDays(EvtDelayLoc, cboFrequency.ItemIEN)
|
---|
1165 | else
|
---|
1166 | DayMax := MaxDays(Encounter.Location, cboFrequency.ItemIEN);
|
---|
1167 | end;
|
---|
1168 | x := Piece(cboFrequency.Items[cboFrequency.ItemIndex], U, 3);
|
---|
1169 | if (x = 'C') or (x = 'D') then
|
---|
1170 | begin
|
---|
1171 | Minutes := StrToIntDef(Piece(cboFrequency.Items[cboFrequency.ItemIndex], U, 4), 0);
|
---|
1172 | Days := Minutes / 1440;
|
---|
1173 | if (Days = 0) then Days := 1;
|
---|
1174 | if Pos('X', UpperCase(txtDays.Text)) > 0 then
|
---|
1175 | begin
|
---|
1176 | x := Trim(Copy(txtDays.Text, 1, Pos('X', UpperCase(txtDays.Text)) - 1)) +
|
---|
1177 | Trim(Copy(txtDays.Text, Pos('X', UpperCase(txtDays.Text)) + 1, 99));
|
---|
1178 | NoOfTimes := ExtractInteger(x);
|
---|
1179 | Days := NoOfTimes * Days; // # days requested
|
---|
1180 | if FloatToStr(NoOfTimes) <> x then
|
---|
1181 | SetError(TX_NO_ALPHA)
|
---|
1182 | else if NoOfTimes = 0 then
|
---|
1183 | SetError(TX_NO_TIMES)
|
---|
1184 | else if (Days > DayMax) then
|
---|
1185 | begin
|
---|
1186 | MsgTxt := Minutes / 60;
|
---|
1187 | // x := ' hour'; <-- original line. //kt 8/8/2007
|
---|
1188 | x := DKLangConstW('fODLab_hour'); //kt added 8/8/2007
|
---|
1189 | if MsgTxt > 24 then
|
---|
1190 | begin
|
---|
1191 | MsgTxt := MsgTxt / 24;
|
---|
1192 | // x := ' day'; <-- original line. //kt 8/8/2007
|
---|
1193 | x := DKLangConstW('fODLab_day'); //kt added 8/8/2007
|
---|
1194 | end;
|
---|
1195 | if MsgTxt > 1 then x := x + 's';
|
---|
1196 | y := 0;
|
---|
1197 | if Minutes > 0 then y := (DayMax * 1440) div Minutes;
|
---|
1198 | if y = 0 then y := 1;
|
---|
1199 | //if y > 0 then
|
---|
1200 | SetError(TX_TOO_MANY_TIMES + IntToStr(y) + CRLF +
|
---|
1201 | // ' (Every ' + FloatToStr(MsgTxt) + x + ' for a maximum of ' + IntToStr(DayMax) + ' days.)') <-- original line. //kt 8/8/2007
|
---|
1202 | DKLangConstW('fODLab_xEvery')+' ' + FloatToStr(MsgTxt) + x + DKLangConstW('fODLab_for_a_maximum_of')+' ' + IntToStr(DayMax) + DKLangConstW('fODLab_daysxx')) //kt added 8/8/2007
|
---|
1203 | //else
|
---|
1204 | // Responses.Update('DAYS', 1, 'X1', 'X1');
|
---|
1205 | end
|
---|
1206 | else
|
---|
1207 | begin
|
---|
1208 | x := 'X' + IntToStr(NoOfTimes);
|
---|
1209 | Responses.Update('DAYS', 1, x, x);
|
---|
1210 | end;
|
---|
1211 | end
|
---|
1212 | else
|
---|
1213 | begin
|
---|
1214 | Days := ExtractInteger(txtDays.Text);
|
---|
1215 | if FloatToStr(Days) <> Trim(txtDays.Text) then
|
---|
1216 | SetError(TX_NO_ALPHA)
|
---|
1217 | //SetError(TX_NO_DAYS) v18.6 (RV)
|
---|
1218 | else if (Days > DayMax) then
|
---|
1219 | SetError(TX_TOO_MANY_DAYS + IntToStr(DayMax))
|
---|
1220 | else
|
---|
1221 | Responses.Update('DAYS', 1, txtDays.Text, txtDays.Text);
|
---|
1222 | end;
|
---|
1223 | end;
|
---|
1224 | end;
|
---|
1225 | end;
|
---|
1226 |
|
---|
1227 | procedure TfrmODLab.cboAvailTestNeedData(Sender: TObject;
|
---|
1228 | const StartFrom: string; Direction, InsertAt: Integer);
|
---|
1229 | begin
|
---|
1230 | cboAvailTest.ForDataUse(SubsetOfOrderItems(StartFrom, Direction, 'S.LAB'));
|
---|
1231 | end;
|
---|
1232 |
|
---|
1233 | procedure TfrmODLab.cboAvailTestExit(Sender: TObject);
|
---|
1234 | begin
|
---|
1235 | inherited;
|
---|
1236 | if (Length(cboAvailTest.ItemID) = 0) or (cboAvailTest.ItemID = '0') then Exit;
|
---|
1237 | if cboAvailTest.ItemID = FLastLabID then Exit;
|
---|
1238 | cboAvailTestSelect(cboAvailTest);
|
---|
1239 | cboAvailTest.SetFocus;
|
---|
1240 | PostMessage(Handle, WM_NEXTDLGCTL, 0, 0);
|
---|
1241 | end;
|
---|
1242 |
|
---|
1243 | procedure TfrmODLab.cboAvailTestSelect(Sender: TObject);
|
---|
1244 | var
|
---|
1245 | x: string;
|
---|
1246 | i: integer;
|
---|
1247 | tmpResp: TResponse;
|
---|
1248 | begin
|
---|
1249 | with cboAvailTest do
|
---|
1250 | begin
|
---|
1251 | if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
|
---|
1252 | FLastLabID := ItemID ;
|
---|
1253 | FLastItemID := ItemID;
|
---|
1254 | Changing := True;
|
---|
1255 | if Sender <> Self then
|
---|
1256 | Responses.Clear; // Sender=Self when called from SetupDialog
|
---|
1257 | if CharAt(ItemID, 1) = 'Q' then
|
---|
1258 | with Responses do
|
---|
1259 | begin
|
---|
1260 | FLastItemID := ItemID;
|
---|
1261 | QuickOrder := ExtractInteger(ItemID);
|
---|
1262 | SetControl(cboAvailTest, 'ORDERABLE', 1);
|
---|
1263 | if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
|
---|
1264 | FLastLabID := ItemID;
|
---|
1265 | end;
|
---|
1266 | ALabTest := TLabTest.Create(ItemID, Responses);
|
---|
1267 | end;
|
---|
1268 | with ALabTest do
|
---|
1269 | begin
|
---|
1270 | lblTestName.Caption := TestName;
|
---|
1271 | LoadCollSamp(cboCollSamp);
|
---|
1272 | cboCollSampChange(Self);
|
---|
1273 | LoadSpecimen(cboSpecimen);
|
---|
1274 | LoadUrgency(cboCollType.ItemID, cboUrgency);
|
---|
1275 | with Responses do if QuickOrder > 0 then
|
---|
1276 | begin
|
---|
1277 | // StatusText('Initializing Quick Order'); <-- original line. //kt 8/8/2007
|
---|
1278 | StatusText(DKLangConstW('fODLab_Initializing_Quick_Order')); //kt added 8/8/2007
|
---|
1279 | Changing := True;
|
---|
1280 | SetControl(cboAvailTest, 'ORDERABLE', 1);
|
---|
1281 | SetControl(cboFrequency, 'SCHEDULE', 1);
|
---|
1282 | SetControl(txtDays, 'DAYS', 1);
|
---|
1283 | tmpResp := FindResponseByName('SAMPLE' ,1);
|
---|
1284 | if (tmpResp <> nil) and (tmpResp.IValue <> '') then with cboCollSamp do
|
---|
1285 | begin
|
---|
1286 | SelectByID(tmpResp.IValue);
|
---|
1287 | if ItemIndex < 0 then
|
---|
1288 | begin
|
---|
1289 | LoadAllSamples;
|
---|
1290 | Items.Insert(0, tmpResp.IValue + U + tmpResp.EValue);
|
---|
1291 | ItemIndex := 0 ;
|
---|
1292 | end;
|
---|
1293 | end
|
---|
1294 | else if LRFSAMP <> '' then
|
---|
1295 | cboCollSamp.SelectByID(LRFSAMP);
|
---|
1296 | // if (cboCollSamp.ItemIndex < 0) and (cboCollSamp.Items.IndexOf('Other...') >= 0) then cboCollSamp.SelectByID('0'); <-- original line. //kt 8/8/2007
|
---|
1297 | if (cboCollSamp.ItemIndex < 0) and (cboCollSamp.Items.IndexOf(DKLangConstW('fODLab_Otherxxx')) >= 0) then cboCollSamp.SelectByID('0'); //kt added 8/8/2007
|
---|
1298 | cboCollSampChange(Self);
|
---|
1299 | DetermineCollectionDefaults(Responses);
|
---|
1300 | LoadUrgency(cboCollType.ItemID, cboUrgency);
|
---|
1301 | SetControl(cboUrgency, 'URGENCY', 1);
|
---|
1302 | Urgency := cboUrgency.ItemIEN;
|
---|
1303 | if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
|
---|
1304 | begin
|
---|
1305 | cboUrgency.ItemIndex := 0;
|
---|
1306 | Urgency := cboUrgency.ItemIEN;
|
---|
1307 | end;
|
---|
1308 | tmpResp := FindResponseByName('SPECIMEN' ,1);
|
---|
1309 | if (tmpResp <> nil) and (tmpResp.IValue <> '') then with cboSpecimen do
|
---|
1310 | begin
|
---|
1311 | SelectByID(tmpResp.IValue);
|
---|
1312 | if ItemIndex < 0 then
|
---|
1313 | begin
|
---|
1314 | if ALabTest <> nil then
|
---|
1315 | ALabTest.SpecimenList.Add(tmpResp.IValue + U + tmpResp.EValue);
|
---|
1316 | Items.Insert(0, tmpResp.IValue + U + tmpResp.EValue);
|
---|
1317 | ItemIndex := 0 ;
|
---|
1318 | end;
|
---|
1319 | end
|
---|
1320 | else if LRFSPEC <> '' then
|
---|
1321 | cboSpecimen.SelectByID(LRFSPEC);
|
---|
1322 | // if (cboSpecimen.ItemIndex < 0) and (cboSpecimen.Items.IndexOf('Other...') >= 0) then cboSpecimen.SelectByID('0'); <-- original line. //kt 8/8/2007
|
---|
1323 | if (cboSpecimen.ItemIndex < 0) and (cboSpecimen.Items.IndexOf(DKLangConstW('fODLab_Otherxxx')) >= 0) then cboSpecimen.SelectByID('0'); //kt added 8/8/2007
|
---|
1324 | Specimen := cboSpecimen.ItemIEN;
|
---|
1325 | i := 1 ;
|
---|
1326 | tmpResp := Responses.FindResponseByName('COMMENT',i);
|
---|
1327 | while tmpResp <> nil do
|
---|
1328 | begin
|
---|
1329 | Comment.Add(tmpResp.EValue);
|
---|
1330 | Inc(i);
|
---|
1331 | tmpResp := Responses.FindResponseByName('COMMENT',i);
|
---|
1332 | end ;
|
---|
1333 | with cboFrequency do
|
---|
1334 | if not Enabled then
|
---|
1335 | begin
|
---|
1336 | ItemIndex := Items.IndexOf('ONE TIME');
|
---|
1337 | if ItemIndex = -1 then ItemIndex := Items.IndexOf('ONCE');
|
---|
1338 | end;
|
---|
1339 | cboFrequencyChange(Self);
|
---|
1340 | end; // Quick Order
|
---|
1341 | if ObtainCollSamp then
|
---|
1342 | begin
|
---|
1343 | lblCollSamp.Enabled := True;
|
---|
1344 | cboCollSamp.Enabled := True;
|
---|
1345 | end
|
---|
1346 | else
|
---|
1347 | begin
|
---|
1348 | with ALabTest do
|
---|
1349 | with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
|
---|
1350 | begin
|
---|
1351 | x := '' ;
|
---|
1352 | for i := 0 to WardComment.Count-1 do
|
---|
1353 | x := x + WardComment.strings[i]+#13#10 ;
|
---|
1354 | pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
|
---|
1355 | OrderMessage(x) ;
|
---|
1356 | end ;
|
---|
1357 | lblCollSamp.Enabled := False;
|
---|
1358 | cboCollSamp.Enabled := False;
|
---|
1359 | end;
|
---|
1360 | if ObtainSpecimen then
|
---|
1361 | begin
|
---|
1362 | lblSpecimen.Enabled:= True;
|
---|
1363 | cboSpecimen.Enabled:= True;
|
---|
1364 | end else
|
---|
1365 | begin
|
---|
1366 | lblSpecimen.Enabled:= False;
|
---|
1367 | cboSpecimen.Enabled:= False;
|
---|
1368 | end;
|
---|
1369 | if ObtainUrgency then
|
---|
1370 | begin
|
---|
1371 | lblUrgency.Enabled := True;
|
---|
1372 | cboUrgency.Enabled := True;
|
---|
1373 | end else
|
---|
1374 | begin
|
---|
1375 | lblUrgency.Enabled := False;
|
---|
1376 | cboUrgency.Enabled := False;
|
---|
1377 | end;
|
---|
1378 | if ObtainComment then
|
---|
1379 | LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment))
|
---|
1380 | else
|
---|
1381 | DisableCommentPanels;
|
---|
1382 | x := '' ;
|
---|
1383 | for i := 0 to CurWardComment.Count-1 do
|
---|
1384 | x := x + CurWardComment.strings[i]+#13#10 ;
|
---|
1385 | i := IndexOfCollSamp(CollSamp);
|
---|
1386 | if i > -1 then with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
|
---|
1387 | for i := 0 to WardComment.Count-1 do
|
---|
1388 | x := x + WardComment.strings[i]+#13#10 ;
|
---|
1389 | pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
|
---|
1390 | OrderMessage(x) ;
|
---|
1391 | end; { with }
|
---|
1392 | StatusText('');
|
---|
1393 | Changing := False;
|
---|
1394 | if Sender <> Self then ControlChange(Self);
|
---|
1395 | end;
|
---|
1396 |
|
---|
1397 | procedure TfrmODLab.cboCollSampChange(Sender: TObject);
|
---|
1398 | var
|
---|
1399 | i: integer;
|
---|
1400 | x: string;
|
---|
1401 | begin
|
---|
1402 | if (ALabTest = nil) or (cboCollSamp.ItemIEN = 0) then exit;
|
---|
1403 | with ALabTest do
|
---|
1404 | begin
|
---|
1405 | ChangeCollSamp(cboCollSamp.ItemIEN);
|
---|
1406 | LoadSpecimen(cboSpecimen);
|
---|
1407 | LoadCollType(cbocollType);
|
---|
1408 | LoadUrgency(cboCollType.ItemID, cboUrgency);
|
---|
1409 | if ObtainSpecimen then
|
---|
1410 | begin
|
---|
1411 | lblSpecimen.Enabled:= True;
|
---|
1412 | cboSpecimen.Enabled:= True;
|
---|
1413 | end else
|
---|
1414 | begin
|
---|
1415 | lblSpecimen.Enabled:= False;
|
---|
1416 | cboSpecimen.Enabled:= False;
|
---|
1417 | end;
|
---|
1418 | if ObtainComment then
|
---|
1419 | LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment))
|
---|
1420 | else
|
---|
1421 | DisableCommentPanels;
|
---|
1422 | if not Changing then with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
|
---|
1423 | begin
|
---|
1424 | x := '' ;
|
---|
1425 | for i := 0 to WardComment.Count-1 do
|
---|
1426 | x := x + WardComment.strings[i]+#13#10 ;
|
---|
1427 | pnlMessage.TabOrder := cboCollSamp.TabOrder + 1;
|
---|
1428 | OrderMessage(x) ;
|
---|
1429 | end ;
|
---|
1430 | end;
|
---|
1431 | ControlChange(Self);
|
---|
1432 | end;
|
---|
1433 |
|
---|
1434 | procedure TfrmODLab.cboUrgencyChange(Sender: TObject);
|
---|
1435 | begin
|
---|
1436 | if ALabTest = nil then exit;
|
---|
1437 | with ALabTest do
|
---|
1438 | ChangeUrgency(cboUrgency.ItemID);
|
---|
1439 | ControlChange(Self);
|
---|
1440 | end;
|
---|
1441 |
|
---|
1442 | procedure TfrmODLab.cboSpecimenChange(Sender: TObject);
|
---|
1443 | begin
|
---|
1444 | if ALabTest = nil then exit;
|
---|
1445 | //with cboSpecimen do if Text = 'Other...' then <-- original line. //kt 8/8/2007
|
---|
1446 | with cboSpecimen do if Text = DKLangConstW('fODLab_Otherxxx') then //kt added 8/8/2007
|
---|
1447 | if (ItemIndex >= 0) and (ItemIEN = 0) then
|
---|
1448 | GetAllSpecimens(cboSpecimen);
|
---|
1449 | with ALabTest do
|
---|
1450 | ChangeSpecimen(cboSpecimen.ItemID);
|
---|
1451 | ControlChange(Self);
|
---|
1452 | end;
|
---|
1453 |
|
---|
1454 | procedure TfrmODLab.cboCollTimeChange(Sender: TObject);
|
---|
1455 | var
|
---|
1456 | CollType: string;
|
---|
1457 | //const
|
---|
1458 | //TX_BAD_TIME = ' is not a routine lab collection time.' ; <-- original line. //kt 8/8/2007
|
---|
1459 | //TX_BAD_TIME_CAP = 'Invalid Time'; <-- original line. //kt 8/8/2007
|
---|
1460 | var
|
---|
1461 | TX_BAD_TIME : string; //kt
|
---|
1462 | TX_BAD_TIME_CAP : string; //kt
|
---|
1463 | begin
|
---|
1464 | TX_BAD_TIME := DKLangConstW('fODLab_is_not_a_routine_lab_collection_timex') ; //kt added 8/8/2007
|
---|
1465 | TX_BAD_TIME_CAP := DKLangConstW('fODLab_Invalid_Time'); //kt added 8/8/2007
|
---|
1466 | CollType := 'LC';
|
---|
1467 | with cboCollTime do if ItemID = 'LO' then
|
---|
1468 | begin
|
---|
1469 | ItemIndex := -1;
|
---|
1470 | Text := GetFutureLabTime(FMToday);
|
---|
1471 | end;
|
---|
1472 | //cboCollType.SelectByID(CollType);
|
---|
1473 | ControlChange(Self);
|
---|
1474 | end;
|
---|
1475 |
|
---|
1476 | procedure TfrmODLab.cboFrequencyChange(Sender: TObject);
|
---|
1477 | var
|
---|
1478 | x: string;
|
---|
1479 | //const
|
---|
1480 | //HINT_TEXT1 = 'Enter a number of days'; <-- original line. //kt 8/8/2007
|
---|
1481 | //HINT_TEXT2 = ', or an "X" followed by a number of times.'; <-- original line. //kt 8/8/2007
|
---|
1482 | var
|
---|
1483 | HINT_TEXT1 : string; //kt
|
---|
1484 | HINT_TEXT2 : string; //kt
|
---|
1485 | begin
|
---|
1486 | HINT_TEXT1 := DKLangConstW('fODLab_Enter_a_number_of_days'); //kt added 8/8/2007
|
---|
1487 | HINT_TEXT2 := DKLangConstW('fODLab_x_or_an_xXx_followed_by_a_number_of_timesx'); //kt added 8/8/2007
|
---|
1488 | with cboFrequency do if ItemIndex > -1 then x := Items[ItemIndex];
|
---|
1489 | with cboFrequency do
|
---|
1490 | if (ItemIndex > -1) and (Piece(Items[ItemIndex], U, 3) <> 'O') then
|
---|
1491 | begin
|
---|
1492 | lblHowManyDays.Enabled := True;
|
---|
1493 | if Piece(Items[ItemIndex], U, 3) = 'C' then
|
---|
1494 | txtDays.Hint := HINT_TEXT1 + HINT_TEXT2
|
---|
1495 | else
|
---|
1496 | txtDays.Hint := '';
|
---|
1497 | txtDays.Enabled := True;
|
---|
1498 | txtDays.Showhint := True;
|
---|
1499 | end
|
---|
1500 | else
|
---|
1501 | begin
|
---|
1502 | txtDays.Text := '';
|
---|
1503 | lblHowManyDays.Enabled := False;
|
---|
1504 | txtDays.Enabled := False;
|
---|
1505 | txtDays.ShowHint := False;
|
---|
1506 | end;
|
---|
1507 | ControlChange(Self);
|
---|
1508 | end;
|
---|
1509 |
|
---|
1510 | procedure TfrmODLab.cboCollTypeChange(Sender: TObject);
|
---|
1511 | begin
|
---|
1512 | if (ALabTest = nil) or Changing or (cboCollType.ItemID = '') then exit;
|
---|
1513 | if (cboCollType.ItemID = 'I') and (not ALabTest.LabCanCollect) then
|
---|
1514 | begin
|
---|
1515 | InfoBox(TX_NO_IMMED, TX_NO_IMMED_CAP, MB_OK or MB_ICONWARNING);
|
---|
1516 | cboCollType.ItemIndex := -1;
|
---|
1517 | Exit;
|
---|
1518 | end;
|
---|
1519 | SetupCollTimes(cboCollType.ItemID);
|
---|
1520 | ALabTest.LoadUrgency(cboCollType.ItemID, cboUrgency);
|
---|
1521 | ControlChange(Self);
|
---|
1522 | end;
|
---|
1523 |
|
---|
1524 | procedure TfrmODLab.SetupCollTimes(CollType: string);
|
---|
1525 | var
|
---|
1526 | tmpImmTime, tmpTime: TFMDateTime;
|
---|
1527 | x, tmpORECALLType, tmpORECALLTime: string;
|
---|
1528 | begin
|
---|
1529 | x := GetLastCollectionTime;
|
---|
1530 | tmpORECALLType := Piece(x, U, 1);
|
---|
1531 | tmpORECALLTime := Piece(x, U, 2);
|
---|
1532 | if CollType = 'SP' then
|
---|
1533 | begin
|
---|
1534 | cboColltime.Visible := False;
|
---|
1535 | txtImmedColl.Visible := False;
|
---|
1536 | pnlCollTimeButton.Visible := False;
|
---|
1537 | pnlCollTimeButton.TabStop := False;
|
---|
1538 | calCollTime.Visible := True;
|
---|
1539 | calColltime.Enabled := True;
|
---|
1540 | if FLastCollTime <> '' then
|
---|
1541 | begin
|
---|
1542 | calCollTime.Text := ValidCollTime(FLastColltime);
|
---|
1543 | if IsFMDateTime(calCollTime.Text) then
|
---|
1544 | begin
|
---|
1545 | calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
|
---|
1546 | calColltime.FMDateTime := StrToFMDateTime(FLastCollTime);
|
---|
1547 | end;
|
---|
1548 | end
|
---|
1549 | else if tmpORECALLTime <> '' then
|
---|
1550 | begin
|
---|
1551 | calCollTime.Text := ValidCollTime(tmpORECALLTime);
|
---|
1552 | if IsFMDateTime(calCollTime.Text) then
|
---|
1553 | begin
|
---|
1554 | calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
|
---|
1555 | calColltime.FMDateTime := StrToFMDateTime(tmpORECALLTime);
|
---|
1556 | end;
|
---|
1557 | end
|
---|
1558 | else if LRFDATE <> '' then
|
---|
1559 | calCollTime.Text := LRFDATE
|
---|
1560 | else
|
---|
1561 | calCollTime.Text := 'TODAY';
|
---|
1562 | end
|
---|
1563 | else if CollType = 'WC' then
|
---|
1564 | begin
|
---|
1565 | cboColltime.Visible := False;
|
---|
1566 | txtImmedColl.Visible := False;
|
---|
1567 | pnlCollTimeButton.Visible := False;
|
---|
1568 | pnlCollTimeButton.TabStop := False;
|
---|
1569 | calCollTime.Visible := True;
|
---|
1570 | calColltime.Enabled := True;
|
---|
1571 | if FLastCollTime <> '' then
|
---|
1572 | begin
|
---|
1573 | calCollTime.Text := ValidColltime(FLastColltime);
|
---|
1574 | if IsFMDateTime(calCollTime.Text) then
|
---|
1575 | begin
|
---|
1576 | calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
|
---|
1577 | calColltime.FMDateTime := StrToFMDateTime(FLastCollTime);
|
---|
1578 | end;
|
---|
1579 | end
|
---|
1580 | else if tmpORECALLTime <> '' then
|
---|
1581 | begin
|
---|
1582 | calCollTime.Text := ValidColltime(tmpORECALLTime);
|
---|
1583 | if IsFMDateTime(calCollTime.Text) then
|
---|
1584 | begin
|
---|
1585 | calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
|
---|
1586 | calColltime.FMDateTime := StrToFMDateTime(tmpORECALLTime);
|
---|
1587 | end;
|
---|
1588 | end
|
---|
1589 | else if LRFDATE <> '' then
|
---|
1590 | calCollTime.Text := LRFDATE
|
---|
1591 | else
|
---|
1592 | calCollTime.Text := 'NOW';
|
---|
1593 | end
|
---|
1594 | else if CollType = 'LC' then
|
---|
1595 | begin
|
---|
1596 | cboColltime.Visible := True;
|
---|
1597 | calCollTime.Visible := False;
|
---|
1598 | calColltime.Enabled := False;
|
---|
1599 | txtImmedColl.Visible := False;
|
---|
1600 | pnlCollTimeButton.Visible := False;
|
---|
1601 | pnlCollTimeButton.TabStop := False;
|
---|
1602 | // with CtrlInits do SetControl(cboCollTime, 'Lab Collection Times'); <-- original line. //kt 8/8/2007
|
---|
1603 | with CtrlInits do SetControl(cboCollTime, DKLangConstW('fODLab_Lab_Collection_Times')); //kt added 8/8/2007
|
---|
1604 | if Pos(U, FLastLabCollTime) > 0 then
|
---|
1605 | cboColltime.SelectByID(Piece(FLastLabCollTime, U, 1))
|
---|
1606 | else if FLastLabCollTime <> '' then
|
---|
1607 | cboCollTime.Text := FLastLabCollTime
|
---|
1608 | else if (tmpORECALLTime <> '') and (tmpORECALLType = 'LC') then
|
---|
1609 | cboCollTime.Text := MakeRelativeDateTime(StrToFMDateTime(tmpORECALLTime))
|
---|
1610 | else if LRFDATE <> '' then
|
---|
1611 | cboCollTime.Text := LRFDATE
|
---|
1612 | else
|
---|
1613 | cboCollTime.ItemIndex := 0;
|
---|
1614 | end
|
---|
1615 | else if CollType = 'I' then
|
---|
1616 | begin
|
---|
1617 | cboColltime.Visible := False;
|
---|
1618 | calCollTime.Visible := False;
|
---|
1619 | calColltime.Enabled := False;
|
---|
1620 | txtImmedColl.Visible := True;
|
---|
1621 | pnlCollTimeButton.Visible := True;
|
---|
1622 | pnlCollTimeButton.TabStop := True;
|
---|
1623 | tmpImmTime := GetDefaultImmCollTime;
|
---|
1624 | tmpTime := 0;
|
---|
1625 | if (FLastColltime <> '') then
|
---|
1626 | tmpTime := StrToFMDateTime(FLastColltime)
|
---|
1627 | else if (tmpORECALLTime <> '') then
|
---|
1628 | tmpTime := StrToFMDateTime(tmpORECALLTime)
|
---|
1629 | else if LRFDATE <> '' then
|
---|
1630 | tmpTime := StrToFMDateTime(LRFDATE);
|
---|
1631 |
|
---|
1632 | if tmpTime > tmpImmTime then
|
---|
1633 | begin
|
---|
1634 | calCollTime.FMDateTime := tmpTime;
|
---|
1635 | txtImmedColl.Text := FormatFMDateTime('mmm dd,yy@hh:nn', tmpTime);
|
---|
1636 | end
|
---|
1637 | else
|
---|
1638 | begin
|
---|
1639 | calCollTime.FMDateTime := GetDefaultImmCollTime;
|
---|
1640 | txtImmedColl.Text := FormatFMDateTime('mmm dd,yy@hh:nn', calCollTime.FMDateTime);
|
---|
1641 | end;
|
---|
1642 | end;
|
---|
1643 | end;
|
---|
1644 |
|
---|
1645 | procedure TfrmODLab.FormClose(Sender: TObject; var Action: TCloseAction);
|
---|
1646 | begin
|
---|
1647 | inherited;
|
---|
1648 | if FCmtTypes <> nil then FCmtTypes.Free;
|
---|
1649 | frmFrame.pnlVisit.Enabled := true;
|
---|
1650 | end;
|
---|
1651 |
|
---|
1652 | procedure TfrmODLab.LoadRequiredComment(CmtType: integer);
|
---|
1653 | begin
|
---|
1654 | DisableCommentPanels;
|
---|
1655 | pnlHide.SendToBack;
|
---|
1656 | lblReqComment.Visible := True ;
|
---|
1657 | case CmtType of
|
---|
1658 | 0 : {ANTICOAGULATION} pnlAntiCoagulation.Show ;
|
---|
1659 | 1 : {DOSE/DRAW TIMES} pnlDoseDraw.Show ;
|
---|
1660 | 2 : {ORDER COMMENT} pnlOrderComment.Show ;
|
---|
1661 | 3 : {ORDER COMMENT MODIFIED} pnlOrderComment.Show ; // DIFFERENT ???
|
---|
1662 | 4 : {TDM (PEAK-TROUGH} begin
|
---|
1663 | pnlPeakTrough.Show ;
|
---|
1664 | grpPeakTrough.ItemIndex := -1;
|
---|
1665 | txtAddlComment.Show;
|
---|
1666 | lblAddlComment.Show;
|
---|
1667 | end;
|
---|
1668 | 5 : {TRANSFUSION} pnlOrderComment.Show ;
|
---|
1669 | 6 : {URINE VOLUME} pnlUrineVolume.Show ;
|
---|
1670 | else
|
---|
1671 | pnlOrderComment.Show ;
|
---|
1672 | end;
|
---|
1673 | end;
|
---|
1674 |
|
---|
1675 | procedure TfrmODLab.txtOrderCommentExit(Sender: TObject);
|
---|
1676 | begin
|
---|
1677 | inherited;
|
---|
1678 | if (not pnlOrderComment.Visible) or (ALabTest = nil) then exit;
|
---|
1679 | with ALabTest do
|
---|
1680 | if Length(txtOrderComment.Text)>0 then
|
---|
1681 | begin
|
---|
1682 | Comment.Clear;
|
---|
1683 | // ChangeComment('~For Test: ' + TestName); <-- original line. //kt 8/8/2007
|
---|
1684 | ChangeComment(DKLangConstW('fODLab_xFor_Testx') + TestName); //kt added 8/8/2007
|
---|
1685 | ChangeComment('~' + txtOrderComment.Text) ;
|
---|
1686 | end
|
---|
1687 | else
|
---|
1688 | Comment.Clear;
|
---|
1689 | ControlChange(Self);
|
---|
1690 | end;
|
---|
1691 |
|
---|
1692 | procedure TfrmODLab.txtAntiCoagulantExit(Sender: TObject);
|
---|
1693 | begin
|
---|
1694 | inherited;
|
---|
1695 | if (not pnlAntiCoagulation.Visible) or (ALabTest = nil) then exit;
|
---|
1696 | with ALabTest do
|
---|
1697 | if Length(txtAntiCoagulant.Text)>0 then
|
---|
1698 | begin
|
---|
1699 | Comment.Clear;
|
---|
1700 | // ChangeComment('~For Test: ' + TestName); <-- original line. //kt 8/8/2007
|
---|
1701 | ChangeComment(DKLangConstW('fODLab_xFor_Testx') + TestName); //kt added 8/8/2007
|
---|
1702 | ChangeComment('~ANTICOAGULANT: ' + txtAntiCoagulant.Text);
|
---|
1703 | end
|
---|
1704 | else
|
---|
1705 | Comment.Clear;
|
---|
1706 | ControlChange(Self);
|
---|
1707 | end;
|
---|
1708 |
|
---|
1709 | procedure TfrmODLab.txtUrineVolumeExit(Sender: TObject);
|
---|
1710 | begin
|
---|
1711 | inherited;
|
---|
1712 | if (not pnlUrineVolume.Visible) or (ALabTest = nil) then exit;
|
---|
1713 | with ALabTest do
|
---|
1714 | begin
|
---|
1715 | Comment.Clear;
|
---|
1716 | ChangeComment(txtUrineVolume.Text) ;
|
---|
1717 | end;
|
---|
1718 | ControlChange(Self);
|
---|
1719 | end;
|
---|
1720 |
|
---|
1721 | procedure TfrmODLab.grpPeakTroughClick(Sender: TObject);
|
---|
1722 | begin
|
---|
1723 | inherited;
|
---|
1724 | if (not pnlPeakTrough.Visible) or (ALabTest = nil) then exit;
|
---|
1725 | with ALabTest,grpPeakTrough do
|
---|
1726 | if ItemIndex > -1 then
|
---|
1727 | begin
|
---|
1728 | Comment.Clear;
|
---|
1729 | // ChangeComment('~For Test: ' + TestName); <-- original line. //kt 8/8/2007
|
---|
1730 | ChangeComment(DKLangConstW('fODLab_xFor_Testx') + TestName); //kt added 8/8/2007
|
---|
1731 | // ChangeComment('~Dose is expected to be at ' + UpperCase(Items[ItemIndex]) + ' level.'); <-- original line. //kt 8/8/2007
|
---|
1732 | ChangeComment(DKLangConstW('fODLab_xDose_is_expected_to_be_at')+' ' + UpperCase(Items[ItemIndex]) + DKLangConstW('fODLab_levelx')); //kt added 8/8/2007
|
---|
1733 | ChangeComment(txtAddlComment.Text) ;
|
---|
1734 | end
|
---|
1735 | else
|
---|
1736 | Comment.Clear;
|
---|
1737 | ControlChange(Self);
|
---|
1738 | end;
|
---|
1739 |
|
---|
1740 | procedure TfrmODLab.txtDoseTimeExit(Sender: TObject);
|
---|
1741 | begin
|
---|
1742 | inherited;
|
---|
1743 | if (not pnlDoseDraw.Visible) or (ALabTest = nil) then exit;
|
---|
1744 | with txtDoseTime do
|
---|
1745 | if Length(Text)>0 then
|
---|
1746 | Text := FormatFMDateTime('mm/dd/yy hh:nn', StrToFMDateTime(Text))
|
---|
1747 | else
|
---|
1748 | Text := 'UNKNOWN';
|
---|
1749 | DoseDrawComment;
|
---|
1750 | ControlChange(Self);
|
---|
1751 | end;
|
---|
1752 |
|
---|
1753 | procedure TfrmODLab.txtDrawTimeExit(Sender: TObject);
|
---|
1754 | begin
|
---|
1755 | inherited;
|
---|
1756 | if (not pnlDoseDraw.Visible) or (ALabTest = nil) then exit;
|
---|
1757 | with txtDrawTime do
|
---|
1758 | if Length(Text)>0 then
|
---|
1759 | Text := FormatFMDateTime('mm/dd/yy hh:nn', StrToFMDateTime(Text))
|
---|
1760 | else
|
---|
1761 | Text := 'UNKNOWN';
|
---|
1762 | DoseDrawComment;
|
---|
1763 | ControlChange(Self);
|
---|
1764 | end;
|
---|
1765 |
|
---|
1766 | procedure TfrmODLab.DoseDrawComment;
|
---|
1767 | begin
|
---|
1768 | if ALabTest = nil then exit;
|
---|
1769 | with ALabTest do
|
---|
1770 | begin
|
---|
1771 | Comment.Clear;
|
---|
1772 | // ChangeComment('~For Test: ' + TestName); <-- original line. //kt 8/8/2007
|
---|
1773 | ChangeComment(DKLangConstW('fODLab_xFor_Testx') + TestName); //kt added 8/8/2007
|
---|
1774 | // ChangeComment('~Last dose: ' + txtDoseTime.Text + <-- original line. //kt 8/8/2007
|
---|
1775 | ChangeComment(DKLangConstW('fODLab_xLast_dosex') + txtDoseTime.Text + //kt added 8/8/2007
|
---|
1776 | // ' draw time: '+txtDrawTime.Text); <-- original line. //kt 8/8/2007
|
---|
1777 | DKLangConstW('fODLab_draw_timex2')+txtDrawTime.Text); //kt added 8/8/2007
|
---|
1778 | end;
|
---|
1779 | end;
|
---|
1780 |
|
---|
1781 | procedure TfrmODLab.txtAddlCommentExit(Sender: TObject);
|
---|
1782 | begin
|
---|
1783 | if (not pnlPeakTrough.Visible) or (ALabTest = nil) then exit;
|
---|
1784 | grpPeakTroughClick(Sender);
|
---|
1785 | end;
|
---|
1786 |
|
---|
1787 | procedure TfrmODLab.DisableCommentPanels;
|
---|
1788 | begin
|
---|
1789 | pnlHide.BringToFront;
|
---|
1790 | lblReqComment.Visible := False;
|
---|
1791 | pnlAntiCoagulation.Visible := False;
|
---|
1792 | pnlOrderComment.Visible := False;
|
---|
1793 | pnlDoseDraw.Visible := False;
|
---|
1794 | pnlPeakTrough.Visible := False;
|
---|
1795 | pnlUrineVolume.Visible := False;
|
---|
1796 | lblAddlComment.Visible := False;
|
---|
1797 | txtAddlComment.Visible := False;
|
---|
1798 | //pnlTransfusion.Visible := False;
|
---|
1799 | end;
|
---|
1800 |
|
---|
1801 | procedure TfrmODLab.cboCollSampKeyPause(Sender: TObject);
|
---|
1802 | begin
|
---|
1803 | inherited;
|
---|
1804 | if ALabTest = nil then exit;
|
---|
1805 | with cboCollSamp do
|
---|
1806 | if (ItemIndex >= 0) and (ItemIEN = 0) then GetAllCollSamples(cboCollSamp);
|
---|
1807 | if (cboCollSamp.ItemIEN = 0) then
|
---|
1808 | begin
|
---|
1809 | ALabTest.Specimen := 0;
|
---|
1810 | ALabTest.CollSamp := 0;
|
---|
1811 | cboCollSamp.ItemIndex := -1;
|
---|
1812 | cboSpecimen.ItemIndex := -1;
|
---|
1813 | end
|
---|
1814 | else
|
---|
1815 | ALabTest.LoadSpecimen(cboSpecimen);
|
---|
1816 | ControlChange(Self);
|
---|
1817 | end;
|
---|
1818 |
|
---|
1819 | procedure TfrmODLab.cboCollSampMouseClick(Sender: TObject);
|
---|
1820 | begin
|
---|
1821 | inherited;
|
---|
1822 | if ALabTest = nil then exit;
|
---|
1823 | with cboCollSamp do
|
---|
1824 | begin
|
---|
1825 | if (ItemIndex >= 0) and (ItemIEN = 0) then
|
---|
1826 | GetAllCollSamples(cboCollSamp);
|
---|
1827 | if (ItemIEN = 0) then
|
---|
1828 | begin
|
---|
1829 | ALabTest.Specimen := 0;
|
---|
1830 | ALabTest.CollSamp := 0;
|
---|
1831 | ItemIndex := -1;
|
---|
1832 | cboSpecimen.ItemIndex := -1;
|
---|
1833 | end
|
---|
1834 | else
|
---|
1835 | ALabTest.LoadSpecimen(cboSpecimen);
|
---|
1836 | end;
|
---|
1837 | ControlChange(Self);
|
---|
1838 | end;
|
---|
1839 |
|
---|
1840 | function TfrmODLab.ValidCollTime(UserEntry: string): string;
|
---|
1841 | var
|
---|
1842 | i: integer;
|
---|
1843 | const
|
---|
1844 | FMDateResponses: array[0..3] of string = ('TODAY','NOW','NOON','MID');
|
---|
1845 | begin
|
---|
1846 | Result := '';
|
---|
1847 | UserEntry := UpperCase(UserEntry);
|
---|
1848 | if StrToFMDateTime(UserEntry) < 0 then exit;
|
---|
1849 | if (UserEntry = 'T') or
|
---|
1850 | (UserEntry = 'N') or
|
---|
1851 | (Copy(UserEntry,1,2)='T+') or
|
---|
1852 | (Copy(UserEntry,1,2)='T@') or
|
---|
1853 | (Copy(UserEntry,1,2)='T-') or
|
---|
1854 | (Copy(UserEntry,1,2)='N+') then Result := UserEntry
|
---|
1855 | else
|
---|
1856 | for i := 0 to 3 do if Pos(FMDateResponses[i],UserEntry)>0 then Result := UserEntry ;
|
---|
1857 | if Result = '' then Result := FloatToStr(StrToFMDateTime(UserEntry));
|
---|
1858 | end;
|
---|
1859 |
|
---|
1860 | procedure TfrmODLab.cboCollTimeExit(Sender: TObject);
|
---|
1861 | var
|
---|
1862 | ADateTime: TFMDateTime;
|
---|
1863 | CollType: string;
|
---|
1864 | isTrue: boolean;
|
---|
1865 | //const
|
---|
1866 | //TX_BAD_TIME = ' is not a routine lab collection time.' ; <-- original line. //kt 8/8/2007
|
---|
1867 | //TX_BAD_TIME_CAP = 'Invalid Time'; <-- original line. //kt 8/8/2007
|
---|
1868 | var
|
---|
1869 | TX_BAD_TIME : string; //kt
|
---|
1870 | TX_BAD_TIME_CAP : string; //kt
|
---|
1871 | begin
|
---|
1872 | TX_BAD_TIME := DKLangConstW('fODLab_is_not_a_routine_lab_collection_timex') ; //kt added 8/8/2007
|
---|
1873 | TX_BAD_TIME_CAP := DKLangConstW('fODLab_Invalid_Time'); //kt added 8/8/2007
|
---|
1874 | inherited;
|
---|
1875 | if (ALabTest = nil) or (cboColltime.Text = '') then Exit;
|
---|
1876 | Changing := True;
|
---|
1877 | CollType := 'LC';
|
---|
1878 | with cboCollTime do if (ItemIndex < 0) or (ITEMID = 'LO') then
|
---|
1879 | if ALabTest.LabCanCollect then
|
---|
1880 | begin
|
---|
1881 | ADateTime := StrToFMDateTime(cboCollTime.Text);
|
---|
1882 | if EvtDelayLoc > 0 then
|
---|
1883 | isTrue := IsLabCollectTime(ADateTime, EvtDelayLoc)
|
---|
1884 | else
|
---|
1885 | isTrue := IsLabCollectTime(ADateTime, Encounter.Location);
|
---|
1886 | if isTrue then
|
---|
1887 | begin
|
---|
1888 | calCollTime.Clear;
|
---|
1889 | cboCollTime.Visible := True;
|
---|
1890 | calCollTime.Visible := False;
|
---|
1891 | calCollTime.Enabled := False;
|
---|
1892 | end {if IsLabCollectTime}
|
---|
1893 | else
|
---|
1894 | begin
|
---|
1895 | InfoBox(cboCollTime.Text + TX_BAD_TIME, TX_BAD_TIME_CAP, MB_OK or MB_ICONWARNING) ;
|
---|
1896 | ItemIndex := -1;
|
---|
1897 | Text := GetFutureLabTime(ADateTime);
|
---|
1898 | end ;
|
---|
1899 | end {if (LabCanCollect...}
|
---|
1900 | else
|
---|
1901 | begin
|
---|
1902 | if OrderForInpatient then CollType := 'WC' else CollType := 'SP';
|
---|
1903 | calCollTime.Text := cboCollTime.Text;
|
---|
1904 | cboCollTime.Clear;
|
---|
1905 | cboCollTime.Visible := False;
|
---|
1906 | calCollTime.Visible := True;
|
---|
1907 | calCollTime.Enabled := True;
|
---|
1908 | end;
|
---|
1909 | cboCollType.SelectByID(CollType);
|
---|
1910 | Changing := False; //v16.3 RV
|
---|
1911 | ControlChange(Self); //v16.3 RV
|
---|
1912 | //Responses.Update('COLLECT', 1, CollType, CollType) ; //v16.3 RV
|
---|
1913 | //memOrder.Text := Responses.OrderText; //v16.3 RV
|
---|
1914 | end;
|
---|
1915 |
|
---|
1916 | procedure TfrmODLab.cboSpecimenMouseClick(Sender: TObject);
|
---|
1917 | begin
|
---|
1918 | inherited;
|
---|
1919 | if ALabTest = nil then exit;
|
---|
1920 | with cboSpecimen do
|
---|
1921 | begin
|
---|
1922 | if (ItemIndex >= 0) and (ItemIEN = 0) then
|
---|
1923 | GetAllSpecimens(cboSpecimen);
|
---|
1924 | if (ItemIEN = 0) then
|
---|
1925 | begin
|
---|
1926 | ALabTest.Specimen := 0;
|
---|
1927 | ItemIndex := -1;
|
---|
1928 | end;
|
---|
1929 | end;
|
---|
1930 | ControlChange(Self);
|
---|
1931 | end;
|
---|
1932 |
|
---|
1933 | procedure TfrmODLab.GetAllCollSamples(AComboBox: TORComboBox);
|
---|
1934 | var
|
---|
1935 | OtherSamp: string;
|
---|
1936 | begin
|
---|
1937 | with ALabTest, AComboBox do
|
---|
1938 | begin
|
---|
1939 | if ((CollSampList.Count + 1) <= AComboBox.Items.Count) then LoadAllSamples;
|
---|
1940 | OtherSamp := SelectOtherCollSample(Font.Size, CollSampCount, CollSampList);
|
---|
1941 | if OtherSamp = '-1' then exit;
|
---|
1942 | if SelectByID(Piece(OtherSamp, U, 1)) = -1 then
|
---|
1943 | if Items.Count > CollSampCount + 1 then
|
---|
1944 | Items[0] := OtherSamp
|
---|
1945 | else
|
---|
1946 | Items.Insert(0, OtherSamp) ;
|
---|
1947 | SelectByID(Piece(OtherSamp, U, 1));
|
---|
1948 | AComboBox.OnChange(Self);
|
---|
1949 | ActiveControl := cmdAccept;
|
---|
1950 | end;
|
---|
1951 | end;
|
---|
1952 |
|
---|
1953 | procedure TfrmODLab.GetAllSpecimens(AComboBox: TORComboBox);
|
---|
1954 | var
|
---|
1955 | OtherSpec: string;
|
---|
1956 | begin
|
---|
1957 | inherited;
|
---|
1958 | if ALabTest <> nil then
|
---|
1959 | with ALabTest, AComboBox do
|
---|
1960 | begin
|
---|
1961 | AComboBox.DroppedDown := False;
|
---|
1962 | OtherSpec := SelectOtherSpecimen(Font.Size, SpecimenList);
|
---|
1963 | if OtherSpec = '-1' then exit;
|
---|
1964 | if SelectByID(Piece(OtherSpec, U, 1)) = -1 then
|
---|
1965 | if Items.Count > SpecListCount + 1 then
|
---|
1966 | Items[0] := OtherSpec
|
---|
1967 | else
|
---|
1968 | Items.Insert(0, OtherSpec) ;
|
---|
1969 | SpecimenList.Add(OtherSpec);
|
---|
1970 | SelectByID(Piece(OtherSpec, U, 1));
|
---|
1971 | AComboBox.OnChange(Self);
|
---|
1972 | end;
|
---|
1973 | end;
|
---|
1974 |
|
---|
1975 | procedure TfrmODLab.cboSpecimenKeyPause(Sender: TObject);
|
---|
1976 | begin
|
---|
1977 | inherited;
|
---|
1978 | if ALabTest = nil then exit;
|
---|
1979 | with cboSpecimen do
|
---|
1980 | if (ItemIndex >= 0) and (ItemIEN = 0) then
|
---|
1981 | GetAllSpecimens(cboSpecimen);
|
---|
1982 | if (cboSpecimen.ItemIEN = 0) then
|
---|
1983 | begin
|
---|
1984 | ALabTest.Specimen := 0;
|
---|
1985 | cboSpecimen.ItemIndex := -1;
|
---|
1986 | end ;
|
---|
1987 | ControlChange(Self);
|
---|
1988 | end;
|
---|
1989 |
|
---|
1990 | procedure TfrmODLab.cmdImmedCollClick(Sender: TObject);
|
---|
1991 | var
|
---|
1992 | ImmedCollTime: string;
|
---|
1993 | begin
|
---|
1994 | inherited;
|
---|
1995 | ImmedCollTime := SelectImmediateCollectTime(Font.Size, txtImmedColl.Text);
|
---|
1996 | if ImmedCollTime <> '-1' then
|
---|
1997 | begin
|
---|
1998 | txtImmedColl.Text := ImmedCollTime;
|
---|
1999 | calCollTime.FMDateTime := StrToFMDateTime(ImmedCollTime);
|
---|
2000 | end
|
---|
2001 | else
|
---|
2002 | begin
|
---|
2003 | txtImmedColl.Clear;
|
---|
2004 | calCollTime.Clear;
|
---|
2005 | end;
|
---|
2006 | end;
|
---|
2007 |
|
---|
2008 | procedure TfrmODLab.ReadServerVariables;
|
---|
2009 | begin
|
---|
2010 | LRFZX := KeyVariable['LRFZX'];
|
---|
2011 | LRFSAMP := KeyVariable['LRFSAMP'];
|
---|
2012 | LRFSPEC := KeyVariable['LRFSPEC'];
|
---|
2013 | LRFDATE := KeyVariable['LRFDATE'];
|
---|
2014 | LRFURG := KeyVariable['LRFURG'];
|
---|
2015 | LRFSCH := KeyVariable['LRFSCH'];
|
---|
2016 | end;
|
---|
2017 |
|
---|
2018 | procedure TfrmODLab.DetermineCollectionDefaults(Responses: TResponses);
|
---|
2019 | var
|
---|
2020 | RespCollect, RespStart: TResponse;
|
---|
2021 | //i: integer;
|
---|
2022 | begin
|
---|
2023 | if ALabTest = nil then exit;
|
---|
2024 | calCollTime.Clear;
|
---|
2025 | cboCollTime.Clear;
|
---|
2026 | calCollTime.Enabled := True;
|
---|
2027 | lblCollTime.Enabled := True;
|
---|
2028 | cboColltime.Enabled := True;
|
---|
2029 | with Responses, ALabTest do
|
---|
2030 | begin
|
---|
2031 | RespCollect := FindResponseByName('COLLECT',1);
|
---|
2032 | RespStart := FindResponseByName('START' ,1);
|
---|
2033 | if (RespCollect <> nil) then with RespCollect do
|
---|
2034 | begin
|
---|
2035 | if IValue = 'LC' then
|
---|
2036 | begin
|
---|
2037 | if not LabCanCollect then
|
---|
2038 | begin
|
---|
2039 | cboCollType.SelectByID('WC');
|
---|
2040 | SetupCollTimes('WC');
|
---|
2041 | end
|
---|
2042 | else // if LabCanCollect
|
---|
2043 | begin
|
---|
2044 | cboCollType.SelectByID('LC');
|
---|
2045 | SetupCollTimes('LC');
|
---|
2046 | // CtrlInits.SetControl(cboCollTime, 'Lab Collection Times') ; <-- original line. //kt 8/8/2007
|
---|
2047 | CtrlInits.SetControl(cboCollTime, DKLangConstW('fODLab_Lab_Collection_Times')) ; //kt added 8/8/2007
|
---|
2048 | if RespStart <> nil then
|
---|
2049 | begin
|
---|
2050 | cboCollTime.SelectByID('L' + RespStart.IValue);
|
---|
2051 | if cboCollTime.ItemIndex < 0 then
|
---|
2052 | cboCollTime.Text := RespStart.IValue;
|
---|
2053 | end;
|
---|
2054 | end;
|
---|
2055 | end
|
---|
2056 | else // if IValue <> 'LC'
|
---|
2057 | begin
|
---|
2058 | cboCollType.SelectByID(IValue) ;
|
---|
2059 | SetupCollTimes(IValue);
|
---|
2060 | if RespStart <> nil then
|
---|
2061 | begin
|
---|
2062 | if ContainsAlpha(RespStart.IValue) then
|
---|
2063 | calColltime.Text := RespStart.IValue
|
---|
2064 | else
|
---|
2065 | calColltime.FMDateTime := StrToFMDateTime(RespStart.IValue);
|
---|
2066 | end;
|
---|
2067 | end ;
|
---|
2068 | if IValue = 'I' then
|
---|
2069 | if not LabCanCollect then
|
---|
2070 | begin
|
---|
2071 | cboCollType.SelectByID('WC');
|
---|
2072 | SetupCollTimes('WC');
|
---|
2073 | end
|
---|
2074 | else
|
---|
2075 | begin
|
---|
2076 | calCollTime.Enabled := False;
|
---|
2077 | if RespStart <> nil then txtImmedColl.Text := RespStart.EValue;
|
---|
2078 | end;
|
---|
2079 | end
|
---|
2080 | else // if (RespCollect = nil)
|
---|
2081 | LoadCollType(cbocollType);
|
---|
2082 | end;
|
---|
2083 | end;
|
---|
2084 | procedure TfrmODLab.pnlCollTimeButtonEnter(Sender: TObject);
|
---|
2085 | begin
|
---|
2086 | inherited;
|
---|
2087 | (Sender as TPanel).BevelOuter := bvRaised;
|
---|
2088 | end;
|
---|
2089 |
|
---|
2090 | procedure TfrmODLab.pnlCollTimeButtonExit(Sender: TObject);
|
---|
2091 | begin
|
---|
2092 | inherited;
|
---|
2093 | (Sender as TPanel).BevelOuter := bvNone;
|
---|
2094 | end;
|
---|
2095 |
|
---|
2096 | procedure TfrmODLab.ViewinReportWindow1Click(Sender: TObject);
|
---|
2097 | begin
|
---|
2098 | inherited;
|
---|
2099 | //ReportBox(memMessage.Lines, 'Lab Procedure', True); <-- original line. //kt 8/8/2007
|
---|
2100 | ReportBox(memMessage.Lines, DKLangConstW('fODLab_Lab_Procedure'), True); //kt added 8/8/2007
|
---|
2101 | end;
|
---|
2102 |
|
---|
2103 | end.
|
---|
2104 |
|
---|
2105 |
|
---|