check for modifier extensions more thoroughly

Author: Grahame Grieve

library/fhir/fhir_common.pas

@@ -65,6 +65,7 @@ interface
 
 const
   CODES_TFhirFilterOperator: Array[TFilterOperator] of String = ('', '=', 'is-a', 'descendent-of', 'is-not-a', 'regex', 'in', 'not-in', 'generalizes', 'exists', 'child-of', 'descendent-leaf', 'of');
+  CODES_TFhirFilterOperatorVCL: Array[TFilterOperator] of String = ('', '=', '<<', '<', '~<<', '/', '^', '~^', '>>', '?', '<!', '!!<', '.');
   CODES_TPublicationStatus: Array[TPublicationStatus] of String = ('', 'draft', 'active', 'retired');
   CODES_TTokenCategory : array [TTokenCategory] of String = ('Clinical', 'Data', 'Meds', 'Schedule', 'Audit', 'Documents', 'Financial', 'MedicationDefinitions', 'Other');
   CODES_TOpIssueCode : array [TOpIssueCode] of String = ('', 'not-in-vs', 'this-code-not-in-vs', 'invalid-code', 'code-comment', 'invalid-display', 'display-comment', 'not-found', 'code-rule', 'vs-invalid', 'cannot-infer', 'status-check', 'invalid-data', 'process-note', 'version-error');

library/fhir/fhir_tx.pas

@@ -43,7 +43,7 @@   TTerminologyOperationContext = class (TTxOperationContext)
     procedure clearContexts;
 
     procedure log(note : String); override;
-    procedure addNote(vs : TFHIRValueSetW; note : String);
+    procedure addNote(vs : TFHIRValueSetW; note : String; indentCount : integer);
     function diagnostics : String;
     property OnGetCurrentRequestCount : TGetCurrentRequestCountEvent read FOnGetCurrentRequestCount write FOnGetCurrentRequestCount;
 
@@ -53,6 +53,7 @@   TTerminologyOperationContext = class (TTxOperationContext)
     class function renderCoded(system, version, code, display : String) : String; overload;
     class function renderCoded(code : TFhirCodingW) : String; overload;
     class function renderCoded(code : TFhirCodeableConceptW) : String; overload;
+    class function renderInclude(inc : TFhirValueSetComposeIncludeW) : String; overload;
   end;
 
   { TFHIRCachedMetadataResource }
@@ -244,6 +245,7 @@   TFHIRTxOperationParams = class (TFslObject)
 
   TTerminologyWorker = class (TFslObject)
   protected
+    FIndentCount : integer;
     FOpContext : TTerminologyOperationContext;
     FFactory : TFHIRFactory;
     FOnGetCSProvider : TGetProviderEvent;
