Skip to content

Commit

Permalink
get http response code correct from operations
Browse files Browse the repository at this point in the history
  • Loading branch information
Grahame Grieve committed Oct 22, 2024
1 parent 8a3c5d8 commit e0d5c5a
Show file tree
Hide file tree
Showing 8 changed files with 70 additions and 6 deletions.
3 changes: 3 additions & 0 deletions library/fhir/fhir_common.pas
Original file line number Diff line number Diff line change
Expand Up @@ -394,6 +394,8 @@ TFhirOperationOutcomeIssueW = class (TFHIRXVersionElementWrapper)
property diagnostics : String read GetDiagnostics write SetDiagnostics;
end;

{ TFhirOperationOutcomeW }

TFhirOperationOutcomeW = class (TFHIRXVersionResourceWrapper)
public
function link : TFhirOperationOutcomeW; overload;
Expand All @@ -407,6 +409,7 @@ TFhirOperationOutcomeW = class (TFHIRXVersionResourceWrapper)
procedure addIssue(issue : TFhirOperationOutcomeIssueW; free : boolean); overload; virtual; abstract;
procedure addIssue(level : TIssueSeverity; cause : TFhirIssueType; path, message : String; issueCode : TOpIssueCode; addIfDuplicate : boolean = false); overload; virtual; abstract;
procedure addIssue(level : TIssueSeverity; cause : TFhirIssueType; path, msgId, message : String; issueCode : TOpIssueCode; addIfDuplicate : boolean = false); overload; virtual; abstract;
procedure addDiagsIssue(message : string); virtual; abstract;
function hasIssues : boolean; virtual; abstract;
function issues : TFslList<TFhirOperationOutcomeIssueW>; virtual; abstract;
function rule(level : TIssueSeverity; source : String; typeCode : TFhirIssueType; path : string; test : boolean; msg : string) : boolean; virtual; abstract;
Expand Down
11 changes: 11 additions & 0 deletions library/fhir2/fhir2_common.pas
Original file line number Diff line number Diff line change
Expand Up @@ -180,6 +180,7 @@ TFhirOperationOutcome2 = class (TFhirOperationOutcomeW)
procedure addIssue(issue : TFhirOperationOutcomeIssueW; owns : boolean); override;
procedure addIssue(level : TIssueSeverity; cause : TFHIRIssueType; path, message : String; code : TOpIssueCode; addIfDuplicate : boolean); override;
procedure addIssue(level : TIssueSeverity; cause : TFhirIssueType; path, msgId, message : String; code : TOpIssueCode; addIfDuplicate : boolean = false); overload; override;
procedure addDiagsIssue(message : string); override;
function hasIssues : boolean; override;
function issues : TFslList<TFhirOperationOutcomeIssueW>; override;
function rule(level : TIssueSeverity; source : String; typeCode : TFhirIssueType; path : string; test : boolean; msg : string) : boolean; override;
Expand Down Expand Up @@ -1320,6 +1321,16 @@ procedure TFhirOperationOutcome2.addIssue(level: TIssueSeverity; cause: TFhirIss
iss.addExtension('http://hl7.org/fhir/StructureDefinition/operationoutcome-message-id', msgid);
end;

procedure TFhirOperationOutcome2.addDiagsIssue(message: string);
var
iss : TFhirOperationOutcomeIssue;
begin
iss := (Fres as TFhirOperationOutcome).issueList.Append;
iss.code := IssueTypeInformational;
iss.severity := IssueSeverityInformation;
iss.diagnostics := message;
end;

function TFhirOperationOutcome2.code: TFhirIssueType;
var
a : TFhirIssueType;
Expand Down
11 changes: 11 additions & 0 deletions library/fhir3/fhir3_common.pas
Original file line number Diff line number Diff line change
Expand Up @@ -180,6 +180,7 @@ TFhirOperationOutcome3 = class (TFhirOperationOutcomeW)
procedure addIssue(issue : TFhirOperationOutcomeIssueW; free : boolean); override;
procedure addIssue(level : TIssueSeverity; cause : TFHIRIssueType; path, message : String; code : TOpIssueCode; addIfDuplicate : boolean); override;
procedure addIssue(level : TIssueSeverity; cause : TFhirIssueType; path, msgId, message : String; code : TOpIssueCode; addIfDuplicate : boolean = false); overload; override;
procedure addDiagsIssue(message : string); override;
function hasIssues : boolean; override;
function issues : TFslList<TFhirOperationOutcomeIssueW>; override;
function rule(level : TIssueSeverity; source : String; typeCode : TFhirIssueType; path : string; test : boolean; msg : string) : boolean; override;
Expand Down Expand Up @@ -1468,6 +1469,16 @@ procedure TFhirOperationOutcome3.addIssue(level: TIssueSeverity;
iss.addExtension('http://hl7.org/fhir/StructureDefinition/operationoutcome-message-id', msgid);
end;

procedure TFhirOperationOutcome3.addDiagsIssue(message: string);
var
iss : TFhirOperationOutcomeIssue;
begin
iss := (Fres as TFhirOperationOutcome).issueList.Append;
iss.code := IssueTypeInformational;
iss.severity := IssueSeverityInformation;
iss.diagnostics := message;
end;

function TFhirOperationOutcome3.code: TFhirIssueType;
var
a : TFhirIssueType;
Expand Down
14 changes: 13 additions & 1 deletion library/fhir4/fhir4_common.pas
Original file line number Diff line number Diff line change
Expand Up @@ -178,6 +178,7 @@ TFhirOperationOutcome4 = class (TFhirOperationOutcomeW)
procedure addIssue(issue : TFhirOperationOutcomeIssueW; free : boolean); override;
procedure addIssue(level : TIssueSeverity; cause : TFHIRIssueType; path, message : String; code : TOpIssueCode; addIfDuplicate : boolean); override;
procedure addIssue(level : TIssueSeverity; cause : TFhirIssueType; path, msgId, message : String; code : TOpIssueCode; addIfDuplicate : boolean = false); overload; override;
procedure addDiagsIssue(message : string); override;
function hasIssues : boolean; override;
function issues : TFslList<TFhirOperationOutcomeIssueW>; override;
function rule(level : TIssueSeverity; source : String; typeCode : TFhirIssueType; path : string; test : boolean; msg : string) : boolean; override;
Expand Down Expand Up @@ -1447,7 +1448,18 @@ procedure TFhirOperationOutcome4.addIssue(level: TIssueSeverity;
iss.details.text := message;
iss.locationList.Add(path);
iss.expressionList.Add(path);
iss.addExtension('http://hl7.org/fhir/StructureDefinition/operationoutcome-message-id', msgid);
if (msgId <> '') then
iss.addExtension('http://hl7.org/fhir/StructureDefinition/operationoutcome-message-id', msgid);
end;

procedure TFhirOperationOutcome4.addDiagsIssue(message: string);
var
iss : TFhirOperationOutcomeIssue;
begin
iss := (Fres as TFhirOperationOutcome).issueList.Append;
iss.code := IssueTypeInformational;
iss.severity := IssueSeverityInformation;
iss.diagnostics := message;
end;

function TFhirOperationOutcome4.code: TFhirIssueType;
Expand Down
11 changes: 11 additions & 0 deletions library/fhir4b/fhir4b_common.pas
Original file line number Diff line number Diff line change
Expand Up @@ -179,6 +179,7 @@ TFhirOperationOutcome4B = class (TFhirOperationOutcomeW)
procedure addIssue(issue : TFhirOperationOutcomeIssueW; free : boolean); override;
procedure addIssue(level : TIssueSeverity; cause : TFHIRIssueType; path, message : String; code : TOpIssueCode; addIfDuplicate : boolean); override;
procedure addIssue(level : TIssueSeverity; cause : TFhirIssueType; path, msgId, message : String; code : TOpIssueCode; addIfDuplicate : boolean = false); overload; override;
procedure addDiagsIssue(message : string); override;
function hasIssues : boolean; override;
function issues : TFslList<TFhirOperationOutcomeIssueW>; override;
function rule(level : TIssueSeverity; source : String; typeCode : TFhirIssueType; path : string; test : boolean; msg : string) : boolean; override;
Expand Down Expand Up @@ -1442,6 +1443,16 @@ procedure TFhirOperationOutcome4B.addIssue(level: TIssueSeverity;
iss.addExtension('http://hl7.org/fhir/StructureDefinition/operationoutcome-message-id', msgid);
end;

procedure TFhirOperationOutcome4B.addDiagsIssue(message: string);
var
iss : TFhirOperationOutcomeIssue;
begin
iss := (Fres as TFhirOperationOutcome).issueList.Append;
iss.code := IssueTypeInformational;
iss.severity := IssueSeverityInformation;
iss.diagnostics := message;
end;

function TFhirOperationOutcome4B.code: TFhirIssueType;
var
a : TFhirIssueType;
Expand Down
11 changes: 11 additions & 0 deletions library/fhir5/fhir5_common.pas
Original file line number Diff line number Diff line change
Expand Up @@ -177,6 +177,7 @@ TFhirOperationOutcome5 = class (TFhirOperationOutcomeW)
procedure addIssue(issue : TFhirOperationOutcomeIssueW; free : boolean); override;
procedure addIssue(level : TIssueSeverity; cause : TFHIRIssueType; path, message : String; code : TOpIssueCode; addIfDuplicate : boolean); override;
procedure addIssue(level : TIssueSeverity; cause : TFhirIssueType; path, msgId, message : String; code : TOpIssueCode; addIfDuplicate : boolean = false); overload; override;
procedure addDiagsIssue(message : string); override;
function hasIssues : boolean; override;
function issues : TFslList<TFhirOperationOutcomeIssueW>; override;
function rule(level : TIssueSeverity; source : String; typeCode : TFhirIssueType; path : string; test : boolean; msg : string) : boolean; override;
Expand Down Expand Up @@ -1459,6 +1460,16 @@ procedure TFhirOperationOutcome5.addIssue(level: TIssueSeverity;
iss.addExtension('http://hl7.org/fhir/StructureDefinition/operationoutcome-message-id', msgid);
end;

procedure TFhirOperationOutcome5.addDiagsIssue(message: string);
var
iss : TFhirOperationOutcomeIssue;
begin
iss := (Fres as TFhirOperationOutcome).issueList.Append;
iss.code := IssueTypeInformational;
iss.severity := IssueSeverityInformation;
iss.diagnostics := message;
end;

function TFhirOperationOutcome5.code: TFhirIssueType;
var
a : TFhirIssueType;
Expand Down
2 changes: 1 addition & 1 deletion library/fsl/fsl_service_win.pas
Original file line number Diff line number Diff line change
Expand Up @@ -446,7 +446,7 @@ procedure ServiceMainEntry(dwArgc: DWORD; lpszArgv: pointer); Stdcall;
procedure TSystemService.ServiceExecute;
begin
// problem: if we weren't actually started as a service we are about
// to hang. But there is no way to deteramine whether we are running
// to hang. But there is no way to determine whether we are running
// as a service
GServiceInfo[0].lpServiceName := PChar(FSystemName);
GServiceInfo[0].lpServiceProc := @ServiceMainEntry;
Expand Down
13 changes: 9 additions & 4 deletions server/tx_operations.pas
Original file line number Diff line number Diff line change
Expand Up @@ -563,19 +563,24 @@ function TFhirValueSetValidationOperation.Execute(context : TOperationContext; m
txResources := processAdditionalResources(context, manager, nil, params);

pout := FServer.validate(request.id, issuePath, vs, coded, profile, abstractOk, inferSystem, mode, txResources, summary, tt);
end;
end;
response.HTTPCode := 200;
response.Message := 'OK';
if summary <> '' then
result := result + ': '+summary;
if (oOut <> nil) then
response.resource := oOut.Resource.link
begin
oOut.addDiagsIssue('X-Request-Id: '+request.externalRequestId);
response.resource := oOut.Resource.link;
response.HTTPCode := 422; // todo, change this?
response.Message := 'Error Processing Request';
end
else
response.resource := pout.Resource.link;
finally
pOut.free;
oOut.free;
end;
response.HTTPCode := 200;
response.Message := 'OK';
response.Body := '';
response.LastModifiedDate := now;
finally
Expand Down

0 comments on commit e0d5c5a

Please sign in to comment.