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

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

Initial upload of TMG-CPRS 1.0.26.69
File size: 57.7 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 <-- original line. //kt 8/8/2007
1140 - Populate DKLangConstW('fOrdersSign_target') orders of a copy/paste operation with contents of DKLangConstW('fOrdersSign_source') order //kt added 8/8/2007
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
1156 fOrdersSign.targetOrderID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID;
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
1167 ShowMessage(BA_NA_PASTE_DISALLOWED);
1168 fOrdersSign.targetOrderID := '';
1169 Continue;
1170 end;
1171 //***************************************************************
1172
1173 newRec := TBADxRecord.Create;
1174 with newRec do
1175 begin
1176 FOrderID := fOrdersSign.targetOrderID;
1177 FBADxCode := CopyBuffer.FBADxCode;
1178 FBASecDx1 := CopyBuffer.FBASecDx1;
1179 FBASecDx2 := CopyBuffer.FBASecDx2;
1180 FBASecDx3 := CopyBuffer.FBASecDx3;
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
1193// ShowMessage('EListError in frmSignOrders.Paste1Click()'+#13+'for i := 0 to clstOrders.Count - 1 do'); <-- original line. //kt 8/8/2007
1194 ShowMessage(DKLangConstW('fOrdersSign_EListError_in_frmSignOrdersxPaste1Clickxx')+#13+DKLangConstW('fOrdersSign_for_i_xx_0_to_clstOrdersxCount_x_1_do')); //kt added 8/8/2007
1195 raise;
1196 end;
1197 end;
1198 clstOrders.Refresh; //Update grid to show pasted Dx
1199 end;
1200{
1201 //CQ6225
1202 if CopyActive then
1203 begin
1204 Paste1.Enabled := false;
1205 CopyActive := false;
1206 end;
1207 //end CQ6225
1208}
1209end;
1210
1211procedure TfrmSignOrders.clstOrdersMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1212{
1213 - Open copy/paste popup menu.
1214}
1215var
1216 ClientPoint: TPoint;
1217 ScreenPoint: TPoint;
1218begin
1219 if not BILLING_AWARE then clstOrders.PopupMenu := nil;
1220
1221 if BILLING_AWARE then
1222 begin
1223 try
1224 if Button = mbRight then //Right-click to open copy/paste popup menu
1225 begin
1226 //CQ3325
1227 if fOrdersSign.frmSignOrders.clstOrders.Items.Count = 1 then
1228 begin
1229 Copy1.Enabled := false;
1230 Paste1.Enabled := false
1231 end
1232 else
1233 begin
1234 Copy1.Enabled := true;
1235 //Paste1.Enabled := true; //commented out for CQ6225
1236 end;
1237 //End CQ3325
1238
1239 if not frmSignOrders.clstOrders.Selected[clstOrders.ItemIndex] then
1240 (Sender as TCheckListBox).Selected[clstOrders.ItemIndex] := true;
1241
1242 ClientPoint.X := X;
1243 ClientPoint.Y := Y;
1244 ScreenPoint := clstOrders.ClientToScreen(ClientPoint);
1245 poBACopyPaste.Popup(ScreenPoint.X, ScreenPoint.Y);
1246 end;
1247 except
1248 on EListError do
1249 begin
1250// ShowMessage('EListError in frmSignOrders.clstOrdersMouseDown()'); <-- original line. //kt 8/8/2007
1251 ShowMessage(DKLangConstW('fOrdersSign_EListError_in_frmSignOrdersxclstOrdersMouseDownxx')); //kt added 8/8/2007
1252 raise;
1253 end;
1254 end;
1255 end;
1256end;
1257
1258
1259procedure TfrmSignOrders.clstOrdersClick(Sender: TObject);
1260//If grid item is an order-able item, then enable the Diagnosis button
1261// else disable the Diagnosis button.
1262var
1263 thisChangeItem: TChangeItem;
1264 i: smallint;
1265 thisOrderList: TStringList;
1266begin
1267 thisOrderList := TStringList.Create;
1268
1269 {Begin BillingAware}
1270 if BILLING_AWARE then
1271 begin
1272
1273 if clstOrders.Items.Count > 1 then
1274 copy1.Enabled := True
1275 else
1276 copy1.Enabled := False;
1277
1278 for i := 0 to clstOrders.Items.Count - 1 do
1279 begin
1280 if clstOrders.Selected[i] then
1281 begin
1282 thisChangeItem := TChangeItem(clstOrders.Items.Objects[i]);
1283
1284 //Disallow copying of a grid HEADER item on LEFT MOUSE CLICK
1285 if thisChangeItem = nil then
1286 begin
1287 Copy1.Enabled := false;
1288 buOrdersDiagnosis.Enabled := false;
1289 Exit;
1290 end;
1291
1292 if (thisChangeItem <> nil) then //Blank row - not an order item
1293 begin
1294 thisOrderList.Clear;
1295 thisOrderList.Add(thisChangeItem.ID);
1296
1297 if IsAllOrdersNA(thisOrderList) then
1298 begin
1299 Diagnosis1.Enabled := false;
1300 buOrdersDiagnosis.Enabled := false;
1301 end
1302 else
1303 begin
1304 Diagnosis1.Enabled := true;
1305 buOrdersDiagnosis.Enabled := true;
1306 end
1307 end
1308 else
1309 begin
1310 buOrdersDiagnosis.Enabled := false;
1311 Diagnosis1.Enabled := False;
1312 Break;
1313 end;
1314 end;
1315 end;
1316
1317 if Assigned(thisOrderList) then thisOrderList.Free;
1318 end;
1319end;
1320
1321procedure TfrmSignOrders.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
1322var
1323 j: integer; //CQ5054
1324begin
1325
1326 if FOSTFHintWndActive then
1327 begin
1328 FOSTFhintWindow.ReleaseHandle ;
1329 FOSTFHintWndActive := False ;
1330 end;
1331
1332 case Key of
1333 67,99: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorSC,fraCoPay.Label24); //C,c
1334 86,118: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorCV,fraCoPay.staticText4); //V,v
1335 79,111: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorAO,fraCoPay.Label18); //O,o
1336 82,114: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorIR,fraCoPay.Label16); //R,r
1337 69,101: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorEC,fraCoPay.Label14); //E,e
1338 77,109: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorMST,fraCoPay.Label12); //M,m
1339 72,104: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorHNC,fraCoPay.lblHNC2); //H,h
1340 //CQ5054
1341 83,115: if (ssAlt in Shift) then
1342 begin
1343 for j := 0 to clstOrders.Items.Count-1 do
1344 clstOrders.Selected[j] := false;
1345 clstOrders.Selected[0] := true;
1346 clstOrders.SetFocus;
1347 end;
1348 //end CQ5054
1349 end;
1350end;
1351
1352//BILLING AWARE Procedure
1353procedure TfrmSignOrders.ShowTreatmentFactorHints(var pHintText: string; var pCompName: TORStaticText); // 508
1354var
1355 HRect: TRect;
1356 thisRect: TRect;
1357 x,y: integer;
1358
1359begin
1360 try
1361 if FOSTFhintWndActive then
1362 begin
1363 FOSTFhintWindow.ReleaseHandle;
1364 FOSTFhintWndActive := False;
1365 end;
1366 except
1367 on E: Exception do
1368 begin
1369 {$ifdef debug}ShowMessage('Unhandled exception in procedure TfrmSignOrders.ShowTreatmentFactorHints()');{$endif}
1370 raise;
1371 end;
1372 end;
1373
1374 try
1375 FOSTFhintWindow := THintWindow.Create(frmSignOrders);
1376 FOSTFhintWindow.Color := clInfoBk;
1377 GetWindowRect(pCompName.Handle,thisRect);
1378 x := thisRect.Left;
1379 y := thisRect.Top;
1380 hrect := FOSTFhintWindow.CalcHintRect(Screen.Width, pHintText,nil);
1381 hrect.Left := hrect.Left + X;
1382 hrect.Right := hrect.Right + X;
1383 hrect.Top := hrect.Top + Y;
1384 hrect.Bottom := hrect.Bottom + Y;
1385
1386 if FOSTFHintWndActive then
1387 begin
1388 with fraCoPay do
1389 begin
1390 //Abbreviated captions
1391 Label23.ShowHint := false;
1392 StaticText1.ShowHint := false;
1393 Label17.ShowHint := false;
1394 Label15.ShowHint := false;
1395 Label13.ShowHint := false;
1396 Label11.ShowHint := false;
1397 lblHNC.ShowHint := false;
1398 //Long captions
1399 staticText4.ShowHint := false;
1400 Label17.ShowHint := false;
1401 Label18.ShowHint := false;
1402 Label15.ShowHint := false;
1403 Label16.ShowHint := false;
1404 Label13.ShowHint := false;
1405 Label14.ShowHint := false;
1406 Label11.ShowHint := false;
1407 Label12.ShowHint := false;
1408 lblHNC.ShowHint := false;
1409 lblHNC2.ShowHint := false;
1410 end;
1411 end
1412 else
1413 begin
1414 with fraCoPay do
1415 begin
1416 //Abbreviated captions
1417 Label23.ShowHint := true;
1418 StaticText1.ShowHint := true;
1419 Label17.ShowHint := true;
1420 Label15.ShowHint := true;
1421 Label13.ShowHint := true;
1422 Label11.ShowHint := true;
1423 lblHNC.ShowHint := true;
1424 //Long captions
1425 staticText4.ShowHint := true;
1426 Label17.ShowHint := true;
1427 Label18.ShowHint := true;
1428 Label15.ShowHint := true;
1429 Label16.ShowHint := true;
1430 Label13.ShowHint := true;
1431 Label14.ShowHint := true;
1432 Label11.ShowHint := true;
1433 Label12.ShowHint := true;
1434 lblHNC.ShowHint := true;
1435 lblHNC2.ShowHint := true;
1436 end;
1437 end;
1438
1439 FOSTFhintWindow.ActivateHint(hrect, pHintText);
1440 FOSTFHintWndActive := True;
1441 except
1442 on E: Exception do
1443 begin
1444 {$ifdef debug}ShowMessage('Unhandled exception in procedure TfrmSignOrders.ShowTreatmentFactorHints()');{$endif}
1445 raise;
1446 end;
1447 end;
1448end;
1449
1450procedure TfrmSignOrders.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
1451begin
1452 try
1453 if FOSTFhintWndActive then
1454 begin
1455 FOSTFhintWindow.ReleaseHandle;
1456 FOSTFHintWndActive := False;
1457 Application.ProcessMessages;
1458 end;
1459 except
1460 on E: Exception do
1461 begin
1462 {$ifdef debug}ShowMessage('Unhandled exception in procedure TfrmSignOrders.FormMouseMove()');{$endif}
1463 raise;
1464 end;
1465 end;
1466end;
1467
1468procedure TfrmSignOrders.fraCoPaylblHNCMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
1469begin
1470 if FOSTFHintWndActive then
1471 begin
1472 with fraCoPay do
1473 begin
1474 //Abbreviated captions
1475 Label23.ShowHint := false;
1476 StaticText1.ShowHint := false;
1477 Label17.ShowHint := false;
1478 Label15.ShowHint := false;
1479 Label13.ShowHint := false;
1480 Label11.ShowHint := false;
1481 lblHNC.ShowHint := false;
1482 //Long captions
1483 Label24.ShowHint := false;
1484 staticText4.ShowHint := false;
1485 Label17.ShowHint := false;
1486 Label18.ShowHint := false;
1487 Label15.ShowHint := false;
1488 Label16.ShowHint := false;
1489 Label13.ShowHint := false;
1490 Label14.ShowHint := false;
1491 Label11.ShowHint := false;
1492 Label12.ShowHint := false;
1493 lblHNC.ShowHint := false;
1494 lblHNC2.ShowHint := false;
1495 end;
1496 end
1497 else
1498 begin
1499 with fraCoPay do
1500 begin
1501 //Abbreviated captions
1502 Label23.ShowHint := true;
1503 StaticText1.ShowHint := true;
1504 Label17.ShowHint := true;
1505 Label15.ShowHint := true;
1506 Label13.ShowHint := true;
1507 Label11.ShowHint := true;
1508 lblHNC.ShowHint := true;
1509 //Long captions
1510 Label24.ShowHint := true;
1511 staticText4.ShowHint := true;
1512 Label17.ShowHint := true;
1513 Label18.ShowHint := true;
1514 Label15.ShowHint := true;
1515 Label16.ShowHint := true;
1516 Label13.ShowHint := true;
1517 Label14.ShowHint := true;
1518 Label11.ShowHint := true;
1519 Label12.ShowHint := true;
1520 lblHNC.ShowHint := true;
1521 lblHNC2.ShowHint := true;
1522 end;
1523 end;
1524
1525end;
1526
1527procedure TfrmSignOrders.fraCoPayLabel23Enter(Sender: TObject);
1528begin
1529 (Sender as TORStaticText).Font.Style := [fsBold];
1530end;
1531
1532procedure TfrmSignOrders.fraCoPayLabel23Exit(Sender: TObject);
1533begin
1534 (Sender as TORStaticText).Font.Style := [];
1535end;
1536
1537procedure TfrmSignOrders.SetItemTextToState;
1538var
1539 i : integer;
1540begin
1541 //The with statement below would cause access violations on other Delphi machines.
1542 { with clstOrders do
1543 begin }
1544 //Must use fully qualifying path includeing the unit... very wierd!
1545
1546 if fOrdersSign.frmSignOrders.clstOrders.Count < 1 then Exit;
1547 for i := 0 to fOrdersSign.frmSignOrders.clstOrders.Count-1 do
1548 if fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i] <> nil then //Not a Group Title
1549 begin
1550 if fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i] is TOrder then
1551 if fOrdersSign.frmSignOrders.clstOrders.Checked[i] then
1552// fOrdersSign.frmSignOrders.clstOrders.Items[i] := 'Checked '+TOrder(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).Text <-- original line. //kt 8/8/2007
1553 fOrdersSign.frmSignOrders.clstOrders.Items[i] := DKLangConstW('fOrdersSign_Checked')+TOrder(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).Text //kt added 8/8/2007
1554 else
1555// fOrdersSign.frmSignOrders.clstOrders.Items[i] := 'Not Checked '+TOrder(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).Text; <-- original line. //kt 8/8/2007
1556 fOrdersSign.frmSignOrders.clstOrders.Items[i] := DKLangConstW('fOrdersSign_Not_Checked')+TOrder(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).Text; //kt added 8/8/2007
1557 end;
1558 if fOrdersSign.frmSignOrders.clstOrders.ItemIndex >= 0 then
1559 fOrdersSign.frmSignOrders.clstOrders.Selected[fOrdersSign.frmSignOrders.clstOrders.ItemIndex] := True;
1560// end;
1561end;
1562
1563procedure TfrmSignOrders.clstOrdersKeyUp(Sender: TObject; var Key: Word;
1564 Shift: TShiftState);
1565begin
1566 if (Key = VK_Space) then
1567 FormatListForScreenReader
1568end;
1569
1570procedure TfrmSignOrders.FormatListForScreenReader;
1571var
1572 ListStateOn : longbool;
1573 Success: longbool;
1574begin
1575 //Determine if a screen reader is currently being used.
1576 Success := SystemParametersInfo(SPI_GETSCREENREADER, 0, @ListStateOn,0);
1577 if Success and ListStateOn then
1578 SetItemTextToState;
1579end;
1580
1581end.
Note: See TracBrowser for help on using the repository browser.