source: cprs/trunk/CPRS-Chart/fReview.pas@ 809

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

Initial Upload of Official WV CPRS 1.0.26.76
File size: 75.5 KB
RevLine 
[456]1unit fReview;
2
3{.$define debug}
4
5interface
6
7uses
8 UBAGlobals,
9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
10 StdCtrls, checklst, uConst, ExtCtrls, uCore, mCoPayDesc, XUDIGSIGSC_TLB,
11 ORCtrls, Menus, UBACore, ORClasses;
12
13type
14 TfrmReview = class(TForm)
15 cmdOK: TButton;
16 cmdCancel: TButton;
17 lstReview: TCaptionCheckListBox;
18 pnlOrderAction: TPanel;
19 radSignChart: TRadioButton;
20 pnlSignature: TPanel;
21 txtESCode: TCaptionEdit;
22 lblESCode: TLabel;
23 Label1: TStaticText;
24 radHoldSign: TRadioButton;
25 grpRelease: TGroupBox;
26 radVerbal: TRadioButton;
27 radPhone: TRadioButton;
28 radPolicy: TRadioButton;
29 radRelease: TRadioButton;
30 fraCoPay: TfraCoPayDesc;
31 laDiagnosis: TLabel;
32 gbxDxLookup: TGroupBox;
33 buDiagnosis: TButton;
34 poBACopyPaste: TPopupMenu;
35 Copy1: TMenuItem;
36 Paste1: TMenuItem;
37 Diagnosis1: TMenuItem;
38 Exit1: TMenuItem;
39 lblSig: TStaticText;
40 procedure FormCreate(Sender: TObject);
41 procedure lstReviewDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
42 procedure cmdOKClick(Sender: TObject);
43 procedure cmdCancelClick(Sender: TObject);
44 procedure lstReviewClickCheck(Sender: TObject);
45 procedure radReleaseClick(Sender: TObject);
46 procedure txtESCodeChange(Sender: TObject);
47 procedure lstReviewMeasureItem(Control: TWinControl; Index: Integer; var AHeight: Integer);
48 procedure FormDestroy(Sender: TObject);
49 procedure lstReviewMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
50 procedure buDiagnosisClick(Sender: TObject);
51 procedure lstReviewClick(Sender: TObject);
52 procedure Exit1Click(Sender: TObject);
53 procedure lstReviewMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
54 procedure Copy1Click(Sender: TObject);
55 procedure Paste1Click(Sender: TObject);
56 procedure ClearDiagnoses1Click(Sender: TObject);
57 procedure FormShow(Sender: TObject);
58 procedure FormKeyDown(Sender: TObject; var Key: Word;
59 Shift: TShiftState);
60 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
61 Y: Integer);
62 procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
63 Shift: TShiftState; X, Y: Integer);
64 procedure fraCoPayLabel24MouseMove(Sender: TObject; Shift: TShiftState;
65 X, Y: Integer);
66 procedure FormClose(Sender: TObject; var Action: TCloseAction);
67 procedure fraCoPayLabel23Enter(Sender: TObject);
68 procedure fraCoPayLabel23Exit(Sender: TObject);
69 procedure lstReviewKeyUp(Sender: TObject; var Key: Word;
70 Shift: TShiftState);
71 procedure FormKeyUp(Sender: TObject; var Key: Word;
72 Shift: TShiftState);
73
74 private
75 { Private declarations }
76 FOKPressed: Boolean;
77 FShowPanel: Integer;
78 FSilent: Boolean;
79 FCouldSign: Boolean;
80 FLastHintItem: integer;
81 FOldHintPause: integer;
82 FOldHintHidePause: integer;
83 FShrunk: boolean;
84 FIsEvtChange: boolean;
85 procedure AddHeader(s: string);
86 function AddItem(ChangeItem: TChangeItem): integer;
87 procedure BuildList(FullList: boolean);
88 procedure BuildFullList;
89 procedure BuildSignList;
90 procedure CleanupChangesList(Sender: TObject; ChangeItem: TChangeItem); {**RV**}
91 function ItemsAreChecked: Boolean;
92 function SignRequiredForAny(FullList: boolean): Boolean;
93 procedure AdjustSignatureTop( HeightAdjustment: integer);
94 function IsSignatureRequired:boolean;
95 function GetNumberOfSelectedOrders : byte;
96 procedure ShowTreatmentFactorHints(var pHintText: string; var pCompName: TORStaticText); // 508
97 procedure SetItemTextToState;
98 procedure FormatListForScreenReader;
99
100 public
101 procedure SetCheckBoxStatus(thisOrderID: string);
102 function GetCheckBoxStatus(sourceOrderID : string) : string; overload;
103 function GetCheckBoxStatus(gridItemIndex : smallint) : string; overload;
104 function GetNonNilItemCount : integer; //CQ5172
105 end;
106
107function ReviewChanges(TimedOut: Boolean; IsEvtChange: boolean = False): Boolean;
108
109var
110{Begin BillingAware}
111 frmReview: TfrmReview; //Originally declared locally in function ReviewChanges()
112 DxRect: TRect;
113{End BillingAware}
114
115 {Begin BillingAware}
116 TFactorMemo: TCaptionMemo;
117 chkBoxStatus: string;
118 srcOrderID: string;
119 targetOrderID: string;
120 tempStrList: TStringList;
121 srcDx: string;
122 tempOrderList: TStringList;
123 copyOrderID: string;
124 srcIndex: integer;
125 CopyBuffer: TBADxRecord;
126 FRVTFHintWindowActive: boolean;
127 FRVTFHintWindow: THintWindow;
128 {End BillingAware}
129 crypto: IXuDigSigS;
130 currentlySelectedItem: integer; //CQ5063
131 currentItems: TStringList; //CQ5063
132
133implementation
134
135{$R *.DFM}
136
137uses ORFn, rCore, fNotes, fConsults, fOrders, rOrders, Hash, fDCSumm, fOCSession, uOrders,
138 fSignItem, fOrdersPrint, fLkUpLocation, fFrame, uSignItems, fSurgery,
139 fBALocalDiagnoses, UBAConst, UBAMessages, fOrdersSign, fClinicWardMeds;
140
141const
142 SP_NONE = 0;
143 SP_CLERK = 1;
144 SP_NURSE = 2;
145 SP_SIGN = 3;
146 TXT_ENCNT = 'Outpatient Encounter';
147 TXT_NOVISIT = 'Visit Type: < None Selected >';
148 TXT_NODIAG = 'Diagnosis: < None Selected >';
149 TXT_NOPROC = 'Procedures: none';
150 TXT_DOCS = 'Documents';
151 TXT_ORDERS = 'Orders';
152 TXT_BLANK = ' ';
153 TX_INVAL_MSG = 'Not a valid electronic signature code. Enter a valid code or press Cancel.';
154 TX_INVAL_CAP = 'Unrecognized Signature Code';
155 TX_ES_REQ = 'Enter your electronic signature to release these orders.';
156 TC_ES_REQ = 'Electronic Signature';
157 TX_NO_REL = CRLF + CRLF + '- cannot be released to the service(s).' + CRLF + CRLF + 'Reason: ';
158 TC_NO_REL = 'Unable to Release Orders';
159 TC_NO_DX = 'Incomplete Diagnosis Entry';
160 TX_NO_DX = 'A Diagnosis must be selected prior to signing any of the following order types:'
161 + CRLF + 'Outpatient Lab,Radiology, Outpatient Medications, Prosthetics.';
162
163procedure TfrmReview.SetCheckBoxStatus(thisOrderID: string);
164{
165 - Set the current CI checkboxes status
166}
167begin
168 if BILLING_AWARE then
169 begin
170 uSignItems.uSigItems.SetSigItems(lstReview, thisOrderID);
171 end;
172end;
173
174function TfrmReview.GetCheckBoxStatus(gridItemIndex: smallint) : string;
175{
176 - Obtain checkbox status for selected order - BY ORDER ID
177}
178var
179 itemsList: TStringList;
180 i: smallint;
181begin
182 Result := '';
183 itemsList := TStringList.Create;
184 itemsList.Clear;
185 itemsList := uSigItems.GetSigItems; //Get FItems list
186
187 if BILLING_AWARE then
188 begin
189 for i := 0 to itemsList.Count-1 do
190 begin
191 //thisOrderID := Piece(itemsList[i],'^',1); //get the order ID
192 if i = gridItemIndex then //compare to order ID of source order
193 begin
194 Result := Piece(itemsList[i],U,4); //return TF status'
195 Break;
196 end;
197 end;
198 end;
199end;
200
201function TfrmReview.GetCheckBoxStatus(sourceOrderID: string) : string; //PASS IN ORDER ID - NOT GRID INDEX
202{
203 - Obtain checkbox status for selected order - BY ORDER ID
204}
205var
206 itemsList: TStringList;
207 i: smallint;
208 thisOrderID: string;
209begin
210 Result := '';
211 itemsList := TStringList.Create;
212 itemsList.Clear;
213 itemsList := uSigItems.GetSigItems; //Get FItems list
214
215 if BILLING_AWARE then
216 begin
217 for i := 0 to itemsList.Count-1 do
218 begin
219 thisOrderID := Piece(itemsList[i],'^',1); //get the order ID
220 if thisOrderID = sourceOrderID then //compare to order ID of source order
221 begin
222 Result := Piece(itemsList[i],U,4); //return TF status'
223 Break;
224 end;
225 end;
226 end;
227end;
228
229function TfrmReview.GetNumberOfSelectedOrders : byte;
230{
231 - Return the number of orders in clstOrders that are currently selected.
232}
233var
234 i: integer;
235 numSelected: byte;
236begin
237 result := 0;
238 if BILLING_AWARE then
239 begin
240 numSelected := 0;
241 for i := 1 to frmReview.lstReview.Items.Count-1 do
242 if (frmReview.lstReview.Selected[i]) then
243 Inc(numSelected);
244
245 Result := numSelected;
246 end;
247end;
248
249function ReviewChanges(TimedOut: Boolean; IsEvtChange: boolean = False): Boolean;
250{ display changes made to chart for this encounter, allow changes to be saved, signed, etc. }
251var
252 i: integer;
253begin
254 Result := True;
255 if Changes.Count = 0 then Exit;
256 frmReview := TfrmReview.Create(Application);
257 try
258 Changes.OnRemove := frmReview.CleanupChangesList; {**RV**}
259 frmReview.FIsEvtChange := IsEvtChange;
260 ResizeAnchoredFormToFont(frmReview);
261
262 if TimedOut and (Changes.Count > 0) then
263 begin
264 frmReview.FSilent := True;
265 frmReview.BuildFullList;
266 with frmReview.lstReview do for i := 0 to Items.Count - 1 do
267 Checked[i] := False;
268 frmReview.cmdOKClick(frmReview);
269 Result := True;
270 end
271 // if user not timed out, execute as before
272 else
273 begin
274 if ((uCore.User.OrderRole = OR_NURSE) or (uCore.User.OrderRole = OR_CLERK)) and Changes.CanSign then
275 begin
276 frmReview.FCouldSign := True;
277 frmReview.BuildSignList; // ok will remove from changes, exit leaves altogether
278 frmReview.ShowModal;
279 Result := frmReview.FOKPressed;
280 end;
281
282 if Result and (Changes.Count > 0) then
283 begin
284 frmReview.FCouldSign := Changes.CanSign;
285 frmReview.BuildFullList;
286
287 if BILLING_AWARE then
288 // build list of orders that are not billable based on package type
289 UBAGlobals.NonBillableOrderList := rpcNonBillableOrders(tempOrderList);
290
291 frmReview.ShowModal;
292 Result := frmReview.FOKPressed;
293 end;
294
295 end;
296
297 finally
298 Changes.OnRemove := nil; {**RV**}
299 frmReview.Release;
300 end;
301end;
302
303procedure TfrmReview.FormCreate(Sender: TObject);
304const
305 TX_FORM_CAPTION = 'Review / Sign Changes ';
306begin
307 FOKPressed := False;
308 FSilent := False;
309 FLastHintItem := -1;
310 Self.Caption := TX_FORM_CAPTION + '(' + Patient.Name + ' - ' + Patient.SSN + ')';
311 FOldHintPause := Application.HintPause;
312 Application.HintPause := 250;
313 FOldHintHidePause := Application.HintHidePause;
314 Application.HintHidePause := 30000;
315 {Begin BillingAware}
316 if BILLING_AWARE then
317 begin
318 lstReview.Height := 220;
319 lstReview.Top := (gbxdxLookup.top + 65);
320 gbxDxLookup.Visible := TRUE;
321 lblsig.Top := (gbxdxLookup.Top + 48);
322 laDiagnosis.Top := Lblsig.Top;
323 laDiagnosis.Left := 270;
324 laDiagnosis.Visible := TRUE;
325 rectIndex := 0;
326 end;
327 {End BillingAware}
328end;
329
330procedure TfrmReview.AddHeader(s: string);
331{ add header to review list, object is left nil }
332begin
333 lstReview.Items.AddObject(s, nil);
334end;
335
336function TfrmReview.AddItem(ChangeItem: TChangeItem): integer;
337{ add a single review item to the list with its associated TChangeItem object }
338begin
339 Result := lstReview.Items.AddObject(ChangeItem.Text, ChangeItem);
340
341 //Begin BillingAware
342 if BILLING_AWARE then
343 begin
344 UBAGlobals.ChangeItemOrderNum := ChangeItem.ID; // GE 2/21/2006 removed "Copy(ChangeItem.ID,0,8)" issue when sites have order number > 8 digits
345 // HDS00005025
346
347 if ChangeItem.ItemType = CH_DOC then // documents are not orderable, code is necessary
348 UBAGlobals.ChangeItemOrderNum := '0'; // document id can be same as order id, orderid = 0 will be nonbillable
349
350 tempOrderList.Add(UBAGlobals.ChangeItemOrderNum);
351 end;
352 //end BillingAware
353
354 case ChangeItem.SignState of
355 CH_SIGN_YES: lstReview.Checked[Result] := True;
356 CH_SIGN_NO: lstReview.Checked[Result] := False;
357 CH_SIGN_NA: lstReview.State[Result] := cbGrayed;
358 end;
359 //hds00006047
360 // this will override the signstate from above for all non-va med orders... no signature required.
361 if ChangeItem.GroupName = '' then
362 begin
363 if StrPos(PChar(ChangeItem.Text),PChar(NonVAMedTxt)) <> nil then
364 lstReview.State[Result] := cbGrayed;
365 end;
366 //hds00006047
367end;
368
369procedure TfrmReview.AdjustSignatureTop( HeightAdjustment: integer);
370//This has been added to support correct anchoring for the lstReview list.
371begin
372 Height := Height + HeightAdjustment;
373 lblSig.Top := lblSig.Top + HeightAdjustment;
374 lstReview.Top := lstReview.Top + HeightAdjustment;
375 lstReview.Height := lstReview.Height - HeightAdjustment;
376 //for 24 pt font, we need to make sure that lstreview is resized before the main form is.
377end;
378
379function TfrmReview.IsSignatureRequired:boolean;
380var
381 i: integer;
382begin
383 Result := FALSE;
384 with lstReview.items do for i := 0 to Pred(Count) do
385 begin
386 if frmReview.lstReview.Checked[i] then
387 begin
388 //CQ4790
389 if TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]) = nil then
390 Continue;
391 //end CQ4790
392
393 if (TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]).SIGNSTATE) <> CH_SIGN_NA then
394 Result := TRUE;
395 end;
396 end;
397end;
398
399procedure TfrmReview.BuildList(FullList: boolean);
400var
401 GrpIndex, ChgIndex, lbIdx: Integer;
402 ChangeItem: TChangeItem;
403 LabelHeight: integer;
404 PrevGrpName: string;
405
406begin
407 tempOrderList := TStringList.Create;
408 tempOrderList.Clear;
409 PrevGrpName := '';
410 lstReview.Clear; // ok to clear without freeing objects since they're part of Changes
411 if(FullList) then
412 begin
413 SigItems.ResetOrders;
414 with Changes do
415 if PCE.Count > 0 then
416 begin
417 for GrpIndex := 0 to PCEGrp.Count - 1 do
418 begin
419 AddHeader('Outpatient Encounter ' + PCEGrp[GrpIndex]);
420 for ChgIndex := 0 to PCE.Count - 1 do
421 begin
422 ChangeItem := PCE[ChgIndex];
423 if ChangeItem.GroupName = PCEGrp[GrpIndex] then AddItem(ChangeItem);
424 end;
425 AddHeader(' ');
426 end;
427 end; {if PCE}
428 end;
429 with Changes do
430 if Documents.Count > 0 then
431 begin
432 AddHeader('Documents');
433 for ChgIndex := 0 to Documents.Count - 1 do
434 begin
435 ChangeItem := Documents[ChgIndex];
436 if(FullList or (ChangeItem.SignState <> CH_SIGN_NA)) then
437 AddItem(ChangeItem);
438 end;
439 if(FullList) then
440 AddHeader(' ');
441 end; {if Documents}
442 if(FullList) then
443 begin
444 with Changes do
445 if Orders.Count > 0 then
446 begin
447
448 for GrpIndex := 0 to OrderGrp.Count - 1 do
449 begin
450 if (GrpIndex > 0 ) and (AnsiCompareText(PrevGrpName,OrderGrp[GrpIndex])=0) then
451 Continue;
452 AddHeader('Orders - ' + OrderGrp[GrpIndex]);
453 {billing aware}
454 if BILLING_AWARE then
455 begin
456 UBACore.rpcBuildSCIEList(Orders); // build list of orders and Billable Status
457 UBACore.CompleteUnsignedBillingInfo(rpcGetUnsignedOrdersBillingData(OrderListSCEI) );
458 end;
459 {billing aware}
460 for ChgIndex := 0 to Orders.Count - 1 do
461 begin
462 ChangeItem := Orders[ChgIndex];
463 if ChangeItem.GroupName = OrderGrp[GrpIndex] then
464 begin
465 lbIdx := AddItem(ChangeItem);
466 SigItems.Add(CH_ORD, ChangeItem.ID, lbIdx);
467 end;
468 end;
469 AddHeader(' ');
470 PrevGrpName := OrderGrp[GrpIndex];
471 end;
472 end; {if Orders}
473 // determine the appropriate panel to display
474 case User.OrderRole of
475 OR_CLERK: FShowPanel := SP_CLERK;
476 OR_NURSE: FShowPanel := SP_NURSE;
477 OR_PHYSICIAN: FShowPanel := SP_SIGN;
478 OR_STUDENT: if Changes.CanSign then FShowPanel := SP_SIGN else FShowPanel := SP_NONE;
479 else FShowPanel := SP_NONE;
480 end; {case User}
481 end
482 else
483 FShowPanel := SP_SIGN;
484
485 case FShowPanel of
486 SP_CLERK: begin
487 pnlSignature.Visible := False;
488 //pnlOrderAction.Visible := True;
489 pnlOrderAction.Visible := SignRequiredForAny(FullList);
490 end;
491 SP_NURSE: begin
492 pnlSignature.Visible := False;
493 radRelease.Visible := True;
494 grpRelease.Visible := True;
495 pnlOrderAction.Visible := SignRequiredForAny(FullList);
496 end;
497 SP_SIGN: begin
498 pnlOrderAction.Visible := False;
499 pnlSignature.Visible := ItemsAreChecked;
500 end;
501 else begin // SP_NONE
502 pnlOrderAction.Visible := False;
503 pnlSignature.Visible := False;
504 end;
505 end; {case FShowPanel}
506 pnlSignature.Visible := ItemsAreChecked;
507 txtESCodeChange(Self);
508 if pnlOrderAction.Visible then
509 begin
510 lblSig.Caption := 'Documents / Orders';
511 if FShowPanel = SP_NURSE then
512 begin
513 if GetUserParam('OR SIGNATURE DEFAULT ACTION') = 'OC'
514 then radHoldSign.Checked := True
515 else radRelease.Checked := True;
516 end;
517 if (radHoldSign.Checked) and (GetUserParam('OR SIGNED ON CHART') = '1')
518 then radSignChart.Checked := True;
519 if radRelease.Checked then radReleaseClick(Self);
520 end {if pnlOrderAction}
521 else
522 begin
523 if (User.OrderRole = OR_STUDENT) or (User.OrderRole = OR_NOKEY) or (User.OrderRole = OR_BADKEYS) then
524 lblSig.Caption := 'These orders will be held until signed'
525 else
526 lblSig.Caption := 'Signature will be Applied to Checked Items';
527 end;
528 //Make sure there is enough width for the buttons and lblSig
529 //begin BillingAware
530 if BILLING_AWARE then
531 begin
532 LabelHeight := lstReview.Top - fraCoPay.Height;
533 AdjustSignatureTop( ResizeHeight( BaseFont, MainFont, LabelHeight) - LabelHeight);
534 end;
535 //end BillingAware
536
537 if (FullList and SigItems.UpdateListBox(lstReview)) then
538 begin
539 fraCoPay.Visible := TRUE;
540 //begin BillingAware
541 if BILLING_AWARE then frmReview.gbxDxLookup.Visible := TRUE;
542 //end BillingAware
543 if(FShrunk) then
544 begin
545 FShrunk := FALSE;
546 AdjustSignatureTop( fraCoPay.Height + 9);
547 end;
548 end
549 else
550 begin
551 fraCoPay.Visible := FALSE;
552 //begin BillingAware
553 if BILLING_AWARE then frmReview.gbxDxLookup.Visible := FALSE;
554 //end BillingAware
555 if(not FShrunk) then
556 begin
557 FShrunk := TRUE;
558 AdjustSignatureTop(-fraCoPay.Height - 9);
559 end;
560 end;
561end; {BuildFullList}
562
563
564procedure TfrmReview.BuildFullList;
565begin
566 BuildList(TRUE);
567end;
568
569procedure TfrmReview.BuildSignList;
570begin
571 BuildList(FALSE);
572end;
573
574function TfrmReview.ItemsAreChecked: Boolean;
575{ return true if any items in the Review List are checked for applying signature }
576var
577 i: Integer;
578begin
579 Result := False;
580 with lstReview do for i := 0 to Items.Count - 1 do if Checked[i] then
581 begin
582 Result := True;
583 break;
584 end;
585end;
586
587function TfrmReview.SignRequiredForAny(FullList: boolean): Boolean;
588var
589 i: Integer;
590 tmpOrders: TStringList;
591 ChangeItem: TChangeItem;
592begin
593 Result := True;
594 if Changes.Documents.Count > 0 then Exit;
595 if(FullList) then
596 begin
597 // if Changes.PCE.Count > 0 then Exit; *** JM - you don't sign encounter informaiton ***
598 tmpOrders := TStringList.Create;
599 try
600 for i := 0 to Pred(Changes.Orders.Count) do
601 begin
602 ChangeItem := Changes.Orders[i];
603 tmpOrders.Add(ChangeItem.ID);
604 end;
605 Result := AnyOrdersRequireSignature(tmpOrders);
606 finally
607 FreeAndNil(tmpOrders);
608 end;
609 end
610 else
611 Result := FALSE;
612end;
613
614procedure TfrmReview.lstReviewClickCheck(Sender: TObject);
615{ prevent grayed checkboxes from being changed to anything else }
616var
617 ChangeItem: TChangeItem;
618
619 procedure updateAllChilds(CheckedStatus: boolean; ParentOrderId: string);
620 var
621 idx: integer;
622 AChangeItem: TChangeItem;
623 begin
624 for idx := 0 to lstReview.Items.Count - 1 do
625 begin
626 AChangeItem := TChangeItem(lstReview.Items.Objects[idx]);
627 if Assigned(AChangeItem) and (AChangeItem.ParentID = ParentOrderId) then
628 if lstReview.Checked[idx] <> CheckedStatus then
629 begin
630 lstReview.Checked[idx] := CheckedStatus;
631 SigItems.EnableSettings(idx, lstReview.checked[Idx]);
632 end;
633 end;
634 end;
635
636begin
637 with lstReview do
638 begin
639 ChangeItem := TChangeItem(Items.Objects[ItemIndex]);
640 if ItemIndex > 0 then
641 begin
642 if (ChangeItem <> nil) then
643 begin
644 if (ChangeItem.SignState = CH_SIGN_NA) then State[ItemIndex] := cbGrayed
645 else
646 begin
647 SigItems.EnableSettings(ItemIndex, checked[ItemIndex]);
648 if Length(ChangeItem.ParentID) > 0 then
649 updateAllChilds(checked[ItemIndex], ChangeItem.ParentID);
650 end;
651 end;
652 end;
653 pnlSignature.Visible := IsSignatureRequired;
654 end;
655end;
656
657procedure TfrmReview.lstReviewDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
658{ outdent the header items (thus hiding the checkbox) }
659var
660 x: string;
661 ARect: TRect;
662 i: integer;
663 tempID: string;
664 thisRec: UBAGlobals.TBADxRecord;
665
666{Begin BillingAware}
667 str: string;
668{End BillingAware}
669
670begin
671 inherited;
672
673 x := '';
674 ARect := Rect;
675
676 if BILLING_AWARE then
677 begin
678 ARect.Right := ARect.Right - 50;
679
680 with lstReview do
681 begin
682 if Items.Objects[Index] = nil then
683 ARect.Left := 0;
684 Canvas.Pen.Color := clSilver;
685 //Canvas.Brush.Color := clLime;
686 Canvas.FillRect(ARect);
687
688 if Index < Items.Count then
689 begin
690 x := Trim(FilteredString(Items[Index]));
691
692 if (ARect.Left = 0) and ( Length(x)>0 ) then
693 Canvas.TextOut(ARect.Left + 2, ARect.Top, x)
694 else
695 if (ARect.Left > 0 ) and ( Length(x)>0 ) then
696 begin
697 //ARect.Right below controls the right-hand side of the Dx Column
698 //Adjust ARect.Right in conjunction with procedure uSignItems.TSigItems.lbDrawItem(), because the
699 //two rectangles overlap each other.
700
701 if BILLING_AWARE then
702 begin
703 arRect[Index] := Classes.Rect(ARect.Right+2, ARect.Top, ARect.Right + 108, ARect.Bottom);
704 Canvas.FillRect(arRect[Index]);
705 end;
706
707 //Draw ORDER TEXT
708 DrawText(Canvas.handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
709
710 if BILLING_AWARE then
711 begin
712 //Dx Column lines
713 Canvas.Pen.Color := clSilver;
714 Canvas.MoveTo(DxRect.Left-1, ARect.Top);
715 Canvas.LineTo(DxRect.Left-1, ARect.Bottom);
716 //Adjust position of 'Diagnosis' column label for font size
717 laDiagnosis.Left := DxRect.Left + 14;
718 laDiagnosis.Top := lblSig.Top;
719 //Assign DxRect for drawing Dx column and Dx string
720 DxRect.Left := ARect.Right + 1;
721 DxRect.Top := ARect.Top;
722 DxRect.Right := DxRect.Left + 80;
723 DxRect.Bottom := ARect.Bottom;
724
725 //Display all saved Dx's
726 for i := 0 to lstReview.Items.Count-1 do
727 //for i := 1 to uSignItems.uSigItems.GetSigItems.Count - 1 do
728 with TOrder(lstReview.Items[i]) do
729 begin
730 // HDS00005025
731 if TChangeItem(lstReview.Items.Objects[Index]).ITEMTYPE = CH_DOC then
732 tempID := '0' // if document id is equal to valid order id identify billable orders
733 else
734 tempID := TChangeItem(lstReview.Items.Objects[Index]).ID;
735 // HDS00005025
736 //WORKS FOR MULTIPLE Dx
737 if Assigned(UBAGlobals.tempDxList) then
738 if UBAGlobals.tempDxNodeExists(tempID) then
739 begin
740 thisRec := TBADxRecord.Create;
741 UBAGlobals.GetBADxListForOrder(thisRec, tempID);
742 str := Piece(thisRec.FBADxCode, '^', 1); // Display Dx text only - not the ICD-9 code
743 str := Piece(str, ':', 1); //in case has : vs. ^
744 DrawText(Canvas.handle, PChar(str), Length(str), arRect[Index], DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
745
746 if (Not UBACore.IsOrderBillable(tempID)) then// and
747 // (Not UBAGlobals.tempDxNodeExists(tempID) ) then // if consult is non cidc but requires dx, show it.
748 begin
749 Canvas.Font.Color := clBlue ;
750 DrawText(Canvas.handle, PChar(NOT_APPLICABLE), Length(NOT_APPLICABLE) , arRect[Index], DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
751 end;
752 end
753 else
754 begin
755 //Determine if order is billable. If NOT billable then insert NA in Dx field
756 if Not UBACore.IsOrderBillable(tempID) then
757 begin
758 Canvas.Font.Color := clBlue ;
759 DrawText(Canvas.handle, PChar(NOT_APPLICABLE), Length(NOT_APPLICABLE) , arRect[Index], DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
760 end;
761 end;
762 end;
763 end;
764 end; //if
765 end; //if
766 end; //with
767 end
768 else
769 begin
770 with lstReview do
771 begin
772 if Items.Objects[Index] = nil then
773 ARect.Left := 0;
774
775 Canvas.FillRect(ARect);
776
777 if Index < Items.Count then
778 begin
779 x := Trim(FilteredString(Items[Index]));
780
781 if (ARect.Left = 0) and ( Length(x) > 0 ) then
782 Canvas.TextOut(ARect.Left + 2, ARect.Top, x)
783 else
784 if (ARect.Left > 0 ) and ( Length(x)>0 ) then
785 begin
786 Canvas.Pen.Color := clSilver;
787 Canvas.MoveTo(0, ARect.Bottom-1);
788 Canvas.LineTo(ARect.Right, ARect.Bottom-1);
789 DrawText(Canvas.handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
790 end;
791 end;
792 end;
793 end;
794end;
795
796procedure TfrmReview.radReleaseClick(Sender: TObject);
797begin
798 if not grpRelease.Visible then Exit;
799 if radRelease.Checked then
800 begin
801 radVerbal.Enabled := True;
802 radPhone.Enabled := True;
803 radPolicy.Enabled := True;
804 if Encounter.Provider = User.DUZ
805 then radPolicy.Checked := True
806 else radVerbal.Checked := True;
807 end else
808 begin
809 radVerbal.Enabled := False;
810 radPhone.Enabled := False;
811 radPolicy.Enabled := False;
812 radVerbal.Checked := False;
813 radPhone.Checked := False;
814 radPolicy.Checked := False;
815 end;
816end;
817
818procedure TfrmReview.txtESCodeChange(Sender: TObject);
819begin
820 if(not pnlSignature.Visible) then
821 cmdOK.Caption := 'OK'
822 else
823 begin
824 if Length(txtESCode.Text) > 0 then cmdOK.Caption := 'Sign' else
825 begin
826 if FCouldSign then cmdOK.Caption := 'Don''t Sign' else cmdOK.Caption := 'OK';
827 end;
828 end;
829end;
830
831procedure TfrmReview.cmdOKClick(Sender: TObject);
832{ validate the electronic signature & call SaveSignItem for the encounter }
833const
834 TX_NOSIGN = 'Save items without signing?';
835 TC_NOSIGN = 'No Signature Entered';
836 TX_SAVERR1 = 'The error, ';
837 TX_SAVERR2 = ', occurred while trying to save:' + CRLF + CRLF;
838 TC_SAVERR = 'Error Saving Order';
839var
840 i, idx, AType, PrintLoc, theSts: Integer;
841 SigSts, RelSts, Nature: Char;
842 ESCode, AnID, AnErrMsg: string;
843 ChangeItem: TChangeItem;
844 OrderList: TStringList;
845 SaveCoPay: boolean;
846 DigSigErr, DigStoreErr, CryptoChecked: Boolean;
847 SigData, SigUser, SigDrugSch, SigDEA: string;
848 cSignature, cHashData, cCrlUrl, cErr: string;
849 cProvDUZ: Int64;
850
851 function OrdersSignedOrReleased: Boolean;
852 var
853 i: Integer;
854 begin
855 Result := False;
856 for i := 0 to Pred(OrderList.Count) do
857 begin
858 if Pos('R', Piece(OrderList[i], U, 2)) > 0 then Result := True;
859 if Pos('S', Piece(OrderList[i], U, 2)) > 0 then Result := True;
860 if Result then Break;
861 end;
862 end;
863
864 function OrdersToBeSignedOrReleased: Boolean;
865 var
866 i: Integer;
867 s,x: string;
868 begin
869 Result := FALSE;
870
871 for i := 0 to Pred(OrderList.Count) do
872 begin
873 s := Piece(OrderList[i], U, 2);
874 x := s[1];
875 if ((s <> '') and (s[1] in [SS_ONCHART, SS_ESIGNED, SS_NOTREQD])) or
876 (Piece(OrderList[i], U, 3) = RS_RELEASE) then
877 begin
878 Result := TRUE;
879 Break;
880 end;
881 end;
882 end;
883
884
885begin
886 ESCode := '';
887 SaveCoPay := FALSE;
888 PrintLoc := 0;
889 if BILLING_AWARE then
890 begin
891 if Assigned(UBAGlobals.UnsignedOrders) then
892 UBAGlobals.UnsignedOrders.Clear;
893 end;
894 if pnlSignature.Visible then
895 begin
896 ESCode := txtESCode.Text;
897
898 if ItemsAreChecked and (Length(ESCode) > 0) and (not ValidESCode(ESCode)) then
899 begin
900 InfoBox(TX_INVAL_MSG, TX_INVAL_CAP, MB_OK);
901 txtESCode.SetFocus;
902 txtESCode.SelectAll;
903 Exit;
904 end;
905 if Length(ESCode) > 0 then ESCode := Encrypt(ESCode);
906 end; {if pnlSignature}
907
908 if not frmFrame.Closing then
909 begin
910 { save/sign orders }
911 OrderList := TStringList.Create;
912 DigSigErr := True;
913 CryptoChecked := False;
914 try
915 Nature := NO_PROVIDER;
916 case User.OrderRole of
917 OR_NOKEY, OR_CLERK, OR_NURSE, OR_STUDENT:
918 begin
919 SigSts := SS_UNSIGNED; // default to med student values
920 RelSts := RS_HOLD;
921 Nature := NO_WRITTEN;
922 if User.OrderRole in [OR_CLERK, OR_NURSE] then
923 begin
924 if radSignChart.Checked then SigSts := SS_ONCHART else SigSts := SS_UNSIGNED;
925 if radRelease.Checked or radSignChart.Checked
926 then RelSts := RS_RELEASE
927 else RelSts := RS_HOLD;
928 if radSignChart.Checked or radHoldSign.Checked then Nature := NO_WRITTEN
929 else if radVerbal.Checked then Nature := NO_VERBAL
930 else if radPhone.Checked then Nature := NO_PHONE
931 else if radPolicy.Checked then Nature := NO_POLICY
932 else Nature := NO_WRITTEN;
933 if not pnlOrderAction.Visible then // if no orders require a signature
934 begin
935 RelSts := RS_RELEASE;
936 Nature := NO_PROVIDER;
937 SigSts := SS_NOTREQD;
938 end;
939 // the following was added due to patch OR*3.0*86
940 if RelSts = RS_RELEASE then
941 begin
942 StatusText('Validating Release...');
943 AnErrMsg := '';
944 for i := 0 to lstReview.Items.Count - 1 do
945 begin
946 ChangeItem := TChangeItem(lstReview.Items.Objects[i]);
947 if (ChangeItem <> nil) and (ChangeItem.ItemType = CH_ORD) then
948 begin
949 ValidateOrderActionNature(ChangeItem.ID, OA_RELEASE, Nature, AnErrMsg);
950 if Length(AnErrMsg) > 0 then
951 begin
952 if IsInvalidActionWarning(ChangeItem.Text, ChangeItem.ID) then Break;
953 InfoBox(ChangeItem.Text + TX_NO_REL + AnErrMsg, TC_NO_REL, MB_OK);
954 Break;
955 end; {if Length(AnErrMsg)}
956 end; {if ChangeItem=CH_ORD}
957 end; {for}
958 StatusText('');
959 if Length(AnErrMsg) > 0 then Exit;
960 end; {if RelSts}
961 // the following supports the change to allow nurses to sign policy orders
962 if FSilent then RelSts := RS_HOLD;
963 if (RelSts = RS_RELEASE) and pnlOrderAction.Visible then
964 begin
965 SignatureForItem(Font.Size, TX_ES_REQ, TC_ES_REQ, ESCode);
966 if ESCode = '' then Exit;
967 if Nature = NO_POLICY then SigSts := SS_ESIGNED;
968 end;
969 end; {if..ORCLERK, OR_NURSE}
970
971 with lstReview do for i := 0 to Items.Count - 1 do
972 begin
973 ChangeItem := TChangeItem(Items.Objects[i]);
974 if (ChangeItem <> nil) and (ChangeItem.ItemType = CH_ORD) and (not radSignChart.Checked) then
975 begin
976 OrderList.Add(ChangeItem.ID + U + SigSts + U + RelSts + U + Nature);
977 if BILLING_AWARE then
978 if not (User.DUZ = 0) and PersonHasKey(User.DUZ, 'PROVIDER') then
979 UBACore.SaveUnsignedOrders(ChangeItem.ID+ '1' + GetCheckBoxStatus(ChangeItem.ID) )
980 end
981 else if (ChangeItem <> nil) and (ChangeItem.ItemType = CH_ORD) and (radSignChart.Checked) then
982 OrderList.Add(ChangeItem.ID + U + SS_ONCHART + U + RS_RELEASE + U + NO_WRITTEN);
983
984 end; {with lstReview}
985 end; {OR_NOKEY, OR_CLERK, OR_NURSE, OR_STUDENT}
986
987 OR_PHYSICIAN:
988 begin
989 Nature := NO_PROVIDER;
990 with lstReview do for i := 0 to Items.Count - 1 do
991 begin
992 DigStoreErr := false;
993 ChangeItem := TChangeItem(Items.Objects[i]);
994 if (ChangeItem <> nil) and (ChangeItem.ItemType = CH_ORD) then
995 begin
996 case State[i] of
997 cbChecked: if Length(ESCode) > 0 then
998 begin
999 SigSts := SS_ESIGNED;
1000 RelSts := RS_RELEASE;
1001 if (OrderRequiresDigitalSignature(ChangeItem.ID)) and (CryptoChecked = false)
1002 and GetPKISite and GetPKIUse then
1003 begin
1004 Cryptochecked := true;
1005 try //PKI object creation
1006 crypto := CoXuDigSigS.Create;
1007 crypto.GetCSP;
1008 StatusText(crypto.Reason);
1009 DigSigErr := False;
1010 except
1011 on E: Exception do
1012 begin
1013 DigSigErr := True;
1014 end;
1015 end;
1016 end;
1017 if (DigSigErr = false) and (OrderRequiresDigitalSignature(ChangeItem.ID))
1018 and (SigItems.OK2SaveSettings) then
1019 begin
1020 StatusText('Retrieving DIGITAL SIGNATURE');
1021 SigDrugSch := GetDrugSchedule(ChangeItem.ID);
1022 SigData := SetExternalText(ChangeItem.ID,SigDrugSch,User.DUZ);
1023 if Length(SigData) < 1 then
1024 begin
1025 ShowMessage(ChangeItem.Text + CRLF + CRLF + 'Digital Signature failed with reason: Unable to get required data from server');
1026 DigStoreErr := true;
1027 end;
1028 SigUser := piece(SigData,'^',18);
1029 SigDEA := piece(SigData,'^',20);
1030 cProvDUZ := User.DUZ;
1031 if DigStoreErr = false then
1032 try
1033 crypto.Reset;
1034 crypto.DEAsig := true;
1035 crypto.UsrName := SigUser;
1036 crypto.DrugSch := SigDrugSch;
1037 crypto.UsrNumber := SigDEA;
1038 crypto.DataBuffer := SigData;
1039 if crypto.Signdata = true then
1040 begin
1041 cSignature := crypto.Signature;
1042 cHashData := crypto.HashValue;
1043 cCrlUrl := crypto.CrlUrl;
1044 end
1045 else
1046 begin
1047 ShowMessage(ChangeItem.Text + CRLF + CRLF + 'Digital Signature failed with reason: '+ piece(Crypto.Reason, '^', 2));
1048 DigStoreErr := true;
1049 end;
1050 except
1051 on E: Exception do
1052 begin
1053 ShowMessage(ChangeItem.Text + CRLF + CRLF + 'Crypto raised an error: '+ E.Message);
1054 DigStoreErr := true;
1055 end;
1056 end; //except
1057 if DigStoreErr = true then //PKI
1058 //NoOp
1059 else
1060 begin
1061 cErr := '';
1062 StoreDigitalSig(ChangeItem.ID, cHashData, cProvDUZ, cSignature, cCrlUrl, cErr);
1063 if cErr = '' then
1064 OrderList.Add(ChangeItem.ID + U + SS_DIGSIG + U + RS_RELEASE + U + Nature);
1065 end;
1066 end
1067 else
1068 begin
1069 if GetPKISite and (OrderRequiresDigitalSignature(ChangeItem.ID)) then
1070 begin
1071 ShowMessage('ORDER NOT SENT TO PHARMACY' + CRLF + CRLF + ChangeItem.Text + CRLF + CRLF +
1072 'This Schedule II medication cannot be electronically entered without a Digital Signature. ' +
1073 CRLF + 'Please discontinue/cancel this order and create a hand written order for manual processing, or digitally sign the order at a PKI-enabled workstation.');
1074 end
1075 else
1076 OrderList.Add(ChangeItem.ID + U + SigSts + U + RelSts + U + Nature);
1077 end;
1078 end else
1079 begin
1080 if BILLING_AWARE then
1081 UBACore.SaveUnsignedOrders(ChangeItem.ID+ '1' + GetCheckBoxStatus(ChangeItem.ID) );
1082 SigSts := SS_UNSIGNED;
1083 RelSts := RS_HOLD;
1084 end;
1085 cbGrayed: if OrderRequiresSignature(ChangeItem.ID) then
1086 begin
1087 SigSts := SS_UNSIGNED;
1088 RelSts := RS_HOLD;
1089 end else
1090 begin
1091 SigSts := SS_NOTREQD;
1092 RelSts := RS_RELEASE;
1093 end;
1094 else begin // (cbUnchecked)
1095 SigSts := SS_UNSIGNED;
1096 RelSts := RS_HOLD;
1097 end;
1098 end; {case State}
1099
1100 if (ChangeItem.GroupName = 'Other Unsigned') and (SigSts = SS_UNSIGNED) and (RelSts = RS_HOLD)
1101 then //NoOp - don't add unsigned orders from outside session to the list
1102 else
1103 begin
1104 if not(State[i] = cbChecked) and (OrderList.IndexOf(ChangeItem.ID + U + SigSts + U + RelSts + U + Nature) < 0) then
1105 OrderList.Add(ChangeItem.ID + U + SigSts + U + RelSts + U + Nature)
1106 else if (cmdOK.Caption = 'Don''t Sign') and (OrderList.IndexOf(ChangeItem.ID + U + SigSts + U + RelSts + U + Nature) < 0) then
1107 OrderList.Add(ChangeItem.ID + U + SigSts + U + RelSts + U + Nature);
1108 end;
1109 end; {if ItemType}
1110 end; {with lstReview}
1111 end; {OR_PHYSICIAN}
1112 end; {case User.OrderRole}
1113 if BILLING_AWARE then
1114 if UBAGLobals.UnsignedOrders.Count > 0 then
1115 UBACore.BuildSaveUnsignedList(uBAGLobals.UnsignedOrders);
1116
1117 // if true BA data in not mandatory.
1118 if not IsUserNurseProvider(User.DUZ) then
1119 begin
1120 if OrdersToBeSignedOrReleased then
1121 begin
1122 if (not SigItems.OK2SaveSettings) then
1123 begin
1124 if (cmdOk.Caption = 'Don''t Sign') then
1125 SaveCoPay := TRUE
1126 else
1127 begin
1128 if BILLING_AWARE then
1129 InfoBox(TX_Order_Error, 'Review/Sign Orders', MB_OK)
1130 else
1131 InfoBox(TC_Order_Error, 'Review/Sign Orders', MB_OK);
1132 Exit;
1133 end
1134 end
1135 else
1136 SaveCoPay := TRUE;
1137 end
1138 else
1139 SaveCoPay := TRUE;
1140
1141 {Begin BillingAware}
1142 if BILLING_AWARE then
1143 begin
1144 if (cmdOk.Caption = 'Sign') then
1145 begin
1146 if Not UBACore.BADxEntered then
1147 begin
1148 InfoBox(TX_NO_DX, TC_NO_DX, MB_OK);
1149 Exit;
1150 end;
1151 end;
1152 {End BillingAware}
1153 end;
1154 end;
1155
1156 {release & print orders}
1157 // test for LockedForOrdering is to make sure patient is locked if pulling in all unsigned
1158 if (User.OrderRole in [OR_NOKEY..OR_STUDENT]) and (OrderList.Count > 0) and LockedForOrdering then
1159 begin
1160 ExecuteSessionOrderChecks(OrderList); // any cancelled orders will be removed from OrderList
1161 StatusText('Sending Orders to Service(s)...');
1162 if OrderList.Count > 0 then
1163 begin
1164
1165 //hds7591 Clinic/Ward movement. Nurse orders
1166 if (cmdOk.Caption = 'Sign') or (cmdOK.Caption = 'OK') and (not frmFrame.TimedOut) then
1167 begin
1168 if IsValidIMOLoc(uCore.TempEncounterLoc,Patient.DFN) then
1169 frmClinicWardMeds.ClinicOrWardLocation(OrderList, uCore.TempEncounterLoc,uCore.TempEncounterLocName, PrintLoc)
1170 else
1171 if (IsValidIMOLoc(Encounter.Location,Patient.DFN)) and ((frmClinicWardMeds.rpcIsPatientOnWard(patient.DFN)) and (Patient.Inpatient = false)) then
1172 frmClinicWardMeds.ClinicOrWardLocation(OrderList, Encounter.Location,Encounter.LocationName, PrintLoc);
1173 end;
1174 uCore.TempEncounterLoc := 0;
1175 uCore.TempEncounterLocName := '';
1176 end;
1177 //hds7591 Clinic/Ward movement.
1178
1179 if SaveCoPay then
1180 SigItems.SaveSettings; // Save CoPay FIRST
1181 SendOrders(OrderList, ESCode); {*KCM*}
1182
1183 with OrderList do for i := 0 to Count - 1 do
1184 begin
1185 if Pos('E', Piece(OrderList[i], U, 2)) > 0 then
1186 begin
1187 ChangeItem := Changes.Locate(CH_ORD, Piece(OrderList[i], U, 1));
1188 if not FSilent then InfoBox(TX_SAVERR1 + Piece(OrderList[i], U, 4) + TX_SAVERR2 + ChangeItem.Text,
1189 TC_SAVERR, MB_OK);
1190 end;
1191 if Pos('R', Piece(OrderList[i], U, 2)) > 0 then
1192 NotifyOtherApps(NAE_ORDER, 'RL' + U + Piece(OrderList[i], U, 1));
1193 end;
1194 if OrdersSignedOrReleased and (not FSilent) then
1195 begin
1196 for idx := OrderList.Count - 1 downto 0 do
1197 begin
1198 if Pos('E', Piece(OrderList[idx], U, 2)) > 0 then
1199 begin
1200 OrderList.Delete(idx);
1201 Continue;
1202 end;
1203 theSts := GetOrderStatus(Piece(OrderList[idx],U,1));
1204 if theSts = 10 then OrderList.Delete(idx); //signed delayed order should not be printed.
1205 end;
1206 PrintOrdersOnSignRelease(OrderList, Nature, PrintLoc);
1207 end;
1208 StatusText('');
1209 UpdateUnsignedOrderAlerts(Patient.DFN);
1210 with Notifications do
1211 if Active and (FollowUp = NF_ORDER_REQUIRES_ELEC_SIGNATURE) then
1212 UnsignedOrderAlertFollowup(Piece(RecordID, U, 2));
1213 UpdateExpiringMedAlerts(Patient.DFN);
1214 UpdateUnverifiedMedAlerts(Patient.DFN);
1215 UpdateUnverifiedOrderAlerts(Patient.DFN);
1216 SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_SIGN, 0);
1217 end; {if User.OrderRole}
1218
1219 finally
1220 FreeAndNil(OrderList);
1221 end;
1222 crypto := nil;
1223 end;
1224
1225 { save/sign documents }
1226 //with lstReview do for i := 0 to Items.Count - 1 do
1227 with lstReview do for i := 0 to Items.Count - 1 do
1228 begin
1229 ChangeItem := TChangeItem(Items.Objects[i]);
1230 if ChangeItem <> nil then with ChangeItem do
1231 case ItemType of
1232 CH_DOC: if Checked[i]
1233 then frmNotes.SaveSignItem(ChangeItem.ID, ESCode)
1234 else frmNotes.SaveSignItem(ChangeItem.ID, '');
1235 CH_CON: if Checked[i]
1236 then frmConsults.SaveSignItem(ChangeItem.ID, ESCode)
1237 else frmConsults.SaveSignItem(ChangeItem.ID, '');
1238 CH_SUM: if Checked[i]
1239 then frmDCSumm.SaveSignItem(ChangeItem.ID, ESCode)
1240 else frmDCSumm.SaveSignItem(ChangeItem.ID, '');
1241 CH_SUR: if Assigned(frmSurgery) then
1242 begin
1243 if Checked[i]
1244 then frmSurgery.SaveSignItem(ChangeItem.ID, ESCode)
1245 else frmSurgery.SaveSignItem(ChangeItem.ID, '');
1246 end;
1247 end; {case}
1248 end; {with lstReview}
1249 if frmFrame.Closing then exit;
1250
1251 // clear all the items that were on the list (but not all in Changes)
1252 with lstReview do for i := Items.Count - 1 downto 0 do
1253 begin
1254 if (not Assigned(Items.Objects[i])) then continue; {**RV**}
1255 ChangeItem := TChangeItem(Items.Objects[i]);
1256 if ChangeItem <> nil then
1257 begin
1258 AnID := ChangeItem.ID;
1259 AType := ChangeItem.ItemType;
1260 Changes.Remove(AType, AnID);
1261 end;
1262 end;
1263 UnlockIfAble;
1264 FOKPressed := True;
1265 Close;
1266end;
1267
1268procedure TfrmReview.CleanupChangesList(Sender: TObject; ChangeItem: TChangeItem);
1269{Added for v15.3 - called by Changes.Remove, but only if fReview in progress}
1270var
1271 i: integer;
1272begin
1273 with lstReview do
1274 begin
1275 i := Items.IndexOfObject(ChangeItem);
1276 if i > -1 then
1277 begin
1278 TChangeItem(Items.Objects[i]).Free;
1279 Items.Objects[i] := nil;
1280 end;
1281 end;
1282end;
1283
1284procedure TfrmReview.cmdCancelClick(Sender: TObject);
1285{ cancelled - do nothing }
1286begin
1287 Inherited;
1288 Close;
1289end;
1290
1291procedure TfrmReview.lstReviewMeasureItem(Control: TWinControl;
1292 Index: Integer; var AHeight: Integer);
1293var
1294 x:string;
1295 ARect: TRect;
1296begin
1297 inherited;
1298 AHeight := SigItemHeight;
1299 with lstReview do if Index < Items.Count then
1300 begin
1301 ARect := ItemRect(Index);
1302 Canvas.FillRect(ARect);
1303 x := FilteredString(Items[Index]);
1304 AHeight := WrappedTextHeightByFont( lstReview.Canvas, Font, x, ARect);
1305 if AHeight > 255 then AHeight := 255;
1306 //-------------------
1307 {Bug fix-HDS00001627}
1308 //if AHeight < 13 then AHeight := 13; {ORIG}
1309 if AHeight < 13 then AHeight := 15;
1310 //-------------------
1311 end;
1312end;
1313
1314procedure TfrmReview.FormDestroy(Sender: TObject);
1315begin
1316 Application.HintPause := FOldHintPause;
1317 Application.HintHidePause := FOldHintHidePause;
1318end;
1319
1320
1321procedure TfrmReview.lstReviewMouseMove(Sender: TObject;
1322 Shift: TShiftState; X, Y: Integer);
1323var
1324 Itm: integer;
1325
1326 {Begin BillingAware}
1327 tempRec: UBAGlobals.TBADxRecord;
1328 i: smallint;
1329 thisOrderID: string;
1330 {End BillingAware}
1331
1332begin
1333 inherited;
1334 Itm := lstReview.ItemAtPos(Point(X, Y), TRUE);
1335 if (Itm >= 0) then
1336 begin
1337 if (Itm <> FLastHintItem) then
1338 begin
1339 Application.CancelHint;
1340 //ORIG lstReview.Hint := TrimRight(lstReview.Items[Itm]);
1341 {Begin BillingAware}
1342 if BILLING_AWARE then
1343 begin
1344 if frmFrame.TimedOut then Exit;
1345 //Billing Awareness 'flyover' hint includes Dx code(s) when Dx code(s) have been assigned to an order
1346
1347 if Assigned(frmReview) then
1348 if Assigned(fReview.frmReview.lstReview.Items.Objects[Itm]) then
1349 thisOrderID := TOrder(fReview.frmReview.lstReview.Items.Objects[Itm]).ID;
1350
1351 if UBAGlobals.tempDxNodeExists(thisOrderID) then
1352 begin
1353 if Assigned(tempDxList) then
1354 try
1355 for i := 0 to (tempDxList.Count - 1) do
1356 begin
1357 tempRec := TBADxRecord(tempDxList.Items[i]);
1358
1359 if Assigned(tempRec) then
1360 if (tempRec.FOrderID = thisOrderID) then
1361 begin
1362 with tempRec do
1363 begin
1364 FBADxCode := StringReplace(tempRec.FBADxCode,'^',':',[rfReplaceAll]);
1365 FBASecDx1 := StringReplace(tempRec.FBASecDx1,'^',':',[rfReplaceAll]);
1366 FBASecDx2 := StringReplace(tempRec.FBASecDx2,'^',':',[rfReplaceAll]);;
1367 FBASecDx3 := StringReplace(tempRec.FBASecDx3,'^',':',[rfReplaceAll]);
1368 end;
1369
1370 lstReview.Hint := TrimRight(lstReview.Items[Itm] + #13 +
1371 tempRec.FBADxCode + #13 + tempRec.FBASecDx1 + #13 + tempRec.FBASecDx2 + #13 + tempRec.FBASecDx3);
1372 end
1373 end //for
1374 except
1375 on EListError do
1376 begin
1377 {$ifdef debug}ShowMessage('EListError in fReview.lstReviewMouseMove()');{$endif}
1378 raise;
1379 end;
1380 end;
1381 end
1382 else
1383 lstReview.Hint := TrimRight(lstReview.Items[Itm]);
1384 end;
1385{End BillingAware}
1386
1387 FLastHintItem := Itm;
1388 Application.ActivateHint(Point(X, Y));
1389 end;
1390 end
1391 else
1392 begin
1393 lstReview.Hint := '';
1394 FLastHintItem := -1;
1395 Application.CancelHint;
1396 end;
1397end;
1398
1399procedure TfrmReview.buDiagnosisClick(Sender: TObject);
1400{Begin BillingAware}
1401var
1402 i: smallint;
1403 thisOrderID: string;
1404 match: boolean;
1405 allBlank: boolean;
1406 numSelected: smallint;
1407 tmpOrderIDList: TStringList;
1408 thisChangeItem: TChangeItem;
1409{End BillingAware}
1410begin
1411{Begin BillingAware}
1412try
1413 if BILLING_AWARE then
1414 begin
1415 //Prevent user from attempting to process first row - It is not an order!
1416 //if lstReview.ItemIndex = 0 then
1417 //Exit;
1418
1419 tmpOrderIDList := TStringList.Create;
1420 if Assigned(tmpOrderIDList) then tmpOrderIDList.Clear;
1421 BAtmpOrderList.Clear;
1422 UBAGlobals.PLFactorsIndexes.Clear;
1423
1424 match := false;
1425 allBlank := false;
1426
1427 try
1428 // User has selected no orders to sign
1429 for i := 0 to fReview.frmReview.lstReview.Items.Count-1 do
1430 begin
1431 if (fReview.frmReview.lstReview.Selected[i]) then
1432 //*********************************
1433 begin //Access Violation fix
1434 thisChangeItem := TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]);
1435 if thisChangeItem = nil then
1436 begin
1437 fReview.frmReview.lstReview.Selected[i] := false;
1438 Continue;
1439 end;
1440 //*********************************
1441 thisOrderID := TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]).ID;
1442 {BAV25 Code} //Used to pass selected orders to Lookup DX form
1443 BAtmpOrderList.Add(TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]).TEXT);
1444 tmpOrderIDList.Add(thisOrderID);
1445 chkBoxStatus := GetCheckBoxStatus(thisOrderID);
1446 UBAGlobals.PLFactorsIndexes.Add(IntToStr(i)+ U + chkBoxStatus);
1447 {BAV25 Code}
1448
1449 // Test for blank Dx on current grid item
1450 if Not (tempDxNodeExists(thisOrderID)) then
1451 if Assigned(UBAGlobals.GlobalDxRec) then
1452 InitializeNewDxRec(UBAGlobals.globalDxRec);
1453 begin
1454 if (tempDxNodeExists(thisOrderID) ) then
1455 if not Assigned(UBAGlobals.globalDxRec) then
1456 begin
1457 UBAGlobals.globalDxRec := UBAGlobals.TBADxRecord.Create;
1458 InitializeNewDxRec(UBAGlobals.globalDxRec);
1459 GetBADxListForOrder(UBAGlobals.globalDxRec, thisOrderID);
1460 end
1461 else
1462 GetBADxListForOrder(UBAGlobals.globalDxRec, thisOrderID);
1463
1464 end
1465 end; //if
1466 end; //for
1467 except
1468 on EListError do
1469 begin
1470 {$ifdef debug}ShowMessage('EListError in fReview.buDiagnosisClick()');{$endif}
1471 raise;
1472 end;
1473 end;
1474
1475 numSelected := CountSelectedOrders(UBAConst.F_REVIEW);
1476
1477 if numSelected = 0 then
1478 begin
1479 ShowMessage(UBAMessages.BA_NO_ORDERS_SELECTED);
1480 Exit;
1481 end
1482 else
1483 if numSelected = 1 then
1484 match := true;
1485
1486 if (UBAGlobals.CompareOrderDx(UBAConst.F_REVIEW)) then
1487 match := true;
1488
1489
1490 if UBAGlobals.AllSelectedDxBlank(UBAConst.F_REVIEW) then
1491 allBlank := true;
1492
1493 if ((match and allBlank) or (match and (not allBlank))) then // All selected are blank or matching-not-blank
1494 begin
1495 frmBALocalDiagnoses.Enter(UBAConst.F_REVIEW, tmpOrderIDList);
1496 end
1497 else
1498 begin
1499 //Warning message
1500 //If 'Yes' on warning message then open localDiagnosis
1501 if (not allBlank) then
1502 if MessageDlg(UBAMessages.BA_CONFIRM_DX_OVERWRITE, mtConfirmation, [mbYes, mbNo], 0) = mrYes then
1503 begin
1504 if Assigned(UBAGlobals.globalDxRec) then
1505 InitializeNewDxRec(UBAGlobals.globalDxRec);
1506 //frmBALocalDiagnoses.Enter(UBAConst.F_REVIEW, tmpOrderIDList);
1507
1508 frmBALocalDiagnoses := TfrmBALocalDiagnoses.Create(frmReview);
1509 frmBALocalDiagnoses.ShowModal;
1510 frmBALocalDiagnoses.Release;
1511
1512 end;
1513 end;
1514 // TFactors come from FBALocalDiagnoses(Problem List Dx's Only).
1515 if Length(UBAGlobals.TFactors) > 0 then
1516 begin
1517 UBACore.SetTreatmentFactors(UBAGlobals.TFactors);
1518 SigItems.DisplayPlTreatmentFactors;
1519 end;
1520 {End BillingAware}
1521 if pnlSignature.Visible then
1522 txtESCode.SetFocus;
1523 end;
1524 finally
1525 if Assigned(tmpOrderIDList) then FreeAndNil(tmpOrderIDList);
1526 end;
1527end;
1528
1529procedure TfrmReview.lstReviewClick(Sender: TObject);
1530//If grid item is an order-able item, then enable the Diagnosis button
1531// else disable the Diagnosis button.
1532{Begin BillingAware}
1533var
1534 thisChangeItem: TChangeItem;
1535 i: smallint;
1536 thisOrderList: TStringList;
1537{End BillingAware}
1538begin
1539thisOrderList := TStringList.Create;
1540
1541{Begin BillingAware}
1542 if BILLING_AWARE then
1543 begin
1544 if lstReview.Items.Count > 1 then
1545 Copy1.Enabled := True
1546 else
1547 Copy1.Enabled := False;
1548
1549 try
1550 for i := 0 to lstReview.Items.Count - 1 do
1551 begin
1552 if lstReview.Selected[i] then
1553 begin
1554 thisChangeItem := TChangeItem(lstReview.Items.Objects[i]);
1555
1556 //Disallow copying of a grid HEADER item on LEFT MOUSE CLICK
1557 if thisChangeItem = nil then
1558 begin
1559 buDiagnosis.Enabled := false;
1560 Copy1.Enabled := false;
1561 Paste1.Enabled := false;
1562 Diagnosis1.Enabled := false;
1563 Exit;
1564 end;
1565
1566 if (thisChangeItem <> nil) then
1567 begin
1568 thisOrderList.Clear;
1569 thisOrderList.Add(thisChangeItem.ID);
1570 // Returns True if All selected orders are N/A, Order selected are NON CIDC or DC'd
1571 if uBACore.IsAllOrdersNA(thisOrderList) then
1572 begin
1573 Diagnosis1.Enabled := false;
1574 buDiagnosis.Enabled := false;
1575 end
1576 else
1577 begin
1578 Diagnosis1.Enabled := true;
1579 buDiagnosis.Enabled := true;
1580 end
1581 end
1582 else
1583 begin
1584 buDiagnosis.Enabled := false;
1585 Diagnosis1.Enabled := False;
1586 Break;
1587 end;
1588 end;
1589 end;
1590 except
1591 on EListError do
1592 begin
1593 {$ifdef debug}ShowMessage('EListError in fReview.lstReviewClick()');{$endif}
1594 raise;
1595 end;
1596 end;
1597 {End BillingAware}
1598 end;
1599 if Assigned(thisOrderList) then thisOrderList.Free;
1600end;
1601
1602procedure TfrmReview.Exit1Click(Sender: TObject);
1603begin
1604 Close;
1605end;
1606
1607procedure TfrmReview.lstReviewMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1608{
1609 - Open copy/paste popup menu.
1610}
1611var
1612 ClientPoint: TPoint;
1613 ScreenPoint: TPoint;
1614 thisChangeItem: TChangeItem;
1615 i: integer;
1616begin
1617 if not BILLING_AWARE then lstReview.PopupMenu := nil;
1618
1619 if BILLING_AWARE then
1620 begin
1621 if Button = mbRight then //Right-click to open copy/paste popup menu
1622 begin
1623 //CQ3325
1624 if frmReview.lstReview.Items.Count = 3 then
1625 begin
1626 Copy1.Enabled := false;
1627 Paste1.Enabled := false
1628 end
1629 else
1630 begin
1631 Copy1.Enabled := true;
1632 //Paste1.Enabled := true; //commented out for CQ6225
1633 end;
1634 //End CQ3325
1635
1636 //CQ HDS00002954 Fix
1637 if Button = mbRight then
1638 //Disallow copying of a grid HEADER item
1639 for i := 0 to lstReview.Items.Count - 1 do
1640 if lstReview.Selected[i] then
1641 begin
1642
1643 thisChangeItem := TChangeItem(lstReview.Items.Objects[i]);
1644
1645 if thisChangeItem = nil then
1646 begin
1647 lstReview.Selected[i] := false;
1648 Copy1.Enabled := false;
1649 Paste1.Enabled := false;
1650 Exit;
1651 end;
1652 end;
1653
1654 if not frmReview.lstReview.Selected[lstReview.ItemIndex] then
1655 (Sender as TCheckListBox).Selected[lstReview.ItemIndex] := true;
1656
1657 ClientPoint.X := X;
1658 ClientPoint.Y := Y;
1659 ScreenPoint := lstReview.ClientToScreen(ClientPoint);
1660 poBACopyPaste.Popup(ScreenPoint.X, ScreenPoint.Y);
1661 end;
1662 end;
1663end;
1664
1665procedure TfrmReview.Copy1Click(Sender: TObject);
1666{
1667 - Copy contents of the 'source' order for copy/paste operation
1668}
1669var
1670 i : byte;
1671 numSelected: byte;
1672 thisChangeItem: TChangeItem;
1673begin
1674 try
1675 if BILLING_AWARE then
1676 begin
1677 Paste1.Enabled := true;
1678
1679 numSelected := GetNumberOfSelectedOrders;
1680
1681 if numSelected > 1 then
1682 begin
1683 ShowMessage('Only 1 order at a time may be selected for ''Copying''');
1684 Exit;
1685 end;
1686
1687
1688 for i := 1 to frmReview.lstReview.Items.Count-1 do
1689 if (frmReview.lstReview.Selected[i]) then
1690 begin
1691 thisChangeItem := TChangeItem.Create;
1692 thisChangeItem := nil;
1693 thisChangeItem := TChangeItem(lstReview.Items.Objects[i]);
1694
1695 //Skip this one if it's a "header" on the grid
1696 if (thisChangeItem = nil) then //or (thisChangeItem.ItemType <> CH_ORD)) then
1697 begin
1698 if Assigned(thisChangeItem) then FreeAndNil(thisChangeItem);
1699 Exit;
1700 end;
1701
1702 fReview.srcOrderID := TChangeItem(frmReview.lstReview.Items.Objects[i]).ID;
1703
1704 //Copy source order to COPY BUFFER and add it to the Dx List
1705 CopyBuffer := TBADxRecord.Create;
1706 InitializeNewDxRec(CopyBuffer);
1707 GetBADxListForOrder(CopyBuffer, fReview.srcOrderID);
1708 fReview.CopyBuffer.FOrderID := BUFFER_ORDER_ID;
1709 UBAGlobals.tempDxList.Add(CopyBuffer);
1710
1711 //***********************************************************************
1712 if Not UBACore.IsOrderBillable(fReview.srcOrderID) then
1713 begin
1714 ShowMessage(BA_NA_COPY_DISALLOWED);
1715 //Continue;
1716 fReview.srcOrderID := '';
1717 Exit;
1718 end;
1719 //***********************************************************************
1720
1721 fReview.srcIndex := lstReview.ItemIndex;
1722 fReview.chkBoxStatus := GetCheckBoxStatus(fReview.srcOrderID);
1723 Break;
1724 end;
1725 end; //if BILLING_AWARE
1726 except
1727 on EListError do
1728 begin
1729 {$ifdef debug}ShowMessage('EListError in fReview.Copy1Click()');{$endif}
1730 raise
1731 end;
1732 end;
1733end;
1734
1735procedure TfrmReview.Paste1Click(Sender: TObject);
1736{
1737 - Populate 'target' orders of a copy/paste operation with contents of 'source' order
1738}
1739var
1740 i: byte;
1741 thisChangeItem: TChangeItem;
1742 newRec: TBADxRecord;
1743begin
1744 if BILLING_AWARE then
1745 begin
1746 if not Assigned(fReview.CopyBuffer) then //CQ5414
1747 fReview.CopyBuffer := TBADxRecord.Create; //CQ5414
1748
1749 try
1750 for i := 1 to lstReview.Count - 1 do
1751 begin
1752 if (frmReview.lstReview.Selected[i]) then
1753 begin
1754 thisChangeItem := TChangeItem(lstReview.Items.Objects[i]);
1755
1756 //Skip this one if it's a "header" on the grid
1757 if (thisChangeItem = nil) then
1758 Continue;
1759
1760 if (fReview.frmReview.lstReview.Selected[i]) then
1761 begin
1762 fReview.targetOrderID := TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]).ID;
1763
1764 if fReview.targetOrderID = fReview.srcOrderID then //disallow copying an order to itself
1765 Continue
1766 else
1767 begin
1768 fReview.CopyBuffer.FOrderID := BUFFER_ORDER_ID;
1769
1770 //***************************************************************
1771 if (NOT UBACore.IsOrderBillable(fReview.targetOrderID) ) then
1772 begin
1773 ShowMessage(BA_NA_PASTE_DISALLOWED);
1774 fReview.targetOrderID := '';
1775 Continue;
1776 end;
1777 //***************************************************************
1778
1779 newRec := TBADxRecord.Create;
1780 with newRec do
1781 begin
1782 FOrderID := fReview.targetOrderID;
1783 FBADxCode := CopyBuffer.FBADxCode;
1784 FBASecDx1 := CopyBuffer.FBASecDx1;
1785 FBASecDx2 := CopyBuffer.FBASecDx2;
1786 FBASecDx3 := CopyBuffer.FBASecDx3;
1787 end;
1788
1789 tempDxList.Add(newRec);
1790
1791 CopyTFCIToTargetOrder(fReview.targetOrderID, fReview.chkBoxStatus);
1792 SetCheckBoxStatus(fReview.targetOrderID); //calls uSignItems.SetSigItems()
1793 end; //else
1794 end; //if
1795 end //if
1796 else
1797 Continue
1798 end; //for
1799 except
1800 on EListError do
1801 begin
1802 {$ifdef debug}ShowMessage('EListError in fReview.Paste1Click()');{$endif}
1803 raise;
1804 end;
1805 end;
1806
1807 end; //if BILLING_AWARE
1808
1809 lstReview.Refresh; //Update grid to show pasted Dx/TF/CI
1810
1811end;
1812
1813procedure TfrmReview.ClearDiagnoses1Click(Sender: TObject);
1814var
1815 selectedOrderIDList: TStringList;
1816 i:integer;
1817begin
1818 selectedOrderIDList := TStringList.Create;
1819 selectedOrderIDList.Clear;
1820
1821 try
1822 for i := 0 to fReview.frmReview.lstReview.Items.Count-1 do
1823 begin
1824 if (fReview.frmReview.lstReview.Selected[i]) then
1825 selectedOrderIDList.Add(TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]).ID);
1826 end;
1827 except
1828 on EListError do
1829 begin
1830 {$ifdef debug}ShowMessage('EListError in fReview.ClearDiagnoses1Click()');{$endif}
1831 raise;
1832 end;
1833 end;
1834
1835 UBACore.ClearSelectedOrderDiagnoses(selectedOrderIDList);
1836end;
1837
1838function TfrmReview.GetNonNilItemCount : integer;
1839//CQ5172
1840var
1841 i: integer;
1842 thisItem: TChangeItem;
1843 howMany: integer;
1844begin
1845 howMany := 0;
1846
1847 for i := 0 to lstReview.Items.Count-1 do
1848 begin
1849 thisItem := TChangeItem(lstReview.Items.Objects[i]);
1850 if thisItem <> nil then
1851 Inc(howMany);
1852 end;
1853
1854 Result := howMany;
1855end;
1856
1857procedure TfrmReview.FormShow(Sender: TObject);
1858var
1859 numOrderItems: integer;
1860begin
1861 //INITIALIZATIONS
1862 Paste1.Enabled := false;
1863 fReview.srcOrderID := '';
1864 fReview.srcDx := '';
1865
1866 //begin BillingAware
1867 if BILLING_AWARE then
1868 frmReview.lstReview.Multiselect := true;
1869 //end BillingAware
1870
1871 FormatListForScreenReader;
1872
1873 //CQ5172
1874 numOrderItems := GetNonNilItemCount;
1875 if BILLING_AWARE then
1876 begin
1877 if (numOrderItems = 1) then
1878 begin
1879 lstReview.Selected[0] := false;
1880 buDiagnosis.Enabled := True;
1881 Diagnosis1.Enabled := True;
1882 lstReview.Selected[1] := true;
1883 // ** if number of orders is 1 and order is billable select order and disable diagnosis button
1884 if NOT UBACore.IsOrderBillable(TChangeItem(frmReview.lstReview.Items.Objects[1]).ID) then
1885 begin
1886 buDiagnosis.Enabled := False;
1887 Diagnosis1.Enabled := False;
1888 lstReview.Selected[1] := false;
1889 end
1890 else
1891 if Piece(TChangeItem(frmReview.lstReview.Items.Objects[1]).ID,';',2) = DISCONTINUED_ORDER then
1892 begin
1893 buDiagnosis.Enabled := False;
1894 Diagnosis1.Enabled :=False ;
1895 end;
1896 end
1897 else
1898 lstReview.Selected[0] := false;
1899 //end CQ5172
1900end;
1901end;
1902
1903procedure TfrmReview.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
1904var
1905 j: integer; //CQ5054
1906begin
1907 currentlySelectedItem := frmReview.lstReview.ItemIndex; //CQ5063
1908
1909 case Key of
1910 67,99: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorSC,fraCoPay.Label24); //C,c
1911 86,118: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorCV,fraCoPay.staticText4); //V,v
1912 79,111: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorAO,fraCoPay.Label18); //O,o
1913 82,114: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorIR,fraCoPay.Label16); //R,r
1914 69,101: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorEC,fraCoPay.Label14); //E,e
1915 77,109: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorMST,fraCoPay.Label12); //M,m
1916 72,104: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorHNC,fraCoPay.lblHNC2); //H,h
1917 //CQ5054
1918 83,115: if (ssAlt in Shift) then
1919 begin
1920 for j := 0 to lstReview.Items.Count-1 do
1921 lstReview.Selected[j] := false;
1922 lstReview.Selected[1] := true;
1923 lstReview.SetFocus;
1924 end;
1925 09:
1926 if FRVTFhintWindowActive then
1927 begin
1928 FRVTFHintWindow.ReleaseHandle;
1929 FRVTFHintWindowActive := False;
1930 end;
1931
1932 //end CQ5054
1933 end;
1934end;
1935
1936procedure TfrmReview.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
1937begin
1938 //CQ5063
1939 if Key = VK_SPACE then
1940 begin
1941 if lstReview.Focused then //CQ6657
1942 begin
1943 lstReview.Selected[lstReview.Items.Count-1] := false;
1944 lstReview.Selected[currentlySelectedItem] := true;
1945 end;
1946 end;
1947 //end CQ5063
1948end;
1949
1950//BILLING AWARE Procedure
1951procedure TfrmReview.ShowTreatmentFactorHints(var pHintText: string; var pCompName: TORStaticText); // 508
1952var
1953 HRect: TRect;
1954 thisRect: TRect;
1955 x,y: integer;
1956
1957begin
1958 if FRVTFhintWindowActive then
1959 begin
1960 FRVTFHintWindow.ReleaseHandle;
1961 FRVTFHintWindowActive := False;
1962 end;
1963
1964 FRVTFHintWindow := THintWindow.Create(frmReview); //(frmReview);
1965 FRVTFHintWindow.Color := clInfoBk;
1966 GetWindowRect(pCompName.Handle,thisRect);
1967 x := thisRect.Left;
1968 y := thisRect.Top;
1969 hrect := FRVTFHintWindow.CalcHintRect(Screen.Width, pHintText,nil);
1970 hrect.Left := hrect.Left + X;
1971 hrect.Right := hrect.Right + X;
1972 hrect.Top := hrect.Top + Y;
1973 hrect.Bottom := hrect.Bottom + Y;
1974
1975 if FRVTFHintWindowActive then
1976 begin
1977 with fraCoPay do
1978 begin
1979 //Abbreviated captions
1980 Label23.ShowHint := false;
1981 StaticText1.ShowHint := false;
1982 Label17.ShowHint := false;
1983 Label15.ShowHint := false;
1984 Label13.ShowHint := false;
1985 Label11.ShowHint := false;
1986 lblHNC.ShowHint := false;
1987 //Long captions
1988 staticText4.ShowHint := false;
1989 Label17.ShowHint := false;
1990 Label18.ShowHint := false;
1991 Label15.ShowHint := false;
1992 Label16.ShowHint := false;
1993 Label13.ShowHint := false;
1994 Label14.ShowHint := false;
1995 Label11.ShowHint := false;
1996 Label12.ShowHint := false;
1997 lblHNC.ShowHint := false;
1998 lblHNC2.ShowHint := false;
1999 end;
2000 end
2001 else
2002 begin
2003 with fraCoPay do
2004 begin
2005 //Abbreviated captions
2006 Label23.ShowHint := true;
2007 StaticText1.ShowHint := true;
2008 Label17.ShowHint := true;
2009 Label15.ShowHint := true;
2010 Label13.ShowHint := true;
2011 Label11.ShowHint := true;
2012 lblHNC.ShowHint := true;
2013 //Long captions
2014 staticText4.ShowHint := true;
2015 Label17.ShowHint := true;
2016 Label18.ShowHint := true;
2017 Label15.ShowHint := true;
2018 Label16.ShowHint := true;
2019 Label13.ShowHint := true;
2020 Label14.ShowHint := true;
2021 Label11.ShowHint := true;
2022 Label12.ShowHint := true;
2023 lblHNC.ShowHint := true;
2024 lblHNC2.ShowHint := true;
2025 end;
2026 end;
2027
2028 FRVTFHintWindow.ActivateHint(hrect, pHintText);
2029 FRVTFHintWindowActive := True;
2030end;
2031
2032
2033procedure TfrmReview.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
2034 Y: Integer);
2035begin
2036// IF BILLING_AWARE then
2037 if FRVTFHintWindowActive then
2038 begin
2039 FRVTFHintWindow.ReleaseHandle;
2040 FRVTFHintWindowActive := False;
2041 end;
2042end;
2043
2044procedure TfrmReview.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
2045begin
2046 if FRVTFHintWindowActive then
2047 begin
2048 FRVTFHintWindow.ReleaseHandle;
2049 FRVTFHintWindowActive := False;
2050 Application.ProcessMessages;
2051 end;
2052end;
2053
2054procedure TfrmReview.fraCoPayLabel24MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
2055begin
2056 if FRVTFHintWindowActive then
2057 begin
2058 with fraCoPay do
2059 begin
2060 //Abbreviated captions
2061 Label23.ShowHint := false;
2062 StaticText1.ShowHint := false;
2063 Label17.ShowHint := false;
2064 Label15.ShowHint := false;
2065 Label13.ShowHint := false;
2066 Label11.ShowHint := false;
2067 lblHNC.ShowHint := false;
2068 //Long captions
2069 Label24.ShowHint := false;
2070 staticText4.ShowHint := false;
2071 Label17.ShowHint := false;
2072 Label18.ShowHint := false;
2073 Label15.ShowHint := false;
2074 Label16.ShowHint := false;
2075 Label13.ShowHint := false;
2076 Label14.ShowHint := false;
2077 Label11.ShowHint := false;
2078 Label12.ShowHint := false;
2079 lblHNC.ShowHint := false;
2080 lblHNC2.ShowHint := false;
2081 end;
2082 end
2083 else
2084 begin
2085 with fraCoPay do
2086 begin
2087 //Abbreviated captions
2088 Label23.ShowHint := true;
2089 StaticText1.ShowHint := true;
2090 Label17.ShowHint := true;
2091 Label15.ShowHint := true;
2092 Label13.ShowHint := true;
2093 Label11.ShowHint := true;
2094 lblHNC.ShowHint := true;
2095 //Long captions
2096 Label24.ShowHint := true;
2097 staticText4.ShowHint := true;
2098 Label17.ShowHint := true;
2099 Label18.ShowHint := true;
2100 Label15.ShowHint := true;
2101 Label16.ShowHint := true;
2102 Label13.ShowHint := true;
2103 Label14.ShowHint := true;
2104 Label11.ShowHint := true;
2105 Label12.ShowHint := true;
2106 lblHNC.ShowHint := true;
2107 lblHNC2.ShowHint := true;
2108 end;
2109 end;
2110end;
2111
2112procedure TfrmReview.FormClose(Sender: TObject; var Action: TCloseAction);
2113begin
2114
2115 if FRVTFHintWindowActive then
2116 begin
2117 FRVTFhintWindow.ReleaseHandle ;
2118 FRVTFHintWindowActive := False ;
2119
2120 with fraCopay do
2121 begin
2122 Label24.ShowHint := false;
2123 staticText4.ShowHint := false;
2124 Label18.ShowHint := false;
2125 Label16.ShowHint := false;
2126 Label14.ShowHint := false;
2127 Label12.ShowHint := false;
2128 lblHNC2.ShowHint := false;
2129 end;
2130 end;
2131
2132// HDS00005143 - if cidc master sw is on and BANurseConsultOrders.Count > 0 then
2133// save those orders with selected DX enteries. Resulting in dx populated for provider.
2134 if rpcGetBAMasterSwStatus then
2135 begin
2136 if BANurseConsultOrders.Count > 0 then
2137 begin
2138 rpcSaveNurseConsultOrder(BANurseConsultOrders);
2139 BANurseConsultOrders.Clear;
2140 end;
2141 end;
2142 {End BillingAware}
2143
2144end;
2145
2146procedure TfrmReview.fraCoPayLabel23Enter(Sender: TObject);
2147begin
2148 (Sender as TORStaticText).Font.Style := [fsBold];
2149end;
2150
2151procedure TfrmReview.fraCoPayLabel23Exit(Sender: TObject);
2152begin
2153 (Sender as TORStaticText).Font.Style := [];
2154end;
2155
2156procedure TfrmReview.SetItemTextToState;
2157var
2158 i : integer;
2159begin
2160
2161 if fReview.frmReview.lstReview.Count < 1 then Exit;
2162 for i := 0 to fReview.frmReview.lstReview.Count-1 do
2163 if fReview.frmReview.lstReview.Items.Objects[i] <> nil then //Not a Group Title
2164 begin
2165 if fReview.frmReview.lstReview.Items.Objects[i] is TChangeItem then
2166 if fReview.frmReview.lstReview.Checked[i] then
2167 fReview.frmReview.lstReview.Items[i] := 'Checked '+TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]).Text
2168 else
2169 fReview.frmReview.lstReview.Items[i] := 'Not Checked '+TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]).Text;
2170 end;
2171 if fReview.frmReview.lstReview.ItemIndex >= 0 then
2172 fReview.frmReview.lstReview.Selected[fReview.frmReview.lstReview.ItemIndex] := True;
2173end;
2174
2175procedure TfrmReview.lstReviewKeyUp(Sender: TObject; var Key: Word;
2176 Shift: TShiftState);
2177begin
2178 if (Key = VK_Space) then
2179 FormatListForScreenReader
2180end;
2181
2182procedure TfrmReview.FormatListForScreenReader;
2183var
2184 ListStateOn : longbool;
2185 Success: longbool;
2186begin
2187 //Determine if a screen reader is currently being used.
2188 Success := SystemParametersInfo(SPI_GETSCREENREADER, 0, @ListStateOn,0);
2189 if Success and ListStateOn then
2190 SetItemTextToState;
2191end;
2192
2193end.
2194
Note: See TracBrowser for help on using the repository browser.