Context Navigation

uSignItems.pas@ 1784

Last change on this file since 1784 was 465, checked in by Kevin Toppenberg, 17 years ago
CPRS v1.0.26.76
File size: 38.0 KB

Line
1	//kt -- Modified with SourceScanner on 8/7/2007
2	unit uSignItems;
3
4	{.$define debug}
5
6	interface
7
8	uses
9	SysUtils, Windows, Classes, Graphics, Controls, StdCtrls, CheckLst, ORClasses, ORCtrls,
10	Dialogs, UBAConst, fODBase, UBACore, Forms;
11
12	type
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
70	function SigItems: TSigItems;
71	function SigItemHeight: integer;
72
73	const
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
83	function TC_Order_Error : string; //kt
84	function TX_Order_Error : string; //kt
85	function TC_Diagnosis_Error : string; //kt
86	function TX_Diagnosis_Error : string; //kt
87
88	var
89	uSigItems: TSigItems = nil; //BAPHII 1.3.1
90
91	implementation
92
93	uses
94	ORFn, ORNet, uConst, TRPCB, rOrders, rPCE, fOrdersSign, fReview,UBAGlobals,
95	DKLang, //kt
96	uCore ;
97
98	type
99	ItemStatus = (isNA, isChecked, isUnchecked, isUnknown);
100	SigDescType = (sdShort, sdLong);
101
102	const
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
133	var
134	uSingletonFlag: boolean = FALSE;
135	FlagCount: integer;
136	BaseFlags: string;
137	tempCkBx: TORCheckBox;
138	thisOrderID: string;
139	thisChangeItem: TChangeItem;
140
141
142	function SigItemDesc(SigItem: TSigItemType; SigDesc : SigDescType) : string; //kt
143	//kt added function to replace constant array
144	begin
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}
196	end;
197
198	function TC_Order_Error : string;
199	begin Result := DKLangConstW('uSignItems_All_Service_Connection_andxor_Rated_Disabilities_questions_must_be_answeredx');
200	end;
201
202	function TX_Order_Error : string;
203	begin 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');
205	end;
206
207	function TC_Diagnosis_Error : string;
208	begin Result := DKLangConstW('uSignItems_Missing_Diagnosis');
209	end;
210
211	function TX_Diagnosis_Error : string;
212	begin Result := DKLangConstW('uSignItems_One_or_more_Orders_have_not_been_assigned_a_Diagnosis');
213	end;
214
215
216	function TSigItems.GetSigItems : TORStringList;
217	begin
218	Result := FItems;
219	end;
220
221	function TSigItems.FindCB(ATag: integer): TORCheckBox;
222	var
223	i: integer;
224	wc: TWinControl;
225	begin
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;
236	end;
237
238	procedure TSigItems.CopyCB(FromIndex, ToIndex: integer);
239	var
240	si: TSigItemType;
241	FromTag, ToTag: integer;
242	FromCB, ToCB: TORCheckBox;
243
244	begin
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;
254	end;
255
256	procedure TSigItems.SetSigItems(Sender: TObject; sourceOrderID: string);
257	{
258	BAPHII 1.3.1
259	}
260	var
261	i: integer;
262	begin
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;
276	end;
277
278	function SigItems: TSigItems;
279	begin
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;
290	end;
291
292	function SigItemHeight: integer;
293	begin
294	Result := MainFontHeight + 2;
295	end;
296
297	{ TSigItems }
298	{
299	FItems Layout:
300	1 2 3 4 5
301	OrderID ^ ListBox Index ^ RPC Call was Made (0 or 1) ^ Settings by char pos ^ Disabled Flag
302	}
303
304	procedure TSigItems.Add(ItemType: Integer; const ID: string; Index: integer);
305	var
306	idx: integer;
307	begin
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;
317	end;
318
319	procedure TSigItems.Clear;
320	begin
321	FItems.Clear;
322	Fcb.Clear;
323	end;
324
325	constructor TSigItems.Create(AOwner: TComponent);
326	begin
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
335	end;
336
337	destructor TSigItems.Destroy;
338	begin
339	FreeAndNil(FItems);
340	FreeAndNil(Fcb);
341	inherited;
342	end;
343
344	procedure TSigItems.Remove(ItemType: integer; const ID: string);
345	var
346	idx: integer;
347
348	begin
349	if ItemType = CH_ORD then
350	begin
351	idx := FItems.IndexOfPiece(ID);
352	if idx >= 0 then
353	FItems.Delete(idx);
354	end;
355	end;
356
357	procedure TSigItems.ResetOrders; // Resets ListBox positions, to avoid old data messing things up
358	var
359	i: integer;
360
361	begin
362	for i := 0 to FItems.Count-1 do
363	FItems.SetStrPiece(i, 2, '-1');
364	end;
365
366	function TSigItems.ItemToTag(Info: TSigItemTagInfo): integer;
367	begin
368	if Info.Index < 0 then
369	Result := 0
370	else
371	Result := (Info.Index*FlagCount) + ord(Info.SigType) + 1;
372	end;
373
374
375	function TSigItems.TagInfo(ASigType: TSigItemType; AIndex: integer): TSigItemTagInfo;
376	begin
377	Result.SigType := ASigType;
378	Result.Index := AIndex;
379	end;
380
381	function TSigItems.TagToItem(ATag: integer): TSigItemTagInfo;
382	begin
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;
394	end;
395
396	type
397	TExposedListBox = class(TCustomListBox)
398	public
399	property OnDrawItem;
400	end;
401
402	function TSigItems.UpdateListBox(lb: TCustomListBox): boolean;
403	const
404	cbWidth = 13;
405	cbHeight = 13;
406	btnGap = 2;
407	//AllTxt = 'All'; <-- original line. //kt 8/7/2007
408
409	var
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
445	begin
446	AllTxt := DKLangConstW('uSignItems_All'); //kt added 8/7/2007
447	Result := FALSE;
448	Fcb.Clear;
449	FBuilding := TRUE;
450	try
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;
786	end;
787
788	procedure TSigItems.cbClicked(Sender: TObject);
789	var
790	i,cnt,p: integer;
791	cb: TORCheckBox;
792	sType: TSigItemType;
793	idx, Flags: string;
794	Info: TSigItemTagInfo;
795	wc, w: TWinControl;
796
797	begin
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;
856	end;
857
858	procedure TSigItems.cbEnter(Sender: TObject);
859	var
860	cb: TORCheckBox;
861	begin
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
872	end;
873
874	procedure TSigItems.cbExit(Sender: TObject);
875	var
876	cb: TORCheckBox;
877	begin
878	cb := TORCheckBox(Sender);
879	cb.Color := clWindow;
880	cb.Font.Color := clWindowText;
881	end;
882
883
884	procedure TSigItems.lbDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
885	var
886	OldRect: TRect;
887	i: integer;
888	cb: TORCheckBox;
889	si: TSigItemType;
890	DrawGrid: boolean;
891
892	begin
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
951	end;
952
953	procedure TSigItems.Notification(AComponent: TComponent;
954	Operation: TOperation);
955	begin
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;
964	end;
965
966	procedure TSigItems.EnableSettings(Index: integer; Checked: boolean);
967	var
968	cb: TORCheckBox;
969	i: integer;
970	Info: TSigItemTagInfo;
971
972	begin
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]);
987	end;
988
989	function TSigItems.OK2SaveSettings: boolean;
990	var
991	i, Index: integer;
992	s: string;
993
994	begin
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}
1025	end;
1026
1027	procedure TSigItems.SaveSettings;
1028	var
1029	s: string;
1030	i, Index: integer;
1031	TmpSL: TStringList;
1032
1033	begin
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;
1062	end;
1063
1064	{ Begin Billing Aware }
1065
1066	procedure TSigItems.DisplayUnsignedStsFlags(sFlags:string);
1067	var
1068	Index: integer;
1069	flags : string;
1070	begin
1071	Index := 0;
1072	Flags := sFlags;
1073	CopyCBValues(Index,Index);
1074
1075	end;
1076
1077	procedure TSigItems.DisplayPlTreatmentFactors;
1078	var
1079	FactorsOut:TStringList;
1080	y: integer;
1081	Index: integer;
1082	begin
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;
1091	end;
1092
1093
1094
1095	procedure TSigItems.CopyCBValues(FromIndex, ToIndex: integer);
1096	var
1097	si: TSigItemType;
1098	FromTag, ToTag: integer;
1099	FromCB, ToCB: TORCheckBox;
1100	x: string;
1101	begin
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
1121	end;
1122
1123	function TSigItems.FindCBValues(ATag: integer):TORCheckBox;
1124	var
1125	i: integer;
1126	wc: TWinControl;
1127	begin
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;
1138	end;
1139
1140	function TSigItems.GetTempCkBxState(Index: integer; CBValue:TSIGItemType):string;
1141	var
1142	locateIdx,thisIdx,i: integer;
1143	iFactor: integer;
1144	TmpCBStatus : string;
1145	begin
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;
1166	end;
1167	{ End Billing Aware }
1168
1169
1170	initialization
1171	FlagCount := ord(high(TSigItemType)) - ord(low(TSigItemType)) + 1;
1172	BaseFlags := StringOfChar(StsChar[isNA], FlagCount);
1173	thisChangeItem := TChangeItem.Create; //CQ3301/3302
1174
1175	finalization
1176	FreeAndNil(uSigItems);
1177
1178	end.
1179

Note: See TracBrowser for help on using the repository browser.

Context Navigation

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

Download in other formats: