Context Navigation

uSignItems.pas@ 1743

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

Rev	Line
[453]	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
[465]	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
[453]	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@ 1743

Download in other formats: