Skip to content

Commit

Permalink
better handling of supplements
Browse files Browse the repository at this point in the history
  • Loading branch information
Grahame Grieve committed Jun 29, 2024
1 parent da49899 commit 34955f7
Show file tree
Hide file tree
Showing 3 changed files with 35 additions and 18 deletions.
1 change: 1 addition & 0 deletions library/fhir/fhir_common.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -757,6 +757,7 @@ TFhirCodeSystemPropertyW = class (TFHIRXVersionElementWrapper)
end;

TFhirCodeSystemContentMode = (cscmNull, cscmNotPresent, cscmExample, cscmFragment, cscmComplete, cscmSupplement);
TFhirCodeSystemContentModeSet = set of TFhirCodeSystemContentMode;

const
CODES_TFhirCodeSystemContentMode : Array[TFhirCodesystemContentMode] of String = ('null', 'not-present', 'example', 'fragment', 'complete', 'supplement');
Expand Down
11 changes: 6 additions & 5 deletions library/fhir/fhir_tx.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -195,7 +195,7 @@ TTerminologyWorker = class (TFslObject)
function sizeInBytesV(magic : integer) : cardinal; override;
procedure deadCheck(place : String); virtual;
function findInAdditionalResources(url, version, resourceType : String; error : boolean) : TFHIRMetadataResourceW;
function findCodeSystem(url, version : String; params : TFHIRTxOperationParams; nullOk : boolean) : TCodeSystemProvider;
function findCodeSystem(url, version : String; params : TFHIRTxOperationParams; kinds : TFhirCodeSystemContentModeSet; nullOk : boolean) : TCodeSystemProvider;
function listVersions(url : String) : String;
procedure loadSupplements(cse: TFHIRCodeSystemEntry; url: String);
procedure checkSupplements(cs: TCodeSystemProvider; src: TFHIRXVersionElementWrapper);
Expand Down Expand Up @@ -360,7 +360,7 @@ function TTerminologyWorker.findInAdditionalResources(url, version, resourceType
end;
end;

function TTerminologyWorker.findCodeSystem(url, version: String; params: TFHIRTxOperationParams; nullOk: boolean): TCodeSystemProvider;
function TTerminologyWorker.findCodeSystem(url, version: String; params: TFHIRTxOperationParams; kinds : TFhirCodeSystemContentModeSet; nullOk: boolean): TCodeSystemProvider;
var
r, r2 : TFHIRMetadataResourceW;
cs, cs2 : TFhirCodeSystemW;
Expand Down Expand Up @@ -391,11 +391,12 @@ function TTerminologyWorker.findCodeSystem(url, version: String; params: TFHIRTx
if (result <> nil) then
exit(result);

if (cs <> nil) and (cs.content = cscmFragment) then
if (cs <> nil) and (cs.content in kinds) then
begin
cse := TFHIRCodeSystemEntry.Create(cs.link);
try
loadSupplements(cse, url);
if cs.content <> cscmSupplement then
loadSupplements(cse, url);
exit(TFhirCodeSystemProvider.Create(FLanguages.link, FI18n.link, FFactory.link, cse.link));
finally
cse.free;
Expand Down Expand Up @@ -516,7 +517,7 @@ procedure TFHIRCodeSystemInformationProvider.lookupCode(coding: TFHIRCodingW; pr
params := TFHIRTxOperationParams.Create;
try
params.defaultToLatestVersion := true;
provider := findCodeSystem(coding.systemUri, coding.version, profile, false);
provider := findCodeSystem(coding.systemUri, coding.version, profile, [cscmComplete, cscmFragment], false);
try
resp.name := provider.name(nil);
resp.systemUri := provider.systemUri;
Expand Down
41 changes: 28 additions & 13 deletions library/ftx/fhir_valuesets.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -495,7 +495,7 @@ function TValueSetChecker.determineSystem(code: String): String;
for vsi in FValueSet.includes do
begin
deadCheck('determineSystem');
cs := findCodeSystem(vsi.systemUri, '', nil, true);
cs := findCodeSystem(vsi.systemUri, '', nil, [cscmComplete, cscmFragment], true);
if (cs = nil) then
exit('');
try
Expand Down Expand Up @@ -681,7 +681,7 @@ procedure TValueSetChecker.prepareConceptSet(desc: string; cc: TFhirValueSetComp
end;
end;
if not FOthers.ExistsByKey(cc.systemUri) then
FOthers.Add(cc.systemUri, findCodeSystem(cc.systemUri, cc.version, FParams, true));
FOthers.Add(cc.systemUri, findCodeSystem(cc.systemUri, cc.version, FParams, [cscmComplete, cscmFragment], true));
if cc.version = '' then
cs := FOthers.matches[cc.systemUri] as TCodeSystemProvider
else
Expand Down Expand Up @@ -812,7 +812,7 @@ function TValueSetChecker.check(path, system, version, code: String; abstractOk,
op.addIssue(isWarning, itInvalid, path, msg, oicInvalidData);
exit(bFalse);
end;
cs := findCodeSystem(system, version, FParams, true);
cs := findCodeSystem(system, version, FParams, [cscmComplete, cscmFragment], true);
try
if cs = nil then
begin
Expand All @@ -827,6 +827,13 @@ function TValueSetChecker.check(path, system, version, code: String; abstractOk,
messages.add(msg);
op.addIssue(isError, itInvalid, addToPath(path, 'system'), msg, oicInvalidData);
end
else if findCodeSystem(system, version, FParams, [cscmSupplement], true) <> nil then
begin
vss.free;
msg := FI18n.translate('CODESYSTEM_CS_NO_SUPPLEMENT', FParams.languages, [system]);
messages.add(msg);
op.addIssue(isError, itInvalid, addToPath(path, 'system'), msg, oicInvalidData);
end
else if (version <> '') then
begin
msg := FI18n.translate('UNKNOWN_CODESYSTEM_VERSION', FParams.languages, [system, version, '['+listVersions(system)+']']);
Expand Down Expand Up @@ -929,7 +936,7 @@ function TValueSetChecker.check(path, system, version, code: String; abstractOk,
else if (false) then
begin
// anyhow, we ignore the value set (at least for now)
cs := findCodeSystem(system, version, FParams, true);
cs := findCodeSystem(system, version, FParams, [cscmComplete, cscmFragment], true);
try
if cs = nil then
begin
Expand Down Expand Up @@ -1091,7 +1098,7 @@ function TValueSetChecker.check(path, system, version, code: String; abstractOk,
else
cs := TCodeSystemProvider(FOthers.matches[cc.systemUri+'|'+v]).link;
if (cs = nil) then
cs := findCodeSystem(system, v, FParams, true);
cs := findCodeSystem(system, v, FParams, [cscmComplete, cscmFragment], true);
if (cs = nil) then
begin
if (not FParams.membershipOnly) then
Expand Down Expand Up @@ -1209,7 +1216,7 @@ function TValueSetChecker.check(path, system, version, code: String; abstractOk,
else
cs := TCodeSystemProvider(FOthers.matches[ccc.systemUri+'|'+v]).link;
if (cs = nil) then
cs := findCodeSystem(system, v, FParams, true);
cs := findCodeSystem(system, v, FParams, [cscmComplete, cscmFragment], true);
if (cs = nil) then
begin
if (not FParams.membershipOnly) then
Expand Down Expand Up @@ -1568,7 +1575,7 @@ function TValueSetChecker.check(issuePath : String; code: TFhirCodeableConceptW;
p := issuePath;
op.addIssue(isError, itInvalid, p, m, oicInvalidData);
end;
prov := findCodeSystem(ws, c.version, FParams, true);
prov := findCodeSystem(ws, c.version, FParams, [cscmComplete, cscmFragment], true);
try
if (prov = nil) then
begin
Expand All @@ -1579,11 +1586,19 @@ function TValueSetChecker.check(issuePath : String; code: TFhirCodeableConceptW;
m := FI18n.translate('Terminology_TX_System_ValueSet2', FParams.languages, [ws]);
msg(m);
op.addIssue(isError, itInvalid, addToPath(path, 'system'), m, oicInvalidData);
cause := itNotFound;
cause := itInvalid;
end
else if findCodeSystem(ws, c.version, FParams, [cscmSupplement], true) <> nil then
begin
vss.free;
m := FI18n.translate('CODESYSTEM_CS_NO_SUPPLEMENT', FParams.languages, [ws]);
msg(m);
op.addIssue(isError, itInvalid, addToPath(path, 'system'), m, oicInvalidData);
cause := itInvalid;
end
else
begin
prov2 := findCodeSystem(ws, '', FParams, true);
prov2 := findCodeSystem(ws, '', FParams, [cscmComplete, cscmFragment], true);
try
bAdd := true;
if (prov2 = nil) and (c.version = '') then
Expand Down Expand Up @@ -3229,7 +3244,7 @@ procedure TFHIRValueSetExpander.checkSource(cset: TFhirValueSetComposeIncludeW;

if cset.systemUri <> '' then
begin
cs := findCodeSystem(cset.systemUri, cset.version, FParams, false);
cs := findCodeSystem(cset.systemUri, cset.version, FParams, [cscmComplete, cscmFragment], false);
try

if cs.contentMode <> cscmComplete then
Expand Down Expand Up @@ -3352,7 +3367,7 @@ procedure TFHIRValueSetExpander.includeCodes(cset: TFhirValueSetComposeIncludeW;
begin
filters := TFslList<TCodeSystemProviderFilterContext>.create;
try
cs := findCodeSystem(cset.systemUri, cset.version, FParams, false);
cs := findCodeSystem(cset.systemUri, cset.version, FParams, [cscmComplete, cscmFragment], false);
try
//Logging.log('Processing '+vsId+',code system "'+cset.systemUri+'|'+cset.version+'", '+inttostr(cset.filterCount)+' filters, '+inttostr(cset.conceptCount)+' concepts');
checkSupplements(cs, cset);
Expand Down Expand Up @@ -3674,7 +3689,7 @@ procedure TFHIRValueSetExpander.excludeCodes(cset: TFhirValueSetComposeIncludeW;
begin
filters := TFslList<TCodeSystemProviderFilterContext>.create;
try
cs := findCodeSystem(cset.systemUri, cset.version, FParams, false);
cs := findCodeSystem(cset.systemUri, cset.version, FParams, [cscmComplete, cscmFragment], false);
try
//Logging.log('Processing '+vsId+',code system "'+cset.systemUri+'|'+cset.version+'", '+inttostr(cset.filterCount)+' filters, '+inttostr(cset.conceptCount)+' concepts');
checkSupplements(cs, cset);
Expand Down Expand Up @@ -4045,7 +4060,7 @@ function TFHIRConceptMapTranslator.checkCode(op: TFhirOperationOutcomeW; langLis
d : String;
begin
result := false;
cp := findCodeSystem(system, version, nil, true);
cp := findCodeSystem(system, version, nil, [cscmComplete, cscmFragment], true);
if cp <> nil then
begin
try
Expand Down

0 comments on commit 34955f7

Please sign in to comment.