source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fOrdersSign.pas@ 1169

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

Uploading from OR_30_258
File size: 51.5 KB
RevLine 
[459]1unit fOrdersSign;
2
3{.$define debug}
4
5interface
6
7uses
8 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
9 fAutoSz, StdCtrls, ORFn, ORCtrls, AppEvnts, mCoPayDesc, XUDIGSIGSC_TLB,
10 ComCtrls, CheckLst, ExtCtrls, uConsults, UBAGlobals,UBACore, UBAMessages, UBAConst,
11 Menus, ORClasses;
12
13type
14 TfrmSignOrders = class(TForm)
15 cmdOK: TButton;
16 cmdCancel: TButton;
17 lblESCode: TLabel;
18 txtESCode: TCaptionEdit;
19 fraCoPay: TfraCoPayDesc;
20 clstOrders: TCaptionCheckListBox;
21 laDiagnosis: TLabel;
22 gbdxLookup: TGroupBox;
23 buOrdersDiagnosis: TButton;
24 poBACopyPaste: TPopupMenu;
25 Copy1: TMenuItem;
26 Paste1: TMenuItem;
27 Diagnosis1: TMenuItem;
28 Exit1: TMenuItem;
29 Label2: TStaticText;
30 procedure FormCreate(Sender: TObject);
31 procedure cmdOKClick(Sender: TObject);
32 procedure cmdCancelClick(Sender: TObject);
33 procedure FormDestroy(Sender: TObject);
34 procedure clstOrdersDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
35 procedure clstOrdersMeasureItem(Control: TWinControl; Index: Integer; var AHeight: Integer);
36 procedure clstOrdersClickCheck(Sender: TObject);
37 procedure clstOrdersMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
38 procedure FormShow(Sender: TObject);
39 procedure buOrdersDiagnosisClick(Sender: TObject);
40 function IsSignatureRequired:boolean;
41 procedure Exit1Click(Sender: TObject);
42 procedure Copy1Click(Sender: TObject);
43 procedure Paste1Click(Sender: TObject);
44 procedure clstOrdersMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
45 procedure clstOrdersClick(Sender: TObject);
46 procedure FormKeyDown(Sender: TObject; var Key: Word;
47 Shift: TShiftState);
48 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
49 Y: Integer);
50 procedure fraCoPaylblHNCMouseMove(Sender: TObject; Shift: TShiftState;
51 X, Y: Integer);
52 procedure fraCoPayLabel23Enter(Sender: TObject);
53 procedure fraCoPayLabel23Exit(Sender: TObject);
54 procedure clstOrdersKeyUp(Sender: TObject; var Key: Word;
55 Shift: TShiftState);
56 private
57 OKPressed: Boolean;
58 ESCode: string;
59 FLastHintItem: integer;
60 FOldHintPause: integer;
61 FOldHintHidePause: integer;
62 function ItemsAreChecked: Boolean;
63 function GetNumberOfSelectedOrders : byte;
64 procedure ShowTreatmentFactorHints(var pHintText: string; var pCompName: TORStaticText); // 508
65 procedure SetItemTextToState;
66 procedure FormatListForScreenReader;
67 public
68 procedure SetCheckBoxStatus(thisOrderID: string);
69 function GetCheckBoxStatus(sourceOrderID : string) : string; overload;
70
71end;
72
73{Begin BillingAware}
74 { TODO 3 -oKW -cRefinement : Change to dynamic array or other dynamic structure for Billing Awareness Phase II. }
75 TarRect = array[MIN_RECT..MAX_RECT] of TRect;
76
77 var
78 thisRect: TRect;
79 j: shortint;
80 ARect: TRect;
81 arRect: TarRect;
82 ProvDx: TProvisionalDiagnosis;
83 FOSTFHintWndActive: boolean;
84 FOSTFhintWindow: THintWindow;
85 tempList : TList;
86
87{End BillingAware}
88
89{Forward} function ExecuteSignOrders(SelectedList: TList): Boolean;
90
91var
92 crypto: IXuDigSigS;
93 rectIndex: Integer;
94
95 {Begin BillingAware}
96 frmSignOrders: TfrmSignOrders;
97 chkBoxStatus: string;
98 srcOrderID: string;
99 targetOrderID: string;
100 tempStrList: TStringList;
101 srcDx: string;
102 tempBillableList :TStringList;
103 tempOrderList: TStringList;
104 copyOrderID: string;
105 srcIndex: integer;
106 CopyBuffer: TBADxRecord;
107 //CopyActive: boolean; //CQ6225
108 {End BillingAware}
109
110implementation
111
112{$R *.DFM}
113
114uses
115 Hash, rCore, rOrders, uConst, fOrdersPrint, uCore, uOrders, uSignItems, fOrders,
[460]116 fPCELex, rPCE, fODConsult, fBALocalDiagnoses, fClinicWardMeds, fFrame;
[459]117
118const
119 TX_SAVERR1 = 'The error, ';
120 TX_SAVERR2 = ', occurred while trying to save:' + CRLF + CRLF;
121 TC_SAVERR = 'Error Saving Order';
122
123function TfrmSignOrders.GetNumberOfSelectedOrders : byte;
124{
125 - Return the number of orders in clstOrders that are currently selected.
126}
127var
128 i: integer;
129 numSelected: byte;
130begin
131 Result := 0;
132 if BILLING_AWARE then
133 begin
134 numSelected := 0;
135
136 try
137 for i := 0 to fOrdersSign.frmSignOrders.clstOrders.Items.Count-1 do
138 if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then
139 Inc(numSelected);
140 except
141 on EListError do
142 begin
143 {$ifdef debug}ShowMessage('EListError in frmSignOrders.GetNumberOfSelectedOrders()');{$endif}
144 raise;
145 end;
146 end;
147
148 Result := numSelected;
149 end;
150end;
151
152procedure TfrmSignOrders.SetCheckBoxStatus(thisOrderID: string);
153{
154 - Set the current GRID checkboxes status
155}
156begin
157 if BILLING_AWARE then
158 begin
159 uSignItems.uSigItems.SetSigItems(clstOrders, thisOrderID);
160 end;
161end;
162
163function TfrmSignOrders.GetCheckBoxStatus(sourceOrderID: string) : string; //PASS IN ORDER ID - NOT GRID INDEX
164{
165- Obtain checkbox status for selected order - BY ORDER ID
166}
167var
168 itemsList: TStringList;
169 i: smallint;
170 thisOrderID: string;
171begin
172 Result := '';
173 itemsList := TStringList.Create;
174 itemsList.Clear;
175 itemsList := uSigItems.GetSigItems; //Get FItems list
176
177 if BILLING_AWARE then
178 begin
179 try
180 for i := 0 to itemsList.Count-1 do
181 begin
182 thisOrderID := Piece(itemsList[i],'^',1); //get the order ID
183 if thisOrderID = sourceOrderID then //compare to order ID of source order
184 begin
185 Result := Piece(itemsList[i],U,4); //return TF status'
186 Break;
187 end;
188 end;
189 except
190 on EListError do
191 begin
192 {$ifdef debug}ShowMessage('EListError in frmSignOrders.GetCheckBoxStatus()');{$endif}
193 raise;
194 end;
195 end;
196 end;
197end;
198
199function ExecuteSignOrders(SelectedList: TList): Boolean;
200var
201 i, cidx,cnt, theSts: Integer;
202 ShrinkHeight: integer;
203 SignList: TStringList;
204 Obj: TOrder;
205 DigSigErr, DigStoreErr: Boolean;
206 x, SigData, SigUser, SigDrugSch, SigDEA: string;
207 cSignature, cHashData, cCrlUrl, cErr: string;
208 cProvDUZ: Int64;
209 OrderText: string;
[460]210 PrintLoc: Integer;
[459]211 // tempOrderID: string;
212
213 function FindOrderText(const AnID: string): string;
214 var
215 i: Integer;
216 begin
217 Result := '';
218 fOrdersSign.tempList := selectedList;
219 with SelectedList do for i := 0 to Count - 1 do
220 with TOrder(Items[i]) do if ID = AnID then
221 begin
222 Result := Text;
223 Break;
224 end;
225 end;
226
227 function SignNotRequired: Boolean;
228 var
229 i: Integer;
230 begin
231 Result := True;
232 tempList := SelectedList;
233 with SelectedList do for i := 0 to Pred(Count) do
234 begin
235 with TOrder(Items[i]) do if Signature <> OSS_NOT_REQUIRE then Result := False;
236 end;
237 end;
238
239 function DigitalSign: Boolean;
240 var
241 i: Integer;
242 begin
243 Result := False;
244
245 with SelectedList do for i := 0 to Pred(Count) do
246 begin
247 with TOrder(Items[i]) do if Copy(DigSigReq,1,1) = '2' then Result := True;
248 end;
249 end;
250
251begin
252 Result := False;
253 DigSigErr := True;
[460]254 PrintLoc := 0;
[459]255 if SelectedList.Count = 0 then Exit;
256 if BILLING_AWARE then
257 begin
258 tempOrderList := TStringList.Create;
259 tempOrderList.Clear;
260 end;
261 frmSignOrders := TfrmSignOrders.Create(Application);
262 try
263 ResizeAnchoredFormToFont(frmSignOrders);
264 SigItems.ResetOrders;
265 with SelectedList do for i := 0 to Count - 1 do
266 begin
267 obj := TOrder(Items[i]);
268 cidx := frmSignOrders.clstOrders.Items.AddObject(Obj.Text,Obj);
269 SigItems.Add(CH_ORD,Obj.ID, cidx);
270 //HDS6205 allows dx entry for NON CIDC Consult orders
271 // if BILLING_AWARE then //HDS6205
272 // if UBAGlobals.BAConsultOrdersRequireDx.Count > 0 then //HDS6205
273 // begin
274 // tempOrderID := UBACore.SetOrderIDConsultDxRequired(Piece(Obj.ID,';',1) + ';1'); //HDS6205
275 // tempOrderList.Add(tempOrderID); //HDS6205
276 // end
277 // else
278 if BILLING_AWARE then
279 tempOrderList.Add(Obj.ID);
280
281 frmSignOrders.clstOrders.Checked[cidx] := TRUE;
282
283 if (TOrder(Items[i]).DGroupName) = NonVAMedGroup then
284 frmSignOrders.clstOrders.State[cidx] := cbGrayed ;
285 end;
286
287 if SigItems.UpdateListBox(frmSignOrders.clstOrders) then
288 frmSignOrders.fraCoPay.Visible := TRUE
289 else
290 begin
291
292 {Begin BillingAware}
293 if BILLING_AWARE then
294 frmSignOrders.gbDxLookup.Visible := FALSE;
295 {End BillingAware}
296
297 ShrinkHeight := frmSignOrders.fraCoPay.Height + 9;
298 frmSignOrders.Height := frmSignOrders.Height - ShrinkHeight;
299 frmSignOrders.Label2.Top := frmSignOrders.Label2.Top - ShrinkHeight;
300 frmSignOrders.clstOrders.Top := frmSignOrders.clstOrders.Top - ShrinkHeight;
301 frmSignOrders.clstOrders.Height := frmSignOrders.clstOrders.Height + ShrinkHeight;
302 end;
303
304 if GetPKISite and GetPKIUse and DigitalSign then //PKI setup for crypto card read
305 begin
306 try //PKI object creation
307 crypto := CoXuDigSigS.Create;
308 crypto.GetCSP;
309 StatusText(crypto.Reason);
310 DigSigErr := False;
311 except
312 on E: Exception do
313 begin
314 DigSigErr := True;
315 end;
316 end;
317 end;
318
319 if SignNotRequired then
320 begin
321 frmSignOrders.lblESCode.Visible := False;
322 frmSignOrders.txtESCode.Visible := False;
323 end;
324
325 if BILLING_AWARE then
326 begin
327 // build list of orders that are not billable based on order type
328 UBAGlobals.NonBillableOrderList := rpcNonBillableOrders(tempOrderList);
329 end;
330
331 frmSignOrders.ShowModal;
332 if frmSignOrders.OKPressed then
333 begin
334 Result := True;
335 SignList := TStringList.Create;
336 try
337 with SelectedList do for i := 0 to Count - 1 do with TOrder(Items[i]) do
338 begin
339 DigStoreErr := false;
340 if (DigSigErr = False) and (Copy(TOrder(Items[i]).DigSigReq,1,1) = '2') then
341 begin
342 StatusText('Retrieving DIGITAL SIGNATURE');
343 x := TOrder(Items[i]).ID;
344 SigDrugSch := GetDrugSchedule(x);
345 SigData := SetExternalText(x,SigDrugSch,User.DUZ);
346 if Length(SigData) < 1 then
347 begin
348 ShowMessage(TOrder(SelectedList.Items[i]).Text + CRLF + CRLF + 'Digital Signature failed with reason: Unable to get required data from server');
349 DigStoreErr := true;
350 end;
351 SigUser := piece(SigData,'^',18);
352 SigDEA := piece(SigData,'^',20);
353 cProvDUZ := User.DUZ;
354 if DigStoreErr = false then
355 try
356 crypto.Reset;
357 crypto.DEAsig := true;
358 crypto.UsrName := SigUser;
359 crypto.DrugSch := SigDrugSch;
360 crypto.UsrNumber := SigDEA;
361 crypto.DataBuffer := SigData;
362 if crypto.Signdata = true then
363 begin
364 cSignature := crypto.Signature;
365 cHashData := crypto.HashValue;
366 cCrlUrl := crypto.CrlUrl;
367 end
368 else
369 begin
370 ShowMessage(TOrder(SelectedList.Items[i]).Text + CRLF + CRLF + 'Digital Signature failed with reason: '+ piece(Crypto.Reason, '^', 2));
371 DigStoreErr := true;
372 end;
373 except
374 on E: Exception do
375 begin
376 ShowMessage(TOrder(SelectedList.Items[i]).Text + CRLF + CRLF + 'Crypto raised an error: '+ E.Message);
377 DigStoreErr := true;
378 end;
379 end; //except
380 if DigStoreErr = true then //PKI
381 begin
382 //NoOp
383 end
384 else
385 begin
386 cErr := '';
387 StoreDigitalSig(ID, cHashData, cProvDUZ, cSignature, cCrlUrl, cErr);
388 cidx := frmSignOrders.clstOrders.Items.IndexOfObject(TOrder(Items[i]));
389 if (cidx > -1 ) and (frmSignOrders.clstOrders.Checked[cidx]) and (cErr = '') then
390 begin
391 UpdateOrderDGIfNeeded(ID);
392 SignList.Add(ID + U + SS_DIGSIG + U + RS_RELEASE + U + NO_PROVIDER);
393 BAOrderList.Add(TOrder(Items[i]).ID);
394 end;
395 end;
396 end
397 else
398 begin
399 if GetPKISite and (Copy(TOrder(SelectedList.Items[i]).DigSigReq,1,1) = '2') then
400 begin
401 ShowMessage('ORDER NOT SENT TO PHARMACY' + CRLF + CRLF + TOrder(SelectedList.Items[i]).Text + CRLF + CRLF +
402 'This Schedule II medication cannot be electronically entered without a Digital Signature. ' +
403 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.');
404 end
405 else
406 begin
407 cidx := frmSignOrders.clstOrders.Items.IndexOfObject(TOrder(Items[i]));
408 if TOrder(Items[i]).DGroupName = NonVAMedGroup then frmSignOrders.clstOrders.Checked[cidx] := True; //Non VA MEDS
409 if (cidx > -1 ) and (frmSignOrders.clstOrders.Checked[cidx]) then
410 begin
411 UpdateOrderDGIfNeeded(ID);
412 SignList.Add(ID + U + SS_ESIGNED + U + RS_RELEASE + U + NO_PROVIDER);
413 end;
414 end;
415 end;
416 end;
417 StatusText('Sending Orders to Service(s)...');
418 if SignList.Count > 0 then
419 begin
[460]420
421 //hds7591 Clinic/Ward movement. Patient Admission IMO
422 if not frmFrame.TimedOut then
423 begin
424 if IsValidIMOLoc(uCore.TempEncounterLoc,Patient.DFN) then
425 frmClinicWardMeds.ClinicOrWardLocation(SignList, Encounter.Location,uCore.Encounter.LocationName, PrintLoc)
426 else
427 if (IsValidIMOLoc(Encounter.Location,Patient.DFN)) and ((frmClinicWardMeds.rpcIsPatientOnWard(patient.DFN)) and (Patient.Inpatient = false)) then
428 frmClinicWardMeds.ClinicOrWardLocation(SignList, Encounter.Location,Encounter.LocationName, PrintLoc);
429 end;
430 uCore.TempEncounterLoc := 0;
431 uCore.TempEncounterLocName := '';
432 //hds7591 Clinic/Ward movement Patient Admission IMO
433
[459]434 SigItems.SaveSettings; // Save CoPay FIRST!
435 SendOrders(SignList, frmSignOrders.ESCode);
[460]436
437 end;
438
439 with SignList do if Count > 0 then for i := 0 to Count - 1 do
[459]440 begin
441 if Pos('E', Piece(SignList[i], U, 2)) > 0 then
442 begin
443 OrderText := FindOrderText(Piece(SignList[i], U, 1));
444 InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText,
445 TC_SAVERR, MB_OK);
446 end;
447 if Pos('R', Piece(SignList[i], U, 2)) > 0 then
448 NotifyOtherApps(NAE_ORDER, 'RL' + U + Piece(SignList[i], U, 1));
449 end;
450 StatusText('');
451 for cnt := SignList.Count - 1 downto 0 do
452 begin
453 if Pos('E', Piece(SignList[cnt], U, 2)) > 0 then
454 begin
455 SignList.Delete(cnt);
456 Continue;
457 end;
458 theSts := GetOrderStatus(Piece(SignList[cnt],U,1));
459 if theSts = 10 then SignList.Delete(cnt); //signed delayed order should not be printed.
460 end;
[460]461 PrintOrdersOnSignRelease(SignList, NO_PROVIDER, PrintLoc);
[459]462 finally
463 SignList.Free;
464 end;
465 end; {if frmSignOrders.OKPressed}
466 finally
467 frmSignOrders.Free;
468 with SelectedList do for i := 0 to Count - 1 do UnlockOrder(TOrder(Items[i]).ID);
469 end;
470 crypto := nil;
471end;
472
473procedure TfrmSignOrders.FormCreate(Sender: TObject);
474begin
475 inherited;
476 FLastHintItem := -1;
477 OKPressed := False;
478 FOldHintPause := Application.HintPause;
479 Application.HintPause := 250;
480 FOldHintHidePause := Application.HintHidePause;
481 Application.HintHidePause := 30000;
482 tempList := TList.Create;
483
484 {Begin BillingAware}
485 //This is the DIAGNOSIS label above the Dx column
486 if BILLING_AWARE then
487 begin
488 clstOrders.Height := 234;
489 clstOrders.Top := (gbdxLookup.top + 65);
490 gbDxLookup.Visible := TRUE;
491 label2.Top := (gbdxLookup.Top + 48);
492 laDiagnosis.Top := Label2.Top;
493 laDiagnosis.Left := 270;
494 laDiagnosis.Visible := TRUE;
495 rectIndex := 0;
496 end
497 else
498 begin
499 label2.Top := 145;
500 label2.Left := 8;
501 end;
502 {End BillingAware}
503
504end;
505
506function TfrmSignOrders.IsSignatureRequired:boolean;
507var
508 i: Integer;
509begin
510 Result := FALSE;
511
512 with tempList do for i := 0 to Pred(Count) do
513 begin
514 if frmSignOrders.clstOrders.Checked[i] then
515 begin
516 with TOrder(Items[i]) do if Signature <> OSS_NOT_REQUIRE then
517 Result := TRUE;
518 end;
519 end;
520end;
521
522procedure TfrmSignOrders.cmdOKClick(Sender: TObject);
523const
524 TX_NO_CODE = 'An electronic signature code must be entered to sign orders.';
525 TC_NO_CODE = 'Electronic Signature Code Required';
526 TX_BAD_CODE = 'The electronic signature code entered is not valid.';
527 TC_BAD_CODE = 'Invalid Electronic Signature Code';
528 TC_NO_DX = 'Incomplete Diagnosis Entry';
529 TX_NO_DX = 'A Diagnosis must be selected prior to signing any of the following order types:'
530 + CRLF + 'Lab, Radiology, Outpatient Medications, Prosthetics.';
531begin
532 inherited;
[460]533
[459]534 if txtESCode.Visible and (Length(txtESCode.Text) = 0) then
535 begin
536 InfoBox(TX_NO_CODE, TC_NO_CODE, MB_OK);
537 Exit;
538 end;
539
540 if txtESCode.Visible and not ValidESCode(txtESCode.Text) then
541 begin
542 InfoBox(TX_BAD_CODE, TC_BAD_CODE, MB_OK);
543 txtESCode.SetFocus;
544 txtESCode.SelectAll;
545 Exit;
546 end;
547
548{Begin BillingAware}
549 if BILLING_AWARE then
550 begin
551 if SigItems.OK2SaveSettings then
[460]552
553 if Not UBACore.BADxEntered then // if Dx have been entered and OK is pressed
[459]554 begin // billing data will be saved. otherwise error message!
555 InfoBox(TX_NO_DX, 'Sign Orders', MB_OK);
556 Exit;
557 end;
558 end;
559{End BillingAware}
560
561 if not SigItems.OK2SaveSettings then
562 begin
563 InfoBox(TX_Order_Error, 'Sign Orders', MB_OK);
564 Exit;
565 end;
566
567 if txtESCode.Visible then
568 ESCode := Encrypt(txtESCode.Text) else ESCode := '';
569
570 OKPressed := True;
571 Close;
572end;
573
574procedure TfrmSignOrders.cmdCancelClick(Sender: TObject);
575begin
576 inherited;
577 Close;
578end;
579
580procedure TfrmSignOrders.FormDestroy(Sender: TObject);
581begin
582 inherited;
583 Application.HintPause := FOldHintPause;
584 Application.HintHidePause := FOldHintHidePause;
585 Crypto := nil; //PKI object destroy
586end;
587
588procedure TfrmSignOrders.clstOrdersDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
589var
590{Begin BillingAware}
591 str: String;
592 tempID: string;
593 thisRec: UBAGlobals.TBADxRecord;
594 {End BillingAware}
595
596 X: string;
597 ARect: TRect;
598begin
599 inherited;
600 X := '';
601 ARect := Rect;
602
603{Begin BillingAware}
604 if BILLING_AWARE then
605 begin
606 with clstOrders do
607 begin
608 if Index < Items.Count then
609 begin
610 Canvas.FillRect(ARect);
611 Canvas.Pen.Color := clSilver;
612 Canvas.MoveTo(ARect.Left, ARect.Bottom);
613 Canvas.LineTo(ARect.Right, ARect.Bottom);
614 x := FilteredString(Items[Index]);
615 ARect.Right := ARect.Right - 50; //50 to 40
616 //Vertical column line
617 Canvas.MoveTo(ARect.Right, Rect.Top);
618 Canvas.LineTo(ARect.Right, Rect.Bottom);
619 //Adjust position of 'Diagnosis' column label for font size
620 laDiagnosis.Left := ARect.Right + 14;
621
622 //ARect.Right below controls the right-hand side of the Dx Column
623 //Adjust ARect.Right in conjunction with procedure uSignItems.TSigItems.lbDrawItem(), because the
624 //two rectangles overlap each other.
625 if BILLING_AWARE then
626 begin
627 arRect[Index] := Classes.Rect(ARect.Right+2, ARect.Top, ARect.Right + 108, ARect.Bottom);
628 Canvas.FillRect(arRect[Index]);
629 end;
630
631 //Win32 API - This call to DrawText draws the text of the ORDER - not the diagnosis code
632 DrawText(Canvas.handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
633 {v25 BA}
634 if BILLING_AWARE then
635 begin
636 if Assigned(UBAGlobals.tempDxList) then
637 begin
638 tempID := TOrder(clstOrders.Items.Objects[Index]).ID;
639
640 if UBAGlobals.tempDxNodeExists(tempID) then
641 begin
642 thisRec := TBADxRecord.Create;
643 UBAGlobals.GetBADxListForOrder(thisRec, tempID);
644 str := Piece(thisRec.FBADxCode,'^',1);
645 {v25 BA}
646 str := Piece(str,':',1);
647 DrawText(Canvas.handle, PChar(str), Length(str), arRect[Index], DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
648 if Not UBACore.IsOrderBillable(tempID) then //and
649 // Not UBAGlobals.tempDxNodeExists(tempID) then // if consult is non cidc but requires dx, show it.
650 begin
651 Canvas.Font.Color := clBlue;
652 DrawText(Canvas.handle, PChar(NOT_APPLICABLE), Length(NOT_APPLICABLE), {Length(str),} arRect[Index], DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
653 end;
654 end
655 else
656 begin
657 // determine if order is billable, if NOT then insert NA in Dx field
658 if Not UBACore.IsOrderBillable(tempID) then
659 begin
660 Canvas.Font.Color := clBlue;
661 DrawText(Canvas.handle, PChar(NOT_APPLICABLE), Length(NOT_APPLICABLE), {Length(str),} arRect[Index], DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
662 end;
663 end;
664 end;
665 end;
666
667 end;
668 end;
669 end
670 else
671 begin
672 X := '';
673 ARect := Rect;
674 with clstOrders do
675 begin
676 if Index < Items.Count then
677 begin
678 Canvas.FillRect(ARect);
679 Canvas.Pen.Color := clSilver;
680 Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
681 Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
682 X := FilteredString(Items[Index]);
683 DrawText(Canvas.handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
684 end;
685 end;
686 end;
687{End BillingAware}
688end;
689
690procedure TfrmSignOrders.clstOrdersMeasureItem(Control: TWinControl;
691 Index: Integer; var AHeight: Integer);
692var
693 X: string;
694 ARect: TRect;
695begin
696 inherited;
697 AHeight := SigItemHeight;
698 with clstOrders do if Index < Items.Count then
699 begin
700 ARect := ItemRect(Index);
701 Canvas.FillRect(ARect);
702 x := FilteredString(Items[Index]);
703 AHeight := WrappedTextHeightByFont(Canvas, Font, x, ARect);
704 if AHeight > 255 then AHeight := 255;
705 //-------------------
706 {Bug fix-HDS00001627}
707 //if AHeight < 13 then AHeight := 13; {ORIG}
708 if AHeight < 13 then AHeight := 15;
709 //-------------------
710 end;
711end;
712
713procedure TfrmSignOrders.clstOrdersClickCheck(Sender: TObject);
714
715 procedure updateAllChilds(CheckedStatus: boolean; ParentOrderId: string);
716 var
717 idx: integer;
718 begin
719 for idx := 0 to clstOrders.Items.Count - 1 do
720 if TOrder(clstOrders.Items.Objects[idx]).ParentID = ParentOrderId then
721 begin
722 if clstOrders.Checked[idx] <> CheckedStatus then
723 begin
724 clstOrders.Checked[idx] := CheckedStatus;
725 SigItems.EnableSettings(idx, clstOrders.checked[Idx]);
726 end;
727 end;
728 end;
729
730begin
731 with clstOrders do
732 begin
733 if Length(TOrder(Items.Objects[ItemIndex]).ParentID)>0 then
734 begin
735 SigItems.EnableSettings(ItemIndex, checked[ItemIndex]);
736 updateAllChilds(checked[ItemIndex],TOrder(Items.Objects[ItemIndex]).ParentID);
737 end else
738 SigItems.EnableSettings(ItemIndex, checked[ItemIndex]);
739 end;
740 if ItemsAreChecked then
741 begin
742 lblESCode.Visible := IsSignatureRequired;
743 txtESCode.Visible := IsSignatureRequired
744 end
745 else
746 begin
747 lblESCode.Visible := ItemsAreChecked;
748 txtESCode.Visible := ItemsAreChecked;
749 end;
750end;
751
752function TfrmSignOrders.ItemsAreChecked: Boolean;
753{ return true if any items in the Review List are checked for applying signature }
754var
755 i: Integer;
756begin
757 Result := False;
758
759 with clstOrders do
760 for i := 0 to Items.Count - 1 do
761 if Checked[i] then
762 begin
763 Result := True;
764 break;
765 end;
766end;
767
768procedure TfrmSignOrders.clstOrdersMouseMove(Sender: TObject;
769 Shift: TShiftState; X, Y: Integer);
770var
771 Itm: integer;
772{Begin BillingAware}
773 thisRec: UBAGlobals.TBADxRecord;
774 i: smallint;
775 thisOrderID: string;
776{End BillingAware}
777begin
778 inherited;
779 Itm := clstOrders.ItemAtPos(Point(X, Y), TRUE);
780 if (Itm >= 0) then
781 begin
782 if (Itm <> FLastHintItem) then
783 begin
784 Application.CancelHint;
785 {Begin BillingAware}
786 if BILLING_AWARE then
787 begin
788 //Billing Awareness 'flyover' hint includes Dx code(s) when Dx code(s) have been assigned to an order
789 thisOrderID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[Itm]).ID;
790
791 if UBAGlobals.tempDxNodeExists(thisOrderID) then
792 begin
793 if Assigned(tempDxList) then
794 try
795 for i := 0 to (tempDxList.Count - 1) do
796 begin
797 thisRec := TBADxRecord(tempDxList.Items[i]);
798
799 if Assigned(thisRec) then
800 if (thisRec.FOrderID = thisOrderID) then
801 begin
802 with thisRec do
803 begin
804 FBADxCode := StringReplace(thisrec.FBADxCode,'^',':',[rfReplaceAll]);
805 FBASecDx1 := StringReplace(thisrec.FBASecDx1,'^',':',[rfReplaceAll]);
806 FBASecDx2 := StringReplace(thisrec.FBASecDx2,'^',':',[rfReplaceAll]);;
807 FBASecDx3 := StringReplace(thisrec.FBASecDx3,'^',':',[rfReplaceAll]);
808 end;
809
810 clstOrders.Hint := TrimRight(clstOrders.Items[Itm] + #13 +
811 thisRec.FBADxCode + #13 + thisRec.FBASecDx1 + #13 + thisRec.FBASecDx2 + #13 + thisRec.FBASecDx3);
812 end
813 end
814 except
815 on EListError do
816 begin
817 {$ifdef debug}ShowMessage('EListError in frmSignOrders.clstOrdersMouseMove()');{$endif}
818 raise;
819 end;
820 end;
821
822 end
823 else
824 clstOrders.Hint := TrimRight(clstOrders.Items[Itm]);
825 end;
826 {End BillingAware}
827 FLastHintItem := Itm;
828 Application.ActivateHint(Point(X, Y));
829 end;
830 end
831 else
832 begin
833 clstOrders.Hint := '';
834 FLastHintItem := -1;
835 Application.CancelHint;
836 end;
837end;
838
839procedure TfrmSignOrders.FormShow(Sender: TObject);
840begin
841{Begin BillingAware}
842
843 //INITIALIZATIONS
844 Paste1.Enabled := false;
845 fOrdersSign.srcOrderID := '';
846 fOrdersSign.srcDx := '';
847 if txtESCode.Visible then
848 frmSignOrders.txtESCode.SetFocus;
849
850 if BILLING_AWARE then
851 begin
852 //List to contain loading OrderID's
853 if not Assigned(UBAGlobals.OrderIDList) then
854 UBAGlobals.OrderIDList := TStringList.Create;
855
856 if BILLING_AWARE then
857 clstOrders.Multiselect := true;
858
859 with fraCoPay do
860 begin
861 Label24.Caption := 'Service &Connected Condition';
862 StaticText4.Caption := 'Combat &Vet (Combat Related)';
863 Label18.Caption := 'Agent &Orange Exposure';
864 Label16.Caption := 'Ionizing &Radiation Exposure';
865 Label14.Caption := '&Environmental Contaminants';
866 Label12.Caption := '&MST';
867 lblHNC2.Caption := '&Head and/or Neck Cancer';
868 Label24.ShowAccelChar := true;
869 StaticText4.ShowAccelChar := true;
870 Label18.ShowAccelChar := true;
871 Label16.ShowAccelChar := true;
872 Label14.ShowAccelChar := true;
873 Label12.ShowAccelChar := true;
874 lblHNC2.ShowAccelChar := true;
875 end;
876 end; //BILLING_AWARE
877
878 clstOrders.TabOrder := 0; //CQ5057
879 FormatListForScreenReader;
880
881 //CQ5172
882 if clstOrders.Count = 1 then
883 begin
884 clstOrders.Selected[0] := true;
885 buOrdersDiagnosis.Enabled := True;
886 Diagnosis1.Enabled := True;
887 // if number of orders is 1 and order is billable select order and disable diagnosis button
888 if NOT UBACore.IsOrderBillable(TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[0]).ID) then
889 begin
890 buOrdersDiagnosis.Enabled := False;
891 Diagnosis1.Enabled := False;
892 clstOrders.Selected[0] := False;
893 end
894 else
895 if Piece(TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[0]).ID,';',2) = DISCONTINUED_ORDER then
896 begin
897 buOrdersDiagnosis.Enabled := False;
898 Diagnosis1.Enabled := False;
899 end;
900 end;
901 //end CQ5172
902end;
903
904 {Begin BillingAware}
905 // New BA Button....
906procedure TfrmSignOrders.buOrdersDiagnosisClick(Sender: TObject);
907var
908 i: smallint;
909 thisOrderID: string;
910 match: boolean;
911 allBlank: boolean;
912 numSelected: smallint;
913begin
914{Begin BillingAware}
915
916 match := false;
917 allBlank := false;
918 //orderIDList := TStringList.Create;
919 if Assigned (orderIDList) then orderIDList.Clear;
920 if Assigned(UBAGlobals.PLFactorsIndexes) then UBAGlobals.PLFactorsIndexes.Clear;
921 if Assigned (BAtmpOrderList) then BAtmpOrderList.Clear;
922
923 try
924 // User has selected no orders to sign
925 for i := 0 to fOrdersSign.frmSignOrders.clstOrders.Items.Count-1 do
926 begin
927 if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then
928 begin
929 thisOrderID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID;
930 orderIDList.Add(thisOrderID);
931 {BAV25 Code}
932 BAtmpOrderList.Add(TOrder(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).TEXT);
933 // stringlist holding index and stsFactors
934 UBAGlobals.PLFactorsIndexes.Add(IntToStr(i)+ U + GetCheckBoxStatus(thisOrderID) ); // store indexes and flags of selected orders
935 {BAV25 Code}
936 // Test for blank Dx on current grid item
937 if not (tempDxNodeExists(thisOrderID)) then
938 if Assigned(UBAGlobals.globalDxRec) then
939 InitializeNewDxRec(UBAGlobals.globalDxRec);
940 if (tempDxNodeExists(thisOrderID)) then
941 begin
942 // Create UBAGlobals.globalDxRec with loaded fields
943 if not Assigned(UBAGlobals.globalDxRec) then
944 begin
945 UBAGlobals.globalDxRec := UBAGlobals.TBADxRecord.Create;
946 InitializeNewDxRec(UBAGlobals.globalDxRec);
947 GetBADxListForOrder(UBAGlobals.globalDxRec, thisOrderID);
948 end
949 else
950 GetBADxListForOrder(UBAGlobals.globalDxRec, thisOrderID);
951
952 {$ifdef debug}
953 with UBAGlobals.globalDxRec do
954 //ShowMessage('globalDxRec:'+#13+FOrderID+#13+FBADxCode+#13+FBASecDx1+#13+FBASecDx2+#13+FBASecDx3);
955 {$endif}
956 end;
957 end; //if
958 end; //for
959 except
960 on E: Exception do
961 ShowMessage(E.ClassName+' error raised, with message : '+E.Message);
962 end;
963
964 numSelected := CountSelectedOrders(UBAConst.F_ORDERS_SIGN);
965
966 if numSelected = 0 then
967 begin
968 ShowMessage(UBAMessages.BA_NO_ORDERS_SELECTED);
969 Exit;
970 end
971 else
972 if numSelected = 1 then
973 match := true;
974
975 if (UBAGlobals.CompareOrderDx(UBAConst.F_ORDERS_SIGN)) then
976 match := true;
977
978
979 if UBAGlobals.AllSelectedDxBlank(UBAConst.F_ORDERS_SIGN) then
980 allBlank := true;
981
982 if ((match and allBlank) or (match and (not allBlank))) then // All selected are blank or matching-not-blank
983// begin
984 { TODO 3 -oKW -cRefinement : Define a const to replace string literal }
985 frmBALocalDiagnoses.Enter(UBAConst.F_ORDERS_SIGN, orderIDList)
986 else
987 begin
988 //Warning message
989 //If 'Yes' on warning message then open localDiagnosis
990 if (not allBlank) then
991 if MessageDlg(UBAMessages.BA_CONFIRM_DX_OVERWRITE, mtConfirmation, [mbYes, mbNo], 0) = mrNo then
992 Exit
993 else
994// begin
995 if Assigned(UBAGlobals.globalDxRec) then
996 InitializeNewDxRec(UBAGlobals.globalDxRec);
997 frmBALocalDiagnoses.Enter(UBAConst.F_ORDERS_SIGN, orderIDList);
998 end;
999 // TFactors come from FBALocalDiagnoses(Problem List Dx's Only).
1000 if Length(UBAGlobals.TFactors) > 0 then
1001 begin
1002 UBACore.SetTreatmentFactors(UBAGlobals.TFactors);
1003 SigItems.DisplayPlTreatmentFactors;
1004 end;
1005 {End BillingAware}
1006 txtESCode.SetFocus;
1007end;
1008
1009procedure TfrmSignOrders.Exit1Click(Sender: TObject);
1010begin
1011 Close;
1012end;
1013
1014procedure TfrmSignOrders.Copy1Click(Sender: TObject);
1015{
1016 - Copy contents of the 'source' order for copy/paste operation
1017}
1018var
1019 i : byte;
1020 numSelected: byte;
1021 thisChangeItem: TChangeItem;
1022begin
1023 try
1024 if BILLING_AWARE then
1025 begin
1026 Paste1.Enabled := true;
1027
1028 numSelected := GetNumberOfSelectedOrders;
1029
1030 if numSelected > 1 then
1031 begin
1032 ShowMessage('Only 1 order at a time may be selected for ''Copying''');
1033 Exit;
1034 end;
1035
1036 for i := 0 to fOrdersSign.frmSignOrders.clstOrders.Items.Count-1 do
1037 if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then
1038 begin
1039 thisChangeItem := TChangeItem.Create;
1040 thisChangeItem := nil;
1041 thisChangeItem := TChangeItem(clstOrders.Items.Objects[i]);
1042 //Skip this one if it's a "header" on the grid
1043 if (thisChangeItem = nil) then //or (thisChangeItem.ItemType <> CH_ORD)) then
1044 begin
1045 FreeAndNil(thisChangeItem);
1046 Exit;
1047 end;
1048
1049 fOrdersSign.srcOrderID := TChangeItem(frmSignOrders.clstOrders.Items.Objects[i]).ID;
1050
1051 //Copy source order to COPY BUFFER and add it to the Dx List
1052 CopyBuffer := TBADxRecord.Create;
1053 InitializeNewDxRec(CopyBuffer);
1054 GetBADxListForOrder(CopyBuffer, fOrdersSign.srcOrderID);
1055 fOrdersSign.CopyBuffer.FOrderID := BUFFER_ORDER_ID;
1056 UBAGlobals.tempDxList.Add(CopyBuffer);
1057
1058 //*************************************************************************
1059 if (NOT UBACore.IsOrderBillable(fOrdersSign.srcOrderID) ) then //and
1060 // (NOT tempDxNodeExists(fOrdersSign.srcOrderID)) then // added to allow copy to NON CIDC consult order the requires a DX. then
1061 begin
1062 ShowMessage(BA_NA_COPY_DISALLOWED);
1063 fOrdersSign.srcOrderID := '';
1064 Exit;
1065 end;
1066 //*************************************************************************
1067
1068 fOrdersSign.srcIndex := clstOrders.ItemIndex;
1069 fOrdersSign.chkBoxStatus := GetCheckBoxStatus(fOrdersSign.srcOrderID);
1070 Break;
1071 end;
1072 end; //if BILLING_AWARE
1073 except
1074 on EListError do
1075 begin
1076 ShowMessage('EListError in frmSignOrders.Copy1Click()');
1077 raise;
1078 end;
1079 end;
1080
1081 //CopyActive := true; //CQ6225
1082 //Paste1.Enabled := true; //CQ6225
1083end;
1084
1085procedure TfrmSignOrders.Paste1Click(Sender: TObject);
1086{
1087 - Populate 'target' orders of a copy/paste operation with contents of 'source' order
1088}
1089var
1090 i: byte;
1091 newRec: TBADxRecord;
1092begin
1093 if BILLING_AWARE then
1094 begin
1095 if not Assigned(fOrdersSign.CopyBuffer) then //CQ5414
1096 fOrdersSign.CopyBuffer := TBADxRecord.Create; //CQ5414
1097
1098 try
1099 for i := 0 to clstOrders.Count - 1 do
1100 begin
1101 if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then
1102 begin
1103 fOrdersSign.targetOrderID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID;
1104
1105 if fOrdersSign.targetOrderID = fOrdersSign.srcOrderID then //disallow copying an order to itself
1106 Continue
1107 else
1108 begin
1109 fOrdersSign.CopyBuffer.FOrderID := BUFFER_ORDER_ID;
1110
1111 //***************************************************************
1112 if Not UBACore.IsOrderBillable(targetOrderID) then
1113 begin
1114 ShowMessage(BA_NA_PASTE_DISALLOWED);
1115 fOrdersSign.targetOrderID := '';
1116 Continue;
1117 end;
1118 //***************************************************************
1119
1120 newRec := TBADxRecord.Create;
1121 with newRec do
1122 begin
1123 FOrderID := fOrdersSign.targetOrderID;
1124 FBADxCode := CopyBuffer.FBADxCode;
1125 FBASecDx1 := CopyBuffer.FBASecDx1;
1126 FBASecDx2 := CopyBuffer.FBASecDx2;
1127 FBASecDx3 := CopyBuffer.FBASecDx3;
1128 end;
1129
1130 tempDxList.Add(newRec);
1131
1132 CopyTFCIToTargetOrder( fOrdersSign.targetOrderID, fOrdersSign.chkBoxStatus);
1133 SetCheckBoxStatus( fOrdersSign.targetOrderID); //calls uSignItems.SetSigItems()
1134 end;
1135 end;
1136 end;
1137 except
1138 on EListError do
1139 begin
1140 ShowMessage('EListError in frmSignOrders.Paste1Click()'+#13+'for i := 0 to clstOrders.Count - 1 do');
1141 raise;
1142 end;
1143 end;
1144 clstOrders.Refresh; //Update grid to show pasted Dx
1145 end;
1146{
1147 //CQ6225
1148 if CopyActive then
1149 begin
1150 Paste1.Enabled := false;
1151 CopyActive := false;
1152 end;
1153 //end CQ6225
1154}
1155end;
1156
1157procedure TfrmSignOrders.clstOrdersMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1158{
1159 - Open copy/paste popup menu.
1160}
1161var
1162 ClientPoint: TPoint;
1163 ScreenPoint: TPoint;
1164begin
1165 if not BILLING_AWARE then clstOrders.PopupMenu := nil;
1166
1167 if BILLING_AWARE then
1168 begin
1169 try
1170 if Button = mbRight then //Right-click to open copy/paste popup menu
1171 begin
1172 //CQ3325
1173 if fOrdersSign.frmSignOrders.clstOrders.Items.Count = 1 then
1174 begin
1175 Copy1.Enabled := false;
1176 Paste1.Enabled := false
1177 end
1178 else
1179 begin
1180 Copy1.Enabled := true;
1181 //Paste1.Enabled := true; //commented out for CQ6225
1182 end;
1183 //End CQ3325
1184
1185 if not frmSignOrders.clstOrders.Selected[clstOrders.ItemIndex] then
1186 (Sender as TCheckListBox).Selected[clstOrders.ItemIndex] := true;
1187
1188 ClientPoint.X := X;
1189 ClientPoint.Y := Y;
1190 ScreenPoint := clstOrders.ClientToScreen(ClientPoint);
1191 poBACopyPaste.Popup(ScreenPoint.X, ScreenPoint.Y);
1192 end;
1193 except
1194 on EListError do
1195 begin
1196 ShowMessage('EListError in frmSignOrders.clstOrdersMouseDown()');
1197 raise;
1198 end;
1199 end;
1200 end;
1201end;
1202
1203
1204procedure TfrmSignOrders.clstOrdersClick(Sender: TObject);
1205//If grid item is an order-able item, then enable the Diagnosis button
1206// else disable the Diagnosis button.
1207var
1208 thisChangeItem: TChangeItem;
1209 i: smallint;
1210 thisOrderList: TStringList;
1211begin
1212 thisOrderList := TStringList.Create;
1213
1214 {Begin BillingAware}
1215 if BILLING_AWARE then
1216 begin
1217
1218 if clstOrders.Items.Count > 1 then
1219 copy1.Enabled := True
1220 else
1221 copy1.Enabled := False;
1222
1223 for i := 0 to clstOrders.Items.Count - 1 do
1224 begin
1225 if clstOrders.Selected[i] then
1226 begin
1227 thisChangeItem := TChangeItem(clstOrders.Items.Objects[i]);
1228
1229 //Disallow copying of a grid HEADER item on LEFT MOUSE CLICK
1230 if thisChangeItem = nil then
1231 begin
1232 Copy1.Enabled := false;
1233 buOrdersDiagnosis.Enabled := false;
1234 Exit;
1235 end;
1236
1237 if (thisChangeItem <> nil) then //Blank row - not an order item
1238 begin
1239 thisOrderList.Clear;
1240 thisOrderList.Add(thisChangeItem.ID);
1241
1242 if IsAllOrdersNA(thisOrderList) then
1243 begin
1244 Diagnosis1.Enabled := false;
1245 buOrdersDiagnosis.Enabled := false;
1246 end
1247 else
1248 begin
1249 Diagnosis1.Enabled := true;
1250 buOrdersDiagnosis.Enabled := true;
1251 end
1252 end
1253 else
1254 begin
1255 buOrdersDiagnosis.Enabled := false;
1256 Diagnosis1.Enabled := False;
1257 Break;
1258 end;
1259 end;
1260 end;
1261
1262 if Assigned(thisOrderList) then thisOrderList.Free;
1263 end;
1264end;
1265
1266procedure TfrmSignOrders.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
1267var
1268 j: integer; //CQ5054
1269begin
[460]1270
[459]1271 if FOSTFHintWndActive then
1272 begin
1273 FOSTFhintWindow.ReleaseHandle ;
1274 FOSTFHintWndActive := False ;
1275 end;
1276
1277 case Key of
1278 67,99: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorSC,fraCoPay.Label24); //C,c
1279 86,118: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorCV,fraCoPay.staticText4); //V,v
1280 79,111: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorAO,fraCoPay.Label18); //O,o
1281 82,114: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorIR,fraCoPay.Label16); //R,r
1282 69,101: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorEC,fraCoPay.Label14); //E,e
1283 77,109: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorMST,fraCoPay.Label12); //M,m
1284 72,104: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorHNC,fraCoPay.lblHNC2); //H,h
1285 //CQ5054
1286 83,115: if (ssAlt in Shift) then
1287 begin
1288 for j := 0 to clstOrders.Items.Count-1 do
1289 clstOrders.Selected[j] := false;
1290 clstOrders.Selected[0] := true;
1291 clstOrders.SetFocus;
1292 end;
1293 //end CQ5054
1294 end;
1295end;
1296
1297//BILLING AWARE Procedure
1298procedure TfrmSignOrders.ShowTreatmentFactorHints(var pHintText: string; var pCompName: TORStaticText); // 508
1299var
1300 HRect: TRect;
1301 thisRect: TRect;
1302 x,y: integer;
1303
1304begin
1305 try
1306 if FOSTFhintWndActive then
1307 begin
1308 FOSTFhintWindow.ReleaseHandle;
1309 FOSTFhintWndActive := False;
1310 end;
1311 except
1312 on E: Exception do
1313 begin
1314 {$ifdef debug}ShowMessage('Unhandled exception in procedure TfrmSignOrders.ShowTreatmentFactorHints()');{$endif}
1315 raise;
1316 end;
1317 end;
1318
1319 try
1320 FOSTFhintWindow := THintWindow.Create(frmSignOrders);
1321 FOSTFhintWindow.Color := clInfoBk;
1322 GetWindowRect(pCompName.Handle,thisRect);
1323 x := thisRect.Left;
1324 y := thisRect.Top;
1325 hrect := FOSTFhintWindow.CalcHintRect(Screen.Width, pHintText,nil);
1326 hrect.Left := hrect.Left + X;
1327 hrect.Right := hrect.Right + X;
1328 hrect.Top := hrect.Top + Y;
1329 hrect.Bottom := hrect.Bottom + Y;
1330
1331 if FOSTFHintWndActive then
1332 begin
1333 with fraCoPay do
1334 begin
1335 //Abbreviated captions
1336 Label23.ShowHint := false;
1337 StaticText1.ShowHint := false;
1338 Label17.ShowHint := false;
1339 Label15.ShowHint := false;
1340 Label13.ShowHint := false;
1341 Label11.ShowHint := false;
1342 lblHNC.ShowHint := false;
1343 //Long captions
1344 staticText4.ShowHint := false;
1345 Label17.ShowHint := false;
1346 Label18.ShowHint := false;
1347 Label15.ShowHint := false;
1348 Label16.ShowHint := false;
1349 Label13.ShowHint := false;
1350 Label14.ShowHint := false;
1351 Label11.ShowHint := false;
1352 Label12.ShowHint := false;
1353 lblHNC.ShowHint := false;
1354 lblHNC2.ShowHint := false;
1355 end;
1356 end
1357 else
1358 begin
1359 with fraCoPay do
1360 begin
1361 //Abbreviated captions
1362 Label23.ShowHint := true;
1363 StaticText1.ShowHint := true;
1364 Label17.ShowHint := true;
1365 Label15.ShowHint := true;
1366 Label13.ShowHint := true;
1367 Label11.ShowHint := true;
1368 lblHNC.ShowHint := true;
1369 //Long captions
1370 staticText4.ShowHint := true;
1371 Label17.ShowHint := true;
1372 Label18.ShowHint := true;
1373 Label15.ShowHint := true;
1374 Label16.ShowHint := true;
1375 Label13.ShowHint := true;
1376 Label14.ShowHint := true;
1377 Label11.ShowHint := true;
1378 Label12.ShowHint := true;
1379 lblHNC.ShowHint := true;
1380 lblHNC2.ShowHint := true;
1381 end;
1382 end;
1383
1384 FOSTFhintWindow.ActivateHint(hrect, pHintText);
1385 FOSTFHintWndActive := True;
1386 except
1387 on E: Exception do
1388 begin
1389 {$ifdef debug}ShowMessage('Unhandled exception in procedure TfrmSignOrders.ShowTreatmentFactorHints()');{$endif}
1390 raise;
1391 end;
1392 end;
1393end;
1394
1395procedure TfrmSignOrders.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
1396begin
1397 try
[460]1398 if FOSTFhintWndActive then
1399 begin
1400 FOSTFhintWindow.ReleaseHandle;
1401 FOSTFHintWndActive := False;
1402 Application.ProcessMessages;
1403 end;
[459]1404 except
1405 on E: Exception do
1406 begin
1407 {$ifdef debug}ShowMessage('Unhandled exception in procedure TfrmSignOrders.FormMouseMove()');{$endif}
1408 raise;
1409 end;
1410 end;
1411end;
1412
1413procedure TfrmSignOrders.fraCoPaylblHNCMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
1414begin
1415 if FOSTFHintWndActive then
1416 begin
1417 with fraCoPay do
1418 begin
1419 //Abbreviated captions
1420 Label23.ShowHint := false;
1421 StaticText1.ShowHint := false;
1422 Label17.ShowHint := false;
1423 Label15.ShowHint := false;
1424 Label13.ShowHint := false;
1425 Label11.ShowHint := false;
1426 lblHNC.ShowHint := false;
1427 //Long captions
1428 Label24.ShowHint := false;
1429 staticText4.ShowHint := false;
1430 Label17.ShowHint := false;
1431 Label18.ShowHint := false;
1432 Label15.ShowHint := false;
1433 Label16.ShowHint := false;
1434 Label13.ShowHint := false;
1435 Label14.ShowHint := false;
1436 Label11.ShowHint := false;
1437 Label12.ShowHint := false;
1438 lblHNC.ShowHint := false;
1439 lblHNC2.ShowHint := false;
1440 end;
1441 end
1442 else
1443 begin
1444 with fraCoPay do
1445 begin
1446 //Abbreviated captions
1447 Label23.ShowHint := true;
1448 StaticText1.ShowHint := true;
1449 Label17.ShowHint := true;
1450 Label15.ShowHint := true;
1451 Label13.ShowHint := true;
1452 Label11.ShowHint := true;
1453 lblHNC.ShowHint := true;
1454 //Long captions
1455 Label24.ShowHint := true;
1456 staticText4.ShowHint := true;
1457 Label17.ShowHint := true;
1458 Label18.ShowHint := true;
1459 Label15.ShowHint := true;
1460 Label16.ShowHint := true;
1461 Label13.ShowHint := true;
1462 Label14.ShowHint := true;
1463 Label11.ShowHint := true;
1464 Label12.ShowHint := true;
1465 lblHNC.ShowHint := true;
1466 lblHNC2.ShowHint := true;
1467 end;
1468 end;
1469
1470end;
1471
1472procedure TfrmSignOrders.fraCoPayLabel23Enter(Sender: TObject);
1473begin
1474 (Sender as TORStaticText).Font.Style := [fsBold];
1475end;
1476
1477procedure TfrmSignOrders.fraCoPayLabel23Exit(Sender: TObject);
1478begin
1479 (Sender as TORStaticText).Font.Style := [];
1480end;
1481
1482procedure TfrmSignOrders.SetItemTextToState;
1483var
1484 i : integer;
1485begin
1486 //The with statement below would cause access violations on other Delphi machines.
1487 { with clstOrders do
1488 begin }
1489 //Must use fully qualifying path includeing the unit... very wierd!
1490
1491 if fOrdersSign.frmSignOrders.clstOrders.Count < 1 then Exit;
1492 for i := 0 to fOrdersSign.frmSignOrders.clstOrders.Count-1 do
1493 if fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i] <> nil then //Not a Group Title
1494 begin
1495 if fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i] is TOrder then
1496 if fOrdersSign.frmSignOrders.clstOrders.Checked[i] then
1497 fOrdersSign.frmSignOrders.clstOrders.Items[i] := 'Checked '+TOrder(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).Text
1498 else
1499 fOrdersSign.frmSignOrders.clstOrders.Items[i] := 'Not Checked '+TOrder(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).Text;
1500 end;
1501 if fOrdersSign.frmSignOrders.clstOrders.ItemIndex >= 0 then
1502 fOrdersSign.frmSignOrders.clstOrders.Selected[fOrdersSign.frmSignOrders.clstOrders.ItemIndex] := True;
1503// end;
1504end;
1505
1506procedure TfrmSignOrders.clstOrdersKeyUp(Sender: TObject; var Key: Word;
1507 Shift: TShiftState);
1508begin
1509 if (Key = VK_Space) then
1510 FormatListForScreenReader
1511end;
1512
1513procedure TfrmSignOrders.FormatListForScreenReader;
1514var
[460]1515 ListStateOn : longbool;
1516 Success: longbool;
[459]1517begin
1518 //Determine if a screen reader is currently being used.
[460]1519 Success := SystemParametersInfo(SPI_GETSCREENREADER, 0, @ListStateOn,0);
1520 if Success and ListStateOn then
1521 SetItemTextToState;
[459]1522end;
1523
1524end.
Note: See TracBrowser for help on using the repository browser.