update for new language / display test cases

exec/pack/Messages_pt-BR.properties

@@ -0,0 +1 @@
+# InstanceValidator = one,other

library/fhir/fhir_common.pas

@@ -61,13 +61,13 @@ interface
   TObservationStatus = (obssNull, obssRegistered, obssPreliminary, obssFinal, obssAmended, obssCorrected, obssCancelled, obssEnteredInError, obssUnknown);
   TTokenCategory = (tcClinical, tcData, tcMeds, tcSchedule, tcAudit, tcDocuments, tcFinancial, tcMedicationDefinition, tcOther);
   TIdentifierUse = (iuNull, iuUsual, iuOfficial, iuTemp, iuSecondary, iuOld);
-  TOpIssueCode = (oicVoid, oicNotInVS, oicThisNotInVS, oicInvalidCode, oicDisplay, oicNotFound, oicCodeRule, oicVSProcessing, oicInferFailed, oicStatusCheck, oicInvalidData, oicProcessingNote);
+  TOpIssueCode = (oicVoid, oicNotInVS, oicThisNotInVS, oicInvalidCode, oicDisplay, oicDisplayComment, oicNotFound, oicCodeRule, oicVSProcessing, oicInferFailed, oicStatusCheck, oicInvalidData, oicProcessingNote);
 
 const
   CODES_TFhirFilterOperator: Array[TFilterOperator] of String = ('', '=', 'is-a', 'descendent-of', 'is-not-a', 'regex', 'in', 'not-in', 'generalizes', 'exists', 'child-of', 'descendent-leaf');
   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', 'invalid-display', 'not-found', 'code-rule', 'vs-invalid', 'cannot-infer', 'status-check', 'invalid-data', 'process-note');
+  CODES_TOpIssueCode : array [TOpIssueCode] of String = ('', 'not-in-vs', 'this-code-not-in-vs', 'invalid-code', 'invalid-display', 'display-comment', 'not-found', 'code-rule', 'vs-invalid', 'cannot-infer', 'status-check', 'invalid-data', 'process-note');
 
 type
   EFHIROperationException = class (EFslException)
@@ -853,6 +853,7 @@   TFhirCodeSystemW = class (TFHIRMetadataResourceW)
     function getChildren(c : TFhirCodeSystemConceptW) : TFhirCodeSystemConceptListW; virtual; abstract;
 
     function buildImplicitValueSet : TFHIRValueSetW; virtual; abstract;
+    function hasAnyDisplays(langs : THTTPLanguageList) : boolean; virtual; abstract;
   end;
 
   { TFhirValueSetExpansionContainsPropertyW }

library/fhir/fhir_tx.pas

@@ -97,7 +97,8 @@   TFHIRTxOperationParams = class (TFslObject)
     FIncompleteOK: boolean;
     FProperties : TStringList;
     FDisplayWarning : boolean;
-    FLanguages : THTTPLanguageList;
+    FHTTPLanguages : THTTPLanguageList;
+    FDisplayLanguages : THTTPLanguageList;
     FDesignations : TStringList;
     FDiagnostics : boolean;
 
@@ -118,8 +119,10 @@   TFHIRTxOperationParams = class (TFslObject)
     FAltCodeRules : TAlternateCodeOptions;
 
     function GetHasDesignations: boolean;
-    function GetHasLanguages: boolean;
-    procedure SetLanguages(value : THTTPLanguageList);
+    function GetHasHTTPLanguages: boolean;
+    function GetHasDisplayLanguages: boolean;
+    procedure SetHTTPLanguages(value : THTTPLanguageList);
+    procedure SetDisplayLanguages(value : THTTPLanguageList);
     procedure SetActiveOnly(value : boolean);
     procedure SetExcludeNested(value : boolean);
     procedure SetGenerateNarrative(value : boolean);
@@ -149,7 +152,9 @@   TFHIRTxOperationParams = class (TFslObject)
     procedure seeVersionRule(url : String; mode : TFhirExpansionParamsVersionRuleMode);
 
     property activeOnly : boolean read FactiveOnly write SetActiveOnly;
-    property languages : THTTPLanguageList read FLanguages write SetLanguages;
+    property HTTPLanguages : THTTPLanguageList read FHTTPLanguages write SetHTTPLanguages;
+    property DisplayLanguages : THTTPLanguageList read FDisplayLanguages write SetDisplayLanguages;
+    function workingLanguages : THTTPLanguageList;
     function langSummary : String;
     property includeDefinition : boolean read FincludeDefinition write SetincludeDefinition;
     property generateNarrative : boolean read FGenerateNarrative write SetGenerateNarrative;
