Skip to content

Commit

Permalink
fix up default-valueset-version tests
Browse files Browse the repository at this point in the history
  • Loading branch information
Grahame Grieve committed Feb 23, 2025
1 parent 889c8d0 commit 5cfa630
Show file tree
Hide file tree
Showing 9 changed files with 60 additions and 22 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 @@ -391,6 +391,7 @@ TFhirOperationOutcomeIssueW = class (TFHIRXVersionElementWrapper)
function link : TFhirOperationOutcomeIssueW; overload;
function display : String; virtual; abstract;
function severity : TIssueSeverity; virtual; abstract;
procedure addCode(systemUri, code : String); virtual; abstract;
property diagnostics : String read GetDiagnostics write SetDiagnostics;
end;

Expand Down
6 changes: 6 additions & 0 deletions library/fhir3/fhir3_common.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -283,6 +283,7 @@ TFHIROperationOutcomeIssue3 = class (TFHIROperationOutcomeIssueW)
function wrapExtension(extension : TFHIRObject) : TFHIRExtensionW; override;
function display : String; override;
function severity : TIssueSeverity; override;
procedure addCode(systemUri, code : String); override;
function getDiagnostics: String; override;
procedure setDiagnostics(Value: String); override;
end;
Expand Down Expand Up @@ -1775,6 +1776,11 @@ function TFHIROperationOutcomeIssue3.severity: TIssueSeverity;
result := ISSUE_SEVERITY_MAP[issue.severity];
end;

procedure TFHIROperationOutcomeIssue3.addCode(systemUri, code: String);
begin
issue.details.addCoding(systemUri, '', code, '');
end;

function TFHIROperationOutcomeIssue3.getDiagnostics: String;
begin
result := issue.diagnostics;
Expand Down
6 changes: 6 additions & 0 deletions library/fhir4/fhir4_common.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -281,6 +281,7 @@ TFHIROperationOutcomeIssue4 = class (TFHIROperationOutcomeIssueW)
public
function wrapExtension(extension : TFHIRObject) : TFHIRExtensionW; override;
function display : String; override;
procedure addCode(systemUri, code : String); override;
function severity : TIssueSeverity; override;
function getDiagnostics: String; override;
procedure setDiagnostics(Value: String); override;
Expand Down Expand Up @@ -1749,6 +1750,11 @@ function TFHIROperationOutcomeIssue4.display: String;
result := i.details.text;
end;

procedure TFHIROperationOutcomeIssue4.addCode(systemUri, code: String);
begin
issue.details.addCoding(systemUri, '', code, '');
end;

function TFHIROperationOutcomeIssue4.issue: TFHIROperationOutcomeIssue;
begin
result := Element as TFHIROperationOutcomeIssue;
Expand Down
6 changes: 6 additions & 0 deletions library/fhir4b/fhir4b_common.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -283,6 +283,7 @@ TFHIROperationOutcomeIssue4B = class (TFHIROperationOutcomeIssueW)
function wrapExtension(extension : TFHIRObject) : TFHIRExtensionW; override;
function display : String; override;
function severity : TIssueSeverity; override;
procedure addCode(systemUri, code : String); override;
function getDiagnostics: String; override;
procedure setDiagnostics(Value: String); override;
end;
Expand Down Expand Up @@ -1755,6 +1756,11 @@ function TFHIROperationOutcomeIssue4B.severity: TIssueSeverity;
result := ISSUE_SEVERITY_MAP[issue.severity];
end;

procedure TFHIROperationOutcomeIssue4B.addCode(systemUri, code: String);
begin
issue.details.addCoding(systemUri, '', code, '');
end;

function TFHIROperationOutcomeIssue4B.getDiagnostics: String;
begin
result := issue.diagnostics;
Expand Down
6 changes: 6 additions & 0 deletions library/fhir5/fhir5_common.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -280,6 +280,7 @@ TFHIROperationOutcomeIssue5 = class (TFHIROperationOutcomeIssueW)
public
function wrapExtension(extension : TFHIRObject) : TFHIRExtensionW; override;
function display : String; override;
procedure addCode(systemUri, code : String); override;
function severity : TIssueSeverity; override;
function getDiagnostics: String; override;
procedure setDiagnostics(Value: String); override;
Expand Down Expand Up @@ -1757,6 +1758,11 @@ function TFHIROperationOutcomeIssue5.display: String;
result := i.details.text;
end;

procedure TFHIROperationOutcomeIssue5.addCode(systemUri, code: String);
begin
issue.details.addCoding(systemUri, '', code, '');
end;

