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