source: cprs/trunk/CPRS-Chart/Consults/fODConsult.pas@ 468

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

Initial Upload of Official WV CPRS 1.0.26.76

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