function TFHIROperationOutcomeIssue5.issue: TFHIROperationOutcomeIssue;
begin
result := Element as TFHIROperationOutcomeIssue;
Expand Down
4 changes: 2 additions & 2 deletions library/ftx/fhir_valuesets.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3316,7 +3316,7 @@ procedure TFHIRValueSetExpander.checkCanExpandValueset(uri, version: String);
vs : TFHIRValueSetW;
begin
vs := findValueSet(uri, version);
try
try
if vs = nil then
begin
if (version = '') and (uri.contains('|')) then
Expand All @@ -3327,7 +3327,7 @@ procedure TFHIRValueSetExpander.checkCanExpandValueset(uri, version: String);
if (version = '') then
raise ETerminologyError.create(FI18n.translate('VS_EXP_IMPORT_UNK', FLangList, [uri]), itUnknown)
else
raise ETerminologyError.create(FI18n.translate('VS_EXP_IMPORT_UNK_PINNED', FLangList, [uri, version]), itUnknown);
raise ETerminologyError.create(FI18n.translate('VS_EXP_IMPORT_UNK_PINNED', FLangList, [uri, version]), itNotFound, oicNotFound);
end;
finally
vs.free;
Expand Down
13 changes: 12 additions & 1 deletion library/ftx/ftx_service.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -47,9 +47,12 @@ ETerminologySetup = class (EFslException); // problem in the terminology confi
ETerminologyError = class (EFslException) // problem in terminology operation
private
FIssueType : TFhirIssueType;
FopIssue : TOpIssueCode;
public
constructor Create(message : String; issueType : TFhirIssueType);
constructor Create(message : String; issueType : TFhirIssueType; opIssue : TOpIssueCode);
property IssueType : TFhirIssueType read FIssueType;
property OpIssue : TOpIssueCode read FopIssue;
end;

ETerminologyTodo = Class(ETerminologyError)
Expand Down Expand Up @@ -1377,10 +1380,18 @@ procedure TCodeSystemIteratorContext.moveCursor(current: integer);

{ ETerminologyError }

constructor ETerminologyError.create(message: String; issueType: TFhirIssueType);
constructor ETerminologyError.Create(message: String; issueType: TFhirIssueType);
begin
inherited Create(message);
FIssueType := issueType;
FopIssue := oicVoid;
end;

constructor ETerminologyError.Create(message: String; issueType: TFhirIssueType; opIssue: TOpIssueCode);
begin
inherited Create(message);
FIssueType := issueType;
FopIssue := opIssue;
end;

