source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/fReview.pas@ 1806

Last change on this file since 1806 was 1693, checked in by healthsevak, 10 years ago

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