source: cprs/trunk/CPRS-Chart/uSignItems.pas

Last change on this file was 830, checked in by Kevin Toppenberg, 14 years ago

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