source: cprs/trunk/CPRS-Chart/Orders/fODBBank.pas@ 1736

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

Updating the working copy to CPRS version 28
File size: 166.4 KB
Line 
1unit fODBBank;
2interface
3
4uses
5 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
6 Forms, Dialogs, StdCtrls, ORCtrls, ORfn, fODBase, ExtCtrls, ComCtrls, uConst,
7 ORDtTm, Buttons, Menus, ImgList, VA508AccessibilityManager, VAUtils;
8
9type
10 TfrmODBBank = class(TfrmODBase)
11 dlgLabCollTime: TORDateTimeDlg;
12 ORWanted: TORDateTimeDlg;
13 pnlComments: TPanel;
14 btnUpdateComments: TButton;
15 btnCancelComment: TButton;
16 lblOrdComment: TLabel;
17 pgeProduct: TPageControl;
18 TabInfo: TTabSheet;
19 edtInfo: TCaptionRichEdit;
20 TabDiag: TTabSheet;
21 lblReqComment: TOROffsetLabel;
22 TabResults: TTabSheet;
23 edtResults: TCaptionRichEdit;
24 pnlFields: TPanel;
25 lblDiagComment: TOROffsetLabel;
26 lblUrgency: TLabel;
27 lblReason: TLabel;
28 lblSurgery: TLabel;
29 cboUrgency: TORComboBox;
30 chkConsent: TCheckBox;
31 cboSurgery: TORComboBox;
32 pnlSelect: TPanel;
33 pnlDiagnosticTests: TGroupBox;
34 cboAvailTest: TORComboBox;
35 pnlBloodComponents: TGroupBox;
36 lblQuantity: TLabel;
37 lblModifiers: TLabel;
38 cboAvailComp: TORComboBox;
39 tQuantity: TEdit;
40 cboModifiers: TORComboBox;
41 GroupBox1: TGroupBox;
42 cboQuick: TORComboBox;
43 pnlSelectedTests: TGroupBox;
44 lvSelectionList: TCaptionListView;
45 btnRemove: TButton;
46 btnRemoveAll: TButton;
47 cboReasons: TORComboBox;
48 lblRequiredField: TLabel;
49 memDiagComment: TRichEdit;
50 lblCollType: TLabel;
51 cboCollType: TORComboBox;
52 lblCollTime: TLabel;
53 cboCollTime: TORComboBox;
54 calWantTime: TORDateBox;
55 lblWanted: TLabel;
56 calCollTime: TORDateBox;
57 txtImmedColl: TCaptionEdit;
58 pnlCollTimeButton: TKeyClickPanel;
59 lblTNS: TLabel;
60 lblNoBloodReq: TLabel;
61 cmdImmedColl: TSpeedButton;
62 Splitter1: TSplitter;
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 FormDestroy(Sender: TObject);
81 procedure btnRemoveClick(Sender: TObject);
82 procedure btnRemoveAllClick(Sender: TObject);
83 procedure cmdAcceptClick(Sender: TObject);
84 procedure calWantTimeChange(Sender: TObject);
85 procedure chkConsentClick(Sender: TObject);
86 procedure cboUrgencyChange(Sender: TObject);
87 procedure cboSurgeryChange(Sender: TObject);
88 procedure calCollTimeChange(Sender: TObject);
89 procedure cboQuickClick(Sender: TObject);
90 procedure tQuantityEnter(Sender: TObject);
91 procedure btnUpdateCommentsClick(Sender: TObject);
92 procedure btnCancelCommentClick(Sender: TObject);
93 procedure cboSurgeryClick(Sender: TObject);
94 procedure cboReasonsEnter(Sender: TObject);
95 procedure cboReasonsExit(Sender: TObject);
96 procedure tQuantityClick(Sender: TObject);
97 procedure tQuantityChange(Sender: TObject);
98 procedure cboReasonsChange(Sender: TObject);
99 procedure cboModifiersChange(Sender: TObject);
100 procedure lvSelectionListClick(Sender: TObject);
101 procedure cboCollTimeChange(Sender: TObject);
102 procedure memDiagCommentChange(Sender: TObject);
103 procedure cboUrgencyExit(Sender: TObject);
104 procedure pnlBloodComponentsEnter(Sender: TObject);
105 procedure pnlDiagnosticTestsEnter(Sender: TObject);
106 procedure pnlDiagnosticTestsExit(Sender: TObject);
107 procedure pnlBloodComponentsExit(Sender: TObject);
108 procedure pnlBloodComponentsClick(Sender: TObject);
109 procedure pnlDiagnosticTestsClick(Sender: TObject);
110 procedure cboCollTypeClick(Sender: TObject);
111 procedure cboAvailTestEnter(Sender: TObject);
112 procedure cboCollTypeEnter(Sender: TObject);
113 procedure txtImmedCollEnter(Sender: TObject);
114 procedure calCollTimeEnter(Sender: TObject);
115 procedure cboCollTimeEnter(Sender: TObject);
116 procedure cboModifiersEnter(Sender: TObject);
117 procedure calWantTimeEnter(Sender: TObject);
118 procedure cboAvailCompEnter(Sender: TObject);
119 procedure FormShow(Sender: TObject);
120 protected
121 FCmtTypes: TStringList ;
122 procedure InitDialog; override;
123 function ValidCollTime(UserEntry: string): string;
124 procedure GetAllCollSamples(AComboBox: TORComboBox);
125 procedure GetAllSpecimens(AComboBox: TORComboBox);
126 procedure SetupCollTimes(CollType: string);
127 procedure LoadCollType(AComboBox:TORComboBox);
128 function ValidAdd: Boolean;
129 procedure ValidateAdd(var AnErrMsg: string);
130 procedure Validate(var AnErrMsg: string); override;
131 procedure ExtractMSBOS(OutList:TStrings; AList:TStrings);
132 procedure ExtractTests(OutList:TStrings; AList:TStrings);
133 procedure ExtractSurgeries(OutList:TStrings; AList:TStrings);
134 procedure ExtractUrgencies(OutList:TStrings; AList:TStrings);
135 procedure ExtractTNSOrders(OutList:TStrings; AList:TStrings);
136 procedure ExtractModifiers(OutList:TStrings; AList:TStrings);
137 procedure ExtractReasons(OutList:TStrings; AList:TStrings);
138 procedure ExtractSpecimens(OutList:TStrings; AList:TStrings);
139 procedure ExtractTypeScreen(OutList:TStrings; AList:TStrings);
140 procedure ExtractOther(OutList:TStrings; AList:TStrings);
141 procedure ExtractPatientInfo(OutList:TStrings; AList:TStrings);
142 procedure ExtractSpecimen(OutList:TStrings; AList:TStrings);
143 function SpecimenNeeded(OutList:TStrings; AList:TStrings; CompID:integer): Boolean;
144 procedure LoadUrgencies(AComboBox:TORComboBox);
145 procedure LoadModifiers(AComboBox:TORComboBox);
146 procedure LoadReasons(AComboBox:TORComboBox);
147
148 private
149 FLastCollType: string;
150 FLastCollTime: string;
151 FLastLabCollTime: string;
152 FLastLabID: string;
153 FLastItemID: string;
154 FEvtDelayLoc: integer;
155 FEvtDivision: integer;
156 FVbecLookup: string;
157 FQuickList: Integer;
158 FQuickItems: TStringList;
159 FOrderAction: Integer;
160 procedure ReadServerVariables;
161 procedure SetOnQuickOrder;
162 public
163 procedure SetupDialog(OrderAction: Integer; const ID: string); override;
164 procedure LoadRequiredComment(CmtType: integer);
165 procedure DetermineCollectionDefaults(Responses: TResponses);
166 property EvtDelayLoc: integer read FEvtDelayLoc write FEvtDelayLoc;
167 property EvtDivision: integer read FEvtDivision write FEvtDivision;
168 end;
169
170type
171 TCollSamp = class(TObject)
172 CollSampID: Integer; { IEN of CollSamp }
173 CollSampName: string; { Name of CollSamp }
174 SpecimenID: Integer; { IEN of default specimen }
175 SpecimenName: string; { Name of the specimen }
176 TubeColor: string; { TubeColor (text) }
177 MinInterval: Integer; { Minimum days between orders }
178 MaxPerDay: Integer; { Maximum orders per day }
179 LabCanCollect: Boolean; { True if lab can collect }
180 SampReqComment: string; { Name of required comment }
181 WardComment: TStringList; { CollSamp specific comment }
182 end;
183
184 TLabTest = class(TObject)
185 TestID: Integer; { IEN of Lab Test }
186 TestName: string; { Name of Lab Test }
187 ItemID: Integer; { Orderable Item ID }
188 LabSubscript: string ; { which section of Lab? }
189 CollSamp: Integer; { index into CollSampList }
190 Specimen: Integer; { IEN of specimen }
191 Urgency: Integer; { IEN of urgency }
192 Comment: TStringList; { text of comment }
193 TestReqComment: string; { Name of required comment }
194 CurReqComment: string; { name of required comment }
195 CurWardComment: TStringList; { WP of Ward Comment }
196 UniqueCollSamp: Boolean; { true if not prompt CollSamp }
197 CollSampList: TList; { collection sample objects }
198 CollSampCount: integer; { count of original contents of CollSampList}
199 SpecimenList: TStringList; { Strings: IEN^Specimen Name }
200 SpecListCount: integer; { count of original contents of SpecimenList}
201 UrgencyList: TStringList; { Strings: IEN^Urgency Name }
202 ForceUrgency: Boolean; { true if not prompt Urgency }
203 SurgeryList: TStringList; { Strings: Surgeries}
204 PatientInfo: TStringList; { Text of Patient Information}
205 ResultsDisplay: TStringList; { Text of Test Results}
206 QuickOrderResponses: TResponses; { if created as a result of a quick order selection}
207 { functions & procedures }
208 constructor Create(const LabTestIEN: string; Responses: TResponses);
209 destructor Destroy; override ;
210 function IndexOfCollSamp(CollSampIEN: Integer): Integer;
211 procedure FillCollSampList(LoadData: TStringList; DfltCollSamp: Integer);
212 procedure LoadAllSamples;
213 procedure SetCollSampDflts;
214 procedure ChangeCollSamp(CollSampIEN: Integer);
215 procedure ChangeSpecimen(const SpecimenIEN: string);
216 procedure ChangeComment(const CommentText: string);
217 function LabCanCollect: Boolean;
218 procedure LoadCollSamp(AComboBox: TORComboBox);
219 procedure LoadSpecimen(AComboBox: TORComboBox);
220 procedure LoadUrgency(CollType: string; AComboBox:TORComboBox);
221 function NameOfCollSamp: string;
222 function NameOfSpecimen: string;
223 function NameOfUrgency: string;
224 function ObtainCollSamp: Boolean;
225 function ObtainSpecimen: Boolean;
226 function ObtainUrgency: Boolean;
227 function ObtainComment: Boolean;
228
229 end;
230
231const
232 CmtType: array[0..6] of string = ('ANTICOAGULATION','DOSE/DRAW TIMES','ORDER COMMENT',
233 'ORDER COMMENT MODIFIED','TDM (PEAK-TROUGH)',
234 'TRANSFUSION','URINE VOLUME');
235var
236 frmODBBank: TfrmODBBank;
237
238implementation
239
240{$R *.dfm}
241
242uses rODBase, rODLab, uCore, rCore, fODLabOthCollSamp, fODLabOthSpec, fODLabImmedColl, fLabCollTimes,
243 rOrders, uODBase, fRptBox;
244
245var
246 uSelectedItems: TStringList; //Selected Items in ListView- if TestYes =1 then test else component
247 //TestYes(1)^Test-Component(2)^Qty(3)^Modifier(4)^Specimen(5,6)^CollTime(7)^CollType(8)
248 uVBECList: TStringList; //List of items from VBEC api
249 uTestsForResults: TStringList; //List of tests to show results
250 uUrgencyList: TStringList; //List of Urgencies
251 uTNSOrders: TStringList; //List of Current orders for Type & Screen
252 uModifierList: TStringList; //List of Modifiers
253 uReasonsList: TStringList; //List of Reasons for Request
254 uRaw: TStringList; //Results Array
255 uTestSelected, uComponentSelected: Boolean; //Used on Validate
256 uDfltUrgency: Integer; //Default Urgency
257 uSelUrgency: String; //Previously Selected Urgency - Used when components have been added for specific urgency
258 uSelSurgery: Integer; //Selected Surgery for Blood order
259 uSpecimen, uGetTnS: Integer; //Set to 1 if a specimen for test is already in lab... no need to collect
260 uDfltCollType, uReason: string;
261 ALabTest: TLabTest;
262 UserHasLRLABKey: boolean;
263 uChangingMSBOS: boolean;
264 LRFZX : string; //the default collection type (LC,WC,SP,I)
265 LRFSAMP : string; //the default sample (ptr)
266 LRFSPEC : string; //the default specimen (ptr)
267 LRFDATE : string; //the default collection time (NOW,NEXT,AM,PM,T...)
268 LRFURG : string; //the default urgency (number) TRY '2'
269 LRFSCH : string; //the default schedule? (ONE TIME, QD, ...)
270 LRORDERMODE : Integer; //the mode being used to order (component or diagnostic test)
271
272const
273 TX_NO_TEST = 'A Lab Test must be specified.' ;
274 TX_NO_IMMED = 'Immediate collect is not available for this test/sample';
275 TX_NO_IMMED_CAP = 'Invalid Collection Type';
276
277 TI_INFO = 0; //Corresponds with pgeProduct TabIndex
278 TI_COMPONENT = 1;
279 TI_RESULTS = 2;
280
281 TORDER_MODE_INFO = 0;
282 TORDER_MODE_DIAG = 1;
283 TORDER_MODE_COMP = 2;
284
285procedure TfrmODBBank.FormCreate(Sender: TObject);
286var
287 i: integer;
288 AList, ATests: TStringList;
289 ListCount: Integer;
290 x: string;
291begin
292 AutoSizeDisabled := True;
293 inherited;
294 AList := TStringList.Create;
295 ATests := TStringList.Create;
296 uSelectedItems := TStringList.Create;
297 uVBECList := TStringList.Create;
298 uTestsForResults := TStringList.Create;
299 uUrgencyList := TStringList.Create;
300 uTNSOrders := TStringList.Create;
301 uModifierList := TStringList.Create;
302 uReasonsList := TStringList.Create;
303 uRaw := TStringList.Create;
304 uSpecimen := 0;
305 uGetTnS := 0;
306 uReason := '';
307 lblTNS.Caption := '';
308 lblTNS.Visible := false;
309 pnlMessage.Visible := false;
310 uDfltUrgency := 9;
311 uSelUrgency := '';
312 uSelSurgery := 0;
313 uChangingMSBOS := false;
314 TabResults.Caption := 'Lab Results';
315 edtResults.Lines.Clear;
316 edtResults.Lines.Add('Lab results are ONLY available after selecting/adding a component on the Blood Bank Orders tab that has been designated for results retrieval.');
317 Responses.Clear;
318 try
319 LRFZX := '';
320 LRFSAMP := '';
321 LRFSPEC := '';
322 LRFDATE := '';
323 LRFURG := '';
324 LRFSCH := '';
325 LRORDERMODE := TORDER_MODE_INFO;
326 FLastColltime := '';
327 FLastLabCollTime := '';
328 FLastItemID := '';
329 uDfltCollType := '';
330 FillerID := 'LR';
331 FEvtDelayLoc := 0;
332 FEvtDivision := 0;
333 UserHasLRLABKey := User.HasKey('LRLAB');
334 AllowQuickOrder := True;
335 if GetDiagnosticPanelLocation then
336 begin
337 pnlDiagnosticTests.Left := 0;
338 pnlBloodComponents.Left := (pnlDiagnosticTests.Width + 10);
339 pnlDiagnosticTests.TabOrder := 0;
340 pnlBloodComponents.TabOrder := 1;
341 end
342 else
343 begin
344 pnlBloodComponents.Left := 0;
345 pnlDiagnosticTests.Left := (pnlBloodComponents.Width + 10);
346 pnlBloodComponents.TabOrder := 0;
347 pnlDiagnosticTests.TabOrder := 1;
348 end;
349 StatusText('Loading Dialog Definition');
350 FCmtTypes := TStringList.Create;
351 for i := 0 to 6 do FCmtTypes.Add(CmtType[i]) ;
352 Responses.Dialog := 'VBEC BLOOD BANK'; // loads formatting info
353 StatusText('Loading Default Values');
354 if Self.EvtID > 0 then
355 begin
356 EvtDelayLoc := StrToIntDef(GetEventLoc1(IntToStr(Self.EvtID)),0);
357 EvtDivision := StrToIntDef(GetEventDiv1(IntToStr(Self.EvtID)),0);
358 if EvtDelayLoc>0 then
359 FastAssign(ODForLab(EvtDelayLoc,EvtDivision), AList)
360 else
361 FastAssign(ODForLab(Encounter.Location,EvtDivision), AList);
362 end else
363 FastAssign(ODForLab(Encounter.Location), AList); // ODForLab returns TStrings with defaults
364 CtrlInits.LoadDefaults(AList);
365 InitDialog;
366 GroupBox1.Visible := True;
367 with CtrlInits do
368 begin
369 SetControl(cboCollType, 'Collection Types');
370 uDfltCollType := ExtractDefault(AList, 'Collection Types');
371 if uDfltCollType <> '' then
372 cboCollType.SelectByID(uDfltCollType)
373 else if OrderForInpatient then
374 cboCollType.SelectByID('LC')
375 else
376 cboCollType.SelectByID('SP');
377 //SetupCollTimes(cboCollType.ItemID);
378 end;
379 cboAvailTest.Clear;
380 aList.Clear;
381 GetDiagnosticTests(aList); //Get Tests in right order
382 for i := 0 to aList.Count - 1 do
383 cboAvailTest.Items.Add(aList[i]);
384 cboAvailComp.Clear;
385 aList.Clear;
386 GetBloodComponents(aList); //Get Components in right order
387 for i := 0 to aList.Count - 1 do
388 cboAvailComp.Items.Add(aList[i]);
389 uVBECList.Clear;
390 edtInfo.Clear;
391 cboSurgery.Clear;
392 GetPatientBBInfo(uVBECList, Patient.DFN, Encounter.Location);
393 aList.Clear;
394 ExtractPatientInfo(AList, uVBECList);
395 QuickCopy(AList, edtInfo);
396 AList.Clear;
397 ExtractSurgeries(AList, uVBECList);
398 for i := 0 to AList.Count - 1 do
399 cboSurgery.Items.Add(AList[i]);
400 AList.Clear;
401 ExtractUrgencies(uUrgencyList, uVBECList);
402 if not(self.EvtID > 0) then ExtractTNSOrders(uTNSOrders, uVBECList);
403 LoadUrgencies(cboUrgency);
404 ExtractModifiers(uModifierList, uVBECList);
405 ExtractReasons(uReasonsList, uVBECList);
406 LoadModifiers(cboModifiers);
407 LoadReasons(cboReasons);
408 pgeProduct.TabIndex := TI_INFO;
409 lvSelectionList.Column[0].Width := 240;
410 lvSelectionList.Column[1].Width := 30;
411 lvSelectionList.Column[2].Width := 100;
412 DisableComponentControls;
413 DisableDiagTestControls;
414 pnlDiagnosticTests.Caption := 'Diagnostic Tests';
415 pgeProduct.ActivePageIndex := TI_INFO;
416 StatusText('');
417 x := 'VBEC';
418 FQuickItems := TStringList.Create;
419 ListForQuickOrders(FQuickList, ListCount, x);
420 if ListCount > 0 then
421 begin
422 SubsetOfQuickOrders(FQuickItems, FQuickList, 0, 0);
423 end else
424 begin
425 ListCount := 1;
426 FQuickItems.Add('0^(No quick orders available)');
427 end;
428
429 FastAssign(FQuickItems, cboQuick.Items);
430 if lvSelectionList.Items.Count > 0 then
431 begin
432 memOrder.Visible := true;
433 cmdAccept.Visible := true;
434 end;
435 finally
436 AList.Free;
437 ATests.Free;
438 end;
439end;
440
441procedure TfrmODBBank.InitDialog;
442begin
443 inherited;
444 Changing := True;
445 if ALabTest <> nil then
446 begin
447 ALabTest.Destroy;
448 ALabTest := nil;
449 end;
450 DisableCommentPanels;
451 cboAvailTest.SelectByID(FLastItemID);
452 cboAvailComp.SelectByID(FLastItemID);
453 cboAvailTest.ItemIndex := -1;
454 StatusText('');
455 Changing := False ;
456end;
457
458procedure TfrmODBBank.SetupDialog(OrderAction: Integer; const ID: string);
459var
460 AnInstance, CurAdd: Integer;
461 AResponse: TResponse;
462 i, j, k, aTNS, getTest, TestAdded, aMSBOSContinue: integer;
463 aStr, aTestYes, aName, aTypeScreen, aSpecimen, aSpecimenUID, aSpecimenReq, aModifier, sub, sub1, x, aTNSString, aUrgText: string;
464 ListItem: TListItem;
465 aList, cList: TStringList;
466 aTests: TStringList;
467 xLabTest: TLabTest;
468 aGotTNS : Boolean;
469begin
470 inherited;
471 aList := TStringList.Create;
472 cList := TStringList.Create;
473 aTests:= TStringList.Create;
474 aGotTNS := false;
475 try
476 FOrderAction := OrderAction;
477 ReadServerVariables;
478 sub1 := '';
479 aTypeScreen := '';
480 aSpecimen := '';
481 aSpecimenUID := '';
482 aSpecimenReq := '';
483 aModifier := '';
484 if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses, ALabTest do
485 begin
486 pgeProduct.ActivePageIndex := TI_COMPONENT;
487 AnInstance := NextInstance('ORDERABLE', 0);
488 while AnInstance > 0 do
489 begin
490 AResponse := FindResponseByName('ORDERABLE', AnInstance);
491 if AResponse <> nil then
492 begin
493 sub := GetSubtype(AResponse.EValue);
494 if sub = 't' then
495 begin
496 SetControl(cboAvailTest, 'ORDERABLE', AnInstance);
497 changing := true;
498 cboAvailTestSelect(Self);
499 changing := false;
500 end
501 else
502 begin
503 SetControl(cboAvailComp, 'ORDERABLE', AnInstance);
504 ALabTest := TLabTest.Create(cboAvailComp.ItemID, Responses);
505 end;
506 if ALabTest = nil then Exit; // Causes access violation
507 if AnInstance = 1 then
508 begin
509 SetControl(cboReasons, 'REASON' , AnInstance);
510 SetControl(calWantTime, 'DATETIME', AnInstance);
511 SetControl(memDiagComment, 'COMMENT', AnInstance);
512 SetControl(chkConsent, 'YN', AnInstance);
513 //DetermineCollectionDefaults(Responses);
514 SetControl(cboSurgery, 'MISC', AnInstance);
515 SetControl(cboUrgency, 'URGENCY', AnInstance);
516 if cboUrgency.ItemIEN = 0 then
517 begin
518 if StrToIntDef(LRFURG, 0) > 0 then
519 cboUrgency.SelectByID(LRFURG)
520 else if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
521 cboUrgency.ItemIndex := 0;
522 end;
523 Urgency := cboUrgency.ItemIEN;
524 if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
525 begin
526 cboUrgency.ItemIndex := 0;
527 Urgency := cboUrgency.ItemIEN;
528 end;
529 i := 1 ;
530 AResponse := Responses.FindResponseByName('COMMENT',i);
531 while AResponse <> nil do
532 begin
533 Comment.Add(AResponse.EValue);
534 Inc(i);
535 AResponse := Responses.FindResponseByName('COMMENT',i);
536 end ;
537 cboUrgencyChange(self);
538 end;
539 if sub = 't' then with ALabTest do //DIAGNOSTIC TEST
540 begin
541 Changing := True;
542 DisableComponentControls;
543 EnableDiagTestControls;
544 LRORDERMODE := TORDER_MODE_DIAG;
545 //DetermineCollectionDefaults(Responses);
546 aList.Clear;
547 aTestYes := '1';
548 ExtractTypeScreen(aList, uVBECList);
549 if aList.Count > 0 then aTypeScreen := aList[0];
550 aList.Clear;
551 if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
552 if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
553 else
554 begin
555 cboUrgency.ItemIndex := 2;
556 for i := 0 to cboUrgency.Items.Count - 1 do
557 begin
558 aUrgText := cboUrgency.Items[i];
559 if aUrgText = '9^ROUTINE' then // Find urgency default of ROUTINE
560 begin
561 cboUrgency.ItemIndex := i;
562 break;
563 end;
564 end;
565 Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
566 cboUrgencyChange(self);
567 end;
568 if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
569 if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
570 memOrder.Text := Responses.OrderText;
571 Changing := False;
572 if ObtainCollSamp then
573 begin
574 //For BloodBank orders, this condition should never occur
575 end
576 else
577 begin
578 with ALabTest do
579 with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
580 begin
581 x := '' ;
582 for i := 0 to WardComment.Count-1 do
583 x := x + WardComment.strings[i]+#13#10 ;
584 pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
585 OrderMessage(x) ;
586 end ;
587 end;
588 end;
589 if sub = 'c' then with ALabTest do //COMPONENT
590 begin
591 Changing := True;
592 DisableDiagTestControls;
593 EnableComponentControls;
594 aTestYes := '0';
595 LRORDERMODE := TORDER_MODE_COMP;
596 SetControl(cboModifiers, 'MODIFIER', AnInstance);
597 SetControl(tQuantity, 'QTY', AnInstance);
598 uComponentSelected := true;
599 aList.Clear;
600 TestAdded := 0;
601 getTest := 0;
602 ExtractTests(aList, uVBECList); //Get Results associated with ordered components
603 for j := 0 to aList.Count - 1 do
604 begin
605 if StrToInt(piece(aList[j],'^',1)) = aLabTest.ItemID then
606 begin
607 if uTestsForResults.Count < 1 then getTest := 1;
608 for k := 0 to uTestsForResults.Count - 1 do
609 begin
610 if piece(uTestsForResults[k],'^',1) = piece(aList[j],'^',3) then
611 begin
612 getTest := 0;
613 break;
614 end
615 else getTest := 1;
616 end;
617 if getTest = 1 then
618 begin
619 uTestsForResults.Add(piece(aList[j],'^',3));
620 TestAdded := 1;
621 end;
622 end;
623 end;
624 if TestAdded = 1 then
625 begin
626 aTests.Clear;
627 GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults);
628 if aTests.Count > 0 then
629 begin
630 edtResults.Clear;
631 QuickCopy(ATests,edtResults);
632 TabResults.Caption := 'Lab Results Available';
633 uRaw.Clear;
634 GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults);
635 end;
636 end;
637 CurAdd := 1;
638 if uRaw.Count > 0 then
639 for j := 0 to uRaw.Count - 1 do
640 begin
641 if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
642 Inc(CurAdd);
643 end;
644 for i := lvSelectionList.Items.Count - 1 downto 0 do
645 begin
646 if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
647 begin
648 aGotTNS := true;
649 break;
650 end;
651 end;
652 if (uTNSOrders.Count < 1) and (aGotTNS = false) and (SpecimenNeeded(aList, uVBECList, aLabTest.ItemID)) then //check to see if type and screen is needed CQ 17349
653 begin
654 uGetTnS := 1;
655 end;
656 if aList.Count > 0 then
657 begin
658 aSpecimen := piece(aList[0], '^',1);
659 aSpecimenUID := piece(aList[0], '^',2);
660 end;
661 aList.Clear;
662 ExtractSpecimens(aList, uVBECList); //Get specimen values to pass back to Server
663 for i := 0 to aList.Count - 1 do
664 begin
665 if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) then
666 begin
667 aSpecimenReq := piece(aList[i],'^',2);
668 if (SpecimenNeeded(aList, uVBECList, aLabTest.ItemID)) then
669 aSpecimenUID := '';
670 break;
671 end;
672 end;
673 with lvSelectionList do
674 begin
675 ListItem := Items.Add;
676 ListItem.Caption := piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2);
677 ListItem.SubItems.Add(tQuantity.Text);
678 if length(cboModifiers.ItemID) > 0 then
679 begin
680 ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
681 ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
682 end
683 else
684 begin
685 ListItem.SubItems.Add('');
686 ListItem.SubItems.Add('');
687 end;
688 ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
689 end;
690 aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimenReq + '^' + aSpecimen + '^' + aSpecimenUID + '^' + IntToStr(aLabTest.ItemID);
691 uSelectedItems.Add(aStr);
692 memOrder.Text := Responses.OrderText;
693 Changing := False;
694 if (Length(cboSurgery.Text) > 0) then
695 begin
696 for i := 0 to cboSurgery.Items.Count - 1 do
697 if uppercase(cboSurgery.Text) = uppercase(piece(cboSurgery.Items[i],'^',2)) then
698 begin
699 cboSurgery.ItemIndex := i;
700 Break;
701 end;
702 cboSurgeryChange(self);
703 end;
704 end;
705 end;
706 StatusText('');
707 AnInstance := NextInstance('ORDERABLE', AnInstance);
708 end; //while AnInstance - ORDERABLE
709 DisableComponentControls;
710 DisableDiagTestControls;
711 end;
712 cList.Clear;
713 if (Length(cboSurgery.ItemID) > 0) then
714 begin
715 for j := 0 to uSelectedItems.Count - 1 do
716 begin
717 xLabTest := TLabTest.Create(piece(uSelectedItems[j],'^',2), Responses);
718 if (piece(uSelectedItems[j],'^',1) = '0') and (not(piece(uSelectedItems[j],'^',3)='')) and (StrToInt(piece(uSelectedItems[j],'^',3)) > 0) and (piece(cboSurgery.Items[cboSurgery.ItemIndex],'^',3) = '1') then
719 begin
720 cList.Add(xLabTest.TestName + '^' + piece(uSelectedItems[j],'^',3));
721 end;
722 xLabTest.Free;
723 end;
724 end;
725 if (uChangingMSBOS = false) and (cList.Count > 0) then
726 begin
727 lblNoBloodReq.Visible := true;
728 with Application do
729 begin
730 NormalizeTopMosts;
731 aMSBOSContinue :=
732 MessageBox(PChar('No blood is required for the surgical procedure: ' + cboSurgery.text +
733 '.' + CRLF +
734 'If you still need to order any components, please enter a justification in the Comment box.'
735 + CRLF + CRLF + 'Do you want me to remove ALL the component orders you''ve just entered? '),
736 PChar('No Blood Required'),MB_YESNO);
737 RestoreTopMosts;
738 end;
739 if aMSBOSContinue = 6 then
740 begin
741 tQuantity.Text := '';
742 for j := uSelectedItems.Count - 1 downto 0 do
743 begin
744 if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '0') then
745 begin
746 lvSelectionList.Items[j].Delete;
747 uSelectedItems.Delete(j);
748 Responses.Update('ORDERABLE', (j+1) ,'', '');
749 Responses.Update('MODIFIER', (j+1), '', '');
750 Responses.Update('QTY', (j+1), '', '');
751 end;
752 end;
753 cboAvailComp.Text := '';
754 cboAvailComp.ItemIndex := -1;
755 cboModifiers.Text := '';
756 cboModifiers.ItemIndex := -1;
757 lblNoBloodReq.Visible := false;
758 //if fODBBank. Active then cboAvailTest.SetFocus;
759 lblTNS.Caption := '';
760 lblTNS.Visible := false;
761 DisableComponentControls;
762 end;
763 end;
764 for i := 0 to lvSelectionList.Items.Count - 1 do
765 begin
766 if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
767 begin
768 uGetTnS := 0;
769 aGotTNS := true;
770 uDfltUrgency := cboUrgency.ItemID;
771 lblTNS.Caption := '';
772 lblTNS.Visible := false;
773 memMessage.Text := '';
774 pnlMessage.Visible := false;
775 pnlDiagnosticTests.Caption := 'Diagnostic Tests';
776 if uTNSOrders.Count > 0 then
777 begin
778 for j := 0 to uTNSOrders.Count - 1 do
779 aTNSString := aTNSString + CRLF + uTNSOrders[j];
780 with Application do
781 begin
782 NormalizeTopMosts;
783 aTNS :=
784 MessageBox(PChar(aTNSString + CRLF + CRLF +
785 'Do you wish to cancel this request for Type & Screen?'),
786 PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'),
787 MB_YESNO);
788 RestoreTopMosts;
789 if aTNS = 6 then
790 begin
791 lvSelectionList.ItemIndex := i;
792 lvSelectionListClick(self);
793 btnRemoveClick(self);
794 break;
795 end;
796 end;
797 end;
798 break;
799 end;
800 end;
801 if uSelectedItems.Count < 1 then uGetTNS := 0;
802
803 for i := uSelectedItems.Count - 1 downto 0 do
804 begin
805 if (aGotTNS = false) and not(piece(uSelectedItems[i],'^',1) = '1') and (uTNSOrders.Count < 1) and (piece(uSelectedItems[i],'^',5) = '1') then //CQ 17349
806 begin
807 uGetTnS := 1;
808 break;
809 end;
810 end;
811
812 CurAdd := 1;
813 for i := 0 to uSelectedItems.Count - 1 do
814 begin
815 aName := lvSelectionList.Items[i].Caption;
816 x := uSelectedItems[i];
817 if piece(x,'^',1) = '1' then //Diagnostic Test related fields
818 begin
819 if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
820 end
821 else
822 begin
823 if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
824 if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
825 if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), piece(x,'^',4));
826 if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
827 if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
828 if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
829 if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
830 else
831 begin
832 cboUrgency.ItemIndex := 2;
833 for j := 0 to cboUrgency.Items.Count - 1 do
834 begin
835 aUrgText := cboUrgency.Items[j];
836 if aUrgText = '9^ROUTINE' then // Find urgency default of ROUTINE
837 begin
838 cboUrgency.ItemIndex := j;
839 break;
840 end;
841 end;
842 Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
843 cboUrgencyChange(self);
844 end;
845 end;
846 Inc(CurAdd);
847 end;
848 if uGetTnS = 1 then
849 begin
850 lblTNS.Caption := 'TYPE + SCREEN must be added to order';
851 lblTNS.Visible := true;
852 memMessage.Text := 'TYPE + SCREEN must be added to order';
853 pnlMessage.Visible := true;
854 pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
855 end
856 else pnlDiagnosticTests.Caption := 'Diagnostic Tests';
857 finally
858 aList.Free;
859 cList.Free;
860 aTests.Free;
861 end;
862 if lvSelectionList.Items.Count > 0 then
863 begin
864 pnlSelectedTests.Visible := True;
865 cmdAccept.Visible := True;
866 memOrder.Visible := True;
867 GroupBox1.Visible := False;
868 lvSelectionList.Items[0].Selected := true;
869 lvSelectionListClick(self);
870 end;
871end;
872
873procedure TfrmODBBank.SetOnQuickOrder;
874 var
875 AnInstance: Integer;
876 AResponse: TResponse;
877 i: integer;
878 x,sub,sub1,aTNSString: string;
879 aList, cList: TStringList;
880 aGotIt, aGotTNS: boolean;
881 aTests: TStringList;
882 ListItem: TListItem;
883 xLabTest: TLabTest;
884 aName, aMsg, aStr, aModifier, aReason, aSurgery, aCollTime, aTestYes, aSpecimen, aSpecimenUID, aSpecimenReq, aTypeScreen, aUrgText: String;
885 CurAdd, j, k, getTest, TestAdded, aMSBOS, aMSBOSContinue, aTNS: Integer;
886begin
887 inherited;
888 aList := TStringList.Create;
889 cList := TStringList.Create;
890 aTests := TStringList.Create;
891 pgeProduct.ActivePageIndex := TI_COMPONENT;
892 try
893 aModifier := '';
894 aReason := '';
895 aSurgery := '';
896 aCollTime := '';
897 aTestYes := '0';
898 aTypeScreen := '';
899 aSpecimen := '';
900 aSpecimenUID := '';
901 aSpecimenReq := '';
902 sub1 := '';
903 aGotTNS := false;
904 ExtractTypeScreen(aList, uVBECList);
905 if aList.Count > 0 then aTypeScreen := aList[0];
906 aList.Clear;
907 ExtractSpecimen(aList, uVBECList);
908 if aList.Count > 0 then
909 begin
910 aSpecimen := piece(aList[0], '^',1);
911 aSpecimenUID := piece(aList[0], '^',2);
912 end;
913 with Responses, ALabTest do
914 begin
915 Changing := True;
916 aGotIt := False;
917 FLastItemID := cboQuick.ItemID;
918 QuickOrder := ExtractInteger(cboQuick.ItemID);
919 with Responses do
920 begin
921 StatusText('Initializing Quick Order');
922 AnInstance := NextInstance('ORDERABLE', 0);
923 while AnInstance > 0 do
924 begin
925 AResponse := FindResponseByName('ORDERABLE', AnInstance);
926 sub := GetSubtype(AResponse.EValue);
927 if sub = 't' then
928 begin
929 SetControl(cboAvailTest, 'ORDERABLE', AnInstance);
930 ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses);
931 end
932 else
933 begin
934 SetControl(cboAvailComp, 'ORDERABLE', AnInstance);
935 ALabTest := TLabTest.Create(cboAvailComp.ItemID, Responses);
936 end;
937 for i := 0 to aList.Count - 1 do
938 if aList[i] = ALabTest.TestName then
939 begin
940 aGotIt := true;
941 break;
942 end;
943 if aGotIt = true then
944 begin
945 aGotIt := false;
946 AnInstance := NextInstance('ORDERABLE', AnInstance);
947 Continue;
948 end
949 else
950 begin
951 aList.Add(ALabTest.TestName);
952 end;
953 if AResponse <> nil then
954 sub1 := GetSubtype(AResponse.EValue);
955 if AnInstance = 1 then
956 begin
957 SetControl(cboReasons, 'REASON', AnInstance);
958 SetControl(calWantTime, 'DATETIME', AnInstance);
959 SetControl(memDiagComment, 'COMMENT', AnInstance);
960 SetControl(chkConsent, 'YN', AnInstance);
961 //DetermineCollectionDefaults(Responses);
962 SetControl(cboUrgency, 'URGENCY', AnInstance);
963 if cboUrgency.ItemIEN = 0 then
964 begin
965 if StrToIntDef(LRFURG, 0) > 0 then
966 cboUrgency.SelectByID(LRFURG)
967 else if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
968 cboUrgency.ItemIndex := 0;
969 end;
970 SetControl(cboSurgery, 'MISC', AnInstance);
971 if Length(cboSurgery.Text) > 0 then
972 begin
973 for i := 0 to cboSurgery.Items.Count - 1 do
974 if uppercase(cboSurgery.Text) = uppercase(piece(cboSurgery.Items[i],'^',2)) then
975 begin
976 cboSurgery.ItemIndex := i;
977 Break;
978 end;
979 cboSurgeryChange(self);
980 end;
981 if not(ALabTest = nil) then
982 begin
983 i := 1 ;
984 AResponse := Responses.FindResponseByName('COMMENT',i);
985 while AResponse <> nil do
986 begin
987 Comment.Add(AResponse.EValue);
988 Inc(i);
989 AResponse := Responses.FindResponseByName('COMMENT',i);
990 end ;
991 end;
992 end;
993 if sub1 = 'c' then
994 begin
995 DisableDiagTestControls;
996 EnableComponentControls;
997 LRORDERMODE := TORDER_MODE_COMP;
998 SetControl(cboAvailComp, 'ORDERABLE', AnInstance);
999 SetControl(cboModifiers, 'MODIFIER', AnInstance);
1000 SetControl(tQuantity, 'QTY', AnInstance);
1001 aList.Clear;
1002 TestAdded := 0;
1003 getTest := 0;
1004 ExtractTests(aList, uVBECList); //Get Results associated with ordered components
1005 for j := 0 to aList.Count - 1 do
1006 begin
1007 if StrToInt(piece(aList[j],'^',1)) = aLabTest.ItemID then
1008 begin
1009 if uTestsForResults.Count < 1 then getTest := 1;
1010 for k := 0 to uTestsForResults.Count - 1 do
1011 begin
1012 if piece(uTestsForResults[k],'^',1) = piece(aList[j],'^',3) then
1013 begin
1014 getTest := 0;
1015 break;
1016 end
1017 else getTest := 1;
1018 end;
1019 if getTest = 1 then
1020 begin
1021 uTestsForResults.Add(piece(aList[j],'^',3));
1022 TestAdded := 1;
1023 end;
1024 end;
1025 end;
1026 if TestAdded = 1 then
1027 begin
1028 aTests.Clear;
1029 GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults);
1030 if aTests.Count > 0 then
1031 begin
1032 edtResults.Clear;
1033 QuickCopy(ATests,edtResults);
1034 TabResults.Caption := 'Lab Results Available';
1035 uRaw.Clear;
1036 GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults);
1037 end;
1038 end;
1039 CurAdd := 1;
1040 if uRaw.Count > 0 then
1041 for j := 0 to uRaw.Count - 1 do
1042 begin
1043 if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
1044 Inc(CurAdd);
1045 end;
1046 aSpecimen := '';
1047 aSpecimenUID := '';
1048 aSpecimenReq := '';
1049 aTestYes := '0';
1050 aReason := '';
1051 aSurgery := '';
1052 aCollTime := '';
1053 ExtractSpecimen(aList, uVBECList);
1054 if aList.Count > 0 then
1055 begin
1056 aSpecimen := piece(aList[0], '^', 1);
1057 aSpecimenUID := piece(aList[0], '^', 2);
1058 end;
1059 if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
1060 if length(cboReasons.ItemID) > 0 then aReason := cboReasons.Items[cboReasons.ItemIndex];
1061 if length(cboSurgery.ItemID) > 0 then aSurgery := cboSurgery.Items[cboSurgery.ItemIndex];
1062 if Length(cboSurgery.ItemID) > 0 then
1063 begin
1064 aList.Clear;
1065 ExtractMSBOS(aList, uVBECList); //Get maximum units for selected Surgey
1066 for i := 0 to aList.Count - 1 do
1067 begin
1068 if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
1069 and (uppercase((piece(aList[i],'^',3))) = uppercase(cboSurgery.Text)) then
1070 begin
1071 aMSBOS := StrToInt(piece(aList[i],'^',4));
1072 if (aMSBOS > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
1073 begin
1074 with Application do
1075 begin
1076 NormalizeTopMosts;
1077 aMSBOSContinue :=
1078 MessageBox(PChar('The number of units ordered (' + tQuantity.Text +
1079 ') for ' + aLabTest.TestName + ' Exceeds the maximum number recommended ('
1080 + IntToStr(aMSBOS) +
1081 ') for the ' + cboSurgery.text +
1082 ' surgical procedure.' + CRLF +
1083 'If you need to order more than the maximum number of units, please enter a justification in the Comment box.'
1084 + CRLF + CRLF + 'Edit the Blood component Quantity?'),
1085 PChar('Maximum Number of Units Exceeded'),
1086 MB_YESNO);
1087 RestoreTopMosts;
1088 end;
1089 if aMSBOSContinue = 6 then
1090 begin
1091 ShowMsg(cboAvailComp.Text + ' has NOT been added to this request.');
1092 lvSelectionList.Clear;
1093 uSelectedItems.Clear;
1094 uTestsForResults.Clear;
1095 uRaw.Clear;
1096 uGetTnS := 0;
1097 lblTNS.Caption := '';
1098 lblTNS.Visible := false;
1099 memMessage.Text := '';
1100 pnlMessage.Visible := false;
1101 FLastItemID := '';
1102 InitDialog;
1103 cboModifiers.ItemIndex := -1;
1104 cboAvailTest.ItemIndex := -1;
1105 cboAvailComp.ItemIndex := -1;
1106 cboSurgery.ItemIndex := -1;
1107 cboUrgency.ItemIndex := -1;
1108 cboReasons.ItemIndex := -1;
1109 cboCollType.ItemIndex := -1;
1110 cboCollTime.ItemIndex := -1;
1111 cboQuick.ItemIndex := -1;
1112 calWantTime.Text := '';
1113 memDiagComment.Text := '';
1114 GroupBox1.Visible := true;
1115 tQuantity.Text := '';
1116 FLastCollType := '';
1117 FLastCollTime := '';
1118 FLastLabCollTime := '';
1119 txtImmedColl.Text := '';
1120 calCollTime.text := '';
1121 exit;
1122 end;
1123 end;
1124 end;
1125 end;
1126 end;
1127 for i := lvSelectionList.Items.Count - 1 downto 0 do
1128 begin
1129 if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
1130 begin
1131 aGotTNS := true;
1132 break;
1133 end;
1134 end;
1135 if (uTNSOrders.Count < 1) and (aGotTNS = false) and (SpecimenNeeded(aList, uVBECList, aLabTest.ItemID)) then //check to see if type and screen is needed CQ 17349
1136 begin
1137 uGetTnS := 1;
1138 end;
1139 aList.Clear;
1140 ExtractSpecimens(aList, uVBECList); //Get specimen values to pass back to Server
1141 for i := 0 to aList.Count - 1 do
1142 begin
1143 if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) then
1144 begin
1145 aSpecimenReq := piece(aList[i],'^',2);
1146 if (SpecimenNeeded(aList, uVBECList, aLabTest.ItemID)) then
1147 aSpecimenUID := '';
1148 break;
1149 end;
1150 end;
1151 uComponentSelected := true;
1152 with lvSelectionList do
1153 begin
1154 ListItem := Items.Add;
1155 ListItem.Caption := piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2);
1156 ListItem.SubItems.Add(tQuantity.Text);
1157 if length(cboModifiers.ItemID) > 0 then
1158 begin
1159 ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
1160 ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
1161 end
1162 else
1163 begin
1164 ListItem.SubItems.Add('');
1165 ListItem.SubItems.Add('');
1166 end;
1167 ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
1168 end;
1169 CurAdd := 1;
1170 aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimenReq + '^' + aSpecimen + '^' + aSpecimenUID + '^' + IntToStr(aLabTest.ItemID);
1171 uSelectedItems.Add(aStr);
1172 for i := 0 to uSelectedItems.Count - 1 do
1173 begin
1174 aName := lvSelectionList.Items[i].Caption;
1175 x := uSelectedItems[i];
1176 if piece(x,'^',1) = '1' then //Diagnostic Test related fields
1177 begin
1178 if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
1179 end
1180 else
1181 begin
1182 if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
1183 if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
1184 if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), aModifier);
1185 if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
1186 if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
1187 end;
1188 Inc(CurAdd);
1189 end;
1190 memOrder.Text := Responses.OrderText;
1191 GroupBox1.Visible := False;
1192 aMsg := '';
1193 LRORDERMODE := TORDER_MODE_INFO;
1194 if lvSelectionList.Items.Count > 0 then
1195 begin
1196 pnlSelectedTests.Visible := True;
1197 cmdAccept.Visible := True;
1198 memOrder.Visible := True;
1199 GroupBox1.Visible := False;
1200 end;
1201 end
1202 else
1203 begin
1204 if sub1 = 't' then
1205 begin
1206 DisableComponentControls;
1207 EnableDiagTestControls;
1208 LRORDERMODE := TORDER_MODE_DIAG;
1209 aTestYes := '1';
1210 SetControl(cboAvailTest, 'ORDERABLE', AnInstance);
1211 //DetermineCollectionDefaults(Responses); //cboCollType = COLLECT , calCollTime = START
1212 i := 1 ;
1213 AResponse := Responses.FindResponseByName('COMMENT',i);
1214 while AResponse <> nil do
1215 begin
1216 Comment.Add(AResponse.EValue);
1217 Inc(i);
1218 AResponse := Responses.FindResponseByName('COMMENT',i);
1219 end ;
1220 if ObtainCollSamp then
1221 begin
1222 //For BloodBank orders, this condition should never occur
1223 end
1224 else
1225 begin
1226 with ALabTest do
1227 with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
1228 begin
1229 x := '' ;
1230 for i := 0 to WardComment.Count-1 do
1231 x := x + WardComment.strings[i]+#13#10 ;
1232 pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
1233 OrderMessage(x) ;
1234 end ;
1235 end;
1236 if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
1237 if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
1238 else
1239 begin
1240 cboUrgency.ItemIndex := 2;
1241 for i := 0 to cboUrgency.Items.Count - 1 do
1242 begin
1243 aUrgText := cboUrgency.Items[i];
1244 if aUrgText = '9^ROUTINE' then // Find urgency default of ROUTINE
1245 begin
1246 cboUrgency.ItemIndex := i;
1247 break;
1248 end;
1249 end;
1250 Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
1251 cboUrgencyChange(self);
1252 end;
1253 if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
1254 if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
1255 uTestSelected := true;
1256 with lvSelectionList do
1257 begin
1258 ListItem := Items.Add;
1259 ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2);
1260 ListItem.SubItems.Add('');
1261 ListItem.SubItems.Add('');
1262 ListItem.SubItems.Add('');
1263 ListItem.SubItems.Add(piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1));
1264 end;
1265 CurAdd := 1;
1266 aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimenReq + '^' + aSpecimen + '^' + aSpecimenUID + '^' + IntToStr(aLabTest.ItemID);
1267 uSelectedItems.Add(aStr);
1268 for i := 0 to uSelectedItems.Count - 1 do
1269 begin
1270 aName := lvSelectionList.Items[i].Caption;
1271 x := uSelectedItems[i];
1272 if piece(x,'^',1) = '1' then //Diagnostic Test related fields
1273 begin
1274 if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
1275 end;
1276 Inc(CurAdd);
1277 end;
1278 memOrder.Text := Responses.OrderText;
1279 if lvSelectionList.Items.Count > 0 then
1280 begin
1281 pnlSelectedTests.Visible := True;
1282 cmdAccept.Visible := True;
1283 memOrder.Visible := True;
1284 GroupBox1.Visible := False;
1285 end;
1286 end;
1287 end;
1288 AnInstance := NextInstance('ORDERABLE', AnInstance);
1289 end;
1290 //Quick Order
1291 end;
1292 cList.Clear;
1293 if (Length(cboSurgery.ItemID) > 0) then
1294 begin
1295 for j := 0 to uSelectedItems.Count - 1 do
1296 begin
1297 xLabTest := TLabTest.Create(piece(uSelectedItems[j],'^',2), Responses);
1298 if (piece(uSelectedItems[j],'^',1) = '0') and (not(piece(uSelectedItems[j],'^',3)='')) and (StrToInt(piece(uSelectedItems[j],'^',3)) > 0) and (piece(cboSurgery.Items[cboSurgery.ItemIndex],'^',3) = '1') then
1299 begin
1300 cList.Add(xLabTest.TestName + '^' + piece(uSelectedItems[j],'^',3));
1301 end;
1302 xLabTest.Free;
1303 end;
1304 end;
1305 if (uChangingMSBOS = false) and (cList.Count > 0) then
1306 begin
1307 lblNoBloodReq.Visible := true;
1308 with Application do
1309 begin
1310 NormalizeTopMosts;
1311 aMSBOSContinue :=
1312 MessageBox(PChar('No blood is required for the surgical procedure: ' + cboSurgery.text +
1313 '.' + CRLF +
1314 'If you still need to order any components, please enter a justification in the Comment box.'
1315 + CRLF + CRLF + 'Do you want me to remove ALL the component orders you''ve just entered? '),
1316 PChar('No Blood Required'),MB_YESNO);
1317 RestoreTopMosts;
1318 end;
1319 if aMSBOSContinue = 6 then
1320 begin
1321 tQuantity.Text := '';
1322 for j := uSelectedItems.Count - 1 downto 0 do
1323 begin
1324 if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '0') then
1325 begin
1326 lvSelectionList.Items[j].Delete;
1327 uSelectedItems.Delete(j);
1328 Responses.Update('ORDERABLE', (j+1) ,'', '');
1329 Responses.Update('MODIFIER', (j+1), '', '');
1330 Responses.Update('QTY', (j+1), '', '');
1331 end;
1332 end;
1333 cboAvailComp.Text := '';
1334 cboAvailComp.ItemIndex := -1;
1335 cboModifiers.Text := '';
1336 cboModifiers.ItemIndex := -1;
1337 lblNoBloodReq.Visible := false;
1338 //if fODBBank. Active then cboAvailTest.SetFocus;
1339 lblTNS.Caption := '';
1340 lblTNS.Visible := false;
1341 DisableComponentControls;
1342 end;
1343 end;
1344 for i := 0 to lvSelectionList.Items.Count - 1 do
1345 begin
1346 if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
1347 begin
1348 uGetTnS := 0;
1349 uDfltUrgency := cboUrgency.ItemID;
1350 lblTNS.Caption := '';
1351 lblTNS.Visible := false;
1352 memMessage.Text := '';
1353 pnlMessage.Visible := false;
1354 pnlDiagnosticTests.Caption := 'Diagnostic Tests';
1355 if uTNSOrders.Count > 0 then
1356 begin
1357 for j := 0 to uTNSOrders.Count - 1 do
1358 aTNSString := aTNSString + CRLF + uTNSOrders[j];
1359 with Application do
1360 begin
1361 NormalizeTopMosts;
1362 aTNS :=
1363 MessageBox(PChar(aTNSString + CRLF + CRLF +
1364 'Do you wish to cancel this request for Type & Screen?'),
1365 PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'),
1366 MB_YESNO);
1367 RestoreTopMosts;
1368 if aTNS = 6 then
1369 begin
1370 lvSelectionList.ItemIndex := i;
1371 lvSelectionListClick(self);
1372 btnRemoveClick(self);
1373 break;
1374 end;
1375 end;
1376 end;
1377 break;
1378 end;
1379 end;
1380 if uGetTnS = 1 then
1381 begin
1382 lblTNS.Caption := 'TYPE + SCREEN must be added to order';
1383 lblTNS.Visible := true;
1384 memMessage.Text := 'TYPE + SCREEN must be added to order';
1385 pnlMessage.Visible := true;
1386 pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
1387 end
1388 else pnlDiagnosticTests.Caption := 'Diagnostic Tests';
1389 if ALabTest <> nil then
1390 begin
1391 if ObtainCollSamp then
1392 begin
1393 //For BloodBank orders, this condition should never occur
1394 end
1395 else
1396 begin
1397 with ALabTest do
1398 with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
1399 begin
1400 x := '' ;
1401 for i := 0 to WardComment.Count-1 do
1402 x := x + WardComment.strings[i]+#13#10 ;
1403 pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
1404 OrderMessage(x) ;
1405 end ;
1406 end;
1407 with ALabTest do
1408 begin
1409 if ObtainComment then
1410 LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment))
1411 else
1412 DisableCommentPanels;
1413 x := '' ;
1414 for i := 0 to CurWardComment.Count-1 do
1415 x := x + CurWardComment.strings[i]+#13#10 ;
1416 i := IndexOfCollSamp(CollSamp);
1417 if i > -1 then with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
1418 for i := 0 to WardComment.Count-1 do
1419 x := x + WardComment.strings[i]+#13#10 ;
1420 pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
1421 OrderMessage(x) ;
1422 end;
1423 GroupBox1.Visible := False;
1424 end;
1425 StatusText('');
1426 Changing := False;
1427 end;
1428 finally //**SubTest
1429 alist.Free;
1430 cList.Free;
1431 aTests.Free;
1432 end;
1433end;
1434
1435constructor TLabTest.Create(const LabTestIEN: string; Responses: TResponses);
1436var
1437 LoadData, OneSamp: TStringList;
1438 DfltCollSamp: Integer;
1439 x: string;
1440 tmpResp: TResponse;
1441begin
1442 LoadData := TStringList.Create;
1443 try
1444 LoadLabTestData(LoadData, LabTestIEN) ;
1445 with LoadData do
1446 begin
1447 QuickOrderResponses := Responses;
1448 TestID := StrToInt(LabTestIEN);
1449 TestName := Piece(ExtractDefault(LoadData, 'Test Name'),U,1);
1450 ItemID := StrToInt(Piece(ExtractDefault(LoadData, 'Item ID'),U,1));
1451 LabSubscript := Piece(ExtractDefault(LoadData, 'Item ID'),U,2);
1452 TestReqComment := ExtractDefault(LoadData, 'ReqCom');
1453 UniqueCollSamp := false;
1454 if Length(ExtractDefault(LoadData, 'Unique CollSamp')) > 0 then UniqueCollSamp := True;
1455 x := ExtractDefault(LoadData, 'Unique CollSamp');
1456 if Length(x) = 0 then x := ExtractDefault(LoadData, 'Lab CollSamp');
1457 if Length(x) = 0 then x := ExtractDefault(LoadData, 'Default CollSamp');
1458 if Length(x) = 0 then x := '-1';
1459 DfltCollSamp := StrToInt(x);
1460 SpecimenList := TStringList.Create;
1461 ExtractItems(SpecimenList, LoadData, 'Specimens');
1462 if LRFSPEC <> '' then SpecimenList.Add(GetOneSpecimen(StrToInt(LRFSPEC)));
1463 UrgencyList := TStringList.Create;
1464 if Length(ExtractDefault(LoadData, 'Default Urgency')) > 0 then { forced urgency }
1465 begin
1466 ForceUrgency := True;
1467 UrgencyList.Add(ExtractDefault(LoadData, 'Default Urgency'));
1468 Urgency := StrToInt(Piece(ExtractDefault(LoadData, 'Default Urgency'), '^', 1));
1469 uDfltUrgency := Urgency;
1470 end
1471 else
1472 begin { list of urgencies }
1473 ExtractItems(UrgencyList, LoadData, 'Urgencies');
1474 if StrToIntDef(LRFURG, 0) > 0 then
1475 Urgency := StrToInt(LRFURG)
1476 else
1477 Urgency := uDfltUrgency;
1478 end;
1479 Comment := TStringList.Create ;
1480 CurWardComment := TStringList.Create;
1481 ExtractText(CurWardComment, LoadData, 'GenWardInstructions');
1482 CollSamp := 0;
1483 CollSampList := TList.Create;
1484 FillCollSampList(LoadData, DfltCollSamp);
1485 with QuickOrderResponses do tmpResp := FindResponseByName('SAMPLE' ,1);
1486 if (LRFSAMP <> '') and (IndexOfCollSamp(StrToInt(LRFSAMP)) < 0) and
1487 (not UniqueCollSamp) and (tmpResp = nil) then
1488 begin
1489 OneSamp := TStringList.Create;
1490 try
1491 FastAssign(GetOneCollSamp(StrToInt(LRFSAMP)), OneSamp);
1492 FillCollSampList(OneSamp, CollSampList.Count);
1493 finally
1494 OneSamp.Free;
1495 end;
1496 end;
1497 if (not UniqueCollSamp) and (CollSampList.Count = 0) then LoadAllSamples;
1498 CollSampCount := CollSampList.Count;
1499 end;
1500 finally
1501 LoadData.Free;
1502 end;
1503 SetCollSampDflts;
1504end;
1505
1506destructor TLabTest.Destroy;
1507var
1508 i: Integer;
1509begin
1510 if CollSampList <> nil then
1511 with CollSampList do for i := 0 to Count - 1 do
1512 with TCollSamp(Items[i]) do
1513 begin
1514 WardComment.Free;
1515 Free;
1516 end;
1517 CollSampList.Free;
1518 SpecimenList.Free;
1519 UrgencyList.Free;
1520 CurWardComment.Free;
1521 Comment.Free;
1522 inherited Destroy;
1523end;
1524
1525function TLabTest.IndexOfCollSamp(CollSampIEN: Integer): Integer;
1526var
1527 i: Integer;
1528begin
1529 Result := -1;
1530 with CollSampList do for i := 0 to Count - 1 do with TCollSamp(Items[i]) do
1531 if CollSampIEN = CollSampID then
1532 begin
1533 Result := i;
1534 break;
1535 end;
1536end;
1537
1538procedure TLabTest.LoadAllSamples;
1539var
1540 LoadList, SpecList: TStringList;
1541 i: Integer;
1542begin
1543 LoadList := TStringList.Create;
1544 SpecList := TStringList.Create;
1545 try
1546 LoadSamples(LoadList) ;
1547 FillCollSampList(LoadList, 0);
1548 ExtractItems(SpecList, LoadList, 'Specimens');
1549 with SpecList do for i := 0 to Count - 1 do
1550 if SpecimenList.IndexOf(Strings[i]) = -1 then SpecimenList.Add(Strings[i]);
1551 finally
1552 LoadList.Free;
1553 SpecList.Free;
1554 end;
1555end;
1556
1557procedure TLabTest.FillCollSampList(LoadData: TStringList; DfltCollSamp: Integer);
1558{1 2 3 4 5 6 7 8 9 10 }
1559{n^IEN^CollSampName^SpecIEN^TubeTop^MinInterval^MaxPerDay^LabCollect^SampReqCommentIEN;name^SpecName}
1560var
1561 i, LastListItem, AnIndex: Integer;
1562 ACollSamp: TCollSamp;
1563 LabCollSamp: Integer;
1564begin
1565 i := -1;
1566 if CollSampList = nil then CollSampList := TList.Create;
1567 LastListItem := CollSampList.Count ;
1568 LabCollSamp := StrToIntDef(ExtractDefault(LoadData, 'Lab CollSamp'), 0);
1569 repeat Inc(i) until (i = LoadData.Count) or (LoadData[i] = '~CollSamp');
1570 Inc(i);
1571 if i < LoadData.Count then repeat
1572 if LoadData[i][1] = 'i' then
1573 begin
1574 ACollSamp := TCollSamp.Create;
1575 with ACollSamp do
1576 begin
1577 AnIndex := StrToIntDef(Copy(Piece(LoadData[i], '^', 1), 2, 999), -1);
1578 CollSampID := StrToInt(Piece(LoadData[i], '^', 2));
1579 CollSampName := Piece(LoadData[i], '^', 3);
1580 SpecimenID := StrToIntDef(Piece(LoadData[i], '^', 4), 0);
1581 SpecimenName := Piece(LoadData[i], '^', 10);
1582 TubeColor := Piece(LoadData[i], '^', 5);
1583 MinInterval := StrToIntDef(Piece(LoadData[i], '^', 6), 0);
1584 MaxPerDay := StrToIntDef(Piece(LoadData[i], '^', 7), 0);
1585 LabCanCollect := AnIndex = LabCollSamp;
1586 SampReqComment := Piece(LoadData[i], '^', 9);
1587 WardComment := TStringList.Create;
1588 if CollSampID = StrToIntDef(LRFSAMP, 0) then
1589 CollSamp := CollSampID
1590 else if AnIndex = DfltCollSamp then
1591 CollSamp := CollSampID;
1592 end; {with}
1593 LastListItem := CollSampList.Add(ACollSamp);
1594 end; {if}
1595 if (LoadData[i][1] = 't') then
1596 TCollSamp(CollSampList.Items[LastListItem]).WardComment.Add(Copy(LoadData[i], 2, 255));
1597 Inc(i);
1598 until (i = LoadData.Count) or (LoadData[i][1] = '~');
1599end;
1600
1601procedure TLabTest.SetCollSampDflts;
1602var
1603 tmpResp: TResponse;
1604begin
1605 Specimen := 0;
1606 Comment.Clear;
1607 CurReqComment := TestReqComment;
1608 if CollSamp = 0 then Exit;
1609 with QuickOrderResponses do tmpResp := FindResponseByName('SPECIMEN' ,1);
1610 if (LRFSPEC <> '') and (tmpResp = nil) then
1611 ChangeSpecimen(LRFSPEC)
1612 else with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
1613 begin
1614 Specimen := SpecimenID;
1615 if SampReqcomment <> '' then CurReqComment := SampReqComment;
1616 end;
1617end;
1618
1619procedure TLabTest.ChangeCollSamp(CollSampIEN: Integer);
1620begin
1621 CollSamp := CollSampIEN;
1622 SetCollSampDflts;
1623end;
1624
1625procedure TLabTest.ChangeSpecimen(const SpecimenIEN: string);
1626begin
1627 Specimen := StrToIntDef(SpecimenIEN,0);
1628end;
1629
1630procedure TLabTest.ChangeComment(const CommentText: string);
1631begin
1632 Comment.Add(CommentText);
1633end;
1634
1635function TLabTest.LabCanCollect: Boolean;
1636var
1637 i: Integer;
1638begin
1639 Result := False;
1640 i := IndexOfCollSamp(CollSamp);
1641 if i > -1 then with TCollSamp(CollSampList.Items[i]) do Result := LabCanCollect;
1642end;
1643
1644procedure TLabTest.LoadCollSamp(AComboBox: TORComboBox);
1645{ loads the collection sample combo box, expects CollSamp to already be set to default }
1646var
1647 i: Integer;
1648 x: string;
1649begin
1650 AComboBox.Clear;
1651 with CollSampList do for i := 0 to Count - 1 do with TCollSamp(Items[i]) do
1652 begin
1653 x := IntToStr(CollSampID) + '^' + CollSampName;
1654 if Length(TubeColor) <> 0 then x := x + ' (' + TubeColor + ')';
1655 AComboBox.Items.Add(x);
1656 if CollSamp = CollSampID then AComboBox.ItemIndex := i;
1657 end;
1658 if ((ALabTest.LabSubscript = 'CH') and (not UserHasLRLABKey)) then
1659 begin
1660 // do not add 'Other' (coded this way for clarity)
1661 end
1662 else
1663 with AComboBox do
1664 begin
1665 Items.Add('0^Other...');
1666 if ItemIndex < 0 then ItemIndex := Items.IndexOf('Other...');
1667 end;
1668end;
1669
1670procedure TLabTest.LoadSpecimen(AComboBox: TORComboBox);
1671{ loads specimen combo box, if SpecimenList is empty, use 'E' xref on 61 ?? }
1672var
1673 i: Integer;
1674 tmpResp: TResponse;
1675begin
1676 AComboBox.Clear;
1677 if ObtainSpecimen then
1678 begin
1679 if SpecimenList.Count = 0 then LoadSpecimens(SpecimenList) ;
1680 FastAssign(SpecimenList, AComboBox.Items);
1681 AComboBox.Items.Add('0^Other...');
1682 with QuickOrderResponses do tmpResp := FindResponseByName('SPECIMEN' ,1);
1683 if (LRFSPEC <> '') and (tmpResp = nil) then
1684 AComboBox.SelectByID(LRFSPEC)
1685 else if Specimen > 0 then
1686 AComboBox.SelectByIEN(Specimen)
1687 else
1688 AComboBox.ItemIndex := AComboBox.Items.IndexOf('Other...');
1689 end
1690 else
1691 begin
1692 i := IndexOfCollSamp(CollSamp);
1693 if i < CollSampList.Count then with TCollSamp(CollSampList.Items[i]) do
1694 begin
1695 AComboBox.Items.Add(IntToStr(SpecimenID) + '^' + SpecimenName);
1696 AComboBox.ItemIndex := 0;
1697 end;
1698 with QuickOrderResponses do tmpResp := FindResponseByName('SPECIMEN' ,1);
1699 if (LRFSPEC <> '') and (tmpResp = nil) then
1700 begin
1701 AComboBox.Items.Add(GetOneSpecimen(StrToInt(LRFSPEC)));
1702 AComboBox.SelectByID(LRFSPEC);
1703 end;
1704 end;
1705 ChangeSpecimen(AComboBox.ItemID);
1706end;
1707
1708procedure TLabTest.LoadUrgency(CollType: string; AComboBox:TORComboBox);
1709var
1710 i, PreviousSelectionIndex: integer;
1711 PreviousSelectionString: String;
1712begin
1713 if UrgencyList.Count < 1 then Exit;
1714 with AComboBox do
1715 begin
1716 PreviousSelectionIndex := -1;
1717 PreviousSelectionString := SelText;
1718 Clear;
1719 for i := 0 to UrgencyList.Count - 1 do
1720 begin
1721 if (CollType = 'LC') and (Piece(UrgencyList[i], U, 3) = '') then
1722 Continue
1723 else
1724 Items.Add(UrgencyList[i]);
1725 if (PreviousSelectionString <> '') and (PreviousSelectionString = Piece(UrgencyList[i], U, 2)) then
1726 PreviousSelectionIndex := i;
1727 end;
1728 if (LRFURG <> '') and (ALabTest.ObtainUrgency) then
1729 SelectByID(LRFURG)
1730 else if PreviousSelectionIndex > -1 then
1731 ItemIndex := PreviousSelectionIndex
1732 else
1733 SelectByIEN(uDfltUrgency);
1734 Urgency := AComboBox.ItemIEN;
1735 end;
1736end;
1737
1738function TLabTest.NameOfCollSamp: string;
1739var
1740 i: Integer;
1741begin
1742 Result := '';
1743 i := IndexOfCollSamp(CollSamp);
1744 if i > -1 then with TCollSamp(CollSampList.Items[i]) do Result := CollSampName;
1745end;
1746
1747function TLabTest.NameOfSpecimen: string;
1748var
1749 i: Integer;
1750begin
1751 Result := '';
1752 if CollSamp > 0 then with TCollSamp(CollSampList[IndexOfCollSamp(CollSamp)]) do
1753 if (Specimen > 0) and (Specimen = SpecimenID) then Result := SpecimenName;
1754 if (Length(Result) = 0) and (Specimen > 0) then with SpecimenList do
1755 for i := 0 to Count - 1 do if Specimen = StrToInt(Piece(Strings[i], '^', 1)) then
1756 begin
1757 Result := Piece(Strings[i], '^', 2);
1758 break;
1759 end;
1760end;
1761
1762function TLabTest.NameOfUrgency: string;
1763var
1764 i: Integer;
1765begin
1766 Result := '';
1767 with UrgencyList do for i := 0 to Count - 1 do
1768 begin
1769 if StrToInt(Piece(Strings[i], '^', 1)) = Urgency
1770 then Result := Piece(Strings[i], '^', 2);
1771 break;
1772 end;
1773end;
1774
1775function TLabTest.ObtainCollSamp: Boolean;
1776begin
1777 Result := (not UniqueCollSamp);
1778end;
1779
1780function TLabTest.ObtainSpecimen: Boolean;
1781var
1782 i: Integer;
1783begin
1784 Result := True;
1785 i := IndexOfCollSamp(CollSamp);
1786 if (i > -1) and (i < CollSampList.Count) then with TCollSamp(CollSampList.Items[i]) do
1787 if SpecimenID > 0 then Result := False;
1788end;
1789
1790function TLabTest.ObtainUrgency: Boolean;
1791begin
1792 Result := not ForceUrgency;
1793end;
1794
1795function TLabTest.ObtainComment: Boolean;
1796begin
1797 Result := Length(CurReqComment) > 0;
1798end;
1799
1800procedure TfrmODBBank.ExtractModifiers(OutList:TStrings; AList:TStrings);
1801begin
1802 ExtractItems(Outlist, AList,'MODIFIERS');
1803end;
1804
1805procedure TfrmODBBank.ExtractReasons(OutList:TStrings; AList:TStrings);
1806begin
1807 ExtractItems(Outlist, AList,'REASONS');
1808end;
1809
1810procedure TfrmODBBank.ExtractUrgencies(OutList:TStrings; AList:TStrings);
1811begin
1812 ExtractItems(Outlist, AList,'URGENCIES');
1813end;
1814
1815procedure TfrmODBBank.ExtractTNSOrders(OutList:TStrings; AList:TStrings);
1816begin
1817 ExtractItems(Outlist, AList,'TNS ORDERS');
1818end;
1819
1820procedure TfrmODBBank.ExtractSurgeries(OutList:TStrings; AList:TStrings);
1821begin
1822 ExtractItems(OutList, AList,'SURGERIES');
1823end;
1824
1825procedure TfrmODBBank.ExtractSpecimens(OutList:TStrings; AList:TStrings);
1826begin
1827 ExtractItems(OutList, AList,'SPECIMENS');
1828end;
1829
1830procedure TfrmODBBank.ExtractTypeScreen(OutList:TStrings; AList:TStrings);
1831begin
1832 ExtractItems(OutList, AList, 'TYPE AND SCREEN');
1833end;
1834
1835procedure TfrmODBBank.ExtractOther(OutList:TStrings; AList:TStrings);
1836begin
1837 ExtractItems(OutList, AList, 'OTHER');
1838end;
1839
1840procedure TfrmODBBank.ExtractSpecimen(OutList:TStrings; AList:TStrings);
1841begin
1842 ExtractItems(OutList, AList, 'SPECIMEN');
1843end;
1844
1845procedure TfrmODBBank.ExtractPatientInfo(OutList:TStrings; AList:TStrings);
1846begin
1847 ExtractItems(OutList, AList, 'INFO');
1848end;
1849
1850procedure TfrmODBBank.ExtractTests(OutList:TStrings; AList:TStrings);
1851begin
1852 ExtractItems(OutList, AList, 'TESTS');
1853end;
1854
1855procedure TfrmODBBank.ExtractMSBOS(OutList:TStrings; AList:TStrings);
1856begin
1857 ExtractItems(OutList, AList, 'MSBOS');
1858end;
1859
1860function TfrmODBBank.SpecimenNeeded(OutList:TStrings; AList:TStrings; CompID:integer): Boolean;
1861var
1862 i:integer;
1863 aborh: boolean;
1864 aSpecimen, aSpecimenUID, aSpecimenDate: string;
1865 aWantDateTime, aExpiredSpecimenDate: TFMDateTime;
1866begin
1867 result := false;
1868 aborh := false;
1869 aSpecimen := '';
1870 aSpecimenUID := '';
1871 OutList.Clear;
1872 ExtractItems(OutList,Alist,'ABORH');
1873 for i := 0 to OutList.Count - 1 do
1874 begin
1875 if Length(OutList[i])>1 then
1876 begin
1877 aborh := true;
1878 end;
1879 end;
1880 if aborh = false then
1881 begin
1882 result := true;
1883 exit;
1884 end;
1885 OutList.Clear;
1886 ExtractSpecimen(OutList, uVBECList);
1887 if OutList.Count > 0 then
1888 begin
1889 aSpecimen := Piece(OutList[0], '^',1);
1890 aSpecimenUID := Piece(OutList[0], '^',2);
1891 end;
1892 OutList.Clear;
1893 ExtractItems(OutList,AList,'SPECIMENS');
1894 aWantDateTime := calWantTime.FMDateTime;
1895 aSpecimenDate := aSpecimen;
1896 aExpiredSpecimenDate := 0;
1897 if Length(aSpecimenDate) > 0 then aExpiredSpecimenDate := StrToFloat(aSpecimenDate);
1898 for i := 0 to OutList.Count - 1 do
1899 begin
1900 if (IntToStr(aLabTest.ItemID) = piece(OutList[i],'^',1)) and (piece(OutList[i],'^',2) = '1') then
1901 begin
1902 if self.EvtID > 0 then
1903 begin
1904 result := true;
1905 exit;
1906 end;
1907 if aSpecimen = '' then
1908 begin
1909 result := true;
1910 exit;
1911 end
1912 else if (Length(calWantTime.Text) > 0) and (aExpiredSpecimenDate < aWantDateTime) then
1913 begin
1914 result := true;
1915 exit;
1916 end;
1917 end;
1918 end;
1919end;
1920
1921procedure TfrmODBBank.Validate(var AnErrMsg: string);
1922
1923 procedure SetError(const x: string);
1924 begin
1925 if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
1926 AnErrMsg := AnErrMsg + x;
1927 end;
1928
1929const
1930 TX_NO_TESTS = 'No Tests or Components selected' ;
1931 TX_TNS_REQUIRED = 'An order for TYPE and SCREEN must be created for this order set' ;
1932
1933begin
1934 inherited;
1935 if uSelectedItems.Count < 1 then
1936 begin
1937 SetError(TX_NO_TESTS);
1938 Exit;
1939 end;
1940 if uGetTns = 1 then
1941 begin
1942 SetError(TX_TNS_REQUIRED);
1943 Exit;
1944 end;
1945 ValidateAdd(AnErrMsg);
1946end;
1947
1948procedure TfrmODBBank.ValidateAdd(var AnErrMsg: string);
1949
1950 procedure SetError(const x: string);
1951 begin
1952 if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
1953 AnErrMsg := AnErrMsg + x;
1954 end;
1955
1956var
1957 aList: TStringList;
1958 i, DaysofFuturePast: integer;
1959 d1, d2: TDateTime;
1960 x,test,aOther: string;
1961const
1962 {Diagnostic Test Errors}
1963 TX_NO_TIME = 'Collection Time is required' ;
1964 TX_NO_TCOLLTYPE = 'Collection Type is required' ;
1965 TX_NO_TESTS = 'A Lab Test or tests must be selected' ;
1966 TX_BAD_TIME = 'Collection times must be chosen from the drop down list or entered as valid' +
1967 ' Fileman date/times (T@1700, T+1@0800, etc.)' ;
1968 TX_PAST_TIME = 'Collection times in the past are not allowed';
1969 TX_NO_DAYS = 'A number of days must be entered for continuous orders';
1970 TX_NO_TIMES = 'A number of times must be entered for continuous orders';
1971 TX_NO_STOP_DATE = 'Could not calculate the stop date for the order. Check "for n Days"';
1972 TX_TOO_MANY_DAYS = 'Maximum number of days allowed is ';
1973 TX_TOO_MANY_TIMES = 'For this frequency, the maximum number of times allowed is: X';
1974 TX_NUMERIC_REQD = 'A numeric value is required for urine volume';
1975 TX_DOSEDRAW_REQD = 'Both DOSE and DRAW times are required for this order';
1976 TX_TDM_REQD = 'A value for LEVEL is required for this order';
1977 TX_NO_COLLSAMPLE = 'A collection sample MUST be specified';
1978 TX_NO_SPECIMEN = 'A specimen MUST be specified';
1979 TX_NO_URGENCY = 'An urgency MUST be specified';
1980 TX_NO_FREQUENCY = 'A collection frequency MUST be specified';
1981 TX_NOT_LAB_COLL_TIME = ' is not a routine lab collection time';
1982 TX_NO_ALPHA = 'For continuous orders, enter a number of days, or an "X" followed by a number of times';
1983 TX_BADTIME_CAP = 'Invalid Immediate Collect Time';
1984 {Component/Type & Screen Errors}
1985 TX_NO_COMPONENTS = 'A Blood Product MUST be selected';
1986 TX_NO_QUANTITY = 'The number of units MUST be specified under "Quantity"';
1987 TX_HIGH_QUANTITY = 'Quantity too high';
1988 TX_NO_DATEMODIFIED= 'A Date/time Wanted MUST be specified';
1989 TX_NO_SURGERY = 'A Surgery MUST be specified for Pre-Op orders'; //only if Pre-op selected
1990 TX_NO_REASON = 'A Reason for Request MUST be entered';
1991 TX_REASON_TOO_LONG= 'Reason for Request MUST be less than 76 characters long';
1992 TX_MODIFIER_TOO_LONG = 'Modifer text MUST be less than 51 characters long';
1993 TX_NO_COMMENT = 'A Comment MUST be entered for this Component';
1994 TX_DUPLICATE = 'Duplicate Test/Component not allowed';
1995 TX_NO_TEST_SELECTED = 'No Test/Component selected';
1996
1997begin
1998 inherited;
1999 AnErrMsg := '';
2000 aList := TStringList.Create;
2001 try
2002 ExtractOther(aList, uVBECList);
2003 if aList.Count > 0 then aOther := aList[0];
2004 aList.Clear;
2005 if uSelectedItems.Count < 1 then
2006 begin
2007 AnErrMsg := TX_NO_TEST_SELECTED;
2008 Exit;
2009 end;
2010 for i := 0 to uSelectedItems.Count - 1 do
2011 begin
2012 x := uSelectedItems[i];
2013 test := lvSelectionList.Items[i].Caption;
2014 if piece(x,'^',1) = '1' then //Diagnostic Test
2015 begin
2016 if uSpecimen = 0 then
2017 if cboCollType.ItemID = '' then
2018 SetError(TX_NO_TCOLLTYPE + ' (' + test + ')')
2019 else if cboCollType.ItemID = 'LC' then
2020 begin
2021 if Length(cboCollTime.Text) = 0 then SetError(TX_NO_TIME + ' (' + test + ')');
2022 with cboCollTime do if (Length(Text) > 0) and (ItemIndex = -1) then
2023 begin
2024 if StrToFMDateTime(Text) < 0 then
2025 SetError(TX_BAD_TIME + ' (' + test + ')')
2026 else if StrToFMDateTime(Text) < FMNow then
2027 SetError(TX_PAST_TIME + ' (' + test + ')')
2028 else if OrderForInpatient then
2029 begin
2030 d1 := FMDateTimeToDateTime(Trunc(StrToFMDateTime(cboColltime.Text)));
2031 d2 := FMDateTimeToDateTime(FMToday);
2032 if EvtDelayLoc > 0 then
2033 DaysofFuturePast := LabCollectFutureDays(EvtDelayLoc,EvtDivision)
2034 else
2035 DaysofFuturePast := LabCollectFutureDays(Encounter.Location);
2036 if DaysofFuturePast = 0 then DaysofFuturePast := 7;
2037 if ((d1 - d2) > DaysofFuturePast) then
2038 SetError('A lab collection cannot be ordered more than '
2039 + IntToStr(DaysofFuturePast) + ' days in advance');
2040 end
2041 else if EvtDelayLoc > 0 then
2042 begin
2043 if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), EvtDelayLoc)) then
2044 SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME + ' (' + test + ')');
2045 end
2046 else if EvtDelayLoc <= 0 then
2047 begin
2048 if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), Encounter.Location)) then
2049 SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME + ' (' + test + ')');
2050 end;
2051 end;
2052 end
2053 else
2054 begin
2055 if cboCollType.ItemID = 'I' then
2056 begin
2057 calCollTime.Text := txtImmedColl.Text;
2058 x := ValidImmCollTime(calCollTime.FMDateTime);
2059 if (Piece(x, U, 1) <> '1') then
2060 SetError(Piece(x, U, 2));
2061 end;
2062
2063 with calColltime do
2064 begin
2065 if FMDateTime = 0 then SetError(TX_BAD_TIME + ' (' + test + ')')
2066 else
2067 begin
2068 // date only was entered
2069 if (FMDateTime - Trunc(FMDateTime) = 0) then
2070 begin
2071 if (Trunc(FMDateTime) < FMToday) then SetError(TX_PAST_TIME + ' (' + test + ')');
2072 end
2073 // date/time was entered
2074 else
2075 begin
2076 if (UpperCase(Text) <> 'NOW') and (FMDateTime < FMNow) then SetError(TX_PAST_TIME + ' (' + test + ')');
2077 end;
2078 end;
2079 end;
2080 end;
2081
2082 with cboUrgency do if ItemIEN <= 0 then SetError(TX_NO_URGENCY + ' (' + test + ')');
2083 end
2084 else //Component
2085 begin
2086 if piece(x,'^',3) ='' then SetError(TX_NO_QUANTITY + ' (' + test + ')')
2087 else
2088 begin
2089 if StrToInt(piece(x,'^',3)) < 1 then SetError(TX_NO_QUANTITY + ' (' + test + ')');
2090 if StrToInt(piece(x,'^',3)) > 100 then SetError(TX_HIGH_QUANTITY + ' (' + test + ')');
2091 end;
2092 if calWantTime.Text = '' then SetError(TX_NO_DATEMODIFIED + ' (' + test + ')');
2093 if (cboReasons.Text = '') and not(uReason = '') then
2094 begin
2095 SetError(TX_NO_REASON + ' (' + test + ').' + ' Previously entered ''Reason for Request'' will be retained.');
2096 cboReasons.Text := uReason; //reset reason back to previous value
2097 end;
2098 if (cboReasons.Text = '') then
2099 begin
2100 SetError(TX_NO_REASON + ' (' + test + ').');
2101 end;
2102 if (memDiagComment.Text = '') and (piece(x,'^',2) = aOther) then SetError(TX_NO_COMMENT + ' (' + test + ')');
2103 if (cboUrgency.Text = 'PRE-OP') and (length(cboSurgery.Text) < 1) then SetError(TX_NO_SURGERY + ' (' + test + ')');
2104 if (length(cboReasons.Text) > 75) then SetError(TX_REASON_TOO_LONG);
2105 if (length(cboModifiers.Text) > 50) then SetError(TX_MODIFIER_TOO_LONG);
2106 end;
2107 end;
2108 finally
2109 aList.Free;
2110 end;
2111end;
2112
2113function TfrmODBBank.ValidAdd: Boolean;
2114const
2115 TX_NO_SAVE = 'This item cannot be added for the following reason(s):' + CRLF + CRLF;
2116 TX_NO_SAVE_CAP = 'Unable to Add item';
2117 TX_SAVE_ERR = 'Unexpected error - it was not possible to Add this item.';
2118var
2119 ErrMsg: string;
2120
2121begin
2122 Result := True;
2123 ValidateAdd(ErrMsg);
2124 if Length(ErrMsg) > 0 then
2125 begin
2126 InfoBox(TX_NO_SAVE + ErrMsg, TX_NO_SAVE_CAP, MB_OK);
2127 Result := False;
2128 Exit;
2129 end;
2130end;
2131
2132function TfrmODBBank.ValidCollTime(UserEntry: string): string;
2133var
2134 i: integer;
2135const
2136 FMDateResponses: array[0..3] of string = ('TODAY','NOW','NOON','MID');
2137begin
2138 Result := '';
2139 UserEntry := UpperCase(UserEntry);
2140 if StrToFMDateTime(UserEntry) < 0 then exit;
2141 if (UserEntry = 'T') or
2142 (UserEntry = 'N') or
2143 (Copy(UserEntry,1,2)='T+') or
2144 (Copy(UserEntry,1,2)='T@') or
2145 (Copy(UserEntry,1,2)='T-') or
2146 (Copy(UserEntry,1,2)='N+') then Result := UserEntry
2147 else
2148 for i := 0 to 3 do if Pos(FMDateResponses[i],UserEntry)>0 then Result := UserEntry ;
2149 if Result = '' then Result := FloatToStr(StrToFMDateTime(UserEntry));
2150end;
2151
2152procedure TfrmODBBank.GetAllCollSamples(AComboBox: TORComboBox);
2153var
2154 OtherSamp: string;
2155begin
2156 with ALabTest, AComboBox do
2157 begin
2158 if ((CollSampList.Count + 1) <= AComboBox.Items.Count) then LoadAllSamples;
2159 OtherSamp := SelectOtherCollSample(Font.Size, CollSampCount, CollSampList);
2160 if OtherSamp = '-1' then exit;
2161 if SelectByID(Piece(OtherSamp, U, 1)) = -1 then
2162 if Items.Count > CollSampCount + 1 then
2163 Items[0] := OtherSamp
2164 else
2165 Items.Insert(0, OtherSamp) ;
2166 SelectByID(Piece(OtherSamp, U, 1));
2167 AComboBox.OnChange(Self);
2168 ActiveControl := cmdAccept;
2169 end;
2170end;
2171
2172procedure TfrmODBBank.GetAllSpecimens(AComboBox: TORComboBox);
2173var
2174 OtherSpec: string;
2175begin
2176 inherited;
2177 if ALabTest <> nil then
2178 with ALabTest, AComboBox do
2179 begin
2180 AComboBox.DroppedDown := False;
2181 OtherSpec := SelectOtherSpecimen(Font.Size, SpecimenList);
2182 if OtherSpec = '-1' then exit;
2183 if SelectByID(Piece(OtherSpec, U, 1)) = -1 then
2184 if Items.Count > SpecListCount + 1 then
2185 Items[0] := OtherSpec
2186 else
2187 Items.Insert(0, OtherSpec) ;
2188 SpecimenList.Add(OtherSpec);
2189 SelectByID(Piece(OtherSpec, U, 1));
2190 AComboBox.OnChange(Self);
2191 end;
2192end;
2193
2194procedure TfrmODBBank.SetupCollTimes(CollType: string);
2195var
2196 tmpImmTime, tmpTime: TFMDateTime;
2197 x, tmpORECALLType, tmpORECALLTime: string;
2198 j: integer;
2199 havetest: boolean;
2200begin
2201 havetest := false;
2202 for j := uSelectedItems.Count - 1 downto 0 do
2203 begin
2204 if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '1') and ((length(calCollTime.Text) > 0) or (length(cboCollTime.Text) > 0)) then
2205 begin
2206 havetest := true;
2207 Break;
2208 end;
2209 end;
2210 //if (havetest = True) and (not(FOrderAction in [ORDER_QUICK, ORDER_EDIT])) then havetest := false;
2211 x := GetLastCollectionTime;
2212 tmpORECALLType := Piece(x, U, 1);
2213 tmpORECALLTime := Piece(x, U, 2);
2214 if CollType = 'SP' then
2215 begin
2216 cboColltime.Visible := False;
2217 txtImmedColl.Visible := False;
2218 pnlCollTimeButton.Visible := False;
2219 pnlCollTimeButton.TabStop := False;
2220 calCollTime.Visible := True;
2221 calCollTime.Enabled := True;
2222 if FLastCollTime <> '' then
2223 begin
2224 calCollTime.Text := ValidCollTime(FLastColltime);
2225 if IsFMDateTime(calCollTime.Text) then
2226 begin
2227 calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
2228 calCollTime.FMDateTime := StrToFMDateTime(FLastCollTime);
2229 end;
2230 end
2231 else if tmpORECALLTime <> '' then
2232 begin
2233 calCollTime.Text := ValidCollTime(tmpORECALLTime);
2234 if IsFMDateTime(calCollTime.Text) then
2235 begin
2236 calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
2237 calCollTime.FMDateTime := StrToFMDateTime(tmpORECALLTime);
2238 end;
2239 end
2240 else if LRFDATE <> '' then
2241 calCollTime.Text := LRFDATE
2242 else if not(FOrderAction in [ORDER_EDIT]) then
2243 calCollTime.Text := 'TODAY'
2244 else if (havetest = false) then
2245 calCollTime.Text := 'TODAY';
2246 if (havetest = false) and (RemoveCollTimeDefault = True) then
2247 begin
2248 calCollTime.Text := '';
2249 calCollTime.FMDateTime := 0;
2250 end;
2251 end
2252 else if CollType = 'WC' then
2253 begin
2254 cboColltime.Visible := False;
2255 txtImmedColl.Visible := False;
2256 pnlCollTimeButton.Visible := False;
2257 pnlCollTimeButton.TabStop := False;
2258 calCollTime.Visible := True;
2259 calColltime.Enabled := True;
2260 if FLastCollTime <> '' then
2261 begin
2262 calCollTime.Text := ValidColltime(FLastColltime);
2263 if IsFMDateTime(calCollTime.Text) then
2264 begin
2265 calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
2266 calCollTime.FMDateTime := StrToFMDateTime(FLastCollTime);
2267 end;
2268 end
2269 else if tmpORECALLTime <> '' then
2270 begin
2271 calCollTime.Text := ValidColltime(tmpORECALLTime);
2272 if IsFMDateTime(calCollTime.Text) then
2273 begin
2274 calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
2275 calCollTime.FMDateTime := StrToFMDateTime(tmpORECALLTime);
2276 end;
2277 end
2278 else if LRFDATE <> '' then
2279 calCollTime.Text := LRFDATE
2280 else if not(FOrderAction in [ORDER_EDIT]) then
2281 calCollTime.Text := 'NOW';
2282 if (havetest = false) and (RemoveCollTimeDefault = True) then
2283 begin
2284 calCollTime.Text := '';
2285 calCollTime.FMDateTime := 0;
2286 end;
2287 end
2288 else if CollType = 'LC' then
2289 begin
2290 cboColltime.Visible := True;
2291 calCollTime.Visible := False;
2292 calColltime.Enabled := False;
2293 txtImmedColl.Visible := False;
2294 pnlCollTimeButton.Visible := False;
2295 pnlCollTimeButton.TabStop := False;
2296 with CtrlInits do SetControl(cboCollTime, 'Lab Collection Times');
2297 if Pos(U, FLastLabCollTime) > 0 then
2298 cboColltime.SelectByID(Piece(FLastLabCollTime, U, 1))
2299 else if FLastLabCollTime <> '' then
2300 cboCollTime.Text := FLastLabCollTime
2301 else if (tmpORECALLTime <> '') and (tmpORECALLType = 'LC') then
2302 cboCollTime.Text := MakeRelativeDateTime(StrToFMDateTime(tmpORECALLTime))
2303 else if LRFDATE <> '' then
2304 cboCollTime.Text := LRFDATE
2305 else
2306 cboCollTime.ItemIndex := 0;
2307 if (havetest = false) and (RemoveCollTimeDefault = True) then
2308 begin
2309 cboCollTime.Text := '';
2310 end;
2311 end
2312 else if CollType = 'I' then
2313 begin
2314 cboColltime.Visible := False;
2315 calCollTime.Visible := False;
2316 calCollTime.Enabled := False;
2317 txtImmedColl.Visible := True;
2318 pnlCollTimeButton.Visible := True;
2319 pnlCollTimeButton.TabStop := True;
2320 tmpImmTime := GetDefaultImmCollTime;
2321 tmpTime := 0;
2322 if (FLastColltime <> '') then
2323 tmpTime := StrToFMDateTime(FLastColltime)
2324 else if (tmpORECALLTime <> '') then
2325 tmpTime := StrToFMDateTime(tmpORECALLTime)
2326 else if LRFDATE <> '' then
2327 tmpTime := StrToFMDateTime(LRFDATE);
2328 if tmpTime > tmpImmTime then
2329 begin
2330 calCollTime.FMDateTime := tmpTime;
2331 txtImmedColl.Text := FormatFMDateTime('mmm dd,yy@hh:nn', tmpTime);
2332 end
2333 else
2334 begin
2335 calCollTime.FMDateTime := GetDefaultImmCollTime;
2336 txtImmedColl.Text := FormatFMDateTime('mmm dd,yy@hh:nn', calCollTime.FMDateTime);
2337 end;
2338 if (havetest = false) and (RemoveCollTimeDefault = True) then
2339 begin
2340 calCollTime.Text := '';
2341 calCollTime.FMDateTime := 0;
2342 txtImmedColl.Text := '';
2343 end;
2344 end;
2345end;
2346
2347procedure TfrmODBBank.LoadCollType(AComboBox:TORComboBox);
2348var
2349 i: integer;
2350begin
2351 with CtrlInits, cboCollType do
2352 begin
2353 SetControl(cboCollType, 'Collection Types');
2354 if not ALabTest.LabCanCollect then
2355 begin
2356 i := SelectByID('LC');
2357 if i > -1 then Items.Delete(i);
2358 i := SelectByID('I');
2359 if i > -1 then Items.Delete(i);
2360 end ;
2361 if LRFZX <> '' then
2362 begin
2363 if (LRFZX = 'LC') or (LRFZX = 'I') then
2364 begin
2365 if ALabTest.LabCanCollect then
2366 cboCollType.SelectByID(LRFZX)
2367 else
2368 cboCollType.SelectByID('WC');
2369 end
2370 else
2371 cboCollType.SelectByID(LRFZX);
2372 end
2373 else if FLastCollType <> '' then
2374 begin
2375 if (FLastCollType = 'LC') or (FLastCollType = 'I') then
2376 begin
2377 if ALabTest.LabCanCollect then
2378 cboCollType.SelectByID(FLastCollType)
2379 else
2380 cboCollType.SelectByID('WC');
2381 end
2382 else
2383 cboCollType.SelectByID(FLastCollType);
2384 end
2385 else if uDfltCollType <> '' then
2386 begin
2387 if (uDfltCollType = 'LC') or (uDfltCollType = 'I') then
2388 begin
2389 if ALabTest.LabCanCollect then
2390 cboCollType.SelectByID(uDfltCollType)
2391 else
2392 cboCollType.SelectByID('WC');
2393 end
2394 else
2395 cboCollType.SelectByID(uDfltCollType);
2396 end
2397 else if OrderForInpatient then
2398 begin
2399 if ALabTest.LabCanCollect then
2400 cboCollType.SelectByID('LC')
2401 else
2402 SelectByID('WC');
2403 end
2404 else
2405 cboCollType.SelectByID('SP');
2406 end;
2407 SetupCollTimes(cboCollType.ItemID);
2408end;
2409
2410procedure TfrmODBBank.ReadServerVariables;
2411begin
2412 LRFZX := KeyVariable['LRFZX'];
2413 LRFSAMP := KeyVariable['LRFSAMP'];
2414 LRFSPEC := KeyVariable['LRFSPEC'];
2415 LRFDATE := KeyVariable['LRFDATE'];
2416 LRFURG := KeyVariable['LRFURG'];
2417 LRFSCH := KeyVariable['LRFSCH'];
2418end;
2419
2420procedure TfrmODBBank.cboQuickClick(Sender: TObject);
2421begin
2422 inherited;
2423 SetOnQuickOrder;
2424end;
2425
2426procedure TfrmODBBank.cboReasonsChange(Sender: TObject);
2427begin
2428 inherited;
2429 cboReasons.Text := StringReplace(cboReasons.Text,CRLF,' ',[rfReplaceAll]);
2430 if (length(cboReasons.Text) > 75) then
2431 begin
2432 ShowMsg('REASON FOR REQUEST cannot be longer than 75 characters');
2433 cboReasons.Text := Copy(cboReasons.Text,0,75);
2434 Exit;
2435 end;
2436 if Length(cboReasons.Text) > 0 then Responses.Update('REASON', 1, cboReasons.Text, cboReasons.Text);
2437 memOrder.Text := Responses.OrderText;
2438end;
2439
2440procedure TfrmODBBank.cboReasonsEnter(Sender: TObject);
2441begin
2442 inherited;
2443 if Length(cboReasons.Text) > 0 then
2444 uReason := cboReasons.Text;
2445end;
2446
2447procedure TfrmODBBank.cboReasonsExit(Sender: TObject);
2448begin
2449 inherited;
2450 if Length(cboReasons.Text) > 0 then
2451 uReason := cboReasons.Text;
2452end;
2453
2454procedure TfrmODBBank.cboAvailTestSelect(Sender: TObject);
2455var
2456 i: integer;
2457 ListItem: TListItem;
2458 aCollTime,aTypeScreen,aStr,aModifier,aSpecimen,aSpecimenUID,aSpecimenReq,aTestYes,x,aName,aTNSString, aUrgText: string;
2459 aList: TStringList;
2460 curAdd,aTNS: Integer;
2461 sub,sub1: string;
2462 aChanging: Boolean;
2463begin
2464 if cboAvailTest.ItemID = '' then Exit;
2465 aList := TStringList.Create;
2466 aChanging := changing;
2467 try
2468 ALabTest := nil;
2469 aTypeScreen := '';
2470 aSpecimen := '';
2471 aSpecimenUID := '';
2472 aSpecimenReq := '';
2473 aTestYes := '1';
2474 aModifier := '';
2475 changing := true;
2476 tQuantity.Text := '';
2477 changing := aChanging;
2478 sub1 := '';
2479 cboModifiers.ItemIndex := -1;
2480 DisableComponentControls;
2481 EnableDiagTestControls;
2482 LRORDERMODE := TORDER_MODE_DIAG;
2483 ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses);
2484 sub := GetSubtype(ALabTest.TestName);
2485 {if not(FOrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK]) then
2486 DetermineCollectionDefaults(Responses); }
2487 DetermineCollectionDefaults(Responses);
2488 with cboAvailTest do
2489 begin
2490 if (Length(ItemID) = 0) or (ItemID = '0') then
2491 begin
2492 changing := aChanging;
2493 Exit;
2494 end;
2495 FLastLabID := ItemID ;
2496 FLastItemID := ItemID;
2497 for i := 0 to uSelectedItems.Count - 1 do
2498 if ItemID = piece(uSelectedItems[i],'^',2) then
2499 begin
2500 ItemIndex := -1;
2501 lvSelectionList.Items[i].Selected := true;
2502 lvSelectionListClick(self);
2503 changing := aChanging;
2504 Exit;
2505 end;
2506 ExtractTypeScreen(aList, uVBECList);
2507 if aList.Count > 0 then aTypeScreen := aList[0];
2508 aList.Clear;
2509 aTNSString := '';
2510 if (Changing = false) and (StrToInt(aTypeScreen) = cboAvailTest.ItemID) and (uTNSOrders.Count > 0) then
2511 begin
2512 for i := 0 to uTNSOrders.Count - 1 do
2513 aTNSString := aTNSString + CRLF + uTNSOrders[i];
2514 with Application do
2515 begin
2516 NormalizeTopMosts;
2517 aTNS :=
2518 MessageBox(PChar(aTNSString + CRLF + CRLF +
2519 'Do you wish to cancel this request for Type & Screen?'),
2520 PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'),
2521 MB_YESNO);
2522 RestoreTopMosts;
2523 if aTNS = 6 then
2524 begin
2525 cboAvailTest.ItemIndex := -1;
2526 exit;
2527 end;
2528 end;
2529 end;
2530 if sub = 't' then with ALabTest do //DIAGNOSTIC TEST
2531 begin
2532 if ObtainCollSamp then
2533 begin
2534 //For BloodBank orders, this condition should never occur
2535 end
2536 else
2537 begin
2538 with ALabTest do
2539 with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
2540 begin
2541 x := '' ;
2542 for i := 0 to WardComment.Count-1 do
2543 x := x + WardComment.strings[i]+#13#10 ;
2544 pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
2545 OrderMessage(x) ;
2546 end ;
2547 end;
2548 end;
2549 end;
2550 if LRORDERMODE = TORDER_MODE_DIAG then
2551 begin
2552 if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
2553 if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
2554 else if changing = false then
2555 begin
2556 for i := 0 to cboUrgency.Items.Count - 1 do
2557 begin
2558 aUrgText := cboUrgency.Items[i];
2559 if aUrgText = '9^ROUTINE' then // Find urgency default of ROUTINE
2560 begin
2561 cboUrgency.ItemIndex := i;
2562 break;
2563 end;
2564 end;
2565 Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
2566 end;
2567 if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
2568 if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
2569 with cboCollTime do
2570
2571 if cboCollType.ItemID = 'LC' then
2572 begin
2573 with cboCollTime do
2574 if Length(ItemID) > 0 then
2575 begin
2576 Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
2577 FLastLabCollTime := ItemID + U + Text;
2578 end
2579 else if Length(Text) > 0 then
2580 begin
2581 Responses.Update('START', 1, ValidCollTime(Text), Text) ;
2582 FLastLabCollTime := ValidCollTime(Text);
2583 end;
2584 end
2585 else
2586 begin
2587 with calCollTime do
2588 if FMDateTime > 0 then
2589 begin
2590 Responses.Update('START', 1, ValidCollTime(Text), Text);
2591 FLastColltime := ValidCollTime(Text);
2592 end
2593 else
2594 begin
2595 Responses.Update('START', 1, '', '') ;
2596 FLastCollTime := '';
2597 end;
2598 end;
2599 if Length(cboCollType.Text) > 0 then Responses.Update('COLLECT',1,cboCollType.ItemID,cboCollType.ItemID);
2600 end;
2601 uTestSelected := true;
2602 with lvSelectionList do
2603 begin
2604 ListItem := Items.Add;
2605 ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2);
2606 ListItem.SubItems.Add('');
2607 ListItem.SubItems.Add('');
2608 ListItem.SubItems.Add('');
2609 ListItem.SubItems.Add(piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1));
2610 if piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1) = aTypeScreen then
2611 begin
2612 lblTNS.Caption := '';
2613 lblTNS.Visible := false;
2614 memMessage.Text := '';
2615 pnlMessage.Visible := false;
2616 uGetTnS := 0;
2617 pnlDiagnosticTests.Caption := 'Diagnostic Tests';
2618 end;
2619 end;
2620 aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimenReq + '^' + aSpecimen + '^' + aSpecimenUID + '^' + IntToStr(aLabTest.ItemID);
2621 uSelectedItems.Add(aStr);
2622 CurAdd := 1;
2623 for i := 0 to uSelectedItems.Count - 1 do
2624 begin
2625 aName := lvSelectionList.Items[i].Caption;
2626 x := uSelectedItems[i];
2627 if piece(x,'^',1) = '1' then //Diagnostic Test related fields
2628 begin
2629 if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
2630 end;
2631 Inc(CurAdd);
2632 end;
2633 memOrder.Text := Responses.OrderText;
2634 finally
2635 aList.Free;
2636 end;
2637 if lvSelectionList.Items.Count > 0 then
2638 begin
2639 pnlSelectedTests.Visible := True;
2640 cmdAccept.Visible := True;
2641 memOrder.Visible := True;
2642 GroupBox1.Visible := False;
2643 end;
2644end;
2645
2646procedure TfrmODBBank.cboAvailCompSelect(Sender: TObject);
2647 var
2648 aList,aTests: TStringList;
2649 i,j,k,getTest,TestAdded: integer;
2650 text : string;
2651 aMSBOS,aMSBOSContinue,curAdd,AnInstance: integer;
2652 sub,sub1: string;
2653 ListItem: TListItem;
2654 aTypeScreen,aSpecimen,aSpecimenUID,aSpecimenReq,aTestYes,aStr,aMsg,aModifier,x,x1,aReason,aSurgery,aCollTime,aCollSave,aName,aUrgText: String;
2655 aChanging: Boolean;
2656begin
2657 if cboAvailComp.ItemID = '' then Exit;
2658 aList := TStringList.Create;
2659 aTests := TStringList.Create;
2660 sub1 := '';
2661 aChanging := changing;
2662 try
2663 DisableDiagTestControls;
2664 EnableComponentControls;
2665 if not(changing = true) then
2666 begin
2667 changing := true;
2668 tQuantity.Text := '';
2669 cboModifiers.ItemIndex := -1;
2670 changing := aChanging;
2671 end;
2672 LRORDERMODE := TORDER_MODE_COMP;
2673 with cboAvailComp do
2674 begin
2675 if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
2676 FLastLabID := ItemID ;
2677 FLastItemID := ItemID;
2678 for i := 0 to uSelectedItems.Count - 1 do
2679 if ItemID = piece(uSelectedItems[i],'^',2) then
2680 begin
2681 ItemIndex := -1;
2682 lvSelectionList.Items[i].Selected := true;
2683 lvSelectionListClick(self);
2684 Exit;
2685 end;
2686 ALabTest := TLabTest.Create(ItemID, Responses);
2687 sub := GetSubtype(ALabTest.TestName);
2688 changing := aChanging;
2689 StatusText('');
2690 end;
2691 aList.Clear;
2692 TestAdded := 0;
2693 getTest := 0;
2694 ExtractTests(aList, uVBECList); //Get Lab Results associated with ordered components
2695 for j := 0 to aList.Count - 1 do
2696 begin
2697 if StrToInt(piece(aList[j],'^',1)) = aLabTest.ItemID then
2698 begin
2699 if uTestsForResults.Count < 1 then getTest := 1;
2700 for k := 0 to uTestsForResults.Count - 1 do
2701 begin
2702 if piece(uTestsForResults[k],'^',1) = piece(aList[j],'^',3) then
2703 begin
2704 getTest := 0;
2705 break;
2706 end
2707 else getTest := 1;
2708 end;
2709 if getTest = 1 then
2710 begin
2711 uTestsForResults.Add(piece(aList[j],'^',3));
2712 TestAdded := 1;
2713 end;
2714 end;
2715 end;
2716 if TestAdded = 1 then
2717 begin
2718 aTests.Clear;
2719 GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults);
2720 if aTests.Count > 0 then
2721 begin
2722 edtResults.Clear;
2723 QuickCopy(ATests,edtResults);
2724 TabResults.Caption := 'Lab Results Available';
2725 uRaw.Clear;
2726 GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults);
2727 end;
2728 end;
2729 CurAdd := 1;
2730 if uRaw.Count > 0 then
2731 for j := 0 to uRaw.Count - 1 do
2732 begin
2733 if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
2734 Inc(CurAdd);
2735 end;
2736 aTypeScreen := '';
2737 aSpecimen := '';
2738 aSpecimenUID := '';
2739 aSpecimenReq := '';
2740 aTestYes := '0';
2741 aReason := '';
2742 aSurgery := '';
2743 aCollTime := '';
2744 aList.Clear;
2745 ExtractTypeScreen(aList, uVBECList);
2746 if aList.Count > 0 then aTypeScreen := aList[0];
2747 aList.Clear;
2748 ExtractSpecimen(aList, uVBECList);
2749 if aList.Count > 0 then
2750 begin
2751 aSpecimen := piece(aList[0], '^', 1);
2752 aSpecimenUID := piece(aList[0], '^', 2);
2753 end;
2754 if (cboSurgery.ItemID = '') and (length(cboSurgery.Text) > 0) then
2755 begin
2756 for i := 0 to cboSurgery.Items.Count - 1 do
2757 if uppercase(cboSurgery.Text) = uppercase(piece(cboSurgery.Items[i],'^',2)) then
2758 begin
2759 cboSurgery.ItemIndex := i;
2760 Break;
2761 end;
2762 end;
2763 if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
2764 if length(cboReasons.ItemID) > 0 then aReason := cboReasons.Items[cboReasons.ItemIndex];
2765 if length(cboSurgery.ItemID) > 0 then aSurgery := cboSurgery.Items[cboSurgery.ItemIndex];
2766 if (Length(cboSurgery.ItemID) > 0) and (length(tQuantity.Text) > 0) and (strToInt(tQuantity.Text) > 0) then
2767 begin
2768 uChangingMSBOS := true;
2769 cboSurgeryChange(self);
2770 uChangingMSBOS := false;
2771 if cboAvailComp.ItemIndex = -1 then Exit;
2772 aList.Clear;
2773 ExtractMSBOS(aList, uVBECList); //Get maximum units for selected Surgey
2774 for i := 0 to aList.Count - 1 do
2775 begin
2776 if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
2777 and (uppercase((piece(aList[i],'^',3))) = uppercase(cboSurgery.Text)) then
2778 begin
2779 aMSBOS := StrToInt(piece(aList[i],'^',4));
2780 if (aMSBOS > 0) and (Length(tQuantity.Text) > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
2781 begin
2782 with Application do
2783 begin
2784 NormalizeTopMosts;
2785 aMSBOSContinue :=
2786 MessageBox(PChar('The number of units ordered (' + tQuantity.Text +
2787 ') for ' + aLabTest.TestName + ' Exceeds the maximum number recommended ('
2788 + IntToStr(aMSBOS) +
2789 ') for the ' + cboSurgery.text +
2790 ' surgical procedure.' + CRLF +
2791 'If you need to order more than the maximum number of units, please enter a justification in the Comment box.'
2792 + CRLF + CRLF + 'Edit the Blood component Quantity?'),
2793 PChar('Maximum Number of Units Exceeded'),
2794 MB_YESNO);
2795 RestoreTopMosts;
2796 end;
2797 if aMSBOSContinue = 6 then
2798 begin
2799 ShowMsg(cboAvailComp.Text + ' has NOT been added to this request.');
2800 exit;
2801 end;
2802 end;
2803 end;
2804 end;
2805 end;
2806 if (uTNSOrders.Count < 1) and (SpecimenNeeded(aList, uVBECList, aLabTest.ItemID)) then //check to see if type and screen is needed CQ 17349
2807 begin
2808 uGetTnS := 1;
2809 for i := 0 to lvSelectionList.Items.Count - 1 do
2810 begin
2811 if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
2812 begin
2813 uGetTnS := 0;
2814 if length(cboUrgency.ItemID) > 0 then uDfltUrgency := cboUrgency.ItemID;
2815 lblTNS.Caption := '';
2816 lblTNS.Visible := false;
2817 memMessage.Text := '';
2818 pnlMessage.Visible := false;
2819 pnlDiagnosticTests.Caption := 'Diagnostic Tests';
2820 break;
2821 end;
2822 end;
2823 end;
2824 aList.Clear;
2825 ExtractSpecimens(aList, uVBECList); //Get specimen values to pass back to Server
2826 for i := 0 to aList.Count - 1 do
2827 begin
2828 if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) then
2829 begin
2830 aSpecimenReq := piece(aList[i],'^',2);
2831 if (SpecimenNeeded(aList, uVBECList, aLabTest.ItemID)) then
2832 aSpecimenUID := '';
2833 break;
2834 end;
2835 end;
2836 uComponentSelected := true;
2837 with lvSelectionList do
2838 begin
2839 ListItem := Items.Add;
2840 ListItem.Caption := piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2);
2841 ListItem.SubItems.Add(tQuantity.Text);
2842 if length(cboModifiers.ItemID) > 0 then
2843 begin
2844 ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
2845 ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
2846 end
2847 else
2848 begin
2849 ListItem.SubItems.Add('');
2850 ListItem.SubItems.Add('');
2851 end;
2852 ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
2853 end;
2854 aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimenReq + '^' + aSpecimen + '^' + aSpecimenUID + '^' + IntToStr(aLabTest.ItemID);
2855 uSelectedItems.Add(aStr);
2856 CurAdd := 1;
2857 for i := 0 to uSelectedItems.Count - 1 do
2858 begin
2859 aName := lvSelectionList.Items[i].Caption;
2860 x := uSelectedItems[i];
2861 if piece(x,'^',1) = '1' then //Diagnostic Test related fields
2862 begin
2863 if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
2864 end
2865 else
2866 begin
2867 if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
2868 if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
2869 if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), piece(x,'^',4));
2870 if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
2871 if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
2872 if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
2873 if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
2874 else
2875 begin
2876 cboUrgency.ItemIndex := 2;
2877 for j := 0 to cboUrgency.Items.Count - 1 do
2878 begin
2879 aUrgText := cboUrgency.Items[j];
2880 if aUrgText = '9^ROUTINE' then // Find urgency default of ROUTINE
2881 begin
2882 cboUrgency.ItemIndex := i;
2883 break;
2884 end;
2885 end;
2886 Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
2887 end;
2888 end;
2889 Inc(CurAdd);
2890 end;
2891 memOrder.Text := Responses.OrderText;
2892 finally
2893 alist.Free;
2894 aTests.Free;
2895 end;
2896 aMsg := '';
2897 LRORDERMODE := TORDER_MODE_INFO;
2898 if uGetTnS = 1 then
2899 begin
2900 lblTNS.Caption := 'TYPE + SCREEN must be added to order';
2901 lblTNS.Visible := true;
2902 memMessage.Text := 'TYPE + SCREEN must be added to order';
2903 pnlMessage.Visible := true;
2904 pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
2905 end
2906 else pnlDiagnosticTests.Caption := 'Diagnostic Tests';
2907 if lvSelectionList.Items.Count > 0 then
2908 begin
2909 pnlSelectedTests.Visible := True;
2910 cmdAccept.Visible := True;
2911 memOrder.Visible := True;
2912 GroupBox1.Visible := False;
2913 end;
2914 if tQuantity.CanFocus = true then tQuantity.SetFocus;
2915end;
2916
2917procedure TfrmODBBank.DisableCommentPanels;
2918begin
2919 lblReqComment.Visible := False;
2920end;
2921
2922procedure TfrmODBBank.DisableComponentControls;
2923var
2924 j: integer;
2925begin
2926 lblQuantity.Enabled := false;
2927 tQuantity.Enabled := false;
2928 lblModifiers.Enabled := false;
2929 cboModifiers.Enabled := false;
2930 lblQuantity.Caption := 'Quantity';
2931 lblWanted.Caption := 'Date/Time Wanted';
2932 lblReason.Caption := 'Reason for Request';
2933 cboAvailComp.ItemIndex := -1;
2934 for j := uSelectedItems.Count - 1 downto 0 do
2935 begin
2936 if piece(uSelectedItems[j],'^',1) = '0' then
2937 begin
2938 lblReason.Caption := 'Reason for Request*';
2939 lblWanted.Caption := 'Date/Time Wanted*';
2940 Break;
2941 end;
2942 end;
2943end;
2944
2945procedure TfrmODBBank.EnableComponentControls;
2946begin
2947 lblQuantity.Enabled := true;
2948 tQuantity.Enabled := true;
2949 lblModifiers.Enabled := true;
2950 cboModifiers.Enabled := true;
2951 lblQuantity.Caption := 'Quantity*';
2952 lblWanted.Caption := 'Date/Time Wanted*';
2953 lblReason.Caption := 'Reason for Request*';
2954 if not(changing) then
2955 if not(uSelUrgency = 'PRE-OP') then
2956 if uSelUrgency = '' then
2957 if lvSelectionList.Items.Count < 1 then
2958 cboUrgency.SelectByID(IntToStr(uDfltUrgency));
2959 if cboUrgency.Text = 'PRE-OP' then
2960 begin
2961 lblSurgery.Enabled := true;
2962 cboSurgery.Enabled := true;
2963 lblSurgery.Caption := 'Surgery*';
2964 end
2965 else
2966 begin
2967 if Length(cboSurgery.Text) > 0 then
2968 begin
2969 lblSurgery.Enabled := true;
2970 cboSurgery.Enabled := true;
2971 lblSurgery.Caption := 'Surgery*';
2972 end
2973 else
2974 begin
2975 lblSurgery.Enabled := false;
2976 cboSurgery.Enabled := false;
2977 lblSurgery.Caption := 'Surgery';
2978 cboSurgery.ItemIndex := -1;
2979 Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
2980 end;
2981 end;
2982
2983 lblDiagComment.Enabled := true;
2984end;
2985
2986procedure TfrmODBBank.DisableDiagTestControls;
2987var
2988 i,j: integer;
2989 diagflg: boolean;
2990begin
2991 diagflg := false;
2992 for i := 0 to uSelectedItems.Count - 1 do
2993 begin
2994 if (piece(uSelectedItems[i],'^',1) = '1') then
2995 begin
2996 diagflg := true;
2997 Break;
2998 end;
2999 end;
3000 if diagflg = false then
3001 begin
3002 lblCollTime.Enabled := false;
3003 calCollTime.Enabled := false;
3004 cboCollTime.Enabled := false;
3005 lblCollType.Enabled := false;
3006 cboCollType.Enabled := false;
3007 cmdImmedColl.Enabled := false;
3008 end;
3009 lblCollTime.Caption := 'Collection Date/Time';
3010 lblCollType.Caption := 'Collection Type';
3011 cboAvailTest.ItemIndex := -1;
3012 for j := uSelectedItems.Count - 1 downto 0 do
3013 begin
3014 if piece(uSelectedItems[j],'^',1) = '1' then
3015 begin
3016 lblCollTime.Caption := 'Collection Date/Time*';
3017 lblCollType.Caption := 'Collection Type*';
3018 Break;
3019 end;
3020 end;
3021end;
3022
3023procedure TfrmODBBank.EnableDiagTestControls;
3024begin
3025 lblCollTime.Enabled := true;
3026 calCollTime.Enabled := true;
3027 cboCollTime.Enabled := true;
3028 lblCollType.Enabled := true;
3029 cboCollType.Enabled := true;
3030 cmdImmedColl.Enabled := true;
3031 lblCollTime.Caption := 'Collection Date/Time*';
3032 lblCollType.Caption := 'Collection Type*';
3033 if not(changing) then
3034 if not(uSelUrgency = 'PRE-OP') then
3035 if uSelUrgency = '' then
3036 if lvSelectionList.Items.Count < 1 then
3037 cboUrgency.SelectByID(IntToStr(uDfltUrgency));
3038end;
3039
3040procedure TfrmODBBank.LoadRequiredComment(CmtType: integer);
3041begin
3042 DisableCommentPanels;
3043 lblReqComment.Visible := True ;
3044end;
3045
3046procedure TfrmODBBank.DetermineCollectionDefaults(Responses: TResponses);
3047var
3048 RespCollect, RespStart: TResponse;
3049begin
3050 if ALabTest = nil then exit;
3051 calCollTime.Enabled := True;
3052 lblCollTime.Enabled := True;
3053 cboColltime.Enabled := True;
3054 with Responses, ALabTest do
3055 begin
3056 RespCollect := FindResponseByName('COLLECT',1);
3057 RespStart := FindResponseByName('START' ,1);
3058 if (RespCollect <> nil) then with RespCollect do
3059 begin
3060 if IValue = 'LC' then
3061 begin
3062 if not LabCanCollect then
3063 begin
3064 cboCollType.SelectByID('WC');
3065 SetupCollTimes('WC');
3066 end
3067 else // if LabCanCollect
3068 begin
3069 cboCollType.SelectByID('LC');
3070 SetupCollTimes('LC');
3071 CtrlInits.SetControl(cboCollTime, 'Lab Collection Times') ;
3072 if RespStart <> nil then
3073 begin
3074 cboCollTime.SelectByID('L' + RespStart.IValue);
3075 if cboCollTime.ItemIndex < 0 then
3076 cboCollTime.Text := RespStart.IValue;
3077 end;
3078 end;
3079 end
3080 else // if IValue <> 'LC'
3081 begin
3082 cboCollType.SelectByID(IValue) ;
3083 SetupCollTimes(IValue);
3084 if RespStart <> nil then
3085 begin
3086 if ContainsAlpha(RespStart.IValue) then
3087 calColltime.Text := RespStart.IValue
3088 else
3089 calColltime.FMDateTime := StrToFMDateTime(RespStart.IValue);
3090 end;
3091 end ;
3092 if IValue = 'I' then
3093 if not LabCanCollect then
3094 begin
3095 cboCollType.SelectByID('WC');
3096 SetupCollTimes('WC');
3097 end
3098 else
3099 begin
3100 calCollTime.Enabled := False;
3101 cboCollType.SelectByID('I');
3102 SetupCollTimes('I');
3103 //cboCollTypeClick(self);
3104 //txtImmedColl.Enabled := True;
3105 if RespStart <> nil then
3106 begin
3107 txtImmedColl.Text := RespStart.EValue;
3108 end;
3109 end;
3110 end
3111 else // if (RespCollect = nil)
3112 LoadCollType(cbocollType);
3113 end;
3114end;
3115
3116procedure TfrmODBBank.cboAvailTestEnter(Sender: TObject);
3117var
3118 j: integer;
3119begin
3120 inherited;
3121 if Length(cboAvailTest.Text) > 0 then Exit;
3122 for j := uSelectedItems.Count - 1 downto 0 do
3123 begin
3124 if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '1') then
3125 begin
3126 lvSelectionList.Items[j].Selected := true;
3127 lvSelectionListClick(self);
3128 Break;
3129 end;
3130 end;
3131end;
3132
3133procedure TfrmODBBank.cboAvailTestExit(Sender: TObject);
3134begin
3135 inherited;
3136 if (Length(cboAvailTest.Text)>0) and (Length(cboAvailTest.ItemID) = 0) or (cboAvailTest.ItemID = '0') then
3137 begin
3138 ShowMsg('Invalid Test Selection. Please select a valid Test.');
3139 cboAvailTestSelect(cboAvailTest);
3140 cboAvailTest.SetFocus;
3141 Exit;
3142 end;
3143 if cboAvailTest.ItemID = FLastLabID then Exit;
3144 if not (Length(cboAvailTest.ItemID) = 0) then cboAvailTestSelect(cboAvailTest);
3145end;
3146
3147procedure TfrmODBBank.cboAvailCompEnter(Sender: TObject);
3148var
3149 j: integer;
3150begin
3151 inherited;
3152 if Length(cboAvailComp.Text) > 0 then Exit;
3153 for j := uSelectedItems.Count - 1 downto 0 do
3154 begin
3155 if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '0') then
3156 begin
3157 lvSelectionList.Items[j].Selected := true;
3158 lvSelectionListClick(self);
3159 Break;
3160 end;
3161 end;
3162end;
3163
3164procedure TfrmODBBank.cboAvailCompExit(Sender: TObject);
3165begin
3166 inherited;
3167 if (Length(cboAvailComp.Text)>0) and (Length(cboAvailComp.ItemID) = 0) or (cboAvailComp.ItemID = '0') then
3168 begin
3169 ShowMsg('Invalid Component selection. Please select a valid Component.');
3170 cboAvailCompSelect(cboAvailComp);
3171 cboAvailComp.SetFocus;
3172 Exit;
3173 end;
3174 if cboAvailComp.ItemID = FLastLabID then Exit;
3175 if not (Length(cboAvailComp.ItemID) = 0) then cboAvailCompSelect(cboAvailComp);
3176end;
3177
3178procedure TfrmODBBank.cboAvailTestNeedData(Sender: TObject;
3179 const StartFrom: String; Direction, InsertAt: Integer);
3180begin
3181 cboAvailTest.ForDataUse(SubsetOfOrderItems(StartFrom, Direction, FVbecLookup));
3182end;
3183
3184procedure TfrmODBBank.cboAvailCompNeedData(Sender: TObject;
3185 const StartFrom: String; Direction, InsertAt: Integer);
3186begin
3187 cboAvailComp.ForDataUse(SubsetOfOrderItems(StartFrom, Direction, FVbecLookup));
3188end;
3189
3190procedure TfrmODBBank.cmdImmedCollClick(Sender: TObject);
3191var
3192 ImmedCollTime: string;
3193begin
3194 inherited;
3195 ImmedCollTime := SelectImmediateCollectTime(Font.Size, txtImmedColl.Text);
3196 if ImmedCollTime <> '-1' then
3197 begin
3198 txtImmedColl.Text := ImmedCollTime;
3199 calCollTime.FMDateTime := StrToFMDateTime(ImmedCollTime);
3200 end
3201 else
3202 begin
3203 txtImmedColl.Clear;
3204 calCollTime.Clear;
3205 end;
3206end;
3207
3208procedure TfrmODBBank.pgeProductChange(Sender: TObject);
3209begin
3210 inherited;
3211 case pgeProduct.TabIndex of
3212 TI_COMPONENT : begin
3213 memOrder.Visible := true;
3214 cmdAccept.Visible := true;
3215 pnlSelectedTests.Visible := true;
3216 lvSelectionList.Width := lvSelectionList.Width + 1; //added to fix font resize issue - funky column display
3217 end;
3218 TI_INFO : begin
3219 if lvSelectionList.Items.Count > 0 then
3220 begin
3221 memOrder.Visible := true;
3222 cmdAccept.Visible := true;
3223 pnlSelectedTests.Visible := true;
3224 end
3225 else
3226 begin
3227 memOrder.Visible := false;
3228 cmdAccept.Visible := false;
3229 pnlSelectedTests.Visible := false;
3230 end;
3231 end;
3232 TI_RESULTS : begin
3233 if lvSelectionList.Items.Count > 0 then
3234 begin
3235 memOrder.Visible := true;
3236 cmdAccept.Visible := true;
3237 pnlSelectedTests.Visible := true;
3238 end
3239 else
3240 begin
3241 memOrder.Visible := false;
3242 cmdAccept.Visible := false;
3243 pnlSelectedTests.Visible := false;
3244 end;
3245 end;
3246 end; {case}
3247end;
3248
3249procedure TfrmODBBank.pnlBloodComponentsClick(Sender: TObject);
3250begin
3251 inherited;
3252 cboAvailComp.SetFocus;
3253end;
3254
3255procedure TfrmODBBank.pnlBloodComponentsEnter(Sender: TObject);
3256begin
3257 inherited;
3258 pnlBloodComponents.Color := clActiveborder;
3259end;
3260
3261procedure TfrmODBBank.pnlBloodComponentsExit(Sender: TObject);
3262begin
3263 inherited;
3264 pnlBloodcomponents.Color := clBtnFace;
3265end;
3266
3267procedure TfrmODBBank.pnlDiagnosticTestsClick(Sender: TObject);
3268begin
3269 inherited;
3270 cboAvailTest.SetFocus;
3271end;
3272
3273procedure TfrmODBBank.pnlDiagnosticTestsEnter(Sender: TObject);
3274begin
3275 inherited;
3276 pnlDiagnosticTests.Color := clActiveBorder;
3277end;
3278
3279procedure TfrmODBBank.pnlDiagnosticTestsExit(Sender: TObject);
3280begin
3281 inherited;
3282 pnlDiagnosticTests.Color := clBtnFace;
3283end;
3284
3285procedure TfrmODBBank.cboCollTimeChange(Sender: TObject);
3286var
3287 CollType: string;
3288const
3289 TX_BAD_TIME = ' is not a routine lab collection time.' ;
3290 TX_BAD_TIME_CAP = 'Invalid Time';
3291begin
3292 CollType := 'LC';
3293 with cboCollTime do
3294 begin
3295 if ItemID = 'LO' then
3296 begin
3297 ItemIndex := -1;
3298 Text := GetFutureLabTime(FMToday);
3299 end;
3300 end;
3301 cboCollType.SelectByID(CollType);
3302 if uSelectedItems.Count > 0 then
3303 begin
3304 with cboCollTime do
3305 if Length(ItemID) > 0 then
3306 begin
3307 Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
3308 FLastLabCollTime := ItemID + U + Text;
3309 end
3310 else if Length(Text) > 0 then
3311 begin
3312 Responses.Update('START', 1, ValidCollTime(Text), Text) ;
3313 FLastLabCollTime := ValidCollTime(Text);
3314 end;
3315 end;
3316end;
3317
3318procedure TfrmODBBank.cboCollTimeEnter(Sender: TObject);
3319var
3320 j: integer;
3321begin
3322 inherited;
3323 if Length(cboAvailTest.Text) > 0 then Exit;
3324 for j := uSelectedItems.Count - 1 downto 0 do
3325 begin
3326 if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '1') then
3327 begin
3328 lvSelectionList.Items[j].Selected := true;
3329 lvSelectionListClick(self);
3330 Break;
3331 end;
3332 end;
3333end;
3334
3335procedure TfrmODBBank.cboCollTypeChange(Sender: TObject);
3336begin
3337 if (ALabTest = nil) or Changing or (cboCollType.ItemID = '') then exit;
3338 if (cboCollType.ItemID = 'I') and (not ALabTest.LabCanCollect) then
3339 begin
3340 InfoBox(TX_NO_IMMED, TX_NO_IMMED_CAP, MB_OK or MB_ICONWARNING);
3341 cboCollType.ItemIndex := -1;
3342 Exit;
3343 end;
3344 if cboCollType.ItemID = 'I' then
3345 begin
3346 cboCollTime.ItemIndex := -1;
3347 cboCollTime.Text := 'NOW';
3348 calCollTime.Text := 'NOW';
3349 end;
3350 SetupCollTimes(cboCollType.ItemID);
3351 if Length(cboCollType.Text) > 0 then Responses.Update('COLLECT',1,cboCollType.ItemID,cboCollType.ItemID);
3352 calCollTimeChange(self);
3353end;
3354
3355procedure TfrmODBBank.cboCollTypeClick(Sender: TObject);
3356begin
3357 inherited;
3358 FOrderAction := 0;
3359end;
3360
3361procedure TfrmODBBank.cboCollTypeEnter(Sender: TObject);
3362var
3363 j: integer;
3364begin
3365 inherited;
3366 if Length(cboAvailTest.Text) > 0 then Exit;
3367 for j := uSelectedItems.Count - 1 downto 0 do
3368 begin
3369 if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '1') then
3370 begin
3371 lvSelectionList.Items[j].Selected := true;
3372 lvSelectionListClick(self);
3373 Break;
3374 end;
3375 end;
3376end;
3377
3378procedure TfrmODBBank.cboModifiersChange(Sender: TObject);
3379var
3380 i: integer;
3381 ListItem: TListItem;
3382 x,q,m: string;
3383begin
3384 inherited;
3385 if changing = true then Exit;
3386 if (cboAvailComp.ItemIndex <> -1) and (uSelectedItems.Count > 0) then
3387 begin
3388 for i := 0 to lvSelectionList.Items.Count - 1 do
3389 begin
3390 x := uSelectedItems[i];
3391 m := piece(x,'^',4);
3392 q := piece(x,'^',3);
3393 if lvSelectionList.Items[i].Caption = piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2) then
3394 begin
3395 ListItem := lvSelectionList.Items[i];
3396 ListItem.SubItems.Clear;
3397 ListItem.SubItems.Add(q);
3398 if length(cboModifiers.ItemID) > 0 then
3399 begin
3400 ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
3401 ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
3402 end
3403 else
3404 begin
3405 ListItem.SubItems.Add('');
3406 ListItem.SubItems.Add('');
3407 end;
3408 ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
3409 Responses.Update('MODIFIER', (i+1), cboModifiers.Text, cboModifiers.Text);
3410 Break;
3411 end;
3412 end;
3413 end;
3414 if Length(cboModifiers.Text) > 0 then
3415 begin
3416 memOrder.Text := Responses.OrderText;
3417 end;
3418end;
3419
3420procedure TfrmODBBank.cboModifiersEnter(Sender: TObject);
3421var
3422 j: integer;
3423begin
3424 inherited;
3425 if Length(cboAvailComp.Text) > 0 then Exit;
3426 for j := uSelectedItems.Count - 1 downto 0 do
3427 begin
3428 if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '0') then
3429 begin
3430 lvSelectionList.Items[j].Selected := true;
3431 lvSelectionListClick(self);
3432 Break;
3433 end;
3434 end;
3435end;
3436
3437procedure TfrmODBBank.LoadModifiers(AComboBox:TORComboBox);
3438var
3439 i: integer;
3440begin
3441 with AComboBox do
3442 begin
3443 Clear;
3444 for i := 0 to uModifierList.Count - 1 do
3445 Items.Add(uModifierList[i]);
3446 end;
3447end;
3448
3449procedure TfrmODBBank.LoadReasons(AComboBox:TORComboBox);
3450var
3451 i: integer;
3452begin
3453 with AComboBox do
3454 begin
3455 Clear;
3456 for i := 0 to uReasonsList.Count - 1 do
3457 Items.Add(uReasonsList[i]);
3458 end;
3459end;
3460
3461procedure TfrmODBBank.LoadUrgencies(AComboBox:TORComboBox);
3462var
3463 i: integer;
3464begin
3465 with AComboBox do
3466 begin
3467 Clear;
3468 {for i := 0 to uUrgencyList.Count - 1 do
3469 if (piece(uUrgencyList[i],'^',2) = 'STAT') and (StatAllowed(Patient.DFN) = false) then
3470 Continue
3471 else
3472 Items.Add(uUrgencyList[i]); }
3473 for i := 0 to uUrgencyList.Count - 1 do
3474 Items.Add(uUrgencyList[i]);
3475 end;
3476end;
3477
3478procedure TfrmODBBank.lvSelectionListClick(Sender: TObject);
3479var
3480 ListItem: TListItem;
3481 x,y: string;
3482 i,j: integer;
3483begin
3484 inherited;
3485 if lvSelectionList.Selected = nil then Exit;
3486 ListItem := lvSelectionList.Selected;
3487 changing := true;
3488 tQuantity.Text := '';
3489 cboModifiers.ItemIndex := -1;
3490 i := lvSelectionList.ItemIndex;
3491 j := 0;
3492 if cboCollType.ItemID = 'LC' then
3493 begin
3494 if (FLastLabCollTime <> '') and (length(cboCollTime.Text) < 1) then
3495 cboCollTime.SelectByID(piece(FLastLabCollTime,'^',1));
3496 end
3497 else if length(calcollTime.Text) < 1 then
3498 begin
3499 if FLastCollTime = 'TODAY' then
3500 calCollTime.Text := FLastCollTime
3501 else if FLastCollTime = 'NOW' then
3502 calCollTime.Text := FLastCollTime
3503 else if FLastCollTime <> '' then
3504 calCollTime.Text := FormatFMDateTime('mmm dd,yyyy@hh:nn',StrToFMDateTime(FLastCollTime));
3505 end;
3506 if (FLastCollType <> '') and (length(cboCollType.Text) < 1) then
3507 cboCollType.SelectByID(FLastCollType);
3508 if uSelectedItems.Count > 0 then
3509 begin
3510 x := uSelectedItems[i];
3511 ALabTest := TLabTest.Create(piece(uSelectedItems[i],'^',2), Responses);
3512 if not(piece(x,'^',2) = '') then j := StrToInt(piece(x,'^',2));
3513 if not(piece(x,'^',1) = '1') and (j > 0) then //Components
3514 begin
3515 DisableDiagTestControls;
3516 EnableComponentControls;
3517 y := ListItem.SubItems[2];
3518 changing := true;
3519 cboModifiers.Text := '';
3520 cboAvailComp.SelectByIEN(j);
3521 tQuantity.Text := ListItem.SubItems[0];
3522 changing := false;
3523 if y <> '' then cboModifiers.ItemIndex := StrToInt(y);
3524 end
3525 else //Diagnostic Tests
3526 begin
3527 DisableComponentControls;
3528 EnableDiagTestControls;
3529 cboAvailTest.SelectByIEN(j);
3530 end;
3531 end;
3532 changing := false;
3533end;
3534
3535procedure TfrmODBBank.memDiagCommentChange(Sender: TObject);
3536begin
3537 inherited;
3538 memDiagComment.Text := StringReplace(memDiagComment.Text,CRLF,' ',[rfReplaceAll]);
3539 if (length(memDiagComment.Text) > 250) then
3540 begin
3541 ShowMsg('COMMENT cannot be longer than 250 characters');
3542 memDiagComment.Text := Copy(memDiagComment.Text,0,250);
3543 Exit;
3544 end;
3545 if lvSelectionList.Items.Count < 1 then Exit;
3546
3547 if uSelectedItems = nil then Exit;
3548
3549 if uSelectedItems.Count > 0 then
3550 Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
3551 memOrder.Text := Responses.OrderText;
3552end;
3553
3554procedure TfrmODBBank.FormDestroy(Sender: TObject);
3555begin
3556 inherited;
3557 uSelectedItems.Free;
3558 uVBECList.Free;
3559 uTestsForResults.Free;
3560 uUrgencyList.Free;
3561 uTNSOrders.Free;
3562 uModifierList.Free;
3563 uReasonsList.Free;
3564 uRaw.Free;
3565end;
3566
3567procedure TfrmODBBank.FormShow(Sender: TObject);
3568begin
3569 inherited;
3570 pgeProduct.SetFocus;
3571end;
3572
3573procedure TfrmODBBank.btnRemoveClick(Sender: TObject);
3574var
3575 i,j,curAdd: integer;
3576 x, aName, aModifier, aReason, aTypeScreen: string;
3577 aList: TStringList;
3578 aSel, aSelTst, aSelComp, aGotTNS : boolean;
3579begin
3580 inherited;
3581 aList := TStringList.Create;
3582 try
3583 curAdd := 1;
3584 aModifier := '';
3585 aReason := '';
3586 aTypeScreen := '';
3587 aSel := false;
3588 aSelTst := false;
3589 aSelComp := false;
3590 aGotTNS := false;
3591 ExtractTypeScreen(aList, uVBECList);
3592 if aList.Count > 0 then aTypeScreen := aList[0];
3593 aList.Clear;
3594 if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
3595 if length(cboReasons.ItemID) > 0 then aReason := cboReasons.Items[cboReasons.ItemIndex];
3596 if lvSelectionList.Items.Count < 1 then
3597 begin
3598 ShowMsg('There is nothing in the list to remove.');
3599 exit;
3600 end;
3601 cboAvailComp.ItemIndex := -1;
3602 tQuantity.Text := '';
3603 tQuantity.Enabled := false;
3604 lblQuantity.Enabled := false;
3605 cboAvailTest.ItemIndex := -1;
3606 uGetTnS := 0;
3607 lblTNS.Caption := '';
3608 lblTNS.Visible := false;
3609 memMessage.Text := '';
3610 pnlMessage.Visible := false;
3611 pnlDiagnosticTests.Caption := 'Diagnostic Tests';
3612 with lvSelectionList do
3613 begin
3614 for i := lvSelectionList.Items.Count - 1 downto 0 do
3615 begin
3616 if lvSelectionList.Items[i].Selected = true then
3617 begin
3618 aSel := true;
3619 for j := uSelectedItems.Count - 1 downto 0 do
3620 if lvSelectionList.Items[i].SubItems[3] = piece(uSelectedItems[j],'^',2) then
3621 begin
3622 uSelectedItems.Delete(j);
3623 lvSelectionList.Items[i].Delete;
3624 break;
3625 end;
3626 end;
3627 end;
3628 end;
3629 for i := lvSelectionList.Items.Count - 1 downto 0 do
3630 begin
3631 if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
3632 begin
3633 aGotTNS := true;
3634 break;
3635 end;
3636 end;
3637 if aGotTNS = false then
3638 begin
3639 for i := uSelectedItems.Count - 1 downto 0 do
3640 begin
3641 if not(piece(uSelectedItems[i],'^',1) = '1') and (uTNSOrders.Count < 1) and (piece(uSelectedItems[i],'^',5) = '1') then //CQ 17349
3642 begin
3643 uGetTnS := 1;
3644 lblTNS.Caption := 'TYPE + SCREEN must be added to order';
3645 lblTNS.Visible := true;
3646 memMessage.Text := 'TYPE + SCREEN must be added to order';
3647 pnlMessage.Visible := true;
3648 pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
3649 break;
3650 end
3651 else pnlDiagnosticTests.Caption := 'Diagnostic Tests';
3652 end;
3653 end;
3654 if (aSel = false) and (lvSelectionList.Items.Count > 0) then
3655 begin
3656 ShowMsg('Please select an item from the list to be removed.');
3657 exit;
3658 end;
3659 Responses.Clear;
3660 pnlDiagnosticTests.Caption := 'Diagnostic Tests';
3661 lblCollTime.Caption := 'Collection Date/Time';
3662 lblCollType.Caption := 'Collection Type';
3663 lblQuantity.Caption := 'Quantity';
3664 lblWanted.Caption := 'Date/Time Wanted';
3665 lblReason.Caption := 'Reason for Request';
3666 if lvSelectionList.Items.Count < 1 then
3667 begin
3668 uGetTnS := 0;
3669 lblTNS.Caption := '';
3670 lblTNS.Visible := false;
3671 memMessage.Text := '';
3672 pnlMessage.Visible := false;
3673 FLastItemID := '';
3674 InitDialog;
3675 cboModifiers.ItemIndex := -1;
3676 cboAvailTest.ItemIndex := -1;
3677 cboAvailComp.ItemIndex := -1;
3678 cboCollType.ItemIndex := -1;
3679 cboCollTime.ItemIndex := -1;
3680 cboQuick.ItemIndex := -1;
3681 calWantTime.Text := '';
3682 GroupBox1.Visible := true;
3683 tQuantity.Text := '';
3684 FLastCollType := '';
3685 FLastCollTime := '';
3686 FLastLabCollTime := '';
3687 txtImmedColl.Text := '';
3688 calCollTime.text := '';
3689 lblNoBloodReq.Visible := false;
3690 end;
3691 for i := 0 to uSelectedItems.Count - 1 do
3692 begin
3693 aName := lvSelectionList.Items[i].Caption;
3694 x := uSelectedItems[i];
3695 if piece(x,'^',1) = '1' then //Diagnostic Test related fields
3696 begin
3697 if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
3698 lblCollTime.Caption := 'Collection Date/Time*';
3699 lblCollType.Caption := 'Collection Type*';
3700 aSelTst := true;
3701 end
3702 else
3703 begin
3704 if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
3705 if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
3706 if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), aModifier);
3707 if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
3708 cboModifiers.ItemIndex := -1;
3709 cboAvailComp.ItemIndex := -1;
3710 tQuantity.Text := '';
3711 lblQuantity.Caption := 'Quantity*';
3712 lblWanted.Caption := 'Date/Time Wanted*';
3713 lblReason.Caption := 'Reason for Request*';
3714 //aSelComp := true;
3715 end;
3716 Inc(CurAdd);
3717 end;
3718 if aSelTst = false then
3719 begin
3720 cboCollType.ItemIndex := -1;
3721 cboCollTime.ItemIndex := -1;
3722 calCollTime.Text := '';
3723 end;
3724 {if aSelcomp = false then
3725 lblNoBloodReq.Visible := false
3726 else
3727 lblNoBloodReq.Visible := true; }
3728 if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
3729 if cboCollType.ItemID = 'LC' then
3730 begin
3731 with cboCollTime do
3732 if Length(ItemID) > 0 then
3733 begin
3734 Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
3735 FLastLabCollTime := ItemID + U + Text;
3736 end
3737 else if Length(Text) > 0 then
3738 begin
3739 Responses.Update('START', 1, ValidCollTime(Text), Text) ;
3740 FLastLabCollTime := ValidCollTime(Text);
3741 end;
3742 end
3743 else
3744 begin
3745 with calCollTime do
3746 if FMDateTime > 0 then
3747 begin
3748 Responses.Update('START', 1, ValidCollTime(Text), Text);
3749 FLastColltime := ValidCollTime(Text);
3750 end
3751 else
3752 begin
3753 Responses.Update('START', 1, '', '') ;
3754 FLastCollTime := '';
3755 end;
3756 end;
3757 with cboCollType do if Length(ItemID) > 0 then
3758 begin
3759 Responses.Update('COLLECT', 1, ItemID, ItemID) ;
3760 FLastCollType := ItemID;
3761 end;
3762 if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
3763 if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
3764 if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
3765 if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
3766 if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes');
3767 memOrder.Text := Responses.OrderText;
3768 CurAdd := 1;
3769 if uRaw.Count > 0 then
3770 for j := 0 to uRaw.Count - 1 do
3771 begin
3772 if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
3773 Inc(CurAdd);
3774 end;
3775 if uSelectedItems.Count < 1 then
3776 begin
3777 uGetTnS := 0;
3778 lblTNS.Caption := '';
3779 lblTNS.Visible := false;
3780 memMessage.Text := '';
3781 pnlMessage.Visible := false;
3782 GroupBox1.Visible := true;
3783 pnlDiagnosticTests.Caption := 'Diagnostic Tests';
3784 end;
3785 finally
3786 aList.Free;
3787 end;
3788end;
3789
3790procedure TfrmODBBank.btnUpdateCommentsClick(Sender: TObject);
3791begin
3792 inherited;
3793 pnlComments.Visible := false;
3794 pnlComments.SendToBack;
3795 Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
3796 memOrder.Text := Responses.OrderText;
3797end;
3798
3799procedure TfrmODBBank.btnCancelCommentClick(Sender: TObject);
3800begin
3801 inherited;
3802 pnlComments.Visible := false;
3803 pnlComments.SendToBack;
3804end;
3805
3806procedure TfrmODBBank.btnRemoveAllClick(Sender: TObject);
3807begin
3808 inherited;
3809 if lvSelectionList.Items.Count < 1 then
3810 begin
3811 ShowMsg('There is nothing in the list to remove.');
3812 exit;
3813 end;
3814 lvSelectionList.Clear;
3815 uSelectedItems.Clear;
3816 uTestsForResults.Clear;
3817 uRaw.Clear;
3818 uGetTnS := 0;
3819 lblTNS.Caption := '';
3820 lblTNS.Visible := false;
3821 memMessage.Text := '';
3822 pnlMessage.Visible := false;
3823 FLastItemID := '';
3824 InitDialog;
3825 cboModifiers.ItemIndex := -1;
3826 cboAvailTest.ItemIndex := -1;
3827 cboAvailComp.ItemIndex := -1;
3828 cboSurgery.ItemIndex := -1;
3829 cboUrgency.ItemIndex := -1;
3830 cboReasons.ItemIndex := -1;
3831 cboCollType.ItemIndex := -1;
3832 cboCollTime.ItemIndex := -1;
3833 cboQuick.ItemIndex := -1;
3834 calWantTime.Text := '';
3835 memDiagComment.Text := '';
3836 GroupBox1.Visible := true;
3837 tQuantity.Text := '';
3838 tQuantity.Enabled := false;
3839 lblQuantity.Enabled := false;
3840 FLastCollType := '';
3841 FLastCollTime := '';
3842 FLastLabCollTime := '';
3843 txtImmedColl.Text := '';
3844 calCollTime.text := '';
3845 lblNoBloodReq.Visible := false;
3846 pnlDiagnosticTests.Caption := 'Diagnostic Tests';
3847 lblCollTime.Caption := 'Collection Date/Time';
3848 lblCollType.Caption := 'Collection Type';
3849 lblQuantity.Caption := 'Quantity';
3850 lblWanted.Caption := 'Date/Time Wanted';
3851 lblReason.Caption := 'Reason for Request';
3852end;
3853
3854procedure TfrmODBBank.cmdAcceptClick(Sender: TObject);
3855var
3856 i: integer;
3857 Comp: boolean;
3858const
3859 Txt1 = 'This order can not be saved for the following reason(s):';
3860 Txt2 = #13+#13+'An order for TYPE and SCREEN must be created with this order set.';
3861begin
3862 if not ValidAdd then Exit;
3863 if uGetTnS = 1 then
3864 begin
3865 MessageDlg(Txt1+Txt2, mtWarning,[mbOK],0);
3866 Exit;
3867 end;
3868 Comp := false;
3869 if uSelectedItems.Count > 0 then
3870 begin
3871 for i := 0 to uSelectedItems.Count - 1 do
3872 if not (piece(uSelectedItems[i],'^',1) = '1') then
3873 begin
3874 Comp := true;
3875 Break;
3876 end;
3877 end;
3878 if Comp = true then
3879 begin
3880 if NursAdminSuppress = true then
3881 ShowMsg('The nursing blood administration order must be entered separately' + '.');
3882 end;
3883 inherited;
3884end;
3885
3886procedure TfrmODBBank.calWantTimeChange(Sender: TObject);
3887var
3888 i: integer;
3889 aList: TStringList;
3890 aSpecimen, aSpecimenUID, aSpecimenReq: string;
3891 aChanging: Boolean;
3892begin
3893 inherited;
3894 aList := TStringList.Create;
3895 aChanging := changing;
3896 try
3897 aSpecimen := '';
3898 aSpecimenUID := '';
3899 aSpecimenReq := '';
3900 if uSelectedItems.Count > 0 then
3901 begin
3902 with calWantTime do if not changing then
3903 begin
3904 if FMDateTime = 0 then
3905 begin
3906 ShowMsg('Invalid Date/Time entered');
3907 changing := true;
3908 calWantTime.Text := '';
3909 changing := aChanging;
3910 Exit;
3911 end
3912 else
3913 begin
3914 // date/time was entered
3915 if (UpperCase(Text) <> 'NOW') and not(Trunc(FMNow) = Trunc(FMDateTime)) and (FMDateTime < FMNow) then
3916 begin
3917 ShowMsg('Date/Time Wanted must be a future Date/Time');
3918 changing := true;
3919 calWantTime.Text := '';
3920 changing := aChanging;
3921 Exit;
3922 end;
3923 end;
3924 end;
3925 if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
3926 memOrder.Text := Responses.OrderText;
3927 aList.Clear;
3928 ExtractSpecimen(aList, uVBECList);
3929 if aList.Count > 0 then
3930 begin
3931 aSpecimen := piece(aList[0], '^', 1);
3932 aSpecimenUID := piece(aList[0], '^', 2);
3933 end;
3934 aList.Clear;
3935 ExtractSpecimens(aList, uVBECList); //Get specimen values to pass back to Server
3936 for i := 0 to aList.Count - 1 do
3937 begin
3938 if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) then
3939 begin
3940 aSpecimenReq := piece(aList[i],'^',2);
3941 if (SpecimenNeeded(aList, uVBECList, aLabTest.ItemID)) then
3942 aSpecimenUID := '';
3943 break;
3944 end;
3945 end;
3946 Responses.Update('SPECSTS', 1, aSpecimenReq + '^' + aSpecimen + '^' + aSpecimenUID, aSpecimenReq);
3947 end;
3948 finally
3949 aList.Free;
3950 end;
3951end;
3952
3953procedure TfrmODBBank.calWantTimeEnter(Sender: TObject);
3954var
3955 j: integer;
3956begin
3957 inherited;
3958 if Length(cboAvailComp.Text) > 0 then Exit;
3959 for j := uSelectedItems.Count - 1 downto 0 do
3960 begin
3961 if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '0') then
3962 begin
3963 lvSelectionList.Items[j].Selected := true;
3964 lvSelectionListClick(self);
3965 Break;
3966 end;
3967 end;
3968end;
3969
3970procedure TfrmODBBank.chkConsentClick(Sender: TObject);
3971begin
3972 inherited;
3973 if uSelectedItems.Count > 0 then
3974 begin
3975 if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes');
3976 memOrder.Text := Responses.OrderText;
3977 end;
3978end;
3979
3980procedure TfrmODBBank.cboUrgencyChange(Sender: TObject);
3981begin
3982 inherited;
3983 if Length(cboUrgency.Text) > 0 then
3984 begin
3985 Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
3986 uSelUrgency := cboUrgency.Text;
3987 if cboUrgency.Text = 'PRE-OP' then
3988 begin
3989 lblSurgery.Enabled := true;
3990 cboSurgery.Enabled := true;
3991 lblSurgery.Caption := 'Surgery*';
3992 end
3993 else
3994 begin
3995 if Length(cboSurgery.Text) > 0 then
3996 begin
3997 lblSurgery.Enabled := true;
3998 cboSurgery.Enabled := true;
3999 lblSurgery.Caption := 'Surgery*';
4000 end
4001 else
4002 begin
4003 lblSurgery.Enabled := false;
4004 cboSurgery.Enabled := false;
4005 lblSurgery.Caption := 'Surgery';
4006 cboSurgery.ItemIndex := -1;
4007 Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
4008 end;
4009 end;
4010 end
4011 else
4012 cboUrgency.SelectByID(IntToStr(uDfltUrgency));
4013 memOrder.Text := Responses.OrderText;
4014end;
4015
4016procedure TfrmODBBank.cboUrgencyExit(Sender: TObject);
4017begin
4018 inherited;
4019 if Length(cboUrgency.Text) < 1 then
4020 cboUrgency.SelectByID(IntToStr(uDfltUrgency));
4021end;
4022
4023procedure TfrmODBBank.cboSurgeryChange(Sender: TObject);
4024var
4025 aList, bList, cList: TStringList;
4026 i,j,aMSBOS,aMSBOSContinue: integer;
4027 x,aTypeScreen: string;
4028 handled,aGotTNS: boolean;
4029 xLabTest: TLabTest;
4030begin
4031 inherited;
4032 cboSurgery.Text := StringReplace(cboSurgery.Text,CRLF,' ',[rfReplaceAll]);
4033 aList := TStringList.Create;
4034 bList := TStringList.Create;
4035 cList := TStringList.Create;
4036 handled := false;
4037 //uGetTNS := 0;
4038 //aGotTNS := false;
4039 ExtractTypeScreen(aList, uVBECList);
4040 if aList.Count > 0 then aTypeScreen := aList[0];
4041 aList.Clear;
4042 bList.Clear;
4043 cList.Clear;
4044 try
4045 cboSurgery.DroppedDown := false;
4046 if (Length(cboSurgery.ItemID) > 0) then
4047 begin
4048 for j := 0 to uSelectedItems.Count - 1 do
4049 begin
4050 xLabTest := TLabTest.Create(piece(uSelectedItems[j],'^',2), Responses);
4051 if (piece(uSelectedItems[j],'^',1) = '0') and (not(piece(uSelectedItems[j],'^',3)='')) and (StrToInt(piece(uSelectedItems[j],'^',3)) > 0) and (piece(cboSurgery.Items[cboSurgery.ItemIndex],'^',3) = '1') then
4052 begin
4053 cList.Add(xLabTest.TestName + '^' + piece(uSelectedItems[j],'^',3));
4054 end;
4055 xLabTest.Free;
4056 end;
4057 end;
4058 if (Length(cboSurgery.ItemID) > 0) and (Length(tQuantity.Text) > 0) and (Length(cboAvailComp.Text) > 0) then
4059 begin
4060 aList.Clear;
4061 ExtractMSBOS(aList, uVBECList); //Get maximum units for selected Surgey
4062 for i := 0 to aList.Count - 1 do
4063 begin
4064 if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
4065 and (uppercase((piece(aList[i],'^',3))) = uppercase(cboSurgery.Text)) then
4066 begin
4067 aMSBOS := StrToInt(piece(aList[i],'^',4));
4068 if (aMSBOS > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
4069 begin
4070 bList.Add(aLabTest.TestName + '^' + tQuantity.Text + '^' + IntToStr(aMSBOS));
4071 end;
4072 handled := true;
4073 break;
4074 end;
4075 end;
4076 end;
4077 if (handled = false) and (Length(cboSurgery.ItemID) > 0) and (uSelectedItems.Count > 0) then
4078 begin
4079 aList.Clear;
4080 ExtractMSBOS(aList, uVBECList); //Get maximum units for selected Surgey
4081 for j := 0 to uSelectedItems.Count - 1 do
4082 begin
4083 xLabTest := TLabTest.Create(piece(uSelectedItems[j],'^',2), Responses);
4084 for i := 0 to aList.Count - 1 do
4085 begin
4086 if (piece(uSelectedItems[j],'^',1) = '0')
4087 and (StrToInt(piece(aList[i],'^',1)) = xLabTest.ItemID)
4088 and (uppercase((piece(aList[i],'^',3))) = uppercase(cboSurgery.Text)) then
4089 begin
4090 aMSBOS := StrToInt(piece(aList[i],'^',4));
4091 if (aMSBOS > 0) and (length(piece(uSelectedItems[j],'^',3)) > 0) and (StrToInt(piece(uSelectedItems[j],'^',3)) > aMSBOS) then
4092 begin
4093 bList.Add(xLabTest.TestName + '^' + piece(uSelectedItems[j],'^',3) + '^' + IntToStr(aMSBOS));
4094 end;
4095 break;
4096 end;
4097 end;
4098 xLabTest.Free;
4099 end;
4100 end;
4101 if (uChangingMSBOS = false) and (cList.Count > 0) then
4102 begin
4103 lblNoBloodReq.Visible := true;
4104 with Application do
4105 begin
4106 NormalizeTopMosts;
4107 aMSBOSContinue :=
4108 MessageBox(PChar('No blood is required for the surgical procedure: ' + cboSurgery.text +
4109 '.' + CRLF +
4110 'If you still need to order any components, please enter a justification in the Comment box.'
4111 + CRLF + CRLF + 'Do you want me to remove ALL the component orders you''ve just entered? '),
4112 PChar('No Blood Required'),MB_YESNO);
4113 RestoreTopMosts;
4114 end;
4115 if aMSBOSContinue = 6 then
4116 begin
4117 tQuantity.Text := '';
4118 bList.Clear;
4119 for j := uSelectedItems.Count - 1 downto 0 do
4120 begin
4121 if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '0') then
4122 begin
4123 lvSelectionList.Items[j].Delete;
4124 uSelectedItems.Delete(j);
4125 Responses.Update('ORDERABLE', (j+1) ,'', '');
4126 Responses.Update('MODIFIER', (j+1), '', '');
4127 Responses.Update('QTY', (j+1), '', '');
4128 end;
4129 end;
4130 cboAvailComp.Text := '';
4131 cboAvailComp.ItemIndex := -1;
4132 cboModifiers.Text := '';
4133 cboModifiers.ItemIndex := -1;
4134 lblNoBloodReq.Visible := false;
4135 //if fODBBank. Active then cboAvailTest.SetFocus;
4136 lblTNS.Caption := '';
4137 lblTNS.Visible := false;
4138 uGetTNS := 0;
4139 aGotTNS := false;
4140 DisableComponentControls;
4141 for i := lvSelectionList.Items.Count - 1 downto 0 do
4142 begin
4143 if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
4144 begin
4145 aGotTNS := true;
4146 break;
4147 end;
4148 end;
4149 for i := uSelectedItems.Count - 1 downto 0 do
4150 begin
4151 if (aGotTNS = false) and not(piece(uSelectedItems[i],'^',1) = '1') and (uTNSOrders.Count < 1) and (piece(uSelectedItems[i],'^',5) = '1') then //CQ 17349
4152 begin
4153 uGetTnS := 1;
4154 lblTNS.Caption := 'TYPE + SCREEN must be added to order';
4155 lblTNS.Visible := true;
4156 memMessage.Text := 'TYPE + SCREEN must be added to order';
4157 pnlMessage.Visible := true;
4158 pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
4159 break;
4160 end
4161 else pnlDiagnosticTests.Caption := 'Diagnostic Tests';
4162 end;
4163 end;
4164 end
4165 else
4166 begin
4167 lblNoBloodReq.Visible := false;
4168 end;
4169
4170 if (uChangingMSBOS = false) and (bList.Count > 0) then
4171 begin
4172 x := '';
4173 for i := 0 to bList.Count - 1 do
4174 begin
4175 x := x + CRLF + piece(bList[i],'^',1) + ' (' + piece(bList[i],'^',2) + ') Max allowed: ' + piece(bList[i],'^',3);
4176 end;
4177 with Application do
4178 begin
4179 NormalizeTopMosts;
4180 aMSBOSContinue :=
4181 MessageBox(PChar('The number of units ordered' + x + CRLF +
4182 'Exceeds the maximum number recommended for '
4183 + cboSurgery.text + CRLF + CRLF +
4184 'If you need to order more than the recommended maximum units, please enter a justification in the Comment box.')
4185 ,PChar('Maximum Number of Units Exceeded'),
4186 MB_OK);
4187 RestoreTopMosts;
4188 end;
4189 end;
4190 if uSelectedItems.Count > 0 then
4191 if Length(cboSurgery.Text) > 0 then
4192 Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
4193 uSelSurgery := 0;
4194 if Length(cboSurgery.Text) > 0 then
4195 begin
4196 if length(cboSurgery.ItemID) > 0 then uSelSurgery := cboSurgery.ItemID;
4197 cboReasons.Text := cboSurgery.Text;
4198 Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
4199 end;
4200 memOrder.Text := Responses.OrderText;
4201 finally
4202 aList.Free;
4203 bList.Free;
4204 cList.Free;
4205 end;
4206end;
4207
4208procedure TfrmODBBank.cboSurgeryClick(Sender: TObject);
4209begin
4210 inherited;
4211 if Length(cboSurgery.Text) > 0 then uSelSurgery := cboSurgery.ItemID;
4212end;
4213
4214procedure TfrmODBBank.tQuantityChange(Sender: TObject);
4215var
4216 aList: TStringList;
4217 i,aMSBOS,aMSBOSContinue: integer;
4218 ListItem: TListItem;
4219 x,m: string;
4220begin
4221 inherited;
4222 if changing = true then Exit;
4223 aList := TStringList.Create;
4224 if Length(tQuantity.Text) > 0 then
4225 begin
4226 if Length(tQuantity.Text) > 2 then
4227 begin
4228 ShowMsg('Invalid entry. Please select a numeric value <100');
4229 tQuantity.Text := '';
4230 Exit;
4231 end;
4232 if StrToInt(tQuantity.Text) > 100 then
4233 begin
4234 ShowMsg('Quantity too high. Please select a value <100');
4235 tQuantity.Text := Copy(tQuantity.Text,0,1);
4236 Exit;
4237 end;
4238 end;
4239 try
4240 if not(aLabTest = nil) and (Length(cboSurgery.ItemID) > 0) and (Length(tQuantity.Text) > 0) then
4241 begin
4242 uChangingMSBOS := true;
4243 cboSurgeryChange(self);
4244 uChangingMSBOS := false;
4245 aList.Clear;
4246 ExtractMSBOS(aList, uVBECList); //Get maximum units for selected Surgery
4247 for i := 0 to aList.Count - 1 do
4248 begin
4249 if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
4250 and (uppercase((piece(aList[i],'^',3))) = uppercase(cboSurgery.Text)) and (Length(tQuantity.Text) > 0) then
4251 begin
4252 aMSBOS := StrToInt(piece(aList[i],'^',4));
4253 if (aMSBOS > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
4254 begin
4255 with Application do
4256 begin
4257 NormalizeTopMosts;
4258 aMSBOSContinue :=
4259 MessageBox(PChar('The number of units ordered (' + tQuantity.Text +
4260 ') for ' + aLabTest.TestName + ' Exceeds the maximum number recommended ('
4261 + IntToStr(aMSBOS) +
4262 ') for the ' + cboSurgery.text +
4263 ' surgical procedure.' + CRLF +
4264 'If you need to order more than the maximum number of units, please enter a justification in the Comment box.'
4265 + CRLF + CRLF + 'Edit the Blood component Quantity?'),
4266 PChar('Maximum Number of Units Exceeded'),
4267 MB_YESNO);
4268
4269 RestoreTopMosts;
4270 end;
4271 if aMSBOSContinue = 6 then
4272 begin
4273 ShowMsg('Please enter a new quantity for ' + cboAvailComp.Text);
4274 tQuantity.Text := '0';
4275 tQuantity.SelLength := 2;
4276 tQuantity.SelectAll;
4277 break;
4278 end;
4279 end;
4280 break;
4281 end;
4282 end;
4283 end;
4284 if (cboAvailComp.ItemIndex <> -1) and (uSelectedItems.Count > 0) then
4285 for i := 0 to lvSelectionList.Items.Count - 1 do
4286 begin
4287 if lvSelectionList.Items[i].Caption = piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2) then
4288 begin
4289 x := uSelectedItems[i];
4290 m := piece(x,'^',4);
4291 ListItem := lvSelectionList.Items[i];
4292 ListItem.SubItems.Clear;
4293 ListItem.SubItems.Add(tQuantity.Text);
4294 SetPiece(x,U,3,tQuantity.Text);
4295 Responses.Update('QTY', (i+1), tQuantity.Text, tQuantity.Text);
4296 uSelectedItems[i] := x;
4297 if length(cboModifiers.ItemID) > 0 then
4298 begin
4299 ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
4300 ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
4301 end
4302 else
4303 begin
4304 ListItem.SubItems.Add('');
4305 ListItem.SubItems.Add('');
4306 end;
4307
4308 ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
4309 Break;
4310 end;
4311 end;
4312 if Length(tQuantity.Text) > 0 then
4313 begin
4314 memOrder.Text := Responses.OrderText;
4315 end;
4316 finally
4317 aList.Free;
4318 end;
4319end;
4320
4321procedure TfrmODBBank.tQuantityClick(Sender: TObject);
4322begin
4323 inherited;
4324 tQuantity.SelLength := 2;
4325 tQuantity.SelectAll;
4326end;
4327
4328procedure TfrmODBBank.tQuantityEnter(Sender: TObject);
4329var
4330 j: integer;
4331begin
4332 inherited;
4333 tQuantity.SelLength := 2;
4334 tQuantity.SelectAll;
4335 if Length(cboAvailComp.Text) > 0 then Exit;
4336 for j := uSelectedItems.Count - 1 downto 0 do
4337 begin
4338 if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '0') then
4339 begin
4340 lvSelectionList.Items[j].Selected := true;
4341 lvSelectionListClick(self);
4342 Break;
4343 end;
4344 end;
4345end;
4346
4347procedure TfrmODBBank.txtImmedCollEnter(Sender: TObject);
4348var
4349 j: integer;
4350begin
4351 inherited;
4352 if Length(cboAvailTest.Text) > 0 then Exit;
4353 for j := uSelectedItems.Count - 1 downto 0 do
4354 begin
4355 if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '1') then
4356 begin
4357 lvSelectionList.Items[j].Selected := true;
4358 lvSelectionListClick(self);
4359 Break;
4360 end;
4361 end;
4362end;
4363
4364procedure TfrmODBBank.calCollTimeChange(Sender: TObject);
4365begin
4366 inherited;
4367 if uSelectedItems.Count > 0 then
4368 begin
4369 if cboCollType.ItemID = 'LC' then
4370 begin
4371 with cboCollTime do
4372 if Length(ItemID) > 0 then
4373 begin
4374 Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
4375 FLastLabCollTime := ItemID + U + Text;
4376 end
4377 else if Length(Text) > 0 then
4378 begin
4379 Responses.Update('START', 1, ValidCollTime(Text), Text) ;
4380 FLastLabCollTime := ValidCollTime(Text);
4381 end;
4382 end
4383 else
4384 begin
4385 with calCollTime do
4386 if FMDateTime > 0 then
4387 begin
4388 Responses.Update('START', 1, ValidCollTime(Text), Text);
4389 FLastColltime := ValidCollTime(Text);
4390 end
4391 else
4392 begin
4393 Responses.Update('START', 1, '', '') ;
4394 FLastCollTime := '';
4395 end;
4396 end;
4397 memOrder.Text := Responses.OrderText;
4398 end;
4399end;
4400
4401procedure TfrmODBBank.calCollTimeEnter(Sender: TObject);
4402var
4403 j: integer;
4404begin
4405 inherited;
4406 if Length(cboAvailTest.Text) > 0 then Exit;
4407 for j := uSelectedItems.Count - 1 downto 0 do
4408 begin
4409 if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '1') then
4410 begin
4411 lvSelectionList.Items[j].Selected := true;
4412 lvSelectionListClick(self);
4413 Break;
4414 end;
4415 end;
4416end;
4417
4418end.
Note: See TracBrowser for help on using the repository browser.