source: cprs/branches/tmg-cprs/CPRS-Chart/Consults/fODConsult.pas@ 1742

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

Initial upload of TMG-CPRS 1.0.26.69

File size: 51.6 KB
RevLine 
[453]1//kt -- Modified with SourceScanner on 8/8/2007
2unit fODConsult;
3
4{$O-}
5
6interface
7
8uses
9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
10 fODBase, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, Buttons,
11 Menus, UBAGlobals, rOrders, fBALocalDiagnoses, UBAConst, UBACore, ORNet,
12 DKLang ;
13
14type
15 TfrmODCslt = class(TfrmODBase)
16 cboService: TORComboBox;
17 cboUrgency: TORComboBox;
18 cboPlace: TORComboBox;
19 txtProvDiag: TCaptionEdit;
20 txtAttn: TORComboBox;
21 lblService: TLabel;
22 lblUrgency: TStaticText;
23 lblPlace: TStaticText;
24 lblAttn: TStaticText;
25 lblProvDiag: TStaticText;
26 treService: TORTreeView;
27 cboCategory: TORComboBox;
28 pnlServiceTreeButton: TKeyClickPanel;
29 btnServiceTree: TSpeedButton;
30 mnuPopProvDx: TPopupMenu;
31 mnuPopProvDxDelete: TMenuItem;
32 cmdLexSearch: TButton;
33 popReason: TPopupMenu;
34 popReasonCut: TMenuItem;
35 popReasonCopy: TMenuItem;
36 popReasonPaste: TMenuItem;
37 popReasonPaste2: TMenuItem;
38 popReasonReformat: TMenuItem;
39 gbInptOpt: TGroupBox;
40 radInpatient: TRadioButton;
41 radOutpatient: TRadioButton;
42 pnlReason: TPanel;
43 lblReason: TLabel;
44 memReason: TRichEdit;
45 btnDiagnosis: TButton;
46 procedure FormCreate(Sender: TObject);
47 procedure txtAttnNeedData(Sender: TObject; const StartFrom: String;
48 Direction, InsertAt: Integer);
49 procedure radInpatientClick(Sender: TObject);
50 procedure radOutpatientClick(Sender: TObject);
51 procedure treServiceChange(Sender: TObject; Node: TTreeNode);
52 procedure ControlChange(Sender: TObject);
53 procedure treServiceExit(Sender: TObject);
54 procedure cmdAcceptClick(Sender: TObject);
55 procedure memReasonExit(Sender: TObject);
56 procedure cboServiceSelect(Sender: TObject);
57 procedure FormDestroy(Sender: TObject);
58 procedure btnServiceTreeClick(Sender: TObject);
59 procedure treServiceCollapsing(Sender: TObject; Node: TTreeNode;
60 var AllowCollapse: Boolean);
61 procedure treServiceMouseDown(Sender: TObject; Button: TMouseButton;
62 Shift: TShiftState; X, Y: Integer);
63 procedure cmdLexSearchClick(Sender: TObject);
64 procedure mnuPopProvDxDeleteClick(Sender: TObject);
65 procedure txtProvDiagChange(Sender: TObject);
66 procedure cboServiceExit(Sender: TObject);
67 procedure popReasonCutClick(Sender: TObject);
68 procedure popReasonCopyClick(Sender: TObject);
69 procedure popReasonPasteClick(Sender: TObject);
70 procedure popReasonPopup(Sender: TObject);
71 procedure popReasonReformatClick(Sender: TObject);
72 procedure pnlServiceTreeButtonEnter(Sender: TObject);
73 procedure pnlServiceTreeButtonExit(Sender: TObject);
74 procedure treServiceKeyDown(Sender: TObject; var Key: Word;
75 Shift: TShiftState);
76 procedure treServiceKeyUp(Sender: TObject; var Key: Word;
77 Shift: TShiftState);
78 procedure memReasonKeyUp(Sender: TObject; var Key: Word;
79 Shift: TShiftState);
80 procedure memReasonKeyDown(Sender: TObject; var Key: Word;
81 Shift: TShiftState);
82 procedure memReasonKeyPress(Sender: TObject; var Key: Char);
83 procedure cboServiceKeyDown(Sender: TObject; var Key: Word;
84 Shift: TShiftState);
85 procedure cboServiceKeyUp(Sender: TObject; var Key: Word;
86 Shift: TShiftState);
87 procedure btnDiagnosisClick(Sender: TObject);
88 procedure cmdQuitClick(Sender: TObject);
89 procedure FormClose(Sender: TObject; var Action: TCloseAction);
90
91 private
92 FcboServiceKeyDownStopClick : boolean;
93 FKeyBoarding: boolean;
94 FLastServiceID: string;
95 FEditCtrl: TCustomEdit;
96 FNavigatingTab: boolean;
97 procedure BuildQuickTree(QuickList: TStrings; const Parent: string; Node: TTreeNode);
98 procedure ReadServerVariables;
99 procedure SetProvDiagPromptingMode;
100 procedure SetupReasonForRequest(OrderAction: integer);
101 procedure GetProvDxandValidateCode(AResponses: TResponses);
102 function ShowPrerequisites: boolean;
103 procedure DoSetFontSize(FontSize: integer);
104 procedure SetUpQuickOrderDX;
105 procedure SaveConsultDxForNurse(pDiagnosis: string); // save the dx entered by nurese if Master BA switch is ON
106 procedure SetUpCopyConsultDiagnoses(pOrderID:string);
107 protected
108 procedure InitDialog; override;
109 procedure Validate(var AnErrMsg: string); override;
110 function DefaultReasonForRequest(Service: string; Resolve: Boolean): TStrings;
111
112 public
113 procedure SetupDialog(OrderAction: Integer; const ID: string); override;
114 procedure SetFontSize(FontSize: integer); override;
115 end;
116
117var
118 LastNode: integer ;
119 displayDXCode: string;
120 consultQuickOrder: boolean;
121
122
123implementation
124
125{$R *.DFM}
126
127uses
128 rODBase, rConsults, uCore, uConsults, rCore, fConsults, fPCELex, rPCE, fPreReq,
129 ORClasses, clipbrd, uTemplates, fFrame, uODBase;
130
131var
132 SvcList, QuickList, Defaults: TStrings ;
133 ProvDx: TProvisionalDiagnosis;
134 GMRCREAF: string;
135 BADxUpdated: boolean;
136 quickCode: string;
137
138//const
139//TX_NOTTHISSVC_TEXT = 'Consults cannot be ordered from this service' ; <-- original line. //kt 8/8/2007
140//TX_NO_SVC = 'A service must be specified.' ; <-- original line. //kt 8/8/2007
141//TX_NO_REASON = 'A reason for this consult must be entered.' ; <-- original line. //kt 8/8/2007
142//TX_SVC_ERROR = 'This service has not been defined in your Orderable Items file.' + <-- original line. //kt 8/8/2007
143// #13#10'Contact IRM for assistance.' ; <-- original line. //kt 8/8/2007
144//TX_NO_URGENCY = 'An urgency must be specified.'; <-- original line. //kt 8/8/2007
145//TX_NO_PLACE = 'A place of consultation must be specified'; <-- original line. //kt 8/8/2007
146//TX_NO_DIAG = 'A provisional diagnosis must be entered for consults to this service.'; <-- original line. //kt 8/8/2007
147//TX_SELECT_DIAG = 'You must select a diagnosis for consults to this service.'; <-- original line. //kt 8/8/2007
148//TX_GROUPER = 'This is not an orderable service. Please select a subspecialty'; <-- original line. //kt 8/8/2007
149//TC_INACTIVE_CODE = 'Inactive ICD Code'; <-- original line. //kt 8/8/2007
150//TX_INACTIVE_CODE1 = 'The provisional diagnosis code is not active as of today''s date.' + #13#10; <-- original line. //kt 8/8/2007
151//TX_INACTIVE_CODE_REQD = 'Another code must be selected before the order can be saved.'; <-- original line. //kt 8/8/2007
152//TX_INACTIVE_CODE_OPTIONAL = 'If another code is not selected, no code will be saved.'; <-- original line. //kt 8/8/2007
153
154var
155 TX_NOTTHISSVC_TEXT : string; //kt
156 TX_NO_SVC : string; //kt
157 TX_NO_REASON : string; //kt
158 TX_SVC_ERROR : string; //kt
159 TX_NO_URGENCY : string; //kt
160 TX_NO_PLACE : string; //kt
161 TX_NO_DIAG : string; //kt
162 TX_SELECT_DIAG : string; //kt
163 TX_GROUPER : string; //kt
164 TC_INACTIVE_CODE : string; //kt
165 TX_INACTIVE_CODE1 : string; //kt
166 TX_INACTIVE_CODE_REQD : string; //kt
167 TX_INACTIVE_CODE_OPTIONAL : string; //kt
168
169procedure SetupVars;
170//kt Added entire function to replace constant declarations 8/8/2007
171begin
172 TX_NOTTHISSVC_TEXT := DKLangConstW('fODConsult_Consults_cannot_be_ordered_from_this_service') ;
173 TX_NO_SVC := DKLangConstW('fODConsult_A_service_must_be_specifiedx') ;
174 TX_NO_REASON := DKLangConstW('fODConsult_A_reason_for_this_consult_must_be_enteredx') ;
175 TX_SVC_ERROR := DKLangConstW('fODConsult_This_service_has_not_been_defined_in_your_Orderable_Items_filex') +
176 #13#10 + DKLangConstW('fODConsult_Contact_IRM_for_assistancex') ;
177 TX_NO_URGENCY := DKLangConstW('fODConsult_An_urgency_must_be_specifiedx');
178 TX_NO_PLACE := DKLangConstW('fODConsult_A_place_of_consultation_must_be_specified');
179 TX_NO_DIAG := DKLangConstW('fODConsult_A_provisional_diagnosis_must_be_entered_for_consults_to_this_servicex');
180 TX_SELECT_DIAG := DKLangConstW('fODConsult_You_must_select_a_diagnosis_for_consults_to_this_servicex');
181 TX_GROUPER := DKLangConstW('fODConsult_This_is_not_an_orderable_servicex_Please_select_a_subspecialty');
182 TC_INACTIVE_CODE := DKLangConstW('fODConsult_Inactive_ICD_Code');
183 TX_INACTIVE_CODE1 := DKLangConstW('fODConsult_The_provisional_diagnosis_code_is_not_active_as_of_todayxxs_datex') + #13#10;
184 TX_INACTIVE_CODE_REQD := DKLangConstW('fODConsult_Another_code_must_be_selected_before_the_order_can_be_savedx');
185 TX_INACTIVE_CODE_OPTIONAL := DKLangConstW('fODConsult_If_another_code_is_not_selectedx_no_code_will_be_savedx');
186end;
187
188procedure TfrmODCslt.FormCreate(Sender: TObject);
189begin
190 frmFrame.pnlVisit.Enabled := false;
191 AutoSizeDisabled := True;
192 inherited;
193 if BILLING_AWARE then
194 begin
195 btnDiagnosis.Visible := True;
196 cmdLexSearch.Visible := False;
197 end
198 else
199 begin
200 btnDiagnosis.Visible := False;
201 cmdLexSearch.Visible := True;
202 end;
203 Defaults := TStringList.Create ;
204 SvcList := TStringList.Create ;
205 QuickList := TStringList.Create ;
206 AllowQuickOrder := True;
207 LastNode := 0;
208 FLastServiceID := '' ;
209 GMRCREAF := '';
210 FillChar(ProvDx, SizeOf(ProvDx), 0);
211 FillerID := 'GMRC'; // does 'on Display' order check **KCM**
212//StatusText('Loading Dialog Definition'); <-- original line. //kt 8/8/2007
213 StatusText(DKLangConstW('fODConsult_Loading_Dialog_Definition')); //kt added 8/8/2007
214 Responses.Dialog := 'GMRCOR CONSULT'; // loads formatting info
215//StatusText('Loading Default Values'); <-- original line. //kt 8/8/2007
216 StatusText(DKLangConstW('fODConsult_Loading_Default_Values')); //kt added 8/8/2007
217 Defaults.Assign(ODForConsults); // ODForConsults returns TStrings with defaults
218 CtrlInits.LoadDefaults(Defaults);
219 txtAttn.InitLongList('') ;
220 PreserveControl(txtAttn);
221 InitDialog;
222 //Calling virtual SetFontSize in constructor is a bad idea!
223 DoSetFontSize( MainFontSize);
224 FcboServiceKeyDownStopClick := false;
225 consultQuickOrder := false;
226
227
228end;
229
230procedure TfrmODCslt.InitDialog;
231begin
232 inherited;
233 Changing := True;
234 FLastServiceID := '';
235 QuickList.Clear;
236 with CtrlInits do
237 begin
238// ExtractItems(QuickList, Defaults, 'ShortList'); <-- original line. //kt 8/8/2007
239 ExtractItems(QuickList, Defaults, DKLangConstW('fODConsult_ShortList')); //kt added 8/8/2007
240 if OrderForInpatient then //INPATIENT CONSULT
241 begin
242 radInpatient.Checked := True;
243 cboCategory.Items.Clear;
244 cboCategory.Items.Add('I^Inpatient');
245 cboCategory.SelectById('I');
246 SetControl(cboPlace, 'Inpt Place');
247 SetControl(cboUrgency, 'Inpt Cslt Urgencies'); //S.GMRCT
248 end
249 else
250 begin
251 radOutpatient.Checked := True; //OUTPATIENT CONSULT
252 cboCategory.Items.Clear;
253 cboCategory.Items.Add('O^Outpatient');
254 cboCategory.SelectById('O');
255 SetControl(cboPlace, 'Outpt Place');
256 SetControl(cboUrgency, 'Outpt Urgencies'); //S.GMRCO
257 end ;
258 end ;
259//StatusText('Initializing Long List'); <-- original line. //kt 8/8/2007
260 StatusText(DKLangConstW('fODConsult_Initializing_Long_List')); //kt added 8/8/2007
261 memOrder.Clear ;
262 memReason.Clear;
263 cboService.Enabled := True;
264 cboService.Font.Color := clWindowText;
265 cboService.Height := 25 + (7 * cboService.ItemHeight);
266 btnServiceTree.Enabled := True;
267 pnlServiceTreeButton.Enabled := True;
268 ActiveControl := cboService;
269 SetProvDiagPromptingMode;
270 Changing := False;
271 StatusText('');
272end;
273
274procedure TfrmODCslt.SetupDialog(OrderAction: Integer; const ID: string);
275//const
276//TX_INACTIVE_SVC = 'This consult service is currently inactive and not receiving requests.' + CRLF + <-- original line. //kt 8/8/2007
277// 'Please contact your Clinical Coordinator/IRM staff to fix this order.'; <-- original line. //kt 8/8/2007
278//TX_INACTIVE_SVC_CAP = 'Inactive Service'; <-- original line. //kt 8/8/2007
279var
280 i:integer;
281 AList: TStringList;
282 tmpResp: TResponse;
283 SvcIEN: string;
284 TX_INACTIVE_SVC : string; //kt
285 TX_INACTIVE_SVC_CAP : string; //kt
286begin
287 TX_INACTIVE_SVC := DKLangConstW('fODConsult_This_consult_service_is_currently_inactive_and_not_receiving_requestsx') + CRLF + //kt added 8/8/2007
288 DKLangConstW('fODConsult_Please_contact_your_Clinical_CoordinatorxIRM_staff_to_fix_this_orderx'); //kt added 8/8/2007
289 TX_INACTIVE_SVC_CAP := DKLangConstW('fODConsult_Inactive_Service'); //kt added 8/8/2007
290 inherited;
291 ReadServerVariables;
292 AList := TStringList.Create;
293 try
294 if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses do
295 begin
296 Changing := True;
297 tmpResp := TResponse(FindResponseByName('ORDERABLE',1));
298 SvcIEN := GetServiceIEN(tmpResp.IValue);
299 if SvcIEN = '-1' then
300 begin
301 InfoBox(TX_INACTIVE_SVC, TX_INACTIVE_SVC_CAP, MB_OK);
302 AbortOrder := True;
303 Close;
304 Exit;
305 end;
306 cboService.Items.Add(SvcIEN + U + tmpResp.EValue + '^^^^' + tmpResp.IValue);
307 cboService.SelectByID(SvcIEN);
308 tmpResp := TResponse(FindResponseByName('CLASS',1));
309 cboCategory.SelectByID(tmpResp.IValue);
310 if tmpResp.IValue = 'I' then
311 radInpatient.Checked := True
312 else
313 radOutpatient.Checked := True ;
314 SetControl(cboUrgency, 'URGENCY', 1);
315 SetControl(cboPlace, 'PLACE', 1);
316 SetControl(txtAttn, 'PROVIDER', 1);
317 cboService.Enabled := False;
318 cboService.Font.Color := clGrayText;
319 btnServiceTree.Enabled := False;
320 pnlServiceTreeButton.Enabled := False;
321 if (OrderAction in [ORDER_COPY, ORDER_QUICK]) and (not ShowPrerequisites) then
322 begin
323 Close;
324 Exit;
325 end;
326 SetProvDiagPromptingMode;
327 GetProvDxandValidateCode(Responses);
328 SetControl(memReason, 'COMMENT', 1);
329 SetupReasonForRequest(OrderAction);
330 Changing := False;
331 ControlChange(Self);
332 end
333 else
334 begin
335 if QuickList.Count > 0 then BuildQuickTree(QuickList, '0', nil) ;
336 SvcList.Assign(LoadServiceListWithSynonyms(CN_SVC_LIST_ORD)); {RV}
337 AList.Assign(SvcList);
338 SortByPiece(AList, U, 2);
339 BuildServiceTree(treService, SvcList, '0', nil) ;
340 with treService do
341 begin
342 for i:=0 to Items.Count-1 do
343 if Items[i].Level > 0 then Items[i].Expanded := False else Items[i].Expanded := True;
344 TopItem := Items[LastNode] ;
345 Changing := True;
346 Selected := Items[LastNode] ;
347 Changing := False;
348 SendMessage(Handle, WM_HSCROLL, SB_THUMBTRACK, 0);
349 end ;
350 if QuickList.Count > 0 then with cboService do
351 begin
352 Items.Assign(QuickList);
353 Items.Add(LLS_LINE);
354 Items.Add(LLS_SPACE);
355 end;
356 Changing := True;
357 for i := 0 to AList.Count - 1 do
358 if (cboService.Items.IndexOf(Trim(Piece(AList.Strings[i], U, 2))) = -1) and {RV}
359 //if (cboService.SelectByID(Piece(AList.Strings[i], U, 1)) = -1) and
360 (Piece(AList.Strings[i], U, 5) <> '1') then
361 cboService.Items.Add(AList.Strings[i]);
362 cboService.ItemIndex := 0;
363 Changing := False;
364 if treService.Selected <> nil then
365 begin
366 if (TORTreeNode(treService.Selected).StringData <> '') and
367 (Piece(TORTreeNode(treService.Selected).StringData, U, 5) <> '1') then
368 cboService.ItemIndex := cboService.Items.IndexOf(Trim(Piece(TORTreeNode(treService.Selected).StringData, U, 2)))
369 //cboService.SelectByID(Piece(string(treService.Selected.Data), U, 1))
370 else
371 cboService.ItemIndex := -1;
372 end
373 else
374 cboService.ItemIndex := -1;
375 if cboService.ItemIEN > 0 then
376 begin
377 if not ShowPrerequisites then
378 begin
379 Close;
380 Exit;
381 end;
382 memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True));
383 end;
384 PreserveControl(treService);
385 PreserveControl(cboService);
386 end;
387 finally
388 AList.Free;
389 end;
390end;
391
392procedure TfrmODCslt.Validate(var AnErrMsg: string);
393
394 procedure SetError(const x: string);
395 begin
396 if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
397 AnErrMsg := AnErrMsg + x;
398 end;
399
400begin
401 SetupVars; //kt added 8/8/2007 to replace constants with vars.
402 inherited;
403 if (not ContainsVisibleChar(memReason.Text)) then SetError(TX_NO_REASON);
404 if cboUrgency.ItemIEN = 0 then SetError(TX_NO_URGENCY);
405 if cboPlace.ItemID = '' then SetError(TX_NO_PLACE);
406 if cboService.ItemIEN = 0 then
407 SetError(TX_NO_SVC)
408 else
409 begin
410 if Piece(cboService.Items[cboService.ItemIndex],U,5) = '1' then SetError(TX_NOTTHISSVC_TEXT);
411 if (Piece(cboService.Items[cboService.ItemIndex],U,5) <> '1')
412 and (Piece(cboService.Items[cboService.ItemIndex],U,6) = '')
413 then SetError(TX_SVC_ERROR) ;
414 end;
415 if (ProvDx.Reqd = 'R') and (not ContainsVisibleChar(txtProvDiag.Text)) then
416 begin
417 if ProvDx.PromptMode = 'F' then
418 SetError(TX_NO_DIAG)
419 else
420 SetError(TX_SELECT_DIAG);
421 end;
422end;
423
424procedure TfrmODCslt.txtAttnNeedData(Sender: TObject;
425 const StartFrom: string; Direction, InsertAt: Integer);
426begin
427 inherited;
428 txtAttn.ForDataUse(SubSetOfPersons(StartFrom, Direction));
429end;
430
431procedure TfrmODCslt.radInpatientClick(Sender: TObject);
432begin
433 inherited;
434 with CtrlInits do
435 begin
436 SetControl(cboPlace, 'Inpt Place');
437 SetControl(cboUrgency, 'Inpt Cslt Urgencies');
438 cboCategory.Items.Clear;
439 cboCategory.Items.Add('I^Inpatient') ;
440 cboCategory.SelectById('I');
441 end ;
442 ControlChange(Self);
443end;
444
445procedure TfrmODCslt.radOutpatientClick(Sender: TObject);
446begin
447 inherited;
448 with CtrlInits do
449 begin
450 SetControl(cboPlace, 'Outpt Place');
451 SetControl(cboUrgency, 'Outpt Urgencies');
452 cboCategory.Items.Clear;
453 cboCategory.Items.Add('O^Outpatient');
454 cboCategory.SelectById('O');
455 end ;
456 ControlChange(Self);
457end;
458
459procedure TfrmODCslt.BuildQuickTree(QuickList: TStrings; const Parent: string; Node: TTreeNode);
460var
461 i: Integer;
462 QuickInfo, Name: string ;
463 ANode: TTreeNode;
464begin
465 with QuickList do
466 begin
467// Node := treService.Items.AddChildObject(Node, 'Quick Orders', nil); <-- original line. //kt 8/8/2007
468 Node := treService.Items.AddChildObject(Node, DKLangConstW('fODConsult_Quick_Orders'), nil); //kt added 8/8/2007
469 for i := 0 to Count - 1 do
470 begin
471 Name := Piece(Strings[i], U, 2);
472 QuickInfo := Strings[i];
473 ANode := treService.Items.AddChildObject(Node, Name, Pointer(QuickInfo));
474 TORTreeNode(ANode).StringData := QuickInfo;
475 end;
476 end;
477end;
478
479procedure TfrmODCslt.treServiceChange(Sender: TObject; Node: TTreeNode);
480var
481 i: integer;
482 tmpSvc: string;
483begin
484 SetupVars; //kt added 8/8/2007 to replace constants with vars.
485 inherited;
486 pnlMessage.Visible := False;
487 if Changing or (treService.Selected = nil)
488 or FKeyBoarding or FcboServiceKeyDownStopClick then exit;
489 Changing := True;
490 with cboService do
491 begin
492 if treService.Selected <> nil then
493 begin
494 if (TORTreeNode(treService.Selected).StringData <> '') and
495 (Piece(TORTreeNode(treService.Selected).StringData, U, 5) <> '1') then
496 cboService.ItemIndex := cboService.Items.IndexOf(Trim(Piece(TORTreeNode(treService.Selected).StringData, U, 2)))
497 //cboService.SelectByID(Piece(string(treService.Selected.Data), U, 1))
498 else
499 begin
500 pnlMessage.TabOrder := treService.TabOrder + 1;
501 OrderMessage(TX_GROUPER);
502 cboService.ItemIndex := -1;
503 Changing := False;
504 Exit;
505 end;
506 end
507 else
508 ItemIndex := -1;
509(* if (treService.Selected.Data <> nil) then
510 SelectByID(Piece(string(treService.Selected.Data), U, 1))
511 else
512 ItemIndex := -1;*)
513 Changing := False;
514 if ItemIndex < 0 then exit;
515 if Piece(Items[ItemIndex],U,5) = '1' then
516 begin
517 Responses.Update('ORDERABLE', 1, '', '');
518 memOrder.Clear;
519 cboService.ItemIndex := -1;
520 FLastServiceID := '';
521 Changing := True;
522 treService.Selected := nil;
523 Changing := False;
524 pnlMessage.TabOrder := treService.TabOrder + 1;
525 OrderMessage(TX_GROUPER);
526 Exit;
527 end;
528 treService.Visible := False;
529 memReason.Clear;
530 if ItemID <> FLastServiceID then FLastServiceID := ItemID else Exit;
531 Changing := True;
532 if Sender <> Self then
533 Responses.Clear; // Sender=Self when called from SetupDialog
534 Changing := False;
535 if CharAt(ItemID, 1) = 'Q' then
536 begin
537 Changing := True;
538 consultQuickOrder := True;
539 Responses.QuickOrder := ExtractInteger(ItemID);
540 tmpSvc := TResponse(Responses.FindResponseByName('ORDERABLE',1)).IValue;
541 with treService do for i := 0 to Items.Count-1 do
542 begin
543 if Piece(TORTreeNode(Items[i]).StringData, U, 6) = tmpSvc then
544 begin
545 Selected := Items[i];
546 break;
547 end;
548 end;
549 if treService.Selected <> nil then
550 begin
551 if (TORTreeNode(treService.Selected).StringData <> '') and
552 (Piece(TORTreeNode(treService.Selected).StringData, U, 5) <> '1') then
553 cboService.ItemIndex := cboService.Items.IndexOf(Trim(Piece(TORTreeNode(treService.Selected).StringData, U, 2)))
554 //cboService.SelectByID(Piece(string(treService.Selected.Data), U, 1))
555 else
556 cboService.ItemIndex := -1;
557 end
558 else
559 cboService.ItemIndex := -1;
560 FLastServiceID := ItemID;
561 cboService.Enabled := False;
562 cboService.Font.Color := clGrayText;
563 btnServiceTree.Enabled := False;
564 pnlServiceTreeButton.Enabled := False;
565 Changing := False;
566 end;
567 end;
568 with Responses do if QuickOrder > 0 then
569 begin
570 tmpSvc := TResponse(Responses.FindResponseByName('ORDERABLE',1)).IValue;
571 with treService do for i := 0 to Items.Count-1 do
572 begin
573 if Piece(TORTreeNode(Items[i]).StringData, U, 6) = tmpSvc then
574 begin
575 Selected := Items[i];
576 break;
577 end;
578 end;
579 if treService.Selected <> nil then
580 begin
581 if (TORTreeNode(treService.Selected).StringData <> '') and
582 (Piece(TORTreeNode(treService.Selected).StringData, U, 5) <> '1') then
583 cboService.ItemIndex := cboService.Items.IndexOf(Trim(Piece(TORTreeNode(treService.Selected).StringData, U, 2)))
584 //cboService.SelectByID(Piece(string(treService.Selected.Data), U, 1))
585 else
586 cboService.ItemIndex := -1;
587 end
588 else
589 cboService.ItemIndex := -1;
590 Changing := True;
591 if not ShowPrerequisites then
592 begin
593 Close;
594 Exit;
595 end;
596 SetControl(cboCategory, 'CLASS', 1);
597 if cboCategory.ItemID = 'I' then radInpatient.Checked := True
598 else radOutpatient.Checked := True ;
599 SetControl(cboUrgency, 'URGENCY', 1);
600 SetControl(cboPlace, 'PLACE', 1);
601 SetControl(txtAttn, 'PROVIDER', 1);
602 SetControl(memReason, 'COMMENT', 1);
603 if ((cboService.ItemIEN > 0) and (Length(memReason.Text) = 0)) then
604 memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True));
605 SetupReasonForRequest(ORDER_QUICK);
606 GetProvDxandValidateCode(Responses);
607 Changing := False;
608 end
609 else
610 begin
611 if cboService.ItemIEN > 0 then
612 begin
613 if not ShowPrerequisites then
614 begin
615 Close;
616 Exit;
617 end;
618 memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True));
619 SetupReasonForRequest(ORDER_NEW);
620 end;
621 end;
622 SetProvDiagPromptingMode;
623 tmpSvc := Piece(cboService.Items[cboService.ItemIndex], U, 6);
624 pnlMessage.TabOrder := treService.TabOrder + 1;
625 OrderMessage(ConsultMessage(StrToIntDef(tmpSvc, 0)));
626 //OrderMessage(ConsultMessage(cboService.ItemIEN));
627 ControlChange(Self) ;
628end;
629
630procedure TfrmODCslt.ControlChange(Sender: TObject);
631var
632 x: string;
633 i: integer;
634begin
635 inherited;
636 if Changing or (cboService.ItemIEN = 0) then Exit;
637 with cboService do
638 begin
639 if (ItemIEN > 0) and (Piece(Items[ItemIndex], U, 5) <> '1') then
640 begin
641 i := Pos('<', Text);
642 if i > 0 then
643 begin
644 x := Piece(Copy(Text, i + 1, 99), '>', 1);
645 x := UpperCase(Copy(x, 1, 1)) + Copy(x, 2, 99);
646 end
647 else
648 x := Text;
649 Responses.Update('ORDERABLE', 1, Piece(Items[ItemIndex], U, 6), x);
650 end
651 else Responses.Update('ORDERABLE', 1, '', '');
652 end;
653 with memReason do if GetTextLen > 0 then Responses.Update('COMMENT', 1, TX_WPTYPE, Text);
654 with cboCategory do if ItemID <> '' then Responses.Update('CLASS', 1, ItemID, Text);
655 with cboUrgency do if ItemIEN > 0 then Responses.Update('URGENCY', 1, ItemID, Text);
656 with cboPlace do if ItemID <> '' then Responses.Update('PLACE', 1, ItemID, Text);
657 with txtAttn do if ItemIEN > 0 then Responses.Update('PROVIDER', 1, ItemID, Text);
658 //with txtProvDiag do if Length(Text) > 0 then Responses.Update('MISC', 1, Text, Text);
659 if Length(ProvDx.Text) > 0 then Responses.Update('MISC', 1, ProvDx.Text, ProvDx.Text)
660 else Responses.Update('MISC', 1, '', '');
661 if Length(ProvDx.Code) > 0 then Responses.Update('CODE', 1, ProvDx.Code, ProvDx.Code)
662 else Responses.Update('CODE', 1, '', '');
663
664 memOrder.Text := Responses.OrderText;
665end;
666
667procedure TfrmODCslt.treServiceExit(Sender: TObject);
668begin
669 inherited;
670 with cboService do
671 begin
672 if ItemIEN > 0 then
673 begin
674 pnlMessage.TabOrder := treService.TabOrder + 1;
675 OrderMessage(ConsultMessage(StrToInt(Piece(Items[ItemIndex],U,6))));
676 end;
677 end;
678end;
679
680procedure TfrmODCslt.SetUpQuickOrderDX;
681// this procedure is called if the user selects a quick code from the list
682// and accepts the order without entering or selection the diagnoses button.
683begin
684 quickCode := ProvDx.Code;
685 if UBACore.IsICD9CodeActive(quickCode,'ICD',0) then
686 begin
687 uBAGlobals.BAConsultDxList.Clear;
688 uBAGlobals.BAConsultDxList.Add(UBAConst.PRIMARY_DX + U + ProvDx.Text + ':' + quickCode);
689 end;
690
691end;
692
693procedure TfrmODCslt.cmdAcceptClick(Sender: TObject);
694var
695 BADiagnosis: string;
696 begin
697 inherited;
698 if treService.Selected <> nil then
699 LastNode := treService.Selected.AbsoluteIndex;
700
701 if BILLING_AWARE and CIDCOkToSave then
702 begin
703 if btnDiagnosis.Enabled then
704 if consultQuickOrder then SetUpQuickOrderDX;
705 if UBAGlobals.BAConsultDxList.Count > 0 then
706 begin
707 uBACore.CompleteConsultOrderRec(uBAGlobals.BAOrderID,UBAGlobals.BAConsultDxList);
708 uBAGlobals.BAConsultDxList.Clear;
709 end;
710 BADiagnosis := ProvDx.Text + '^' + ProvDx.Code;
711 end;
712
713 if NOT BILLING_AWARE then
714 begin
715 // this will save a dx entered by a nurse to be reviewed by a provided.
716 // this is active if CIDC MASTER SWITCH is ON.
717 if rpcGetBAMasterSwStatus then // BA master sw is on.
718 if (uCore.User.OrderRole = OR_NURSE) then // user is a nurse
719 begin
720 if ProvDx.Text <> '' then // consult dx has been selected
721 begin
722 SaveConsultDxForNurse(ProvDx.Text + ProvDx.Code); // save selected dx, will be displayed to Provider
723 end;
724 end;
725 end;
726end;
727
728procedure TfrmODCslt.memReasonExit(Sender: TObject);
729var
730 AStringList: TStringList;
731begin
732 inherited;
733 AStringList := TStringList.Create;
734 try
735 AStringList.Assign(memReason.Lines);
736 LimitStringLength(AStringList, 74);
737 memReason.Lines.Assign(AstringList);
738 ControlChange(Self);
739 finally
740 AStringList.Free;
741 end;
742end;
743
744procedure TfrmODCslt.cboServiceSelect(Sender: TObject);
745var
746 tmpSvc: string;
747begin
748 SetupVars; //kt added 8/8/2007 to replace constants with vars.
749 if FcboServiceKeyDownStopClick then
750 begin
751 Exit; //This fixes clearquest: HDS00001418
752 FcboServiceKeyDownStopClick := false;
753 end;
754 memReason.Clear;
755 with cboService do
756 begin
757 if (ItemIndex < 0) or (ItemID = '') then
758 begin
759 Responses.Update('ORDERABLE', 1, '', '');
760 memOrder.Clear;
761 FLastServiceID := '';
762 exit;
763 end;
764 if Piece(Items[ItemIndex],U,5) = '1' then
765 begin
766 Responses.Update('ORDERABLE', 1, '', '');
767 memOrder.Clear;
768 FLastServiceID := '';
769 pnlMessage.TabOrder := cboService.TabOrder + 1;
770 OrderMessage(TX_GROUPER);
771 Exit;
772 end;
773 FLastServiceID := ItemID;
774 if CharAt(ItemID, 1) = 'Q' then
775 begin
776 Changing := True;
777 Responses.QuickOrder := ExtractInteger(ItemID);
778 consultQuickOrder := True;
779 tmpSvc := TResponse(Responses.FindResponseByName('ORDERABLE',1)).EValue;
780 ItemIndex := Items.IndexOf(Trim(tmpSvc));
781(* tmpSvc := TResponse(Responses.FindResponseByName('ORDERABLE',1)).IValue;
782 for i := 0 to Items.Count-1 do
783 begin
784 if Piece(Items[i],U,6) = tmpSvc then
785 begin
786 ItemIndex := i;
787 break;
788 end;
789 end;*)
790 FLastServiceID := ItemID;
791 Enabled := False;
792 Font.Color := clGrayText;
793 btnServiceTree.Enabled := False;
794 pnlServiceTreeButton.Enabled := False;
795 Changing := False;
796 with Responses do if QuickOrder > 0 then
797 begin
798 Changing := True;
799 if not ShowPrerequisites then
800 begin
801 Close;
802 Exit;
803 end;
804 SetControl(cboCategory, 'CLASS', 1);
805 if cboCategory.ItemID = 'I' then radInpatient.Checked := True
806 else radOutpatient.Checked := True ;
807 SetControl(cboUrgency, 'URGENCY', 1);
808 SetControl(cboPlace, 'PLACE', 1);
809 SetControl(txtAttn, 'PROVIDER', 1);
810 SetControl(memReason, 'COMMENT', 1);
811// if ((cboService.ItemIEN > 0) and (Length(memReason.Text) = 0)) then
812// memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True));
813 SetupReasonForRequest(ORDER_QUICK);
814 GetProvDxandValidateCode(Responses);
815 Changing := False;
816 end
817 else
818 begin
819 if cboService.ItemIEN > 0 then
820 begin
821 Changing := True;
822 if not ShowPrerequisites then
823 begin
824 Close;
825 Exit;
826 end;
827 memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True));
828 SetupReasonForRequest(ORDER_NEW);
829 Changing := False;
830 end;
831 end;
832 end
833 else
834 begin
835 Changing := True;
836 if not ShowPrerequisites then
837 begin
838 Close;
839 Exit;
840 end;
841 QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason);
842 SetupReasonForRequest(ORDER_NEW);
843 Changing := False;
844 end;
845 end;
846 treService.Visible := False;
847 SetProvDiagPromptingMode;
848 tmpSvc := Piece(cboService.Items[cboService.ItemIndex], U, 6);
849 pnlMessage.TabOrder := cboService.TabOrder + 1;
850 OrderMessage(ConsultMessage(StrToIntDef(tmpSvc, 0)));
851 //OrderMessage(ConsultMessage(cboService.ItemIEN));
852 ControlChange(Self) ;
853end;
854
855procedure TfrmODCslt.FormDestroy(Sender: TObject);
856begin
857 Defaults.Free;
858 SvcList.Free ;
859 QuickList.Free;
860 inherited;
861end;
862
863procedure TfrmODCslt.btnServiceTreeClick(Sender: TObject);
864var
865 i: integer;
866begin
867 inherited;
868 Changing := True;
869 treService.Visible := not treService.Visible;
870 if treService.Visible then
871 begin
872 treService.SetFocus;
873 with treService do for i := 0 to Items.Count-1 do
874 begin
875 if Piece(TORTreeNode(Items[i]).StringData, U, 1) = cboService.ItemID then
876 begin
877 Selected := Items[i];
878 if Piece(TORTreeNode(Items[i]).StringData, U, 5) = '1' then Selected.Expand(True);
879 break;
880 end;
881 end;
882 end;
883 Changing := False;
884end;
885
886procedure TfrmODCslt.ReadServerVariables;
887begin
888 if StrToIntDef(KeyVariable['GMRCNOAT'], 0) > 0 then
889 begin
890 txtAttn.Enabled := False;
891 txtAttn.Font.Color := clGrayText;
892 lblAttn.Enabled := False;
893 txtAttn.Color := clBtnFace;
894 end
895 else
896 begin
897 txtAttn.Enabled := True;
898 txtAttn.Font.Color := clWindowText;
899 lblAttn.Enabled := True;
900 txtAttn.Color := clWindow;
901 end;
902
903 if StrToIntDef(KeyVariable['GMRCNOPD'], 0) > 0 then
904 begin
905 if BILLING_AWARE then
906 btnDiagnosis.Enabled := False //1.4.18
907 else
908 cmdLexSearch.Enabled := False;
909 txtProvDiag.Enabled := False;
910 txtProvDiag.Font.Color := clGrayText;
911 lblProvDiag.Enabled := False;
912 txtProvDiag.ReadOnly := True;
913 txtProvDiag.Color := clBtnFace;
914 end
915 else SetProvDiagPromptingMode;
916
917 GMRCREAF := KeyVariable['GMRCREAF'];
918end;
919
920procedure TfrmODCslt.treServiceCollapsing(Sender: TObject; Node: TTreeNode;
921 var AllowCollapse: Boolean);
922begin
923 inherited;
924 Changing := True;
925 treService.Selected := nil;
926 Changing := False;
927 AllowCollapse := True;
928end;
929
930procedure TfrmODCslt.treServiceMouseDown(Sender: TObject;
931 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
932var
933 tmpNode: TORTreeNode;
934 NodeRect: TRect;
935begin
936 inherited;
937 if Button <> mbLeft then exit;
938 tmpNode := TORTreeNode(treService.GetNodeAt(X, Y));
939 if tmpNode = nil then exit;
940 NodeRect := tmpNode.DisplayRect(True);
941 if treService.Selected <> nil then
942 if (X >= NodeRect.Left) then // user clicked in the text of the item, not on the bitmap
943 begin
944 if tmpNode.StringData <> '' then
945 if (Piece(tmpNode.StringData, U, 5) <> '1') then
946 treService.Visible := False;
947 end;
948end;
949
950procedure TfrmODCslt.cmdLexSearchClick(Sender: TObject);
951var
952 Match: string;
953 i: integer;
954begin
955 inherited;
956
957 if BILLING_AWARE then BADxUpdated := FALSE;
958
959 LexiconLookup(Match, LX_ICD);
960 if Match = '' then Exit;
961 ProvDx.Code := Piece(Match, U, 1);
962 ProvDx.Text := Piece(Match, U, 2);
963 i := Pos(' (ICD', ProvDx.Text);
964 if i = 0 then i := Length(ProvDx.Text) + 1;
965 if ProvDx.Text[i-1] = '*' then i := i - 2;
966 ProvDx.Text := Copy(ProvDx.Text, 1, i - 1);
967 txtProvDiag.Text := ProvDx.Text + ' (' + ProvDx.Code + ')';
968
969 ProvDx.CodeInactive := False;
970end;
971
972procedure TfrmODCslt.SetProvDiagPromptingMode;
973//const
974//TX_USE_LEXICON = 'You must use the "Lexicon" button to select a provisional diagnosis for this service.'; <-- original line. //kt 8/8/2007
975//TX_USE_DIAGNOSIS = 'You must use the "Diagnosis" button to select a diagnosis for this service.'; <-- original line. //kt 8/8/2007
976
977//TX_PROVDX_OPT = 'Provisional Diagnosis'; <-- original line. //kt 8/8/2007
978//TX_PROVDX_REQD = 'Provisional Dx (REQUIRED)'; <-- original line. //kt 8/8/2007
979var
980 TX_USE_LEXICON : string; //kt
981 TX_USE_DIAGNOSIS : string; //kt
982 TX_PROVDX_OPT : string; //kt
983 TX_PROVDX_REQD : string; //kt
984
985begin
986 TX_USE_LEXICON := DKLangConstW('fODConsult_You_must_use_the_xLexiconx_button_to_select_a_provisional_diagnosis_for_this_servicex'); //kt added 8/8/2007
987 TX_USE_DIAGNOSIS := DKLangConstW('fODConsult_You_must_use_the_xDiagnosisx_button_to_select_a_diagnosis_for_this_servicex'); //kt added 8/8/2007
988 TX_PROVDX_OPT := DKLangConstW('fODConsult_Provisional_Diagnosis'); //kt added 8/8/2007
989 TX_PROVDX_REQD := DKLangConstW('fODConsult_Provisional_Dx_xREQUIREDx'); //kt added 8/8/2007
990 if BILLING_AWARE then
991 btnDiagnosis.Enabled := False //1.4.18
992 else
993 cmdLexSearch.Enabled := False;
994 txtProvDiag.Enabled := False;
995 txtProvDiag.ReadOnly := True;
996 txtProvDiag.Color := clBtnFace;
997 txtProvDiag.Font.Color := clBtnText;
998 lblProvDiag.Enabled := False;
999 txtProvDiag.Hint := '';
1000 if cboService.ItemIEN = 0 then Exit;
1001 GetProvDxMode(ProvDx, cboService.ItemID + CSLT_PTR);
1002 // Returns: string A^B
1003 // A = O (optional), R (required) or S (suppress)
1004 // B = F (free-text) or L (lexicon)
1005 with ProvDx do if (Reqd = '') or (PromptMode = '') then Exit;
1006 if ProvDx.Reqd = 'R' then
1007 begin
1008 lblProvDiag.Caption := TX_PROVDX_REQD;
1009 if (BILLING_AWARE) and (ProvDx.PromptMode[1] = '') then btnDiagnosis.Enabled := True;
1010 end
1011 else
1012 lblProvDiag.Caption := TX_PROVDX_OPT;
1013 if ProvDx.Reqd = 'S' then
1014 begin
1015 cmdLexSearch.Enabled := False;
1016 txtProvDiag.Enabled := False;
1017 txtProvDiag.ReadOnly := True;
1018 txtProvDiag.Color := clBtnFace;
1019 txtProvDiag.Font.Color := clBtnText;
1020 lblProvDiag.Enabled := False;
1021 end
1022 else
1023 case ProvDx.PromptMode[1] of
1024 'F': begin
1025 cmdLexSearch.Enabled := False;
1026 txtProvDiag.Enabled := True;
1027 txtProvDiag.ReadOnly := False;
1028 txtProvDiag.Color := clWindow;
1029 txtProvDiag.Font.Color := clWindowText;
1030 lblProvDiag.Enabled := True;
1031 end;
1032 'L': begin
1033 if BILLING_AWARE then
1034 begin
1035 btnDiagnosis.Enabled := True; //1.4.18
1036 txtProvDiag.Hint := TX_USE_DIAGNOSIS;
1037 end
1038 else
1039 begin
1040 cmdLexSearch.Enabled := True;
1041 txtProvDiag.Hint := TX_USE_LEXICON;
1042 end;
1043 txtProvDiag.Enabled := True;
1044 txtProvDiag.ReadOnly := True;
1045 txtProvDiag.Color := clInfoBk;
1046 txtProvDiag.Font.Color := clInfoText;
1047 lblProvDiag.Enabled := True;
1048 end;
1049 end;
1050end;
1051
1052
1053procedure TfrmODCslt.mnuPopProvDxDeleteClick(Sender: TObject);
1054begin
1055 inherited;
1056 ProvDx.Text := '';
1057 ProvDx.Code := '';
1058 txtProvDiag.Text := '';
1059 ControlChange(Self);
1060end;
1061
1062procedure TfrmODCslt.txtProvDiagChange(Sender: TObject);
1063begin
1064 inherited;
1065 if ProvDx.PromptMode = 'F' then
1066 begin
1067 ProvDx.Text := txtProvDiag.Text;
1068 displayDxCode := ProvDx.Text;
1069 end;
1070 ControlChange(Self);
1071end;
1072
1073procedure TfrmODCslt.SetupReasonForRequest(OrderAction: integer);
1074var
1075 EditReason: string;
1076
1077 procedure EnableReason;
1078 begin
1079 memReason.Color := clWindow;
1080 memReason.Font.Color := clWindowText;
1081 memReason.ReadOnly := False;
1082// lblReason.Caption := 'Reason for Request'; <-- original line. //kt 8/8/2007
1083 lblReason.Caption := DKLangConstW('fODConsult_Reason_for_Request'); //kt added 8/8/2007
1084 end;
1085
1086 procedure DisableReason;
1087 begin
1088 memReason.Color := clInfoBk;
1089 memReason.Font.Color := clInfoText;
1090 memReason.ReadOnly := True;
1091// lblReason.Caption := 'Reason for Request (not editable)'; <-- original line. //kt 8/8/2007
1092 lblReason.Caption := DKLangConstW('fODConsult_Reason_for_Request__xnot_editablex'); //kt added 8/8/2007
1093 end;
1094
1095begin
1096 if ((OrderAction = ORDER_QUICK) and (cboService.ItemID <> '') and (Length(memReason.Text) = 0)) then
1097 memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True));
1098 EditReason := GMRCREAF;
1099 if EditReason = '' then EditReason := ReasonForRequestEditable(cboService.ItemID + CSLT_PTR);
1100 case EditReason[1] of
1101 '0': EnableReason;
1102 '1': if OrderAction in [ORDER_COPY, ORDER_EDIT] then
1103 EnableReason
1104 else
1105 DisableReason;
1106 '2': DisableReason
1107 else
1108 EnableReason;
1109 end;
1110end;
1111
1112function TfrmODCslt.ShowPrerequisites: boolean;
1113//const
1114//TC_PREREQUISITES = 'Service Prerequisites - '; <-- original line. //kt 8/8/2007
1115var
1116 AList: TStringList;
1117 TC_PREREQUISITES : string; //kt
1118begin
1119 TC_PREREQUISITES := DKLangConstW('fODConsult_Service_Prerequisites_x'); //kt added 8/8/2007
1120 Result := True;
1121 AbortOrder := False;
1122 AList := TStringList.Create;
1123 try
1124 with cboService do
1125 if ItemIEN > 0 then
1126 begin
1127 Alist.Assign(GetServicePrerequisites(ItemID + CSLT_PTR));
1128 if AList.Count > 0 then
1129 begin
1130 if not DisplayPrerequisites(AList, TC_PREREQUISITES + DisplayText[ItemIndex]) then
1131 begin
1132 memOrder.Clear;
1133 Result := False;
1134 AbortOrder := True;
1135 end
1136 else Result := True;
1137 end;
1138 end;
1139 finally
1140 AList.Free;
1141 end;
1142end;
1143
1144procedure TfrmODCslt.cboServiceExit(Sender: TObject);
1145begin
1146 inherited;
1147 if Length(memOrder.Text) = 0 then Exit;
1148 if (Length(cboService.ItemID) = 0) or (cboService.ItemID = '0') then Exit;
1149 if cboService.ItemID = FLastServiceID then Exit;
1150 cboServiceSelect(cboService);
1151 // CQ #7490, following line commented out v26.24 (RV)
1152 // CQ #9610 and 10074 - uncommented and "if" added v26.54 (RV)
1153 if cboService.Enabled then cboService.SetFocus;
1154 PostMessage(Handle, WM_NEXTDLGCTL, 0, 0);
1155end;
1156
1157procedure TfrmODCslt.popReasonPopup(Sender: TObject);
1158begin
1159 inherited;
1160 if PopupComponent(Sender, popReason) is TCustomEdit
1161 then FEditCtrl := TCustomEdit(PopupComponent(Sender, popReason))
1162 else FEditCtrl := nil;
1163 if FEditCtrl <> nil then
1164 begin
1165 popReasonCut.Enabled := FEditCtrl.SelLength > 0;
1166 popReasonCopy.Enabled := popReasonCut.Enabled;
1167 popReasonPaste.Enabled := (not TORExposedCustomEdit(FEditCtrl).ReadOnly) and
1168 Clipboard.HasFormat(CF_TEXT);
1169 end else
1170 begin
1171 popReasonCut.Enabled := False;
1172 popReasonCopy.Enabled := False;
1173 popReasonPaste.Enabled := False;
1174 end;
1175 popReasonReformat.Enabled := True;
1176end;
1177
1178procedure TfrmODCslt.popReasonCutClick(Sender: TObject);
1179begin
1180 inherited;
1181 FEditCtrl.CutToClipboard;
1182end;
1183
1184procedure TfrmODCslt.popReasonCopyClick(Sender: TObject);
1185begin
1186 inherited;
1187 FEditCtrl.CopyToClipboard;
1188end;
1189
1190procedure TfrmODCslt.popReasonPasteClick(Sender: TObject);
1191begin
1192 inherited;
1193 FEditCtrl.SelText := Clipboard.AsText;
1194end;
1195
1196procedure TfrmODCslt.popReasonReformatClick(Sender: TObject);
1197begin
1198 inherited;
1199 if Screen.ActiveControl <> memReason then Exit;
1200 ReformatMemoParagraph(memReason);
1201end;
1202
1203function TfrmODCslt.DefaultReasonForRequest(Service: string;
1204 Resolve: Boolean): TStrings;
1205var
1206 TmpSL: TStringList;
1207 DocInfo: string;
1208 x: string;
1209 HasObjects: boolean;
1210begin
1211 Resolve := FALSE ; // override value passed in - resolve on client - PSI-05-093
1212 DocInfo := '';
1213 TmpSL := TStringList.Create;
1214 try
1215 Result := GetDefaultReasonForRequest(Service + CSLT_PTR, Resolve);
1216 TmpSL.Assign(Result);
1217 x := TmpSL.Text;
1218 ExpandOrderObjects(x, HasObjects);
1219 TmpSL.Text := x;
1220 Responses.OrderContainsObjects := HasObjects;
1221// ExecuteTemplateOrBoilerPlate(TmpSL, cboService.ItemIEN , ltConsult, nil, 'Reason for Request: ' + cboService.DisplayText[cboService.ItemIndex], DocInfo); <-- original line. //kt 8/8/2007
1222 ExecuteTemplateOrBoilerPlate(TmpSL, cboService.ItemIEN , ltConsult, nil, DKLangConstW('fODConsult_Reason_for_Requestx') + cboService.DisplayText[cboService.ItemIndex], DocInfo); //kt added 8/8/2007
1223 if TmpSL.Text <> x then Responses.OrderContainsObjects := False;
1224 Result.Assign(TmpSL);
1225 finally
1226 TmpSL.Free;
1227 end;
1228end;
1229
1230procedure TfrmODCslt.pnlServiceTreeButtonEnter(Sender: TObject);
1231begin
1232 inherited;
1233 (Sender as TPanel).BevelOuter := bvRaised;
1234end;
1235
1236procedure TfrmODCslt.pnlServiceTreeButtonExit(Sender: TObject);
1237begin
1238 inherited;
1239 (Sender as TPanel).BevelOuter := bvNone;
1240end;
1241
1242procedure TfrmODCslt.treServiceKeyDown(Sender: TObject; var Key: Word;
1243 Shift: TShiftState);
1244begin
1245 inherited;
1246 case Key of
1247 VK_SPACE, VK_RETURN:
1248 begin
1249 Key := 0;
1250 FKeyBoarding := False;
1251 treServiceChange(Sender, treService.Selected);
1252 end;
1253 else
1254 FKeyBoarding := True;
1255 end;
1256end;
1257
1258procedure TfrmODCslt.treServiceKeyUp(Sender: TObject; var Key: Word;
1259 Shift: TShiftState);
1260begin
1261 inherited;
1262 FKeyBoarding := False;
1263end;
1264
1265procedure TfrmODCslt.DoSetFontSize(FontSize: integer);
1266begin
1267 memReason.DefAttributes.Size := FontSize;
1268 treService.Font.Size := FontSize * 7 div 8;
1269end;
1270
1271procedure TfrmODCslt.SetFontSize(FontSize: integer);
1272begin
1273 inherited SetFontSize(FontSize);
1274 DoSetFontSize(FontSize);
1275end;
1276
1277procedure TfrmODCslt.memReasonKeyUp(Sender: TObject; var Key: Word;
1278 Shift: TShiftState);
1279begin
1280 inherited;
1281 if FNavigatingTab then
1282 begin
1283 if ssShift in Shift then
1284 FindNextControl(Sender as TWinControl, False, True, False).SetFocus //previous control
1285 else if ssCtrl in Shift then
1286 FindNextControl(Sender as TWinControl, True, True, False).SetFocus; //next control
1287 FNavigatingTab := False;
1288 end;
1289 if (key = VK_ESCAPE) then begin
1290 FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
1291 key := 0;
1292 end;
1293end;
1294
1295procedure TfrmODCslt.GetProvDxandValidateCode(AResponses: TResponses);
1296var
1297 tmpDx: TResponse;
1298
1299begin
1300 SetupVars; //kt added 8/8/2007 to replace constants with vars.
1301 with AResponses do
1302 begin
1303 tmpDx := TResponse(FindResponseByName('MISC',1));
1304 if tmpDx <> nil then ProvDx.Text := tmpDx.Evalue;
1305 tmpDx := TResponse(FindResponseByName('CODE',1));
1306 sourceOrderID := Responses.CopyOrder;
1307 if (tmpDx <> nil) and (tmpDx.EValue <> '') then
1308 begin
1309 if IsActiveICDCode(tmpDx.EValue) then
1310 ProvDx.Code := tmpDx.Evalue
1311 else
1312 begin
1313 if ProvDx.Reqd = 'R' then
1314 InfoBox(TX_INACTIVE_CODE1 + TX_INACTIVE_CODE_REQD, TC_INACTIVE_CODE, MB_ICONWARNING or MB_OK)
1315 else
1316 InfoBox(TX_INACTIVE_CODE1 + TX_INACTIVE_CODE_OPTIONAL, TC_INACTIVE_CODE, MB_ICONWARNING or MB_OK);
1317 ProvDx.Code := '';
1318 ProvDx.Text := '';
1319 end;
1320 end;
1321 txtProvDiag.Text := ProvDx.Text;
1322 if ProvDx.Code <> '' then
1323 txtProvDiag.Text := (txtProvDiag.Text + ' (' + ProvDx.Code + ')' )
1324 else
1325 begin
1326 if BILLING_AWARE then
1327 if (sourceOrderID <> '') and (ProvDx.Code <> '') then // if sourceid exists then user is copying an order.
1328 SetUpCopyConsultDiagnoses(sourceOrderID);
1329
1330 end;
1331
1332 end;
1333end;
1334
1335procedure TfrmODCslt.memReasonKeyDown(Sender: TObject; var Key: Word;
1336 Shift: TShiftState);
1337begin
1338 inherited;
1339 //The navigating tab controls were inadvertantently adding tab characters
1340 //This should fix it
1341 FNavigatingTab := (Key = VK_TAB) and ([ssShift,ssCtrl] * Shift <> []);
1342 if FNavigatingTab then
1343 Key := 0;
1344end;
1345
1346procedure TfrmODCslt.memReasonKeyPress(Sender: TObject; var Key: Char);
1347begin
1348 inherited;
1349 if FNavigatingTab then
1350 Key := #0; //Disable shift-tab processing
1351end;
1352
1353procedure TfrmODCslt.cboServiceKeyDown(Sender: TObject; var Key: Word;
1354 Shift: TShiftState);
1355begin
1356 inherited;
1357 //This fixes clearquest: HDS00001418 Makes it so OnClick is not called
1358 //Except when Enter or Space is pressed. VK_LBUTTON activates OnClick in TORComboBoxes
1359 FcboServiceKeyDownStopClick := false;
1360 if (Key <> VK_RETURN) {and (Key <> VK_SPACE)} and (Key <> VK_LBUTTON) then //comment on this line is fix for CQ6789
1361 FcboServiceKeyDownStopClick := True
1362 else
1363 Key := VK_LBUTTON;
1364end;
1365
1366procedure TfrmODCslt.cboServiceKeyUp(Sender: TObject; var Key: Word;
1367 Shift: TShiftState);
1368begin
1369 inherited;
1370 FcboServiceKeyDownStopClick := false;
1371end;
1372
1373
1374procedure TfrmODCslt.btnDiagnosisClick(Sender: TObject);
1375var
1376 leftParan, rightParan: string;
1377 tmpOrderIDList: TStringList;
1378begin
1379 inherited;
1380 tmpOrderIDList := TStringList.Create;
1381 tmpOrderIDList.Clear;
1382 leftParan := '(';
1383 rightParan := ')';
1384 UBAGlobals.BAtmpOrderList.Clear;
1385 UBAGlobals.BAtmpOrderList.Add(Responses.OrderText);
1386 quickCode := '';
1387 if consultQuickOrder then
1388 begin
1389 quickCode := Piece(txtProvDiag.text,'(',2);
1390 quickCode := Piece(quickCode,')',1);
1391 if UBACore.IsICD9CodeActive(quickCode,'ICD',0) then
1392 begin
1393 uBAGlobals.BAConsultDxList.Clear;
1394 uBAGlobals.BAConsultDxList.Add(UBAConst.PRIMARY_DX + U + Piece(txtProvDiag.text,'(',1) + ':' + quickCode);
1395 end;
1396
1397 end;
1398 frmBALocalDiagnoses.Enter(UBAConst.F_CONSULTS, nil);
1399 if displayDxCode = '' then txtProvDiag.Text := ''
1400 else
1401 begin
1402 if displayDxCode <> 'DXCANCEL' then
1403 begin
1404 ProvDx.Code := Piece(displayDxCode,':', 2);
1405 ProvDx.Text := Piece(displayDxCode,':', 1);
1406 txtProvDiag.Text := ProvDx.Text + ' (' + ProvDx.Code + ')';
1407 end;
1408 end;
1409
1410 ProvDx.CodeInactive := False;
1411end;
1412
1413procedure TfrmODCslt.cmdQuitClick(Sender: TObject);
1414begin
1415 inherited;
1416 if BILLING_AWARE then uBAGlobals.BAConsultDxList.Clear;
1417end;
1418
1419procedure TfrmODCslt.SaveConsultDxForNurse(pDiagnosis: string);
1420var
1421 s,tmpTFactors: string;
1422 tmpList: TStringList;
1423begin
1424 tmpList := TStringList.Create;
1425 tmpList.Clear;
1426 s := '';
1427 tmpList.Add(uBAGlobals.BAOrderID);
1428 s := GetPatientTFactors(tmpList);
1429 tmpTFactors := ConvertPIMTreatmentFactors(s);
1430 BANurseConsultOrders.Add(uBAGlobals.BAOrderID + '1' + tmpTFactors + U + ProvDX.Code);
1431end;
1432
1433procedure TfrmODCslt.SetUpCopyConsultDiagnoses(pOrderID:string);
1434var
1435 sourceOrderID, primaryText,primaryCode: string;
1436 sourceOrderList: TStringList;
1437 thisOrderList: TStringList;
1438begin
1439//logic handles setting up diagnoses when copying an order.
1440 sourceOrderList := TStringList.Create;
1441 sourceOrderList.Clear;
1442 thisOrderList := TStringList.Create;
1443 thisOrderList.Clear;
1444 if IsOrderBillable(sourceOrderID) then
1445 begin
1446 thisOrderList.Add(sourceOrderID);
1447 sourceOrderList := rpcRetrieveSelectedOrderInfo(thisOrderList);
1448 primaryText := Piece(sourceOrderList.Strings[0],U,4);
1449 primaryCode := Piece(sourceOrderList.Strings[0],U,3);
1450 txtProvDiag.Text := primaryText + ' (' + primaryCode + ')';
1451 ProvDx.CodeInactive := False;
1452 // need to handle the rest of the dx's
1453 uBAGlobals.BAConsultDxList.Clear;
1454 uBAGlobals.BAConsultDxList.Add(UBAConst.PRIMARY_DX + U + Piece(txtProvDiag.text,'(',1) + ':' + primaryCode);
1455 if (Piece(sourceOrderList.Strings[0],U,5) <> '') then // dx2
1456 uBAGlobals.BAConsultDxList.Add(UBAConst.SECONDARY_DX + U + Piece(sourceOrderList.Strings[0],U,6) + ':' + Piece(sourceOrderList.Strings[0],U,5));
1457 if (Piece(sourceOrderList.Strings[0],U,7) <> '') then // dx3
1458 uBAGlobals.BAConsultDxList.Add(UBAConst.SECONDARY_DX + U + Piece(sourceOrderList.Strings[0],U,8) + ':' + Piece(sourceOrderList.Strings[0],U,7));
1459 if (Piece(sourceOrderList.Strings[0],U,9) <> '') then // dx4
1460 uBAGlobals.BAConsultDxList.Add(UBAConst.SECONDARY_DX + U + Piece(sourceOrderList.Strings[0],U,10) + ':' + Piece(sourceOrderList.Strings[0],U,9));
1461 end;
1462end;
1463
1464procedure TfrmODCslt.FormClose(Sender: TObject; var Action: TCloseAction);
1465begin
1466 inherited;
1467 frmFrame.pnlVisit.Enabled := true;
1468end;
1469
1470end.
1471
1472
Note: See TracBrowser for help on using the repository browser.