Merge branch 'master' into makelinuxinstallscript

costateixeira · Aug 18, 2024 · 1b94d54 · 1b94d54
2 parents 9c345db + e34a092
commit 1b94d54
Show file tree

Hide file tree

Showing 45 changed files with 543 additions and 269 deletions.
diff --git a/install/install-tk.iss b/install/install-tk.iss
@@ -3,11 +3,11 @@
 ; AppID can never be changed as subsequent installations require the same installation ID each time
 AppID=FHIRToolkit
 AppName=Health Intersections FHIR Toolkit
-AppVerName=FHIRToolkit v3.4.7
+AppVerName=FHIRToolkit v3.4.8
 
 ; compilation control
 OutputDir=..\install\build
-OutputBaseFilename=fhirtoolkit-win64-3.4.7
+OutputBaseFilename=fhirtoolkit-win64-3.4.8
 Compression=lzma2/ultra64
 
 ; 64 bit
@@ -32,11 +32,11 @@ UninstallFilesDir={app}\uninstall
 ; win2000+ add/remove programs support
 AppPublisher=Health Intersections P/L
 AppPublisherURL=http://www.healthintersections.com.au
-AppVersion=3.4.7
+AppVersion=3.4.8
 AppSupportURL=https://github.com/grahamegrieve/fhirserver
 AppUpdatesURL=https://github.com/grahamegrieve/fhirserver
 AppCopyright=Copyright (c) Health Intersections Pty Ltd 2020+
-VersionInfoVersion=3.4.7.0
+VersionInfoVersion=3.4.8.0
 
 ; dialog support
 LicenseFile=..\license

diff --git a/install/install.iss b/install/install.iss
@@ -3,11 +3,11 @@
 ; AppID can never be changed as subsequent installations require the same installation ID each time
 AppID=FHIRServer
 AppName=Health Intersections FHIR Server
-AppVerName=FHIRServer v3.4.7
+AppVerName=FHIRServer v3.4.8
 
 ; compilation control
 OutputDir=..\install\build
-OutputBaseFilename=fhirserver-win64-3.4.7
+OutputBaseFilename=fhirserver-win64-3.4.8
 Compression=lzma2/ultra64
 
 ; 64 bit
@@ -34,11 +34,11 @@ UninstallFilesDir={app}\uninstall
 ; win2000+ add/remove programs support
 AppPublisher=Health Intersections P/L
 AppPublisherURL=http://www.healthintersections.com.au
-AppVersion=3.4.7
+AppVersion=3.4.8
 AppSupportURL=https://github.com/grahamegrieve/fhirserver
 AppUpdatesURL=https://github.com/grahamegrieve/fhirserver
 AppCopyright=Copyright (c) Health Intersections Pty Ltd 2011+
-VersionInfoVersion=3.4.7.0
+VersionInfoVersion=3.4.8.0
 
 ; dialog support
 LicenseFile=..\license

diff --git a/library/fhir/fhir_common.pas b/library/fhir/fhir_common.pas
@@ -270,6 +270,7 @@   TFHIRXVersionResourceWrapper = class (TFHIRObject)
     property language : String read GetLanguage write SetLanguage;
 
     function AsJson : String; override;
+    function SourcePackage : String;
 
     // extensions:
     function hasExtension(url : String) : boolean; override;
@@ -1551,6 +1552,7 @@   TFHIRResourceProxyV = class abstract (TFslObject)
     FFhirObjectVersion : TFHIRVersion;
     FFhirType : String;
     FId  : String;
+    FPackageId: String;
     FSupplements: String;
     FUrl : String;
     FVersion : String;
@@ -1564,11 +1566,12 @@   TFHIRResourceProxyV = class abstract (TFslObject)
     function wrapResource : TFHIRXVersionResourceWrapper; virtual; abstract;
     procedure SetResourceV(value : TFHIRResourceV);
   public
-    constructor Create(fhirObjectVersion : TFHIRVersion; fhirType, id : String; url, version, supplements, content, valueSet : String); overload;
-    constructor Create(resource : TFHIRResourceV; url, version : String); overload;
+    constructor Create(packageId : String; fhirObjectVersion : TFHIRVersion; fhirType, id : String; url, version, supplements, content, valueSet : String); overload;
+    constructor Create(packageId : String; resource : TFHIRResourceV; url, version : String); overload;
     destructor Destroy; override;
     function link : TFHIRResourceProxyV; overload;
 