{ ETerminologyTodo }
Expand Down
38 changes: 20 additions & 18 deletions server/endpoint_storage.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -169,7 +169,7 @@ TStorageWebEndpoint = class (TFhirWebServerEndpoint)
sCookie, provenance, sBearer: String; oPostStream: TStream; oResponse: TFHIRResponse; var aFormat: TFHIRFormat; var redirect: boolean; form: TMimeMessage;
bAuth, secure: boolean; out relativeReferenceAdjustment: integer; var style : TFHIROutputStyle; Session: TFHIRSession; cert: TIdOpenSSLX509; tt : TFslTimeTracker): TFHIRRequest;
Procedure ProcessOutput(start : UInt64; oRequest: TFHIRRequest; oResponse: TFHIRResponse; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; relativeReferenceAdjustment: integer; style : TFHIROutputStyle; gzip, cache: boolean; summary : String);
procedure SendError(response: TIdHTTPResponseInfo; logid : string; status: word; format: TFHIRFormat; langList : THTTPLanguageList; message, url: String; e: exception; Session: TFHIRSession; addLogins: boolean; path: String; relativeReferenceAdjustment: integer; code: TFHIRIssueType; messageId, diagnostics : String); overload;
procedure SendError(response: TIdHTTPResponseInfo; logid : string; status: word; format: TFHIRFormat; langList : THTTPLanguageList; message, url: String; e: exception; Session: TFHIRSession; addLogins: boolean; path: String; relativeReferenceAdjustment: integer; code: TFHIRIssueType; messageId, diagnostics : String; opIssue : TOpIssueCode); overload;
function processProvenanceHeader(header : String; langList : THTTPLanguageList): TFhirProvenanceW;
function EncodeVersionsJson(r: TFHIRResourceV): TBytes;
function EncodeVersionsXml(r: TFHIRResourceV): TBytes;
Expand Down Expand Up @@ -1548,65 +1548,65 @@ function TStorageWebEndpoint.HandleRequest(AContext: TIdContext; request: TIdHTT
result := result + ' (Auth needed)';
end
else
SendError(response, logId, e.status, aFormat, langList, e.message, sPath, e, Session, true, sPath + sDoc, relativeReferenceAdjustment, itLogin, '', '');
SendError(response, logId, e.status, aFormat, langList, e.message, sPath, e, Session, true, sPath + sDoc, relativeReferenceAdjustment, itLogin, '', '', oicVoid);
end;
on e: ETerminologyError do
begin
//result := result + ' (Auth needed)';
if noErrCode then
SendError(response, logId, 200, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, itNotSupported, '', '')
SendError(response, logId, 200, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, itNotSupported, '', '', oicVoid)
else if e.IssueType = itNull then
SendError(response, logId, HTTP_ERR_BUSINESS_RULES_FAILED, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, itNotSupported, '', '')
SendError(response, logId, HTTP_ERR_BUSINESS_RULES_FAILED, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, itNotSupported, '', '', e.OpIssue)
else
SendError(response, logId, HTTP_ERR_BUSINESS_RULES_FAILED, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, e.issueType, '', '')
SendError(response, logId, HTTP_ERR_BUSINESS_RULES_FAILED, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, e.issueType, '', '', e.OpIssue)
end;
on e: ETerminologySetup do
begin
result := result + ' (msg: '+e.message+')';
if noErrCode then
SendError(response, logId, 200, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, itNotSupported, '', '')
SendError(response, logId, 200, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, itNotSupported, '', '', oicVoid)
else
SendError(response, logId, HTTP_ERR_BUSINESS_RULES_FAILED, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, itNotSupported, '', '');
SendError(response, logId, HTTP_ERR_BUSINESS_RULES_FAILED, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, itNotSupported, '', '', oicVoid);
end;
on e: ETooCostly do
begin
result := result + ' (msg: Too-Costly)';
if noErrCode then
SendError(response, logId, 200, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, itTooCostly, '', e.Diagnostics)
SendError(response, logId, 200, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, itTooCostly, '', e.Diagnostics, oicVoid)
else
SendError(response, logId, HTTP_ERR_BUSINESS_RULES_FAILED, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, itTooCostly, '', e.Diagnostics);
SendError(response, logId, HTTP_ERR_BUSINESS_RULES_FAILED, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, itTooCostly, '', e.Diagnostics, oicVoid);
end;
on e: ERestfulException do
begin
result := result + ' (msg: '+e.message+')';
if noErrCode then
SendError(response, logId, 200, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, e.code, '', '')
SendError(response, logId, 200, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, e.code, '', '', oicVoid)
else
SendError(response, logId, e.status, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, e.code, '', '');
SendError(response, logId, e.status, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, e.code, '', '', oicVoid);
end;
on e: EWebServerException do
begin
result := result + ' (msg: '+e.message+')';
if noErrCode then
SendError(response, logId, 200, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, issueType(e.issueType), e.MessageId, '')
SendError(response, logId, 200, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, issueType(e.issueType), e.MessageId, '', oicVoid)
else
SendError(response, logId, e.Code, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, issueType(e.issueType), e.MessageId, e.diagnostics);
SendError(response, logId, e.Code, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, issueType(e.issueType), e.MessageId, e.diagnostics, oicVoid);
end;
on e: EFslException do
begin
result := result + ' (msg: '+e.message+')';
if noErrCode then
SendError(response, logId, 200, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, itNull, '', '')
SendError(response, logId, 200, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, itNull, '', '', oicVoid)
else
SendError(response, logId, HTTP_ERR_INTERNAL, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, itNull, '', '');
SendError(response, logId, HTTP_ERR_INTERNAL, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, itNull, '', '', oicVoid);
end;
on e: exception do
begin
result := result + ' (err: '+e.message+')';
if noErrCode then
SendError(response, logId, 200, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, itNull, '', '')
SendError(response, logId, 200, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, itNull, '', '', oicVoid)
else
SendError(response, logId, HTTP_ERR_INTERNAL, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, itNull, '', '');
SendError(response, logId, HTTP_ERR_INTERNAL, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, itNull, '', '', oicVoid);
end;
end;
finally
Expand Down Expand Up @@ -2260,7 +2260,7 @@ procedure TStorageWebEndpoint.ProcessOutput(start: UInt64;
end;

procedure TStorageWebEndpoint.SendError(response: TIdHTTPResponseInfo; logid: string; status: word; format: TFHIRFormat; langList : THTTPLanguageList;
message, url: String; e: exception; Session: TFHIRSession; addLogins: boolean; path: String; relativeReferenceAdjustment: integer; code: TFHIRIssueType; messageId, diagnostics : String);
message, url: String; e: exception; Session: TFHIRSession; addLogins: boolean; path: String; relativeReferenceAdjustment: integer; code: TFHIRIssueType; messageId, diagnostics : String; opIssue : TOpIssueCode);
var
issue: TFhirOperationOutcomeW;
oComp: TFHIRComposer;
Expand All @@ -2283,6 +2283,8 @@ procedure TStorageWebEndpoint.SendError(response: TIdHTTPResponseInfo; logid: st
iss.diagnostics := diagnostics;
if (messageId <> '') then
iss.addExtensionV('http://hl7.org/fhir/StructureDefinition/operationoutcome-message-id', FContext.factory.makeString(messageId));
if (opIssue <> oicVoid) then
iss.addCode('http://hl7.org/fhir/tools/CodeSystem/tx-issue-type', CODES_TOpIssueCode[opIssue]);
issue.addIssue(iss, false);
finally
iss.free;
Expand Down
2 changes: 1 addition & 1 deletion server/tx_operations.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1429,7 +1429,7 @@ procedure TFhirTerminologyOperation.processExpansionParams(request: TFHIRRequest
result.seeVersionRule(p.valueString, fvmCheck)
else if (p.name = 'force-system-version') then
result.seeVersionRule(p.valueString, fvmOverride)
else if (p.name = 'valueset-version') then
else if (p.name = 'default-valueset-version') then
result.getValueSetVersionRules.add(p.valueString)
else if (p.name = 'displayLanguage') then
result.DisplayLanguages := parseLanguages(p.valueString)
Expand Down

0 comments on commit 5cfa630

Please sign in to comment.