@@ -313,7 +315,6 @@ constructor TTerminologyOperationContext.Create(i18n: TI18nSupport; id : String;
     FTimeTracker := TFslTimeTracker.create
   else
     FTimeTracker := tt;
-  FTimeTracker.step('tx-op');
 end;
 
 destructor TTerminologyOperationContext.Destroy;
@@ -387,11 +388,12 @@ procedure TTerminologyOperationContext.log(note: String);
   FTimeTracker.step(s);
 end;
 
-procedure TTerminologyOperationContext.addNote(vs : TFHIRValueSetW; note : String);
+procedure TTerminologyOperationContext.addNote(vs : TFHIRValueSetW; note : String; indentCount : integer);
 var
   s : string;
 begin
-  s := inttostr(GetTickCount64 - FStartTime)+'ms '+vs.vurl+': '+note;
+  s := StringPadRight(inttostr(GetTickCount64 - FStartTime)+'ms', ' ', 4)+' '+
+     StringPadLeft('', ' ', indentCount*2)+'#'+inttostr(SerialNumber)+': '+note;
   //if UnderDebugger then
   //  Logging.log(s);
   FTimeTracker.step(s);
@@ -442,6 +444,62 @@ class function TTerminologyOperationContext.renderCoded(code: TFhirCodeableConce
   result := '['+result+']';
 end;
 
+class function TTerminologyOperationContext.renderInclude(inc: TFhirValueSetComposeIncludeW): String;
+var
+  first : boolean;
+  cc : TFhirValueSetComposeIncludeConceptW;
+  ci : TFhirValueSetComposeIncludeFilterW;
+  s : String;
+begin
+  if inc.systemUri <> '' then
+  begin
+    result := '('+inc.systemUri+')';
+    if inc.hasConcepts then
+    begin
+      result := result + '(';
+      first := true;
+      for cc in inc.concepts.forEnum do
+      begin
+        if first then
+          first := false
+        else
+          result := result + ',';
+        result := result + cc.code;
+      end;
+      result := result+')';
+    end;
+    if (inc.hasFilters) then
+    begin
+      result := result + '(';
+      first := true;
+      for ci in inc.filters.forEnum do
+      begin
+        if first then
+          first := false
+        else
+          result := result + ',';
+        result := result + ci.prop+CODES_TFhirFilterOperatorVCL[ci.op]+ci.value;
+      end;
+      result := result+')';
+    end;
+  end
+  else
+  begin
+    result := '';
+      result := result + '(';
+      first := true;
+      for s in inc.valueSets do
+      begin
+        if first then
+          first := false
+        else
+          result := result + ',';
+        result := result + '^'+s;
+      end;
+      result := result+')';
+  end;
+end;
+
 { TFHIRCachedMetadataResource }
 
 procedure TFHIRCachedMetadataResource.SetLoadedCS(AValue: TFHIRCodeSystemEntry);
@@ -773,7 +831,7 @@ procedure TTerminologyWorker.deadCheck(place: String);
   SetThreadStatus(ClassName+'.'+place);
   if FOpContext.deadCheck(time) then
   begin
-    FOpContext.addNote(vsHandle, 'Operation took too long @ '+place+' ('+className+')');
+    FOpContext.addNote(vsHandle, 'Operation took too long @ '+place+' ('+className+')', FIndentCount);
     Logging.log('Operation took too long @ '+place+' ('+className+')');
     raise costDiags(ETooCostly.create(FI18n.translate('VALUESET_TOO_COSTLY_TIME', FParams.HTTPlanguages, ['??', inttostr(time), opName])));
   end;
@@ -1306,7 +1364,7 @@ function TFhirExpansionParamsVersionRule.link: TFhirExpansionParamsVersionRule;
 
 function TFhirExpansionParamsVersionRule.asString: String;
 begin
-  result := Fsystem+'#'+Fversion+'/'+inttostr(ord(FMode));
+  result := NAMES_TFhirExpansionParamsVersionRuleMode[FMode]+':'+Fsystem+'#'+Fversion;
 end;
 
 function TFhirExpansionParamsVersionRule.asParam: String;

library/fhir3/fhir3_factory.pas

@@ -221,6 +221,10 @@ procedure TFHIRFactoryR3.checkNoModifiers(res: TFHIRObject; method, param: strin
     TFHIRDomainResource(res).checkNoModifiers(method, param)
   else if res is TFHIRBackboneElement then
     TFHIRBackboneElement(res).checkNoModifiers(method, param)
+  else if res is TFHIRXVersionElementWrapper then 
+    checkNoModifiers((res as TFHIRXVersionElementWrapper).Element, method, param, allowed) 
+  else if res is TFHIRXVersionResourceWrapper then 
+    checkNoModifiers((res as TFHIRXVersionResourceWrapper).Resource, method, param, allowed) 
 end;
 
 function TFHIRFactoryR3.corePackage: String;

library/fhir4/fhir4_factory.pas

@@ -225,6 +225,10 @@ procedure TFHIRFactoryR4.checkNoModifiers(res: TFHIRObject; method, param: strin
     TFHIRDomainResource(res).checkNoModifiers(method, param)
   else if res is TFHIRBackboneElement then
     TFHIRBackboneElement(res).checkNoModifiers(method, param)
+  else if res is TFHIRXVersionElementWrapper then
+    checkNoModifiers((res as TFHIRXVersionElementWrapper).Element, method, param, allowed)
+  else if res is TFHIRXVersionResourceWrapper then
+    checkNoModifiers((res as TFHIRXVersionResourceWrapper).Resource, method, param, allowed)
 end;
 
 function TFHIRFactoryR4.corePackage: String;

library/fhir4b/fhir4b_factory.pas

@@ -223,6 +223,10 @@ procedure TFHIRFactoryR4B.checkNoModifiers(res: TFHIRObject; method,
     TFHIRDomainResource(res).checkNoModifiers(method, param)
   else if res is TFHIRBackboneElement then
     TFHIRBackboneElement(res).checkNoModifiers(method, param)
+  else if res is TFHIRXVersionElementWrapper then 
+    checkNoModifiers((res as TFHIRXVersionElementWrapper).Element, method, param, allowed) 
+  else if res is TFHIRXVersionResourceWrapper then 
+    checkNoModifiers((res as TFHIRXVersionResourceWrapper).Resource, method, param, allowed) 
 end;
 
 function TFHIRFactoryR4B.corePackage: String;

library/fhir5/fhir5_factory.pas

@@ -225,6 +225,10 @@ procedure TFHIRFactoryR5.checkNoModifiers(res: TFHIRObject; method, param: strin
     TFHIRDomainResource(res).checkNoModifiers(method, param)
   else if res is TFHIRBackboneElement then
     TFHIRBackboneElement(res).checkNoModifiers(method, param)
+  else if res is TFHIRXVersionElementWrapper then 
+    checkNoModifiers((res as TFHIRXVersionElementWrapper).Element, method, param, allowed) 
+  else if res is TFHIRXVersionResourceWrapper then 
+    checkNoModifiers((res as TFHIRXVersionResourceWrapper).Resource, method, param, allowed) 
 end;
 
 function TFHIRFactoryR5.corePackage: String;