source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/fODBBank.~pas@ 1156

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

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