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

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

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