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

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

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