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