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

Last change on this file since 1797 was 1679, checked in by healthsevak, 10 years ago

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