@@ -181,7 +186,8 @@   TFHIRTxOperationParams = class (TFslObject)
     property hasDefaultToLatestVersion : boolean read FHasDefaultToLatestVersion;
     property hasIncompleteOK : boolean read FHasIncompleteOK;
     property hasDisplayWarning : boolean read FHasDisplayWarning;
-    property hasLanguages : boolean read GetHasLanguages;
+    property hasHTTPLanguages : boolean read GetHasHTTPLanguages;
+    property hasDisplayLanguages : boolean read GetHasDisplayLanguages;
     property hasDesignations : boolean read GetHasDesignations;
 
     function summary : string;
@@ -521,7 +527,7 @@ procedure TTerminologyWorker.deadCheck(place: String);
   if FOpContext.deadCheck(time) then
   begin
     logging.log('Operation took too long ('+className+')');
-    raise ETooCostly.create(FI18n.translate('VALUESET_TOO_COSTLY_TIME', FParams.languages, ['??', inttostr(time)]));
+    raise ETooCostly.create(FI18n.translate('VALUESET_TOO_COSTLY_TIME', FParams.HTTPlanguages, ['??', inttostr(time)]));
   end;
 end;
 
@@ -654,15 +660,26 @@ constructor TFHIRTxOperationParams.Create;
   FGenerateNarrative := true;
 end;
 
-procedure TFHIRTxOperationParams.SetLanguages(value: THTTPLanguageList);
+procedure TFHIRTxOperationParams.SetHTTPLanguages(value: THTTPLanguageList);
 begin
-  FLanguages.free;
-  FLanguages := value;
+  FHTTPLanguages.free;
+  FHTTPLanguages := value;
+end;
+
+procedure TFHIRTxOperationParams.SetDisplayLanguages(value: THTTPLanguageList);
+begin
+  FDisplayLanguages.free;
+  FDisplayLanguages := value;
+end;
+
+function TFHIRTxOperationParams.GetHasHTTPLanguages: boolean;
+begin
+  result := (FHTTPLanguages <> nil) and (FHTTPLanguages.source <> '');
 end;
 
-function TFHIRTxOperationParams.GetHasLanguages: boolean;
+function TFHIRTxOperationParams.GetHasDisplayLanguages: boolean;
 begin
-  result := (FLanguages <> nil) and (FLanguages.source <> '');
+  result := (FDisplayLanguages <> nil) and (FDisplayLanguages.source <> '');
 end;
 
 function TFHIRTxOperationParams.GetHasDesignations: boolean;
@@ -746,7 +763,8 @@ function TFHIRTxOperationParams.sizeInBytesV(magic : integer) : cardinal;
 begin
   result := inherited sizeInBytesV(magic);
   inc(result, FVersionRules.sizeInBytes(magic));
-  inc(result, FLanguages.sizeInBytes(magic));
+  inc(result, FHTTPLanguages.sizeInBytes(magic));
+  inc(result, FDisplayLanguages.sizeInBytes(magic));
   inc(result, (FUid.length * sizeof(char)) + 12);
 end;
 
