source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fODLab.pas@ 459

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

Adding foia-cprs branch

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