Skip to content

Commit 2df5baa

Browse files
author
Grahame Grieve
committed
implement OMOP translations
1 parent 1484a13 commit 2df5baa

6 files changed

Lines changed: 274 additions & 76 deletions

File tree

‎library/ftx/fhir_valuesets.pas‎

Lines changed: 100 additions & 42 deletions
Original file line numberDiff line numberDiff line change
@@ -244,13 +244,15 @@ TFHIRConceptMapTranslator = class (TValueSetWorker)
244244
function checkCode(op : TFhirOperationOutcomeW; langList : THTTPLanguageList; path : string; code : string; system, version : string; display : string) : boolean;
245245
function isOkTarget(cm: TFhirConceptMapW; vs: TFhirValueSetW): boolean;
246246
function isOkSource(cm: TFhirConceptMapW; vs: TFhirValueSetW; coding: TFHIRCodingW; out group : TFhirConceptMapGroupW; out match : TFhirConceptMapGroupElementW): boolean; overload;
247-
function isOkSource(cm: TFhirConceptMapW; coding: TFHIRCodingW; out group : TFhirConceptMapGroupW; out match : TFhirConceptMapGroupElementW): boolean; overload;
247+
function isOkSource(cm: TFhirConceptMapW; coding: TFHIRCodingW; target : String; out group : TFhirConceptMapGroupW; out match : TFhirConceptMapGroupElementW): boolean; overload;
248248
function findConceptMap(var cm: TFhirConceptMapW; var msg : String): boolean;
249+
function translateUsingGroups(cm: TFHIRConceptMapW; coding: TFHIRCodingW; target : String; params: TFhirParametersW): boolean;
250+
function translateUsingCodeSystem(cm: TFHIRConceptMapW; coding: TFHIRCodingW; target : String; params: TFhirParametersW): boolean;
249251
public
250252
constructor Create(factory : TFHIRFactory; opContext : TTerminologyOperationContext; getVS: TGetValueSetEvent; getCS : TGetProviderEvent; getVersions : TGetSystemVersionsEvent; getExpansion : TGetExpansionEvent; txResources : TFslMetadataResourceList; languages : TIETFLanguageDefinitions; i18n : TI18nSupport); overload;
251253
destructor Destroy; override;
252254

253-
function translate(langList : THTTPLanguageList; reqId : String; cml : TFslList<TFHIRConceptMapW>; coding: TFHIRCodingW; params : TFhirParametersW; profile : TFhirTxOperationParams) : TFhirParametersW;
255+
function translate(langList : THTTPLanguageList; reqId : String; cml : TFslList<TFHIRConceptMapW>; coding: TFHIRCodingW; target : String; params : TFhirParametersW; profile : TFhirTxOperationParams) : TFhirParametersW;
254256
//function translate(langList : THTTPLanguageList; reqId : String; cm : TLoadedConceptMap; coding : TFHIRCodingW; params : TFhirParametersW; txResources : TFslMetadataResourceList; profile : TFhirTxOperationParams): TFhirParametersW; overload;
255257
//function translate(langList : THTTPLanguageList; source : TFhirValueSetW; coding : TFHIRCodingW; target : TFhirValueSetW; params : TFhirParametersW; txResources : TFslMetadataResourceList; profile : TFhirTxOperationParams) : TFhirParametersW; overload;
256258
//function translate(langList : THTTPLanguageList; source : TFhirValueSetW; coded : TFhirCodeableConceptW; target : TFhirValueSetW; params : TFhirParametersW; txResources : TFslMetadataResourceList; profile : TFhirTxOperationParams) : TFhirParametersW; overload;
@@ -4367,61 +4369,117 @@ destructor TFHIRConceptMapTranslator.Destroy;
43674369
inherited Destroy;
43684370
end;
43694371