@@ -759,8 +777,8 @@ procedure TFHIRTxOperationParams.seeParameter(name: String; value: TFHIRObject;
 begin
   if (value <> nil) then
   begin
-    if (name = 'displayLanguage') and (not HasLanguages or overwrite) then
-      languages := THTTPLanguageList.create(value.primitiveValue, not isValidation);
+    if (name = 'displayLanguage') and (not HasHTTPLanguages or overwrite) then
+      DisplayLanguages := THTTPLanguageList.create(value.primitiveValue, not isValidation);
 
     if (name = 'includeAlternateCodes') then
       altCodeRules.seeParam(value.primitiveValue);
@@ -790,12 +808,22 @@ procedure TFHIRTxOperationParams.seeVersionRule(url: String; mode: TFhirExpansio
     raise ETerminologyError.Create('Unable to understand '+CODES_TFhirExpansionParamsVersionRuleMode[mode]+' system version "'+url+'"', itInvalid);
 end;
 
+function TFHIRTxOperationParams.workingLanguages: THTTPLanguageList;
+begin
+  if FDisplayLanguages <> nil then
+    result := FDisplayLanguages
+  else
+    result := FHTTPLanguages;
+end;
+
 function TFHIRTxOperationParams.langSummary: String;
 begin
-  if (FLanguages = nil) or (FLanguages.source = '') then
-    result := '--'
+  if (FDisplayLanguages <> nil) and (FDisplayLanguages.source <> '') then
+    result := FDisplayLanguages.asString(false)
+  else if (FHTTPLanguages <> nil) and (FHTTPLanguages.source <> '') then
+    result := FHTTPLanguages.asString(false)
   else
-    result := FLanguages.asString(false);
+    result := '--'
 end;
 
 function TFHIRTxOperationParams.summary: string;
@@ -814,8 +842,10 @@ function TFHIRTxOperationParams.summary: string;
   s('uid', FUid);
   if (FProperties <> nil) then
     s('properties', FProperties.commaText);
-  if (FLanguages <> nil) then
-    s('lang' , FLanguages.asString(true));
+  if (FHTTPLanguages <> nil) then
+    s('http-lang' , FHTTPLanguages.asString(true));
+  if (FDisplayLanguages <> nil) then
+    s('disp-lang' , FDisplayLanguages.asString(true));
   if (FDesignations <> nil) then
     s('designations', FDesignations.commaText);
   b('active-only', FactiveOnly);
@@ -845,7 +875,8 @@ destructor TFHIRTxOperationParams.Destroy;
 begin
   FAltCodeRules.free;
   FVersionRules.free;
-  FLanguages.free;
+  FHTTPLanguages.free;
+  FDisplayLanguages.free;
   FProperties.free;
   FDesignations.free;
   inherited;
@@ -870,8 +901,10 @@ function TFHIRTxOperationParams.hash: String;
     b(FHasLimitedExpansion)+b(FHesExcludeNotForUI)+b(FHasExcludePostCoordinated)+b(FHasIncludeDesignations)+
     b(FHasIncludeDefinition)+b(FHasDefaultToLatestVersion)+b(FHasIncompleteOK)+b(FHasDisplayWarning)+b(FHasexcludeNotForUI)+b(FHasMembershipOnly)+b(FDefaultToLatestVersion);
 
-  if hasLanguages then
-    s := s + FLanguages.AsString(true)+'|';
+  if hasHTTPLanguages then
+    s := s + FHTTPLanguages.AsString(true)+'|';
+  if hasDisplayLanguages then
+    s := s + '*'+FDisplayLanguages.AsString(true)+'|';
   if hasDesignations then
     s := s + FDesignations.commaText+'|';
   for t in FVersionRules do

library/fhir2/fhir2_common.pas

@@ -629,6 +629,7 @@   TFhirCodeSystem2 = class (TFhirCodeSystemW)
     function getChildren(c : TFhirCodeSystemConceptW) : TFhirCodeSystemConceptListW; override;
     function getCode(code : String) : TFhirCodeSystemConceptW; override;
     function buildImplicitValueSet : TFHIRValueSetW; override;
+    function hasAnyDisplays(langs : THTTPLanguageList) : boolean; override;
 
     function getDate: TFslDateTime; override;
     function getStatus: TPublicationStatus; override;
@@ -3742,6 +3743,11 @@ function TFhirCodeSystem2.buildImplicitValueSet: TFHIRValueSetW;
   result := TFHIRValueSet2.Create(vs.Link);
 end;
 
+function TFhirCodeSystem2.hasAnyDisplays(langs: THTTPLanguageList): boolean;
+begin
+  result := false;
+end;
+
 function TFhirCodeSystem2.concept(ndx: integer): TFhirCodeSystemConceptW;
 begin
   result := TFhirCodeSystemConcept2.Create(cs.conceptList[ndx].Link);

library/fhir3/fhir3_common.pas

@@ -735,6 +735,8 @@   TFhirCodeSystemProperty3 = class (TFhirCodeSystemPropertyW)
   TFhirCodeSystem3 = class (TFhirCodeSystemW)
   private
     function cs : TFhirCodeSystem;
+    function hasLanguage(cc: TFhirCodeSystemConcept; langs: THTTPLanguageList
+      ): boolean;
   public
     function wrapExtension(extension : TFHIRObject) : TFHIRExtensionW; override;
     function GetLanguage: String; override;
@@ -785,6 +787,7 @@   TFhirCodeSystem3 = class (TFhirCodeSystemW)
     function getChildren(c : TFhirCodeSystemConceptW) : TFhirCodeSystemConceptListW; override;
     function getCode(code : String) : TFhirCodeSystemConceptW; override;
     function buildImplicitValueSet : TFHIRValueSetW; override;
+    function hasAnyDisplays(langs : THTTPLanguageList) : boolean; override;
   end;
 
   TFHIRLookupOpRequest3 = class (TFHIRLookupOpRequestW)
@@ -4276,6 +4279,46 @@ function TFhirCodeSystem3.buildImplicitValueSet: TFHIRValueSetW;
   result := TFHIRValueSet3.Create(cs.buildImplicitValueSet);
 end;
 
+function TFhirCodeSystem3.hasLanguage(cc : TFhirCodeSystemConcept; langs: THTTPLanguageList): boolean;
+var
+  cc1 : TFhirCodeSystemConcept;
+  d : TFhirCodeSystemConceptDesignation;
+  hl : boolean;
+begin
+  if langs.matches(cs.Language, false) and (cc.display <> '') then
+    exit(true);
+
+  result := false;
+
+  for d in cc.designationList do
+    if langs.matches(d.language, false) then
+      exit(true);
+
+  for cc1 in cc.conceptList do
+  begin
+    hl := hasLanguage(cc1, langs);
+    if (hl) then
+      exit(true);
+  end;
+end;
+
+function TFhirCodeSystem3.hasAnyDisplays(langs: THTTPLanguageList): boolean;
+var
+  cc : TFhirCodeSystemConcept;
+  hl : boolean;
+begin
+  result := false;
+  if (langs.count > 0) then
+  begin
+    for cc in cs.conceptList do
+    begin
+      hl := hasLanguage(cc, langs);
+      if (hl) then
+        exit(true);
+    end;
+  end;
+end;
+
 function TFhirCodeSystem3.concept(ndx: integer): TFhirCodeSystemConceptW;
 begin
   result := TFhirCodeSystemConcept3.Create(cs.conceptList[ndx].Link);

library/fhir4/fhir4_common.pas

@@ -749,6 +749,8 @@   TFhirCodeSystemProperty4 = class (TFhirCodeSystemPropertyW)
   TFhirCodeSystem4 = class (TFhirCodeSystemW)
   private
     function cs : TFhirCodeSystem;
+    function hasLanguage(cc: TFhirCodeSystemConcept; langs: THTTPLanguageList
+      ): boolean;
   public
     function wrapExtension(extension : TFHIRObject) : TFHIRExtensionW; override;
     function GetLanguage: String; override;
@@ -793,6 +795,7 @@   TFhirCodeSystem4 = class (TFhirCodeSystemW)
     function getDate: TFslDateTime; override;
     function getStatus: TPublicationStatus; override;
     function buildImplicitValueSet : TFHIRValueSetW; override;
+    function hasAnyDisplays(langs : THTTPLanguageList) : boolean; override;
     function getContext: String; override;
     function getPublisher: String; override;
     procedure setPublisher(Value: String); override;
@@ -3970,6 +3973,46 @@ function TFhirCodeSystem4.buildImplicitValueSet: TFHIRValueSetW;
   result := TFHIRValueSet4.Create(cs.buildImplicitValueSet);
 end;
 
+function TFhirCodeSystem4.hasLanguage(cc : TFhirCodeSystemConcept; langs: THTTPLanguageList): boolean;  
+var
+  cc1 : TFhirCodeSystemConcept;
+  d : TFhirCodeSystemConceptDesignation;
+  hl : boolean;
+begin
+  if langs.matches(cs.Language, false) and (cc.display <> '') then
+    exit(true);
+
+  result := false;
+
+  for d in cc.designationList do
+    if langs.matches(d.language, false) then
+      exit(true);
+
+  for cc1 in cc.conceptList do
+  begin
+    hl := hasLanguage(cc1, langs);
+    if (hl) then
+      exit(true);
+  end;
+end;
+
+function TFhirCodeSystem4.hasAnyDisplays(langs: THTTPLanguageList): boolean;
+var
+  cc : TFhirCodeSystemConcept;
+  hl : boolean;
+begin
+  result := false;
+  if (langs.count > 0) then
+  begin
+    for cc in cs.conceptList do
+    begin
+      hl := hasLanguage(cc, langs);
+      if (hl) then
+        exit(true);
+    end;
+  end;
+end;
+
 function TFhirCodeSystem4.concept(ndx: integer): TFhirCodeSystemConceptW;
 begin
   result := TFhirCodeSystemConcept4.Create(cs.conceptList[ndx].Link, cs);