source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/fODRad.pas@ 1717

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

Initial upload of TMG-CPRS 1.0.26.69
File size: 30.7 KB
RevLine 
[453]1//kt -- Modified with SourceScanner on 8/8/2007
2unit fODRad;
3
4interface
5
6uses
7 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
8 Forms, Dialogs, StdCtrls, ORCtrls, fODBase, ORFn, ExtCtrls,
9 ComCtrls, uConst, ORDtTm, DKLang;
10
11type
12 TfrmODRad = class(TfrmODBase)
13 lblDrug: TLabel;
14 cboProcedure: TORComboBox;
15 cboAvailMod: TORComboBox;
16 lblAvailMod: TLabel;
17 cmdRemove: TButton;
18 calRequestDate: TORDateBox;
19 cboUrgency: TORComboBox;
20 cboTransport: TORComboBox;
21 cboCategory: TORComboBox;
22 chkPreOp: TCheckBox;
23 cboSubmit: TORComboBox;
24 lstLastExam: TORListBox;
25 lblReason: TLabel;
26 memReason: TCaptionMemo;
27 lstSelectMod: TORListBox;
28 lblSelectMod: TLabel;
29 lblRequestDate: TLabel;
30 lblUrgency: TLabel;
31 lblTransport: TLabel;
32 lblCategory: TLabel;
33 lblSubmit: TLabel;
34 lblLastExam: TLabel;
35 lblAskSubmit: TLabel;
36 chkIsolation: TCheckBox;
37 FRadCommonCombo: TORListBox;
38 lblImType: TLabel;
39 cboImType: TORComboBox;
40 calPreOp: TORDateBox;
41 lblPreOp: TLabel;
42 pnlLeft: TORAutoPanel;
43 pnlRight: TORAutoPanel;
44 pnlHandR: TPanel;
45 grpPregnant: TGroupBox;
46 radPregnant: TRadioButton;
47 radPregnantNo: TRadioButton;
48 radPregnantUnknown: TRadioButton;
49 procedure cboProcedureNeedData(Sender: TObject;
50 const StartFrom: string; Direction, InsertAt: Integer);
51 procedure cboAvailModMouseClick(Sender: TObject);
52 procedure cmdRemoveClick(Sender: TObject);
53 procedure ControlChange(Sender: TObject);
54 procedure cboProcedureSelect(Sender: TObject);
55 procedure SetModifierList;
56 procedure cboCategoryChange(Sender: TObject);
57 procedure FormCreate(Sender: TObject);
58 procedure cboImTypeChange(Sender: TObject);
59 procedure memReasonExit(Sender: TObject);
60 procedure FormResize(Sender: TObject);
61 procedure cboAvailModKeyDown(Sender: TObject; var Key: Word;
62 Shift: TShiftState);
63 procedure calPreOpChange(Sender: TObject);
64 procedure cmdAcceptClick(Sender: TObject);
65 procedure cboProcedureExit(Sender: TObject);
66 procedure cboImTypeExit(Sender: TObject);
67 procedure FormClose(Sender: TObject; var Action: TCloseAction);
68 procedure chkIsolationExit(Sender: TObject);
69 procedure calPreOpExit(Sender: TObject);
70 procedure cboImTypeDropDownClose(Sender: TObject);
71 private
72 FLastRadID: string;
73 FEditCopy: boolean;
74 FPreOpDate: string;
75 FEvtDelayDiv: string;
76 FPredefineOrder: boolean;
77 ImageTypeChanged : boolean;
78 FFormFirstOpened: boolean;
79 function NoPregnantSelection : Boolean;
80 procedure ImageTypeChange;
81 procedure FormFirstOpened(Sender: TObject);
82 protected
83 procedure InitDialog; override;
84 procedure Validate(var AnErrMsg: string); override;
85 procedure SetDefaultPregant;
86 public
87 procedure SetupDialog(OrderAction: Integer; const ID: string); override;
88 end;
89
90implementation
91
92{$R *.DFM}
93
94uses rODBase, rODRad, rOrders, uCore, rCore, fODRadApproval, fODRadConShRes, fLkUpLocation, fFrame,
95 uFormMonitor;
96
97//const
98//TX_NO_PROC = 'An Imaging Procedure must be specified.' ; <-- original line. //kt 8/8/2007
99//TX_NO_MODE = 'A mode of transport must be selected.'; <-- original line. //kt 8/8/2007
100//TX_NO_REASON = 'A History & Reason for Exam must be entered.' ; <-- original line. //kt 8/8/2007
101//TX_NO_DATE = 'Unable to evaluate request date.' ; <-- original line. //kt 8/8/2007
102//TX_APPROVAL_REQUIRED= 'This procedure requires Radiologist approval.' ; <-- original line. //kt 8/8/2007
103//TX_NO_SOURCE = 'A source must be specified for Contract/Sharing/Research patients.'; <-- original line. //kt 8/8/2007
104//TX_NO_AGREE = 'There are no active agreements of the type specified.'; <-- original line. //kt 8/8/2007
105//TX_NO_AGREE_CAP = 'No Agreements on file'; <-- original line. //kt 8/8/2007
106//TX_ORD_LOC = 'Ordering location must be specified if patient type and order category do not match.'; <-- original line. //kt 8/8/2007
107//TC_REQ_LOC = 'Location Required'; <-- original line. //kt 8/8/2007
108//TX_LOC_ORDER = 'The selected location will be used to determine the ordering location ' + <-- original line. //kt 8/8/2007
109// 'when the patient location does not match the specified category.'; <-- original line. //kt 8/8/2007
110//TX_NO_CATEGORY = 'A category of examination must be specified.'; <-- original line. //kt 8/8/2007
111//TX_NO_IMAGING_LOCATION = 'A "Submit To" location must be specified.'; <-- original line. //kt 8/8/2007
112
113var
114 TX_NO_PROC : string; //kt
115 TX_NO_MODE : string; //kt
116 TX_NO_REASON : string; //kt
117 TX_NO_DATE : string; //kt
118 TX_APPROVAL_REQUIRED : string; //kt
119 TX_NO_SOURCE : string; //kt
120 TX_NO_AGREE : string; //kt
121 TX_NO_AGREE_CAP : string; //kt
122 TX_ORD_LOC : string; //kt
123 TC_REQ_LOC : string; //kt
124 TX_LOC_ORDER : string; //kt
125 TX_NO_CATEGORY : string; //kt
126 TX_NO_IMAGING_LOCATION : string; //kt
127
128
129procedure SetupVars;
130//kt Added entire function to replace constant declarations 8/8/2007
131begin
132 TX_NO_PROC := DKLangConstW('fODRad_An_Imaging_Procedure_must_be_specifiedx') ;
133 TX_NO_MODE := DKLangConstW('fODRad_A_mode_of_transport_must_be_selectedx');
134 TX_NO_REASON := DKLangConstW('fODRad_A_History_x_Reason_for_Exam_must_be_enteredx') ;
135 TX_NO_DATE := DKLangConstW('fODRad_Unable_to_evaluate_request_datex') ;
136 TX_APPROVAL_REQUIRED:= DKLangConstW('fODRad_This_procedure_requires_Radiologist_approvalx') ;
137 TX_NO_SOURCE := DKLangConstW('fODRad_A_source_must_be_specified_for_ContractxSharingxResearch_patientsx');
138 TX_NO_AGREE := DKLangConstW('fODRad_There_are_no_active_agreements_of_the_type_specifiedx');
139 TX_NO_AGREE_CAP := DKLangConstW('fODRad_No_Agreements_on_file');
140 TX_ORD_LOC := DKLangConstW('fODRad_Ordering_location_must_be_specified_if_patient_type_and_order_category_do_not_matchx');
141 TC_REQ_LOC := DKLangConstW('fODRad_Location_Required');
142 TX_LOC_ORDER := DKLangConstW('fODRad_The_selected_location_will_be_used_to_determine_the_ordering_location') +
143 DKLangConstW('fODRad_when_the_patient_location_does_not_match_the_specified_categoryx');
144 TX_NO_CATEGORY := DKLangConstW('fODRad_A_category_of_examination_must_be_specifiedx');
145 TX_NO_IMAGING_LOCATION := DKLangConstW('fODRad_A__xSubmit_Tox__location_must_be_specifiedx');
146end;
147
148var
149 Radiologist, Contract, Research: string ;
150 AName, IsPregnant: string;
151 ALocation, AType: integer;
152
153{ TfrmODBase common methods }
154
155procedure TfrmODRad.SetupDialog(OrderAction: Integer; const ID: string);
156var
157 tmpResp: TResponse;
158 i: integer;
159begin
160 SetupVars; //kt added 8/8/2007 to replace constants with vars.
161 SetupVars; //kt added 8/8/2007 to replace constants with vars.
162 inherited;
163 if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses do
164 begin
165 if (OrderAction = ORDER_QUICK) or (OrderAction = ORDER_EDIT) or (OrderAction = ORDER_COPY) then
166 FPredefineOrder := True;
167 FEditCopy := True;
168 Changing := True;
169 with cboImType do
170 begin
171 Items.Assign(SubsetOfImagingTypes);
172 for i := 0 to Items.Count-1 do
173 if StrToIntDef(Piece(Items[i],U,4), 0) = DisplayGroup then ItemIndex := i;
174 if OrderAction = ORDER_EDIT then
175 begin
176 Enabled := False;
177 Color := clBtnFace;
178 end;
179 end;
180 if Self.EvtID>0 then
181 FEvtDelayDiv := GetEventDiv1(IntToStr(Self.EvtID));
182 CtrlInits.LoadDefaults(ODForRad(Patient.DFN, FEvtDelayDiv, DisplayGroup)); // ODForRad returns TStrings with defaults
183 InitDialog;
184 SetControl(cboProcedure, 'ORDERABLE', 1);
185 Changing := True;
186 SetModifierList;
187 SetControl(cboUrgency, 'URGENCY', 1);
188 SetControl(cboTransport, 'MODE', 1);
189 SetControl(cboSubmit, 'IMLOC', 1);
190 SetControl(cboCategory, 'CLASS', 1);
191 SetControl(memReason, 'COMMENT', 1);
192 SetControl(chkIsolation, 'YN', 1);
193 SetControl(radPregnant, 'PREGNANT', 1);
194 SetControl(calPreOp, 'PREOP', 1);
195 tmpResp := FindResponseByName('START',1);
196 if tmpResp <> nil then
197 begin
198 if ContainsAlpha(tmpResp.IValue) then
199 calRequestDate.Text := tmpResp.IValue
200 else
201 calRequestDate.FMDateTime := StrToFMDateTime(tmpResp.IValue);
202 end;
203 tmpResp := FindResponseByName('PROVIDER',1);
204 if tmpResp <> nil then with tmpResp do if Length(EValue)>0 then Radiologist := IValue + '^' + EValue;
205 if (cboCategory.ItemID = 'C') or (cboCategory.ItemID = 'S') then
206 begin
207 tmpResp := FindResponseByName('CONTRACT',1);
208 if tmpResp <> nil then with tmpResp do
209 if Length(EValue)>0 then
210 begin
211 Contract := IValue + '^' + EValue;
212 Research := '';
213 end;
214 end;
215 if cboCategory.ItemID = 'R' then
216 begin
217 tmpResp := FindResponseByName('RESEARCH',1);
218 if tmpResp <> nil then with tmpResp do
219 if Length(EValue)>0 then
220 begin
221 Research := EValue;
222 Contract := '';
223 end;
224 end;
225 //hds00007460
226 tmpResp := FindResponseByName('PREGNANT',1);
227 if tmpResp <> nil then
228 if Length(tmpResp.EValue)>0 then
229 begin
230 IsPregnant := tmpResp.EValue;
231 if IsPregnant = 'YES' then
232 radPregnant.Checked := True
233 else
234 if IsPregnant = 'NO' then
235 radPregnantNo.Checked := True
236 else
237 if IsPregnant = 'UNKNOWN' then
238 radPregnantUnknown.Checked := True;
239 end;
240 //hds00007460
241 Changing := False;
242 FEditCopy := False;
243 OrderMessage(ImagingMessage(cboProcedure.ItemIEN)) ;
244 ControlChange(Self);
245 FPredefineOrder := False;
246 end;
247end;
248
249procedure TfrmODRad.InitDialog;
250var
251 i: integer;
252 tmplst: TStringList;
253begin
254 if not FEditCopy then inherited;
255
256 FPreOpDate := '';
257 FLastRadID := '';
258 Radiologist := '';
259 Contract := '';
260 Research := '';
261 ALocation := 0;
262 AName := '';
263 AType := 0;
264 FEvtDelayDiv := '';
265 if (Self.EvtID > 0 ) and (FEvtDelayDiv = '') then
266 FEvtDelayDiv := GetEventDiv1(IntToStr(Self.EvtID));
267 with CtrlInits do
268 begin
269// SetControl(cboProcedure, 'ShortList'); <-- original line. //kt 8/8/2007
270 SetControl(cboProcedure, DKLangConstW('fODRad_ShortList')); //kt added 8/8/2007
271 if cboProcedure.Items.Count > 0 then cboProcedure.InsertSeparator;
272// SetControl(FRadCommonCombo, 'Common Procedures'); <-- original line. //kt 8/8/2007
273 SetControl(FRadCommonCombo, DKLangConstW('fODRad_Common_Procedures')); //kt added 8/8/2007
274 for i := 0 to FRadCommonCombo.Items.Count-1 do
275 cboProcedure.Items.Add(FRadCommonCombo.Items[i]);
276 if FRadCommonCombo.Items.Count>0 then cboProcedure.InsertSeparator;
277
278 calRequestDate.Text := 'TODAY';
279// SetControl(cboAvailMod, 'Modifiers'); <-- original line. //kt 8/8/2007
280 SetControl(cboAvailMod, DKLangConstW('fODRad_Modifiers')); //kt added 8/8/2007
281// SetControl(cboUrgency, 'Urgencies'); <-- original line. //kt 8/8/2007
282 SetControl(cboUrgency, DKLangConstW('fODRad_Urgencies')); //kt added 8/8/2007
283// SetControl(cboTransport, 'Transport'); <-- original line. //kt 8/8/2007
284 SetControl(cboTransport, DKLangConstW('fODRad_Transport')); //kt added 8/8/2007
285 with cboTransport do if OrderForInpatient
286 then SelectByID('W')
287 else SelectByID('A');
288// SetControl(cboCategory, 'Category'); <-- original line. //kt 8/8/2007
289 SetControl(cboCategory, DKLangConstW('fODRad_Category')); //kt added 8/8/2007
290 with cboCategory do if OrderForInpatient
291 then SelectByID('I')
292 else SelectByID('O');
293// SetControl(cboSubmit, 'Submit to'); <-- original line. //kt 8/8/2007
294 SetControl(cboSubmit, DKLangConstW('fODRad_Submit_to')); //kt added 8/8/2007
295// SetControl(lblAskSubmit,'Ask Submit') ; <-- original line. //kt 8/8/2007
296 SetControl(lblAskSubmit,DKLangConstW('fODRad_Ask_Submit')) ; //kt added 8/8/2007
297 if (cboSubmit.Items.Count = 0) then
298 begin
299 cboSubmit.ItemIndex := -1;
300 lblSubmit.Enabled := False;
301 cboSubmit.Enabled := False;
302 cboSubmit.Font.Color := clGrayText;
303 end
304 else if (lblAskSubmit.Caption = 'YES') then
305 begin
306 if (cboSubmit.Items.Count > 1) then
307 begin
308 tmplst := TStringList.Create;
309 try
310 tmplst.Assign(cboSubmit.Items);
311 SortByPiece(tmplst, U, 2);
312 cboSubmit.Items.Assign(tmplst);
313 finally
314 tmplst.Free;
315 end;
316 cboSubmit.ItemIndex := -1 ;
317 lblSubmit.Enabled := True;
318 cboSubmit.Enabled := True;
319 cboSubmit.Font.Color := clWindowText;
320 end
321 else
322 begin
323 cboSubmit.ItemIndex := 0;
324 lblSubmit.Enabled := False;
325 cboSubmit.Enabled := False;
326 cboSubmit.Font.Color := clGrayText;
327 end;
328 end
329 else if lblAskSubmit.Caption = 'NO' then
330 begin
331 if (cboSubmit.Items.Count = 1) then
332 cboSubmit.ItemIndex := 0
333 else
334 cboSubmit.ItemIndex := -1 ;
335 lblSubmit.Enabled := False;
336 cboSubmit.Enabled := False;
337 cboSubmit.Font.Color := clGrayText;
338 end;
339 chkIsolation.Checked := PatientOnIsolationProcedures(Patient.DFN) ;
340// SetControl(lstLastExam, 'Last 7 Days'); <-- original line. //kt 8/8/2007
341 SetControl(lstLastExam, DKLangConstW('fODRad_Last_7_Days')); //kt added 8/8/2007
342 end;
343 lstSelectMod.Clear;
344 ControlChange(Self);
345//StatusText('Initializing Long List'); <-- original line. //kt 8/8/2007
346 StatusText(DKLangConstW('fODRad_Initializing_Long_List')); //kt added 8/8/2007
347 cboProcedure.InitLongList('') ;
348 StatusText('');
349end;
350
351procedure TfrmODRad.ControlChange(Sender: TObject);
352var
353 i: integer ;
354begin
355 inherited;
356 if Changing then Exit;
357 Responses.Clear;
358 with cboProcedure do
359 if ItemIEN > 0 then Responses.Update('ORDERABLE', 1, ItemID, Text)
360 else Responses.Update('ORDERABLE', 1, '' , '');
361 //with calRequestDate do if FMDateTime > 0 then RPC call on EVERY character typed in REASON box!!!! (v15)
362 with calRequestDate do if Length(Text) > 0 then
363 Responses.Update('START', 1, Text, Text)
364 else Responses.Update('START', 1, '', '') ;
365 with cboUrgency do if Length(ItemID) > 0 then Responses.Update('URGENCY', 1, ItemID, Text);
366 with cboTransport do if Length(ItemID) > 0 then Responses.Update('MODE', 1, ItemID, Text);
367 with cboCategory do if Length(ItemID) > 0 then Responses.Update('CLASS', 1, ItemID, Text);
368 with cboSubmit do if Length(ItemID) > 0 then Responses.Update('IMLOC', 1, ItemID, Text);
369//with radPregnant do if Checked then Responses.Update('PREGNANT', 1, 'Y' , 'Yes') <-- original line. //kt 8/8/2007
370 with radPregnant do if Checked then Responses.Update('PREGNANT', 1, 'Y' , DKLangConstW('fODRad_Yes')) //kt added 8/8/2007
371 else if not Enabled then Responses.Update('PREGNANT', 1, '' , '');
372 with radPregnantNo do if Checked then Responses.Update('PREGNANT', 1, 'N' , 'No');
373//with radPregnantUnknown do if Checked then Responses.Update('PREGNANT', 1, 'U' , 'Unknown'); <-- original line. //kt 8/8/2007
374 with radPregnantUnknown do if Checked then Responses.Update('PREGNANT', 1, 'U' , DKLangConstW('fODRad_Unknown')); //kt added 8/8/2007
375//with chkIsolation do if Checked then Responses.Update('YN', 1, '1' , 'Yes') <-- original line. //kt 8/8/2007
376 with chkIsolation do if Checked then Responses.Update('YN', 1, '1' , DKLangConstW('fODRad_Yes')) //kt added 8/8/2007
377 else Responses.Update('YN', 1, '0' , 'No');
378 with calPreOp do if Length(Text) > 0 then Responses.Update('PREOP', 1, FPreOpDate, Text);
379 with memReason do if GetTextLen > 0 then Responses.Update('COMMENT', 1, TX_WPTYPE, Text);
380 with lstSelectMod do for i := 0 to Items.Count - 1 do
381 Responses.Update('MODIFIER',i+1, Piece(Items[i],U,1), Piece(Items[i],U,2));
382 Responses.Update('PROVIDER',1, Piece(Radiologist,U,1),Piece(Radiologist,U,2)) ;
383 Responses.Update('CONTRACT',1, Piece(Contract,U,1),Piece(Contract,U,2)) ;
384 Responses.Update('RESEARCH',1, Research, Research) ;
385 if ALocation > 0 then Responses.Update('LOCATION', 1, IntToStr(ALocation), AName)
386 else with Encounter do Responses.Update('LOCATION', 1, IntToStr(Location) , LocationName);
387 memOrder.Text := Responses.OrderText;
388end;
389
390procedure TfrmODRad.Validate(var AnErrMsg: string);
391var
392 i, j: integer;
393 AskLoc: boolean;
394
395 procedure SetError(const x: string);
396 begin
397 if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
398 AnErrMsg := AnErrMsg + x;
399 end;
400
401 procedure GetOrderingLocation(AType: integer);
402 begin
403 ALocation := 0;
404 AName := '';
405 LookupLocation(ALocation, AName, AType, TX_LOC_ORDER);
406 if ALocation = 0 then
407 begin
408 SetError(TX_ORD_LOC);
409 if OrderForInpatient then cboCategory.SelectByID('I') else cboCategory.SelectByID('O');
410 with Encounter do Responses.Update('LOCATION', 1, IntToStr(Location) , LocationName);
411 end
412 else
413 Responses.Update('LOCATION', 1, IntToStr(ALocation), AName);
414 end;
415
416begin
417 SetupVars; //kt added 8/8/2007 to replace constants with vars.
418 inherited ;
419 with cboProcedure do
420 begin
421 if ((Length(Text) = 0) or (ItemIEN <= 0)) then SetError(TX_NO_PROC)
422 else
423 begin
424 if ItemID <> FLastRadID then Responses.Update('PROVIDER',1, '','');
425 if (UpperCase(Piece(Items[ItemIndex],U,4))='Y') and (Radiologist='') then
426 begin
427 SelectApprovingRadiologist(Font.Size, Radiologist);
428 if Radiologist='' then SetError(TX_APPROVAL_REQUIRED)
429 else
430 Responses.Update('PROVIDER',1, Piece(Radiologist,U,1),Piece(Radiologist,U,2)) ;
431 end ;
432 end ;
433 end;
434 with cboCategory do
435 begin
436 AskLoc := True;
437 if ((not Patient.Inpatient) and (Self.EvtType = 'A')) then
438 AskLoc := False;
439 if ItemID = '' then SetError(TX_NO_CATEGORY);
440 if (CharAt(ItemID,1) in ['C','S']) and (Contract = '') then SetError(TX_NO_SOURCE);
441 if (CharAt(ItemID, 1) = 'R') and (Research = '') then SetError(TX_NO_SOURCE);
442 if ((CharAt(ItemID, 1) = 'O') and (LocationType(Encounter.Location) = 'W')) then
443 begin
444 if AskLoc then
445 GetOrderingLocation(LOC_OUTP);
446 end
447 else if ((CharAt(ItemID, 1) = 'I') and (not (LocationType(Encounter.Location) = 'W'))) then
448 begin
449 if AskLoc then
450 GetOrderingLocation(LOC_INP);
451 end;
452 end;
453 if Length(cboTransport.Text) = 0 then SetError(TX_NO_MODE);
454
455 if Length(memReason.Text) < 2 then
456 SetError(TX_NO_REASON)
457 else
458 begin
459 j := 0;
460 for i := 1 to Length(memReason.Text) do
461 begin
462 if memReason.Text[i] in ['A'..'Z','a'..'z','0'..'9'] then j := j + 1;
463 if not (memReason.Text[i] in ['A'..'Z','a'..'z','0'..'9']) and (j > 0) then j := 0;
464 if j = 2 then break;
465 end;
466 if j < 2 then SetError(TX_NO_REASON);
467 end;
468
469 with cboSubmit do
470 if Enabled and (ItemIEN = 0)then SetError(TX_NO_IMAGING_LOCATION);
471
472 with calRequestDate do
473 if FMDateTime = 0 then SetError(TX_NO_DATE);
474
475end;
476
477procedure TfrmODRad.cboProcedureNeedData(Sender: TObject;
478 const StartFrom: string; Direction, InsertAt: Integer);
479
480begin
481 SetupVars; //kt added 8/8/2007 to replace constants with vars.
482 inherited ;
483 cboProcedure.ForDataUse(SubSetOfRadProcs(DisplayGroup, StartFrom, Direction));
484 end;
485
486procedure TfrmODRad.cboAvailModMouseClick(Sender: TObject);
487var
488 x: string;
489 i: integer;
490 Found: boolean;
491begin
492 if (cboAvailMod.Items.Count < 1) or //GE 04-30-05 prevent list index out of bounds when empty
493 (cboAvailMod.ItemIndex < 0) then Exit;
494 Found := False;
495 with cboAvailMod do x := Items[ItemIndex];
496 with lstSelectMod do
497 begin
498 if Items.Count > 0 then
499 for i := 0 to Items.Count - 1 do
500 if Items[i] = x then Found := True;
501 if not Found then
502 begin
503 Items.Add(x);
504 SelectByID(Piece(x, U, 1));
505 end;
506 end;
507 if Piece(x, '^', 2) = 'PORTABLE EXAM' then
508 cboTransport.SelectByID('P');
509 ControlChange(Sender);
510end;
511
512procedure TfrmODRad.cmdRemoveClick(Sender: TObject);
513begin
514 with lstSelectMod do
515 if (SelCount = 0) or (ItemIndex < 0) then exit
516 else
517 begin
518 if Piece(Items[ItemIndex], U, 2) = 'PORTABLE EXAM' then
519 with cboTransport do if OrderForInpatient
520 then SelectByID('W')
521 else SelectByID('A');
522 Items.Delete(ItemIndex);
523 ItemIndex := Items.Count - 1;
524 if ItemIndex > -1 then SelectByID(Piece(Items[ItemIndex], U, 1));
525 end ;
526 ControlChange(Sender);
527end;
528
529procedure TfrmODRad.cboProcedureSelect(Sender: TObject);
530var
531 tmpResp: TResponse;
532begin
533 inherited;
534 with cboProcedure do
535 begin
536 if ItemID <> FLastRadID then
537 begin
538 FLastRadID := ItemID;
539 if FPredefineOrder then
540 FPredefineOrder := False;
541 end else Exit;
542 Changing := True;
543 if Sender <> Self then
544 Responses.Clear; // Sender=Self when called from SetupDialog
545 ClearControl(lstSelectMod);
546 ClearControl(lstLastExam);
547 //ClearControl(memReason); {WPB-1298-30758}
548 Changing := False;
549 if CharAt(ItemID, 1) = 'Q' then
550 with Responses do
551 begin
552 QuickOrder := ExtractInteger(ItemID);
553 //SetControl(cboProcedure, 'ORDERABLE', 1); //v22.9 - RV
554 //SetModifierList; //v22.9 - RV
555 FLastRadID := ItemID;
556 end;
557 end;
558 with Responses do if QuickOrder > 0 then
559 begin
560 Changing := True;
561 SetControl(cboProcedure, 'ORDERABLE', 1);
562 SetModifierList; //v22.9 - RV
563 SetControl(lstSelectMod, 'MODIFIER', 1);
564 SetControl(cboUrgency, 'URGENCY', 1);
565 SetControl(cboSubmit, 'IMLOC', 1);
566 SetControl(cboTransport, 'MODE', 1);
567 SetControl(cboCategory, 'CLASS', 1);
568 SetControl(memReason, 'COMMENT', 1);
569 SetControl(chkIsolation, 'YN', 1);
570 SetControl(radPregnant, 'PREGNANT', 1);
571 SetControl(calPreOp , 'PREOP', 1);
572 tmpResp := FindResponseByName('START',1);
573 if tmpResp <> nil then
574 begin
575 if ContainsAlpha(tmpResp.IValue) then
576 calRequestDate.Text := tmpResp.IValue
577 else
578 calRequestDate.FMDateTime := StrToFMDateTime(tmpResp.IValue);
579 end;
580 Changing := False;
581 end;
582 OrderMessage(ImagingMessage(cboProcedure.ItemIEN)) ;
583 ControlChange(Self);
584end;
585
586procedure TfrmODRad.SetModifierList;
587var
588 i: integer;
589 tmpResp: TResponse;
590begin
591 i := 1;
592 tmpResp := Responses.FindResponseByName('MODIFIER',i);
593 while tmpResp <> nil do
594 begin
595 lstSelectMod.Items.Add(tmpResp.IValue + '^' + tmpResp.EValue);
596 if tmpResp.EValue = 'PORTABLE EXAM' then
597 with cboTransport do SelectByID('P');
598 Inc(i);
599 tmpResp := Responses.FindResponseByName('MODIFIER',i);
600 end ;
601end;
602
603procedure TfrmODRad.cboCategoryChange(Sender: TObject);
604var
605 Source: string;
606begin
607 SetupVars; //kt added 8/8/2007 to replace constants with vars.
608 inherited;
609 if Contract <> '' then Source := Contract
610 else if Research <> '' then Source := Research
611 else Source := '';
612 Contract := '';
613 Research := '';
614 with cboCategory do
615 begin
616 if CharAt(ItemID,1) in ['C','S','R'] then
617 begin
618 SelectSource(Font.Size, CharAt(ItemID,1), Source);
619 if Source = '-1' then
620 InfoBox(TX_NO_AGREE, TX_NO_AGREE_CAP, MB_OK or MB_ICONWARNING)
621 else if CharAt(ItemID,1) in ['C','S'] then
622 Contract := Source
623 else if ItemID='R' then
624 Research := Source;
625 end;
626 end;
627 ControlChange(Self);
628end;
629
630procedure TfrmODRad.FormCreate(Sender: TObject);
631begin
632 FFormFirstOpened := TRUE;
633 ImageTypeChanged := false;
634 frmFrame.pnlVisit.Enabled := false;
635 AutoSizeDisabled := True;
636 inherited;
637 memReason.Width := pnlHandR.ClientWidth;
638 memReason.Height := pnlHandR.ClientHeight - memReason.Top;
639 FillerID := 'RA'; // does 'on Display' order check **KCM**
640//StatusText('Loading Dialog Definition'); <-- original line. //kt 8/8/2007
641 StatusText(DKLangConstW('fODRad_Loading_Dialog_Definition')); //kt added 8/8/2007
642 Responses.Clear;
643 DisplayGroup := 0;
644 AllowQuickOrder := True;
645 Responses.Dialog := 'RA OERR EXAM'; // loads formatting info
646//StatusText('Loading Default Values'); <-- original line. //kt 8/8/2007
647 StatusText(DKLangConstW('fODRad_Loading_Default_Values')); //kt added 8/8/2007
648 cboImType.Items.Assign(SubsetOfImagingTypes);
649 if Self.EvtID>0 then
650 FEvtDelayDiv := GetEventDiv1(IntToStr(Self.EvtID));
651 PreserveControl(cboImType);
652 PreserveControl(calRequestDate);
653 PreserveControl(cboUrgency);
654 PreserveControl(cboTransport);
655 PreserveControl(cboSubmit);
656 PreserveControl(cboCategory);
657 PreserveControl(calPreOp);
658 PreserveControl(memReason); {WPB-1298-30758}
659 if (Patient.Sex <> 'F') then
660 begin
661 radPregnant.Enabled := False;
662 radPregnantNo.Enabled := False;
663 radPregnantUnknown.Enabled := False;
664 end else SetDefaultPregant;
665 FormMonitorBringToFrontEvent(Self, FormFirstOpened);
666end;
667
668{Assigned to cbolmType.OnDropDownClose and cbolmType.OnExit, instead of
669 cbolmType.OnChange, becuase when it is OnChange the delay interfers with
670 Window-Eyes ability to read the drop-down Items.}
671procedure TfrmODRad.cboImTypeChange(Sender: TObject);
672begin
673 inherited;
674 ImageTypeChanged := true;
675end;
676
677procedure TfrmODRad.memReasonExit(Sender: TObject);
678var
679 AStringList: TStringList;
680begin
681 inherited;
682 AStringList := TStringList.Create;
683 try
684 AStringList.Assign(memReason.Lines);
685 LimitStringLength(AStringList, 74);
686 memReason.Lines.Assign(AstringList);
687 ControlChange(Self);
688 finally
689 AStringList.Free;
690 end;
691end;
692
693procedure TfrmODRad.FormResize(Sender: TObject);
694begin
695 inherited;
696 memReason.Width := pnlHandR.ClientWidth;
697 memReason.Height := pnlHandR.ClientHeight - memReason.Top;
698end;
699
700procedure TfrmODRad.cboAvailModKeyDown(Sender: TObject; var Key: Word;
701 Shift: TShiftState);
702begin
703 inherited;
704 if Key = VK_RETURN then cboAvailModMouseClick(Self);
705end;
706
707procedure TfrmODRad.calPreOpChange(Sender: TObject);
708begin
709 inherited;
710 FPreOpDate := FloatToStr(calPreOp.FMDateTime);
711 ControlChange(Self);
712end;
713
714procedure TfrmODRad.SetDefaultPregant;
715begin
716 if (Patient.Sex = 'F') and ((Patient.Age > 55) or (Patient.Age < 12)) then
717 radPregnantNo.Checked := True;
718end;
719
720procedure TfrmODRad.cmdAcceptClick(Sender: TObject);
721//const
722//Txt1 = 'This order can not be saved for the following reason(s):'; <-- original line. //kt 8/8/2007
723//Txt2 = #13+#13+'A response for the pregnant field must be selected.'; <-- original line. //kt 8/8/2007
724var
725 NeedCheckPregnant: boolean;
726 Txt1 : string; //kt
727 Txt2 : string; //kt
728begin
729 Txt1 := DKLangConstW('fODRad_This_order_can_not_be_saved_for_the_following_reasonxsxx'); //kt added 8/8/2007
730 Txt2 := #13+#13+DKLangConstW('fODRad_A_response_for_the_pregnant_field_must_be_selectedx'); //kt added 8/8/2007
731 if Patient.Sex = 'F' then
732 begin
733 NeedCheckPregnant := True;
734 if radPregnant.Checked then NeedCheckPregnant := False
735 else if radPregnantNo.Checked then NeedCheckPregnant := False
736 else if radPregnantUnknown.Checked then NeedCheckPregnant := False;
737 if NeedCheckPregnant then
738 begin
739 MessageDlg(Txt1+Txt2, mtWarning,[mbOK],0);
740 Exit;
741 end;
742 end;
743 inherited;
744end;
745
746procedure TfrmODRad.cboProcedureExit(Sender: TObject);
747var
748 i: integer;
749 ModList: TStringList;
750begin
751 inherited;
752 ModList := TStringList.Create;
753 if lstSelectMod.Items.Count > 0 then
754 for i := 0 to lstSelectMod.Count - 1 do
755 ModList.Add(lstSelectMod.Items[i]);
756 cboProcedureSelect(Self);
757 for i := 0 to ModList.Count - 1 do
758 begin
759 lstSelectMod.Items.Add(ModList[i]);
760 lstSelectMod.SelectByID(Piece(ModList[i],U,1));
761 end;
762 with lstSelectMod do
763 for i := 0 to Items.Count - 1 do
764 Responses.Update('MODIFIER',i+1, Piece(Items[i],U,1), Piece(Items[i],U,2));
765end;
766
767
768procedure TfrmODRad.cboImTypeExit(Sender: TObject);
769begin
770 inherited;
771 ImageTypeChange;
772end;
773
774procedure TfrmODRad.FormClose(Sender: TObject; var Action: TCloseAction);
775begin
776 inherited;
777 frmFrame.pnlVisit.Enabled := true;
778 FormMonitorBringToFrontEvent(Self, nil);
779end;
780
781procedure TfrmODRad.chkIsolationExit(Sender: TObject);
782begin
783 inherited;
784 //Fix for CQ: 10025
785 if TabIsPressed() then
786 if NoPregnantSelection() then
787 if radPregnant.CanFocus then
788 radPregnant.SetFocus();
789end;
790
791procedure TfrmODRad.calPreOpExit(Sender: TObject);
792begin
793 inherited;
794 //Fix for CQ: 10025
795 if ShiftTabIsPressed() then
796 if NoPregnantSelection() then
797 if radPregnant.CanFocus then
798 radPregnant.SetFocus();
799end;
800
801function TfrmODRad.NoPregnantSelection : Boolean;
802begin
803 result := not ((radPregnant.Checked) or (radPregnantNo.Checked) or (radPregnantUnknown.Checked));
804end;
805
806procedure TfrmODRad.cboImTypeDropDownClose(Sender: TObject);
807begin
808 inherited;
809 ImageTypeChange;
810end;
811
812procedure TfrmODRad.ImageTypeChange;
813begin
814 if not ImageTypeChanged then Exit;
815 ImageTypeChanged := false;
816 if FPredefineOrder then
817 FPredefineOrder := False;
818 if Changing or (cboImtype.ItemIndex = -1) then exit;
819 with cboImType do DisplayGroup := StrToIntDef(Piece(Items[ItemIndex], U, 4), 0) ;
820 if DisplayGroup = 0 then exit;
821 CtrlInits.LoadDefaults(ODForRad(Patient.DFN, FEvtDelayDiv, DisplayGroup)); // ODForRad returns TStrings with defaults
822 FPredefineOrder := False;
823 InitDialog;
824end;
825
826procedure TfrmODRad.FormFirstOpened(Sender: TObject);
827begin
828 if(FFormFirstOpened) then
829 begin
830 FFormFirstOpened := FALSE;
831 with cboImType do
832 if not FEditCopy and (ItemIEN = 0) and (DroppedDown = False) and (Application.Active) then
833 begin
834 cboImType.DroppedDown := TRUE;
835 end;
836 end;
837end;
838
839end.
840
Note: See TracBrowser for help on using the repository browser.