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

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

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