source: cprs/branches/foia-cprs/CPRS-Chart/fReview.pas@ 459

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

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