+    property packageId : String read FPackageId;
     property fhirObjectVersion : TFHIRVersion read FFhirObjectVersion;
     property fhirType : String read FFhirType;
     property id  : String read FId write FId;
@@ -1589,7 +1592,7 @@   TFHIRResourceProxyW = class (TFHIRResourceProxyV)
     procedure loadResource; override;
     function wrapResource : TFHIRXVersionResourceWrapper; override;
   public
-    constructor Create(resource : TFHIRXVersionResourceWrapper; url, version : String); overload;
+    constructor Create(packageId : String; resource : TFHIRXVersionResourceWrapper; url, version : String); overload;
   end;
 
   TFHIRMetadataResourceManagerW<T : TFHIRMetadataResourceW> = class (TFslObject)
@@ -1691,9 +1694,9 @@ function TFHIRResourceProxyW.wrapResource: TFHIRXVersionResourceWrapper;
 
 end;
 
-constructor TFHIRResourceProxyW.Create(resource: TFHIRXVersionResourceWrapper; url, version: String);
+constructor TFHIRResourceProxyW.Create(packageId : String; resource: TFHIRXVersionResourceWrapper; url, version: String);
 begin
-  inherited create(resource.Resource.link, url, version);
+  inherited create(packageId, resource.Resource.link, url, version);
   FResourceW := resource.link;
 end;
 
@@ -1774,6 +1777,11 @@ function TFHIRXVersionResourceWrapper.AsJson: String;
   Result := FRes.asJson;
 end;
 
+function TFHIRXVersionResourceWrapper.SourcePackage: String;
+begin
+  result := FRes.SourcePackage;
+end;
+
 function TFHIRXVersionResourceWrapper.hasExtension(url: String): boolean;
 begin
   Result:= FRes.hasExtension(url);
@@ -3155,9 +3163,10 @@ procedure TFhirIdentifierW.SetType(const Value: TFhirCodeableConceptW);
 
 { TFHIRResourceProxyV }
 
-constructor TFHIRResourceProxyV.Create(fhirObjectVersion : TFHIRVersion; fhirType, id : String; url, version, supplements, content, valueSet : String);
+constructor TFHIRResourceProxyV.Create(packageId : String; fhirObjectVersion : TFHIRVersion; fhirType, id : String; url, version, supplements, content, valueSet : String);
 begin
   inherited Create;
+  FPackageId := packageId;
   FFhirObjectVersion := fhirObjectVersion;
   FFhirType := fhirType;
   FId := id;
