source: cprs/branches/foia-cprs/CPRS-Chart/uSignItems.pas@ 1591

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

Uploading 1.0.26.76, OR_30_277
File size: 32.4 KB
RevLine 
[463]1unit uSignItems;
[459]2
3{.$define debug}
4
5interface
6
7uses
8 SysUtils, Windows, Classes, Graphics, Controls, StdCtrls, CheckLst, ORClasses, ORCtrls,
9 Dialogs, UBAConst, fODBase, UBACore, Forms;
10
11type
12 TSigItemType = (siServiceConnected, siAgentOrange, siIonizingRadiation,
13 siEnvironmentalContaminants, siMST, siHeadNeckCancer, siCombatVeteran);
14
[460]15 TSigItemTagInfo = record
[459]16 SigType: TSigItemType;
17 Index: integer;
18 end;
19
20 TSigItems = class(TComponent)
21 private
22 FBuilding: boolean;
23 FStsCount: integer;
24 FItems: TORStringList;
25 FOldDrawItemEvent: TDrawItemEvent;
26 Fcb: TList;
27 Flb: TCustomListBox;
28 FLastValidX: integer;
29 FValidGap: integer;
30 FDy: integer;
31 FAllCheck: array[TSigItemType] of boolean;
32 FAllCatCheck: boolean;
33 FcbX: array[TSigItemType] of integer;
34 function TagInfo(ASigType: TSigItemType; AIndex: integer): TSigItemTagInfo;
35 //function ItemToTag(Info: TSigItemTagInfo): integer;
36 //function TagToItem(ATag: integer): TSigItemTagInfo;
37 procedure cbClicked(Sender: TObject);
38 procedure cbEnter(Sender: TObject);
39 procedure cbExit(Sender: TObject);
40 procedure lbDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
41 procedure CopyCBValues(FromIndex, ToIndex: integer);
42 function FindCBValues(ATag: integer): TORCheckBox;
43 function GetTempCkBxState(Index: integer; CBValue:TSigItemType): string;
[460]44
[459]45 protected
46 procedure Notification(AComponent: TComponent; Operation: TOperation); override;
47 public
48 constructor Create(AOwner: TComponent); override;
49 destructor Destroy; override;
50 procedure Add(ItemType: Integer; const ID: string; Index: integer);
51 procedure Remove(ItemType: integer; const ID: string);
52 procedure ResetOrders;
53 procedure Clear;
54 function UpdateListBox(lb: TCustomListBox): boolean;
55 procedure EnableSettings(Index: integer; Checked: boolean);
56 function OK2SaveSettings: boolean;
57 procedure SaveSettings;
58 procedure DisplayPlTreatmentFactors;
59 procedure DisplayUnsignedStsFlags(sFlags:string);
60 function GetSigItems : TORStringList; //BAPHII 1.3.1
61 function FindCB(ATag: integer): TORCheckBox; //BAPHII 1.3.1
62 procedure CopyCB(FromIndex, ToIndex: integer); //BAPHII 1.3.1
63 procedure SetSigItems(Sender: TObject; sourceOrderID: string); //BAPHII 1.3.1
[460]64 //procedure SetSigItems(Sender: TObject; itemsList: TStringList; sourceOrderID: string); //BAPHII 1.3.1
[459]65 function ItemToTag(Info: TSigItemTagInfo): integer; //CQ5074
66 function TagToItem(ATag: integer): TSigItemTagInfo; //CQ5074
67 end;
68
69function SigItems: TSigItems;
70function SigItemHeight: integer;
71
72const
73
[460]74 TC_Order_Error = 'All Service Connection and/or Rated Disabilities questions must be answered.';
[459]75
[460]76
[459]77 TX_Order_Error = 'All Service Connection and/or Rated Disabilities questions must be answered, '+#13+
78 'and at least one diagnosis selected for each order that requires a diagnosis.';
79
80 TC_Diagnosis_Error = ' Missing Diagnosis';
81 TX_Diagnosis_Error = ' One or more Orders have not been assigned a Diagnosis';
82 INIT_STR = '';
83
84
85var
86 uSigItems: TSigItems = nil; //BAPHII 1.3.1
87
88implementation
89
90uses
91 ORFn, ORNet, uConst, TRPCB, rOrders, rPCE, fOrdersSign, fReview,UBAGlobals,
92 uCore ;
93
94type
95 ItemStatus = (isNA, isChecked, isUnchecked, isUnknown);
96 SigDescType = (sdShort, sdLong);
97
98const
99 SigItemDesc: array[TSigItemType, SigDescType] of string =
100 { siServiceConnected } (('SC', 'Service Connected Condition'),
101 { siAgentOrange } ('AO', 'Agent Orange Exposure'),
102 { siIonizingRadiation } ('IR', 'Ionizing Radiation Exposure'),
103 { siEnvironmentalContaminants } ('EC', 'Environmental Contaminants'),
104 { siMST } ('MST', 'MST'), //'Military Sexual Trauma'
105 { siHeadNeckCancer } ('HNC', 'Head and/or Neck Cancer'),
106 { siCombatVeteran } ('CV', 'Combat Veteran Related'));
107
108 SigItemDisplayOrder: array[TSigItemType] of TSigItemType =
109 ( siServiceConnected,
110 siCombatVeteran,
111 siAgentOrange,
112 siIonizingRadiation,
113 siEnvironmentalContaminants,
114 siMST,
115 siHeadNeckCancer );
116
117 StsChar: array[ItemStatus] of char =
118 { isNA } ('N',
119 { isChecked } 'C',
120 { isUnchecked } 'U',
121 { isUnknown } '?');
122
123 ColIdx = 30000;
124 AllIdx = 31000;
125 NA_FLAGS = 'NNNNNNN';
126
127var
128 uSingletonFlag: boolean = FALSE;
129 FlagCount: integer;
130 BaseFlags: string;
131 tempCkBx: TORCheckBox;
[460]132 thisOrderID: string;
[459]133 thisChangeItem: TChangeItem;
134
135
136function TSigItems.GetSigItems : TORStringList;
137begin
138 Result := FItems;
139end;
140
141function TSigItems.FindCB(ATag: integer): TORCheckBox;
142var
143 i: integer;
144 wc: TWinControl;
145begin
146 for i := 0 to Fcb.Count-1 do
147 begin
148 wc := TWinControl(Fcb[i]);
149 if(wc is TORCheckBox) and (wc.Tag = ATag) then
150 begin
151 Result := TORCheckBox(wc);
152 exit;
153 end;
154 end;
155 Result := nil;
156end;
157
158procedure TSigItems.CopyCB(FromIndex, ToIndex: integer);
159var
160 si: TSigItemType;
161 FromTag, ToTag: integer;
162 FromCB, ToCB: TORCheckBox;
163
164begin
165 for si := low(TSigItemType) to high(TSigItemType) do
166 begin
167 FromTag := ItemToTag(TagInfo(si, FromIndex));
168 ToTag := ItemToTag(TagInfo(si, ToIndex));
169 FromCB := FindCB(FromTag);
170 ToCB := FindCB(ToTag);
171 if(Assigned(FromCB) and Assigned(ToCB)) then
172 ToCB.State := FromCB.State;
173 end;
174end;
175
176procedure TSigItems.SetSigItems(Sender: TObject; sourceOrderID: string);
177{
178 BAPHII 1.3.1
179}
180var
181 i: integer;
182begin
183 if (Sender as TCaptionCheckListBox).Name = 'clstOrders' then
184 for i := 0 to frmSignOrders.clstOrders.Count - 1 do
185 begin
186 if ((fOrdersSign.frmSignOrders.clstOrders.Selected[i]) and (fOrdersSign.targetOrderID <> fOrdersSign.srcOrderID)) then
187 CopyCB(fOrdersSign.srcIndex, i);
188 end
189 else
190 if (Sender as TCaptionCheckListBox).Name = 'lstReview' then
191 for i := 1 to frmReview.lstReview.Count -1 do
192 begin
193 if ((fReview.frmReview.lstReview.Selected[i]) and (fReview.targetOrderID <> fReview.srcOrderID)) then
194 CopyCB(fReview.srcIndex, i);
195 end;
196end;
197
198function SigItems: TSigItems;
199begin
200 if not assigned(uSigItems) then
201 begin
202 uSingletonFlag := TRUE;
203 try
204 uSigItems := TSigItems.Create(nil);
205 finally
206 uSingletonFlag := FALSE;
207 end;
208 end;
209 Result := uSigItems;
210end;
211
212function SigItemHeight: integer;
213begin
214 Result := MainFontHeight + 2;
215end;
216
217{ TSigItems }
218{
219FItems Layout:
2201 2 3 4 5
221OrderID ^ ListBox Index ^ RPC Call was Made (0 or 1) ^ Settings by char pos ^ Disabled Flag
222}
223
224procedure TSigItems.Add(ItemType: Integer; const ID: string; Index: integer);
225var
226 idx: integer;
227begin
228 if ItemType = CH_ORD then
229 begin
230 idx := FItems.IndexOfPiece(ID);
231 if idx < 0 then
232 idx := FItems.Add(ID);
233 FItems.SetStrPiece(idx, 2, IntToStr(Index));
234 FItems.SetStrPiece(idx,5,INIT_STR); // hds4807 value was being reatained when same order selected in FReview.
235
236 end;
237end;
238
239procedure TSigItems.Clear;
240begin
241 FItems.Clear;
242 Fcb.Clear;
243end;
244
245constructor TSigItems.Create(AOwner: TComponent);
246begin
247 if not uSingletonFlag then
248 raise Exception.Create('Only one instance of TSigItems allowed');
249 inherited Create(AOwner);
250 FItems := TORStringList.Create;
251 Fcb := TList.Create;
252 tempCkBx := TORCheckBox.Create(Owner);
253
254end;
255
256destructor TSigItems.Destroy;
257begin
258 FreeAndNil(FItems);
259 FreeAndNil(Fcb);
260 inherited;
261end;
262
263procedure TSigItems.Remove(ItemType: integer; const ID: string);
264var
265 idx: integer;
266
267begin
268 if ItemType = CH_ORD then
269 begin
270 idx := FItems.IndexOfPiece(ID);
271 if idx >= 0 then
272 FItems.Delete(idx);
273 end;
274end;
275
276procedure TSigItems.ResetOrders; // Resets ListBox positions, to avoid old data messing things up
277var
278 i: integer;
279
280begin
281 for i := 0 to FItems.Count-1 do
282 FItems.SetStrPiece(i, 2, '-1');
283end;
284
285function TSigItems.ItemToTag(Info: TSigItemTagInfo): integer;
286begin
287 if Info.Index < 0 then
288 Result := 0
289 else
290 Result := (Info.Index*FlagCount) + ord(Info.SigType) + 1;
291end;
292
293
294function TSigItems.TagInfo(ASigType: TSigItemType; AIndex: integer): TSigItemTagInfo;
295begin
296 Result.SigType := ASigType;
297 Result.Index := AIndex;
298end;
299
300function TSigItems.TagToItem(ATag: integer): TSigItemTagInfo;
301begin
302 if ATag <= 0 then
303 begin
304 Result.Index := -1;
305 Result.SigType := TSigItemType(0);
306 end
307 else
308 begin
309 dec(ATag);
310 Result.SigType := TSigItemType(ATag mod FlagCount);
311 Result.Index := ATag div FlagCount;
312 end;
313end;
314
315type
316 TExposedListBox = class(TCustomListBox)
317 public
318 property OnDrawItem;
319 end;
320
321function TSigItems.UpdateListBox(lb: TCustomListBox): boolean;
322const
323 cbWidth = 13;
324 cbHeight = 13;
325 btnGap = 2;
326 AllTxt = 'All';
327
328var
329 cb: TORCheckBox;
330 btn: TButton;
331 lbl: TLabel;
332 prnt: TWinControl;
333 ownr: TComponent;
334 FirstValidItem: TSigItemType;
335 x, y, MaxX, i, btnW, btnH, j, dx, ht, idx, dgrp: integer;
336 s, id, Code, cType, Flags: string;
337 StsCode: char;
338 sx, si: TSigItemType;
339 sts, StsIdx: ItemStatus;
340 StsUsed: array[TSigItemType] of boolean;
341 AResponses : TResponses;
342 UFlags: string;
343 thisCB: TORCheckBox;
344 cpFlags: string;
345
346
347 itemText: string;
348 thisTagInfo: TSigItemTagInfo;
349
350 function CreateCB(AParent: TWinControl): TORCheckBox;
351 begin
352 Result := TORCheckBox.Create(ownr);
353 Result.Parent := AParent;
354 Result.Height := cbHeight;
355 Result.Width := cbWidth;
356 Result.GrayedStyle := gsBlueQuestionMark;
357 Result.GrayedToChecked := FALSE;
358 Result.OnClick := cbClicked;
359 Result.OnEnter := cbEnter;
360 Result.OnExit := cbExit;
361 Fcb.Add(Result);
362 end;
363
364begin
365 Result := FALSE;
366 Fcb.Clear;
367 FBuilding := TRUE;
368try
369
370 try
371 idx := 0;
372 RPCBrokerV.ClearParameters := True;
373
374 for i := 0 to FItems.Count-1 do
375 begin
376 s := FItems[i];
377 thisOrderID := Piece(s,U,1);
378 if BILLING_AWARE then
379 if NOT UBACore.IsOrderBillable(thisOrderID) then
380 RemoveOrderFromDxList(thisOrderID);
381 if (piece(s, U, 2) <> '-1') and (piece(s, U, 3) <> '1') then
382 begin
383 with RPCBrokerV do
384 begin
385 if idx = 0 then
386 Param[1].PType := list;
387 inc(idx);
388 Param[1].Mult[IntToStr(idx)] := piece(s, U, 1);
389 end;
390 end;
391 end; //for
392
393 if idx > 0 then
394 begin
[460]395 if BILLING_AWARE then
396 rpcGetSC4Orders // get SC/EIC information for all CIDC TYPE orders
[459]397 else
[460]398 GetCoPay4Orders; // enforces existing NON CIDC CO-PAY rules
399 for i := 0 to RPCBrokerV.Results.Count-1 do
[459]400 begin
401 s := RPCBrokerV.Results[i];
402 {Begin BillingAware}
403 if BILLING_AWARE then
404 begin
405 if (CharAt(piece(s,';',2),1) <> '1') then
406 s := piece(s,U,1);
407 end;
408 id := piece(s,U,1);
409 idx := FItems.IndexOfPiece(id);
410
411 if idx >= 0 then
412 begin
413 FItems.SetStrPiece(idx, 3, '1'); // Mark as read from RPC
414 j := 2;
415 Flags := BaseFlags;
416
417 repeat
418 Code := piece(s,U,j);
419
420 if Code <> '' then
421 begin
422 cType := piece(Code, ';', 1);
423
424 for si := low(TSigItemType) to high(TSigItemType) do
425 begin
426 if cType = SigItemDesc[si, sdShort] then
427 begin
428 cType := piece(Code, ';', 2);
429
430 if cType = '0' then
431 sts := isUnchecked
432 else
433 if cType = '1' then
434 sts := isChecked
435 else
436 sts := isUnknown;
437
438 Flags[ord(si)+1] := StsChar[sts];
439 break;
440
441 end; //if cType = SigItemDesc[si, sdShort]
442 end; //for
443 end; //if Code <> ''
444
445 inc(j);
446 until(Code = '');
447
448 FItems.SetStrPiece(idx, 4, Flags);
[460]449 // new code if deleted order and ba on then
[459]450 // reset appropriate tf flags to "?".
451
452
453 if BILLING_AWARE then
454 begin
455 if not UBACore.OrderRequiresSCEI(Piece(s,U,1)) then
456 FItems.SetStrPiece(idx,4, NA_FLAGS)
457 else
458 begin
459
460 if UBAGlobals.BAUnsignedOrders.Count > 0 then
461 begin
462 UFlags := UBACore.GetUnsignedOrderFlags(Piece(s,U,1),UBAGlobals.BAUnsignedOrders);
463 if UFlags <> '' then FItems.SetStrPiece(idx,4, UFlags)
464 end;
465 //********************************
466 if UBAGlobals.BACopiedOrderFlags.Count > 0 then //BAPHII 1.3.2
467 begin
468 UFlags := UBACore.GetUnsignedOrderFlags(Piece(s,U,1),UBAGlobals.BACopiedOrderFlags); //BAPHII 1.3.2
469 if UFlags <> '' then //BAPHII 1.3.2
470 FItems.SetStrPiece(idx,4,UFlags); //BAPHII 1.3.2
471 end;
472 //********************************
473 if UBAGlobals.BAConsultPLFlags.Count > 0 then
474 begin
475 UFlags := GetConsultFlags(Piece(s,U,1),UBAGlobals.BAConsultPLFlags,Flags);
476
477 if UFlags <> '' then
478 FItems.SetStrPiece(idx,4, UFlags);
479 end;
480
481 UBAGlobals.BAFlagsIN := Flags;
482 end; //else
483 end; //if BILLING_AWARE
484
485 end; //if idx >= 0
486
487 end; //for i := 0 to RPCBrokerV.Results.Count-1
488 end; //if idx > 0
489
490 FStsCount := 0;
491
492 for si := low(TSigItemType) to high(TSigItemType) do
493 StsUsed[si] := FALSE;
[460]494 // loop thru orders selected to be signed fReview/fOrdersSign.
[459]495 for i := 0 to FItems.Count-1 do
496 begin
497 s := FItems[i];
498
499 if (piece(s,u,2) <> '-1') and (piece(s,u,3) = '1') then
500 begin
[460]501 s := piece(s, u, 4); // SC/EI
502 // code added 01/17/2006 - check dc'd nurse orders, originals where requiring CIDC if assigned to patient.
503 if (BILLING_AWARE) and (not UBACore.IsOrderBillable(Piece(s,U,1))) then
504 s := NA_FLAGS;
[459]505
506 for si := low(TSigItemType) to high(TSigItemType) do
507 if (not StsUsed[si]) and (s[ord(si)+1] <> StsChar[isNA]) then
508 begin
509 StsUsed[si] := TRUE;
510 inc(FStsCount);
511 if FStsCount >= FlagCount then break;
512 end;
513 end;
514
515 if FStsCount >= FlagCount then
516 Break;
517 end; //for
518
519 {Begin BillingAware}
520 if BILLING_AWARE then
521 begin
522 if FStsCount = 0 then // Billing Awareness. Force Grid to paint correctly
523 FStsCount := 1;
524 end;
525 {End BillingAware}
526
527 if FStsCount > 0 then
528 begin
529 Result := TRUE;
530 FirstValidItem := TSigItemType(0);
531
532 prnt := lb.Parent;
533 ownr := lb.Owner;
534 MaxX := lb.ClientWidth;
535 lb.Canvas.Font := MainFont;
536 btnW := 0;
537
538 for si := low(TSigItemType) to high(TSigItemType) do
539 begin
540 j := lb.Canvas.TextWidth(SigItemDesc[si, sdShort]);
541 if btnW < j then
542 btnW := j;
543 end;
544
545 inc(btnW, 8);
546 btnH := ResizeHeight( BaseFont, MainFont, 21);
547 x := MaxX;
548 dx := (btnW - cbWidth) div 2;
549
550 for si := high(TSigItemType) downto low(TSigItemType) do
551 begin
552 FcbX[si] := x - btnW + dx;
553 dec(x, btnW + btnGap);
554 end;
555
556 if FStsCount > 1 then
557 begin
558 FAllCatCheck := FALSE;
559 btn := TButton.Create(ownr);
560 btn.Parent := prnt;
561 btn.Height := btnH;
562 btn.Width := btnW;
563 btn.Caption := AllTxt;
564 btn.OnClick := cbClicked;
565 btn.Left := FcbX[TSigItemType(0)] + lb.Left - dx + 2 - (FcbX[TSigItemType(1)] - FcbX[TSigItemType(0)]);
566 btn.Top := lb.Top - btn.height - 2;
567 btn.Tag := AllIdx;
568 btn.ShowHint := TRUE;
569 btn.Hint := 'Set All Related Entries';
570 btn.TabOrder := lb.TabOrder;
571 Fcb.Add(btn);
572 end;
573
574 for sx := low(TSigItemType) to high(TSigItemType) do
575 begin
576 si := SigItemDisplayOrder[sx];
577 FAllCheck[si] := TRUE;
578 btn := TButton.Create(ownr);
579 btn.Parent := prnt;
580 btn.Height := btnH;
581 btn.Width := btnW;
582 btn.Caption := SigItemDesc[si, sdShort];
583 btn.OnClick := cbClicked;
584 btn.Left := FcbX[sx] + lb.Left - dx + 2;
585 btn.Top := lb.Top - btn.height - 2;
586 btn.Tag := ColIdx + ord(si);
587 btn.ShowHint := TRUE;
588 btn.Hint := 'Set all ' + SigItemDesc[si, sdLong];
589 btn.Enabled := StsUsed[si];
590 //tab order before listbox but after previous buttons.
591 btn.TabOrder := lb.TabOrder;
592 Fcb.Add(btn);
593 end;
594
595 FValidGap := ((FcbX[succ(TSigItemType(0))] - FcbX[TSigItemType(0)] - cbWidth) div 2) + 1;
596 FLastValidX := FcbX[FirstValidItem] - FValidGap;
597 lb.ControlStyle := lb.ControlStyle + [csAcceptsControls];
598
599 try
600 ht := SigItemHeight;
601 FDy := ((ht - cbHeight) div 2);
602 y := lb.TopIndex;
603 FOldDrawItemEvent := TExposedListBox(lb).OnDrawItem;
604 Flb := lb;
605 TExposedListBox(lb).OnDrawItem := lbDrawItem;
606 lb.FreeNotification(Self);
607
608 for i := 0 to FItems.Count-1 do
609 begin
610 s := FItems[i];
611
612 if piece(s,u,3) = '1' then
613 begin
614 idx := StrToIntDef(piece(s,U,2),-1);
615
616 if idx >= 0 then
617 begin
618 Flags := piece(s,u,4);
[460]619 //loop thru treatment factors
[459]620 for sx := low(TSigItemType) to high(TSigItemType) do
621 begin
622 si := SigItemDisplayOrder[sx];
623 StsCode := Flags[ord(si)+1];
624 StsIdx := isNA;
625
626 for sts := low(ItemStatus) to high(ItemStatus) do
627 if StsCode = StsChar[sts] then
628 begin
629 StsIdx := sts;
630 Break;
631 end;
632
633 if (StsIdx <> isNA) then
634 begin
635 cb := CreateCB(lb);
636 cb.Left := FcbX[sx];
637 cb.Top := (ht * (idx - y)) + FDy;
638 cb.Tag := ItemToTag(TagInfo(si, idx));
639 cb.ShowHint := TRUE;
640 cb.Hint := SigItemDesc[si, sdLong];
641
642 //CQ3301/3302
643 thisTagInfo := TagToItem(cb.Tag);
644 itemText := '';
645 thisChangeItem := nil; //init
646
647 thisChangeItem := TChangeItem(lb.Items.Objects[thisTagInfo.Index]);
648
649 if (thisChangeItem <> nil) then
650 begin
651 itemText := (FilteredString(lb.Items[thisTagInfo.Index]));
652 cb.Caption := itemText + cb.Hint; //CQ3301/3302 - gives JAWS a caption to read
653 end;
654 //end CQ3301/3302
655
[463]656 // GWOT - CV Default to Yes.
657 if ( (si = siCombatVeteran) and (StsIdx = isUnKnown) ) then
658 begin
659 StsIdx := isChecked;
660 Flags[7] := 'C'; // HD200866 default as Combat Related - GWOT mandated Change
661 FItems.SetStrPiece(i, 4, Flags); // HD200866 default as Combat Related - GWOT mandated Change
662 end;
[459]663
664 case StsIdx of
665 isChecked: cb.State := cbChecked;
666 isUnchecked: cb.State := cbUnchecked;
667 else cb.State := cbGrayed;
668 end; //case
669
670 end; //if (StsIdx <> isNA)
671
672 end; //for sx := low(TSigItemType) to high(TSigItemType)
673
674 end; // if idx >= 0
675
676 end; //if piece(s,u,3) = '1'
677
678 end; //for i := 0 to FItems.Count-1
679
680 finally
681 lb.ControlStyle := lb.ControlStyle - [csAcceptsControls];
682 end; //if FStsCount > 0
683 end;
684
685 finally
686 FBuilding := FALSE;
687 end;
688 except
689 on ERangeError do
690 begin
691 ShowMessage('ERangeError in UpdateListBox' + s);
692 raise;
693 end;
694 end;
695end;
696
697procedure TSigItems.cbClicked(Sender: TObject);
698var
699 i,cnt,p: integer;
700 cb: TORCheckBox;
701 sType: TSigItemType;
702 idx, Flags: string;
703 Info: TSigItemTagInfo;
704 wc, w: TWinControl;
705
706begin
707 if FBuilding then exit;
708 wc := TWinControl(Sender);
709 if wc.Tag = AllIdx then
710 begin
711 FAllCatCheck := not FAllCatCheck;
712 for sType := low(TSigItemType) to high(TSigItemType) do
713 FAllCheck[sType] := FAllCatCheck;
714 cnt := 0;
715 for i := 0 to Fcb.Count-1 do
716 begin
717 w := TWinControl(Fcb[i]);
718 if (w <> wc) and (w.Tag >= ColIdx) and (w is TButton) then
719 begin
720 inc(cnt);
721 if w.Enabled then
722 TButton(w).Click;
723 if cnt >= FlagCount then break;
724 end;
725 end;
726 end
727 else
728 if wc.Tag >= ColIdx then
729 begin
730 sType := TSigItemType(wc.Tag - ColIdx);
731 FAllCheck[sType] := not FAllCheck[sType];
732 for i := 0 to Fcb.Count-1 do
733 begin
734 w := TWinControl(Fcb[i]);
735 if (w.Tag < ColIdx) and (w is TORCheckBox) then
736 begin
737 if TagToItem(w.Tag).SigType = sType then
738 TORCheckBox(w).Checked := FAllCheck[sType];
739 end;
740 end;
741 end
742 else
743 begin
744 cb := TORCheckBox(wc);
745 info := TagToItem(cb.Tag);
746 if info.Index >= 0 then
747 begin
748 idx := inttostr(info.Index);
749 i := FItems.IndexOfPiece(idx,U,2);
750 if i >= 0 then
751 begin
752 p := ord(Info.SigType)+1;
753 Flags := piece(FItems[i],U,4);
754 case cb.State of
755 cbUnchecked: Flags[p] := StsChar[isUnchecked];
756 cbChecked: Flags[p] := StsChar[isChecked];
757 else Flags[p] := StsChar[isUnknown];
758 end;
759 FItems.SetStrPiece(i,4,Flags);
760 if BILLING_AWARE then
761 UBAGlobals.BAFlagsIN := Flags;
762 end;
763 end;
764 end;
765end;
766
767procedure TSigItems.cbEnter(Sender: TObject);
768var
769 cb: TORCheckBox;
770begin
771 cb := TORCheckBox(Sender);
772 cb.Color := clHighlight;
773 cb.Font.Color := clHighlightText;
774
775 // commented out causing check box states to be out of sync when
776 //checked individually and/or when by column or all.
777 //CQ5074
778 if ( (cb.Focused) and (cb.State = cbGrayed) ) and (not IsAMouseButtonDown) then
779 cb.Checked := false;
780 //end CQ5074
781end;
782
783procedure TSigItems.cbExit(Sender: TObject);
784var
785 cb: TORCheckBox;
786begin
787 cb := TORCheckBox(Sender);
788 cb.Color := clWindow;
789 cb.Font.Color := clWindowText;
790end;
791
792
793procedure TSigItems.lbDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
794var
795 OldRect: TRect;
796 i: integer;
797 cb: TORCheckBox;
798 si: TSigItemType;
799 DrawGrid: boolean;
800
801begin
802 DrawGrid := (Index < flb.Items.Count);
803 if DrawGrid and (trim(Flb.Items[Index]) = '') and
804 (Index = (flb.Items.Count - 1)) then
805 DrawGrid := FALSE;
806 if DrawGrid then
807 dec(Rect.Bottom);
808 OldRect := Rect;
809
810 Rect.Right := FlastValidX - 4;
811 {Begin BillingAware}
812 if BILLING_AWARE then Rect.Right := FLastValidX - 55;
813 {End BillingAware}
814
815 if assigned(FOldDrawItemEvent) then
816 FOldDrawItemEvent(Control, Index, Rect, State)
817 else
818 begin
819 Flb.Canvas.FillRect(Rect);
820 if Index < flb.Items.Count then
821 Flb.Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top, FilteredString(Flb.Items[Index]));
822 end;
823
824 if DrawGrid then
825 begin
826 Flb.Canvas.Pen.Color := clBtnFace;
827 Flb.Canvas.MoveTo(Rect.Left, Rect.Bottom);
828 Flb.Canvas.LineTo(OldRect.RIght, Rect.Bottom);
829 end;
830
831 if BILLING_AWARE then OldRect.Left := Rect.Right + 90
832 else OldRect.Left := Rect.Right;
833
834 //// SC Column
835 Flb.Canvas.FillRect(OldRect);
836 for i := 0 to Fcb.Count-1 do
837 begin
838 cb := TORCheckBox(Fcb[i]);
839
840 if TagToItem(cb.Tag).Index = Index then
841 begin
842 cb.Invalidate;
843 cb.Top := Rect.Top + FDy;
844 end;
845 end;
846
847 // EI Columns
848 if DrawGrid then
849 begin
850 for si := low(TSigItemType) to high(TSigItemType) do
851 begin
852 if FcbX[si] > FLastValidX then
853 begin
854 Flb.Canvas.MoveTo(FcbX[si] - FValidGap, Rect.Top);
855 Flb.Canvas.LineTo(FcbX[si] - FValidGap, Rect.Bottom);
856 end;
857 end;
858 end;
859
860end;
861
862procedure TSigItems.Notification(AComponent: TComponent;
863 Operation: TOperation);
864begin
865 inherited;
866 if (AComponent = Flb) and (Operation = opRemove) then
867 begin
868 Fcb.Clear;
869 TExposedListBox(Flb).OnDrawItem := FOldDrawItemEvent;
870 FOldDrawItemEvent := nil;
871 Flb := nil;
872 end;
873end;
874
875procedure TSigItems.EnableSettings(Index: integer; Checked: boolean);
876var
877 cb: TORCheckBox;
878 i: integer;
879 Info: TSigItemTagInfo;
880
881begin
882 if Index < 0 then exit;
883 for i := 0 to Fcb.Count-1 do
884 begin
885 if TObject(Fcb[i]) is TORCheckBox then
886 begin
887 cb := TORCheckBox(Fcb[i]);
888 info := TagToItem(cb.Tag);
889 if info.Index = Index then
890 cb.enabled := Checked;
891 end;
892 end;
893 i := FItems.IndexOfPiece(IntToStr(Index), U, 2);
894 if i >= 0 then
895 FItems.SetStrPiece(i, 5, BoolChar[not Checked]);
896end;
897
898function TSigItems.OK2SaveSettings: boolean;
899var
900 i, Index: integer;
901 s: string;
902
903begin
904 {Begin BillingAware}
905 if BILLING_AWARE then
906 begin
907 if Assigned(UBAGlobals.BAOrderList) then
908 BAOrderList.Clear
909 else
910 begin
911 BAOrderList := TStringList.Create;
912 BAOrderList.Clear;
913 end;
914{End BillingAware}
915 end;
916
917 Result := TRUE;
918 for i := 0 to FItems.Count-1 do
919 begin
920 s := FItems[i];
921 Index := StrToIntDef(piece(s,U,2),-1);
922 if(Index >= 0) and (piece(s,U,5) <> '1') then
923 begin
924 if pos(StsChar[isUnknown], piece(s, U, 4)) > 0 then
925 begin
926 Result := FALSE;
927 break;
928 end{end if}
929 else
930 if BILLING_AWARE then
931 BAOrderList.Add(piece(s,U,1)+ piece(s,U,3) + piece(s,U,4)); //baph1
932 end; {end if}
933 end;{end for}
934end;
935
936procedure TSigItems.SaveSettings;
937var
938 s: string;
939 i, Index: integer;
940 TmpSL: TStringList;
941
942begin
943 TmpSL := TStringList.Create;
944
945 try
946 for i := 0 to FItems.Count-1 do
947 begin
948 s := FItems[i];
949 Index := StrToIntDef(piece(s,U,2),-1);
950 if(Index >= 0) and (piece(s,U,5) <> '1') then
951 begin
952 TmpSL.Add(Piece(s,U,1) + U + piece(s,U,4));
953 FItems.SetStrPiece(i, 6, '1');
954 end;
955 end;
956
957 SaveCoPayStatus(TmpSL);
958
959 finally
960 TmpSL.Free;
961 end;
962 i := 0;
963 while i < FItems.Count do
964 begin
965 if Piece(FItems[i], U, 6) = '1' then
966 FItems.Delete(i)
967 else
968 inc(i);
969 end;
970 Fcb.Clear;
971end;
972
973{ Begin Billing Aware }
974
975procedure TSigItems.DisplayUnsignedStsFlags(sFlags:string);
976var
977 Index: integer;
978 flags : string;
979begin
980 Index := 0;
981 Flags := sFlags;
982 CopyCBValues(Index,Index);
983
984end;
985
986procedure TSigItems.DisplayPlTreatmentFactors;
987var
988 FactorsOut:TStringList;
989 y: integer;
990 Index: integer;
991begin
992 FactorsOut := TStringList.Create;
993 FactorsOut.Clear;
994 FactorsOut := UBAGlobals.PLFactorsIndexes;
995 for y := 0 to FactorsOut.Count-1 do
996 begin
997 Index := StrToInt(Piece(FactorsOut.Strings[y],U,1));
998 CopyCBValues(Index,Index);
999 end;
1000end;
1001
1002
1003
1004procedure TSigItems.CopyCBValues(FromIndex, ToIndex: integer);
1005var
1006 si: TSigItemType;
1007 FromTag, ToTag: integer;
1008 FromCB, ToCB: TORCheckBox;
1009 x: string;
1010begin
1011 tempCkBx.GrayedStyle := gsBlueQuestionMark;
1012
1013 for si := low(TSigItemType) to high(TSigItemType) do
1014 begin
1015 FromTag := ItemToTag(TagInfo(si, FromIndex));
1016 ToTag := ItemToTag(TagInfo(si, ToIndex));
1017 FromCB := FindCBValues(FromTag);
1018 ToCB := FindCBValues(ToTag);
1019
1020 if assigned(FromCB) then // and assigned(ToCB)) then
1021 begin
1022 tempCkBx.State := cbGrayed;
1023 x:= GetTempCkBxState(FromIndex,si);
1024 if x = 'C' then tempCkBx.State := cbChecked
1025 else if x = 'U' then tempCkBx.State := cbUnChecked ;
1026 ToCB.State := tempCkBx.State;// FromCB.State;
1027 end;
1028 end; //for
1029
1030end;
1031
1032function TSigItems.FindCBValues(ATag: integer):TORCheckBox;
1033var
1034 i: integer;
1035 wc: TWinControl;
1036begin
1037 for i := 0 to Fcb.Count-1 do
1038 begin
1039 wc := TWinControl(Fcb[i]);
1040 if(wc is TORCheckBox) and (wc.Tag = ATag) then
1041 begin
1042 Result := TORCheckBox(wc);
1043 Exit;
1044 end;
1045 end;
1046 Result := nil;
1047end;
1048
1049function TSigItems.GetTempCkBxState(Index: integer; CBValue:TSIGItemType):string;
1050var
1051 locateIdx,thisIdx,i: integer;
1052 iFactor: integer;
1053 TmpCBStatus : string;
1054begin
1055 try
1056 locateIdx := Index;
1057 iFactor := Ord(CBValue) +1;
1058 for i := 0 to UBAGlobals.BAFlagsOut.count-1 do
1059 begin
1060 thisIdx := StrToInt(Piece(UBAGlobals.BAFlagsOut.Strings[i],U,1));
1061 if thisIdx = locateIdx then
1062 begin
1063 TmpCBStatus := Piece(UBAGlobals.BAFlagsOut.Strings[i],U,2);
1064 TmpCBStatus := Copy(TmpCBStatus,iFactor,1);
1065 Result :=TmpCBStatus;
1066 end;
1067 end;
1068 except
1069 on EAccessViolation do
1070 begin
1071 {$ifdef debug}ShowMessage('EAccessViolation in uSignItems.GetTempCkBxState()');{$endif}
1072 raise;
1073 end;
1074 end;
1075end;
1076 { End Billing Aware }
1077
1078
1079initialization
1080 FlagCount := ord(high(TSigItemType)) - ord(low(TSigItemType)) + 1;
1081 BaseFlags := StringOfChar(StsChar[isNA], FlagCount);
1082 thisChangeItem := TChangeItem.Create; //CQ3301/3302
1083
1084finalization
1085 FreeAndNil(uSigItems);
1086
1087end.
1088
Note: See TracBrowser for help on using the repository browser.