source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/fOrdersSign.pas@ 797

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

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