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

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

Upgrade to version 27

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