4370-
function TFHIRConceptMapTranslator.translate(langList: THTTPLanguageList; reqId : String; cml : TFslList<TFHIRConceptMapW>; coding: TFHIRCodingW; params: TFhirParametersW; profile: TFhirTxOperationParams): TFhirParametersW;
4372+
function TFHIRConceptMapTranslator.translateUsingGroups(cm: TFHIRConceptMapW; coding: TFHIRCodingW; target : String; params: TFhirParametersW): boolean;
43714373
var
4372-
cm : TFHIRConceptMapW;
43734374
g : TFhirConceptMapGroupW;
43744375
em : TFhirConceptMapGroupElementW;
43754376
map : TFhirConceptMapGroupElementTargetW;
43764377
outcome : TFHIRCodingW;
43774378
p, pp : TFhirParametersParameterW;
43784379
prod : TFhirConceptMapGroupElementDependsOnW;
4379-
added : boolean;
4380-
msg : String;
43814380
begin
4382-
result := FFactory.wrapParams(FFactory.makeResource('Parameters'));
4383-
try
4384-
try
4385-
added := false;
4386-
for cm in cml do
4381+
result := false;
4382+
if isOkSource(cm, coding, target, g, em) then
4383+
begin
4384+
try
4385+
for map in em.targets.forEnum do
43874386
begin
4388-
//else if not checkCode(op, langList, '', coding.code, coding.systemUri, coding.version, coding.display) then
4389-
// raise ETerminologyError.Create('Code '+coding.code+' in system '+coding.systemUri+' not recognized', itUnknown);
4390-
if isOkSource(cm, coding, g, em) then
4387+
if (map.equivalence in [cmeNull, cmeEquivalent, cmeEqual, cmeWider, cmeSubsumes, cmeNarrower, cmeSpecializes, cmeInexact]) then
43914388
begin
4389+
params.AddParamBool('result', true);
4390+
result := true;
4391+
outcome := FFactory.wrapCoding(FFactory.makeByName('Coding'));
43924392
try
4393-
for map in em.targets.forEnum do
4393+
p := params.AddParam('match');
4394+
outcome.systemUri := g.target;
4395+
outcome.code := map.code;
4396+
p.AddParam('concept', outcome.Element.Link);
4397+
p.addParamCode('equivalence', CODES_TFHIRConceptEquivalence[map.equivalence]);
4398+
if (map.comments <> '') then
4399+
p.addParamStr('message', map.comments);
4400+
for prod in map.products.forEnum do
43944401
begin
4395-
if (map.equivalence in [cmeNull, cmeEquivalent, cmeEqual, cmeWider, cmeSubsumes, cmeNarrower, cmeSpecializes, cmeInexact]) then
4396-
begin
4397-
result.AddParamBool('result', true);
4398-
added := true;
4399-
outcome := FFactory.wrapCoding(FFactory.makeByName('Coding'));
4400-
try
4401-
p := result.AddParam('match');
4402-
outcome.systemUri := g.target;
4403-
outcome.code := map.code;
4404-
p.AddParam('concept', outcome.Element.Link);
4405-
p.addParamCode('equivalence', CODES_TFHIRConceptEquivalence[map.equivalence]);
4406-
if (map.comments <> '') then
4407-
p.addParamStr('message', map.comments);
4408-
for prod in map.products.forEnum do
4409-
begin
4410-
pp := p.addParam('product');
4411-
pp.addParamStr('element', prod.property_);
4412-
pp.addParam('concept').value := FFactory.makeCoding(prod.system_, prod.value);
4413-
end;
4414-
finally
4415-
outcome.free;
4416-
end;
4417-
end;
4402+
pp := p.addParam('product');
4403+
pp.addParamStr('element', prod.property_);
4404+
pp.addParam('concept').value := FFactory.makeCoding(prod.system_, prod.value);
44184405
end;
44194406
finally
4420-
em.free;
4421-
g.free;
4407+
outcome.free;
4408+
end;
4409+
end;
4410+
end;
4411+
finally
4412+
em.free;
4413+
g.free;
4414+
end;
4415+
end;
4416+
end;
4417+
4418+
function TFHIRConceptMapTranslator.translateUsingCodeSystem(cm: TFHIRConceptMapW; coding: TFHIRCodingW; target : String; params: TFhirParametersW): boolean;
4419+
var
4420+
prov : TCodeSystemProvider;
4421+
codes : TFslList<TCodeTranslation>;
4422+
t : TCodeTranslation;
4423+
outcome : TFHIRCodingW;
4424+
p : TFhirParametersParameterW;
4425+
begin
4426+
result := false;
4427+
prov := (cm.tag as TCodeSystemProviderFactory).getProvider;
4428+
try
4429+
params.addParamUri('used-system', prov.systemUri()+'|'+prov.version());
4430+
codes := TFslList<TCodeTranslation>.create;
4431+
try
4432+
prov.getTranslations(coding, target, codes);
4433+
if not codes.Empty then
4434+
begin
4435+
params.AddParamBool('result', true);
4436+
result := true;
4437+
for t in codes do
4438+
begin
4439+
if (t.map <> '') then
4440+
params.addParamUri('used-conceptmap', t.map);
4441+
outcome := FFactory.wrapCoding(FFactory.makeByName('Coding'));
4442+
try
4443+
p := params.AddParam('match');
4444+
outcome.systemUri := t.uri;
4445+
outcome.code := t.code;
4446+
outcome.version := t.version;
4447+
outcome.display := t.display;
4448+
p.AddParam('concept', outcome.Element.Link);
4449+
p.addParamCode('equivalence', CODES_TFHIRConceptEquivalence[t.equivalence]);
4450+
if (t.message <> '') then
4451+
p.addParamStr('message', t.message);
4452+
finally
4453+
outcome.free;
44224454
end;
44234455
end;
44244456
end;
4457+
finally
4458+
codes.free;
4459+
end;
4460+
finally
4461+
prov.free;
4462+
end;
4463+
end;
4464+
4465+
function TFHIRConceptMapTranslator.translate(langList: THTTPLanguageList; reqId : String; cml : TFslList<TFHIRConceptMapW>; coding: TFHIRCodingW; target : String; params: TFhirParametersW; profile: TFhirTxOperationParams): TFhirParametersW;
4466+
var
4467+
cm : TFHIRConceptMapW;
4468+
added : boolean;
4469+
begin
4470+
result := FFactory.wrapParams(FFactory.makeResource('Parameters'));
4471+
try
4472+
try
4473+
added := false;
4474+
for cm in cml do
4475+
begin
4476+
//else if not checkCode(op, langList, '', coding.code, coding.systemUri, coding.version, coding.display) then
4477+
// raise ETerminologyError.Create('Code '+coding.code+' in system '+coding.systemUri+' not recognized', itUnknown);
4478+
if (cm.Tag <> nil) and (cm.tag is TCodeSystemProviderFactory) then
4479+
added := translateUsingCodeSystem(cm, coding, target, result)
4480+
else
4481+
added := translateUsingGroups(cm, coding, target,result);
4482+
end;
44254483
if not added then
44264484
begin
44274485
result.AddParamBool('result', false);
@@ -4473,15 +4531,15 @@ function TFHIRConceptMapTranslator.isOkSource(cm: TFhirConceptMapW;
44734531

44744532

44754533
function TFHIRConceptMapTranslator.isOkSource(cm: TFhirConceptMapW;
4476-
coding: TFHIRCodingW; out group: TFhirConceptMapGroupW; out
4534+
coding: TFHIRCodingW; target : String; out group: TFhirConceptMapGroupW; out
44774535
match: TFhirConceptMapGroupElementW): boolean;
44784536
var
44794537
g : TFhirConceptMapGroupW;
44804538
em : TFhirConceptMapGroupElementW;
44814539
begin
44824540
result := false;
44834541
for g in cm.groups.forEnum do
4484-
if (g.source = coding.systemUri) then
4542+
if (g.source = coding.systemUri) and (g.target = target) then
44854543
begin
44864544
for em in g.elements.forEnum do
44874545
if (em.code = coding.code) then

‎library/ftx/ftx_service.pas‎

Lines changed: 59 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -242,6 +242,28 @@ TAlternateCodeOptions = class (TFslObject)
242242
function passes(prop : TFhirCodeSystemConceptPropertyW) : boolean;
243243
end;
244244

245+
{ TCodeTranslation }
246+
247+
TCodeTranslation = class (TFslObject)
248+
private
249+
FCode : String;
250+
FMap: String;
251+
FUri : String;
252+
FVersion : String;
253+
FDisplay : String;
254+
FMessage : String;
255+
FEquivalence : TFHIRConceptEquivalence;
256+
public
257+
function link : TCodeTranslation; overload;
258+
property code : String read FCode write FCode;
259+
property uri : String read FUri write FUri;
260+
property version : String read FVersion write FVersion;
261+
property display : String read FDisplay write FDisplay;
262+
property message : String read FMessage write FMessage;
263+
property equivalence : TFHIRConceptEquivalence read FEquivalence write FEquivalence;
264+
property map : String read FMap write FMap;
265+
end;
266+
245267
{ TCodeSystemProvider }
246268

247269
TCodeSystemProvider = class abstract (TFslObject)
@@ -323,13 +345,28 @@ TCodeSystemProvider = class abstract (TFslObject)
323345
procedure getStatus(out status: TPublicationStatus; out standardsStatus: String; out experimental : boolean); virtual;
324346
procedure getCDSInfo(opContext : TTxOperationContext; card : TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display : String); virtual;
325347

326-
procedure registerConceptMaps(list : TFslList<TFHIRConceptMapW>); virtual;
348+
procedure registerConceptMaps(list : TFslList<TFHIRConceptMapW>; factory : TFHIRFactory); virtual;
349+
procedure getTranslations(coding: TFHIRCodingW; target : String; codes : TFslList<TCodeTranslation>); virtual;
327350
procedure RecordUse(count : integer = 1);
328351
procedure checkReady; virtual;
329352
function defToThisVersion(specifiedVersion : String) : boolean; virtual;
330353
property UseCount : cardinal read FUseCount;
331354
end;
332355

356+
{ TCodeSystemProviderFactory }
357+
358+
TCodeSystemProviderFactory = class (TFslObject)
359+
public
360+
function link : TCodeSystemProviderFactory; overload;
361+
function getProvider : TCodeSystemProvider; virtual; abstract;
362+
function systemUri : String; virtual; abstract;
363+
function version : String; virtual; abstract;
364+
function name : String; virtual; abstract;
365+
function TotalCount : integer; virtual; abstract;
366+
function versionDesc : String; virtual; abstract;
367+
function description : String; virtual; abstract;
368+
end;
369+
333370
const
334371
CODES_TDisplayCheckingStyle : Array [TDisplayCheckingStyle] of String = ('Exact', 'CaseInsensitive', 'Normalised');
335372

@@ -386,6 +423,13 @@ function TAlternateCodeOptions.passes(prop: TFhirCodeSystemConceptPropertyW): bo
386423
end;
387424
end;
388425

426+
{ TCodeTranslation }
427+
428+
function TCodeTranslation.link: TCodeTranslation;
429+
begin
430+
result := TCodeTranslation(inherited link);
431+
end;
432+
389433

390434
{ TConceptDesignations }
391435

@@ -1000,11 +1044,16 @@ procedure TCodeSystemProvider.getCDSInfo(opContext : TTxOperationContext; card:
10001044
card.summary := 'No CDSHook Implementation for code system '+systemUri+' for code '+code+' ('+display+')';
10011045
end;
10021046

1003-
procedure TCodeSystemProvider.registerConceptMaps(list: TFslList<TFHIRConceptMapW>);
1047+
procedure TCodeSystemProvider.registerConceptMaps(list: TFslList<TFHIRConceptMapW>; factory : TFHIRFactory);
10041048
begin
10051049
// nothing
10061050
end;
10071051

1052+
procedure TCodeSystemProvider.getTranslations(coding: TFHIRCodingW; target: String; codes: TFslList<TCodeTranslation>);
1053+
begin
1054+
// no translations
1055+
end;
1056+
10081057
function TCodeSystemProvider.getPrepContext(opContext : TTxOperationContext): TCodeSystemProviderFilterPreparationContext;
10091058
begin
10101059
result := nil;
@@ -1454,4 +1503,12 @@ constructor TTxOperationContext.create(version: TFhirVersion);
14541503
FVersion := version;
14551504
end;
14561505

1506+
{ TCodeSystemProviderFactory }
1507+
1508+
function TCodeSystemProviderFactory.link: TCodeSystemProviderFactory;
1509+
begin
1510+
result := TCodeSystemProviderFactory(inherited link);
1511+
end;
1512+
1513+
14571514
end.

0 commit comments

Comments
 (0)