I keep on getting that my sdate got no Value.
procedure TForm1.Button12Click(Sender: TObject);
var
sdate : string;
begin
sDate := inputbox('Date', 'Enter Date', '');
CDQuery.Active := False;
CDQuery.SQL.Text := 'Select Ownername, DateOfBirth from Owner_Table where DateOfBirth < Datevalue(sdate)';
CDQuery.Active := True;
end;
You did not concatenate sDate with your SQL statement. You just put it inside the string.
You need to do something like this:
sDate := inputbox('Date', 'Enter Date', '');
CDQuery.Active := False;
CDQuery.SQL.Text := 'Select Ownername, DateOfBirth from Owner_Table where DateOfBirth < DateValue(:sdate)';
CDQuery.Parameters.ParamByName('sdate').Value := sDate;
CDQuery.Active := True;
Related
For my procedure I wanted to put the identifier as a parameter, but I dont know what datatype to use that knows the .clear method or is usable on a TListBox. In this example I used string but that obviously doesn't work.
procedure Reset(input, output: string);
begin
input := '';
output.Clear;
"input" is my Edit.text, so I can just use string for that, but "output" is my ListBox.
my entire code is
unit UFunction;
interface
uses
System.Classes,System.StrUtils,System.AnsiStrings,System.SysUtils;
procedure CaseSensitiveSwitchFlip ;
procedure CopyToClipboard;
procedure Reset(Input: string; Output: string);
procedure Sort(input: string);
implementation
uses
UInterface, Vcl.Clipbrd;
procedure CaseSensitiveSwitchFlip ;
begin
IstCaseSensitiveActive := not IstCaseSensitiveActive
end;
procedure CopyToClipboard;
begin
ClipBoard.AsText := Form3.ListeLb.Items.Text;
end;
procedure Reset(input: string; output: string);
begin
input:='';
output:= '';
end;
procedure Sort(input: string);
var
ArrayIndex, inputIndex, Count: integer;
Character: array[1..256] of string;
text: string;
begin
if (input<>'') then begin
if (input<>'') and (Form3.ListeLb.Items.Count <> 0) then
Form3.ListeLb.Clear;
ArrayIndex:= 0;
repeat
if input<>'' then begin
ArrayIndex:= ArrayIndex +1;
if not IstCaseSensitiveActive then
input:= AnsiUpperCase(input);
Character[ArrayIndex]:= input[1];
Count:= 1;
inputIndex:= 0;
text:= (input);
delete(text, 1, 1);
input:= text;
if AnsiContainsStr(input, Character[ArrayIndex]) and (Character[ArrayIndex] <> ' ') then begin
repeat
inputIndex:= inputIndex +1;
if Character[ArrayIndex] = input[inputIndex] then begin
Count:= Count + 1;
text:= input;
delete(text, inputIndex, 1);
input:= text;
inputIndex:= inputIndex - 1;
end;
until not (AnsiContainsStr(input, Character[ArrayIndex])) or (Character[ArrayIndex] = ' ');
Form3.ListeLb.Items.Add(Character[ArrayIndex] + ': ' + IntToStr (Count))
end
else if (Character[ArrayIndex] <> ' ') then begin
Form3.ListeLb.Items.Add(Character[ArrayIndex] + ': ' + IntToStr (Count))
end;
end;
until (length(input) = 1) or (input = '');
if input <> '' then begin
ArrayIndex:= ArrayIndex + 1;
Character[ArrayIndex]:= input[1];
input := '';
if Character[ArrayIndex] <> ' ' then
Form3.ListeLb.Items.Add(Character[ArrayIndex] +': ' + IntToStr (1));
end;
end
end;
end.
You have to simply change types of paramter input to TEdit output to TListBox
procedure reset(input:TEdit; output:TListBox)
begin
input.Text:='';
output.items.clear;
end;
A lot of time passed when I saw pascal not object code without classes;
I have a FDStored procedure that has a datetime parameter:
create procedure [dbo].[p_gl_for_ap]
(#inMode char(1), --I=Invoice, C=Check
#inId_Invoice integer, --reqd for invoice or credit memo maintenance, I
#inReg char(3), --reqd for check update or void, C
#inCheckNo integer, --reqd for check update or void, C
#inIs_Reversal char, --Y only if Invoice Delete or Check Void
#inDt_Rev datetime, --reqd only for reversal
#inDt datetime, --optl G/L tran date; normally null
#inId_glsrcjrn varchar(10),
#inId_create integer,
#ret integer output)
AS
declare....
and I have a FDStoredProc component using the stored procedure:
(following is from component to code)
var
spGLForAP: TFDStoredProc;
spGLForAP := TFDStoredProc.Create(Self);
spGLForAP.Name := 'spGLForAP';
spGLForAP.Connection := dmConnect.cnxData;
with spGLForAP.FormatOptions.MapRules.Add do begin
SourceDataType := dtDateTime;
TargetDataType := dtDateTimeStamp;
end;
spGLForAP.StoredProcName := 'p_gl_for_ap';
with spGLForAP.ParamData.Add do begin
Position := 1;
Name := 'RESULT';
DataType := ftInteger;
ParamType := ptResult;
end;
with spGLForAP.ParamData.Add do begin
Position := 2;
Name := 'inMode';
DataType := ftFixedChar;
ParamType := ptInput;
Size := 1;
end;
with spGLForAP.ParamData.Add do begin
Position := 3;
Name := 'inId_Invoice';
DataType := ftInteger;
ParamType := ptInput;
end;
with spGLForAP.ParamData.Add do begin
Position := 4;
Name := 'inReg';
DataType := ftFixedChar;
ParamType := ptInput;
Size := 3;
end;
with spGLForAP.ParamData.Add do begin
Position := 5;
Name := 'inCheckNo';
DataType := ftInteger;
ParamType := ptInput;
end;
with spGLForAP.ParamData.Add do begin
Position := 6;
Name := 'inIs_Reversal';
DataType := ftFixedChar;
ParamType := ptInput;
Size := 1;
end;
with spGLForAP.ParamData.Add do begin
Position := 7;
Name := 'inDt_Rev';
DataType := ftDateTime;
FDDataType := dtDateTimeStamp;
NumericScale := 3;
ParamType := ptInput;
end;
with spGLForAP.ParamData.Add do begin
Position := 8;
Name := 'inDt';
DataType := ftDateTime;
FDDataType := dtDateTimeStamp;
NumericScale := 3;
ParamType := ptInput;
end;
with spGLForAP.ParamData.Add do begin
Position := 9;
Name := 'inId_glsrcjrn';
DataType := ftString;
ParamType := ptInput;
Size := 10;
end;
with spGLForAP.ParamData.Add do begin
Position := 10;
Name := 'inId_create';
DataType := ftInteger;
ParamType := ptInput;
end;
with spGLForAP.ParamData.Add do begin
Position := 11;
Name := 'ret';
DataType := ftInteger;
ParamType := ptInputOutput;
end;
I am initializing with this code:
function tdmAP.DoGLForAP(whichInvoice: integer; hasDelete: Boolean):
integer;
begin
spGLForAP.Params.ClearValues;
spGLForAP.ParamByName('inMode').AsString := 'I';
spGLForAP.ParamByName('inId_Invoice').AsInteger := whichInvoice;
spGLForAP.ParamByName('inReg').AsString := '';
spGLForAP.ParamByName('inCheckNo').AsInteger := 0;
if hasDelete then
begin
spGLForAP.ParamByName('inIs_Reversal').AsString := 'Y';
spGLForAP.ParamByName('indt_Rev').value := Date;
end
else
begin
spGLForAP.ParamByName('inIs_Reversal').AsString := 'N';
spGLForAP.ParamByName('indt_Rev').AsDateTime := Date;
end;
spGLForAP.ParamByName('indt').AsDateTime := Date;
spGLForAP.ParamByName('inId_glsrcjrn').AsString := '';
spGLForAP.ParamByName('inId_create').AsInteger := LoginRec.LoginUserId;;
try
spGLForAP.Prepare;
spGLForAP.Execute;
Result := spGLForAP.ParamByName('ret').AsInteger;
except
on E:Exception do
begin
ShowMessage('Error executing stored procedure p_gl_for_ap: ' + e.Message);
result := -1;
end;
end;
end;
but I keep getting error back from firedac complaining about the parameter type changing:
error on execute
I have tried using the datatype mapping.
I have tried using this code:
spGLForAP.ParamByName('indt_Rev').value = 0;
and
spGLForAP.ParamByName('indt_Rev').AsDateTime := Date;
and
spGLForAP.ParamByName('indt_Rev').AsDateTime := now;
I have also tried changing the datatypes on the two date parameters from ftTimeStamp to ftDateTime, repreparing the query after setting the parameters types, and just about anything else I can think of. obviously, I'm missing something...
using Delphi 10.2.2 Tokyo, against mssql server 2008R2.
note: in this particular case, I'm trying to set the inDt_rev and inDt to 0. but can't seem to successfully set them to any value.
Try to change this part of your code:
with spGLForAP.ParamData.Add do begin
Position := 7;
Name := 'inDt_Rev';
DataType := ftDateTime;
FDDataType := dtDateTimeStamp;
NumericScale := 3;
ParamType := ptInput;
end;
with spGLForAP.ParamData.Add do begin
Position := 8;
Name := 'inDt';
DataType := ftDateTime;
FDDataType := dtDateTimeStamp;
NumericScale := 3;
ParamType := ptInput;
end;
to this one:
with spGLForAP.Params.Add do begin
Name := '#inDt_Rev';
DataType := ftTimeStamp;
ParamType := ptInput;
end;
with spGLForAP.Params.Add do begin
Name := '#inDt';
DataType := ftTimeStamp;
ParamType := ptInput;
end;
and use Value property instead of .AsDateTime accessor like:
spGLForAP.Params.ParamByName('#inDt').Value := Now;
or use AsSQLTimeStamp accessor:
// uses Data.SqlTimSt;
spGLForAP.Params.ParamByName('#inDt').AsSQLTimeStamp := DateTimeToSQLTimeStamp(Now);
because FireDAC maps such parameter as dtDateTimeStamp type (for which is the AsSQLTimeStamp accessor for).
You can create a custom data type mapping rule:
http://docwiki.embarcadero.com/RADStudio/XE5/en/Data_Type_Mapping_(FireDAC)
And map dtTimeStamp into dtDateTime.
// --------------------------- MAP RULES ------------------------- \\
with dm6.fdDB.FormatOptions do begin
OwnMapRules := True;
with MapRules.Add do begin
SourceDataType := dtDateTimeStamp;
TargetDataType := dtDateTime;
end;
end;
I want to set my own procedure to OnGetText event of fields in a dynamic query
My procedure is like this :
procedure TMainFrm.MyFieldGetText(Sender: TField; var Text: String;
DisplayText: Boolean);
begin
...
end;
"...Captions" are String array constants
I set the event handler in OnAfterOpen event of ADOQuery :
procedure TImportFrm.ADOQueryAfterOpen(DataSet: TDataSet);
var
I : Integer;
begin
for I := 0 to ADOQuery.FieldCount - 1 do
ADOQuery.Fields[I].OnGetText := MainFrm.MyFieldGetText;
end;
But after opening ADOQuery , there is no Text to display , it looks like the Text value is empty !
It seems it doesn't matter what my procedure do , because when I set an empty procedure ( with no code ) , no text displayed too
what goes wrong ?
thanks ...
Try this:
procedure TMainFrm.MyFieldGetText(Sender: TField; var Text: String;
DisplayText: Boolean);
begin
if Sender.FieldName = 'XX' then
begin
Text := .... String(Sender.Value);// ( or Text := Sender.AsString);
end;
if Sender.FieldName = 'YY' then
begin
Text := .... String(Sender.Value);// ( or Text := Sender.AsString);
end;
...
end;
Thanks all
The problem was that I should mention all situations of Text and should use Sender.value instead of Text in right side ! , I changed my procedure to this and problem solved :
procedure TMainFrm.MyFieldGetText(Sender: TField; var Text: String;
DisplayText: Boolean);
begin
if Sender.AsVariant = Null then
Exit;
Text := Sender.AsString;
if MatchStr(Sender.FieldName, BooleanFieldNames) then
Text := BooleanCaptions[Sender.AsInteger];
if Sender.FieldName = 'BNStatus' then
Text := BNStatusCaptions[Sender.AsInteger];
if MatchStr(Sender.FieldName, ['FStatus', 'LStatus', 'FirstStatus']) then
Text := FLStatusCaptions[Sender.AsInteger];
if Sender.FieldName = 'PayType' then
Text := PayTypeCaptions[Sender.AsInteger];
if Sender.FieldName = 'BGType' then
Text := BGTypeCaptions[Sender.AsInteger];
if Sender.FieldName = 'Updated' then
Text := UpdatedCaptions[Sender.AsInteger];
if Sender.FieldName = 'DieUser' then
Text := DieUserCaptions[Sender.AsInteger];
if Sender.FieldName = 'LiveUser' then
Text := LiveUserCaptions[Sender.AsInteger];
if Sender.FieldName = 'NVStatus' then
Text := NVStatusCaptions[Sender.AsInteger];
if Sender.FieldName = 'BSGender' then
Text := BSGenderCaptions[Sender.AsInteger];
if Sender.FieldName = 'BSMType' then
Text := BSMTypeCaptions[Sender.AsInteger];
end;
Thanks again ...
I'm creating a new app in XE3 but using some units created in D2007.
I"m getting an error when freeing a TStringList data item. Here's the code that creates the data item FSQL:
procedure TPayorDM.DataModuleCreate(Sender: TObject);
begin
FPayorDRM := TDRM.Create;
FSQL := TStringList.Create;
end;
Here's the code that is getting the error:
procedure TPayorDM.DataModuleDestroy(Sender: TObject);
begin
FreeAndNil(FSQL);
if T_Payor.Active then T_Payor.Close;
FreeAndNil(FPayorDRM);
end;
The error occurs on 'FreeAndNil(FSQL);'. I have tried 'FSQL.Free' and I get the same result.
Here's the error I'm getting:
Project: PayorUpdate.exe raised exception class EInvalidPointer with message 'Invalid pointer operation.
When I break blue arrows (debug mode) is pointing to _FreeMem(Pointer(Self)); in the procedure TObject.FreeInstance in System unit as follows:
procedure TObject.FreeInstance;
begin
CleanupInstance;
_FreeMem(Pointer(Self));
end;
If I don't free the TStringList data item I would have a memory leak in the app.
Is there possibly a configuration option I need to set? I've search with google and have not found anything that explains what I am doing wrong other than one of the three possibilities:
It was allocated by some other memory manager.
It had already been freed once before.
It had never been allocated by anything.
If I put a try ... except... I'm able to get around the issue, but I prefer not to do this.
BTW, I have another TStringList in different unit and I create and FreeAndNil and I do not get any error.
Here is entire source:
unit PayorDataMgr;
interface
uses
SysUtils,
Classes,
Dialogs,
NativeXML,
adscnnct,
DB,
adsdata,
adsfunc,
adstable,
ace,
cbs.drm,
cbs.utils,
cbs.LogFiles;
const
POLICY_TYPES: array[1..3] of string = ('Primary','Secondary','Tertiary');
type
TPayorRecord = Record
ASSIGNBENEFITS: Boolean;
AUTHORIZE: Boolean;
BATCHBILL: Boolean;
CLAIMMAX: Integer;
DISCONTINUED: TDateTime;
DISPENSEUPDATE: Boolean;
EHRSIGNOFF: Boolean;
EMCDEST: String;
FORM: String;
GOVASSIGN: Boolean;
HIDE: Boolean;
IGRPUNIQUE: Integer;
LEGACYPLAN: String;
LEGACYTYPE: String;
LOCALATTN: String;
LOCALCITY: String;
LOCALNAME: String;
LOCALPHONE: String;
LOCALSTATE: String;
LOCALSTREET: String;
LOCALZIP: String;
MASTERATTN: String;
MASTERCITY: String;
MASTERNAME: String;
MASTERPHONE: String;
MASTERSTATE: String;
MASTERSTREET: String;
MASTERZIP: String;
MEDIGAPCODE: String;
MEDIGAPPAYOR: Boolean;
MEDPLANGUID: String;
MODIFIED: TDateTime;
NEICCODE: String;
NEICTYPESTDC: Integer;
OWNER: String;
PAYORGUID: String;
PAYORSUBTYPESTDC: Integer;
PAYORTYPESTDC: Integer;
PAYORUNIQUE: Integer;
PAYPERCENT: Integer;
RTCODE: String;
SRXPLANGUID: String;
STATEFILTER: String;
procedure Clear;
End;
TPayors = Record
private
function _pGetCount: Integer;
public
Items: Array of TPayorRecord;
procedure Add(const aItem:TPayorRecord);
function CarriersList:TStrings;
procedure Free;
function GetPayorGuid(const aPAYORUNIQUE:Integer):String;
function IndexOfIgrpUnique(Const aIGRPUNIQUE:Integer):Integer;
function IndexOfPayorUnique(Const aPAYORUNIQUE:Integer):Integer;
procedure SortByName;
property Count:Integer Read _pGetCount;
End;
TPayorDM = class(TDataModule)
CommonConnection: TAdsConnection;
T_Payor: TAdsTable;
Q_Payor: TAdsQuery;
procedure DataModuleDestroy(Sender: TObject);
procedure DataModuleCreate(Sender: TObject);
private
FPayorDRM: TDRM;
FSQL: TStringList;
function _LoadRecordFromTable:TPayorRecord;
function _newIDSTRING(const aFormat:String='F'):String;
{ Private declarations }
procedure _pSetConnectionHandle(const Value: Integer);
procedure _pSetErrorMessage(const Value: String);
procedure _psetSQL(const Value: TStringList);
{ Private properties }
property ErrorMessage:String Write _pSetErrorMessage;
public
function AddPayor(var aPAYORRECORD:TPAYORRECORD):Boolean;
function ExecuteScript(const aTo,aFrom:string):Boolean;
function FindPayor(const aPAYORGUID:String):Boolean;overload;
function FindPayor(const aPAYORUNIQUE:Integer):Boolean;overload;
function GetPayorData:TDRM;
function GetRecordCount(const aData:String):Integer;
function LoadCarriers(const aHide:boolean = False):TPayors;
function LoadPayor:TPayorRecord;
function OpenTable:Boolean;
function UpdateFromXML(const aPayorNode:TXMLNode):boolean;
{ Public declarations }
property ConnectionHandle:Integer Write _pSetConnectionHandle;
property DynamicPayorFields:TDRM Read FPayorDRM;
property SQL:TStringList Read FSQL Write _psetSQL;
end;
var
PayorDM: TPayorDM;
implementation
{$R *.dfm}
function TPayorDM.AddPayor(var aPAYORRECORD: TPAYORRECORD): Boolean;
begin
Result := False;
if IsNull(aPAYORRECORD.LOCALNAME) then Exit;
{ Create uniques }
{ Add Record }
if not T_Payor.Active then
if not OpenTable then Exit;
with T_Payor do
try
Insert;
FieldByName('PAYORGUID').AsString := _newIDSTRING;
FieldByName('MASTERNAME').AsString := aPAYORRECORD.MASTERNAME;
FieldByName('MASTERSTREET').AsString := aPAYORRECORD.MASTERSTREET;
FieldByName('MASTERCITY').AsString := aPAYORRECORD.MASTERCITY;
FieldByName('MASTERSTATE').AsString := aPAYORRECORD.MASTERSTATE;
FieldByName('PAYORTYPESTDC').AsInteger := aPAYORRECORD.PAYORTYPESTDC;
FieldByName('MASTERZIP').AsString := aPAYORRECORD.MASTERZIP;
FieldByName('MASTERATTN').AsString := aPAYORRECORD.MASTERATTN;
FieldByName('MASTERPHONE').AsString := aPAYORRECORD.MASTERPHONE;
FieldByName('NEICCODE').AsString := aPAYORRECORD.NEICCODE;
FieldByName('RTCODE').AsString := aPAYORRECORD.RTCODE;
FieldByName('STATEFILTER').AsString := aPAYORRECORD.STATEFILTER;
FieldByName('NEICTYPESTDC').AsInteger := aPAYORRECORD.NEICTYPESTDC;
FieldByName('PAYORSUBTYPESTDC').AsInteger := aPAYORRECORD.PAYORSUBTYPESTDC;
FieldByName('OWNER').AsString := aPAYORRECORD.OWNER;
FieldByName('HIDE').AsBoolean := aPAYORRECORD.HIDE;
FieldByName('IGRPUNIQUE').AsInteger := aPAYORRECORD.IGRPUNIQUE;
FieldByName('FORM').AsString := aPAYORRECORD.FORM;
FieldByName('GOVASSIGN').AsBoolean := aPAYORRECORD.GOVASSIGN;
FieldByName('CLAIMMAX').AsInteger := aPAYORRECORD.CLAIMMAX;
FieldByName('MEDIGAPCODE').AsString := aPAYORRECORD.MEDIGAPCODE;
FieldByName('EMCDEST').AsString := aPAYORRECORD.EMCDEST;
FieldByName('ASSIGNBENEFITS').AsBoolean := aPAYORRECORD.ASSIGNBENEFITS;
FieldByName('BATCHBILL').AsBoolean := aPAYORRECORD.BATCHBILL;
FieldByName('MEDIGAPPAYOR').AsBoolean := aPAYORRECORD.MEDIGAPPAYOR;
FieldByName('MEDPLANGUID').AsString := aPAYORRECORD.MEDPLANGUID;
FieldByName('SRXPLANGUID').AsString := aPAYORRECORD.SRXPLANGUID;
FieldByName('PAYPERCENT').AsInteger := aPAYORRECORD.PAYPERCENT;
FieldByName('LOCALNAME').AsString := aPAYORRECORD.LOCALNAME;
FieldByName('LOCALSTREET').AsString := aPAYORRECORD.LOCALSTREET;
FieldByName('LOCALCITY').AsString := aPAYORRECORD.LOCALCITY;
FieldByName('LOCALSTATE').AsString := aPAYORRECORD.LOCALSTATE;
FieldByName('LOCALZIP').AsString := aPAYORRECORD.LOCALZIP;
FieldByName('LOCALATTN').AsString := aPAYORRECORD.LOCALATTN;
FieldByName('LOCALPHONE').AsString := aPAYORRECORD.LOCALPHONE;
FieldByName('EHRSIGNOFF').AsBoolean := aPAYORRECORD.EHRSIGNOFF;
FieldByName('DISCONTINUED').AsDateTime := aPAYORRECORD.DISCONTINUED;
FieldByName('MODIFIED').AsDateTime := Now;
FieldByName('LEGACYPLAN').AsString := aPAYORRECORD.LEGACYPLAN;
FieldByName('LEGACYTYPE').AsString := aPAYORRECORD.LEGACYTYPE;
FieldByName('AUTHORIZE').AsBoolean := aPAYORRECORD.AUTHORIZE;
FieldByName('DISPENSEUPDATE').AsBoolean := aPAYORRECORD.DISPENSEUPDATE;
Post;
aPAYORRECORD.PAYORUNIQUE := FieldByName('PAYORUNIQUE').AsInteger;
aPAYORRECORD.PAYORGUID := FieldByName('PAYORGUID').AsString;
Close;
Result := True;
except on E: EADSDatabaseError do
begin
ErrorMessage := 'AddPayor: ERRORCODE: ' + IntToStr(e.ACEErrorCode) +
' ERROR: ' + e.Message;
end;
end;
end;
procedure TPayorDM.DataModuleCreate(Sender: TObject);
begin
FPayorDRM := TDRM.Create;
FSQL := TStringList.Create; { FSQL Created }
end;
procedure TPayorDM.DataModuleDestroy(Sender: TObject);
begin
try
FSQL.Free; { FSQL destroyed - work around to get unit to run without error}
except
end;
if T_Payor.Active then T_Payor.Close;
FreeAndNil(FPayorDRM);
end;
function TPayorDM.ExecuteScript(const aTo, aFrom: string):Boolean;
begin
Result := False;
if FSQL.Count = 0 then exit;
with Q_Payor do
try
if Active then Close;
SQL := FSQL;
ParamByName('to').Text := aTo;
ParambyName('from').Text := aFrom;
ExecSQL;
if Active then Close;
Result := True;
except on E: EADSDatabaseError do
begin
ErrorMessage := 'ExecuteScript: ERRORCODE: ' + IntToStr(e.ACEErrorCode) +
' ERROR: ' + e.Message + ' SQL: ' + Q_Payor.SQL.Text;
end;
end;
end;
function TPayorDM.FindPayor(const aPAYORUNIQUE: Integer): Boolean;
begin
T_Payor.IndexName := 'PAYORUNIQUE';
Result := T_Payor.FindKey([aPAYORUNIQUE]);
end;
function TPayorDM.FindPayor(const aPAYORGUID: String): Boolean;
begin
T_Payor.IndexName := 'PAYORGUID';
Result := T_Payor.FindKey([aPAYORGUID]);
end;
function TPayorDM.GetPayorData: TDRM;
begin
if FPayorDRM.Count = 0 then
FPayorDRM.BuildDRMList(T_Payor);
Result := FPayorDRM;
end;
function TPayorDM.GetRecordCount(const aData:string): Integer;
begin
Result := 0;
if FSQL.Count = 0 then exit;
with Q_Payor do
try
if Active then Close;
SQL := FSQL;
ParamByName('data').AsString := aData;
Open;
Result := RecordCount;
Close;
except on E: EADSDatabaseError do
begin
ErrorMessage := 'GetRecordCount: ERRORCODE: ' + IntToStr(e.ACEErrorCode) +
' ERROR: ' + e.Message;
end;
end;
end;
function TPayorDM.LoadCarriers(const aHide: boolean): TPayors;
begin
OpenTable;
Result.Free;
with T_Payor do
begin
First;
while not EOF do
begin
if T_Payor.FieldByName('HIDE').AsBoolean = aHide then
Result.Add(_LoadRecordFromTable);
Next;
end;
First;
Result.SortByName;
end;
end;
function TPayorDM.LoadPayor: TPayorRecord;
begin
Result.Clear;
try
if not T_Payor.active then exit;
if T_Payor.RecNo = 0 then exit;
Result := _LoadRecordFromTable;
except on E: EADSDatabaseError do
begin
ErrorMessage := 'LoadPayor: ERRORCODE: ' + IntToStr(e.ACEErrorCode) +
' ERROR: ' + e.Message;
end;
end;
end;
function TPayorDM.OpenTable: Boolean;
begin
Result := False;
with T_Payor do
try
if not Active then Open;
FPayorDRM.BuildDRMList(T_Payor);
FPayorDRM.LoadValues(T_Payor); { test }
FPayorDRM.ExportDRMList; { test }
Result := True;
except on E: EADSDatabaseError do
begin
ErrorMessage := 'OpenTable: ERRORCODE: ' + IntToStr(e.ACEErrorCode) +
' ERROR: ' + e.Message;
end;
end;
end;
function TPayorDM.UpdateFromXML(const aPayorNode: TXMLNode): boolean;
var
fKeyData:TXMLNode;
Idx,fPAYORUNIQUE:Integer;
begin
Result := False;
if not Assigned(aPayorNode) then Exit;
try
if FPayorDRM.Count = 0 then
FPayorDRM.BuildDRMList(T_Payor);
FPayorDRM.ClearValues;
fKeyData := aPayorNode.FindNode('KeyData');
FPayorDRM.FindRecordFromKeyData(fKeyData,T_Payor);
fPAYORUNIQUE := FPayorDRM.FieldByName('PAYORUNIQUE').AsInteger;
FPayorDRM.LoadValues(aPayorNode);
if fPAYORUNIQUE = 0 then
begin
FPayorDRM.FieldByName('PAYORUNIQUE').AsInteger := 0;
FPayorDRM.FieldByName('PAYORGUID').AsString := _newIDSTRING;
FPayorDRM.FieldByName('MODIFIED').AsDate := Now;
FPayorDRM.AddRecord(T_Payor)
end
else
begin
FPayorDRM.FieldByName('MODIFIED').AsDate := Now;
FPayorDRM.UpdateRecord(T_Payor);
end;
except on e:exception do
begin
ErrorMessage := 'UpdateFromXML: ERROR: ' + e.Message;
end;
end;
end;
function TPayorDM._LoadRecordFromTable: TPayorRecord;
begin
with T_Payor do
begin
Result.PAYORUNIQUE := FieldByName('PAYORUNIQUE').AsInteger;
Result.PAYORGUID := FieldByName('PAYORGUID').AsString;
Result.MASTERNAME := FieldByName('MASTERNAME').AsString;
Result.MASTERSTREET := FieldByName('MASTERSTREET').AsString;
Result.MASTERCITY := FieldByName('MASTERCITY').AsString;
Result.MASTERSTATE := FieldByName('MASTERSTATE').AsString;
Result.PAYORTYPESTDC := FieldByName('PAYORTYPESTDC').AsInteger;
Result.MASTERZIP := FieldByName('MASTERZIP').AsString;
Result.MASTERATTN := FieldByName('MASTERATTN').AsString;
Result.MASTERPHONE := FieldByName('MASTERPHONE').AsString;
Result.NEICCODE := FieldByName('NEICCODE').AsString;
Result.RTCODE := FieldByName('RTCODE').AsString;
Result.STATEFILTER := FieldByName('STATEFILTER').AsString;
Result.NEICTYPESTDC := FieldByName('NEICTYPESTDC').AsInteger;
Result.PAYORSUBTYPESTDC := FieldByName('PAYORSUBTYPESTDC').AsInteger;
Result.OWNER := FieldByName('OWNER').AsString;
Result.HIDE := FieldByName('HIDE').AsBoolean;
Result.IGRPUNIQUE := FieldByName('IGRPUNIQUE').AsInteger;
Result.FORM := FieldByName('FORM').AsString;
Result.GOVASSIGN := FieldByName('GOVASSIGN').AsBoolean;
Result.CLAIMMAX := FieldByName('CLAIMMAX').AsInteger;
Result.MEDIGAPCODE := FieldByName('MEDIGAPCODE').AsString;
Result.EMCDEST := FieldByName('EMCDEST').AsString;
Result.ASSIGNBENEFITS := FieldByName('ASSIGNBENEFITS').AsBoolean;
Result.BATCHBILL := FieldByName('BATCHBILL').AsBoolean;
Result.MEDIGAPPAYOR := FieldByName('MEDIGAPPAYOR').AsBoolean;
Result.MEDPLANGUID := FieldByName('MEDPLANGUID').AsString;
Result.SRXPLANGUID := FieldByName('SRXPLANGUID').AsString;
Result.PAYPERCENT := FieldByName('PAYPERCENT').AsInteger;
Result.LOCALNAME := FieldByName('LOCALNAME').AsString;
Result.LOCALSTREET := FieldByName('LOCALSTREET').AsString;
Result.LOCALCITY := FieldByName('LOCALCITY').AsString;
Result.LOCALSTATE := FieldByName('LOCALSTATE').AsString;
Result.LOCALZIP := FieldByName('LOCALZIP').AsString;
Result.LOCALATTN := FieldByName('LOCALATTN').AsString;
Result.LOCALPHONE := FieldByName('LOCALPHONE').AsString;
Result.EHRSIGNOFF := FieldByName('EHRSIGNOFF').AsBoolean;
Result.DISCONTINUED := FieldByName('DISCONTINUED').AsDateTime;
Result.MODIFIED := FieldByName('MODIFIED').AsDateTime;
Result.LEGACYPLAN := FieldByName('LEGACYPLAN').AsString;
Result.LEGACYTYPE := FieldByName('LEGACYTYPE').AsString;
Result.AUTHORIZE := FieldByName('AUTHORIZE').AsBoolean;
Result.DISPENSEUPDATE := FieldByName('DISPENSEUPDATE').AsBoolean;
end;
end;
function TPayorDM._newIDSTRING(const aFormat: String): String;
begin
Result := '';
try
with Q_Payor do
try
SQL.Clear;
SQL.Add('SELECT NEWIDSTRING( "' + aFormat + '" ) AS GUID FROM system.iota');
Open;
Result := FieldByName('GUID').AsString;
Close;
except on E: EADSDatabaseError do
begin
ErrorMessage := '_newIDSTRING: ERRORCODE: ' + IntToStr(e.ACEErrorCode) +
' ERROR: ' + e.Message;
end;
end;
finally
end;
end;
procedure TPayorDM._pSetConnectionHandle(const Value: Integer);
begin
if T_Payor.Active then T_Payor.Close;
CommonConnection.SetHandle(Value);
OpenTable;
end;
procedure TPayorDM._pSetErrorMessage(const Value: String);
begin
WriteError('[TPayorDM]' + Value,LogFilename);
end;
procedure TPayorDM._psetSQL(const Value: TStringList);
begin
FSQL := Value;
end;
{ TPayorRecord }
procedure TPayorRecord.Clear;
begin
PAYORUNIQUE := 0;
PAYORGUID := '';
MASTERNAME := '';
MASTERSTREET := '';
MASTERCITY := '';
MASTERSTATE := '';
PAYORTYPESTDC := 0;
MASTERZIP := '';
MASTERATTN := '';
MASTERPHONE := '';
NEICCODE := '';
RTCODE := '';
STATEFILTER := '';
NEICTYPESTDC := 0;
PAYORSUBTYPESTDC := 0;
OWNER := '';
HIDE := False;
IGRPUNIQUE := 0;
FORM := '';
GOVASSIGN := False;
CLAIMMAX := 0;
MEDIGAPCODE := '';
EMCDEST := '';
ASSIGNBENEFITS := False;
BATCHBILL := False;
MEDIGAPPAYOR := False;
MEDPLANGUID := '';
SRXPLANGUID := '';
PAYPERCENT := 0;
LOCALNAME := '';
LOCALSTREET := '';
LOCALCITY := '';
LOCALSTATE := '';
LOCALZIP := '';
LOCALATTN := '';
LOCALPHONE := '';
EHRSIGNOFF := False;
DISCONTINUED := 0;
MODIFIED := 0;
LEGACYPLAN := '';
LEGACYTYPE := '';
AUTHORIZE := False;
DISPENSEUPDATE := False;
end;
{ TPayors }
procedure TPayors.Add(const aItem: TPayorRecord);
begin
SetLength(Items,Count + 1);
Items[Count - 1] := aItem;
end;
function TPayors.CarriersList: TStrings;
var
I: Integer;
begin
Result := TStringList.Create;
Result.Clear;
SortbyName;
try
for I := 0 to Count - 1 do
Result.Add(Items[I].LOCALNAME);
finally
end;
end;
procedure TPayors.Free;
begin
Items := Nil;
end;
function TPayors.GetPayorGuid(const aPAYORUNIQUE: Integer): String;
var
Idx:Integer;
begin
Result := '';
Idx := IndexOfPayorUnique(aPAYORUNIQUE);
if not (Idx = -1) then
Result := Items[Idx].PAYORGUID;
end;
function TPayors.IndexOfIgrpUnique(const aIGRPUNIQUE: Integer): Integer;
var
I: Integer;
begin
Result := -1;
for I := 0 to Count - 1 do
if Items[I].IGRPUNIQUE = aIGRPUNIQUE then
begin
Result := I;
Break;
end;
end;
function TPayors.IndexOfPayorUnique(const aPAYORUNIQUE: Integer): Integer;
var
I: Integer;
begin
Result := -1;
for I := 0 to Count - 1 do
if Items[I].PAYORUNIQUE = aPAYORUNIQUE then
begin
Result := I;
Break;
end;
end;
procedure TPayors.SortByName;
var
fSort:TStringList;
fParse:TStrings;
I,Idx: Integer;
fTempPayor:TPayors;
begin
fSort := TStringList.Create;
fParse := TStringList.Create;
fTempPayor.Items := Self.Items;
fSort.Sorted := True;
try
for I := 0 to Count - 1 do
fSort.Add(Items[I].LOCALNAME + #9 + IntToStr(I));
Items := Nil;
for I := 0 to fSort.Count - 1 do
begin
cbs.utils.ParseDelimited(fParse,fSort[I],#9);
Idx := StrToInt(fParse[1]);
Add(fTempPayor.Items[Idx]);
end;
finally
fTempPayor.Free;
fParse.Free;
fSort.Free;
end;
end;
function TPayors._pGetCount: Integer;
begin
Result := Length(Items);
end;
end.
You are (most probably) double freeing a stringlist (and never freeing at least one). The problem is in the setter of your 'SQL' property (which is backed by the 'FSQL' field):
procedure TPayorDM._psetSQL(const Value: TStringList);
begin
FSQL := Value;
end;
Here you are loosing the reference to the already existing stringlist (LHS). Consider the below scenario:
You call
PayorDM.SQL := AStringList;
and the reference to the private field you created in the constructor is gone, instead you keep a reference to 'AStringList'. After that at some point you destroy 'AStringList', now the 'FSQL' field is a stale pointer. When in the destructor you call
FSQL.Free;
you get an invalid pointer operation.
Change your setter to:
procedure TPayorDM._psetSQL(const Value: TStringList);
begin
FSQL.Assign(Value);
end;
I just need to split a string like: "STANS", "Payment, chk#1", ,1210.000 into an array based on ,. The result in the string list would be
STANS
Payment, chk#1
1210.000
Create a TStringList and assign your comma separated string to StringList.CommaText. This parses your input and returns the split strings as the items of the string list.
StringList.CommaText := '"STANS", "Payment, chk# 1", ,1210.000';
//StringList[0]='STANS'
//StringList[1]='Payment, chk# 1'
//etc.
I wrote this function and works perfect for me in Delphi 2007
function ParseCSV(const S: string; ADelimiter: Char = ','; AQuoteChar: Char = '"'): TStrings;
type
TState = (sNone, sBegin, sEnd);
var
I: Integer;
state: TState;
token: string;
procedure AddToResult;
begin
if (token <> '') and (token[1] = AQuoteChar) then
begin
Delete(token, 1, 1);
Delete(token, Length(token), 1);
end;
Result.Add(token);
token := '';
end;
begin
Result := TstringList.Create;
state := sNone;
token := '';
I := 1;
while I <= Length(S) do
begin
case state of
sNone:
begin
if S[I] = ADelimiter then
begin
token := '';
AddToResult;
Inc(I);
Continue;
end;
state := sBegin;
end;
sBegin:
begin
if S[I] = ADelimiter then
if (token <> '') and (token[1] <> AQuoteChar) then
begin
state := sEnd;
Continue;
end;
if S[I] = AQuoteChar then
if (I = Length(S)) or (S[I + 1] = ADelimiter) then
state := sEnd;
end;
sEnd:
begin
state := sNone;
AddToResult;
Inc(I);
Continue;
end;
end;
token := token + S[I];
Inc(I);
end;
if token <> '' then
AddToResult;
if S[Length(S)] = ADelimiter then
AddToResult
end;