@@ -3168,9 +3177,10 @@ constructor TFHIRResourceProxyV.Create(fhirObjectVersion : TFHIRVersion; fhirTyp
   FValueSet := valueSet;
 end;
 
-constructor TFHIRResourceProxyV.Create(resource : TFHIRResourceV; url, version : String);
+constructor TFHIRResourceProxyV.Create(packageId : String; resource : TFHIRResourceV; url, version : String);
 begin
   inherited Create;
+  FPackageId := packageId;
   FFhirObjectVersion := resource.fhirObjectVersion;
   FFhirType := resource.fhirType;
   FId := resource.id;

diff --git a/library/fhir/fhir_context.pas b/library/fhir/fhir_context.pas
@@ -81,7 +81,7 @@    TFHIRContextLoaderEngine = class (TBackgroundTaskEngine)
      procedure doNpmWork(sender : TObject; pct : integer; done : boolean; desc : String);
      procedure loadPackage(context : TFHIRWorkerContextWithFactory; id : String; user, ignoreEmptyCodeSystems : boolean);
      procedure doProgress(state : String; c, t : integer);
-     procedure loadResource(context : TFHIRWorkerContextWithFactory; res: TFHIRResourceV; ignoreEmptyCodeSystems: boolean);
+     procedure loadResource(packageId : String; context : TFHIRWorkerContextWithFactory; res: TFHIRResourceV; ignoreEmptyCodeSystems: boolean);
    protected
      function canCancel : boolean; override;
    public
@@ -173,7 +173,7 @@ procedure TFHIRContextLoaderEngine.execute(request: TBackgroundTaskRequestPackag
   end;
 end;
 
-procedure TFHIRContextLoaderEngine.loadResource(context : TFHIRWorkerContextWithFactory; res : TFHIRResourceV; ignoreEmptyCodeSystems : boolean);
+procedure TFHIRContextLoaderEngine.loadResource(packageId : String; context : TFHIRWorkerContextWithFactory; res : TFHIRResourceV; ignoreEmptyCodeSystems : boolean);
 var
   cs : TFhirCodeSystemW;
 begin
@@ -182,13 +182,13 @@ procedure TFHIRContextLoaderEngine.loadResource(context : TFHIRWorkerContextWith
     cs := context.factory.wrapCodeSystem(res.link);
     try
       if (not ignoreEmptyCodeSystems or (cs.content in [cscmFragment, cscmComplete, cscmSupplement])) then
-        context.seeResource(res);
+        context.seeResource(packageId, res);
     finally
       cs.free;
     end;
   end
   else
-    context.seeResource(res);
+    context.seeResource(packageId, res);
 end;
 
 procedure TFHIRContextLoaderEngine.doNpmWork(sender: TObject; pct: integer; done: boolean; desc: String);
@@ -230,7 +230,7 @@ procedure TFHIRContextLoaderEngine.loadPackage(context : TFHIRWorkerContextWithF
         end;
         try
           try
-            loadResource(context, res, ignoreEmptyCodeSystems);
+            loadResource(npm.name+'#'+npm.version, context, res, ignoreEmptyCodeSystems);
           except
             on e : Exception do
               raise EFHIRException.Create('Error Loading '+s+': '+e.Message);

diff --git a/library/fhir/fhir_factory.pas b/library/fhir/fhir_factory.pas
@@ -195,8 +195,8 @@   TFHIRFactory = class abstract (TFslObject)
     function makeTerminologyCapablities : TFhirTerminologyCapabilitiesW; virtual; abstract;
     function makeIssue(level : TIssueSeverity; issue: TFhirIssueType; location, message: String) : TFhirOperationOutcomeIssueW; virtual; abstract;
 
-    function makeProxy(pi : TNpmPackageResource; worker : TFHIRWorkerContextV; lock : TFslLock) : TFHIRResourceProxyV; overload; virtual; abstract;
-    function makeProxy(presource : TFHIRResourceV) : TFHIRResourceProxyV; overload; virtual; abstract;
+    function makeProxy(packageId : String; pi : TNpmPackageResource; worker : TFHIRWorkerContextV; lock : TFslLock) : TFHIRResourceProxyV; overload; virtual; abstract;
+    function makeProxy(packageId : String; presource : TFHIRResourceV) : TFHIRResourceProxyV; overload; virtual; abstract;
 
     function wrapResource(r : TFHIRResourceV) : TFHIRXVersionResourceWrapper; virtual;
     function wrapCapabilityStatement(r : TFHIRResourceV) : TFHIRCapabilityStatementW; virtual; abstract;
@@ -281,8 +281,8 @@   TFHIRWorkerContextWithFactory = class (TFHIRWorkerContextV)
     property pcm : TFHIRPackageManager read FPcm;
     property LoadInfo : TPackageLoadingInformation read FLoadInfo;
 
-    procedure loadResourceJson(rType, id : String; json : TStream); override;
-    procedure seeResource(res : TFHIRResourceV); overload; virtual; abstract;
+    procedure loadResourceJson(packageId : String; rType, id : String; json : TStream); override;
+    procedure seeResource(packageId : String; res : TFHIRResourceV); overload; virtual; abstract;
     procedure seeResource(res : TFHIRResourceProxyV); overload; virtual; abstract;
     procedure dropResource(rtpe, id : String); overload; virtual; abstract;
     procedure LoadCodeSystem(r : TFhirResourceProxyV); virtual; abstract;
@@ -361,8 +361,8 @@   TFHIRFactoryX = class (TFHIRFactory)
     function makeParameters : TFHIRParametersW; override;
     function makeTerminologyCapablities : TFhirTerminologyCapabilitiesW; override;
     function makeIssue(level : TIssueSeverity; issue: TFhirIssueType; location, message: String) : TFhirOperationOutcomeIssueW; override;
-    function makeProxy(pi : TNpmPackageResource; worker : TFHIRWorkerContextV; lock : TFslLock) : TFHIRResourceProxyV; overload; override;
-    function makeProxy(presource : TFHIRResourceV) : TFHIRResourceProxyV; overload; override;
+    function makeProxy(packageId : String; pi : TNpmPackageResource; worker : TFHIRWorkerContextV; lock : TFslLock) : TFHIRResourceProxyV; overload; override;
+    function makeProxy(packageId : String; presource : TFHIRResourceV) : TFHIRResourceProxyV; overload; override;
     function wrapResource(r : TFHIRResourceV) : TFHIRXVersionResourceWrapper; virtual;
     function wrapCapabilityStatement(r : TFHIRResourceV) : TFHIRCapabilityStatementW; override;
     function wrapStructureDefinition(r : TFHIRResourceV) : TFhirStructureDefinitionW; override;
@@ -796,12 +796,12 @@ function TFHIRFactoryX.makeIssue(level: TIssueSeverity; issue: TFhirIssueType; l
   raise EFslException.Create('makeIssue is not implemented in the non-versioned FHIRFactory');
 end;
 
-function TFHIRFactoryX.makeProxy(pi: TNpmPackageResource; worker: TFHIRWorkerContextV; lock: TFslLock): TFHIRResourceProxyV;
+function TFHIRFactoryX.makeProxy(packageId : String; pi: TNpmPackageResource; worker: TFHIRWorkerContextV; lock: TFslLock): TFHIRResourceProxyV;
 begin
   raise EFslException.Create('makeProxy is not implemented in the non-versioned FHIRFactory');
 end;
 
-function TFHIRFactoryX.makeProxy(presource: TFHIRResourceV): TFHIRResourceProxyV;
+function TFHIRFactoryX.makeProxy(packageId : String; presource: TFHIRResourceV): TFHIRResourceProxyV;
 begin
   raise EFslException.Create('makeProxy is not implemented in the non-versioned FHIRFactory');
 end;
@@ -1237,7 +1237,7 @@ procedure TFHIRWorkerContextWithFactory.LoadingFinished;
   // nothing here
 end;
 
-procedure TFHIRWorkerContextWithFactory.loadResourceJson(rType, id: String;
+procedure TFHIRWorkerContextWithFactory.loadResourceJson(packageId : String; rType, id: String;
   json: TStream);
 var
   p : TFHIRParser;
@@ -1246,7 +1246,8 @@ procedure TFHIRWorkerContextWithFactory.loadResourceJson(rType, id: String;
   try
     p.source := json;
     p.Parse;
-    SeeResource(p.resource);
+    p.resource.SourcePackage := packageId;
+    SeeResource(packageId, p.resource);
   finally
     p.free;
   end;

diff --git a/library/fhir/fhir_objects.pas b/library/fhir/fhir_objects.pas
@@ -594,6 +594,8 @@   TFHIRObjectList = class (TFslObjectList)
   end;
 
   TFHIRResourceV = class (TFHIRObject)
+  private
+    FSourcePackage : String;
   protected
     function GetProfileVersion: TFHIRVersion; virtual;
     procedure SetProfileVersion(Value: TFHIRVersion); virtual;
@@ -606,6 +608,7 @@   TFHIRResourceV = class (TFHIRObject)
     procedure checkNoImplicitRules(place, role : String); virtual; abstract;
 
     property profileVersion : TFHIRVersion read GetProfileVersion write SetProfileVersion;
+    property SourcePackage : String read FSourcePackage write FSourcePackage;
   end;
 
   { TFHIRWorkerContextV }
@@ -628,7 +631,7 @@   TFHIRWorkerContextV = class (TFslObject)
     property Packages : TStringList read FPackages;
 
     Property LangList : THTTPLanguageList read FLangList write SetLangList;
-    procedure loadResourceJson(rtype, id : String; json : TStream); virtual; abstract;
+    procedure loadResourceJson(packageId : String; rtype, id : String; json : TStream); virtual; abstract;
     Property version : TFHIRVersion read GetVersion;
     function versionString : String;
     function oid2Uri(oid : String) : String; virtual; abstract;