source: cprs/trunk/CPRS-Chart/Orders/fOrdersSign.pas@ 1211

Last change on this file since 1211 was 829, checked in by Kevin Toppenberg, 14 years ago

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