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

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

Adding foia-cprs branch
File size: 51.1 KB
Line 
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,
116 fPCELex, rPCE, fODConsult, fBALocalDiagnoses;
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;
210 // tempOrderID: string;
211
212 function FindOrderText(const AnID: string): string;
213 var
214 i: Integer;
215 begin
216 Result := '';
217 fOrdersSign.tempList := selectedList;
218 with SelectedList do for i := 0 to Count - 1 do
219 with TOrder(Items[i]) do if ID = AnID then
220 begin
221 Result := Text;
222 Break;
223 end;
224 end;
225
226 function SignNotRequired: Boolean;
227 var
228 i: Integer;
229 begin
230 Result := True;
231 tempList := SelectedList;
232 with SelectedList do for i := 0 to Pred(Count) do
233 begin
234 with TOrder(Items[i]) do if Signature <> OSS_NOT_REQUIRE then Result := False;
235 end;
236 end;
237
238 function DigitalSign: Boolean;
239 var
240 i: Integer;
241 begin
242 Result := False;
243
244 with SelectedList do for i := 0 to Pred(Count) do
245 begin
246 with TOrder(Items[i]) do if Copy(DigSigReq,1,1) = '2' then Result := True;
247 end;
248 end;
249
250begin
251 Result := False;
252 DigSigErr := True;
253 DigStoreErr := False;
254 Obj := Nil;
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
420 SigItems.SaveSettings; // Save CoPay FIRST!
421 SendOrders(SignList, frmSignOrders.ESCode);
422 end;
423 with SignList do if Count > 0 then for i := 0 to Count - 1 do
424 begin
425 if Pos('E', Piece(SignList[i], U, 2)) > 0 then
426 begin
427 OrderText := FindOrderText(Piece(SignList[i], U, 1));
428 InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText,
429 TC_SAVERR, MB_OK);
430 end;
431 if Pos('R', Piece(SignList[i], U, 2)) > 0 then
432 NotifyOtherApps(NAE_ORDER, 'RL' + U + Piece(SignList[i], U, 1));
433 end;
434 StatusText('');
435 for cnt := SignList.Count - 1 downto 0 do
436 begin
437 if Pos('E', Piece(SignList[cnt], U, 2)) > 0 then
438 begin
439 SignList.Delete(cnt);
440 Continue;
441 end;
442 theSts := GetOrderStatus(Piece(SignList[cnt],U,1));
443 if theSts = 10 then SignList.Delete(cnt); //signed delayed order should not be printed.
444 end;
445 PrintOrdersOnSignRelease(SignList, NO_PROVIDER);
446 finally
447 SignList.Free;
448 end;
449 end; {if frmSignOrders.OKPressed}
450 finally
451 frmSignOrders.Free;
452 with SelectedList do for i := 0 to Count - 1 do UnlockOrder(TOrder(Items[i]).ID);
453 end;
454 crypto := nil;
455end;
456
457procedure TfrmSignOrders.FormCreate(Sender: TObject);
458begin
459 inherited;
460 FLastHintItem := -1;
461 OKPressed := False;
462 FOldHintPause := Application.HintPause;
463 Application.HintPause := 250;
464 FOldHintHidePause := Application.HintHidePause;
465 Application.HintHidePause := 30000;
466 tempList := TList.Create;
467
468 {Begin BillingAware}
469 //This is the DIAGNOSIS label above the Dx column
470 if BILLING_AWARE then
471 begin
472 clstOrders.Height := 234;
473 clstOrders.Top := (gbdxLookup.top + 65);
474 gbDxLookup.Visible := TRUE;
475 label2.Top := (gbdxLookup.Top + 48);
476 laDiagnosis.Top := Label2.Top;
477 laDiagnosis.Left := 270;
478 laDiagnosis.Visible := TRUE;
479 rectIndex := 0;
480 end
481 else
482 begin
483 label2.Top := 145;
484 label2.Left := 8;
485 end;
486 {End BillingAware}
487
488end;
489
490function TfrmSignOrders.IsSignatureRequired:boolean;
491var
492 i: Integer;
493begin
494 Result := FALSE;
495
496 with tempList do for i := 0 to Pred(Count) do
497 begin
498 if frmSignOrders.clstOrders.Checked[i] then
499 begin
500 with TOrder(Items[i]) do if Signature <> OSS_NOT_REQUIRE then
501 Result := TRUE;
502 end;
503 end;
504end;
505
506procedure TfrmSignOrders.cmdOKClick(Sender: TObject);
507{Begin BillingAware}
508var
509 BABillingRecs: TStringList;
510{End BillingAware}
511const
512 TX_NO_CODE = 'An electronic signature code must be entered to sign orders.';
513 TC_NO_CODE = 'Electronic Signature Code Required';
514 TX_BAD_CODE = 'The electronic signature code entered is not valid.';
515 TC_BAD_CODE = 'Invalid Electronic Signature Code';
516 TC_NO_DX = 'Incomplete Diagnosis Entry';
517 TX_NO_DX = 'A Diagnosis must be selected prior to signing any of the following order types:'
518 + CRLF + 'Lab, Radiology, Outpatient Medications, Prosthetics.';
519begin
520 inherited;
521{Begin BillingAware}
522 if BILLING_AWARE then
523 begin
524 BABillingRecs := TStringList.Create;
525 BABillingRecs.Clear;
526 end;
527{End BillingAware}
528
529 if txtESCode.Visible and (Length(txtESCode.Text) = 0) then
530 begin
531 InfoBox(TX_NO_CODE, TC_NO_CODE, MB_OK);
532 Exit;
533 end;
534
535 if txtESCode.Visible and not ValidESCode(txtESCode.Text) then
536 begin
537 InfoBox(TX_BAD_CODE, TC_BAD_CODE, MB_OK);
538 txtESCode.SetFocus;
539 txtESCode.SelectAll;
540 Exit;
541 end;
542
543{Begin BillingAware}
544 if BILLING_AWARE then
545 begin
546 if SigItems.OK2SaveSettings then
547 if Not BADxEntered then // if Dx have been entered and OK is pressed
548 begin // billing data will be saved. otherwise error message!
549 InfoBox(TX_NO_DX, 'Sign Orders', MB_OK);
550 Exit;
551 end;
552 end;
553{End BillingAware}
554
555 if not SigItems.OK2SaveSettings then
556 begin
557 InfoBox(TX_Order_Error, 'Sign Orders', MB_OK);
558 Exit;
559 end;
560
561 if txtESCode.Visible then
562 ESCode := Encrypt(txtESCode.Text) else ESCode := '';
563
564 OKPressed := True;
565 Close;
566end;
567
568procedure TfrmSignOrders.cmdCancelClick(Sender: TObject);
569begin
570 inherited;
571 Close;
572end;
573
574procedure TfrmSignOrders.FormDestroy(Sender: TObject);
575begin
576 inherited;
577 Application.HintPause := FOldHintPause;
578 Application.HintHidePause := FOldHintHidePause;
579 Crypto := nil; //PKI object destroy
580end;
581
582procedure TfrmSignOrders.clstOrdersDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
583var
584{Begin BillingAware}
585 str: String;
586 tempID: string;
587 thisRec: UBAGlobals.TBADxRecord;
588 {End BillingAware}
589
590 X: string;
591 ARect: TRect;
592begin
593 inherited;
594 X := '';
595 ARect := Rect;
596
597{Begin BillingAware}
598 if BILLING_AWARE then
599 begin
600 with clstOrders do
601 begin
602 if Index < Items.Count then
603 begin
604 Canvas.FillRect(ARect);
605 Canvas.Pen.Color := clSilver;
606 Canvas.MoveTo(ARect.Left, ARect.Bottom);
607 Canvas.LineTo(ARect.Right, ARect.Bottom);
608 x := FilteredString(Items[Index]);
609 ARect.Right := ARect.Right - 50; //50 to 40
610 //Vertical column line
611 Canvas.MoveTo(ARect.Right, Rect.Top);
612 Canvas.LineTo(ARect.Right, Rect.Bottom);
613 //Adjust position of 'Diagnosis' column label for font size
614 laDiagnosis.Left := ARect.Right + 14;
615
616 //ARect.Right below controls the right-hand side of the Dx Column
617 //Adjust ARect.Right in conjunction with procedure uSignItems.TSigItems.lbDrawItem(), because the
618 //two rectangles overlap each other.
619 if BILLING_AWARE then
620 begin
621 arRect[Index] := Classes.Rect(ARect.Right+2, ARect.Top, ARect.Right + 108, ARect.Bottom);
622 Canvas.FillRect(arRect[Index]);
623 end;
624
625 //Win32 API - This call to DrawText draws the text of the ORDER - not the diagnosis code
626 DrawText(Canvas.handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
627 {v25 BA}
628 if BILLING_AWARE then
629 begin
630 if Assigned(UBAGlobals.tempDxList) then
631 begin
632 tempID := TOrder(clstOrders.Items.Objects[Index]).ID;
633
634 if UBAGlobals.tempDxNodeExists(tempID) then
635 begin
636 thisRec := TBADxRecord.Create;
637 UBAGlobals.GetBADxListForOrder(thisRec, tempID);
638 str := Piece(thisRec.FBADxCode,'^',1);
639 {v25 BA}
640 str := Piece(str,':',1);
641 DrawText(Canvas.handle, PChar(str), Length(str), arRect[Index], DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
642 if Not UBACore.IsOrderBillable(tempID) then //and
643 // Not UBAGlobals.tempDxNodeExists(tempID) then // if consult is non cidc but requires dx, show it.
644 begin
645 Canvas.Font.Color := clBlue;
646 DrawText(Canvas.handle, PChar(NOT_APPLICABLE), Length(NOT_APPLICABLE), {Length(str),} arRect[Index], DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
647 end;
648 end
649 else
650 begin
651 // determine if order is billable, if NOT then insert NA in Dx field
652 if Not UBACore.IsOrderBillable(tempID) then
653 begin
654 Canvas.Font.Color := clBlue;
655 DrawText(Canvas.handle, PChar(NOT_APPLICABLE), Length(NOT_APPLICABLE), {Length(str),} arRect[Index], DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
656 end;
657 end;
658 end;
659 end;
660
661 end;
662 end;
663 end
664 else
665 begin
666 X := '';
667 ARect := Rect;
668 with clstOrders do
669 begin
670 if Index < Items.Count then
671 begin
672 Canvas.FillRect(ARect);
673 Canvas.Pen.Color := clSilver;
674 Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
675 Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
676 X := FilteredString(Items[Index]);
677 DrawText(Canvas.handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
678 end;
679 end;
680 end;
681{End BillingAware}
682end;
683
684procedure TfrmSignOrders.clstOrdersMeasureItem(Control: TWinControl;
685 Index: Integer; var AHeight: Integer);
686var
687 X: string;
688 ARect: TRect;
689begin
690 inherited;
691 AHeight := SigItemHeight;
692 with clstOrders do if Index < Items.Count then
693 begin
694 ARect := ItemRect(Index);
695 Canvas.FillRect(ARect);
696 x := FilteredString(Items[Index]);
697 AHeight := WrappedTextHeightByFont(Canvas, Font, x, ARect);
698 if AHeight > 255 then AHeight := 255;
699 //-------------------
700 {Bug fix-HDS00001627}
701 //if AHeight < 13 then AHeight := 13; {ORIG}
702 if AHeight < 13 then AHeight := 15;
703 //-------------------
704 end;
705end;
706
707procedure TfrmSignOrders.clstOrdersClickCheck(Sender: TObject);
708
709 procedure updateAllChilds(CheckedStatus: boolean; ParentOrderId: string);
710 var
711 idx: integer;
712 begin
713 for idx := 0 to clstOrders.Items.Count - 1 do
714 if TOrder(clstOrders.Items.Objects[idx]).ParentID = ParentOrderId then
715 begin
716 if clstOrders.Checked[idx] <> CheckedStatus then
717 begin
718 clstOrders.Checked[idx] := CheckedStatus;
719 SigItems.EnableSettings(idx, clstOrders.checked[Idx]);
720 end;
721 end;
722 end;
723
724begin
725 with clstOrders do
726 begin
727 if Length(TOrder(Items.Objects[ItemIndex]).ParentID)>0 then
728 begin
729 SigItems.EnableSettings(ItemIndex, checked[ItemIndex]);
730 updateAllChilds(checked[ItemIndex],TOrder(Items.Objects[ItemIndex]).ParentID);
731 end else
732 SigItems.EnableSettings(ItemIndex, checked[ItemIndex]);
733 end;
734 if ItemsAreChecked then
735 begin
736 lblESCode.Visible := IsSignatureRequired;
737 txtESCode.Visible := IsSignatureRequired
738 end
739 else
740 begin
741 lblESCode.Visible := ItemsAreChecked;
742 txtESCode.Visible := ItemsAreChecked;
743 end;
744end;
745
746function TfrmSignOrders.ItemsAreChecked: Boolean;
747{ return true if any items in the Review List are checked for applying signature }
748var
749 i: Integer;
750begin
751 Result := False;
752
753 with clstOrders do
754 for i := 0 to Items.Count - 1 do
755 if Checked[i] then
756 begin
757 Result := True;
758 break;
759 end;
760end;
761
762procedure TfrmSignOrders.clstOrdersMouseMove(Sender: TObject;
763 Shift: TShiftState; X, Y: Integer);
764var
765 Itm: integer;
766{Begin BillingAware}
767 thisRec: UBAGlobals.TBADxRecord;
768 i: smallint;
769 thisOrderID: string;
770{End BillingAware}
771begin
772 inherited;
773 Itm := clstOrders.ItemAtPos(Point(X, Y), TRUE);
774 if (Itm >= 0) then
775 begin
776 if (Itm <> FLastHintItem) then
777 begin
778 Application.CancelHint;
779 {Begin BillingAware}
780 if BILLING_AWARE then
781 begin
782 //Billing Awareness 'flyover' hint includes Dx code(s) when Dx code(s) have been assigned to an order
783 thisRec := TBADxRecord.Create;
784 thisOrderID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[Itm]).ID;
785
786 if UBAGlobals.tempDxNodeExists(thisOrderID) then
787 begin
788 if Assigned(tempDxList) then
789 try
790 for i := 0 to (tempDxList.Count - 1) do
791 begin
792 thisRec := TBADxRecord(tempDxList.Items[i]);
793
794 if Assigned(thisRec) then
795 if (thisRec.FOrderID = thisOrderID) then
796 begin
797 with thisRec do
798 begin
799 FBADxCode := StringReplace(thisrec.FBADxCode,'^',':',[rfReplaceAll]);
800 FBASecDx1 := StringReplace(thisrec.FBASecDx1,'^',':',[rfReplaceAll]);
801 FBASecDx2 := StringReplace(thisrec.FBASecDx2,'^',':',[rfReplaceAll]);;
802 FBASecDx3 := StringReplace(thisrec.FBASecDx3,'^',':',[rfReplaceAll]);
803 end;
804
805 clstOrders.Hint := TrimRight(clstOrders.Items[Itm] + #13 +
806 thisRec.FBADxCode + #13 + thisRec.FBASecDx1 + #13 + thisRec.FBASecDx2 + #13 + thisRec.FBASecDx3);
807 end
808 end
809 except
810 on EListError do
811 begin
812 {$ifdef debug}ShowMessage('EListError in frmSignOrders.clstOrdersMouseMove()');{$endif}
813 raise;
814 end;
815 end;
816
817 end
818 else
819 clstOrders.Hint := TrimRight(clstOrders.Items[Itm]);
820 end;
821 {End BillingAware}
822 FLastHintItem := Itm;
823 Application.ActivateHint(Point(X, Y));
824 end;
825 end
826 else
827 begin
828 clstOrders.Hint := '';
829 FLastHintItem := -1;
830 Application.CancelHint;
831 end;
832end;
833
834procedure TfrmSignOrders.FormShow(Sender: TObject);
835begin
836{Begin BillingAware}
837
838 //INITIALIZATIONS
839 Paste1.Enabled := false;
840 fOrdersSign.srcOrderID := '';
841 fOrdersSign.srcDx := '';
842 if txtESCode.Visible then
843 frmSignOrders.txtESCode.SetFocus;
844
845 if BILLING_AWARE then
846 begin
847 //List to contain loading OrderID's
848 if not Assigned(UBAGlobals.OrderIDList) then
849 UBAGlobals.OrderIDList := TStringList.Create;
850
851 if BILLING_AWARE then
852 clstOrders.Multiselect := true;
853
854 with fraCoPay do
855 begin
856 Label24.Caption := 'Service &Connected Condition';
857 StaticText4.Caption := 'Combat &Vet (Combat Related)';
858 Label18.Caption := 'Agent &Orange Exposure';
859 Label16.Caption := 'Ionizing &Radiation Exposure';
860 Label14.Caption := '&Environmental Contaminants';
861 Label12.Caption := '&MST';
862 lblHNC2.Caption := '&Head and/or Neck Cancer';
863 Label24.ShowAccelChar := true;
864 StaticText4.ShowAccelChar := true;
865 Label18.ShowAccelChar := true;
866 Label16.ShowAccelChar := true;
867 Label14.ShowAccelChar := true;
868 Label12.ShowAccelChar := true;
869 lblHNC2.ShowAccelChar := true;
870 end;
871 end; //BILLING_AWARE
872
873 clstOrders.TabOrder := 0; //CQ5057
874 FormatListForScreenReader;
875
876 //CQ5172
877 if clstOrders.Count = 1 then
878 begin
879 clstOrders.Selected[0] := true;
880 buOrdersDiagnosis.Enabled := True;
881 Diagnosis1.Enabled := True;
882 // if number of orders is 1 and order is billable select order and disable diagnosis button
883 if NOT UBACore.IsOrderBillable(TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[0]).ID) then
884 begin
885 buOrdersDiagnosis.Enabled := False;
886 Diagnosis1.Enabled := False;
887 clstOrders.Selected[0] := False;
888 end
889 else
890 if Piece(TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[0]).ID,';',2) = DISCONTINUED_ORDER then
891 begin
892 buOrdersDiagnosis.Enabled := False;
893 Diagnosis1.Enabled := False;
894 end;
895 end;
896 //end CQ5172
897end;
898
899 {Begin BillingAware}
900 // New BA Button....
901procedure TfrmSignOrders.buOrdersDiagnosisClick(Sender: TObject);
902var
903 i: smallint;
904 thisOrderID: string;
905 match: boolean;
906 allBlank: boolean;
907 numSelected: smallint;
908begin
909{Begin BillingAware}
910
911 numSelected := 0;
912 match := false;
913 allBlank := false;
914 //orderIDList := TStringList.Create;
915 if Assigned (orderIDList) then orderIDList.Clear;
916 if Assigned(UBAGlobals.PLFactorsIndexes) then UBAGlobals.PLFactorsIndexes.Clear;
917 if Assigned (BAtmpOrderList) then BAtmpOrderList.Clear;
918
919 try
920 // User has selected no orders to sign
921 for i := 0 to fOrdersSign.frmSignOrders.clstOrders.Items.Count-1 do
922 begin
923 if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then
924 begin
925 thisOrderID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID;
926 orderIDList.Add(thisOrderID);
927 {BAV25 Code}
928 BAtmpOrderList.Add(TOrder(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).TEXT);
929 // stringlist holding index and stsFactors
930 UBAGlobals.PLFactorsIndexes.Add(IntToStr(i)+ U + GetCheckBoxStatus(thisOrderID) ); // store indexes and flags of selected orders
931 {BAV25 Code}
932 // Test for blank Dx on current grid item
933 if not (tempDxNodeExists(thisOrderID)) then
934 if Assigned(UBAGlobals.globalDxRec) then
935 InitializeNewDxRec(UBAGlobals.globalDxRec);
936 if (tempDxNodeExists(thisOrderID)) then
937 begin
938 // Create UBAGlobals.globalDxRec with loaded fields
939 if not Assigned(UBAGlobals.globalDxRec) then
940 begin
941 UBAGlobals.globalDxRec := UBAGlobals.TBADxRecord.Create;
942 InitializeNewDxRec(UBAGlobals.globalDxRec);
943 GetBADxListForOrder(UBAGlobals.globalDxRec, thisOrderID);
944 end
945 else
946 GetBADxListForOrder(UBAGlobals.globalDxRec, thisOrderID);
947
948 {$ifdef debug}
949 with UBAGlobals.globalDxRec do
950 //ShowMessage('globalDxRec:'+#13+FOrderID+#13+FBADxCode+#13+FBASecDx1+#13+FBASecDx2+#13+FBASecDx3);
951 {$endif}
952 end;
953 end; //if
954 end; //for
955 except
956 on E: Exception do
957 ShowMessage(E.ClassName+' error raised, with message : '+E.Message);
958 end;
959
960 numSelected := CountSelectedOrders(UBAConst.F_ORDERS_SIGN);
961
962 if numSelected = 0 then
963 begin
964 ShowMessage(UBAMessages.BA_NO_ORDERS_SELECTED);
965 Exit;
966 end
967 else
968 if numSelected = 1 then
969 match := true;
970
971 if (UBAGlobals.CompareOrderDx(UBAConst.F_ORDERS_SIGN)) then
972 match := true;
973
974
975 if UBAGlobals.AllSelectedDxBlank(UBAConst.F_ORDERS_SIGN) then
976 allBlank := true;
977
978 if ((match and allBlank) or (match and (not allBlank))) then // All selected are blank or matching-not-blank
979// begin
980 { TODO 3 -oKW -cRefinement : Define a const to replace string literal }
981 frmBALocalDiagnoses.Enter(UBAConst.F_ORDERS_SIGN, orderIDList)
982 else
983 begin
984 //Warning message
985 //If 'Yes' on warning message then open localDiagnosis
986 if (not allBlank) then
987 if MessageDlg(UBAMessages.BA_CONFIRM_DX_OVERWRITE, mtConfirmation, [mbYes, mbNo], 0) = mrNo then
988 Exit
989 else
990// begin
991 if Assigned(UBAGlobals.globalDxRec) then
992 InitializeNewDxRec(UBAGlobals.globalDxRec);
993 frmBALocalDiagnoses.Enter(UBAConst.F_ORDERS_SIGN, orderIDList);
994 end;
995 // TFactors come from FBALocalDiagnoses(Problem List Dx's Only).
996 if Length(UBAGlobals.TFactors) > 0 then
997 begin
998 UBACore.SetTreatmentFactors(UBAGlobals.TFactors);
999 SigItems.DisplayPlTreatmentFactors;
1000 end;
1001 {End BillingAware}
1002 txtESCode.SetFocus;
1003end;
1004
1005procedure TfrmSignOrders.Exit1Click(Sender: TObject);
1006begin
1007 Close;
1008end;
1009
1010procedure TfrmSignOrders.Copy1Click(Sender: TObject);
1011{
1012 - Copy contents of the 'source' order for copy/paste operation
1013}
1014var
1015 i : byte;
1016 numSelected: byte;
1017 thisChangeItem: TChangeItem;
1018begin
1019 try
1020 if BILLING_AWARE then
1021 begin
1022 Paste1.Enabled := true;
1023
1024 numSelected := GetNumberOfSelectedOrders;
1025
1026 if numSelected > 1 then
1027 begin
1028 ShowMessage('Only 1 order at a time may be selected for ''Copying''');
1029 Exit;
1030 end;
1031
1032 for i := 0 to fOrdersSign.frmSignOrders.clstOrders.Items.Count-1 do
1033 if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then
1034 begin
1035 thisChangeItem := TChangeItem.Create;
1036 thisChangeItem := nil;
1037 thisChangeItem := TChangeItem(clstOrders.Items.Objects[i]);
1038 //Skip this one if it's a "header" on the grid
1039 if (thisChangeItem = nil) then //or (thisChangeItem.ItemType <> CH_ORD)) then
1040 begin
1041 FreeAndNil(thisChangeItem);
1042 Exit;
1043 end;
1044
1045 fOrdersSign.srcOrderID := TChangeItem(frmSignOrders.clstOrders.Items.Objects[i]).ID;
1046
1047 //Copy source order to COPY BUFFER and add it to the Dx List
1048 CopyBuffer := TBADxRecord.Create;
1049 InitializeNewDxRec(CopyBuffer);
1050 GetBADxListForOrder(CopyBuffer, fOrdersSign.srcOrderID);
1051 fOrdersSign.CopyBuffer.FOrderID := BUFFER_ORDER_ID;
1052 UBAGlobals.tempDxList.Add(CopyBuffer);
1053
1054 //*************************************************************************
1055 if (NOT UBACore.IsOrderBillable(fOrdersSign.srcOrderID) ) then //and
1056 // (NOT tempDxNodeExists(fOrdersSign.srcOrderID)) then // added to allow copy to NON CIDC consult order the requires a DX. then
1057 begin
1058 ShowMessage(BA_NA_COPY_DISALLOWED);
1059 fOrdersSign.srcOrderID := '';
1060 Exit;
1061 end;
1062 //*************************************************************************
1063
1064 fOrdersSign.srcIndex := clstOrders.ItemIndex;
1065 fOrdersSign.chkBoxStatus := GetCheckBoxStatus(fOrdersSign.srcOrderID);
1066 Break;
1067 end;
1068 end; //if BILLING_AWARE
1069 except
1070 on EListError do
1071 begin
1072 ShowMessage('EListError in frmSignOrders.Copy1Click()');
1073 raise;
1074 end;
1075 end;
1076
1077 //CopyActive := true; //CQ6225
1078 //Paste1.Enabled := true; //CQ6225
1079end;
1080
1081procedure TfrmSignOrders.Paste1Click(Sender: TObject);
1082{
1083 - Populate 'target' orders of a copy/paste operation with contents of 'source' order
1084}
1085var
1086 i: byte;
1087 newRec: TBADxRecord;
1088begin
1089 if BILLING_AWARE then
1090 begin
1091 if not Assigned(fOrdersSign.CopyBuffer) then //CQ5414
1092 fOrdersSign.CopyBuffer := TBADxRecord.Create; //CQ5414
1093
1094 try
1095 for i := 0 to clstOrders.Count - 1 do
1096 begin
1097 if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then
1098 begin
1099 fOrdersSign.targetOrderID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID;
1100
1101 if fOrdersSign.targetOrderID = fOrdersSign.srcOrderID then //disallow copying an order to itself
1102 Continue
1103 else
1104 begin
1105 fOrdersSign.CopyBuffer.FOrderID := BUFFER_ORDER_ID;
1106
1107 //***************************************************************
1108 if Not UBACore.IsOrderBillable(targetOrderID) then
1109 begin
1110 ShowMessage(BA_NA_PASTE_DISALLOWED);
1111 fOrdersSign.targetOrderID := '';
1112 Continue;
1113 end;
1114 //***************************************************************
1115
1116 newRec := TBADxRecord.Create;
1117 with newRec do
1118 begin
1119 FOrderID := fOrdersSign.targetOrderID;
1120 FBADxCode := CopyBuffer.FBADxCode;
1121 FBASecDx1 := CopyBuffer.FBASecDx1;
1122 FBASecDx2 := CopyBuffer.FBASecDx2;
1123 FBASecDx3 := CopyBuffer.FBASecDx3;
1124 end;
1125
1126 tempDxList.Add(newRec);
1127
1128 CopyTFCIToTargetOrder( fOrdersSign.targetOrderID, fOrdersSign.chkBoxStatus);
1129 SetCheckBoxStatus( fOrdersSign.targetOrderID); //calls uSignItems.SetSigItems()
1130 end;
1131 end;
1132 end;
1133 except
1134 on EListError do
1135 begin
1136 ShowMessage('EListError in frmSignOrders.Paste1Click()'+#13+'for i := 0 to clstOrders.Count - 1 do');
1137 raise;
1138 end;
1139 end;
1140 clstOrders.Refresh; //Update grid to show pasted Dx
1141 end;
1142{
1143 //CQ6225
1144 if CopyActive then
1145 begin
1146 Paste1.Enabled := false;
1147 CopyActive := false;
1148 end;
1149 //end CQ6225
1150}
1151end;
1152
1153procedure TfrmSignOrders.clstOrdersMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1154{
1155 - Open copy/paste popup menu.
1156}
1157var
1158 ClientPoint: TPoint;
1159 ScreenPoint: TPoint;
1160begin
1161 if not BILLING_AWARE then clstOrders.PopupMenu := nil;
1162
1163 if BILLING_AWARE then
1164 begin
1165 try
1166 if Button = mbRight then //Right-click to open copy/paste popup menu
1167 begin
1168 //CQ3325
1169 if fOrdersSign.frmSignOrders.clstOrders.Items.Count = 1 then
1170 begin
1171 Copy1.Enabled := false;
1172 Paste1.Enabled := false
1173 end
1174 else
1175 begin
1176 Copy1.Enabled := true;
1177 //Paste1.Enabled := true; //commented out for CQ6225
1178 end;
1179 //End CQ3325
1180
1181 if not frmSignOrders.clstOrders.Selected[clstOrders.ItemIndex] then
1182 (Sender as TCheckListBox).Selected[clstOrders.ItemIndex] := true;
1183
1184 ClientPoint.X := X;
1185 ClientPoint.Y := Y;
1186 ScreenPoint := clstOrders.ClientToScreen(ClientPoint);
1187 poBACopyPaste.Popup(ScreenPoint.X, ScreenPoint.Y);
1188 end;
1189 except
1190 on EListError do
1191 begin
1192 ShowMessage('EListError in frmSignOrders.clstOrdersMouseDown()');
1193 raise;
1194 end;
1195 end;
1196 end;
1197end;
1198
1199
1200procedure TfrmSignOrders.clstOrdersClick(Sender: TObject);
1201//If grid item is an order-able item, then enable the Diagnosis button
1202// else disable the Diagnosis button.
1203var
1204 thisChangeItem: TChangeItem;
1205 i: smallint;
1206 thisOrderList: TStringList;
1207begin
1208 thisOrderList := TStringList.Create;
1209
1210 {Begin BillingAware}
1211 if BILLING_AWARE then
1212 begin
1213
1214 if clstOrders.Items.Count > 1 then
1215 copy1.Enabled := True
1216 else
1217 copy1.Enabled := False;
1218
1219 for i := 0 to clstOrders.Items.Count - 1 do
1220 begin
1221 if clstOrders.Selected[i] then
1222 begin
1223 thisChangeItem := TChangeItem(clstOrders.Items.Objects[i]);
1224
1225 //Disallow copying of a grid HEADER item on LEFT MOUSE CLICK
1226 if thisChangeItem = nil then
1227 begin
1228 Copy1.Enabled := false;
1229 buOrdersDiagnosis.Enabled := false;
1230 Exit;
1231 end;
1232
1233 if (thisChangeItem <> nil) then //Blank row - not an order item
1234 begin
1235 thisOrderList.Clear;
1236 thisOrderList.Add(thisChangeItem.ID);
1237
1238 if IsAllOrdersNA(thisOrderList) then
1239 begin
1240 Diagnosis1.Enabled := false;
1241 buOrdersDiagnosis.Enabled := false;
1242 end
1243 else
1244 begin
1245 Diagnosis1.Enabled := true;
1246 buOrdersDiagnosis.Enabled := true;
1247 end
1248 end
1249 else
1250 begin
1251 buOrdersDiagnosis.Enabled := false;
1252 Diagnosis1.Enabled := False;
1253 Break;
1254 end;
1255 end;
1256 end;
1257
1258 if Assigned(thisOrderList) then thisOrderList.Free;
1259 end;
1260end;
1261
1262procedure TfrmSignOrders.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
1263var
1264 j: integer; //CQ5054
1265begin
1266 //if BILLING_AWARE then
1267 //begin
1268 if FOSTFHintWndActive then
1269 begin
1270 FOSTFhintWindow.ReleaseHandle ;
1271 FOSTFHintWndActive := False ;
1272 end;
1273
1274 case Key of
1275 67,99: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorSC,fraCoPay.Label24); //C,c
1276 86,118: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorCV,fraCoPay.staticText4); //V,v
1277 79,111: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorAO,fraCoPay.Label18); //O,o
1278 82,114: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorIR,fraCoPay.Label16); //R,r
1279 69,101: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorEC,fraCoPay.Label14); //E,e
1280 77,109: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorMST,fraCoPay.Label12); //M,m
1281 72,104: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorHNC,fraCoPay.lblHNC2); //H,h
1282 //CQ5054
1283 83,115: if (ssAlt in Shift) then
1284 begin
1285 for j := 0 to clstOrders.Items.Count-1 do
1286 clstOrders.Selected[j] := false;
1287 clstOrders.Selected[0] := true;
1288 clstOrders.SetFocus;
1289 end;
1290 //end CQ5054
1291 end;
1292
1293 //end //if BILLING_AWARE
1294end;
1295
1296//BILLING AWARE Procedure
1297procedure TfrmSignOrders.ShowTreatmentFactorHints(var pHintText: string; var pCompName: TORStaticText); // 508
1298var
1299 HRect: TRect;
1300 thisRect: TRect;
1301 x,y: integer;
1302
1303begin
1304 try
1305 if FOSTFhintWndActive then
1306 begin
1307 FOSTFhintWindow.ReleaseHandle;
1308 FOSTFhintWndActive := False;
1309 end;
1310 except
1311 on E: Exception do
1312 begin
1313 {$ifdef debug}ShowMessage('Unhandled exception in procedure TfrmSignOrders.ShowTreatmentFactorHints()');{$endif}
1314 raise;
1315 end;
1316 end;
1317
1318 x := 0;
1319 y := 0;
1320
1321 try
1322 FOSTFhintWindow := THintWindow.Create(frmSignOrders);
1323 FOSTFhintWindow.Color := clInfoBk;
1324 GetWindowRect(pCompName.Handle,thisRect);
1325 x := thisRect.Left;
1326 y := thisRect.Top;
1327 hrect := FOSTFhintWindow.CalcHintRect(Screen.Width, pHintText,nil);
1328 hrect.Left := hrect.Left + X;
1329 hrect.Right := hrect.Right + X;
1330 hrect.Top := hrect.Top + Y;
1331 hrect.Bottom := hrect.Bottom + Y;
1332
1333 if FOSTFHintWndActive then
1334 begin
1335 with fraCoPay do
1336 begin
1337 //Abbreviated captions
1338 Label23.ShowHint := false;
1339 StaticText1.ShowHint := false;
1340 Label17.ShowHint := false;
1341 Label15.ShowHint := false;
1342 Label13.ShowHint := false;
1343 Label11.ShowHint := false;
1344 lblHNC.ShowHint := false;
1345 //Long captions
1346 staticText4.ShowHint := false;
1347 Label17.ShowHint := false;
1348 Label18.ShowHint := false;
1349 Label15.ShowHint := false;
1350 Label16.ShowHint := false;
1351 Label13.ShowHint := false;
1352 Label14.ShowHint := false;
1353 Label11.ShowHint := false;
1354 Label12.ShowHint := false;
1355 lblHNC.ShowHint := false;
1356 lblHNC2.ShowHint := false;
1357 end;
1358 end
1359 else
1360 begin
1361 with fraCoPay do
1362 begin
1363 //Abbreviated captions
1364 Label23.ShowHint := true;
1365 StaticText1.ShowHint := true;
1366 Label17.ShowHint := true;
1367 Label15.ShowHint := true;
1368 Label13.ShowHint := true;
1369 Label11.ShowHint := true;
1370 lblHNC.ShowHint := true;
1371 //Long captions
1372 staticText4.ShowHint := true;
1373 Label17.ShowHint := true;
1374 Label18.ShowHint := true;
1375 Label15.ShowHint := true;
1376 Label16.ShowHint := true;
1377 Label13.ShowHint := true;
1378 Label14.ShowHint := true;
1379 Label11.ShowHint := true;
1380 Label12.ShowHint := true;
1381 lblHNC.ShowHint := true;
1382 lblHNC2.ShowHint := true;
1383 end;
1384 end;
1385
1386 FOSTFhintWindow.ActivateHint(hrect, pHintText);
1387 FOSTFHintWndActive := True;
1388 except
1389 on E: Exception do
1390 begin
1391 {$ifdef debug}ShowMessage('Unhandled exception in procedure TfrmSignOrders.ShowTreatmentFactorHints()');{$endif}
1392 raise;
1393 end;
1394 end;
1395end;
1396
1397procedure TfrmSignOrders.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
1398begin
1399 try
1400 if BILLING_AWARE then
1401 begin
1402 if FOSTFhintWndActive then
1403 begin
1404 FOSTFhintWindow.ReleaseHandle;
1405 FOSTFHintWndActive := False;
1406 Application.ProcessMessages;
1407 end;
1408 end;
1409 except
1410 on E: Exception do
1411 begin
1412 {$ifdef debug}ShowMessage('Unhandled exception in procedure TfrmSignOrders.FormMouseMove()');{$endif}
1413 raise;
1414 end;
1415 end;
1416end;
1417
1418procedure TfrmSignOrders.fraCoPaylblHNCMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
1419begin
1420 if FOSTFHintWndActive then
1421 begin
1422 with fraCoPay do
1423 begin
1424 //Abbreviated captions
1425 Label23.ShowHint := false;
1426 StaticText1.ShowHint := false;
1427 Label17.ShowHint := false;
1428 Label15.ShowHint := false;
1429 Label13.ShowHint := false;
1430 Label11.ShowHint := false;
1431 lblHNC.ShowHint := false;
1432 //Long captions
1433 Label24.ShowHint := false;
1434 staticText4.ShowHint := false;
1435 Label17.ShowHint := false;
1436 Label18.ShowHint := false;
1437 Label15.ShowHint := false;
1438 Label16.ShowHint := false;
1439 Label13.ShowHint := false;
1440 Label14.ShowHint := false;
1441 Label11.ShowHint := false;
1442 Label12.ShowHint := false;
1443 lblHNC.ShowHint := false;
1444 lblHNC2.ShowHint := false;
1445 end;
1446 end
1447 else
1448 begin
1449 with fraCoPay do
1450 begin
1451 //Abbreviated captions
1452 Label23.ShowHint := true;
1453 StaticText1.ShowHint := true;
1454 Label17.ShowHint := true;
1455 Label15.ShowHint := true;
1456 Label13.ShowHint := true;
1457 Label11.ShowHint := true;
1458 lblHNC.ShowHint := true;
1459 //Long captions
1460 Label24.ShowHint := true;
1461 staticText4.ShowHint := true;
1462 Label17.ShowHint := true;
1463 Label18.ShowHint := true;
1464 Label15.ShowHint := true;
1465 Label16.ShowHint := true;
1466 Label13.ShowHint := true;
1467 Label14.ShowHint := true;
1468 Label11.ShowHint := true;
1469 Label12.ShowHint := true;
1470 lblHNC.ShowHint := true;
1471 lblHNC2.ShowHint := true;
1472 end;
1473 end;
1474
1475end;
1476
1477procedure TfrmSignOrders.fraCoPayLabel23Enter(Sender: TObject);
1478begin
1479 (Sender as TORStaticText).Font.Style := [fsBold];
1480end;
1481
1482procedure TfrmSignOrders.fraCoPayLabel23Exit(Sender: TObject);
1483begin
1484 (Sender as TORStaticText).Font.Style := [];
1485end;
1486
1487procedure TfrmSignOrders.SetItemTextToState;
1488var
1489 i : integer;
1490begin
1491 //The with statement below would cause access violations on other Delphi machines.
1492 { with clstOrders do
1493 begin }
1494 //Must use fully qualifying path includeing the unit... very wierd!
1495
1496 if fOrdersSign.frmSignOrders.clstOrders.Count < 1 then Exit;
1497 for i := 0 to fOrdersSign.frmSignOrders.clstOrders.Count-1 do
1498 if fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i] <> nil then //Not a Group Title
1499 begin
1500 if fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i] is TOrder then
1501 if fOrdersSign.frmSignOrders.clstOrders.Checked[i] then
1502 fOrdersSign.frmSignOrders.clstOrders.Items[i] := 'Checked '+TOrder(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).Text
1503 else
1504 fOrdersSign.frmSignOrders.clstOrders.Items[i] := 'Not Checked '+TOrder(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).Text;
1505 end;
1506 if fOrdersSign.frmSignOrders.clstOrders.ItemIndex >= 0 then
1507 fOrdersSign.frmSignOrders.clstOrders.Selected[fOrdersSign.frmSignOrders.clstOrders.ItemIndex] := True;
1508// end;
1509end;
1510
1511procedure TfrmSignOrders.clstOrdersKeyUp(Sender: TObject; var Key: Word;
1512 Shift: TShiftState);
1513begin
1514 if (Key = VK_Space) then
1515 FormatListForScreenReader
1516end;
1517
1518procedure TfrmSignOrders.FormatListForScreenReader;
1519var
1520 ListStateOn : boolean;
1521begin
1522 //Determine if a screen reader is currently being used.
1523 SystemParametersInfo(SPI_GETSCREENREADER, 0, @ListStateOn,0);
1524 if ListStateOn then
1525 SetItemTextToState
1526end;
1527
1528end.
Note: See TracBrowser for help on using the repository browser.