Add supplement support for LOINC

library/ftx/fhir_valuesets.pas

@@ -1073,7 +1073,6 @@ function TValueSetChecker.check(path, system, version, code: String; abstractOk,
     end
     else
     begin
-      // todo: we can never get here?
       if (system = '') and inferSystem then
       begin
         system := determineSystem(FOpContext, code);

library/ftx/ftx_loinc_services.pas

@@ -181,14 +181,18 @@   TLOINCServices = class (TCodeSystemProvider)
     FRelationships : TDictionary<String, String>;
     FProperties : TDictionary<String, String>;
     FStatusKeys : TDictionary<String, String>;
+    FSupplements : TFslList<TFhirCodeSystemW>;
     function commaListOfCodes(source: String): String;
+    procedure addSupplementDisplays(displays : TFslList<TLoincDisplay>; code : String);
     function filterBySQL(opContext : TTxOperationContext; c : TFDBConnection; d, sql, lsql : String; forExpansion : boolean) : TCodeSystemProviderFilterContext;
   protected
     function sizeInBytesV(magic : integer) : cardinal; override;
   public
     constructor Create(languages : TIETFLanguageDefinitions; i18n : TI18nSupport);
+    constructor CreateInternal;
     destructor Destroy; Override;
     Function Link : TLOINCServices; Overload;
+    function cloneWithSupplements(supplements : TFslList<TFhirCodeSystemW>) : TCodeSystemProvider; override;
 
     Procedure Load(Const sFilename : String);
     class function checkFile(Const sFilename : String) : String;
@@ -325,16 +329,25 @@ constructor TLOINCServices.Create(languages : TIETFLanguageDefinitions; i18n : T
   FLock := TFslLock.create('LOINC');
 end;
 
-destructor TLOINCServices.Destroy;
+constructor TLOINCServices.CreateInternal;
 begin
-  FRelationships.free;
-  FProperties.free;
-  FStatusKeys.free;
+  inherited Create;
+end;
 
-  FCodeList.free;
-  FCodes.free;
-  FLangs.free;
-  FLock.free;
+destructor TLOINCServices.Destroy;
+begin
+  if FSupplements = nil then // only the root owns these
+  begin
+    FRelationships.free;
+    FProperties.free;
+    FStatusKeys.free;
+    FCodeList.free;
+    FCodes.free;
+    FLangs.free;
+    FLock.free;
+  end
+  else
+    FSupplements.free;
   inherited;
 end;
 
@@ -343,6 +356,34 @@ function TLOINCServices.Link: TLOINCServices;
   result := TLOINCServices(inherited Link);
 end;
 
+function TLOINCServices.cloneWithSupplements(supplements: TFslList<TFhirCodeSystemW>): TCodeSystemProvider;
+var
+  r : TLOINCServices;
+begin
+  r := TLOINCServices.createInternal;
+  try
+    r.FLangs := FLangs;
+    r.FCodes := FCodes;
+    r.FCodeList := FCodeList;
+    r.FRelationships := FRelationships;
+    r.FProperties := FProperties;
+    r.FStatusKeys := FStatusKeys;
+    r.FLock := FLock;
+
+    r.FSupplements := TFslList<TFhirCodeSystemW>.create;
+    r.FSupplements.AddAll(supplements);
+
+    r.FDB := FDB;
+    r.FVersion := FVersion;
+    r.FRoot := FRoot;
+    r.FFirstCodeKey := FFirstCodeKey;
+
+    result := r.link;
+  finally
+    r.free;
+  end;
+end;
+
 procedure TLOINCServices.defineFeatures(opContext : TTxOperationContext; features: TFslList<TFHIRFeature>);
 begin
   features.Add(TFHIRFeature.fromString('rest.Codesystem:'+systemUri+'.filter', 'SCALE_TYP:equals'));
@@ -793,6 +834,9 @@ function TLOINCServices.Display(opContext : TTxOperationContext; context: TCodeS
           raise;
         end;
       end;
+      if FSupplements <> nil then
+        addSupplementDisplays(displays, (context as TLoincProviderContext).Code);
+
       // now we have them all - iterate looking for a match
       for ll in langList.langs do
         for disp in displays do
@@ -1063,6 +1107,32 @@ function TLOINCServices.commaListOfCodes(source : String) : String;
         CommaAdd(result, ''''+sqlWrapString(s)+'''')
 end;
 
+procedure TLOINCServices.addSupplementDisplays(displays: TFslList<TLoincDisplay>; code: String);
+var
+  cs : TFhirCodeSystemW;
+  def : TFhirCodeSystemConceptW;
+  dsg: TFhirCodeSystemConceptDesignationW;
+begin
+  for cs in FSupplements do
+  begin
+    def := cs.getCode(code);
+    if (def <> nil) then
+    begin
+      try
+        if (def.display <> '') then
+          displays.Add(TLoincDisplay.create(cs.language, def.display));
+        for dsg in def.designations.forEnum do
+          if dsg.language <> '' then
+            displays.Add(TLoincDisplay.create(dsg.language, dsg.value))
+          else
+            displays.Add(TLoincDisplay.create(cs.language, dsg.value));
+      finally
+        def.free;
+      end;
+    end;
+  end;
+end;
+
 function TLOINCServices.filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop: String; op: TFhirFilterOperator; value: String; prep: TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext;
 var
   c : TFDBConnection;