source: cprs/trunk/CPRS-Chart/Orders/fODLab.pas@ 1679

Last change on this file since 1679 was 1679, checked in by healthsevak, 9 years ago

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