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

Last change on this file since 830 was 830, checked in by Kevin Toppenberg, 14 years ago

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