get http response code correct from operations

HealthIntersections · Oct 22, 2024 · e0d5c5a · e0d5c5a
1 parent 8a3c5d8
commit e0d5c5a
Show file tree

Hide file tree

Showing 8 changed files with 70 additions and 6 deletions.
diff --git a/library/fhir/fhir_common.pas b/library/fhir/fhir_common.pas
@@ -394,6 +394,8 @@ TFhirOperationOutcomeIssueW = class (TFHIRXVersionElementWrapper)
  property diagnostics : String read GetDiagnostics write SetDiagnostics;
  end;
 
+ { TFhirOperationOutcomeW }
+
  TFhirOperationOutcomeW = class (TFHIRXVersionResourceWrapper)
  public
  function link : TFhirOperationOutcomeW; overload;
@@ -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;

diff --git a/library/fhir2/fhir2_common.pas b/library/fhir2/fhir2_common.pas
@@ -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;
@@ -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;

diff --git a/library/fhir3/fhir3_common.pas b/library/fhir3/fhir3_common.pas
@@ -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;
@@ -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;

diff --git a/library/fhir4/fhir4_common.pas b/library/fhir4/fhir4_common.pas
@@ -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;
@@ -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;

diff --git a/library/fhir4b/fhir4b_common.pas b/library/fhir4b/fhir4b_common.pas
@@ -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;
@@ -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;

diff --git a/library/fhir5/fhir5_common.pas b/library/fhir5/fhir5_common.pas
@@ -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;
@@ -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;

diff --git a/library/fsl/fsl_service_win.pas b/library/fsl/fsl_service_win.pas
@@ -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;

diff --git a/server/tx_operations.pas b/server/tx_operations.pas
@@ -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