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

Last change on this file was 1679, checked in by healthsevak, 9 years ago

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