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

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

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