source: cprs/branches/tmg-cprs/CPRS-Chart/fReview.pas@ 1270

Last change on this file since 1270 was 729, checked in by Kevin Toppenberg, 15 years ago

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