Merge branch 'HealthIntersections:master' into master

costateixeira · Oct 22, 2024 · e0c6ad1 · e0c6ad1
2 parents 45a1ff7 + e0d5c5a
commit e0c6ad1
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