source: cprs/branches/tmg-cprs/CPRS-Chart/uSignItems.pas@ 454

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

Initial upload of TMG-CPRS 1.0.26.69

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