source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fODBBank.pas@ 1676

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

Uploading from OR_30_258
File size: 81.2 KB
RevLine 
[460]1unit fODBBank;
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, ImgList;
9
10type
11 TfrmODBBank = class(TfrmODBase)
12 pnlBB: TPanel;
13 pnlFull: TPanel;
14 pgeProduct: TPageControl;
15 tabInfo: TTabSheet;
16 edtInfo: TCaptionRichEdit;
17 TabDiag: TTabSheet;
18 lblReqComment: TOROffsetLabel;
19 pnlFields: TPanel;
20 dlgLabCollTime: TORDateTimeDlg;
21 ORWanted: TORDateTimeDlg;
22 lblDiagComment: TOROffsetLabel;
23 txtDiagComment: TCaptionEdit;
24 pnlSelectedTests: TGroupBox;
25 lvSelectionList: TCaptionListView;
26 lblUrgency: TLabel;
27 cboUrgency: TORComboBox;
28 lblCollType: TLabel;
29 cboCollType: TORComboBox;
30 chkConsent: TCheckBox;
31 lblPreparation: TLabel;
32 calWantTime: TORDateBox;
33 lblWanted: TLabel;
34 tReason: TEdit;
35 lblReason: TLabel;
36 cboSurgery: TORComboBox;
37 lblSurgery: TLabel;
38 txtImmedColl: TCaptionEdit;
39 cboCollTime: TORComboBox;
40 lblCollTime: TLabel;
41 cmdImmedColl: TSpeedButton;
42 pnlCollTimeButton: TKeyClickPanel;
43 calCollTime: TORDateBox;
44 cboPreparation: TORComboBox;
45 btnRemove: TButton;
46 btnRemoveAll: TButton;
47 pnlTop: TPanel;
48 pnlSelect: TPanel;
49 pnlDiagTests: TGroupBox;
50 cboAvailTest: TORComboBox;
51 pnlBloodComponents: TGroupBox;
52 lblQuantity: TLabel;
53 cboAvailComp: TORComboBox;
54 tQuantity: TEdit;
55 upQuantity: TUpDown;
56 TabResults: TTabSheet;
57 edtResults: TCaptionRichEdit;
58 btnAddTests: TORAlignSpeedButton;
59 ImageList1: TImageList;
60 lblModifiers: TLabel;
61 cboModifiers: TORComboBox;
62 lblTNS: TLabel;
63 procedure FormCreate(Sender: TObject);
64 procedure cboAvailTestSelect(Sender: TObject);
65 procedure cboAvailCompSelect(Sender: TObject);
66 procedure DisableCommentPanels;
67 procedure DisableComponentControls;
68 procedure DisableDiagTestControls;
69 procedure EnableComponentControls;
70 procedure EnableDiagTestControls;
71 procedure cboAvailTestExit(Sender: TObject);
72 procedure cboAvailCompExit(Sender: TObject);
73 procedure cboAvailTestNeedData(Sender: TObject;
74 const StartFrom: String; Direction, InsertAt: Integer);
75 procedure cboAvailCompNeedData(Sender: TObject;
76 const StartFrom: String; Direction, InsertAt: Integer);
77 procedure cmdImmedCollClick(Sender: TObject);
78 procedure pgeProductChange(Sender: TObject);
79 procedure cboCollTypeChange(Sender: TObject);
80 procedure btnAddTestsClick(Sender: TObject);
81 procedure FormDestroy(Sender: TObject);
82 procedure btnRemoveClick(Sender: TObject);
83 procedure btnRemoveAllClick(Sender: TObject);
84 procedure cmdAcceptClick(Sender: TObject);
85 procedure calWantTimeChange(Sender: TObject);
86 procedure chkConsentClick(Sender: TObject);
87 procedure cboUrgencyChange(Sender: TObject);
88 procedure txtDiagCommentChange(Sender: TObject);
89 procedure cboPreparationChange(Sender: TObject);
90 procedure cboSurgeryChange(Sender: TObject);
91 procedure tReasonChange(Sender: TObject);
92 procedure calCollTimeChange(Sender: TObject);
93 protected
94 FCmtTypes: TStringList ;
95 procedure InitDialog; override;
96 function ValidCollTime(UserEntry: string): string;
97 procedure GetAllCollSamples(AComboBox: TORComboBox);
98 procedure GetAllSpecimens(AComboBox: TORComboBox);
99 procedure SetupCollTimes(CollType: string);
100 procedure LoadCollType(AComboBox:TORComboBox);
101 function ValidAdd: Boolean;
102 procedure ValidateAdd(var AnErrMsg: string);
103 procedure Validate(var AnErrMsg: string); override;
104 procedure ExtractMSBOS(OutList:TStrings; AList:TStrings);
105 procedure ExtractTests(OutList:TStrings; AList:TStrings);
106 procedure ExtractSurgeries(OutList:TStrings; AList:TStrings);
107 procedure ExtractUrgencies(OutList:TStrings; AList:TStrings);
108 procedure ExtractModifiers(OutList:TStrings; AList:TStrings);
109 procedure ExtractSpecimens(OutList:TStrings; AList:TStrings);
110 procedure ExtractTypeScreen(OutList:TStrings; AList:TStrings);
111 procedure ExtractPatientInfo(OutList:TStrings; AList:TStrings);
112 procedure ExtractSpecimen(OutList:TStrings; AList:TStrings);
113 function SpecimenNeeded(OutList:TStrings; AList:TStrings; CompID:integer): Boolean;
114 procedure LoadUrgencies(AComboBox:TORComboBox);
115 procedure LoadModifiers(AComboBox:TORComboBox);
116 private
117 FLastCollType: string;
118 FLastCollTime: string;
119 FLastLabCollTime: string;
120 FLastLabID: string;
121 FLastItemID: string;
122 FEvtDelayLoc: integer;
123 FEvtDivision: integer;
124 FVbecLookup: string;
125 procedure ReadServerVariables;
126 public
127 procedure SetupDialog(OrderAction: Integer; const ID: string); override;
128 procedure LoadRequiredComment(CmtType: integer);
129 procedure DetermineCollectionDefaults(Responses: TResponses);
130 property EvtDelayLoc: integer read FEvtDelayLoc write FEvtDelayLoc;
131 property EvtDivision: integer read FEvtDivision write FEvtDivision;
132 end;
133
134type
135 TCollSamp = class(TObject)
136 CollSampID: Integer; { IEN of CollSamp }
137 CollSampName: string; { Name of CollSamp }
138 SpecimenID: Integer; { IEN of default specimen }
139 SpecimenName: string; { Name of the specimen }
140 TubeColor: string; { TubeColor (text) }
141 MinInterval: Integer; { Minimum days between orders }
142 MaxPerDay: Integer; { Maximum orders per day }
143 LabCanCollect: Boolean; { True if lab can collect }
144 SampReqComment: string; { Name of required comment }
145 WardComment: TStringList; { CollSamp specific comment }
146 end;
147
148 TLabTest = class(TObject)
149 TestID: Integer; { IEN of Lab Test }
150 TestName: string; { Name of Lab Test }
151 ItemID: Integer; { Orderable Item ID }
152 LabSubscript: string ; { which section of Lab? }
153 CollSamp: Integer; { index into CollSampList }
154 Specimen: Integer; { IEN of specimen }
155 Comment: TStringList; { text of comment }
156 TestReqComment: string; { Name of required comment }
157 CurReqComment: string; { name of required comment }
158 CurWardComment: TStringList; { WP of Ward Comment }
159 UniqueCollSamp: Boolean; { true if not prompt CollSamp }
160 CollSampList: TList; { collection sample objects }
161 CollSampCount: integer; { count of original contents of CollSampList}
162 SpecimenList: TStringList; { Strings: IEN^Specimen Name }
163 SpecListCount: integer; { count of original contents of SpecimenList}
164 SurgeryList: TStringList; { Strings: Surgeries}
165 PatientInfo: TStringList; { Text of Patient Information}
166 ResultsDisplay: TStringList; { Text of Test Results}
167 QuickOrderResponses: TResponses; { if created as a result of a quick order selection}
168 { functions & procedures }
169 constructor Create(const LabTestIEN: string; Responses: TResponses);
170 destructor Destroy; override ;
171 function IndexOfCollSamp(CollSampIEN: Integer): Integer;
172 procedure FillCollSampList(LoadData: TStringList; DfltCollSamp: Integer);
173 procedure LoadAllSamples;
174 procedure SetCollSampDflts;
175 procedure ChangeCollSamp(CollSampIEN: Integer);
176 procedure ChangeSpecimen(const SpecimenIEN: string);
177 procedure ChangeComment(const CommentText: string);
178 function LabCanCollect: Boolean;
179 procedure LoadCollSamp(AComboBox: TORComboBox);
180 procedure LoadSpecimen(AComboBox: TORComboBox);
181 function NameOfCollSamp: string;
182 function NameOfSpecimen: string;
183 function ObtainCollSamp: Boolean;
184 function ObtainSpecimen: Boolean;
185 function ObtainComment: Boolean;
186 end;
187
188const
189 CmtType: array[0..6] of string = ('ANTICOAGULATION','DOSE/DRAW TIMES','ORDER COMMENT',
190 'ORDER COMMENT MODIFIED','TDM (PEAK-TROUGH)',
191 'TRANSFUSION','URINE VOLUME');
192var
193 frmODBBank: TfrmODBBank;
194
195implementation
196
197{$R *.dfm}
198
199uses rODBase, rODLab, uCore, rCore, fODLabOthCollSamp, fODLabOthSpec, fODLabImmedColl, fLabCollTimes,
200 rOrders, uODBase, fRptBox;
201
202var
203 uSelectedItems: TStringList; //Selected Items in ListView- if TestYes =1 then test else component
204 //TestYes(1)^Test-Component(2)^Qty(3)^Sample(4,5)^Specimen(6,7)^Modifier(8)
205 uVBECList: TStringList; //List of items from VBEC api
206 uTestsForResults: TStringList; //List of tests to show results
207 uUrgencyList: TStringList; //List of Urgencies
208 uModifierList: TStringList; //List of Modifiers
209 uRaw: TStringList; //Results Array
210 uTestSelected, uComponentSelected: Boolean; //Used on Validate
211 uDfltUrgency: Integer;
212 uSpecimen, uGetTnS: Integer; //Set to 1 if a specimen for test is already in lab... no need to collect
213 uDfltCollType: string;
214 ALabTest: TLabTest;
215 UserHasLRLABKey: boolean;
216 LRFZX : string; //the default collection type (LC,WC,SP,I)
217 LRFSAMP : string; //the default sample (ptr)
218 LRFSPEC : string; //the default specimen (ptr)
219 LRFDATE : string; //the default collection time (NOW,NEXT,AM,PM,T...)
220 LRFURG : string; //the default urgency (number) TRY '2'
221 LRFSCH : string; //the default schedule? (ONE TIME, QD, ...)
222 LRORDERMODE : Integer; //the mode being used to order (component or diagnostic test)
223
224const
225 TX_NO_TEST = 'A Lab Test must be specified.' ;
226 TX_NO_IMMED = 'Immediate collect is not available for this test/sample';
227 TX_NO_IMMED_CAP = 'Invalid Collection Type';
228
229 TI_INFO = 0; //Corresponds with pgeProduct TabIndex
230 TI_ORDER = 1;
231 TI_RESULTS = 2;
232
233 TORDER_MODE_INFO = 0;
234 TORDER_MODE_DIAG = 1;
235 TORDER_MODE_COMP = 2;
236
237procedure TfrmODBBank.FormCreate(Sender: TObject);
238var
239 i: integer;
240 AList, ATests: TStringList;
241begin
242 AutoSizeDisabled := True;
243 inherited;
244 AList := TStringList.Create;
245 ATests := TStringList.Create;
246 uSelectedItems := TStringList.Create;
247 uVBECList := TStringList.Create;
248 uTestsForResults := TStringList.Create;
249 uUrgencyList := TStringList.Create;
250 uModifierList := TStringList.Create;
251 uRaw := TStringList.Create;
252 uSpecimen := 0;
253 uGetTnS := 0;
254 lblTNS.Caption := '';
255 lblTNS.Visible := false;
256 uDfltUrgency := 9;
257 TabResults.ImageIndex := 0;
258 Responses.Clear;
259 try
260 LRFZX := '';
261 LRFSAMP := '';
262 LRFSPEC := '';
263 LRFDATE := '';
264 LRFURG := '';
265 LRFSCH := '';
266 LRORDERMODE := TORDER_MODE_INFO;
267 DisableComponentControls;
268 DisableDiagTestControls;
269 FLastColltime := '';
270 FLastLabCollTime := '';
271 FLastItemID := '';
272 uDfltCollType := '';
273 FillerID := 'LR';
274 FEvtDelayLoc := 0;
275 FEvtDivision := 0;
276 UserHasLRLABKey := User.HasKey('LRLAB');
277 AllowQuickOrder := True;
278 StatusText('Loading Dialog Definition');
279 lblReqComment.Visible := False ;
280 lblModifiers.Enabled := False;
281 cboModifiers.Enabled := False;
282 FCmtTypes := TStringList.Create;
283 for i := 0 to 6 do FCmtTypes.Add(CmtType[i]) ;
284 Responses.Dialog := 'VBEC BLOOD BANK'; // loads formatting info
285 StatusText('Loading Default Values');
286 if Self.EvtID > 0 then
287 begin
288 EvtDelayLoc := StrToIntDef(GetEventLoc1(IntToStr(Self.EvtID)),0);
289 EvtDivision := StrToIntDef(GetEventDiv1(IntToStr(Self.EvtID)),0);
290 if EvtDelayLoc>0 then
291 AList.Assign(ODForLab(EvtDelayLoc,EvtDivision))
292 else
293 AList.Assign(ODForLab(Encounter.Location,EvtDivision));
294 end else
295 AList.Assign(ODForLab(Encounter.Location)); // ODForLab returns TStrings with defaults
296 CtrlInits.LoadDefaults(AList);
297 InitDialog;
298 with CtrlInits do
299 begin
300 SetControl(cboCollType, 'Collection Types');
301 uDfltCollType := ExtractDefault(AList, 'Collection Types');
302 if uDfltCollType <> '' then
303 cboCollType.SelectByID(uDfltCollType)
304 else if OrderForInpatient then
305 cboCollType.SelectByID('LC')
306 else
307 cboCollType.SelectByID('SP');
308 SetupCollTimes(cboCollType.ItemID);
309 StatusText('Initializing List of Tests');
310 FVbecLookup := 'S.VBT';
311 cboAvailTest.InitLongList('');
312 end;
313 cboAvailComp.Clear;
314 aList.Clear;
315 GetBloodComponents(aList); //Get Components in right order
316 for i := 0 to aList.Count - 1 do
317 cboAvailComp.Items.Add(aList[i]);
318 uVBECList.Clear;
319 edtInfo.Clear;
320 cboSurgery.Clear;
321 GetPatientBBInfo(uVBECList, Patient.DFN, Encounter.Location);
322 aList.Clear;
323 ExtractPatientInfo(AList, uVBECList);
324 QuickCopy(AList, edtInfo);
325 AList.Clear;
326 ExtractSurgeries(AList, uVBECList);
327 for i := 0 to AList.Count - 1 do
328 cboSurgery.Items.Add(AList[i]);
329 AList.Clear;
330 ExtractUrgencies(uUrgencyList, uVBECList);
331 LoadUrgencies(cboUrgency);
332 cboUrgency.SelectByID(IntToStr(uDfltUrgency));
333 ExtractModifiers(uModifierList, uVBECList);
334 LoadModifiers(cboModifiers);
335 calWantTime.Text := FormatFMDateTime('mmm dd,yyyy@hh:nn',DateTimeToFMDateTime(Now));
336 //cboPreparation.SelectByID('I');
337 memMessage.Visible := false;
338 memOrder.Visible := false;
339 cmdAccept.Visible := false;
340 pgeProduct.TabIndex := TI_INFO;
341 lvSelectionList.Column[0].Width := 200;
342 lvSelectionList.Column[1].Width := 40;
343 pgeProduct.ActivePageIndex := TI_INFO;
344 PreserveControl(cboAvailTest);
345 PreserveControl(cboAvailComp);
346 PreserveControl(cboCollType);
347 PreserveControl(cboCollTime);
348 PreserveControl(calCollTime);
349 PreserveControl(calWantTime);
350 StatusText('');
351
352 finally
353 AList.Free;
354 ATests.Free;
355 end;
356end;
357
358procedure TfrmODBBank.InitDialog;
359begin
360 inherited;
361 Changing := True;
362 if ALabTest <> nil then
363 begin
364 ALabTest.Destroy;
365 ALabTest := nil;
366 end;
367 DisableCommentPanels;
368 cboAvailTest.SelectByID(FLastItemID);
369 cboAvailComp.SelectByID(FLastItemID);
370 cboAvailTest.ItemIndex := -1;
371 StatusText('');
372 Changing := False ;
373end;
374
375procedure TfrmODBBank.SetupDialog(OrderAction: Integer; const ID: string);
376var
377 tmpResp: TResponse;
378 i: integer;
379begin
380 inherited;
381 ReadServerVariables;
382 if LRFZX <> '' then
383 begin
384 cboCollType.SelectByID(LRFZX);
385 if cboCollType.ItemIndex > -1 then SetupCollTimes(LRFZX);
386 end;
387 if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses, ALabTest do
388 begin
389 SetControl(cboAvailTest, 'ORDERABLE', 1);
390 cboAvailTestSelect(Self);
391 if ALabTest = nil then Exit; // Causes access violation in FillCollSampleList
392 Changing := True;
393 DetermineCollectionDefaults(Responses);
394 i := 1 ;
395 tmpResp := Responses.FindResponseByName('COMMENT',i);
396 while tmpResp <> nil do
397 begin
398 Comment.Add(tmpResp.EValue);
399 Inc(i);
400 tmpResp := Responses.FindResponseByName('COMMENT',i);
401 end ;
402 Changing := False;
403 end;
404end;
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 ItemID := StrToInt(Piece(ExtractDefault(LoadData, 'Item ID'),U,1));
422 LabSubscript := Piece(ExtractDefault(LoadData, 'Item ID'),U,2);
423 TestReqComment := ExtractDefault(LoadData, 'ReqCom');
424 if Length(ExtractDefault(LoadData, 'Unique CollSamp')) > 0 then UniqueCollSamp := True;
425 x := ExtractDefault(LoadData, 'Unique CollSamp');
426 if Length(x) = 0 then x := ExtractDefault(LoadData, 'Lab CollSamp');
427 if Length(x) = 0 then x := ExtractDefault(LoadData, 'Default CollSamp');
428 if Length(x) = 0 then x := '-1';
429 DfltCollSamp := StrToInt(x);
430 SpecimenList := TStringList.Create;
431 ExtractItems(SpecimenList, LoadData, 'Specimens');
432 if LRFSPEC <> '' then SpecimenList.Add(GetOneSpecimen(StrToInt(LRFSPEC)));
433 Comment := TStringList.Create ;
434 CurWardComment := TStringList.Create;
435 ExtractText(CurWardComment, LoadData, 'GenWardInstructions');
436 CollSamp := 0;
437 CollSampList := TList.Create;
438 FillCollSampList(LoadData, DfltCollSamp);
439 with QuickOrderResponses do tmpResp := FindResponseByName('SAMPLE' ,1);
440 if (LRFSAMP <> '') and (IndexOfCollSamp(StrToInt(LRFSAMP)) < 0) and
441 (not UniqueCollSamp) and (tmpResp = nil) then
442 begin
443 OneSamp := TStringList.Create;
444 try
445 OneSamp.Assign(GetOneCollSamp(StrToInt(LRFSAMP)));
446 FillCollSampList(OneSamp, CollSampList.Count);
447 finally
448 OneSamp.Free;
449 end;
450 end;
451 if (not UniqueCollSamp) and (CollSampList.Count = 0) then LoadAllSamples;
452 CollSampCount := CollSampList.Count;
453 end;
454 finally
455 LoadData.Free;
456 end;
457 SetCollSampDflts;
458end;
459
460destructor TLabTest.Destroy;
461var
462 i: Integer;
463begin
464 if CollSampList <> nil then
465 with CollSampList do for i := 0 to Count - 1 do
466 with TCollSamp(Items[i]) do
467 begin
468 WardComment.Free;
469 Free;
470 end;
471 CollSampList.Free;
472 SpecimenList.Free;
473 CurWardComment.Free;
474 Comment.Free;
475 inherited Destroy;
476end;
477
478function TLabTest.IndexOfCollSamp(CollSampIEN: Integer): Integer;
479var
480 i: Integer;
481begin
482 Result := -1;
483 with CollSampList do for i := 0 to Count - 1 do with TCollSamp(Items[i]) do
484 if CollSampIEN = CollSampID then
485 begin
486 Result := i;
487 break;
488 end;
489end;
490
491procedure TLabTest.LoadAllSamples;
492var
493 LoadList, SpecList: TStringList;
494 i: Integer;
495begin
496 LoadList := TStringList.Create;
497 SpecList := TStringList.Create;
498 try
499 LoadSamples(LoadList) ;
500 FillCollSampList(LoadList, 0);
501 ExtractItems(SpecList, LoadList, 'Specimens');
502 with SpecList do for i := 0 to Count - 1 do
503 if SpecimenList.IndexOf(Strings[i]) = -1 then SpecimenList.Add(Strings[i]);
504 finally
505 LoadList.Free;
506 SpecList.Free;
507 end;
508end;
509
510procedure TLabTest.FillCollSampList(LoadData: TStringList; DfltCollSamp: Integer);
511{1 2 3 4 5 6 7 8 9 10 }
512{n^IEN^CollSampName^SpecIEN^TubeTop^MinInterval^MaxPerDay^LabCollect^SampReqCommentIEN;name^SpecName}
513var
514 i, LastListItem, AnIndex: Integer;
515 ACollSamp: TCollSamp;
516 LabCollSamp: Integer;
517begin
518 i := -1;
519 if CollSampList = nil then CollSampList := TList.Create;
520 LastListItem := CollSampList.Count ;
521 LabCollSamp := StrToIntDef(ExtractDefault(LoadData, 'Lab CollSamp'), 0);
522 repeat Inc(i) until (i = LoadData.Count) or (LoadData[i] = '~CollSamp');
523 Inc(i);
524 if i < LoadData.Count then repeat
525 if LoadData[i][1] = 'i' then
526 begin
527 ACollSamp := TCollSamp.Create;
528 with ACollSamp do
529 begin
530 AnIndex := StrToIntDef(Copy(Piece(LoadData[i], '^', 1), 2, 999), -1);
531 CollSampID := StrToInt(Piece(LoadData[i], '^', 2));
532 CollSampName := Piece(LoadData[i], '^', 3);
533 SpecimenID := StrToIntDef(Piece(LoadData[i], '^', 4), 0);
534 SpecimenName := Piece(LoadData[i], '^', 10);
535 TubeColor := Piece(LoadData[i], '^', 5);
536 MinInterval := StrToIntDef(Piece(LoadData[i], '^', 6), 0);
537 MaxPerDay := StrToIntDef(Piece(LoadData[i], '^', 7), 0);
538 LabCanCollect := AnIndex = LabCollSamp;
539 SampReqComment := Piece(LoadData[i], '^', 9);
540 WardComment := TStringList.Create;
541 if CollSampID = StrToIntDef(LRFSAMP, 0) then
542 CollSamp := CollSampID
543 else if AnIndex = DfltCollSamp then
544 CollSamp := CollSampID;
545 end; {with}
546 LastListItem := CollSampList.Add(ACollSamp);
547 end; {if}
548 if (LoadData[i][1] = 't') then
549 TCollSamp(CollSampList.Items[LastListItem]).WardComment.Add(Copy(LoadData[i], 2, 255));
550 Inc(i);
551 until (i = LoadData.Count) or (LoadData[i][1] = '~');
552end;
553
554procedure TLabTest.SetCollSampDflts;
555var
556 tmpResp: TResponse;
557begin
558 Specimen := 0;
559 Comment.Clear;
560 CurReqComment := TestReqComment;
561 if CollSamp = 0 then Exit;
562 with QuickOrderResponses do tmpResp := FindResponseByName('SPECIMEN' ,1);
563 if (LRFSPEC <> '') and (tmpResp = nil) then
564 ChangeSpecimen(LRFSPEC)
565 else with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
566 begin
567 Specimen := SpecimenID;
568 if SampReqcomment <> '' then CurReqComment := SampReqComment;
569 end;
570end;
571
572procedure TLabTest.ChangeCollSamp(CollSampIEN: Integer);
573begin
574 CollSamp := CollSampIEN;
575 SetCollSampDflts;
576end;
577
578procedure TLabTest.ChangeSpecimen(const SpecimenIEN: string);
579begin
580 Specimen := StrToIntDef(SpecimenIEN,0);
581end;
582
583procedure TLabTest.ChangeComment(const CommentText: string);
584begin
585 Comment.Add(CommentText);
586end;
587
588function TLabTest.LabCanCollect: Boolean;
589var
590 i: Integer;
591begin
592 Result := False;
593 i := IndexOfCollSamp(CollSamp);
594 if i > -1 then with TCollSamp(CollSampList.Items[i]) do Result := LabCanCollect;
595end;
596
597procedure TLabTest.LoadCollSamp(AComboBox: TORComboBox);
598{ loads the collection sample combo box, expects CollSamp to already be set to default }
599var
600 i: Integer;
601 x: string;
602begin
603 AComboBox.Clear;
604 with CollSampList do for i := 0 to Count - 1 do with TCollSamp(Items[i]) do
605 begin
606 x := IntToStr(CollSampID) + '^' + CollSampName;
607 if Length(TubeColor) <> 0 then x := x + ' (' + TubeColor + ')';
608 AComboBox.Items.Add(x);
609 if CollSamp = CollSampID then AComboBox.ItemIndex := i;
610 end;
611 if ((ALabTest.LabSubscript = 'CH') and (not UserHasLRLABKey)) then
612 begin
613 // do not add 'Other' (coded this way for clarity)
614 end
615 else
616 with AComboBox do
617 begin
618 Items.Add('0^Other...');
619 if ItemIndex < 0 then ItemIndex := Items.IndexOf('Other...');
620 end;
621end;
622
623procedure TLabTest.LoadSpecimen(AComboBox: TORComboBox);
624{ loads specimen combo box, if SpecimenList is empty, use 'E' xref on 61 ?? }
625var
626 i: Integer;
627 tmpResp: TResponse;
628begin
629 AComboBox.Clear;
630 if ObtainSpecimen then
631 begin
632 if SpecimenList.Count = 0 then LoadSpecimens(SpecimenList) ;
633 AComboBox.Items.Assign(SpecimenList);
634 AComboBox.Items.Add('0^Other...');
635 with QuickOrderResponses do tmpResp := FindResponseByName('SPECIMEN' ,1);
636 if (LRFSPEC <> '') and (tmpResp = nil) then
637 AComboBox.SelectByID(LRFSPEC)
638 else if Specimen > 0 then
639 AComboBox.SelectByIEN(Specimen)
640 else
641 AComboBox.ItemIndex := AComboBox.Items.IndexOf('Other...');
642 end
643 else
644 begin
645 i := IndexOfCollSamp(CollSamp);
646 if i < CollSampList.Count then with TCollSamp(CollSampList.Items[i]) do
647 begin
648 AComboBox.Items.Add(IntToStr(SpecimenID) + '^' + SpecimenName);
649 AComboBox.ItemIndex := 0;
650 end;
651 with QuickOrderResponses do tmpResp := FindResponseByName('SPECIMEN' ,1);
652 if (LRFSPEC <> '') and (tmpResp = nil) then
653 begin
654 AComboBox.Items.Add(GetOneSpecimen(StrToInt(LRFSPEC)));
655 AComboBox.SelectByID(LRFSPEC);
656 end;
657 end;
658 ChangeSpecimen(AComboBox.ItemID);
659end;
660
661function TLabTest.NameOfCollSamp: string;
662var
663 i: Integer;
664begin
665 Result := '';
666 i := IndexOfCollSamp(CollSamp);
667 if i > -1 then with TCollSamp(CollSampList.Items[i]) do Result := CollSampName;
668end;
669
670function TLabTest.NameOfSpecimen: string;
671var
672 i: Integer;
673begin
674 Result := '';
675 if CollSamp > 0 then with TCollSamp(CollSampList[IndexOfCollSamp(CollSamp)]) do
676 if (Specimen > 0) and (Specimen = SpecimenID) then Result := SpecimenName;
677 if (Length(Result) = 0) and (Specimen > 0) then with SpecimenList do
678 for i := 0 to Count - 1 do if Specimen = StrToInt(Piece(Strings[i], '^', 1)) then
679 begin
680 Result := Piece(Strings[i], '^', 2);
681 break;
682 end;
683end;
684
685function TLabTest.ObtainCollSamp: Boolean;
686begin
687 Result := (not UniqueCollSamp);
688end;
689
690function TLabTest.ObtainSpecimen: Boolean;
691var
692 i: Integer;
693begin
694 Result := True;
695 i := IndexOfCollSamp(CollSamp);
696 if (i > -1) and (i < CollSampList.Count) then with TCollSamp(CollSampList.Items[i]) do
697 if SpecimenID > 0 then Result := False;
698end;
699
700function TLabTest.ObtainComment: Boolean;
701begin
702 Result := Length(CurReqComment) > 0;
703end;
704
705procedure TfrmODBBank.ExtractModifiers(OutList:TStrings; AList:TStrings);
706begin
707 ExtractItems(Outlist, AList,'MODIFIERS');
708end;
709
710procedure TfrmODBBank.ExtractUrgencies(OutList:TStrings; AList:TStrings);
711begin
712 ExtractItems(Outlist, AList,'URGENCIES');
713end;
714
715procedure TfrmODBBank.ExtractSurgeries(OutList:TStrings; AList:TStrings);
716begin
717 ExtractItems(OutList, AList,'SURGERIES');
718end;
719
720procedure TfrmODBBank.ExtractSpecimens(OutList:TStrings; AList:TStrings);
721begin
722 ExtractItems(OutList, AList,'SPECIMENS');
723end;
724
725procedure TfrmODBBank.ExtractTypeScreen(OutList:TStrings; AList:TStrings);
726begin
727 ExtractItems(OutList, AList, 'TYPE AND SCREEN');
728end;
729
730procedure TfrmODBBank.ExtractSpecimen(OutList:TStrings; AList:TStrings);
731begin
732 ExtractItems(OutList, AList, 'SPECIMEN');
733end;
734
735procedure TfrmODBBank.ExtractPatientInfo(OutList:TStrings; AList:TStrings);
736begin
737 ExtractItems(OutList, AList, 'INFO');
738end;
739
740procedure TfrmODBBank.ExtractTests(OutList:TStrings; AList:TStrings);
741begin
742 ExtractItems(OutList, AList, 'TESTS');
743end;
744
745procedure TfrmODBBank.ExtractMSBOS(OutList:TStrings; AList:TStrings);
746begin
747 ExtractItems(OutList, AList, 'MSBOS');
748end;
749
750function TfrmODBBank.SpecimenNeeded(OutList:TStrings; AList:TStrings; CompID:integer): Boolean;
751var
752 i:integer;
753 aborh: boolean;
754 aSpecimen, aSpecimenDate: string;
755 aWantDateTime, aExpiredSpecimenDate: TFMDateTime;
756begin
757 result := false;
758 aborh := false;
759 aSpecimen := '';
760 OutList.Clear;
761 ExtractItems(OutList,Alist,'ABORH');
762 for i := 0 to OutList.Count - 1 do
763 begin
764 if Length(OutList[i])>1 then
765 begin
766 aborh := true;
767 end;
768 end;
769 if aborh = false then
770 begin
771 result := true;
772 exit;
773 end;
774 OutList.Clear;
775 ExtractSpecimen(OutList, uVBECList);
776 if OutList.Count > 0 then aSpecimen := OutList[0];
777 OutList.Clear;
778 ExtractItems(OutList,AList,'SPECIMENS');
779 aWantDateTime := calWantTime.FMDateTime;
780 aSpecimenDate := piece(aSpecimen,'^',1);
781 aExpiredSpecimenDate := 0;
782 if Length(aSpecimenDate) > 0 then aExpiredSpecimenDate := StrToFloat(aSpecimenDate);
783
784 for i := 0 to OutList.Count - 1 do
785 begin
786 if (IntToStr(aLabTest.ItemID) = piece(OutList[i],'^',1)) and (piece(OutList[i],'^',2) = '1') then
787 if aSpecimen = '' then
788 begin
789 result := true;
790 exit;
791 end
792 else if (Length(calWantTime.Text) > 0) and (aExpiredSpecimenDate < aWantDateTime) then
793 begin
794 result := true;
795 exit;
796 end;
797 end;
798end;
799
800procedure TfrmODBBank.Validate(var AnErrMsg: string);
801
802 procedure SetError(const x: string);
803 begin
804 if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
805 AnErrMsg := AnErrMsg + x;
806 end;
807
808const
809 TX_NO_TESTS = 'No Tests or Components selected' ;
810 TX_TNS_REQUIRED = 'An order for TYPE and SCREEN must be created for this order set' ;
811
812begin
813 inherited;
814 if uSelectedItems.Count < 1 then
815 SetError(TX_NO_TESTS);
816 if uGetTns = 1 then
817 SetError(TX_TNS_REQUIRED);
818end;
819
820procedure TfrmODBBank.ValidateAdd(var AnErrMsg: string);
821
822 procedure SetError(const x: string);
823 begin
824 if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
825 AnErrMsg := AnErrMsg + x;
826 end;
827
828var
829 i, CmtType, DaysofFuturePast: integer;
830 d1, d2: TDateTime;
831 x: string;
832const
833 {Diagnostic Test Errors}
834 TX_NO_TIME = 'Collection Time is required.' ;
835 TX_NO_TCOLLTYPE = 'Collection Type is required.' ;
836 TX_NO_TESTS = 'A Lab Test or tests must be selected.' ;
837 TX_BAD_TIME = 'Collection times must be chosen from the drop down list or entered as valid' +
838 ' Fileman date/times (T@1700, T+1@0800, etc.).' ;
839 TX_PAST_TIME = 'Collection times in the past are not allowed.';
840 TX_NO_DAYS = 'A number of days must be entered for continuous orders.';
841 TX_NO_TIMES = 'A number of times must be entered for continuous orders.';
842 TX_NO_STOP_DATE = 'Could not calculate the stop date for the order. Check "for n Days".';
843 TX_TOO_MANY_DAYS = 'Maximum number of days allowed is ';
844 TX_TOO_MANY_TIMES = 'For this frequency, the maximum number of times allowed is: X';
845 //TX_NO_COMMENT = 'A comment is required for this test and collection sample.';
846 TX_NUMERIC_REQD = 'A numeric value is required for urine volume.';
847 TX_DOSEDRAW_REQD = 'Both DOSE and DRAW times are required for this order.';
848 TX_TDM_REQD = 'A value for LEVEL is required for this order.';
849 //TX_ANTICOAG_REQD = 'You must specify an anticoagulant on this order.' ;
850 TX_NO_COLLSAMPLE = 'A collection sample MUST be specified.';
851 TX_NO_SPECIMEN = 'A specimen MUST be specified.';
852 TX_NO_URGENCY = 'An urgency MUST be specified.';
853 TX_NO_FREQUENCY = 'A collection frequency MUST be specified.';
854 TX_NOT_LAB_COLL_TIME = ' is not a routine lab collection time.';
855 TX_NO_ALPHA = 'For continuous orders, enter a number of days, or an "X" followed by a number of times.';
856 TX_BADTIME_CAP = 'Invalid Immediate Collect Time';
857 {Component/Type & Screen Errors}
858 TX_NO_COMPONENTS = 'A Blood Product MUST be selected.';
859 TX_NO_QUANTITY = 'The number of units MUST be specified under "Quantity".';
860 TX_HIGH_QUANTITY = 'Quantity too high.';
861 TX_NO_DATEMODIFIED= 'A Date/time Wanted MUST be specified';
862 //TX_NO_PREPARATION = 'Preparation MUST be specified - either "Hold" or "Immediate".';
863 TX_NO_SURGERY = 'A Surgery MUST be specified for Pre-Op orders'; //only if Pre-op selected
864 TX_NO_REASON = 'A Reason for Request MUST be entered';
865 TX_NO_COMMENT = 'A Comment MUST be entered for this Component';
866 TX_DUPLICATE = 'Duplicate Test/Component not allowed';
867 TX_NO_TEST_SELECTED = 'No Test/Component selected';
868
869begin
870 inherited;
871 AnErrMsg := '';
872 if aLabTest = nil then
873 begin
874 AnErrMsg := TX_NO_TEST_SELECTED;
875 Exit;
876 end;
877 for i := 0 to uSelectedItems.Count - 1 do
878 if IntToStr(aLabTest.TestID) = piece(uSelectedItems[i],'^',2) then
879 begin
880 AnErrMsg := TX_DUPLICATE;
881 Exit;
882 end;
883 if LRORDERMODE = TORDER_MODE_DIAG then
884 begin
885 with cboAvailTest do if ItemIEN <= 0 then SetError(TX_NO_TESTS);
886
887 if ALabTest <> nil then
888 if (cboCollType.ItemID = 'I') and (not ALabTest.LabCanCollect) then
889 begin
890 SetError(TX_NO_IMMED);
891 cboCollType.ItemIndex := -1;
892 end;
893 if uSpecimen = 0 then
894 if cboCollType.ItemID = '' then
895 SetError(TX_NO_TCOLLTYPE)
896 else if cboCollType.ItemID = 'LC' then
897 begin
898 if Length(cboCollTime.Text) = 0 then SetError(TX_NO_TIME);
899 with cboCollTime do if (Length(Text) > 0) and (ItemIndex = -1) then
900 begin
901 if StrToFMDateTime(Text) < 0 then
902 SetError(TX_BAD_TIME)
903 else if StrToFMDateTime(Text) < FMNow then
904 SetError(TX_PAST_TIME)
905 else if OrderForInpatient then
906 begin
907 d1 := FMDateTimeToDateTime(Trunc(StrToFMDateTime(cboColltime.Text)));
908 d2 := FMDateTimeToDateTime(FMToday);
909 if EvtDelayLoc > 0 then
910 DaysofFuturePast := LabCollectFutureDays(EvtDelayLoc,EvtDivision)
911 else
912 DaysofFuturePast := LabCollectFutureDays(Encounter.Location);
913 if DaysofFuturePast = 0 then DaysofFuturePast := 7;
914 if ((d1 - d2) > DaysofFuturePast) then
915 SetError('A lab collection cannot be ordered more than '
916 + IntToStr(DaysofFuturePast) + ' days in advance');
917 end
918 else if EvtDelayLoc > 0 then
919 begin
920 if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), EvtDelayLoc)) then
921 SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME);
922 end
923 else if EvtDelayLoc <= 0 then
924 begin
925 if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), Encounter.Location)) then
926 SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME);
927 end;
928 end;
929 end
930 else
931 begin
932 if cboCollType.ItemID = 'I' then
933 begin
934 calCollTime.Text := txtImmedColl.Text;
935 x := ValidImmCollTime(calCollTime.FMDateTime);
936 if (Piece(x, U, 1) <> '1') then
937 SetError(Piece(x, U, 2));
938 end;
939
940 with calColltime do
941 begin
942 if FMDateTime = 0 then SetError(TX_BAD_TIME)
943 else
944 begin
945 // date only was entered
946 if (FMDateTime - Trunc(FMDateTime) = 0) then
947 begin
948 if (Trunc(FMDateTime) < FMToday) then SetError(TX_PAST_TIME);
949 end
950 // date/time was entered
951 else
952 begin
953 if (UpperCase(Text) <> 'NOW') and (FMDateTime < FMNow) then SetError(TX_PAST_TIME);
954 end;
955 end;
956 end;
957 end;
958
959 with cboUrgency do if ItemIEN <= 0 then SetError(TX_NO_URGENCY);
960 if ALabTest <> nil then
961 begin
962 CmtType := FCmtTypes.IndexOf(ALabTest.CurReqComment) ;
963 with ALabTest do
964 case CmtType of
965 0 : {ANTICOAGULATION} {if (Pos('ANTICOAGULANT',Comment.Text)=0) then
966 SetError(TX_ANTICOAG_REQD)};
967 1 : {DOSE/DRAW TIMES} if (Pos('Last dose:',Comment.Text)=0) or
968 (Pos('draw time:',Comment.Text)=0) then
969 SetError(TX_DOSEDRAW_REQD);
970 2 : {ORDER COMMENT} {if (Length(Comment.Text)=0) then
971 SetError(TX_NO_COMMENT)};
972 3 : {ORDER COMMENT MODIFIED} {if (Length(Comment.Text)=0) then
973 SetError(TX_NO_COMMENT)};
974 4 : {TDM (PEAK-TROUGH} if (Pos('Dose is expected',Comment.Text)=0) then
975 SetError(TX_TDM_REQD);
976 5 : {TRANSFUSION} {if (Length(Comment.Text)=0) then
977 SetError(TX_NO_COMMENT)};
978 6 : {URINE VOLUME} if (Length(Comment.Text)>0) and
979 (ExtractInteger(Comment.Text)<=0) then
980 Comment.Text := '?';
981 {SetError(TX_NUMERIC_REQD);}
982 end;
983 end;
984 end
985 else if LRORDERMODE = TORDER_MODE_COMP then
986 begin
987 with cboAvailComp do
988 begin
989 if ItemIEN <= 0 then SetError(TX_NO_COMPONENTS);
990 end;
991 if StrToInt(tQuantity.Text) < 1 then SetError(TX_NO_QUANTITY);
992 if calWantTime.Text = '' then SetError(TX_NO_DATEMODIFIED);
993 //if cboPreparation.Text ='' then SetError(TX_NO_PREPARATION);
994 if StrToInt(tQuantity.Text) > 100 then SetError(TX_HIGH_QUANTITY);
995 if tReason.Text = '' then SetError(TX_NO_REASON);
996 if (txtDiagComment.Text = '') and (cboAvailComp.Text = 'OTHER') then SetError(TX_NO_COMMENT);
997 if (cboUrgency.Text = 'PRE-OP') and (length(cboSurgery.ItemID) < 1) then SetError(TX_NO_SURGERY);
998 end;
999end;
1000
1001function TfrmODBBank.ValidAdd: Boolean;
1002const
1003 TX_NO_SAVE = 'This item cannot be added for the following reason(s):' + CRLF + CRLF;
1004 TX_NO_SAVE_CAP = 'Unable to Add item';
1005 TX_SAVE_ERR = 'Unexpected error - it was not possible to Add this item.';
1006var
1007 ErrMsg: string;
1008
1009begin
1010 Result := True;
1011 ValidateAdd(ErrMsg);
1012 if Length(ErrMsg) > 0 then
1013 begin
1014 InfoBox(TX_NO_SAVE + ErrMsg, TX_NO_SAVE_CAP, MB_OK);
1015 Result := False;
1016 Exit;
1017 end;
1018end;
1019
1020function TfrmODBBank.ValidCollTime(UserEntry: string): string;
1021var
1022 i: integer;
1023const
1024 FMDateResponses: array[0..3] of string = ('TODAY','NOW','NOON','MID');
1025begin
1026 Result := '';
1027 UserEntry := UpperCase(UserEntry);
1028 if StrToFMDateTime(UserEntry) < 0 then exit;
1029 if (UserEntry = 'T') or
1030 (UserEntry = 'N') or
1031 (Copy(UserEntry,1,2)='T+') or
1032 (Copy(UserEntry,1,2)='T@') or
1033 (Copy(UserEntry,1,2)='T-') or
1034 (Copy(UserEntry,1,2)='N+') then Result := UserEntry
1035 else
1036 for i := 0 to 3 do if Pos(FMDateResponses[i],UserEntry)>0 then Result := UserEntry ;
1037 if Result = '' then Result := FloatToStr(StrToFMDateTime(UserEntry));
1038end;
1039
1040procedure TfrmODBBank.GetAllCollSamples(AComboBox: TORComboBox);
1041var
1042 OtherSamp: string;
1043begin
1044 with ALabTest, AComboBox do
1045 begin
1046 if ((CollSampList.Count + 1) <= AComboBox.Items.Count) then LoadAllSamples;
1047 OtherSamp := SelectOtherCollSample(Font.Size, CollSampCount, CollSampList);
1048 if OtherSamp = '-1' then exit;
1049 if SelectByID(Piece(OtherSamp, U, 1)) = -1 then
1050 if Items.Count > CollSampCount + 1 then
1051 Items[0] := OtherSamp
1052 else
1053 Items.Insert(0, OtherSamp) ;
1054 SelectByID(Piece(OtherSamp, U, 1));
1055 AComboBox.OnChange(Self);
1056 ActiveControl := cmdAccept;
1057 end;
1058end;
1059
1060procedure TfrmODBBank.GetAllSpecimens(AComboBox: TORComboBox);
1061var
1062 OtherSpec: string;
1063begin
1064 inherited;
1065 if ALabTest <> nil then
1066 with ALabTest, AComboBox do
1067 begin
1068 AComboBox.DroppedDown := False;
1069 OtherSpec := SelectOtherSpecimen(Font.Size, SpecimenList);
1070 if OtherSpec = '-1' then exit;
1071 if SelectByID(Piece(OtherSpec, U, 1)) = -1 then
1072 if Items.Count > SpecListCount + 1 then
1073 Items[0] := OtherSpec
1074 else
1075 Items.Insert(0, OtherSpec) ;
1076 SpecimenList.Add(OtherSpec);
1077 SelectByID(Piece(OtherSpec, U, 1));
1078 AComboBox.OnChange(Self);
1079 end;
1080end;
1081
1082procedure TfrmODBBank.SetupCollTimes(CollType: string);
1083var
1084 tmpImmTime, tmpTime: TFMDateTime;
1085 x, tmpORECALLType, tmpORECALLTime: string;
1086begin
1087 x := GetLastCollectionTime;
1088 tmpORECALLType := Piece(x, U, 1);
1089 tmpORECALLTime := Piece(x, U, 2);
1090 if CollType = 'SP' then
1091 begin
1092 cboColltime.Visible := False;
1093 txtImmedColl.Visible := False;
1094 pnlCollTimeButton.Visible := False;
1095 pnlCollTimeButton.TabStop := False;
1096 calCollTime.Visible := True;
1097 calColltime.Enabled := True;
1098 if FLastCollTime <> '' then
1099 begin
1100 calCollTime.Text := ValidCollTime(FLastColltime);
1101 if IsFMDateTime(calCollTime.Text) then
1102 begin
1103 calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
1104 calColltime.FMDateTime := StrToFMDateTime(FLastCollTime);
1105 end;
1106 end
1107 else if tmpORECALLTime <> '' then
1108 begin
1109 calCollTime.Text := ValidCollTime(tmpORECALLTime);
1110 if IsFMDateTime(calCollTime.Text) then
1111 begin
1112 calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
1113 calColltime.FMDateTime := StrToFMDateTime(tmpORECALLTime);
1114 end;
1115 end
1116 else if LRFDATE <> '' then
1117 calCollTime.Text := LRFDATE
1118 else
1119 calCollTime.Text := 'TODAY';
1120 end
1121 else if CollType = 'WC' then
1122 begin
1123 cboColltime.Visible := False;
1124 txtImmedColl.Visible := False;
1125 pnlCollTimeButton.Visible := False;
1126 pnlCollTimeButton.TabStop := False;
1127 calCollTime.Visible := True;
1128 calColltime.Enabled := True;
1129 if FLastCollTime <> '' then
1130 begin
1131 calCollTime.Text := ValidColltime(FLastColltime);
1132 if IsFMDateTime(calCollTime.Text) then
1133 begin
1134 calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
1135 calColltime.FMDateTime := StrToFMDateTime(FLastCollTime);
1136 end;
1137 end
1138 else if tmpORECALLTime <> '' then
1139 begin
1140 calCollTime.Text := ValidColltime(tmpORECALLTime);
1141 if IsFMDateTime(calCollTime.Text) then
1142 begin
1143 calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
1144 calColltime.FMDateTime := StrToFMDateTime(tmpORECALLTime);
1145 end;
1146 end
1147 else if LRFDATE <> '' then
1148 calCollTime.Text := LRFDATE
1149 else
1150 calCollTime.Text := 'NOW';
1151 end
1152 else if CollType = 'LC' then
1153 begin
1154 cboColltime.Visible := True;
1155 calCollTime.Visible := False;
1156 calColltime.Enabled := False;
1157 txtImmedColl.Visible := False;
1158 pnlCollTimeButton.Visible := False;
1159 pnlCollTimeButton.TabStop := False;
1160 with CtrlInits do SetControl(cboCollTime, 'Lab Collection Times');
1161 if Pos(U, FLastLabCollTime) > 0 then
1162 cboColltime.SelectByID(Piece(FLastLabCollTime, U, 1))
1163 else if FLastLabCollTime <> '' then
1164 cboCollTime.Text := FLastLabCollTime
1165 else if (tmpORECALLTime <> '') and (tmpORECALLType = 'LC') then
1166 cboCollTime.Text := MakeRelativeDateTime(StrToFMDateTime(tmpORECALLTime))
1167 else if LRFDATE <> '' then
1168 cboCollTime.Text := LRFDATE
1169 else
1170 cboCollTime.ItemIndex := 0;
1171 end
1172 else if CollType = 'I' then
1173 begin
1174 cboColltime.Visible := False;
1175 calCollTime.Visible := False;
1176 calColltime.Enabled := False;
1177 txtImmedColl.Visible := True;
1178 pnlCollTimeButton.Visible := True;
1179 pnlCollTimeButton.TabStop := True;
1180 tmpImmTime := GetDefaultImmCollTime;
1181 tmpTime := 0;
1182 if (FLastColltime <> '') then
1183 tmpTime := StrToFMDateTime(FLastColltime)
1184 else if (tmpORECALLTime <> '') then
1185 tmpTime := StrToFMDateTime(tmpORECALLTime)
1186 else if LRFDATE <> '' then
1187 tmpTime := StrToFMDateTime(LRFDATE);
1188
1189 if tmpTime > tmpImmTime then
1190 begin
1191 calCollTime.FMDateTime := tmpTime;
1192 txtImmedColl.Text := FormatFMDateTime('mmm dd,yy@hh:nn', tmpTime);
1193 end
1194 else
1195 begin
1196 calCollTime.FMDateTime := GetDefaultImmCollTime;
1197 txtImmedColl.Text := FormatFMDateTime('mmm dd,yy@hh:nn', calCollTime.FMDateTime);
1198 end;
1199 end;
1200end;
1201
1202procedure TfrmODBBank.LoadCollType(AComboBox:TORComboBox);
1203var
1204 i: integer;
1205begin
1206 with CtrlInits, cboCollType do
1207 begin
1208 SetControl(cboCollType, 'Collection Types');
1209 if not ALabTest.LabCanCollect then
1210 begin
1211 i := SelectByID('LC');
1212 if i > -1 then Items.Delete(i);
1213 i := SelectByID('I');
1214 if i > -1 then Items.Delete(i);
1215 end ;
1216 if LRFZX <> '' then
1217 begin
1218 if (LRFZX = 'LC') or (LRFZX = 'I') then
1219 begin
1220 if ALabTest.LabCanCollect then
1221 cboCollType.SelectByID(LRFZX)
1222 else
1223 cboCollType.SelectByID('WC');
1224 end
1225 else
1226 cboCollType.SelectByID(LRFZX);
1227 end
1228 else if FLastCollType <> '' then
1229 begin
1230 if (FLastCollType = 'LC') or (FLastCollType = 'I') then
1231 begin
1232 if ALabTest.LabCanCollect then
1233 cboCollType.SelectByID(FLastCollType)
1234 else
1235 cboCollType.SelectByID('WC');
1236 end
1237 else
1238 cboCollType.SelectByID(FLastCollType);
1239 end
1240 else if uDfltCollType <> '' then
1241 begin
1242 if (uDfltCollType = 'LC') or (uDfltCollType = 'I') then
1243 begin
1244 if ALabTest.LabCanCollect then
1245 cboCollType.SelectByID(uDfltCollType)
1246 else
1247 cboCollType.SelectByID('WC');
1248 end
1249 else
1250 cboCollType.SelectByID(uDfltCollType);
1251 end
1252 else if OrderForInpatient then
1253 begin
1254 if ALabTest.LabCanCollect then
1255 cboCollType.SelectByID('LC')
1256 else
1257 SelectByID('WC');
1258 end
1259 else
1260 cboCollType.SelectByID('SP');
1261 end;
1262 SetupCollTimes(cboCollType.ItemID);
1263end;
1264
1265procedure TfrmODBBank.ReadServerVariables;
1266begin
1267 LRFZX := KeyVariable['LRFZX'];
1268 LRFSAMP := KeyVariable['LRFSAMP'];
1269 LRFSPEC := KeyVariable['LRFSPEC'];
1270 LRFDATE := KeyVariable['LRFDATE'];
1271 LRFURG := KeyVariable['LRFURG'];
1272 LRFSCH := KeyVariable['LRFSCH'];
1273end;
1274
1275procedure TfrmODBBank.cboAvailTestSelect(Sender: TObject);
1276var
1277 x: string;
1278 i: integer;
1279begin
1280 DisableComponentControls;
1281 EnableDiagTestControls;
1282 LRORDERMODE := TORDER_MODE_DIAG;
1283 with cboAvailTest do
1284 begin
1285 if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
1286 for i := 0 to uSelectedItems.Count - 1 do
1287 if ItemID = piece(uSelectedItems[i],'^',1) then
1288 begin
1289 ShowMessage('This test has already been selected!');
1290 Exit;
1291 end;
1292 FLastLabID := ItemID ;
1293 FLastItemID := ItemID;
1294 Changing := True;
1295 if Sender <> Self then
1296 Responses.Clear; // Sender=Self when called from SetupDialog
1297 if CharAt(ItemID, 1) = 'Q' then
1298 with Responses do
1299 begin
1300 FLastItemID := ItemID;
1301 QuickOrder := ExtractInteger(ItemID);
1302 SetControl(cboAvailTest, 'ORDERABLE', 1);
1303 if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
1304 FLastLabID := ItemID;
1305 end;
1306 ALabTest := TLabTest.Create(ItemID, Responses);
1307 end;
1308 with ALabTest do
1309 begin
1310
1311 {with Responses do if QuickOrder > 0 then
1312 begin
1313 StatusText('Initializing Quick Order');
1314 Changing := True;
1315 SetControl(cboAvailTest, 'ORDERABLE', 1);
1316 DetermineCollectionDefaults(Responses);
1317 LoadUrgency(cboCollType.ItemID, cboUrgency);
1318 SetControl(cboUrgency, 'URGENCY', 1);
1319 Urgency := cboUrgency.ItemIEN;
1320 if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
1321 begin
1322 cboUrgency.ItemIndex := 0;
1323 Urgency := cboUrgency.ItemIEN;
1324 end;
1325 tmpResp := FindResponseByName('SPECIMEN' ,1);
1326 i := 1 ;
1327 tmpResp := Responses.FindResponseByName('COMMENT',i);
1328 while tmpResp <> nil do
1329 begin
1330 Comment.Add(tmpResp.EValue);
1331 Inc(i);
1332 tmpResp := Responses.FindResponseByName('COMMENT',i);
1333 end ;
1334 end; // Quick Order}
1335 if ObtainCollSamp then
1336 begin
1337 //For BloodBank orders, this condition should never occur
1338 end
1339 else
1340 begin
1341 with ALabTest do
1342 with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
1343 begin
1344 x := '' ;
1345 for i := 0 to WardComment.Count-1 do
1346 x := x + WardComment.strings[i]+#13#10 ;
1347 pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
1348 OrderMessage(x) ;
1349 end ;
1350 end;
1351 if ObtainComment then
1352 LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment))
1353 else
1354 DisableCommentPanels;
1355 x := '' ;
1356 for i := 0 to CurWardComment.Count-1 do
1357 x := x + CurWardComment.strings[i]+#13#10 ;
1358 i := IndexOfCollSamp(CollSamp);
1359 if i > -1 then with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
1360 for i := 0 to WardComment.Count-1 do
1361 x := x + WardComment.strings[i]+#13#10 ;
1362 pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
1363 OrderMessage(x) ;
1364 end; { with }
1365 StatusText('');
1366 Changing := False;
1367end;
1368
1369procedure TfrmODBBank.cboAvailCompSelect(Sender: TObject);
1370var
1371 x: string;
1372 i: integer;
1373begin
1374 DisableDiagTestControls;
1375 EnableComponentControls;
1376 LRORDERMODE := TORDER_MODE_COMP;
1377 with cboAvailComp do
1378 begin
1379 if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
1380 for i := 0 to uSelectedItems.Count - 1 do
1381 if ItemID = piece(uSelectedItems[i],'^',1) then
1382 begin
1383 ShowMessage('This component has already been selected!');
1384 Exit;
1385 end;
1386 FLastLabID := ItemID ;
1387 FLastItemID := ItemID;
1388 Changing := True;
1389 if Sender <> Self then
1390 Responses.Clear; // Sender=Self when called from SetupDialog
1391 if CharAt(ItemID, 1) = 'Q' then
1392 with Responses do
1393 begin
1394 FLastItemID := ItemID;
1395 QuickOrder := ExtractInteger(ItemID);
1396 SetControl(cboAvailComp, 'ORDERABLE', 1);
1397 if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
1398 FLastLabID := ItemID;
1399 end;
1400 ALabTest := TLabTest.Create(ItemID, Responses);
1401 end;
1402 with ALabTest do
1403 begin
1404
1405 {with Responses do if QuickOrder > 0 then
1406 begin
1407 StatusText('Initializing Quick Order');
1408 Changing := True;
1409 SetControl(cboAvailTest, 'ORDERABLE', 1);
1410 DetermineCollectionDefaults(Responses);
1411 LoadUrgency(cboCollType.ItemID, cboUrgency);
1412 SetControl(cboUrgency, 'URGENCY', 1);
1413 Urgency := cboUrgency.ItemIEN;
1414 if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
1415 begin
1416 cboUrgency.ItemIndex := 0;
1417 Urgency := cboUrgency.ItemIEN;
1418 end;
1419 tmpResp := FindResponseByName('SPECIMEN' ,1);
1420 i := 1 ;
1421 tmpResp := Responses.FindResponseByName('COMMENT',i);
1422 while tmpResp <> nil do
1423 begin
1424 Comment.Add(tmpResp.EValue);
1425 Inc(i);
1426 tmpResp := Responses.FindResponseByName('COMMENT',i);
1427 end ;
1428 end; // Quick Order}
1429 {if ObtainCollSamp then
1430 begin
1431 // should not occur with Blood orders
1432 end
1433 else
1434 begin
1435 with ALabTest do
1436 with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
1437 begin
1438 x := '' ;
1439 for i := 0 to WardComment.Count-1 do
1440 x := x + WardComment.strings[i]+#13#10 ;
1441 pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
1442 OrderMessage(x) ;
1443 end ;
1444 end;
1445 }
1446 if ObtainComment then
1447 LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment))
1448 else
1449 DisableCommentPanels;
1450 x := '' ;
1451 for i := 0 to CurWardComment.Count-1 do
1452 x := x + CurWardComment.strings[i]+#13#10 ;
1453 i := IndexOfCollSamp(CollSamp);
1454 if i > -1 then with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
1455 for i := 0 to WardComment.Count-1 do
1456 x := x + WardComment.strings[i]+#13#10 ;
1457 pnlMessage.TabOrder := cboAvailComp.TabOrder + 1;
1458 OrderMessage(x) ;
1459 end; { with }
1460 StatusText('');
1461 Changing := False;
1462end;
1463
1464procedure TfrmODBBank.DisableCommentPanels;
1465begin
1466 lblReqComment.Visible := False;
1467end;
1468
1469procedure TfrmODBBank.DisableComponentControls;
1470begin
1471 lblModifiers.Enabled := false;
1472 cboModifiers.Enabled := false;
1473 lblWanted.Enabled := false;
1474 calWantTime.Enabled := false;
1475 //lblPreparation.Enabled := false;
1476 //cboPreparation.Enabled := false;
1477 lblSurgery.Enabled := false;
1478 cboSurgery.Enabled := false;
1479 lblReason.Enabled := false;
1480 tReason.Enabled := false;
1481 chkConsent.Enabled := false;
1482 lblQuantity.Enabled := false;
1483 tQuantity.Enabled := false;
1484 upQuantity.Enabled := false;
1485 cboAvailComp.ItemIndex := -1;
1486 tQuantity.Text := '0';
1487end;
1488
1489procedure TfrmODBBank.EnableComponentControls;
1490begin
1491 lblModifiers.Enabled := true;
1492 cboModifiers.Enabled := true;
1493 lblWanted.Enabled := true;
1494 calWantTime.Enabled := true;
1495 //lblPreparation.Enabled := true;
1496 //cboPreparation.Enabled := true;
1497 if cboUrgency.Text = 'PRE-OP' then
1498 begin
1499 lblSurgery.Enabled := true;
1500 cboSurgery.Enabled := true;
1501 end;
1502 lblReason.Enabled := true;
1503 tReason.Enabled := true;
1504 chkConsent.Enabled := true;
1505 lblQuantity.Enabled := true;
1506 tQuantity.Enabled := true;
1507 upQuantity.Enabled := true;
1508 txtDiagComment.Enabled := true;
1509 lblDiagComment.Enabled := true;
1510end;
1511
1512procedure TfrmODBBank.DisableDiagTestControls;
1513begin
1514 lblCollTime.Enabled := false;
1515 calCollTime.Enabled := false;
1516 cboCollTime.Enabled := false;
1517 cboAvailTest.ItemIndex := -1;
1518 lblCollType.Enabled := false;
1519 cboCollType.Enabled := false;
1520 cmdImmedColl.Enabled := false;
1521end;
1522
1523procedure TfrmODBBank.EnableDiagTestControls;
1524begin
1525 calWantTime.Enabled := true;
1526 lblWanted.Enabled := true;
1527 lblCollTime.Enabled := true;
1528 calCollTime.Enabled := true;
1529 cboCollTime.Enabled := true;
1530 lblCollType.Enabled := true;
1531 cboCollType.Enabled := true;
1532 lblUrgency.Enabled := true;
1533 cboUrgency.Enabled := true;
1534 txtDiagComment.Enabled := true;
1535 lblDiagComment.Enabled := true;
1536 cmdImmedColl.Enabled := true;
1537end;
1538
1539procedure TfrmODBBank.LoadRequiredComment(CmtType: integer);
1540begin
1541 DisableCommentPanels;
1542 lblReqComment.Visible := True ;
1543end;
1544
1545procedure TfrmODBBank.DetermineCollectionDefaults(Responses: TResponses);
1546var
1547 RespCollect, RespStart: TResponse;
1548begin
1549 if ALabTest = nil then exit;
1550 calCollTime.Clear;
1551 cboCollTime.Clear;
1552 calCollTime.Enabled := True;
1553 lblCollTime.Enabled := True;
1554 cboColltime.Enabled := True;
1555 with Responses, ALabTest do
1556 begin
1557 RespCollect := FindResponseByName('COLLECT',1);
1558 RespStart := FindResponseByName('START' ,1);
1559 if (RespCollect <> nil) then with RespCollect do
1560 begin
1561 if IValue = 'LC' then
1562 begin
1563 if not LabCanCollect then
1564 begin
1565 cboCollType.SelectByID('WC');
1566 SetupCollTimes('WC');
1567 end
1568 else // if LabCanCollect
1569 begin
1570 cboCollType.SelectByID('LC');
1571 SetupCollTimes('LC');
1572 CtrlInits.SetControl(cboCollTime, 'Lab Collection Times') ;
1573 if RespStart <> nil then
1574 begin
1575 cboCollTime.SelectByID('L' + RespStart.IValue);
1576 if cboCollTime.ItemIndex < 0 then
1577 cboCollTime.Text := RespStart.IValue;
1578 end;
1579 end;
1580 end
1581 else // if IValue <> 'LC'
1582 begin
1583 cboCollType.SelectByID(IValue) ;
1584 SetupCollTimes(IValue);
1585 if RespStart <> nil then
1586 begin
1587 if ContainsAlpha(RespStart.IValue) then
1588 calColltime.Text := RespStart.IValue
1589 else
1590 calColltime.FMDateTime := StrToFMDateTime(RespStart.IValue);
1591 end;
1592 end ;
1593 if IValue = 'I' then
1594 if not LabCanCollect then
1595 begin
1596 cboCollType.SelectByID('WC');
1597 SetupCollTimes('WC');
1598 end
1599 else
1600 begin
1601 calCollTime.Enabled := False;
1602 if RespStart <> nil then txtImmedColl.Text := RespStart.EValue;
1603 end;
1604 end
1605 else // if (RespCollect = nil)
1606 LoadCollType(cbocollType);
1607 end;
1608end;
1609
1610procedure TfrmODBBank.cboAvailTestExit(Sender: TObject);
1611begin
1612 inherited;
1613 if (Length(cboAvailTest.ItemID) = 0) or (cboAvailTest.ItemID = '0') then Exit;
1614 if cboAvailTest.ItemID = FLastLabID then Exit;
1615 cboAvailTestSelect(cboAvailTest);
1616 cboAvailTest.SetFocus;
1617 PostMessage(Handle, WM_NEXTDLGCTL, 0, 0);
1618end;
1619
1620procedure TfrmODBBank.cboAvailCompExit(Sender: TObject);
1621begin
1622 inherited;
1623 if (Length(cboAvailComp.ItemID) = 0) or (cboAvailComp.ItemID = '0') then Exit;
1624 if cboAvailComp.ItemID = FLastLabID then Exit;
1625 cboAvailCompSelect(cboAvailComp);
1626 cboAvailComp.SetFocus;
1627 PostMessage(Handle, WM_NEXTDLGCTL, 0, 0);
1628end;
1629
1630procedure TfrmODBBank.cboAvailTestNeedData(Sender: TObject;
1631 const StartFrom: String; Direction, InsertAt: Integer);
1632begin
1633 cboAvailTest.ForDataUse(SubsetOfOrderItems(StartFrom, Direction, FVbecLookup));
1634end;
1635
1636procedure TfrmODBBank.cboAvailCompNeedData(Sender: TObject;
1637 const StartFrom: String; Direction, InsertAt: Integer);
1638begin
1639 cboAvailComp.ForDataUse(SubsetOfOrderItems(StartFrom, Direction, FVbecLookup));
1640end;
1641
1642procedure TfrmODBBank.cmdImmedCollClick(Sender: TObject);
1643var
1644 ImmedCollTime: string;
1645begin
1646 inherited;
1647 ImmedCollTime := SelectImmediateCollectTime(Font.Size, txtImmedColl.Text);
1648 if ImmedCollTime <> '-1' then
1649 begin
1650 txtImmedColl.Text := ImmedCollTime;
1651 calCollTime.FMDateTime := StrToFMDateTime(ImmedCollTime);
1652 end
1653 else
1654 begin
1655 txtImmedColl.Clear;
1656 calCollTime.Clear;
1657 end;
1658end;
1659
1660procedure TfrmODBBank.pgeProductChange(Sender: TObject);
1661begin
1662 inherited;
1663 case pgeProduct.TabIndex of
1664 TI_ORDER : begin
1665 memMessage.Visible := true;
1666 memOrder.Visible := true;
1667 cmdAccept.Visible := true;
1668 pnlSelectedTests.Visible := true;
1669 pgeProduct.Height := 281;
1670 end;
1671 TI_INFO : begin
1672 if lvSelectionList.Items.Count > 0 then exit;
1673 LRORDERMODE := TORDER_MODE_INFO;
1674 memMessage.Visible := false;
1675 memOrder.Visible := false;
1676 cmdAccept.Visible := false;
1677 pnlSelectedTests.Visible := false;
1678 pgeProduct.Height := 411;
1679 end;
1680 TI_RESULTS : begin
1681 if lvSelectionList.Items.Count > 0 then exit;
1682 memMessage.Visible := false;
1683 memOrder.Visible := false;
1684 cmdAccept.Visible := false;
1685 pnlSelectedTests.Visible := false;
1686 pgeProduct.Height := 411;
1687 end;
1688 end; {case}
1689end;
1690
1691procedure TfrmODBBank.cboCollTypeChange(Sender: TObject);
1692begin
1693 if (ALabTest = nil) or Changing or (cboCollType.ItemID = '') then exit;
1694 if (cboCollType.ItemID = 'I') and (not ALabTest.LabCanCollect) then
1695 begin
1696 InfoBox(TX_NO_IMMED, TX_NO_IMMED_CAP, MB_OK or MB_ICONWARNING);
1697 cboCollType.ItemIndex := -1;
1698 Exit;
1699 end;
1700 SetupCollTimes(cboCollType.ItemID);
1701end;
1702
1703procedure TfrmODBBank.LoadModifiers(AComboBox:TORComboBox);
1704var
1705 i: integer;
1706begin
1707 with AComboBox do
1708 begin
1709 Clear;
1710 for i := 0 to uModifierList.Count - 1 do
1711 Items.Add(uModifierList[i]);
1712 end;
1713end;
1714
1715procedure TfrmODBBank.LoadUrgencies(AComboBox:TORComboBox);
1716var
1717 i: integer;
1718begin
1719 with AComboBox do
1720 begin
1721 Clear;
1722 for i := 0 to uUrgencyList.Count - 1 do
1723 if (piece(uUrgencyList[i],'^',2) = 'STAT') and (StatAllowed(Patient.DFN) = false) then
1724 Continue
1725 else
1726 Items.Add(uUrgencyList[i]);
1727 end;
1728end;
1729
1730procedure TfrmODBBank.btnAddTestsClick(Sender: TObject);
1731var
1732 aList, aTests, aRaw: TStringList;
1733 ListItem: TListItem;
1734 aStr, aMsg: String; //add independent structures for components, Tests, and associated fields.
1735 aCollType, aModifier, aPreparation, aSurgery, aCollTime, aTestYes, aSpecimen, aCollSave: String;
1736 CurAdd, i, j, k, getTest, TestAdded, aMSBOS, aMSBOSContinue: Integer;
1737 x, name, aTypeScreen: String;
1738begin
1739 if not ValidAdd then Exit;
1740 aList := TStringList.Create;
1741 aTests := TStringList.Create;
1742 aRaw := TStringList.Create;
1743 try
1744 aCollType := '';
1745 aModifier := '';
1746 aPreparation := '';
1747 aSurgery := '';
1748 aCollTime := '';
1749 aTestYes := '0';
1750 aTypeScreen := '';
1751 uGetTnS := 0;
1752 aSpecimen := '';
1753 ExtractTypeScreen(aList, uVBECList);
1754 if aList.Count > 0 then aTypeScreen := aList[0];
1755 aList.Clear;
1756 ExtractSpecimen(aList, uVBECList);
1757 if aList.Count > 0 then aSpecimen := aList[0];
1758 if LRORDERMODE = TORDER_MODE_DIAG then aTestYes := '1';
1759 if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
1760 //if length(cboPreparation.ItemID) > 0 then aPreparation := cboPreparation.Items[cboPreparation.ItemIndex];
1761 if length(cboSurgery.ItemID) > 0 then aSurgery := cboSurgery.Items[cboSurgery.ItemIndex];
1762 if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex];
1763 if (LRORDERMODE = TORDER_MODE_DIAG) and (length(cboAvailTest.ItemID) > 0) then
1764 begin
1765 uTestSelected := true;
1766 with lvSelectionList do
1767 begin
1768 ListItem := Items.Add;
1769 ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2);
1770 ListItem.SubItems.Add('');
1771 if length(cboModifiers.ItemID) > 0 then ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex])
1772 else ListItem.SubItems.Add('');
1773 ListItem.SubItems.Add(piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1));
1774 if piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1) = aTypeScreen then
1775 begin
1776 lblTNS.Caption := '';
1777 lblTNS.Visible := false;
1778 end;
1779 end;
1780 lblCollTime.Enabled := false;
1781 calCollTime.Enabled := false;
1782 cboCollTime.Enabled := false;
1783 lblCollType.Enabled := false;
1784 cboCollType.Enabled := false;
1785 cboAvailTest.ItemIndex := -1;
1786 end;
1787 if (LRORDERMODE = TORDER_MODE_COMP) and (length(cboAvailComp.ItemID) > 0) then
1788 begin
1789 if Length(cboSurgery.ItemID) > 0 then
1790 begin
1791 aList.Clear;
1792 ExtractMSBOS(aList, uVBECList); //Get maximum units for selected Surgey
1793 for i := 0 to aList.Count - 1 do
1794 begin
1795 if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
1796 and (StrToInt(piece(aList[i],'^',2)) = cboSurgery.ItemID) then
1797 begin
1798 aMSBOS := StrToInt(piece(aList[i],'^',4));
1799 if (aMSBOS > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
1800 begin
1801 with Application do
1802 begin
1803 NormalizeTopMosts;
1804 aMSBOSContinue :=
1805 MessageBox(PChar('The number of units ordered (' + tQuantity.Text +
1806 ') exceeds the maximum number of units (' + IntToStr(aMSBOS) +
1807 ') for the ' + cboSurgery.text +
1808 ' surgical procedure selected.' + CRLF + CRLF + 'Do you wish to continue?'),
1809 PChar('Maximum Number of Units Exceeded'),
1810 MB_YESNO);
1811 RestoreTopMosts;
1812 end;
1813 if aMSBOSContinue = 7 then
1814 begin
1815 ShowMessage(cboAvailComp.Text + ' has NOT been added to this request.');
1816 exit;
1817 end;
1818 end;
1819 end;
1820 end;
1821 end;
1822 if SpecimenNeeded(aList, uVBECList, aLabTest.ItemID) then //check to see if type and screen is needed
1823 begin
1824 uGetTnS := 1;
1825 for i := 0 to lvSelectionList.Items.Count - 1 do
1826 begin
1827 if lvSelectionList.Items[i].SubItems[2] = aTypeScreen then
1828 begin
1829 uGetTnS := 0;
1830 uDfltUrgency := cboUrgency.ItemID;
1831 lblTNS.Caption := '';
1832 lblTNS.Visible := false;
1833 break;
1834 end;
1835 end;
1836 end;
1837 aList.Clear;
1838 ExtractSpecimens(aList, uVBECList); //Get specimen values to pass back to Server
1839 for i := 0 to aList.Count - 1 do
1840 begin
1841 if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) then
1842 begin
1843 aSpecimen := piece(aList[i],'^',2) + '^' + aSpecimen;
1844 break;
1845 end;
1846 end;
1847 uComponentSelected := true;
1848 with lvSelectionList do
1849 begin
1850 ListItem := Items.Add;
1851 ListItem.Caption := piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2);
1852 ListItem.SubItems.Add(tQuantity.Text);
1853 if length(cboModifiers.ItemID) > 0 then ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex])
1854 else ListItem.SubItems.Add('');
1855 ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
1856 end;
1857 lblWanted.Enabled := false;
1858 calWantTime.Enabled := false;
1859 //lblPreparation.Enabled := false;
1860 //cboPreparation.Enabled := false;
1861 lblSurgery.Enabled := false;
1862 cboSurgery.Enabled := false;
1863 lblReason.Enabled := false;
1864 tReason.Enabled := false;
1865 chkConsent.Enabled := false;
1866 cboAvailComp.ItemIndex := -1;
1867 end;
1868 if Sender <> Self then
1869 Responses.Clear; // Sender=Self when called from SELF
1870 CurAdd := 1;
1871 aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen; //aSpecimen has 2 pieces
1872 uSelectedItems.Add(aStr);
1873 for i := 0 to uSelectedItems.Count - 1 do
1874 begin
1875 name := lvSelectionList.Items[i].Caption;
1876 x := uSelectedItems[i];
1877 if piece(x,'^',1) = '1' then //Diagnostic Test related fields
1878 begin
1879 if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), name);
1880 end
1881 else
1882 begin
1883 if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), name);
1884 if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
1885 if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), aModifier);
1886 if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
1887 if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
1888 end;
1889 Inc(CurAdd);
1890 aList.Clear;
1891 TestAdded := 0;
1892 getTest := 0;
1893 ExtractTests(aList, uVBECList); //Get Results associated with ordered components
1894 for j := 0 to aList.Count - 1 do
1895 begin
1896 if StrToInt(piece(aList[j],'^',1)) = aLabTest.ItemID then
1897 begin
1898 if uTestsForResults.Count < 1 then getTest := 1;
1899 for k := 0 to uTestsForResults.Count - 1 do
1900 begin
1901 if piece(uTestsForResults[k],'^',1) = piece(aList[j],'^',3) then
1902 begin
1903 getTest := 0;
1904 break;
1905 end
1906 else getTest := 1;
1907 end;
1908 if getTest = 1 then
1909 begin
1910 uTestsForResults.Add(piece(aList[j],'^',3));
1911 TestAdded := 1;
1912 end;
1913 end;
1914 end;
1915 if TestAdded = 1 then
1916 begin
1917 edtResults.Clear;
1918 aTests.Clear;
1919 GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults);
1920 QuickCopy(ATests,edtResults);
1921 if edtResults.Lines.Count > 0 then TabResults.ImageIndex := 1;
1922 uRaw.Clear;
1923 GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults);
1924 end;
1925 end;
1926 if LRORDERMODE = TORDER_MODE_DIAG then
1927 begin
1928 if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
1929 with cboCollType do if Length(ItemID) > 0 then
1930 begin
1931 Responses.Update('COLLECT', 1, ItemID, ItemID) ;
1932 FLastCollType := ItemID;
1933 end;
1934 if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
1935 if Length(txtDiagComment.Text) > 0 then Responses.Update('COMMENT',1,txtDiagComment.Text,txtDiagComment.Text);
1936 if cboCollType.ItemID = 'LC' then
1937 begin
1938 with cboCollTime do
1939 if Length(ItemID) > 0 then
1940 begin
1941 Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
1942 FLastLabCollTime := ItemID + U + Text;
1943 end
1944 else if Length(Text) > 0 then
1945 begin
1946 Responses.Update('START', 1, ValidCollTime(Text), Text) ;
1947 FLastLabCollTime := ValidCollTime(Text);
1948 end;
1949 end
1950 else
1951 begin
1952 with calCollTime do
1953 if FMDateTime > 0 then
1954 begin
1955 Responses.Update('START', 1, ValidCollTime(Text), Text);
1956 FLastColltime := ValidCollTime(Text);
1957 end
1958 else
1959 begin
1960 Responses.Update('START', 1, '', '') ;
1961 FLastCollTime := '';
1962 end;
1963 end;
1964 end;
1965 if LRORDERMODE = TORDER_MODE_COMP then
1966 begin
1967 if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
1968 if Length(txtDiagComment.Text) > 0 then Responses.Update('COMMENT',1,txtDiagComment.Text,txtDiagComment.Text);
1969 if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
1970 //if Length(cboPreparation.Text) > 0 then Responses.Update('XFUSION',1,cboPreparation.ItemID,cboPreparation.Text);
1971 if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
1972 if Length(tReason.Text) > 0 then Responses.Update('REASON',1,tReason.Text,tReason.Text);
1973 if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes');
1974 end;
1975 memOrder.Text := Responses.OrderText;
1976 CurAdd := 1;
1977 if uRaw.Count > 0 then
1978 for j := 0 to uRaw.Count - 1 do
1979 begin
1980 if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
1981 Inc(CurAdd);
1982 end;
1983 tQuantity.Text := '0';
1984 ALabTest := nil;
1985 finally
1986 aList.Free;
1987 aTests.Free;
1988 aRaw.Free;
1989 end;
1990 aMsg := '';
1991 if UgetTnS = 1 then
1992 begin
1993 lblTNS.Caption := 'TYPE + SCREEN must be added to order';
1994 lblTNS.Visible := true;
1995 cboAvailTest.SelectByID(aTypeScreen);
1996 cboAvailTestSelect(self);
1997 end;
1998 {if getTnS = 1 then
1999 begin
2000 for i := 1 to cboAvailTest.Items.Count - 1 do
2001 begin
2002 if piece(cboAvailTest.Items[i],'^',1) = aTypeScreen then
2003 begin
2004 if piece(aSpecimen,'^',1) = '1' then
2005 begin
2006 cboCollTime.Text := calWantTime.Text;
2007 aCollSave := cboCollTime.Text + '^' + cboCollTime.ItemID + '^' + cboCollType.Text + '^' + cboCollType.ItemID;
2008 cboCollTime.Text := '';
2009 cboCollType.Text := '';
2010 uSpecimen := 1;
2011 end;
2012 cboModifiers.Text := '';
2013 cboAvailTest.SelectByID(aTypeScreen);
2014 cboAvailTestSelect(Self);
2015 btnAddTestsClick(Self);
2016 uSpecimen := 0;
2017 cboCollTime.Text := piece(aCollSave,'^',1);
2018 cboCollType.Text := piece(aCollSave,'^',3);
2019 aCollSave := '';
2020 break;
2021 end;
2022 end;
2023 aMsg := 'An order for Type and Screen has been added to this request' + '.';
2024 end;
2025 if (getTns = 1) then
2026 begin
2027 if length(aMsg) > 0 then aMsg := aMsg + crlf + crlf;
2028 ShowMessage(aMsg);
2029 end;}
2030 cboModifiers.Text := '';
2031 edtResults.Height := 247;
2032 edtInfo.Height := 247;
2033end;
2034
2035procedure TfrmODBBank.FormDestroy(Sender: TObject);
2036begin
2037 inherited;
2038 uSelectedItems.Free;
2039 uVBECList.Free;
2040 uTestsForResults.Free;
2041 uUrgencyList.Free;
2042 uModifierList.Free;
2043 uRaw.Free;
2044end;
2045
2046procedure TfrmODBBank.btnRemoveClick(Sender: TObject);
2047var
2048 i,j,curAdd: integer;
2049 x, name, aModifier, aTypeScreen: string;
2050 aList: TStringList;
2051begin
2052 inherited;
2053 aList := TStringList.Create;
2054 curAdd := 1;
2055 aModifier := '';
2056 aTypeScreen := '';
2057 ExtractTypeScreen(aList, uVBECList);
2058 if aList.Count > 0 then aTypeScreen := aList[0];
2059 aList.Clear;
2060 if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
2061 with lvSelectionList do
2062 begin
2063 for i := lvSelectionList.Items.Count - 1 downto 0 do
2064 begin
2065 if lvSelectionList.Items[i].Selected = true then
2066 for j := uSelectedItems.Count - 1 downto 0 do
2067 if lvSelectionList.Items[i].SubItems[2] = piece(uSelectedItems[j],'^',2) then
2068 begin
2069 if lvSelectionList.Items[i].SubItems[2] = aTypeScreen then
2070 begin
2071 uGetTnS := 1;
2072 lblTNS.Caption := 'TYPE+SCREEN must be added to order';
2073 lblTNS.Visible := true;
2074 end;
2075 uSelectedItems.Delete(j);
2076 lvSelectionList.Items[i].Delete;
2077 break;
2078 end;
2079 end;
2080 end;
2081 Responses.Clear;
2082 for i := 0 to uSelectedItems.Count - 1 do
2083 begin
2084 name := lvSelectionList.Items[i].Caption;
2085 x := uSelectedItems[i];
2086 if piece(x,'^',1) = '1' then //Diagnostic Test related fields
2087 begin
2088 if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), name);
2089 end
2090 else
2091 begin
2092 if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), name);
2093 if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
2094 if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), aModifier);
2095 if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
2096 end;
2097 Inc(CurAdd);
2098 end;
2099 if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
2100 if cboCollType.ItemID = 'LC' then
2101 begin
2102 with cboCollTime do
2103 if Length(ItemID) > 0 then
2104 begin
2105 Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
2106 FLastLabCollTime := ItemID + U + Text;
2107 end
2108 else if Length(Text) > 0 then
2109 begin
2110 Responses.Update('START', 1, ValidCollTime(Text), Text) ;
2111 FLastLabCollTime := ValidCollTime(Text);
2112 end;
2113 end
2114 else
2115 begin
2116 with calCollTime do
2117 if FMDateTime > 0 then
2118 begin
2119 Responses.Update('START', 1, ValidCollTime(Text), Text);
2120 FLastColltime := ValidCollTime(Text);
2121 end
2122 else
2123 begin
2124 Responses.Update('START', 1, '', '') ;
2125 FLastCollTime := '';
2126 end;
2127 end;
2128 with cboCollType do if Length(ItemID) > 0 then
2129 begin
2130 Responses.Update('COLLECT', 1, ItemID, ItemID) ;
2131 FLastCollType := ItemID;
2132 end;
2133 if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
2134 if Length(txtDiagComment.Text) > 0 then Responses.Update('COMMENT',1,txtDiagComment.Text,txtDiagComment.Text);
2135 //if Length(cboPreparation.Text) > 0 then Responses.Update('XFUSION',1,cboPreparation.ItemID,cboPreparation.Text);
2136 if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
2137 if Length(tReason.Text) > 0 then Responses.Update('REASON',1,tReason.Text,tReason.Text);
2138 if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes');
2139 memOrder.Text := Responses.OrderText;
2140 CurAdd := 1;
2141 if uRaw.Count > 0 then
2142 for j := 0 to uRaw.Count - 1 do
2143 begin
2144 if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
2145 Inc(CurAdd);
2146 end;
2147 if uSelectedItems.Count < 1 then
2148 begin
2149 uGetTnS := 0;
2150 lblTNS.Caption := '';
2151 lblTNS.Visible := false;
2152 end;
2153 aList.Free;
2154end;
2155
2156procedure TfrmODBBank.btnRemoveAllClick(Sender: TObject);
2157begin
2158 inherited;
2159 lvSelectionList.Clear;
2160 uSelectedItems.Clear;
2161 uTestsForResults.Clear;
2162 uRaw.Clear;
2163 uGetTnS := 0;
2164 lblTNS.Caption := '';
2165 lblTNS.Visible := false;
2166 InitDialog;
2167end;
2168
2169procedure TfrmODBBank.cmdAcceptClick(Sender: TObject);
2170var
2171 i: integer;
2172 Comp: boolean;
2173const
2174 Txt1 = 'This order can not be saved for the following reason(s):';
2175 Txt2 = #13+#13+'An order for TYPE and SCREEN must be created with this order set.';
2176begin
2177 if uGetTnS = 1 then
2178 begin
2179 MessageDlg(Txt1+Txt2, mtWarning,[mbOK],0);
2180 Exit;
2181 end;
2182 Comp := false;
2183 if uSelectedItems.Count > 0 then
2184 begin
2185 for i := 0 to uSelectedItems.Count - 1 do
2186 if not (piece(uSelectedItems[i],'^',1) = '1') then
2187 begin
2188 Comp := true;
2189 Break;
2190 end;
2191 end;
2192 if Comp = true then
2193 ShowMessage('The nursing blood administration order must be entered separately' + '.');
2194 inherited;
2195end;
2196
2197procedure TfrmODBBank.calWantTimeChange(Sender: TObject);
2198begin
2199 inherited;
2200 if uSelectedItems.Count > 0 then
2201 if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
2202end;
2203
2204procedure TfrmODBBank.chkConsentClick(Sender: TObject);
2205begin
2206 inherited;
2207 if uSelectedItems.Count > 0 then
2208 begin
2209 if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes')
2210 else Responses.Update('YN',1,'0','No');
2211 end;
2212end;
2213
2214procedure TfrmODBBank.cboUrgencyChange(Sender: TObject);
2215begin
2216 inherited;
2217 if Length(cboUrgency.Text) > 0 then
2218 begin
2219 Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
2220 if cboUrgency.Text = 'PRE-OP' then
2221 begin
2222 lblSurgery.Enabled := true;
2223 cboSurgery.Enabled := true;
2224 end
2225 else
2226 begin
2227 lblSurgery.Enabled := false;
2228 cboSurgery.Enabled := false;
2229 cboSurgery.Text := '';
2230 if uSelectedItems.Count > 0 then
2231 Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
2232 end;
2233 end;
2234end;
2235
2236procedure TfrmODBBank.txtDiagCommentChange(Sender: TObject);
2237begin
2238 inherited;
2239 if uSelectedItems.Count > 0 then
2240 Responses.Update('COMMENT',1,txtDiagComment.Text,txtDiagComment.Text);
2241end;
2242
2243procedure TfrmODBBank.cboPreparationChange(Sender: TObject);
2244begin
2245 inherited;
2246 Exit; // disable Preparation, since it is no longer needed by VBECS
2247 if uSelectedItems.Count > 0 then
2248 if Length(cboPreparation.Text) > 0 then
2249 Responses.Update('XFUSION',1,cboPreparation.ItemID,cboPreparation.Text);
2250end;
2251
2252procedure TfrmODBBank.cboSurgeryChange(Sender: TObject);
2253begin
2254 inherited;
2255 if uSelectedItems.Count > 0 then
2256 if Length(cboSurgery.Text) > 0 then
2257 Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
2258end;
2259
2260procedure TfrmODBBank.tReasonChange(Sender: TObject);
2261begin
2262 inherited;
2263 if uSelectedItems.Count > 0 then
2264 if Length(tReason.Text) > 0 then
2265 Responses.Update('REASON',1,tReason.Text,tReason.Text);
2266end;
2267
2268procedure TfrmODBBank.calCollTimeChange(Sender: TObject);
2269begin
2270 inherited;
2271 if uSelectedItems.Count > 0 then
2272 begin
2273 if cboCollType.ItemID = 'LC' then
2274 begin
2275 with cboCollTime do
2276 if Length(ItemID) > 0 then
2277 begin
2278 Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
2279 FLastLabCollTime := ItemID + U + Text;
2280 end
2281 else if Length(Text) > 0 then
2282 begin
2283 Responses.Update('START', 1, ValidCollTime(Text), Text) ;
2284 FLastLabCollTime := ValidCollTime(Text);
2285 end;
2286 end
2287 else
2288 begin
2289 with calCollTime do
2290 if FMDateTime > 0 then
2291 begin
2292 Responses.Update('START', 1, ValidCollTime(Text), Text);
2293 FLastColltime := ValidCollTime(Text);
2294 end
2295 else
2296 begin
2297 Responses.Update('START', 1, '', '') ;
2298 FLastCollTime := '';
2299 end;
2300 end;
2301 end;
2302end;
2303
2304end.
Note: See TracBrowser for help on using the repository browser.