From 3c7947326da3e152aea0f7b64f5f7a44530737c1 Mon Sep 17 00:00:00 2001 From: Grahame Grieve Date: Tue, 2 Jan 2024 16:04:37 +1100 Subject: [PATCH] fix unicode and fhirpath tests --- library/fhir4/fhir4_pathengine.pas | 106 ++- library/fhir4/fhir4_pathnode.pas | 4 +- library/fhir4b/fhir4b_pathengine.pas | 122 +++- library/fhir4b/fhir4b_pathnode.pas | 4 +- library/fhir5/fhir5_pathengine.pas | 942 +++++++++++++++------------ library/fhir5/fhir5_pathnode.pas | 4 +- library/fsl/fsl_fpc.pas | 9 +- library/fsl/fsl_ucum.pas | 2 + library/fsl/fsl_utilities.pas | 15 +- library/fsl/tests/fsl_testing.pas | 32 + library/fsl/tests/fsl_tests.pas | 9 +- library/fsl/tests/fsl_tests_npm.pas | 1 + library/ftx/ftx_ucum_services.pas | 35 + library/web/fsl_crypto.pas | 10 +- 14 files changed, 805 insertions(+), 490 deletions(-) diff --git a/library/fhir4/fhir4_pathengine.pas b/library/fhir4/fhir4_pathengine.pas index 1569f4c3e..1df622154 100644 --- a/library/fhir4/fhir4_pathengine.pas +++ b/library/fhir4/fhir4_pathengine.pas @@ -282,6 +282,7 @@ TFHIRPathEngine = class (TFHIRPathEngineV) function funcLowBoundary(context : TFHIRPathExecutionContext; focus : TFHIRSelectionList; exp : TFHIRPathExpressionNode) : TFHIRSelectionList; function funcHighBoundary(context : TFHIRPathExecutionContext; focus : TFHIRSelectionList; exp : TFHIRPathExpressionNode) : TFHIRSelectionList; function funcPrecision(context : TFHIRPathExecutionContext; focus : TFHIRSelectionList; exp : TFHIRPathExpressionNode) : TFHIRSelectionList; + function funcComparable(context : TFHIRPathExecutionContext; focus : TFHIRSelectionList; exp : TFHIRPathExpressionNode) : TFHIRSelectionList; function qtyToCanonical(q : TFHIRQuantity) : TUcumPair; function pairToQty(p: TUcumPair): TFHIRQuantity; @@ -696,6 +697,7 @@ procedure TFHIRPathParser.checkParameters(lexer: TFHIRPathLexer; location : TSou pfLowBoundary: checkParamCount(lexer, location, exp, 0, 1); pfHighBoundary: checkParamCount(lexer, location, exp, 0, 1); pfPrecision: checkParamCount(lexer, location, exp, 0); + pfComparable : checkParamCount(lexer, location, exp, 1); pfEncode, pfDecode, pfEscape, pfUnescape : checkParamCount(lexer, location, exp, 1); pfCustom: ; // nothing end; @@ -2183,19 +2185,28 @@ function TFHIRPathEngine.funcIif(context: TFHIRPathExecutionContext; focus: TFHI var n1 : TFHIRSelectionList; v : TEqualityTriState; + cn : TFHIRPathExecutionContext; begin - n1 := execute(context, focus, exp.Parameters[0], true); + if (focus.Empty) then + cn := context.Link + else + cn := context.changeThis(focus[0].value, 0); try - v := asBool(n1); + n1 := execute(cn, focus, exp.Parameters[0], true); + try + v := asBool(n1); - if (v = equalTrue) then - result := execute(context, focus, exp.parameters[1], true) - else if (exp.parameters.count < 3) then - result := TFHIRSelectionList.Create - else - result := execute(context, focus, exp.parameters[2], true); + if (v = equalTrue) then + result := execute(context, focus, exp.parameters[1], true) + else if (exp.parameters.count < 3) then + result := TFHIRSelectionList.Create + else + result := execute(context, focus, exp.parameters[2], true); + finally + n1.free; + end; finally - n1.free; + cn.free; end; end; @@ -2342,15 +2353,17 @@ function TFHIRPathEngine.funcJoin(context: TFHIRPathExecutionContext; focus: TFH param : String; b : TFslStringBuilder; o : TFHIRSelection; + first : boolean; begin nl := execute(context, focus, exp.Parameters[0], true); try b := TFslStringBuilder.Create; try param := nl[0].value.primitiveValue; + first := true; for o in focus do begin - b.seperator(param); + if (first) then first := false else b.Append(param); b.append(o.value.primitiveValue); end; result := TFHIRSelectionList.Create(TFhirString.Create(b.ToString)); @@ -3535,17 +3548,24 @@ function TFHIRPathEngine.funcCombine(context : TFHIRPathExecutionContext; focus: var item : TFHIRSelection; res : TFHIRSelectionList; + fl : TFHIRSelectionList; begin result := TFHIRSelectionList.Create; try for item in focus do result.add(item.link); - res := execute(context, focus, exp.Parameters[0], true); + fl := TFHIRSelectionList.create; try - for item in res do - result.add(item.link); + fl.add(context.this.link); + res := execute(context, fl, exp.Parameters[0], true); + try + for item in res do + result.add(item.link); + finally + res.free; + end; finally - res.free; + fl.free; end; result.Link; finally @@ -3629,6 +3649,7 @@ function TFHIRPathEngine.funcSplit(context: TFHIRPathExecutionContext; focus: TF var nl : TFHIRSelectionList; param, s : String; + p : TStringArray; begin nl := execute(context, focus, exp.Parameters[0], true); try @@ -3636,8 +3657,11 @@ function TFHIRPathEngine.funcSplit(context: TFHIRPathExecutionContext; focus: TF result := TFHIRSelectionList.Create(); try if focus.Count = 1 then - for s in focus[0].value.primitiveValue.Split([param]) do + begin + p := focus[0].value.primitiveValue.Split([param]); + for s in p do result.add(TFhirString.Create(s)); + end; result.Link; finally result.free; @@ -3802,6 +3826,55 @@ function TFHIRPathEngine.funcHighBoundary(context : TFHIRPathExecutionContext; f end; end; +function TFHIRPathEngine.funcComparable(context : TFHIRPathExecutionContext; focus : TFHIRSelectionList; exp : TFHIRPathExpressionNode) : TFHIRSelectionList; +var + n1 : TFHIRSelectionList; + s1, u1, s2, u2 : String; +begin + result := TFHIRSelectionList.Create; + try + if (focus.Count <> 1) or (focus[0].value.fhirType <> 'Quantity') then + result.add(TFHIRBoolean.Create(false)) + else + begin + n1 := execute(context, focus, exp.Parameters[0], true); + try + if (n1.Count <> 1) or (n1[0].value.fhirType <> 'Quantity') then + result.add(TFHIRBoolean.Create(false)) + else + begin + s1 := focus[0].value.getPrimitiveValue('system'); + u1 := focus[0].value.getPrimitiveValue('code'); + s2 := n1[0].value.getPrimitiveValue('system'); + u2 := n1[0].value.getPrimitiveValue('code'); + + if (s1 = '') or (s2 = '') or (s1 <> s2) then + result.add(TFHIRBoolean.Create(false)) + else if (u1 = '') or (u2 = '') then + result.add(TFHIRBoolean.Create(false)) + else if (u1 = u2) then + result.add(TFHIRBoolean.Create(true)) + else if (s1 = 'http://unitsofmeasure.org') and (FUcum <> nil) then + begin + try + result.add(TFHIRBoolean.Create(FUcum.isComparable(u1, u2))); + except + result.add(TFHIRBoolean.Create(false)); + end; + end + else + result.add(TFHIRBoolean.Create(false)) + end; + finally + n1.free; + end; + end; + result.Link; + finally + result.free; + end; +end; + function TFHIRPathEngine.funcPrecision(context : TFHIRPathExecutionContext; focus : TFHIRSelectionList; exp : TFHIRPathExpressionNode) : TFHIRSelectionList; var base : TFhirObject; @@ -6091,6 +6164,7 @@ function TFHIRPathEngine.evaluateFunction(context : TFHIRPathExecutionContext; f pfLowBoundary : result := funcLowBoundary(context, focus, exp); pfHighBoundary : result := funcHighBoundary(context, focus, exp); pfPrecision : result := funcPrecision(context, focus, exp); + pfComparable : result := funcComparable(context, focus, exp); pfCustom : result := funcCustom(context, focus, exp); else raise EFHIRPath.Create('Unknown Function '+exp.name); @@ -6745,6 +6819,8 @@ function TFHIRPathEngine.evaluateFunctionType(context: TFHIRPathExecutionTypeCon raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on decima;, date, datetime, instant, time and Quantity, not '+focus.describe); result := TFHIRTypeDetails.Create(csSINGLETON, [FP_Integer]); end; + pfComparable : + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_Boolean]); pfCustom : result := evaluateCustomFunctionType(context, focus, exp); else diff --git a/library/fhir4/fhir4_pathnode.pas b/library/fhir4/fhir4_pathnode.pas index 8613c3c52..ffb83aa88 100644 --- a/library/fhir4/fhir4_pathnode.pas +++ b/library/fhir4/fhir4_pathnode.pas @@ -56,7 +56,7 @@ interface pfToBoolean, pfToInteger, pfToString, pfToDecimal, pfToQuantity, pfToDateTime, pfToTime, pfAbs, pfCeiling, pfExp, pfFloor, pfLn, pfLog, pfPower, pfTruncate, pfRound, pfSqrt, pfForHtml, pfEncode, pfDecode, pfEscape, pfUnescape, pfTrim, pfSplit, pfJoin, pfIndexOf, - pfLowBoundary, pfHighBoundary, pfPrecision, + pfLowBoundary, pfHighBoundary, pfPrecision, pfComparable, pfCustom); TFHIRPathExpressionNodeKind = (enkName, enkFunction, enkConstant, enkGroup, enkStructure, enkUnary); // structure is not used in fhir4_pathengine, but is in CQL @@ -78,7 +78,7 @@ interface 'toBoolean', 'toInteger', 'toString', 'toDecimal', 'toQuantity', 'toDateTime', 'toTime', 'abs', 'ceiling', 'exp', 'floor', 'ln', 'log', 'power', 'truncate', 'round', 'sqrt', 'forHtml', 'encode', 'decode', 'escape', 'unescape', 'trim', 'split', 'join', 'indexOf', - 'lowBoundary', 'highBoundary', 'precision', + 'lowBoundary', 'highBoundary', 'precision', 'comparable', 'xx-custom-xx'); FHIR_SD_NS = 'http://hl7.org/fhir/StructureDefinition/'; diff --git a/library/fhir4b/fhir4b_pathengine.pas b/library/fhir4b/fhir4b_pathengine.pas index f54921e1b..405ceffa3 100644 --- a/library/fhir4b/fhir4b_pathengine.pas +++ b/library/fhir4b/fhir4b_pathengine.pas @@ -280,6 +280,7 @@ TFHIRPathEngine = class (TFHIRPathEngineV) function funcLowBoundary(context : TFHIRPathExecutionContext; focus : TFHIRSelectionList; exp : TFHIRPathExpressionNode) : TFHIRSelectionList; function funcHighBoundary(context : TFHIRPathExecutionContext; focus : TFHIRSelectionList; exp : TFHIRPathExpressionNode) : TFHIRSelectionList; function funcPrecision(context : TFHIRPathExecutionContext; focus : TFHIRSelectionList; exp : TFHIRPathExpressionNode) : TFHIRSelectionList; + function funcComparable(context : TFHIRPathExecutionContext; focus : TFHIRSelectionList; exp : TFHIRPathExpressionNode) : TFHIRSelectionList; function qtyToCanonical(q : TFHIRQuantity) : TUcumPair; function pairToQty(p: TUcumPair): TFHIRQuantity; @@ -604,7 +605,7 @@ procedure TFHIRPathParser.checkParameters(lexer: TFHIRPathLexer; location : TSou case exp.FunctionId of pfEmpty: checkParamCount(lexer, location, exp, 0); pfNot: checkParamCount(lexer, location, exp, 0); - pfExists: checkParamCount(lexer, location, exp, 0, 1); // 1 is allowed in cql, and should be allowed in fhir4b_pathengine as well + pfExists: checkParamCount(lexer, location, exp, 0, 1); // 1 is allowed in cql, and should be allowed in fhir4_pathengine as well pfSubsetOf: checkParamCount(lexer, location, exp, 1); pfSupersetOf: checkParamCount(lexer, location, exp, 1); pfIsDistinct: checkParamCount(lexer, location, exp, 0); @@ -694,6 +695,7 @@ procedure TFHIRPathParser.checkParameters(lexer: TFHIRPathLexer; location : TSou pfLowBoundary: checkParamCount(lexer, location, exp, 0, 1); pfHighBoundary: checkParamCount(lexer, location, exp, 0, 1); pfPrecision: checkParamCount(lexer, location, exp, 0); + pfComparable : checkParamCount(lexer, location, exp, 1); pfEncode, pfDecode, pfEscape, pfUnescape : checkParamCount(lexer, location, exp, 1); pfCustom: ; // nothing end; @@ -2181,19 +2183,28 @@ function TFHIRPathEngine.funcIif(context: TFHIRPathExecutionContext; focus: TFHI var n1 : TFHIRSelectionList; v : TEqualityTriState; + cn : TFHIRPathExecutionContext; begin - n1 := execute(context, focus, exp.Parameters[0], true); + if (focus.Empty) then + cn := context.Link + else + cn := context.changeThis(focus[0].value, 0); try - v := asBool(n1); + n1 := execute(cn, focus, exp.Parameters[0], true); + try + v := asBool(n1); - if (v = equalTrue) then - result := execute(context, focus, exp.parameters[1], true) - else if (exp.parameters.count < 3) then - result := TFHIRSelectionList.Create - else - result := execute(context, focus, exp.parameters[2], true); + if (v = equalTrue) then + result := execute(context, focus, exp.parameters[1], true) + else if (exp.parameters.count < 3) then + result := TFHIRSelectionList.Create + else + result := execute(context, focus, exp.parameters[2], true); + finally + n1.free; + end; finally - n1.free; + cn.free; end; end; @@ -2340,15 +2351,17 @@ function TFHIRPathEngine.funcJoin(context: TFHIRPathExecutionContext; focus: TFH param : String; b : TFslStringBuilder; o : TFHIRSelection; + first : boolean; begin nl := execute(context, focus, exp.Parameters[0], true); try b := TFslStringBuilder.Create; try param := nl[0].value.primitiveValue; + first := true; for o in focus do begin - b.seperator(param); + if (first) then first := false else b.Append(param); b.append(o.value.primitiveValue); end; result := TFHIRSelectionList.Create(TFhirString.Create(b.ToString)); @@ -2559,7 +2572,7 @@ function TFHIRPathEngine.funcMatchesFull(context : TFHIRPathExecutionContext; fo var res : TFHIRSelectionList; s, p : String; - reg : TRegularExpression; + reg : TREgularExpression; begin result := TFHIRSelectionList.Create; try @@ -2574,7 +2587,7 @@ function TFHIRPathEngine.funcMatchesFull(context : TFHIRPathExecutionContext; fo result.add(TFHIRBoolean.Create(false)) else begin - reg := TRegularExpression.Create('(?s)' + p, [roCompiled]); + reg := TREgularExpression.Create('(?s)' + p, [roCompiled]); try s := convertToString(focus[0].value); result.add(TFHIRBoolean.Create(reg.isFullMatch(s))); @@ -3533,17 +3546,24 @@ function TFHIRPathEngine.funcCombine(context : TFHIRPathExecutionContext; focus: var item : TFHIRSelection; res : TFHIRSelectionList; + fl : TFHIRSelectionList; begin result := TFHIRSelectionList.Create; try for item in focus do result.add(item.link); - res := execute(context, focus, exp.Parameters[0], true); + fl := TFHIRSelectionList.create; try - for item in res do - result.add(item.link); + fl.add(context.this.link); + res := execute(context, fl, exp.Parameters[0], true); + try + for item in res do + result.add(item.link); + finally + res.free; + end; finally - res.free; + fl.free; end; result.Link; finally @@ -3627,6 +3647,7 @@ function TFHIRPathEngine.funcSplit(context: TFHIRPathExecutionContext; focus: TF var nl : TFHIRSelectionList; param, s : String; + p : TStringArray; begin nl := execute(context, focus, exp.Parameters[0], true); try @@ -3634,8 +3655,11 @@ function TFHIRPathEngine.funcSplit(context: TFHIRPathExecutionContext; focus: TF result := TFHIRSelectionList.Create(); try if focus.Count = 1 then - for s in focus[0].value.primitiveValue.Split([param]) do + begin + p := focus[0].value.primitiveValue.Split([param]); + for s in p do result.add(TFhirString.Create(s)); + end; result.Link; finally result.free; @@ -3800,6 +3824,55 @@ function TFHIRPathEngine.funcHighBoundary(context : TFHIRPathExecutionContext; f end; end; +function TFHIRPathEngine.funcComparable(context : TFHIRPathExecutionContext; focus : TFHIRSelectionList; exp : TFHIRPathExpressionNode) : TFHIRSelectionList; +var + n1 : TFHIRSelectionList; + s1, u1, s2, u2 : String; +begin + result := TFHIRSelectionList.Create; + try + if (focus.Count <> 1) or (focus[0].value.fhirType <> 'Quantity') then + result.add(TFHIRBoolean.Create(false)) + else + begin + n1 := execute(context, focus, exp.Parameters[0], true); + try + if (n1.Count <> 1) or (n1[0].value.fhirType <> 'Quantity') then + result.add(TFHIRBoolean.Create(false)) + else + begin + s1 := focus[0].value.getPrimitiveValue('system'); + u1 := focus[0].value.getPrimitiveValue('code'); + s2 := n1[0].value.getPrimitiveValue('system'); + u2 := n1[0].value.getPrimitiveValue('code'); + + if (s1 = '') or (s2 = '') or (s1 <> s2) then + result.add(TFHIRBoolean.Create(false)) + else if (u1 = '') or (u2 = '') then + result.add(TFHIRBoolean.Create(false)) + else if (u1 = u2) then + result.add(TFHIRBoolean.Create(true)) + else if (s1 = 'http://unitsofmeasure.org') and (FUcum <> nil) then + begin + try + result.add(TFHIRBoolean.Create(FUcum.isComparable(u1, u2))); + except + result.add(TFHIRBoolean.Create(false)); + end; + end + else + result.add(TFHIRBoolean.Create(false)) + end; + finally + n1.free; + end; + end; + result.Link; + finally + result.free; + end; +end; + function TFHIRPathEngine.funcPrecision(context : TFHIRPathExecutionContext; focus : TFHIRSelectionList; exp : TFHIRPathExpressionNode) : TFHIRSelectionList; var base : TFhirObject; @@ -3831,7 +3904,7 @@ function TFHIRPathEngine.funcCeiling(context: TFHIRPathExecutionContext; focus: var base : TFHIRObject; qty : TFHIRQuantity; - d : TFslDecimal; + v : TFslDecimal; begin if (focus.count <> 1) then raise EFHIRPath.Create('Error evaluating FHIRPath expression: focus for floor has more than one value'); @@ -3845,10 +3918,10 @@ function TFHIRPathEngine.funcCeiling(context: TFHIRPathExecutionContext; focus: begin qty := (base as TFhirQuantity).Clone; try - d := TFslDecimal.Create(qty.value); - d := d.Trunc; - d := d.AddInt(1); - qty.value := d.AsString; + v := TFslDecimal.Create(qty.value); + v := v.trunc; + v := v.addInt(1); + qty.value := v.AsString; result.add(qty.Link); finally qty.free; @@ -6089,6 +6162,7 @@ function TFHIRPathEngine.evaluateFunction(context : TFHIRPathExecutionContext; f pfLowBoundary : result := funcLowBoundary(context, focus, exp); pfHighBoundary : result := funcHighBoundary(context, focus, exp); pfPrecision : result := funcPrecision(context, focus, exp); + pfComparable : result := funcComparable(context, focus, exp); pfCustom : result := funcCustom(context, focus, exp); else raise EFHIRPath.Create('Unknown Function '+exp.name); @@ -6743,6 +6817,8 @@ function TFHIRPathEngine.evaluateFunctionType(context: TFHIRPathExecutionTypeCon raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on decima;, date, datetime, instant, time and Quantity, not '+focus.describe); result := TFHIRTypeDetails.Create(csSINGLETON, [FP_Integer]); end; + pfComparable : + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_Boolean]); pfCustom : result := evaluateCustomFunctionType(context, focus, exp); else diff --git a/library/fhir4b/fhir4b_pathnode.pas b/library/fhir4b/fhir4b_pathnode.pas index 75f34c8f1..868d9a6fb 100644 --- a/library/fhir4b/fhir4b_pathnode.pas +++ b/library/fhir4b/fhir4b_pathnode.pas @@ -56,7 +56,7 @@ interface pfToBoolean, pfToInteger, pfToString, pfToDecimal, pfToQuantity, pfToDateTime, pfToTime, pfAbs, pfCeiling, pfExp, pfFloor, pfLn, pfLog, pfPower, pfTruncate, pfRound, pfSqrt, pfForHtml, pfEncode, pfDecode, pfEscape, pfUnescape, pfTrim, pfSplit, pfJoin, pfIndexOf, - pfLowBoundary, pfHighBoundary, pfPrecision, + pfLowBoundary, pfHighBoundary, pfPrecision, pfComparable, pfCustom); TFHIRPathExpressionNodeKind = (enkName, enkFunction, enkConstant, enkGroup, enkStructure, enkUnary); // structure is not used in fhir4b_pathengine, but is in CQL @@ -78,7 +78,7 @@ interface 'toBoolean', 'toInteger', 'toString', 'toDecimal', 'toQuantity', 'toDateTime', 'toTime', 'abs', 'ceiling', 'exp', 'floor', 'ln', 'log', 'power', 'truncate', 'round', 'sqrt', 'forHtml', 'encode', 'decode', 'escape', 'unescape', 'trim', 'split', 'join', 'indexOf', - 'lowBoundary', 'highBoundary', 'precision', + 'lowBoundary', 'highBoundary', 'precision', 'comparable', 'xx-custom-xx'); FHIR_SD_NS = 'http://hl7.org/fhir/StructureDefinition/'; diff --git a/library/fhir5/fhir5_pathengine.pas b/library/fhir5/fhir5_pathengine.pas index fa5198d7f..8c31cbc4d 100644 --- a/library/fhir5/fhir5_pathengine.pas +++ b/library/fhir5/fhir5_pathengine.pas @@ -34,8 +34,8 @@ interface uses - SysUtils, Classes, Math, Generics.Collections, Character, - fsl_base, fsl_utilities, fsl_stream, fsl_fpc, fsl_json, fsl_xml, fsl_regex, + SysUtils, Classes, Math, Generics.Collections, Character, + fsl_base, fsl_utilities, fsl_stream, fsl_fpc, fsl_xml, fsl_json, fsl_regex, fsl_ucum, fhir_objects, fhir_factory, fhir_pathengine, fhir_uris, fhir5_pathnode, fhir5_enums, fhir5_types, fhir5_resources, fhir5_utilities, fhir5_context, fhir5_constants; @@ -280,6 +280,7 @@ TFHIRPathEngine = class (TFHIRPathEngineV) function funcLowBoundary(context : TFHIRPathExecutionContext; focus : TFHIRSelectionList; exp : TFHIRPathExpressionNode) : TFHIRSelectionList; function funcHighBoundary(context : TFHIRPathExecutionContext; focus : TFHIRSelectionList; exp : TFHIRPathExpressionNode) : TFHIRSelectionList; function funcPrecision(context : TFHIRPathExecutionContext; focus : TFHIRSelectionList; exp : TFHIRPathExpressionNode) : TFHIRSelectionList; + function funcComparable(context : TFHIRPathExecutionContext; focus : TFHIRSelectionList; exp : TFHIRPathExpressionNode) : TFHIRSelectionList; function qtyToCanonical(q : TFHIRQuantity) : TUcumPair; function pairToQty(p: TUcumPair): TFHIRQuantity; @@ -382,7 +383,7 @@ implementation { TFHIRConstant } -constructor TFHIRConstant.create(value: String); +constructor TFHIRConstant.Create(value: String); begin inherited Create; FValue := value; @@ -390,7 +391,7 @@ constructor TFHIRConstant.create(value: String); function TFHIRConstant.createPropertyValue(propName: string): TFHIRObject; begin - raise EFHIRTodo.create('TFHIRConstant.createPropertyValue'); + raise EFHIRTodo.Create('TFHIRConstant.createPropertyValue'); end; function TFHIRConstant.fhirType: string; @@ -400,12 +401,12 @@ function TFHIRConstant.fhirType: string; function TFHIRConstant.getId: String; begin - raise EFHIRTodo.create('TFHIRConstant.getId:'); + raise EFHIRTodo.Create('TFHIRConstant.getId:'); end; function TFHIRConstant.getTypesForProperty(propName : string): String; begin - raise EFHIRTodo.create('TFHIRConstant.getTypesForProperty'); + raise EFHIRTodo.Create('TFHIRConstant.getTypesForProperty'); end; function TFHIRConstant.hasExtensions: boolean; @@ -430,12 +431,12 @@ function TFHIRConstant.makeStringValue(v: String): TFHIRObject; procedure TFHIRConstant.setIdValue(id: String); begin - raise EFHIRTodo.create('TFHIRConstant.setIdValue'); + raise EFHIRTodo.Create('TFHIRConstant.setIdValue'); end; function TFHIRConstant.setProperty(propName: string; propValue: TFHIRObject) : TFHIRObject; begin - raise EFHIRTodo.create('TFHIRConstant.setProperty'); + raise EFHIRTodo.Create('TFHIRConstant.setProperty'); end; function TFHIRConstant.sizeInBytesV(magic : integer) : cardinal; @@ -446,7 +447,7 @@ function TFHIRConstant.sizeInBytesV(magic : integer) : cardinal; { TFHIRClassTypeInfo } -constructor TFHIRClassTypeInfo.create(instance: TFHIRObject); +constructor TFHIRClassTypeInfo.Create(instance: TFHIRObject); begin inherited Create; FInstance := instance; @@ -454,7 +455,7 @@ constructor TFHIRClassTypeInfo.create(instance: TFHIRObject); function TFHIRClassTypeInfo.createPropertyValue(propName: string): TFHIRObject; begin - raise EFHIRTodo.create('TFHIRClassTypeInfo.createPropertyValue'); + raise EFHIRTodo.Create('TFHIRClassTypeInfo.createPropertyValue'); end; destructor TFHIRClassTypeInfo.Destroy; @@ -471,9 +472,9 @@ function TFHIRClassTypeInfo.fhirType: string; procedure TFHIRClassTypeInfo.GetChildrenByName(name: string; list: TFHIRSelectionList); begin if (name = 'name') then - list.add(TFHIRString.create(getName).noExtensions) + list.add(TFHIRString.Create(getName).noExtensions) else if (name = 'namespace') then - list.add(TFHIRString.create(getNamespace).noExtensions) + list.add(TFHIRString.Create(getNamespace).noExtensions) else inherited GetChildrenByName(name, list); end; @@ -490,7 +491,7 @@ function TFHIRClassTypeInfo.getNamespace: String; function TFHIRClassTypeInfo.getTypesForProperty(propName : string): String; begin - raise EFHIRTodo.create('TFHIRClassTypeInfo.getTypesForProperty'); + raise EFHIRTodo.Create('TFHIRClassTypeInfo.getTypesForProperty'); end; function TFHIRClassTypeInfo.hasExtensions: boolean; @@ -500,7 +501,7 @@ function TFHIRClassTypeInfo.hasExtensions: boolean; function TFHIRClassTypeInfo.getId: String; begin - raise EFHIRTodo.create('TFHIRClassTypeInfo.getId:'); + raise EFHIRTodo.Create('TFHIRClassTypeInfo.getId:'); end; function TFHIRClassTypeInfo.makeCodeValue(v: String): TFHIRObject; @@ -520,12 +521,12 @@ function TFHIRClassTypeInfo.makeStringValue(v: String): TFHIRObject; procedure TFHIRClassTypeInfo.setIdValue(id: String); begin - raise EFHIRTodo.create('TFHIRClassTypeInfo.setIdValue'); + raise EFHIRTodo.Create('TFHIRClassTypeInfo.setIdValue'); end; function TFHIRClassTypeInfo.setProperty(propName: string; propValue: TFHIRObject) : TFHIRObject; begin - raise EFHIRTodo.create('TFHIRClassTypeInfo.setProperty'); + raise EFHIRTodo.Create('TFHIRClassTypeInfo.setProperty'); end; function TFHIRClassTypeInfo.getName: String; @@ -555,7 +556,7 @@ function TFHIRPathParser.parse(lexer: TFHIRPathLexer): TFHIRPathExpressionNode; result := parseExpression(lexer, true); try if not result.check(msg, 0) then - raise EFHIRPath.create('Error "'+msg+'" parsing "'+lexer.Path); + raise EFHIRPath.Create('Error "'+msg+'" parsing "'+lexer.Path); result.Link; finally result.free; @@ -576,7 +577,7 @@ function TFHIRPathParser.parse(path: String): TFHIRPathExpressionNode; if not lexer.done then raise lexer.error('Premature expression termination at unexpected token "'+lexer.current+'"'); if not result.check(msg, 0) then - raise EFHIRPath.create('Error parsing "'+path+'": '+msg); + raise EFHIRPath.Create('Error parsing "'+path+'": '+msg); result.Link; finally @@ -604,7 +605,7 @@ procedure TFHIRPathParser.checkParameters(lexer: TFHIRPathLexer; location : TSou case exp.FunctionId of pfEmpty: checkParamCount(lexer, location, exp, 0); pfNot: checkParamCount(lexer, location, exp, 0); - pfExists: checkParamCount(lexer, location, exp, 0, 1); // 1 is allowed in cql, and should be allowed in fhir5_pathengine as well + pfExists: checkParamCount(lexer, location, exp, 0, 1); // 1 is allowed in cql, and should be allowed in fhir4_pathengine as well pfSubsetOf: checkParamCount(lexer, location, exp, 1); pfSupersetOf: checkParamCount(lexer, location, exp, 1); pfIsDistinct: checkParamCount(lexer, location, exp, 0); @@ -694,6 +695,7 @@ procedure TFHIRPathParser.checkParameters(lexer: TFHIRPathLexer; location : TSou pfLowBoundary: checkParamCount(lexer, location, exp, 0, 1); pfHighBoundary: checkParamCount(lexer, location, exp, 0, 1); pfPrecision: checkParamCount(lexer, location, exp, 0); + pfComparable : checkParamCount(lexer, location, exp, 1); pfEncode, pfDecode, pfEscape, pfUnescape : checkParamCount(lexer, location, exp, 1); pfCustom: ; // nothing end; @@ -718,7 +720,7 @@ function TFHIRPathParser.parse(path: String; var i: integer): TFHIRPathExpressio result := parseExpression(lexer, true); try if not result.check(msg, 0) then - raise EFHIRPath.create('Error parsing "'+path+'": '+msg); + raise EFHIRPath.Create('Error parsing "'+path+'": '+msg); result.Link; finally result.free; @@ -1065,7 +1067,7 @@ function TFHIRPathEngine.check(appInfo : TFslObject; resourceType, context, path end; try - ctxt := TFHIRPathExecutionTypeContext.create(appInfo, resourceType, types.Link, types.Link); + ctxt := TFHIRPathExecutionTypeContext.Create(appInfo, resourceType, types.Link, types.Link); try result := executeType(ctxt, types, expr, true); finally @@ -1114,7 +1116,7 @@ function TFHIRPathEngine.convertToString(item: TFHIRObject): String; end; -constructor TFHIRPathEngine.create(context: TFHIRWorkerContext; ucum : TUcumServiceInterface); +constructor TFHIRPathEngine.Create(context: TFHIRWorkerContext; ucum : TUcumServiceInterface); var sd : TFhirStructureDefinition; list : TFslList; @@ -1140,7 +1142,7 @@ constructor TFHIRPathEngine.create(context: TFHIRWorkerContext; ucum : TUcumServ if (sd.derivation = TypeDerivationRuleSPECIALIZATION) and (sd.kind = StructureDefinitionKindPrimitiveType) then primitiveTypes.add(sd.id); {$ELSE} - raise EFHIRException.create('Debug this'); + raise EFHIRException.Create('Debug this'); if (sd.constrainedType = DefinedTypesNull) then allTypes.add(sd.id); if (sd.constrainedType = DefinedTypesNull) and isPrimitive(sd) then @@ -1170,11 +1172,11 @@ function TFHIRPathEngine.dateAdd(d: TFhirObject; qty: TFhirQuantity; negate: boo if (c = 'years') or (c = 'year') then result.dateValue := d.dateValue.add(v, dtuYear) else if (c = 'a') then - raise EFHIRPath.create(format('Error in date arithmetic: attempt to add a definite quantity duration time unit %s', [c])) + raise EFHIRPath.Create(format('Error in date arithmetic: attempt to add a definite quantity duration time unit %s', [c])) else if (c = 'months') or (c = 'month') then result.dateValue := d.dateValue.add(v, dtuMonth) else if (c = 'mo') then - raise EFHIRPath.create(format('Error in date arithmetic: attempt to add a definite quantity duration time unit %s', [c])) + raise EFHIRPath.Create(format('Error in date arithmetic: attempt to add a definite quantity duration time unit %s', [c])) else if (c = 'weeks') or (c = 'week') or (c = 'wk') then result.dateValue := d.dateValue.add(v * 7, dtuDay) else if (c = 'days') or (c = 'day') or (c = 'd') then @@ -1188,7 +1190,7 @@ function TFHIRPathEngine.dateAdd(d: TFhirObject; qty: TFhirQuantity; negate: boo else if (c = 'millisecond') or (c = 'millisecond') or (c = 'ms') then result.dateValue := d.dateValue.add(v, dtuMillisecond) else - raise EFHIRPath.create(format('Error in date arithmetic: unrecognized time unit %s', [c])); + raise EFHIRPath.Create(format('Error in date arithmetic: unrecognized time unit %s', [c])); result.Link; finally result.free; @@ -1470,7 +1472,7 @@ function TFHIRPathEngine.evaluate(appInfo : TFslObject; resource : TFHIRObject; function TFHIRPathEngine.evaluateCustomFunctionType(context: TFHIRPathExecutionTypeContext; focus: TFHIRTypeDetails; exp: TFHIRPathExpressionNode): TFHIRTypeDetails; begin - raise EFHIRPath.create('Unknown Function '+exp.name); + raise EFHIRPath.Create('Unknown Function '+exp.name); end; function TFHIRPathEngine.executeV(context: TFHIRPathExecutionContext; item: TFHIRObject; exp: TFHIRPathExpressionNodeV; atEntry: boolean): TFHIRSelectionList; @@ -1603,51 +1605,51 @@ procedure TFHIRPathEngine.ListAllChildren(item : TFHIRObject; results : TFHIRSel function TFHIRPathEngine.resolveConstantType(ctxt: TFHIRPathExecutionTypeContext; constant : TFHIRObject) : TFHIRTypeDetails; begin if (constant is TFHIRBoolean) then - result := TFHIRTypeDetails.create(csSINGLETON, [FP_Boolean]) + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_Boolean]) else if (constant is TFHIRInteger) then - result := TFHIRTypeDetails.create(csSINGLETON, [FP_Integer]) + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_Integer]) else if (constant is TFHIRDecimal) then - result := TFHIRTypeDetails.create(csSINGLETON, [FP_Decimal]) + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_Decimal]) else if (constant is TFHIRQuantity) then - result := TFHIRTypeDetails.create(csSINGLETON, [FP_Quantity]) + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_Quantity]) else if (constant is TFHIRConstant) then result := resolveConstantType(ctxt, (constant as TFHIRConstant).FValue) else - result := TFHIRTypeDetails.create(csSINGLETON, [FP_String]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_String]); end; function TFHIRPathEngine.resolveConstantType(ctxt: TFHIRPathExecutionTypeContext; s : String) : TFHIRTypeDetails; begin if (s.startsWith('@')) then if (s.startsWith('@T')) then - result := TFHIRTypeDetails.create(csSINGLETON, [FP_Time]) + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_Time]) else - result := TFHIRTypeDetails.create(csSINGLETON, [FP_DateTime]) + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_DateTime]) else if (s.equals('%sct')) then - result := TFHIRTypeDetails.create(csSINGLETON, [FP_String]) + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_String]) else if (s.equals('%loinc')) then - result := TFHIRTypeDetails.create(csSINGLETON, [FP_String]) + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_String]) else if (s.equals('%ucum')) then - result := TFHIRTypeDetails.create(csSINGLETON, [FP_String]) + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_String]) else if (s.equals('%resource')) then begin if (ctxt.resourceType = '') then - raise EFHIRPath.create('%resource cannot be used in this context'); - result := TFHIRTypeDetails.create(csSINGLETON, [ctxt.resourceType]); + raise EFHIRPath.Create('%resource cannot be used in this context'); + result := TFHIRTypeDetails.Create(csSINGLETON, [ctxt.resourceType]); end else if (s.equals('%context')) then result := ctxt.context.link else if (s.equals('%map-codes')) then - result := TFHIRTypeDetails.create(csSINGLETON, [FP_String]) + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_String]) else if (s.equals('%us-zip')) then - result := TFHIRTypeDetails.create(csSINGLETON, [FP_String]) + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_String]) else if (s.startsWith('%`vs-')) then - result := TFHIRTypeDetails.create(csSINGLETON, [FP_String]) + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_String]) else if (s.startsWith('%`cs-')) then - result := TFHIRTypeDetails.create(csSINGLETON, [FP_String]) + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_String]) else if (s.startsWith('%`ext-')) then - result := TFHIRTypeDetails.create(csSINGLETON, [FP_String]) + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_String]) else - raise EFHIRPath.create('Unknown fixed constant type for "'+s+'"'); + raise EFHIRPath.Create('Unknown fixed constant type for "'+s+'"'); end; function TFHIRPathEngine.executeType(ctxt: TFHIRPathExecutionTypeContext; focus: TFHIRTypeDetails; exp: TFHIRPathExpressionNode; atEntry : boolean): TFHIRTypeDetails; @@ -1678,7 +1680,7 @@ function TFHIRPathEngine.executeType(ctxt: TFHIRPathExecutionTypeContext; focus: end; end; if (result.hasNoTypes) then - raise EFHIRPath.create('The name '+exp.Name+' was not valid for any of the possible types: '+focus.describe()); + raise EFHIRPath.Create('The name '+exp.Name+' was not valid for any of the possible types: '+focus.describe()); end; enkUnary : begin @@ -1731,7 +1733,7 @@ function TFHIRPathEngine.executeType(ctxt: TFHIRPathExecutionTypeContext; focus: while (next <> nil) do begin if (last.Operation in [popIs, popAs]) then - work := TFHIRTypeDetails.create(csSINGLETON, next.name) + work := TFHIRTypeDetails.Create(csSINGLETON, next.name) else work := executeType(ctxt, focus, next, atEntry); try @@ -1863,11 +1865,11 @@ function TFHIRPathEngine.funcContains(context : TFHIRPathExecutionContext; focus end; if (focus.count <> 1) then - result.add(TFHIRBoolean.create(false).noExtensions) + result.add(TFHIRBoolean.Create(false).noExtensions) else if sw = '' then - result.add(TFHIRBoolean.create(true).noExtensions) + result.add(TFHIRBoolean.Create(true).noExtensions) else - result.add(TFHIRBoolean.create(convertToString(focus[0].value).contains(sw)).noExtensions); + result.add(TFHIRBoolean.Create(convertToString(focus[0].value).contains(sw)).noExtensions); end; result.Link; finally @@ -2009,11 +2011,11 @@ function TFHIRPathEngine.funcEndsWith(context: TFHIRPathExecutionContext; focus: end; if (focus.count <> 1) then - result.add(TFHIRBoolean.create(false).noExtensions) + result.add(TFHIRBoolean.Create(false).noExtensions) else if (sw = '') then - result.add(TFHIRBoolean.create(true).noExtensions) + result.add(TFHIRBoolean.Create(true).noExtensions) else - result.add(TFHIRBoolean.create(convertToString(focus[0].value).endsWith(sw)).noExtensions); + result.add(TFHIRBoolean.Create(convertToString(focus[0].value).endsWith(sw)).noExtensions); end; result.Link; finally @@ -2157,9 +2159,9 @@ function TFHIRPathEngine.funcHasValue(context: TFHIRPathExecutionContext; focus: result := TFHIRSelectionList.Create; try if (focus.count = 1) then - result.add(TFHIRBoolean.create(focus[0].value.hasPrimitiveValue).noExtensions) + result.add(TFHIRBoolean.Create(focus[0].value.hasPrimitiveValue).noExtensions) else - result.add(TFHIRBoolean.create(false).noExtensions); + result.add(TFHIRBoolean.Create(false).noExtensions); result.Link; finally result.free; @@ -2170,7 +2172,7 @@ function TFHIRPathEngine.funcHtmlChecks(context: TFHIRPathExecutionContext; focu begin result := TFHIRSelectionList.Create; try - result.add(TFHIRBoolean.create(true).noExtensions); + result.add(TFHIRBoolean.Create(true).noExtensions); result.Link; finally result.free; @@ -2181,19 +2183,28 @@ function TFHIRPathEngine.funcIif(context: TFHIRPathExecutionContext; focus: TFHI var n1 : TFHIRSelectionList; v : TEqualityTriState; + cn : TFHIRPathExecutionContext; begin - n1 := execute(context, focus, exp.Parameters[0], true); + if (focus.Empty) then + cn := context.Link + else + cn := context.changeThis(focus[0].value, 0); try - v := asBool(n1); + n1 := execute(cn, focus, exp.Parameters[0], true); + try + v := asBool(n1); - if (v = equalTrue) then - result := execute(context, focus, exp.parameters[1], true) - else if (exp.parameters.count < 3) then - result := TFHIRSelectionList.Create - else - result := execute(context, focus, exp.parameters[2], true); + if (v = equalTrue) then + result := execute(context, focus, exp.parameters[1], true) + else if (exp.parameters.count < 3) then + result := TFHIRSelectionList.Create + else + result := execute(context, focus, exp.parameters[2], true); + finally + n1.free; + end; finally - n1.free; + cn.free; end; end; @@ -2227,18 +2238,18 @@ function TFHIRPathEngine.funcIs(context: TFHIRPathExecutionContext; focus: TFHIR result := TFHIRSelectionList.Create; try if (focus.count = 0) or (focus.count > 1) then - result.add(TFHIRBoolean.create(false).noExtensions) + result.add(TFHIRBoolean.Create(false).noExtensions) else begin ns := ''; n := ''; texp := exp.Parameters[0]; if (texp.Kind <> enkName) then - raise EFHIRPath.create('Unsupported Expression type for Parameter on Is'); + raise EFHIRPath.Create('Unsupported Expression type for Parameter on Is'); if (texp.inner <> nil) then begin if (texp.Kind <> enkName) then - raise EFHIRPath.create('Unsupported Expression type for Parameter on Is'); + raise EFHIRPath.Create('Unsupported Expression type for Parameter on Is'); ns := texp.Name; n := texp.inner.Name; end @@ -2255,19 +2266,19 @@ function TFHIRPathEngine.funcIs(context: TFHIRPathExecutionContext; focus: TFHIR if (ns = 'System') then begin if (focus[0].value is TFHIRResource) then - result.add(TFHIRBoolean.create(false).noExtensions) + result.add(TFHIRBoolean.Create(false).noExtensions) else if (not (focus[0].value is TFHIRElement) or (focus[0].value as TFHIRElement).DisallowExtensions) then if (focus[0].value.fhirType = 'date') and (n = 'DateTime') then - result.add(TFHIRBoolean.create(true).noExtensions) + result.add(TFHIRBoolean.Create(true).noExtensions) else - result.add(TFHIRBoolean.create(n = capitalise(focus[0].value.fhirType)).noExtensions) + result.add(TFHIRBoolean.Create(n = capitalise(focus[0].value.fhirType)).noExtensions) else - result.add(TFHIRBoolean.create(false).noExtensions); + result.add(TFHIRBoolean.Create(false).noExtensions); end else if (ns = 'FHIR') then - result.add(TFHIRBoolean.create(typeMatches(n, focus[0].value.fhirType, true)).noExtensions) + result.add(TFHIRBoolean.Create(typeMatches(n, focus[0].value.fhirType, true)).noExtensions) else - result.add(TFHIRBoolean.create(false).noExtensions); + result.add(TFHIRBoolean.Create(false).noExtensions); end; result.link; finally @@ -2284,7 +2295,7 @@ function TFHIRPathEngine.funcIsDistinct( context: TFHIRPathExecutionContext; foc result := TFHIRSelectionList.Create; try if (focus.count = 1) then - result.add(TFHIRBoolean.create(true).noExtensions) + result.add(TFHIRBoolean.Create(true).noExtensions) else if (focus.count > 1) then begin distinct := true; @@ -2303,7 +2314,7 @@ function TFHIRPathEngine.funcIsDistinct( context: TFHIRPathExecutionContext; foc break; end; end; - result.add(TFHIRBoolean.create(distinct).noExtensions); + result.add(TFHIRBoolean.Create(distinct).noExtensions); end; result.link; finally @@ -2340,15 +2351,17 @@ function TFHIRPathEngine.funcJoin(context: TFHIRPathExecutionContext; focus: TFH param : String; b : TFslStringBuilder; o : TFHIRSelection; + first : boolean; begin nl := execute(context, focus, exp.Parameters[0], true); try b := TFslStringBuilder.Create; try param := nl[0].value.primitiveValue; + first := true; for o in focus do begin - b.seperator(param); + if (first) then first := false else b.Append(param); b.append(o.value.primitiveValue); end; result := TFHIRSelectionList.Create(TFhirString.Create(b.ToString)); @@ -2378,14 +2391,14 @@ function TFHIRPathEngine.funcIndexOf(context: TFHIRPathExecutionContext; focus: begin sw := convertToString(nl); if (sw = '') then - result.add(TFHIRInteger.create(0)) + result.add(TFHIRInteger.Create(0)) else // if (focus[0].hasType(FHIR_TYPES_STRING)) then begin s := convertToString(focus[0].value); if (s = '') then - result.add(TFHIRInteger.create(0)) + result.add(TFHIRInteger.Create(0)) else - result.add(TFHIRInteger.create(s.indexOf(sw))); + result.add(TFHIRInteger.Create(s.indexOf(sw))); end; end; finally @@ -2414,7 +2427,7 @@ function TFHIRPathEngine.funcLength(context : TFHIRPathExecutionContext; focus: if (focus.count = 1) then begin s := convertToString(focus[0].value); - result.add(TFHIRInteger.create(inttostr(s.length)).noExtensions); + result.add(TFHIRInteger.Create(inttostr(s.length)).noExtensions); end; result.Link; finally @@ -2533,13 +2546,13 @@ function TFHIRPathEngine.funcMatches(context : TFHIRPathExecutionContext; focus: begin p := convertToString(res); if (p = '') then - result.add(TFHIRBoolean.create(false)) + result.add(TFHIRBoolean.Create(false)) else begin reg := TRegularExpression.Create('(?s)' + p, [roCompiled]); try s := convertToString(focus[0].value); - result.add(TFHIRBoolean.create(reg.isMatch(s))); + result.add(TFHIRBoolean.Create(reg.isMatch(s))); finally reg.free; end; @@ -2559,7 +2572,7 @@ function TFHIRPathEngine.funcMatchesFull(context : TFHIRPathExecutionContext; fo var res : TFHIRSelectionList; s, p : String; - reg : TRegularExpression; + reg : TREgularExpression; begin result := TFHIRSelectionList.Create; try @@ -2571,13 +2584,13 @@ function TFHIRPathEngine.funcMatchesFull(context : TFHIRPathExecutionContext; fo begin p := convertToString(res); if (p = '') then - result.add(TFHIRBoolean.create(false)) + result.add(TFHIRBoolean.Create(false)) else begin - reg := TRegularExpression.Create('(?s)' + p, [roCompiled]); + reg := TREgularExpression.Create('(?s)' + p, [roCompiled]); try s := convertToString(focus[0].value); - result.add(TFHIRBoolean.create(reg.isFullMatch(s))); + result.add(TFHIRBoolean.Create(reg.isFullMatch(s))); finally reg.free; end; @@ -2595,7 +2608,7 @@ function TFHIRPathEngine.funcMatchesFull(context : TFHIRPathExecutionContext; fo function TFHIRPathEngine.funcMemberOf(context: TFHIRPathExecutionContext; focus: TFHIRSelectionList; exp: TFHIRPathExpressionNode): TFHIRSelectionList; begin - raise EFHIRPathTodo.create('TFHIRPathEngine.funcMemberOf'); + raise EFHIRPathTodo.Create('TFHIRPathEngine.funcMemberOf'); end; function TFHIRPathEngine.funcNot(context : TFHIRPathExecutionContext; focus: TFHIRSelectionList; exp: TFHIRPathExpressionNode): TFHIRSelectionList; @@ -2704,7 +2717,7 @@ function TFHIRPathEngine.funcReplace(context: TFHIRPathExecutionContext; focus: begin f := convertToString(focus[0].value); if (f = '') then - result.add(TFHIRString.create('')) + result.add(TFHIRString.Create('')) else if (t = '') then begin b := TFslStringBuilder.Create; @@ -2715,7 +2728,7 @@ function TFHIRPathEngine.funcReplace(context: TFHIRPathExecutionContext; focus: b.append(f[i]); b.append(r); end; - result.add(TFHIRString.create(b.toString)) + result.add(TFHIRString.Create(b.toString)) finally b.free; end; @@ -2723,7 +2736,7 @@ function TFHIRPathEngine.funcReplace(context: TFHIRPathExecutionContext; focus: else begin n := f.replace(t, r); - result.add(TFHIRString.create(n)); + result.add(TFHIRString.Create(n)); end end else @@ -2762,13 +2775,13 @@ function TFHIRPathEngine.funcReplaceMatches( context: TFHIRPathExecutionContext; begin f := convertToString(focus[0].value); if (f = '') then - result.add(TFHIRString.create('')) + result.add(TFHIRString.Create('')) else if (t = '') then - result.add(TFHIRString.create(f)) + result.add(TFHIRString.Create(f)) else begin n := f.replace(t, r); - result.add(TFHIRString.create(TRegularExpression.replace(n, t, r))); + result.add(TFHIRString.Create(TRegularExpression.replace(n, t, r))); end end else @@ -2833,7 +2846,7 @@ function TFHIRPathEngine.funcResolve(context : TFHIRPathExecutionContext; focus: else begin if not assigned(FOnResolveReference) then - raise EFHIRPath.create('resolve() - resolution services for '+exp.name+' not implemented yet'); + raise EFHIRPath.Create('resolve() - resolution services for '+exp.name+' not implemented yet'); res := FOnResolveReference(self, context.appInfo, s); end; if (res <> nil) then @@ -2934,7 +2947,7 @@ function TFHIRPathEngine.funcSelect(context: TFHIRPathExecutionContext; focus: T function TFHIRPathEngine.funcSingle(context: TFHIRPathExecutionContext; focus: TFHIRSelectionList; exp: TFHIRPathExpressionNode): TFHIRSelectionList; begin if (focus.count <> 1) then - raise EFHIRPath.create(StringFormat('Single() : checking for 1 item but found %d items', [focus.count])); + raise EFHIRPath.Create(StringFormat('Single() : checking for 1 item but found %d items', [focus.count])); result := focus.link; end; @@ -2967,9 +2980,9 @@ function TFHIRPathEngine.funcStartsWith(context : TFHIRPathExecutionContext; foc begin sw := convertToString(swb); if (sw = '') then - result.add(TFHIRBoolean.create(true).noExtensions) + result.add(TFHIRBoolean.Create(true).noExtensions) else - result.add(TFHIRBoolean.create(convertToString(focus[0].value).startsWith(sw)).noExtensions); + result.add(TFHIRBoolean.Create(convertToString(focus[0].value).startsWith(sw)).noExtensions); end; finally swb.free; @@ -3010,7 +3023,7 @@ function TFHIRPathEngine.funcSubsetOf(context: TFHIRPathExecutionContext; focus: break; end; end; - result := TFHIRSelectionList.Create(TFHIRBoolean.create(valid).noExtensions); + result := TFHIRSelectionList.Create(TFHIRBoolean.Create(valid).noExtensions); finally target.free; end; @@ -3098,7 +3111,7 @@ function TFHIRPathEngine.funcExists(context: TFHIRPathExecutionContext; focus: T pc.free; end; - result.add(TFHIRBoolean.create(not empty).noExtensions); + result.add(TFHIRBoolean.Create(not empty).noExtensions); result.link; finally result.free; @@ -3168,7 +3181,7 @@ function TFHIRPathEngine.funcSupersetOf( context: TFHIRPathExecutionContext; foc break; end; end; - result := TFHIRSelectionList.Create(TFHIRBoolean.create(valid).noExtensions); + result := TFHIRSelectionList.Create(TFHIRBoolean.Create(valid).noExtensions); finally target.free; end; @@ -3533,17 +3546,24 @@ function TFHIRPathEngine.funcCombine(context : TFHIRPathExecutionContext; focus: var item : TFHIRSelection; res : TFHIRSelectionList; + fl : TFHIRSelectionList; begin result := TFHIRSelectionList.Create; try for item in focus do result.add(item.link); - res := execute(context, focus, exp.Parameters[0], true); + fl := TFHIRSelectionList.create; try - for item in res do - result.add(item.link); + fl.add(context.this.link); + res := execute(context, fl, exp.Parameters[0], true); + try + for item in res do + result.add(item.link); + finally + res.free; + end; finally - res.free; + fl.free; end; result.Link; finally @@ -3557,7 +3577,7 @@ function TFHIRPathEngine.funcType(context : TFHIRPathExecutionContext; focus: TF begin result := TFHIRSelectionList.Create; for item in focus do - result.add(TFHIRClassTypeInfo.create(item.value.Link)); + result.add(TFHIRClassTypeInfo.Create(item.value.Link)); end; function TFHIRPathEngine.funcOfType(context : TFHIRPathExecutionContext; focus: TFHIRSelectionList; exp : TFHIRPathExpressionNode) : TFHIRSelectionList; @@ -3615,18 +3635,19 @@ function TFHIRPathEngine.funcPower(context: TFHIRPathExecutionContext; focus: TF function TFHIRPathEngine.funcElementDefinition(context : TFHIRPathExecutionContext; focus: TFHIRSelectionList; exp : TFHIRPathExpressionNode) : TFHIRSelectionList; begin - raise EFHIRTodo.create('TFHIRPathEngine.funcElementDefinition'); + raise EFHIRTodo.Create('TFHIRPathEngine.funcElementDefinition'); end; function TFHIRPathEngine.funcSlice(context : TFHIRPathExecutionContext; focus: TFHIRSelectionList; exp : TFHIRPathExpressionNode) : TFHIRSelectionList; begin - raise EFHIRTodo.create('TFHIRPathEngine.funcSlice'); + raise EFHIRTodo.Create('TFHIRPathEngine.funcSlice'); end; function TFHIRPathEngine.funcSplit(context: TFHIRPathExecutionContext; focus: TFHIRSelectionList; exp: TFHIRPathExpressionNode): TFHIRSelectionList; var nl : TFHIRSelectionList; param, s : String; + p : TStringArray; begin nl := execute(context, focus, exp.Parameters[0], true); try @@ -3634,8 +3655,11 @@ function TFHIRPathEngine.funcSplit(context: TFHIRPathExecutionContext; focus: TF result := TFHIRSelectionList.Create(); try if focus.Count = 1 then - for s in focus[0].value.primitiveValue.Split([param]) do + begin + p := focus[0].value.primitiveValue.Split([param]); + for s in p do result.add(TFhirString.Create(s)); + end; result.Link; finally result.free; @@ -3718,19 +3742,19 @@ function TFHIRPathEngine.funcLowBoundary(context : TFHIRPathExecutionContext; fo base := focus[0].value; if (base.hasType('decimal')) then - result.add(TFhirDecimal.create(lowBoundaryForDecimal(base.primitiveValue(), dp(8)))) + result.add(TFhirDecimal.Create(lowBoundaryForDecimal(base.primitiveValue(), dp(8)))) else if (base.hasType('date')) then - result.add(TFHIRDateTime.create(lowBoundaryForDate(base.primitiveValue(), dp(8)))) + result.add(TFHIRDateTime.Create(lowBoundaryForDate(base.primitiveValue(), dp(8)))) else if (base.hasType('dateTime')) then - result.add(TFHIRDateTime.create(lowBoundaryForDate(base.primitiveValue(), dp(17)))) + result.add(TFHIRDateTime.Create(lowBoundaryForDate(base.primitiveValue(), dp(17)))) else if (base.hasType('time')) then - result.add(TFHIRTime.create(lowBoundaryForTime(base.primitiveValue(), dp(9)))) + result.add(TFHIRTime.Create(lowBoundaryForTime(base.primitiveValue(), dp(9)))) else if (base.hasType('Quantity')) then begin value := base.getPrimitiveValue('value'); v := base.Clone; result.add(v); - v.setProperty('value', TFHIRDecimal.create(lowBoundaryForDecimal(value, dp(8)))); + v.setProperty('value', TFHIRDecimal.Create(lowBoundaryForDecimal(value, dp(8)))); end else raise EFHIRPath.Create('Unable to generate low boundary for '+base.fhirType); @@ -3777,19 +3801,19 @@ function TFHIRPathEngine.funcHighBoundary(context : TFHIRPathExecutionContext; f base := focus[0].value; if (base.hasType('decimal')) then - result.add(TFhirDecimal.create(highBoundaryForDecimal(base.primitiveValue(), dp(8)))) + result.add(TFhirDecimal.Create(highBoundaryForDecimal(base.primitiveValue(), dp(8)))) else if (base.hasType('date')) then - result.add(TFHIRDateTime.create(highBoundaryForDate(base.primitiveValue(), dp(8)))) + result.add(TFHIRDateTime.Create(highBoundaryForDate(base.primitiveValue(), dp(8)))) else if (base.hasType('dateTime')) then - result.add(TFHIRDateTime.create(highBoundaryForDate(base.primitiveValue(), dp(17)))) + result.add(TFHIRDateTime.Create(highBoundaryForDate(base.primitiveValue(), dp(17)))) else if (base.hasType('time')) then - result.add(TFHIRTime.create(highBoundaryForTime(base.primitiveValue(), dp(9)))) + result.add(TFHIRTime.Create(highBoundaryForTime(base.primitiveValue(), dp(9)))) else if (base.hasType('Quantity')) then begin value := base.getPrimitiveValue('value'); v := base.Clone; result.add(v); - v.setProperty('value', TFHIRDecimal.create(highBoundaryForDecimal(value, dp(8)))); + v.setProperty('value', TFHIRDecimal.Create(highBoundaryForDecimal(value, dp(8)))); end else raise EFHIRPath.Create('Unable to generate low boundary for '+base.fhirType); @@ -3800,6 +3824,55 @@ function TFHIRPathEngine.funcHighBoundary(context : TFHIRPathExecutionContext; f end; end; +function TFHIRPathEngine.funcComparable(context : TFHIRPathExecutionContext; focus : TFHIRSelectionList; exp : TFHIRPathExpressionNode) : TFHIRSelectionList; +var + n1 : TFHIRSelectionList; + s1, u1, s2, u2 : String; +begin + result := TFHIRSelectionList.Create; + try + if (focus.Count <> 1) or (focus[0].value.fhirType <> 'Quantity') then + result.add(TFHIRBoolean.Create(false)) + else + begin + n1 := execute(context, focus, exp.Parameters[0], true); + try + if (n1.Count <> 1) or (n1[0].value.fhirType <> 'Quantity') then + result.add(TFHIRBoolean.Create(false)) + else + begin + s1 := focus[0].value.getPrimitiveValue('system'); + u1 := focus[0].value.getPrimitiveValue('code'); + s2 := n1[0].value.getPrimitiveValue('system'); + u2 := n1[0].value.getPrimitiveValue('code'); + + if (s1 = '') or (s2 = '') or (s1 <> s2) then + result.add(TFHIRBoolean.Create(false)) + else if (u1 = '') or (u2 = '') then + result.add(TFHIRBoolean.Create(false)) + else if (u1 = u2) then + result.add(TFHIRBoolean.Create(true)) + else if (s1 = 'http://unitsofmeasure.org') and (FUcum <> nil) then + begin + try + result.add(TFHIRBoolean.Create(FUcum.isComparable(u1, u2))); + except + result.add(TFHIRBoolean.Create(false)); + end; + end + else + result.add(TFHIRBoolean.Create(false)) + end; + finally + n1.free; + end; + end; + result.Link; + finally + result.free; + end; +end; + function TFHIRPathEngine.funcPrecision(context : TFHIRPathExecutionContext; focus : TFHIRSelectionList; exp : TFHIRPathExpressionNode) : TFHIRSelectionList; var base : TFhirObject; @@ -3813,11 +3886,11 @@ function TFHIRPathEngine.funcPrecision(context : TFHIRPathExecutionContext; focu base := focus[0].value; if (base.hasType('decimal')) then - result.add(TFHIRInteger.create(getDecimalPrecision(base.primitiveValue()))) + result.add(TFHIRInteger.Create(getDecimalPrecision(base.primitiveValue()))) else if (base.hasType('date') or base.hasType('dateTime')) then - result.add(TFHIRInteger.create(getDatePrecision(base.primitiveValue()))) + result.add(TFHIRInteger.Create(getDatePrecision(base.primitiveValue()))) else if (base.hasType('time')) then - result.add(TFHIRInteger.create(getTimePrecision(base.primitiveValue()))) + result.add(TFHIRInteger.Create(getTimePrecision(base.primitiveValue()))) else raise EFHIRPath.Create('Unable to get precision for '+base.fhirType); end; @@ -3831,7 +3904,7 @@ function TFHIRPathEngine.funcCeiling(context: TFHIRPathExecutionContext; focus: var base : TFHIRObject; qty : TFHIRQuantity; - d : TFslDecimal; + v : TFslDecimal; begin if (focus.count <> 1) then raise EFHIRPath.Create('Error evaluating FHIRPath expression: focus for floor has more than one value'); @@ -3845,10 +3918,10 @@ function TFHIRPathEngine.funcCeiling(context: TFHIRPathExecutionContext; focus: begin qty := (base as TFhirQuantity).Clone; try - d := TFslDecimal.Create(qty.value); - d := d.Trunc; - d := d.AddInt(1); - qty.value := d.AsString; + v := TFslDecimal.Create(qty.value); + v := v.trunc; + v := v.addInt(1); + qty.value := v.AsString; result.add(qty.Link); finally qty.free; @@ -3909,7 +3982,7 @@ function TFHIRPathEngine.funcCheckModifiers(context : TFHIRPathExecutionContext; function TFHIRPathEngine.funcConformsTo(context : TFHIRPathExecutionContext; focus: TFHIRSelectionList; exp : TFHIRPathExpressionNode) : TFHIRSelectionList; begin - raise EFHIRTodo.create('TFHIRPathEngine.funcConformsTo'); + raise EFHIRTodo.Create('TFHIRPathEngine.funcConformsTo'); end; function TFHIRPathEngine.funcAbs(context: TFHIRPathExecutionContext; focus: TFHIRSelectionList; exp: TFHIRPathExpressionNode): TFHIRSelectionList; @@ -4145,7 +4218,7 @@ function TFHIRPathEngine.funcLower(context : TFHIRPathExecutionContext; focus : begin sw := convertToString(focus[0].value); if sw <> '' then - result.add(TFHIRString.create(sw.ToLower).noExtensions); + result.add(TFHIRString.Create(sw.ToLower).noExtensions); end; result.Link; finally @@ -4163,7 +4236,7 @@ function TFHIRPathEngine.funcUpper(context : TFHIRPathExecutionContext; focus : begin sw := convertToString(focus[0].value); if sw <> '' then - result.add(TFHIRString.create(sw.ToUpper).noExtensions); + result.add(TFHIRString.Create(sw.ToUpper).noExtensions); end; result.Link; finally @@ -4182,7 +4255,7 @@ function TFHIRPathEngine.funcToChars(context : TFHIRPathExecutionContext; focus begin sw := convertToString(focus[0].value); for c in sw do - result.add(TFHIRString.create(c).noExtensions); + result.add(TFHIRString.Create(c).noExtensions); end; result.Link; finally @@ -4203,8 +4276,8 @@ function TFHIRPathEngine.funcToBoolean(context : TFHIRPathExecutionContext; focu else if (focus[0].value is TFHIRInteger) then begin case StrToInt((focus[0].value as TFHIRInteger).value) of - 0: result.add(TFHIRBoolean.create(false).noExtensions()); - 1: result.add(TFHIRBoolean.create(true).noExtensions()); + 0: result.add(TFHIRBoolean.Create(false).noExtensions()); + 1: result.add(TFHIRBoolean.Create(true).noExtensions()); else end; end @@ -4212,15 +4285,15 @@ function TFHIRPathEngine.funcToBoolean(context : TFHIRPathExecutionContext; focu begin s := removeTrailingZeros(TFHIRDecimal(focus[0].value).value); if (s = '0') then - result.add(TFHIRBoolean.create(false).noExtensions()) + result.add(TFHIRBoolean.Create(false).noExtensions()) else if (s = '1') then - result.add(TFHIRBoolean.create(true).noExtensions()); + result.add(TFHIRBoolean.Create(true).noExtensions()); end else if (focus[0].value is TFHIRString) then if SameText('true', focus[0].value.primitiveValue) then - result.add(TFHIRBoolean.create(true).noExtensions()) + result.add(TFHIRBoolean.Create(true).noExtensions()) else if SameText('false', focus[0].value.primitiveValue) then - result.add(TFHIRBoolean.create(false).noExtensions()); + result.add(TFHIRBoolean.Create(false).noExtensions()); end; result.Link; finally @@ -4258,12 +4331,12 @@ function TFHIRPathEngine.funcToQuantity(context : TFHIRPathExecutionContext; foc function TFHIRPathEngine.funcToDateTime(context : TFHIRPathExecutionContext; focus : TFHIRSelectionList; exp : TFHIRPathExpressionNode) : TFHIRSelectionList; begin - raise EFHIRTodo.create('TFHIRPathEngine.funcToDateTime'); + raise EFHIRTodo.Create('TFHIRPathEngine.funcToDateTime'); end; function TFHIRPathEngine.funcToTime(context : TFHIRPathExecutionContext; focus : TFHIRSelectionList; exp : TFHIRPathExpressionNode) : TFHIRSelectionList; begin - raise EFHIRTodo.create('TFHIRPathEngine.funcToTime'); + raise EFHIRTodo.Create('TFHIRPathEngine.funcToTime'); end; function TFHIRPathEngine.funcIsInteger(context : TFHIRPathExecutionContext; focus : TFHIRSelectionList; exp : TFHIRPathExpressionNode) : TFHIRSelectionList; @@ -4271,15 +4344,15 @@ function TFHIRPathEngine.funcIsInteger(context : TFHIRPathExecutionContext; focu result := TFHIRSelectionList.Create; try if (focus.count <> 1) then - result.add(TFHIRBoolean.create(false).noExtensions()) + result.add(TFHIRBoolean.Create(false).noExtensions()) else if (focus[0].value is TFHIRInteger) then - result.add(TFHIRBoolean.create(true).noExtensions()) + result.add(TFHIRBoolean.Create(true).noExtensions()) else if (focus[0].value is TFHIRBoolean) then - result.add(TFHIRBoolean.create(true).noExtensions()) + result.add(TFHIRBoolean.Create(true).noExtensions()) else if (focus[0].value is TFHIRString) then - result.add(TFHIRBoolean.create(StringIsInteger32(convertToString(focus[0].value))).noExtensions()) + result.add(TFHIRBoolean.Create(StringIsInteger32(convertToString(focus[0].value))).noExtensions()) else - result.add(TFHIRBoolean.create(false).noExtensions()); + result.add(TFHIRBoolean.Create(false).noExtensions()); result.Link; finally result.free; @@ -4291,17 +4364,17 @@ function TFHIRPathEngine.funcIsDecimal(context : TFHIRPathExecutionContext; focu result := TFHIRSelectionList.Create; try if (focus.count <> 1) then - result.add(TFHIRBoolean.create(false).noExtensions()) + result.add(TFHIRBoolean.Create(false).noExtensions()) else if (focus[0].value is TFHIRInteger) then - result.add(TFHIRBoolean.create(true).noExtensions()) + result.add(TFHIRBoolean.Create(true).noExtensions()) else if (focus[0].value is TFHIRBoolean) then - result.add(TFHIRBoolean.create(true).noExtensions()) + result.add(TFHIRBoolean.Create(true).noExtensions()) else if (focus[0].value is TFHIRDecimal) then - result.add(TFHIRBoolean.create(true).noExtensions()) + result.add(TFHIRBoolean.Create(true).noExtensions()) else if (focus[0].value is TFHIRString) then - result.add(TFHIRBoolean.create(StringIsDecimal(convertToString(focus[0].value))).noExtensions()) + result.add(TFHIRBoolean.Create(StringIsDecimal(convertToString(focus[0].value))).noExtensions()) else - result.add(TFHIRBoolean.create(false).noExtensions()); + result.add(TFHIRBoolean.Create(false).noExtensions()); result.Link; finally result.free; @@ -4313,11 +4386,11 @@ function TFHIRPathEngine.funcIsString(context : TFHIRPathExecutionContext; focus result := TFHIRSelectionList.Create; try if (focus.count <> 1) then - result.add(TFHIRBoolean.create(false).noExtensions()) + result.add(TFHIRBoolean.Create(false).noExtensions()) else if not (focus[0].value is TFHIRDateTime) and not (focus[0].value is TFHIRTime) then - result.add(TFHIRBoolean.create(true).noExtensions()) + result.add(TFHIRBoolean.Create(true).noExtensions()) else - result.add(TFHIRBoolean.create(false).noExtensions()); + result.add(TFHIRBoolean.Create(false).noExtensions()); result.Link; finally result.free; @@ -4329,17 +4402,17 @@ function TFHIRPathEngine.funcIsBoolean(context : TFHIRPathExecutionContext; focu result := TFHIRSelectionList.Create; try if (focus.count <> 1) then - result.add(TFHIRBoolean.create(false).noExtensions()) + result.add(TFHIRBoolean.Create(false).noExtensions()) else if (focus[0].value is TFHIRInteger) and (StrToIntDef((focus[0].value as TFHIRInteger).value, -1) >= 0) and (StrToIntDef((focus[0].value as TFHIRInteger).value, -1) <= 1) then - result.add(TFHIRBoolean.create(true).noExtensions()) + result.add(TFHIRBoolean.Create(true).noExtensions()) else if (focus[0].value is TFHIRBoolean) then - result.add(TFHIRBoolean.create(true).noExtensions()) + result.add(TFHIRBoolean.Create(true).noExtensions()) else if (focus[0].value is TFHIRDecimal) then - result.add(TFHIRBoolean.create(StringArrayExistsSensitive(['0', '1'], removeTrailingZeros(focus[0].value.primitiveValue))).noExtensions()) + result.add(TFHIRBoolean.Create(StringArrayExistsSensitive(['0', '1'], removeTrailingZeros(focus[0].value.primitiveValue))).noExtensions()) else if (focus[0].value is TFHIRString) then - result.add(TFHIRBoolean.create(StringArrayExistsInSensitive(['true', 'false'], convertToString(focus[0].value))).noExtensions()) + result.add(TFHIRBoolean.Create(StringArrayExistsInSensitive(['true', 'false'], convertToString(focus[0].value))).noExtensions()) else - result.add(TFHIRBoolean.create(false).noExtensions()); + result.add(TFHIRBoolean.Create(false).noExtensions()); result.Link; finally result.free; @@ -4412,22 +4485,22 @@ function TFHIRPathEngine.funcIsQuantity(context : TFHIRPathExecutionContext; foc result := TFHIRSelectionList.Create; try if (focus.count <> 1) then - result.add(TFHIRBoolean.create(false).noExtensions()) + result.add(TFHIRBoolean.Create(false).noExtensions()) else if (focus[0].value is TFHIRInteger) then - result.add(TFHIRBoolean.create(true).noExtensions()) + result.add(TFHIRBoolean.Create(true).noExtensions()) else if (focus[0].value is TFHIRDecimal) then - result.add(TFHIRBoolean.create(true).noExtensions()) + result.add(TFHIRBoolean.Create(true).noExtensions()) else if (focus[0].value is TFHIRQuantity) then - result.add(TFHIRBoolean.create(true).noExtensions()) + result.add(TFHIRBoolean.Create(true).noExtensions()) else if (focus[0].value is TFHIRBoolean) then - result.add(TFHIRBoolean.create(true).noExtensions()) + result.add(TFHIRBoolean.Create(true).noExtensions()) else if (focus[0].value is TFHIRString) then begin q := parseQuantityString(focus[0].value.primitiveValue()); - result.add(TFHIRBoolean.create(q <> nil).noExtensions()); + result.add(TFHIRBoolean.Create(q <> nil).noExtensions()); end else - result.add(TFHIRBoolean.create(false).noExtensions()); + result.add(TFHIRBoolean.Create(false).noExtensions()); result.Link; finally result.free; @@ -4440,15 +4513,15 @@ function TFHIRPathEngine.funcIsDate(context: TFHIRPathExecutionContext; focus: T result := TFHIRSelectionList.Create; try if (focus.count <> 1) then - result.add(TFHIRBoolean.create(false).noExtensions()) + result.add(TFHIRBoolean.Create(false).noExtensions()) else if (focus[0].value is TFHIRDateTime) or (focus[0].value is TFHIRDate) then - result.add(TFHIRBoolean.create(true).noExtensions()) + result.add(TFHIRBoolean.Create(true).noExtensions()) else if (focus[0].value is TFHIRString) then - result.add(TFHIRBoolean.create(TRegularExpression.isMatch(convertToString(focus[0].value), + result.add(TFHIRBoolean.Create(TRegularExpression.isMatch(convertToString(focus[0].value), '([0-9]([0-9]([0-9][1-9]|[1-9]0)|[1-9]00)|[1-9]000)(-(0[1-9]|1[0-2])(-(0[1-9]|[1-2][0-9]|3[0-1]))?)?' )).noExtensions()) else - result.add(TFHIRBoolean.create(false).noExtensions()); + result.add(TFHIRBoolean.Create(false).noExtensions()); result.Link; finally result.free; @@ -4460,15 +4533,15 @@ function TFHIRPathEngine.funcIsDateTime(context : TFHIRPathExecutionContext; foc result := TFHIRSelectionList.Create; try if (focus.count <> 1) then - result.add(TFHIRBoolean.create(false).noExtensions()) + result.add(TFHIRBoolean.Create(false).noExtensions()) else if (focus[0].value is TFHIRDateTime) or (focus[0].value is TFHIRDate) then - result.add(TFHIRBoolean.create(true).noExtensions()) + result.add(TFHIRBoolean.Create(true).noExtensions()) else if (focus[0].value is TFHIRString) then - result.add(TFHIRBoolean.create(TRegularExpression.isMatch(convertToString(focus[0].value), + result.add(TFHIRBoolean.Create(TRegularExpression.isMatch(convertToString(focus[0].value), '([0-9]([0-9]([0-9][1-9]|[1-9]0)|[1-9]00)|[1-9]000)(-(0[1-9]|1[0-2])(-(0[1-9]|[1-2][0-9]|3[0-1])(T([01][0-9]|2[0-3]):[0-5][0-9]:([0-5][0-9]|60)(\.[0-9]+)?(Z|(\+|-)((0[0-9]|1[0-3]):[0-5][0-9]|14:00))?)?)?)?' )).noExtensions()) else - result.add(TFHIRBoolean.create(false).noExtensions()); + result.add(TFHIRBoolean.Create(false).noExtensions()); result.Link; finally result.free; @@ -4480,14 +4553,14 @@ function TFHIRPathEngine.funcIsTime(context : TFHIRPathExecutionContext; focus : result := TFHIRSelectionList.Create; try if (focus.count <> 1) then - result.add(TFHIRBoolean.create(false).noExtensions()) + result.add(TFHIRBoolean.Create(false).noExtensions()) else if (focus[0].value is TFHIRTime) then - result.add(TFHIRBoolean.create(true).noExtensions()) + result.add(TFHIRBoolean.Create(true).noExtensions()) else if (focus[0].value is TFHIRString) then - result.add(TFHIRBoolean.create(TRegularExpression.IsMatch(convertToString(focus[0].value), + result.add(TFHIRBoolean.Create(TRegularExpression.IsMatch(convertToString(focus[0].value), '(T)?([01][0-9]|2[0-3])(:[0-5][0-9](:([0-5][0-9]|60))?)?(\\.[0-9]+)?(Z|(\\+|-)((0[0-9]|1[0-3]):[0-5][0-9]|14:00))?')).noExtensions()) else - result.add(TFHIRBoolean.create(false).noExtensions()); + result.add(TFHIRBoolean.Create(false).noExtensions()); result.Link; finally result.free; @@ -4519,7 +4592,7 @@ function TFHIRPathEngine.preOperate(left: TFHIRSelectionList; op: TFHIRPathOpera function TFHIRPathEngine.operate(left: TFHIRSelectionList; op: TFHIRPathOperation; right: TFHIRSelectionList): TFHIRSelectionList; begin case op of - popNull: raise EFHIRPath.create('An internal error has occurred'); + popNull: raise EFHIRPath.Create('An internal error has occurred'); popEquals: result := opequal(left, right); popEquivalent: result := opEquivalent(left, right); popNotEquals: result := opNotequal(left, right); @@ -4544,9 +4617,9 @@ function TFHIRPathEngine.operate(left: TFHIRSelectionList; op: TFHIRPathOperatio popMod: result := opMod(left, right); popIs: result := opIs(left, right); popAs: result := opAs(left, right); - popCustom : raise EFHIRPath.create('An internal error has occurred (custom operation not implemented)'); + popCustom : raise EFHIRPath.Create('An internal error has occurred (custom operation not implemented)'); else - raise EFHIRPath.create('An internal error has occurred (operation not implemented)'); + raise EFHIRPath.Create('An internal error has occurred (operation not implemented)'); end; end; @@ -4554,37 +4627,37 @@ function TFHIRPathEngine.operate(left: TFHIRSelectionList; op: TFHIRPathOperatio function TFHIRPathEngine.operateTypes(left: TFHIRTypeDetails; op: TFHIRPathOperation; right: TFHIRTypeDetails): TFHIRTypeDetails; begin case op of - popEquals: result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); - popEquivalent: result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); - popNotEquals: result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); - popNotEquivalent: result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); - popLessThan: result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); - popGreater: result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); - popLessOrEqual: result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); - popGreaterOrEqual: result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); - popIs: result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); + popEquals: result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); + popEquivalent: result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); + popNotEquals: result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); + popNotEquivalent: result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); + popLessThan: result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); + popGreater: result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); + popLessOrEqual: result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); + popGreaterOrEqual: result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); + popIs: result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); popAs: result := TFHIRTypeDetails.createList(csSINGLETON, right.Types); popUnion: result := left.union(right); - popOr: result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); - popAnd: result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); - popXor: result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); - popImplies : result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); + popOr: result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); + popAnd: result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); + popXor: result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); + popImplies : result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); popTimes: begin - result := TFHIRTypeDetails.create(csSINGLETON, []); + result := TFHIRTypeDetails.Create(csSINGLETON, []); if (left.hasType(context, 'integer')) and (right.hasType(context, 'integer')) then result.addType(FP_integer) else if (left.hasType(context, ['integer', 'decimal'])) and (right.hasType(context, ['integer', 'decimal'])) then result.addType(FP_decimal); end; popDivideBy: begin - result := TFHIRTypeDetails.create(csSINGLETON, []); + result := TFHIRTypeDetails.Create(csSINGLETON, []); if (left.hasType(context, 'integer')) and (right.hasType(context, 'integer')) then result.addType(FP_decimal) else if (left.hasType(context, ['integer', 'decimal'])) and (right.hasType(context, ['integer', 'decimal'])) then result.addType(FP_decimal) end; popPlus: begin - result := TFHIRTypeDetails.create(csSINGLETON, []); + result := TFHIRTypeDetails.Create(csSINGLETON, []); if (left.hasType(context, 'integer')) and (right.hasType(context, 'integer')) then result.addType(FP_integer) else if (left.hasType(context, ['integer', 'decimal'])) and (right.hasType(context, ['integer', 'decimal'])) then @@ -4592,9 +4665,9 @@ function TFHIRPathEngine.operateTypes(left: TFHIRTypeDetails; op: TFHIRPathOpera else if (left.hasType(context, ['string', 'id', 'code', 'uri'])) and (right.hasType(context, ['string', 'id', 'code', 'uri'])) then result.addType(FP_string); end; - popConcatenate : result := TFHIRTypeDetails.create(csSINGLETON, ['string']); + popConcatenate : result := TFHIRTypeDetails.Create(csSINGLETON, ['string']); popMinus: begin - result := TFHIRTypeDetails.create(csSINGLETON, []); + result := TFHIRTypeDetails.Create(csSINGLETON, []); if (left.hasType(context, 'integer')) and (right.hasType(context, 'integer')) then result.addType(FP_integer) else if (left.hasType(context, ['integer', 'decimal'])) and (right.hasType(context, ['integer', 'decimal'])) then @@ -4606,22 +4679,22 @@ function TFHIRPathEngine.operateTypes(left: TFHIRTypeDetails; op: TFHIRPathOpera if (right.hasType(context, ['Quantity'])) then result.addType(left.type_) else - raise EFHIRPath.create(format('Error in date arithmetic: Unable to subtract type {0} from {1}', [right.type_, left.type_])); + raise EFHIRPath.Create(format('Error in date arithmetic: Unable to subtract type {0} from {1}', [right.type_, left.type_])); end; end; popDiv, popMod: begin - result := TFHIRTypeDetails.create(csSINGLETON, []); + result := TFHIRTypeDetails.Create(csSINGLETON, []); if (left.hasType(context, 'integer')) and (right.hasType(context, 'integer')) then result.addType(FP_integer) else if (left.hasType(context, ['integer', 'decimal'])) and (right.hasType(context, ['integer', 'decimal'])) then result.addType(FP_Decimal); end; - popIn: result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); - popContains: result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); + popIn: result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); + popContains: result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); // todo: add memberOf - popCustom : raise EFHIRPath.create('An internal error has occurred (operation not implemented)'); + popCustom : raise EFHIRPath.Create('An internal error has occurred (operation not implemented)'); else - raise EFHIRPathTodo.create('TFHIRPathEngine.operateTypes'); + raise EFHIRPathTodo.Create('TFHIRPathEngine.operateTypes'); end; end; @@ -4705,17 +4778,17 @@ function TFHIRPathEngine.opDiv(left, right: TFHIRSelectionList): TFHIRSelectionL pl, pr : TUcumPair; begin if (left.count = 0) then - raise EFHIRPath.create('Error performing div: left operand has no value'); + raise EFHIRPath.Create('Error performing div: left operand has no value'); if (left.count > 1) then - raise EFHIRPath.create('Error performing div: left operand has more than one value'); + raise EFHIRPath.Create('Error performing div: left operand has more than one value'); if (not left[0].value.isPrimitive()) and not left[0].value.hasType('Quantity') then - raise EFHIRPath.create(StringFormat('Error performing div: left operand has the wrong type (%s)', [left[0].value.fhirType])); + raise EFHIRPath.Create(StringFormat('Error performing div: left operand has the wrong type (%s)', [left[0].value.fhirType])); if (right.count = 0) then - raise EFHIRPath.create('Error performing div: right operand has no value'); + raise EFHIRPath.Create('Error performing div: right operand has no value'); if (right.count > 1) then - raise EFHIRPath.create('Error performing div: right operand has more than one value'); + raise EFHIRPath.Create('Error performing div: right operand has more than one value'); if (not right[0].value.isPrimitive()) and not right[0].value.hasType('Quantity') then - raise EFHIRPath.create(StringFormat('Error performing div: right operand has the wrong type (%s)', [right[0].value.fhirType])); + raise EFHIRPath.Create(StringFormat('Error performing div: right operand has the wrong type (%s)', [right[0].value.fhirType])); result := TFHIRSelectionList.Create(); try @@ -4725,7 +4798,7 @@ function TFHIRPathEngine.opDiv(left, right: TFHIRSelectionList): TFHIRSelectionL if (l.hasType('integer')) and (r.hasType('integer')) then begin if r.primitiveValue() <> '0' then - result.add(TFHIRInteger.create(inttostr(strtoInt(l.primitiveValue()) div strtoInt(r.primitiveValue()))).noExtensions) + result.add(TFHIRInteger.Create(inttostr(strtoInt(l.primitiveValue()) div strtoInt(r.primitiveValue()))).noExtensions) end else if (l.hasType(['quantity'])) and (r.hasType(['quantity'])) and (FUcum <> nil) and FUcum.isConfigured then begin @@ -4755,10 +4828,10 @@ function TFHIRPathEngine.opDiv(left, right: TFHIRSelectionList): TFHIRSelectionL d1 := TFslDecimal.valueOf(l.primitiveValue()); d2 := TFslDecimal.valueOf(r.primitiveValue()); d3 := d1.divInt(d2); - result.add(TFHIRDecimal.create(d3.asDecimal).noExtensions); + result.add(TFHIRDecimal.Create(d3.asDecimal).noExtensions); end else - raise EFHIRPath.create(StringFormat('Error performing div: left and right operand have incompatible or illegal types (%s, %s)', [left[0].value.fhirType(), right[0].value.fhirType()])); + raise EFHIRPath.Create(StringFormat('Error performing div: left and right operand have incompatible or illegal types (%s, %s)', [left[0].value.fhirType(), right[0].value.fhirType()])); result.Link; finally result.free; @@ -4772,17 +4845,17 @@ function TFHIRPathEngine.opDivideBy(left, right: TFHIRSelectionList): TFHIRSelec pl, pr, p : TUcumPair; begin if (left.count = 0) then - raise EFHIRPath.create('Error performing /: left operand has no value'); + raise EFHIRPath.Create('Error performing /: left operand has no value'); if (left.count > 1) then - raise EFHIRPath.create('Error performing /: left operand has more than one value'); + raise EFHIRPath.Create('Error performing /: left operand has more than one value'); if (not left[0].value.isPrimitive()) and not left[0].value.hasType('Quantity') then - raise EFHIRPath.create(StringFormat('Error performing -: left operand has the wrong type (%s)', [left[0].value.fhirType()])); + raise EFHIRPath.Create(StringFormat('Error performing -: left operand has the wrong type (%s)', [left[0].value.fhirType()])); if (right.count = 0) then - raise EFHIRPath.create('Error performing /: right operand has no value'); + raise EFHIRPath.Create('Error performing /: right operand has no value'); if (right.count > 1) then - raise EFHIRPath.create('Error performing /: right operand has more than one value'); + raise EFHIRPath.Create('Error performing /: right operand has more than one value'); if (not right[0].value.isPrimitive()) and not right[0].value.hasType('Quantity') then - raise EFHIRPath.create(StringFormat('Error performing /: right operand has the wrong type (%s)', [right[0].value.fhirType()])); + raise EFHIRPath.Create(StringFormat('Error performing /: right operand has the wrong type (%s)', [right[0].value.fhirType()])); result := TFHIRSelectionList.Create(); try @@ -4795,7 +4868,7 @@ function TFHIRPathEngine.opDivideBy(left, right: TFHIRSelectionList): TFHIRSelec d2 := TFslDecimal.valueOf(r.primitiveValue()); d3 := d1.divide(d2); if not d3.IsUndefined then - result.add(TFHIRDecimal.create(d3.asDecimal).noExtensions); + result.add(TFHIRDecimal.Create(d3.asDecimal).noExtensions); end else if (l.hasType(['Quantity'])) and (r.hasType(['Quantity'])) and (FUcum <> nil) and FUcum.isConfigured then begin @@ -4820,7 +4893,7 @@ function TFHIRPathEngine.opDivideBy(left, right: TFHIRSelectionList): TFHIRSelec end; end else - raise EFHIRPath.create(StringFormat('Error performing /: left and right operand have incompatible or illegal types (%s, %s)', [left[0].value.fhirType(), right[0].value.fhirType()])); + raise EFHIRPath.Create(StringFormat('Error performing /: left and right operand have incompatible or illegal types (%s, %s)', [left[0].value.fhirType(), right[0].value.fhirType()])); result.link; finally result.free; @@ -4946,8 +5019,8 @@ function TFHIRPathEngine.opGreater(left, right: TFHIRSelectionList): TFHIRSelect dl := TFHIRSelectionList.Create; dr := TFHIRSelectionList.Create; try - dl.add(TFhirDecimal.create(qtyToCanonical(left[0].value as TFhirQuantity).Value)); - dr.add(TFhirDecimal.create(qtyToCanonical(right[0].value as TFhirQuantity).Value)); + dl.add(TFhirDecimal.Create(qtyToCanonical(left[0].value as TFhirQuantity).Value)); + dr.add(TFhirDecimal.Create(qtyToCanonical(right[0].value as TFhirQuantity).Value)); result := opGreater(dl, dr); finally dl.free; @@ -4955,7 +5028,7 @@ function TFHIRPathEngine.opGreater(left, right: TFHIRSelectionList): TFHIRSelect end; end else - raise EFHIRPath.create('Canonical Comparison isn''t available'); + raise EFHIRPath.Create('Canonical Comparison isn''t available'); finally lUnit.free; rUnit.free; @@ -5023,8 +5096,8 @@ function TFHIRPathEngine.opGreaterOrEqual(left, right: TFHIRSelectionList): TFHI dl := TFHIRSelectionList.Create; dr := TFHIRSelectionList.Create; try - dl.add(TFhirDecimal.create(qtyToCanonical(left[0].value as TFhirQuantity).Value)); - dr.add(TFhirDecimal.create(qtyToCanonical(right[0].value as TFhirQuantity).Value)); + dl.add(TFhirDecimal.Create(qtyToCanonical(left[0].value as TFhirQuantity).Value)); + dr.add(TFhirDecimal.Create(qtyToCanonical(right[0].value as TFhirQuantity).Value)); result := opGreaterOrEqual(dl, dr); finally dl.free; @@ -5032,7 +5105,7 @@ function TFHIRPathEngine.opGreaterOrEqual(left, right: TFHIRSelectionList): TFHI end; end else - raise EFHIRPath.create('Canonical Comparison isn''t available'); + raise EFHIRPath.Create('Canonical Comparison isn''t available'); finally lUnit.free; rUnit.free; @@ -5053,7 +5126,7 @@ function TFHIRPathEngine.opIn(left, right: TFHIRSelectionList): TFHIRSelectionLi if (left.count = 0) then exit(TFHIRSelectionList.Create); if (right.count = 0) then - exit(TFHIRSelectionList.Create(TFHIRBoolean.create(false))); + exit(TFHIRSelectionList.Create(TFHIRBoolean.Create(false))); ans := true; for l in left do begin @@ -5089,9 +5162,9 @@ function TFHIRPathEngine.opIs(left, right: TFHIRSelectionList): TFHIRSelectionLi begin tn := convertToString(right); if not (left[0].value is TFHIRElement) or (left[0].value as TFHIRElement).DisallowExtensions then - result.add(TFHIRBoolean.create((capitalise(left[0].value.fhirType) = tn) or ('System.'+capitalise(left[0].value.fhirType) = tn)).noExtensions) + result.add(TFHIRBoolean.Create((capitalise(left[0].value.fhirType) = tn) or ('System.'+capitalise(left[0].value.fhirType) = tn)).noExtensions) else - result.add(TFHIRBoolean.create(typeMatches(tn, left[0].value.fhirType, true)).noExtensions); + result.add(TFHIRBoolean.Create(typeMatches(tn, left[0].value.fhirType, true)).noExtensions); end; result.link; finally @@ -5154,8 +5227,8 @@ function TFHIRPathEngine.opLessOrEqual(left, right: TFHIRSelectionList): TFHIRSe dl := TFHIRSelectionList.Create; dr := TFHIRSelectionList.Create; try - dl.add(TFhirDecimal.create(qtyToCanonical(left[0].value as TFhirQuantity).value)); - dr.add(TFhirDecimal.create(qtyToCanonical(right[0].value as TFhirQuantity).Value)); + dl.add(TFhirDecimal.Create(qtyToCanonical(left[0].value as TFhirQuantity).value)); + dr.add(TFhirDecimal.Create(qtyToCanonical(right[0].value as TFhirQuantity).Value)); result := opLessOrEqual(dl, dr); finally dl.free; @@ -5163,7 +5236,7 @@ function TFHIRPathEngine.opLessOrEqual(left, right: TFHIRSelectionList): TFHIRSe end; end else - raise EFHIRPath.create('Canonical Comparison isn''t available'); + raise EFHIRPath.Create('Canonical Comparison isn''t available'); finally lUnit.free; rUnit.free; @@ -5232,8 +5305,8 @@ function TFHIRPathEngine.opLessThan(left, right: TFHIRSelectionList): TFHIRSelec dl := TFHIRSelectionList.Create; dr := TFHIRSelectionList.Create; try - dl.add(TFhirDecimal.create(qtyToCanonical(left[0].value as TFhirQuantity).Value)); - dr.add(TFhirDecimal.create(qtyToCanonical(right[0].value as TFhirQuantity).Value)); + dl.add(TFhirDecimal.Create(qtyToCanonical(left[0].value as TFhirQuantity).Value)); + dr.add(TFhirDecimal.Create(qtyToCanonical(right[0].value as TFhirQuantity).Value)); result := opLessThan(dl, dr); finally dl.free; @@ -5241,7 +5314,7 @@ function TFHIRPathEngine.opLessThan(left, right: TFHIRSelectionList): TFHIRSelec end; end else - raise EFHIRPath.create('Canonical Comparison isn''t available'); + raise EFHIRPath.Create('Canonical Comparison isn''t available'); finally lUnit.free; rUnit.free; @@ -5263,13 +5336,13 @@ function TFHIRPathEngine.opMinus(left, right: TFHIRSelectionList): TFHIRSelectio if (left.count = 0) or (right.count = 0) then exit(TFHIRSelectionList.Create); if (left.count > 1) then - raise EFHIRPath.create('Error performing -: left operand has more than one value'); + raise EFHIRPath.Create('Error performing -: left operand has more than one value'); if (not left[0].value.isPrimitive() and not left[0].hasType('Quantity')) then - raise EFHIRPath.create(StringFormat('Error performing -: left operand has the wrong type (%s)', [left[0].value.fhirType()])); + raise EFHIRPath.Create(StringFormat('Error performing -: left operand has the wrong type (%s)', [left[0].value.fhirType()])); if (right.count > 1) then - raise EFHIRPath.create('Error performing -: right operand has more than one value'); + raise EFHIRPath.Create('Error performing -: right operand has more than one value'); if (not right[0].value.isPrimitive() and not ((left[0].value.isDateTime() or ('0' = left[0].value.primitiveValue) or left[0].value.hasType('Quantity')) and right[0].value.hasType('Quantity'))) then - raise EFHIRPath.create(StringFormat('Error performing -: right operand has the wrong type (%s)', [right[0].value.fhirType()])); + raise EFHIRPath.Create(StringFormat('Error performing -: right operand has the wrong type (%s)', [right[0].value.fhirType()])); result := TFHIRSelectionList.Create(); try @@ -5277,13 +5350,13 @@ function TFHIRPathEngine.opMinus(left, right: TFHIRSelectionList): TFHIRSelectio r := right[0].value; if (l.hasType('integer')) and (r.hasType('integer')) then - result.add(TFHIRInteger.create(inttostr(strToInt(l.primitiveValue()) - strToInt(r.primitiveValue()))).noExtensions) + result.add(TFHIRInteger.Create(inttostr(strToInt(l.primitiveValue()) - strToInt(r.primitiveValue()))).noExtensions) else if (l.hasType('decimal') or l.hasType('integer')) and (r.hasType('decimal') or r.hasType('integer')) then begin d1 := TFslDecimal.valueOf(l.primitiveValue()); d2 := TFslDecimal.valueOf(r.primitiveValue()); d3 := d1.Subtract(d2); - result.add(TFHIRDecimal.create(d3.asDecimal).noExtensions); + result.add(TFHIRDecimal.Create(d3.asDecimal).noExtensions); end else if (l.hasType(['decimal', 'integer', 'Quantity']) and r.hasType('Quantity')) then begin @@ -5303,7 +5376,7 @@ function TFHIRPathEngine.opMinus(left, right: TFHIRSelectionList): TFHIRSelectio else if (l.isDateTime() and r.hasType('Quantity')) then result.add(dateAdd(l, r as TFHIRQuantity, true)) else - raise EFHIRPath.create(StringFormat('Error performing -: left and right operand have incompatible or illegal types (%s, %s)', [left[0].value.fhirType(), right[0].value.fhirType()])); + raise EFHIRPath.Create(StringFormat('Error performing -: left and right operand have incompatible or illegal types (%s, %s)', [left[0].value.fhirType(), right[0].value.fhirType()])); result.Link; finally result.free; @@ -5316,17 +5389,17 @@ function TFHIRPathEngine.opMod(left, right: TFHIRSelectionList): TFHIRSelectionL d1, d2, d3 : TFslDecimal; begin if (left.count = 0) then - raise EFHIRPath.create('Error performing mod: left operand has no value'); + raise EFHIRPath.Create('Error performing mod: left operand has no value'); if (left.count > 1) then - raise EFHIRPath.create('Error performing mod: left operand has more than one value'); + raise EFHIRPath.Create('Error performing mod: left operand has more than one value'); if (not left[0].value.isPrimitive()) then - raise EFHIRPath.create(StringFormat('Error performing mod: left operand has the wrong type (%s)', [left[0].value.fhirType()])); + raise EFHIRPath.Create(StringFormat('Error performing mod: left operand has the wrong type (%s)', [left[0].value.fhirType()])); if (right.count = 0) then - raise EFHIRPath.create('Error performing mod: right operand has no value'); + raise EFHIRPath.Create('Error performing mod: right operand has no value'); if (right.count > 1) then - raise EFHIRPath.create('Error performing mod: right operand has more than one value'); + raise EFHIRPath.Create('Error performing mod: right operand has more than one value'); if (not right[0].value.isPrimitive()) then - raise EFHIRPath.create(StringFormat('Error performing mod: right operand has the wrong type (%s)', [right[0].value.fhirType()])); + raise EFHIRPath.Create(StringFormat('Error performing mod: right operand has the wrong type (%s)', [right[0].value.fhirType()])); result := TFHIRSelectionList.Create(); try @@ -5336,17 +5409,17 @@ function TFHIRPathEngine.opMod(left, right: TFHIRSelectionList): TFHIRSelectionL if (l.hasType('integer')) and (r.hasType('integer')) then begin if r.primitiveValue() <> '0' then - result.add(TFHIRInteger.create(inttostr(strToInt(l.primitiveValue()) mod strToInt(r.primitiveValue()))).noExtensions) + result.add(TFHIRInteger.Create(inttostr(strToInt(l.primitiveValue()) mod strToInt(r.primitiveValue()))).noExtensions) end else if (l.hasType(['integer', 'decimal'])) and (r.hasType(['integer', 'decimal'])) then begin d1 := TFslDecimal.valueOf(l.primitiveValue()); d2 := TFslDecimal.valueOf(r.primitiveValue()); d3 := d1.Modulo(d2); - result.add(TFHIRDecimal.create(d3.asDecimal).noExtensions); + result.add(TFHIRDecimal.Create(d3.asDecimal).noExtensions); end else - raise EFHIRPath.create(StringFormat('Error performing mod: left and right operand have incompatible or illegal types (%s, %s)', [left[0].value.fhirType(), right[0].value.fhirType()])); + raise EFHIRPath.Create(StringFormat('Error performing mod: left and right operand have incompatible or illegal types (%s, %s)', [left[0].value.fhirType(), right[0].value.fhirType()])); result.Link; finally @@ -5443,13 +5516,13 @@ function TFHIRPathEngine.opConcatenate(left, right: TFHIRSelectionList): TFHIRSe l, r : String; begin if (left.count > 1) then - raise EFHIRPath.create('Error performing &: left operand has more than one value'); + raise EFHIRPath.Create('Error performing &: left operand has more than one value'); if (left.Count = 1) and (not left[0].value.hasType(FHIR_TYPES_STRING)) then - raise EFHIRPath.create(StringFormat('Error performing &: left operand has the wrong type (%s)', [left[0].value.fhirType()])); + raise EFHIRPath.Create(StringFormat('Error performing &: left operand has the wrong type (%s)', [left[0].value.fhirType()])); if (right.count > 1) then - raise EFHIRPath.create('Error performing &: right operand has more than one value'); + raise EFHIRPath.Create('Error performing &: right operand has more than one value'); if (right.Count = 1) and (not right[0].value.hasType(FHIR_TYPES_STRING)) then - raise EFHIRPath.create(StringFormat('Error performing &: right operand has the wrong type (%s)', [right[0].value.fhirType()])); + raise EFHIRPath.Create(StringFormat('Error performing &: right operand has the wrong type (%s)', [right[0].value.fhirType()])); result := TFHIRSelectionList.Create(); try @@ -5461,7 +5534,7 @@ function TFHIRPathEngine.opConcatenate(left, right: TFHIRSelectionList): TFHIRSe r := '' else r := right[0].value.primitiveValue(); - result.add(TFHIRString.create(l + r).noExtensions); + result.add(TFHIRString.Create(l + r).noExtensions); result.Link; finally result.free; @@ -5476,13 +5549,13 @@ function TFHIRPathEngine.opPlus(left, right: TFHIRSelectionList): TFHIRSelection if (left.count = 0) or (right.count = 0) then exit(TFHIRSelectionList.Create); if (left.count > 1) then - raise EFHIRPath.create('Error performing +: left operand has more than one value'); + raise EFHIRPath.Create('Error performing +: left operand has more than one value'); if (not left[0].value.isPrimitive()) then - raise EFHIRPath.create(StringFormat('Error performing +: left operand has the wrong type (%s)', [left[0].value.fhirType()])); + raise EFHIRPath.Create(StringFormat('Error performing +: left operand has the wrong type (%s)', [left[0].value.fhirType()])); if (right.count > 1) then - raise EFHIRPath.create('Error performing +: right operand has more than one value'); + raise EFHIRPath.Create('Error performing +: right operand has more than one value'); if (not right[0].value.isPrimitive() and not ((left[0].value.isDateTime() or ('0' = left[0].value.primitiveValue) or left[0].value.hasType('Quantity')) and right[0].value.hasType('Quantity'))) then - raise EFHIRPath.create(StringFormat('Error performing +: right operand has the wrong type (%s)', [right[0].value.fhirType()])); + raise EFHIRPath.Create(StringFormat('Error performing +: right operand has the wrong type (%s)', [right[0].value.fhirType()])); result := TFHIRSelectionList.Create(); try @@ -5490,20 +5563,20 @@ function TFHIRPathEngine.opPlus(left, right: TFHIRSelectionList): TFHIRSelection r := right[0].value; if (l.hasType(['string', 'id', 'code', 'uri'])) and (r.hasType(['string', 'id', 'code', 'uri'])) then - result.add(TFHIRString.create(l.primitiveValue() + r.primitiveValue()).noExtensions) + result.add(TFHIRString.Create(l.primitiveValue() + r.primitiveValue()).noExtensions) else if (l.hasType('integer')) and (r.hasType('integer')) then - result.add(TFHIRInteger.create(inttostr(strToInt(l.primitiveValue()) + strToInt(r.primitiveValue()))).noExtensions) + result.add(TFHIRInteger.Create(inttostr(strToInt(l.primitiveValue()) + strToInt(r.primitiveValue()))).noExtensions) else if (l.hasType(['integer', 'decimal'])) and (r.hasType(['integer', 'decimal'])) then begin d1 := TFslDecimal.valueOf(l.primitiveValue()); d2 := TFslDecimal.valueOf(r.primitiveValue()); d3 := d1.Add(d2); - result.add(TFHIRDecimal.create(d3.asDecimal).noExtensions); + result.add(TFHIRDecimal.Create(d3.asDecimal).noExtensions); end else if (l.isDateTime) and (r.hasType('Quantity')) then result.add(dateAdd(l, r as TFHIRQuantity, false)) else - raise EFHIRPath.create(StringFormat('Error performing +: left and right operand have incompatible or illegal types (%s, %s)', [left[0].value.fhirType(), right[0].value.fhirType()])); + raise EFHIRPath.Create(StringFormat('Error performing +: left and right operand have incompatible or illegal types (%s, %s)', [left[0].value.fhirType(), right[0].value.fhirType()])); result.Link; finally result.free; @@ -5517,17 +5590,17 @@ function TFHIRPathEngine.opTimes(left, right: TFHIRSelectionList): TFHIRSelectio p, pl, pr : TUcumPair; begin if (left.count = 0) then - raise EFHIRPath.create('Error performing *: left operand has no value'); + raise EFHIRPath.Create('Error performing *: left operand has no value'); if (left.count > 1) then - raise EFHIRPath.create('Error performing *: left operand has more than one value'); + raise EFHIRPath.Create('Error performing *: left operand has more than one value'); if (not left[0].value.isPrimitive()) and not left[0].value.hasType('Quantity') then - raise EFHIRPath.create(StringFormat('Error performing +: left operand has the wrong type (%s)', [left[0].value.fhirType()])); + raise EFHIRPath.Create(StringFormat('Error performing +: left operand has the wrong type (%s)', [left[0].value.fhirType()])); if (right.count = 0) then - raise EFHIRPath.create('Error performing *: right operand has no value'); + raise EFHIRPath.Create('Error performing *: right operand has no value'); if (right.count > 1) then - raise EFHIRPath.create('Error performing *: right operand has more than one value'); + raise EFHIRPath.Create('Error performing *: right operand has more than one value'); if (not right[0].value.isPrimitive()) and not right[0].value.hasType('Quantity') then - raise EFHIRPath.create(StringFormat('Error performing *: right operand has the wrong type (%s)', [right[0].value.fhirType()])); + raise EFHIRPath.Create(StringFormat('Error performing *: right operand has the wrong type (%s)', [right[0].value.fhirType()])); result := TFHIRSelectionList.Create(); try @@ -5535,7 +5608,7 @@ function TFHIRPathEngine.opTimes(left, right: TFHIRSelectionList): TFHIRSelectio r := right[0].value; if (l.hasType('integer')) and (r.hasType('integer')) then - result.add(TFHIRInteger.create(inttostr(strToInt(l.primitiveValue()) * strToInt(r.primitiveValue()))).noExtensions) + result.add(TFHIRInteger.Create(inttostr(strToInt(l.primitiveValue()) * strToInt(r.primitiveValue()))).noExtensions) else if (l.hasType(['Quantity'])) and (r.hasType(['Quantity'])) and (FUcum <> nil) and FUcum.isConfigured then begin pl := qtyToPair(l as TFHIRQuantity); @@ -5563,10 +5636,10 @@ function TFHIRPathEngine.opTimes(left, right: TFHIRSelectionList): TFHIRSelectio d1 := TFslDecimal.valueOf(l.primitiveValue()); d2 := TFslDecimal.valueOf(r.primitiveValue()); d3 := d1.Multiply(d2); - result.add(TFHIRDecimal.create(d3.asDecimal).noExtensions); + result.add(TFHIRDecimal.Create(d3.asDecimal).noExtensions); end else - raise EFHIRPath.create(StringFormat('Error performing /: left and right operand have incompatible or illegal types (%s, %s)', [left[0].value.fhirType(), right[0].value.fhirType()])); + raise EFHIRPath.Create(StringFormat('Error performing /: left and right operand have incompatible or illegal types (%s, %s)', [left[0].value.fhirType(), right[0].value.fhirType()])); result.link; finally result.free; @@ -5662,7 +5735,7 @@ function TFHIRPathEngine.resolveConstant(context : TFHIRPathExecutionContext; co else if (c.FValue.startsWith('@')) then result := processDateConstant(context.appInfo, c.FValue.substring(1)) else - raise EFHIRPath.create('Invaild FHIR Constant '+c.FValue); + raise EFHIRPath.Create('Invaild FHIR Constant '+c.FValue); end; function TFHIRPathEngine.processDateConstant(appinfo : TFslObject; value : String) : TFHIRObject; @@ -5671,7 +5744,7 @@ function TFHIRPathEngine.processDateConstant(appinfo : TFslObject; value : Strin v : string; begin if (value.startsWith('T')) then - exit(TFHIRTime.create(value.substring(1)).noExtensions()); + exit(TFHIRTime.Create(value.substring(1)).noExtensions()); v := value; if (v.length > 10) then @@ -5685,9 +5758,9 @@ function TFHIRPathEngine.processDateConstant(appinfo : TFslObject; value : Strin v := v.substring(0, 10+i); end; if (v.length > 10) then - result := TFHIRDateTime.create(TFslDateTime.fromXML(value)).noExtensions() + result := TFHIRDateTime.Create(TFslDateTime.fromXML(value)).noExtensions() else - result := TFHIRDate.create(TFslDateTime.fromXML(value)).noExtensions(); + result := TFHIRDate.Create(TFslDateTime.fromXML(value)).noExtensions(); end; function TFHIRPathEngine.qtyEqual(left, right: TFHIRQuantity): TEqualityTriState; @@ -5818,27 +5891,27 @@ function TFHIRPathEngine.resolveConstant(context : TFHIRPathExecutionContext; s ext : TFHIRPathEngineExtension; begin if (s = '%sct') then - result := TFHIRString.create(URI_SNOMED).noExtensions() + result := TFHIRString.Create(URI_SNOMED).noExtensions() else if (s = '%loinc') then - result := TFHIRString.create(URI_LOINC).noExtensions() + result := TFHIRString.Create(URI_LOINC).noExtensions() else if (s = '%ucum') then - result := TFHIRString.create(URI_UCUM).noExtensions() + result := TFHIRString.Create(URI_UCUM).noExtensions() else if (s = '%resource') then begin if (context.resource = nil) then - raise EFHIRPath.create('Cannot use %resource in this context'); + raise EFHIRPath.Create('Cannot use %resource in this context'); result := context.resource.Link; end else if (s = '%context') then result := context.context.link else if (s = '%us-zip') then - result := TFHIRString.create('[0-9]{5}(-[0-9]{4}){0,1}').noExtensions() + result := TFHIRString.Create('[0-9]{5}(-[0-9]{4}){0,1}').noExtensions() else if (s.startsWith('%`vs-')) then - result := TFHIRString.create('http://hl7.org/fhir/ValueSet/'+s.substring(5, s.length-6)).noExtensions() + result := TFHIRString.Create('http://hl7.org/fhir/ValueSet/'+s.substring(5, s.length-6)).noExtensions() else if (s.startsWith('%`cs-')) then - result := TFHIRString.create('http://hl7.org/fhir/'+s.substring(5, s.length-1)).noExtensions() + result := TFHIRString.Create('http://hl7.org/fhir/'+s.substring(5, s.length-1)).noExtensions() else if (s.startsWith('%`ext-')) then - result := TFHIRString.create('http://hl7.org/fhir/StructureDefinition/'+s.substring(6, s.length-7)).noExtensions() + result := TFHIRString.Create('http://hl7.org/fhir/StructureDefinition/'+s.substring(6, s.length-7)).noExtensions() else begin for ext in FExtensions do @@ -5846,7 +5919,7 @@ function TFHIRPathEngine.resolveConstant(context : TFHIRPathExecutionContext; s if ext.resolveConstant(context, s, result) then exit; end; - raise EFHIRPath.create('Unknown fixed constant "'+s+'"') + raise EFHIRPath.Create('Unknown fixed constant "'+s+'"') end; end; @@ -5869,7 +5942,7 @@ function TFHIRPathEngine.execute(context : TFHIRPathExecutionContext; focus: TFH else if atEntry and (exp.name = '$total') then work.addAll(context.total) else if atEntry and (exp.name = '$index') then - work.add(TFHIRInteger.create(context.index)) + work.add(TFHIRInteger.Create(context.index)) else for item in focus do begin @@ -5976,10 +6049,10 @@ function TFHIRPathEngine.execute(context : TFHIRPathExecutionContext; focus: TFH function TFHIRPathEngine.executeType(focus: String; exp: TFHIRPathExpressionNode; atEntry : boolean): TFHIRTypeDetails; begin if (atEntry and exp.Name[1].IsUpper) and (focus = TFHIRProfiledType.ns(exp.Name)) then - result := TFHIRTypeDetails.create(csSINGLETON, [focus]) + result := TFHIRTypeDetails.Create(csSINGLETON, [focus]) else begin - result := TFHIRTypeDetails.create(csNULL, []); + result := TFHIRTypeDetails.Create(csNULL, []); try ListChildTypesByName(focus, exp.name, result); result.Link; @@ -6089,9 +6162,10 @@ function TFHIRPathEngine.evaluateFunction(context : TFHIRPathExecutionContext; f pfLowBoundary : result := funcLowBoundary(context, focus, exp); pfHighBoundary : result := funcHighBoundary(context, focus, exp); pfPrecision : result := funcPrecision(context, focus, exp); + pfComparable : result := funcComparable(context, focus, exp); pfCustom : result := funcCustom(context, focus, exp); else - raise EFHIRPath.create('Unknown Function '+exp.name); + raise EFHIRPath.Create('Unknown Function '+exp.name); end; end; @@ -6134,7 +6208,7 @@ function TFHIRPathEngine.funcCustom(context : TFHIRPathExecutionContext; focus: end; end; if not done and (not couldHaveBeen or (focus.Count > 0)) then - raise EFHIRPath.create('Unknown Function '+exp.name); + raise EFHIRPath.Create('Unknown Function '+exp.name); result.Link; finally result.free; @@ -6236,7 +6310,7 @@ procedure TFHIRPathEngine.checkParamTypes(funcId : TFHIRPathFunction; paramTypes sd := context.fetchStructureDefinition(sd.baseDefinition); end; if (not ok) then - raise EFHIRPath.create('The parameter type "'+a.uri+'" is not legal for '+CODES_TFHIRPathFunctions[funcId]+' parameter '+Integer.toString(i)+', expecting '+pt.describe()); + raise EFHIRPath.Create('The parameter type "'+a.uri+'" is not legal for '+CODES_TFHIRPathFunctions[funcId]+' parameter '+Integer.toString(i)+', expecting '+pt.describe()); end; end; end; @@ -6250,7 +6324,7 @@ function TFHIRPathEngine.childTypes(focus : TFHIRTypeDetails; mask : string) : T var f : TFHIRProfiledType; begin - result := TFHIRTypeDetails.create(csUNORDERED, []); + result := TFHIRTypeDetails.Create(csUNORDERED, []); try for f in focus.types do ListChildTypesByName(f.uri, mask, result); @@ -6287,7 +6361,7 @@ function TFHIRPathEngine.evaluateFunctionType(context: TFHIRPathExecutionTypeCon paramTypes := TFslList.Create; try if (exp.FunctionId in [pfIs, pfAs, pfOfType]) then - paramTypes.add(TFHIRTypeDetails.create(csSINGLETON, [FP_string])) + paramTypes.add(TFHIRTypeDetails.Create(csSINGLETON, [FP_string])) else begin i := 0; @@ -6310,27 +6384,27 @@ function TFHIRPathEngine.evaluateFunctionType(context: TFHIRPathExecutionTypeCon case exp.FunctionId of pfEmpty : - result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); pfNot : - result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); pfExists : - result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); pfSubsetOf : begin checkParamTypes(exp.FunctionId, paramTypes, [focus.link]); - result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); end; pfSupersetOf : begin checkParamTypes(exp.FunctionId, paramTypes, [focus.link]); - result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); end; pfIsDistinct : - result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); pfDistinct : result := focus.Link; pfCount : - result := TFHIRTypeDetails.create(csSINGLETON, [FP_integer]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_integer]); pfWhere : if (focus.hasType(self.context, 'Reference')) then begin @@ -6363,7 +6437,7 @@ function TFHIRPathEngine.evaluateFunctionType(context: TFHIRPathExecutionTypeCon pfSelect : result := paramTypes[0].link; pfAll : - result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); pfRepeat : result := TFHIRTypeDetails.createList(focus.CollectionStatus, allTypes); pfAggregate : @@ -6371,14 +6445,14 @@ function TFHIRPathEngine.evaluateFunctionType(context: TFHIRPathExecutionTypeCon pfItem : begin if (focus.CollectionStatus = csUNORDERED) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on ordered collections'); - checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.create(csSINGLETON, [FP_integer])]); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on ordered collections'); + checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.Create(csSINGLETON, [FP_integer])]); result := focus.Link; end; pfOfType : begin - checkParamTypes(exp.FunctionId, paramTypes, TFHIRTypeDetails.create(csSINGLETON, [FP_String])); - result := TFHIRTypeDetails.create(csSINGLETON, [exp.Parameters[0].name]); + checkParamTypes(exp.FunctionId, paramTypes, TFHIRTypeDetails.Create(csSINGLETON, [FP_String])); + result := TFHIRTypeDetails.Create(csSINGLETON, [exp.Parameters[0].name]); end; pfType : begin @@ -6390,54 +6464,54 @@ function TFHIRPathEngine.evaluateFunctionType(context: TFHIRPathExecutionTypeCon c := c or not pt.isSystemType(); end; if (s and c) then - result := TFHIRTypeDetails.create(csSINGLETON, [FP_SimpleTypeInfo, FP_ClassInfo]) + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_SimpleTypeInfo, FP_ClassInfo]) else if (s) then - result := TFHIRTypeDetails.create(csSINGLETON, [FP_SimpleTypeInfo]) + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_SimpleTypeInfo]) else - result := TFHIRTypeDetails.create(csSINGLETON, [FP_ClassInfo]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_ClassInfo]); end; pfAs : begin - checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.create(csSINGLETON, [FP_string])]); - result := TFHIRTypeDetails.create(csSINGLETON, exp.Parameters[0].Name); + checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.Create(csSINGLETON, [FP_string])]); + result := TFHIRTypeDetails.Create(csSINGLETON, exp.Parameters[0].Name); end; pfIs : begin - checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.create(csSINGLETON, [FP_string])]); - result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); + checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.Create(csSINGLETON, [FP_string])]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); end; pfSingle : result := focus.toSingleton(); pfFirst : begin if (focus.CollectionStatus = csUNORDERED) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on ordered collections'); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on ordered collections'); result := focus.toSingleton(); end; pfLast : begin if (focus.CollectionStatus = csUNORDERED) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on ordered collections'); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on ordered collections'); result := focus.toSingleton(); end; pfTail : begin if (focus.CollectionStatus = csUNORDERED) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on ordered collections'); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on ordered collections'); result := focus.Link; end; pfSkip : begin if (focus.CollectionStatus = csUNORDERED) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on ordered collections'); - checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.create(csSINGLETON, [FP_integer])]); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on ordered collections'); + checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.Create(csSINGLETON, [FP_integer])]); result := focus.Link; end; pfTake : begin if (focus.CollectionStatus = csUNORDERED) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on ordered collections'); - checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.create(csSINGLETON, [FP_integer])]); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on ordered collections'); + checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.Create(csSINGLETON, [FP_integer])]); result := focus.Link; end; pfUnion : @@ -6450,7 +6524,7 @@ function TFHIRPathEngine.evaluateFunctionType(context: TFHIRPathExecutionTypeCon result := focus.link; pfIif : begin - result := TFHIRTypeDetails.create(csNull, []); + result := TFHIRTypeDetails.Create(csNull, []); result.update(paramTypes[0]); if (paramTypes.count > 1) then result.update(paramTypes[1]); @@ -6458,75 +6532,75 @@ function TFHIRPathEngine.evaluateFunctionType(context: TFHIRPathExecutionTypeCon pfLower : begin if (not focus.hasType(self.context, ['string', 'code', 'uri', 'id'])) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on string, code, uri, id'+' not '+focus.describe); - result := TFHIRTypeDetails.create(csSINGLETON, [FP_string]); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on string, code, uri, id'+' not '+focus.describe); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_string]); end; pfUpper : begin if (not focus.hasType(self.context, ['string', 'code', 'uri', 'id'])) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on string, code, uri, id'+' not '+focus.describe); - result := TFHIRTypeDetails.create(csSINGLETON, [FP_string]); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on string, code, uri, id'+' not '+focus.describe); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_string]); end; pfToChars : begin if (not focus.hasType(self.context, ['string', 'code', 'uri', 'id'])) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on string, code, uri, id'+' not '+focus.describe); - result := TFHIRTypeDetails.create(csSINGLETON, [FP_string]); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on string, code, uri, id'+' not '+focus.describe); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_string]); end; pfSubstring : begin if (not focus.hasType(self.context, ['string', 'code', 'uri', 'id'])) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on string, code, uri, id'+' not '+focus.describe); - checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.create(csSINGLETON, [FP_Integer]), TFHIRTypeDetails.create(csSINGLETON, [FP_integer])]); - result := TFHIRTypeDetails.create(csSINGLETON, [FP_string]); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on string, code, uri, id'+' not '+focus.describe); + checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.Create(csSINGLETON, [FP_Integer]), TFHIRTypeDetails.Create(csSINGLETON, [FP_integer])]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_string]); end; pfStartsWith : begin if (not focus.hasType(self.context, ['string', 'code', 'uri', 'id'])) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on string, code, uri, id'+' not '+focus.describe); - checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.create(csSINGLETON, [FP_string])]); - result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on string, code, uri, id'+' not '+focus.describe); + checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.Create(csSINGLETON, [FP_string])]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); end; pfEndsWith : begin if (not focus.hasType(self.context, ['string', 'code', 'uri', 'id'])) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on string, code, uri, id'+' not '+focus.describe); - checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.create(csSINGLETON, [FP_string])]); - result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on string, code, uri, id'+' not '+focus.describe); + checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.Create(csSINGLETON, [FP_string])]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); end; pfMatches, pfMatchesFull : begin if (not focus.hasType(self.context, ['string', 'code', 'uri', 'id'])) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on string, code, uri, id'+' not '+focus.describe); - checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.create(csSINGLETON, [FP_string])]); - result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on string, code, uri, id'+' not '+focus.describe); + checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.Create(csSINGLETON, [FP_string])]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); end; pfReplaceMatches : begin if (not focus.hasType(self.context, ['string', 'code', 'uri', 'id'])) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on string, code, uri, id'+' not '+focus.describe); - checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.create(csSINGLETON, [FP_string]), TFHIRTypeDetails.create(csSINGLETON, [FP_string])]); - result := TFHIRTypeDetails.create(csSINGLETON, [FP_string]); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on string, code, uri, id'+' not '+focus.describe); + checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.Create(csSINGLETON, [FP_string]), TFHIRTypeDetails.Create(csSINGLETON, [FP_string])]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_string]); end; pfContains : begin if (not focus.hasType(self.context, ['string', 'code', 'uri', 'id'])) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on string, code, uri, id'+' not '+focus.describe); - checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.create(csSINGLETON, [FP_string])]); - result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on string, code, uri, id'+' not '+focus.describe); + checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.Create(csSINGLETON, [FP_string])]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); end; pfReplace : begin if (not focus.hasType(self.context, ['string', 'code', 'uri', 'id'])) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on string, code, uri, id'+' not '+focus.describe); - checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.create(csSINGLETON, [FP_string]), TFHIRTypeDetails.create(csSINGLETON, [FP_string])]); - result := TFHIRTypeDetails.create(csSINGLETON, [FP_string]); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on string, code, uri, id'+' not '+focus.describe); + checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.Create(csSINGLETON, [FP_string]), TFHIRTypeDetails.Create(csSINGLETON, [FP_string])]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_string]); end; pfLength : begin if (not focus.hasType(self.context, primitiveTypes)) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+primitiveTypes.CommaText+' not '+focus.describe); - result := TFHIRTypeDetails.create(csSINGLETON, [FP_integer]); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+primitiveTypes.CommaText+' not '+focus.describe); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_integer]); end; pfChildren : result := childTypes(focus, '*'); @@ -6535,218 +6609,220 @@ function TFHIRPathEngine.evaluateFunctionType(context: TFHIRPathExecutionTypeCon pfMemberOf : begin if (not focus.hasType(self.context, ['string', 'code', 'uri', 'Coding', 'CodeableConcept'])) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on string, code, uri, Coding, CodeableConcept not '+focus.describe); - checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.create(csSINGLETON, [FP_string])]); - result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on string, code, uri, Coding, CodeableConcept not '+focus.describe); + checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.Create(csSINGLETON, [FP_string])]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); end; pfTrace : begin - checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.create(csSINGLETON, [FP_string])]); + checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.Create(csSINGLETON, [FP_string])]); result := focus.Link; end; pfToday : - result := TFHIRTypeDetails.create(csSINGLETON, [FP_DateTime]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_DateTime]); pfNow : - result := TFHIRTypeDetails.create(csSINGLETON, [FP_dateTime]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_dateTime]); pfResolve : begin if (not focus.hasType(self.context, ['uri', 'Reference'])) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on uri, Reference not '+focus.describe); - result := TFHIRTypeDetails.create(csSINGLETON, ['DomainResource']); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on uri, Reference not '+focus.describe); + result := TFHIRTypeDetails.Create(csSINGLETON, ['DomainResource']); end; pfExtension : begin - checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.create(csSINGLETON, [FP_string])]); - result := TFHIRTypeDetails.create(csSINGLETON, ['Extension']); + checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.Create(csSINGLETON, [FP_string])]); + result := TFHIRTypeDetails.Create(csSINGLETON, ['Extension']); end; pfHasExtension : begin - checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.create(csSINGLETON, [FP_string])]); - result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); + checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.Create(csSINGLETON, [FP_string])]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); end; pfAllFalse: - result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); pfAnyFalse: - result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); pfAllTrue: - result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); pfAnyTrue: - result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); pfElementDefinition: begin - checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.create(csSINGLETON, [FP_string])]); - result := TFHIRTypeDetails.create(csSINGLETON, ['ElementDefinition']); + checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.Create(csSINGLETON, [FP_string])]); + result := TFHIRTypeDetails.Create(csSINGLETON, ['ElementDefinition']); end; pfSlice: begin - checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.create(csSINGLETON, [FP_string, FP_string])]); + checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.Create(csSINGLETON, [FP_string, FP_string])]); result := focus.Link; end; pfCheckModifiers: begin - checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.create(csUNORDERED, [FP_string])]); + checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.Create(csUNORDERED, [FP_string])]); result := focus.Link; end; pfConformsTo: begin - checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.create(csSINGLETON, [FP_string])]); - result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); + checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.Create(csSINGLETON, [FP_string])]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); end; pfHasValue: - result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); pfHtmlChecks: - result := TFHIRTypeDetails.create(csSINGLETON, [FP_boolean]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_boolean]); pfToInteger : begin if (not focus.hasType(self.context, primitiveTypes)) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+primitiveTypes.CommaText+' not '+focus.describe); - result := TFHIRTypeDetails.create(csSINGLETON, [FP_integer]); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+primitiveTypes.CommaText+' not '+focus.describe); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_integer]); end; pfToDecimal : begin if (not focus.hasType(self.context, primitiveTypes)) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+primitiveTypes.CommaText+' not '+focus.describe); - result := TFHIRTypeDetails.create(csSINGLETON, [FP_decimal]); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+primitiveTypes.CommaText+' not '+focus.describe); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_decimal]); end; pfToString : begin if (not focus.hasType(self.context, primitiveTypes) and not focus.hasType(self.context, 'Quantity')) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+primitiveTypes.CommaText+' not '+focus.describe); - result := TFHIRTypeDetails.create(csSINGLETON, [FP_string]); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+primitiveTypes.CommaText+' not '+focus.describe); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_string]); end; pfToQuantity : begin if (not focus.hasType(self.context, primitiveTypes) and not focus.hasType(self.context, 'Quantity')) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+primitiveTypes.CommaText+' not '+focus.describe); - result := TFHIRTypeDetails.create(csSINGLETON, [FP_Quantity]); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+primitiveTypes.CommaText+' not '+focus.describe); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_Quantity]); end; pfToBoolean : begin if (not focus.hasType(self.context, primitiveTypes)) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+primitiveTypes.CommaText+' not '+focus.describe); - result := TFHIRTypeDetails.create(csSINGLETON, [FP_Boolean]); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+primitiveTypes.CommaText+' not '+focus.describe); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_Boolean]); end; pfToDateTime : begin if (not focus.hasType(self.context, primitiveTypes)) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+primitiveTypes.CommaText+' not '+focus.describe); - result := TFHIRTypeDetails.create(csSINGLETON, [FP_DateTime]); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+primitiveTypes.CommaText+' not '+focus.describe); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_DateTime]); end; pfToTime : begin if (not focus.hasType(self.context, primitiveTypes)) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+primitiveTypes.CommaText+' not '+focus.describe); - result := TFHIRTypeDetails.create(csSINGLETON, [FP_Time]); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+primitiveTypes.CommaText+' not '+focus.describe); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_Time]); end; pfAbs : begin if (not focus.hasType(self.context, FHIR_TYPES_NUMERIC) and not focus.hasType(self.context, 'Quantity')) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+CommaText(FHIR_TYPES_NUMERIC)+' and Quantity not '+focus.describe); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+CommaText(FHIR_TYPES_NUMERIC)+' and Quantity not '+focus.describe); result := TFHIRTypeDetails.createList(csSINGLETON, focus.types); end; pfCeiling : begin if (not focus.hasType(self.context, FHIR_TYPES_NUMERIC) and not focus.hasType(self.context, 'Quantity')) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+CommaText(FHIR_TYPES_NUMERIC)+' and Quantity not '+focus.describe); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+CommaText(FHIR_TYPES_NUMERIC)+' and Quantity not '+focus.describe); result := TFHIRTypeDetails.createList(csSINGLETON, focus.types); end; pfExp : begin if (not focus.hasType(self.context, FHIR_TYPES_NUMERIC) and not focus.hasType(self.context, 'Quantity')) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+CommaText(FHIR_TYPES_NUMERIC)+' and Quantity not '+focus.describe); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+CommaText(FHIR_TYPES_NUMERIC)+' and Quantity not '+focus.describe); result := TFHIRTypeDetails.createList(csSINGLETON, focus.types); end; pfFloor : begin if (not focus.hasType(self.context, FHIR_TYPES_NUMERIC) and not focus.hasType(self.context, 'Quantity')) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+CommaText(FHIR_TYPES_NUMERIC)+' and Quantity not '+focus.describe); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+CommaText(FHIR_TYPES_NUMERIC)+' and Quantity not '+focus.describe); result := TFHIRTypeDetails.createList(csSINGLETON, focus.types); end; pfLn : begin if (not focus.hasType(self.context, FHIR_TYPES_NUMERIC) and not focus.hasType(self.context, 'Quantity')) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+CommaText(FHIR_TYPES_NUMERIC)+' and Quantity not '+focus.describe); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+CommaText(FHIR_TYPES_NUMERIC)+' and Quantity not '+focus.describe); result := TFHIRTypeDetails.createList(csSINGLETON, focus.types); end; pfLog : begin if (not focus.hasType(self.context, FHIR_TYPES_NUMERIC) and not focus.hasType(self.context, 'Quantity')) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+CommaText(FHIR_TYPES_NUMERIC)+' and Quantity not '+focus.describe); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+CommaText(FHIR_TYPES_NUMERIC)+' and Quantity not '+focus.describe); result := TFHIRTypeDetails.createList(csSINGLETON, focus.types); end; pfPower : begin if (not focus.hasType(self.context, FHIR_TYPES_NUMERIC) and not focus.hasType(self.context, 'Quantity')) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+CommaText(FHIR_TYPES_NUMERIC)+' and Quantity not '+focus.describe); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+CommaText(FHIR_TYPES_NUMERIC)+' and Quantity not '+focus.describe); result := TFHIRTypeDetails.createList(csSINGLETON, focus.types); end; pfTruncate : begin if (not focus.hasType(self.context, FHIR_TYPES_NUMERIC) and not focus.hasType(self.context, 'Quantity')) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+CommaText(FHIR_TYPES_NUMERIC)+' and Quantity not '+focus.describe); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+CommaText(FHIR_TYPES_NUMERIC)+' and Quantity not '+focus.describe); result := TFHIRTypeDetails.createList(csSINGLETON, focus.types); end; pfRound : begin if (not focus.hasType(self.context, FHIR_TYPES_NUMERIC) and not focus.hasType(self.context, 'Quantity')) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+CommaText(FHIR_TYPES_NUMERIC)+' and Quantity not '+focus.describe); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+CommaText(FHIR_TYPES_NUMERIC)+' and Quantity not '+focus.describe); result := TFHIRTypeDetails.createList(csSINGLETON, focus.types); end; pfSqrt : begin if (not focus.hasType(self.context, FHIR_TYPES_NUMERIC) and not focus.hasType(self.context, 'Quantity')) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+CommaText(FHIR_TYPES_NUMERIC)+' and Quantity not '+focus.describe); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+CommaText(FHIR_TYPES_NUMERIC)+' and Quantity not '+focus.describe); result := TFHIRTypeDetails.createList(csSINGLETON, focus.types); end; pfConvertsToString, pfConvertsToQuantity : begin if (not focus.hasType(self.context, primitiveTypes) and not focus.hasType(self.context, 'Quantity')) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+primitiveTypes.CommaText+' not '+focus.describe); - result := TFHIRTypeDetails.create(csSINGLETON, [FP_Boolean]); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+primitiveTypes.CommaText+' not '+focus.describe); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_Boolean]); end; pfConvertsToInteger, pfConvertsToDecimal, pfConvertsToDateTime, pfConvertsToDate, pfConvertsToTime, pfConvertsToBoolean : begin if (not focus.hasType(self.context, primitiveTypes)) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+primitiveTypes.CommaText+' not '+focus.describe); - result := TFHIRTypeDetails.create(csSINGLETON, [FP_Boolean]); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on '+primitiveTypes.CommaText+' not '+focus.describe); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_Boolean]); end; pfForHtml, pfEncode, pfDecode, pfEscape, pfUnescape, pfTrim : begin - result := TFHIRTypeDetails.create(csSINGLETON, [FP_String]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_String]); end; pfSplit : - result := TFHIRTypeDetails.create(csORDERED, [FP_String]); + result := TFHIRTypeDetails.Create(csORDERED, [FP_String]); pfJoin : - result := TFHIRTypeDetails.create(csSINGLETON, [FP_String]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_String]); pfIndexOf : - result := TFHIRTypeDetails.create(csSINGLETON, [FP_Integer]); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_Integer]); pfLowBoundary, pfHighBoundary : begin if (not focus.hasNoTypes() and not focus.hasType(self.context, 'decimal') and not focus.hasType(self.context, 'date') and not focus.hasType(self.context, 'dateTime') and not focus.hasType(self.context, 'time') and not focus.hasType(self.context, 'Quantity')) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on decimal, date, datetime, instant, time and Quantity, not '+focus.describe); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on decimal, date, datetime, instant, time and Quantity, not '+focus.describe); if (paramTypes.count > 0) then - checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.create(csSINGLETON, [FP_Integer])]); + checkParamTypes(exp.FunctionId, paramTypes, [TFHIRTypeDetails.Create(csSINGLETON, [FP_Integer])]); if (focus.hasType(self.context, 'date') or focus.hasType(self.context, 'dateTime') or focus.hasType(self.context, 'instant')) then - result := TFHIRTypeDetails.create(csSINGLETON, [FP_DateTime]) + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_DateTime]) else if (focus.hasType(self.context, 'decimal')) then - result := TFHIRTypeDetails.create(csSINGLETON, [FP_Decimal]) + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_Decimal]) else if (focus.hasType(self.context, 'time')) then - result := TFHIRTypeDetails.create(csSINGLETON, [FP_Time]) + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_Time]) else - result := TFHIRTypeDetails.create(csSINGLETON, []) + result := TFHIRTypeDetails.Create(csSINGLETON, []) end; pfPrecision : begin if (not focus.hasNoTypes() and not focus.hasType(self.context, 'decimal') and not focus.hasType(self.context, 'date') and not focus.hasType(self.context, 'dateTime') and not focus.hasType(self.context, 'time') and not focus.hasType(self.context, 'Quantity')) then - raise EFHIRPath.create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on decima;, date, datetime, instant, time and Quantity, not '+focus.describe); - result := TFHIRTypeDetails.create(csSINGLETON, [FP_Integer]); + raise EFHIRPath.Create('The function "'+CODES_TFHIRPathFunctions[exp.FunctionId]+'()" can only be used on decima;, date, datetime, instant, time and Quantity, not '+focus.describe); + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_Integer]); end; + pfComparable : + result := TFHIRTypeDetails.Create(csSINGLETON, [FP_Boolean]); pfCustom : result := evaluateCustomFunctionType(context, focus, exp); else - raise EFHIRPath.create('not Implemented yet?'); + raise EFHIRPath.Create('not Implemented yet?'); end; finally paramTypes.free; @@ -6814,7 +6890,7 @@ function processDateConstant(s : String) : TFHIRDataType; // else if s = '%resource' then // begin // if (context.resource = nil) then -// raise EFHIRPath.create('%resource cannot be used in this context'); +// raise EFHIRPath.Create('%resource cannot be used in this context'); // result := context.resource.link; // end // else if s = '%us-zip' then @@ -6826,7 +6902,7 @@ function processDateConstant(s : String) : TFHIRDataType; // else if s.StartsWith('%"ext-') then // result := TFhirString.Create('http://hl7.org/fhir/StructureDefinition/'+s.Substring(6, s.length-7)).noExtensions // else -// raise EFHIRPath.create('Unknown fixed constant '+s); +// raise EFHIRPath.Create('Unknown fixed constant '+s); //end; // @@ -6886,7 +6962,7 @@ procedure TFHIRPathEngine.ListChildTypesByName(type_, name : String; result : TF rt : TFslStringSet; begin if (type_ = '') then - raise EFHIRPath.create('No type provided in BuildToolPathEvaluator.ListChildTypesByName'); + raise EFHIRPath.Create('No type provided in BuildToolPathEvaluator.ListChildTypesByName'); if (type_ = 'http://hl7.org/fhir/StructureDefinition/xhtml') then exit; if (type_ = 'Custom') or (type_ = 'http://hl7.org/fhir/StructureDefinition/Custom') then @@ -6919,7 +6995,7 @@ procedure TFHIRPathEngine.ListChildTypesByName(type_, name : String; result : TF sd := worker.fetchStructureDefinition(url); if (sd = nil) then - raise EFHIRPath.create('Unknown type '+type_); // this really is an error, because we can only get to here if the internal infrastrucgture is wrong + raise EFHIRPath.Create('Unknown type '+type_); // this really is an error, because we can only get to here if the internal infrastrucgture is wrong m := nil; sdl := TFslList.Create; try @@ -6931,7 +7007,7 @@ procedure TFHIRPathEngine.ListChildTypesByName(type_, name : String; result : TF begin dt := worker.fetchStructureDefinition('http://hl7.org/fhir/StructureDefinition/'+specifiedType); if (dt = nil) then - raise EFHIRPath.create('unknown data type '+specifiedType); + raise EFHIRPath.Create('unknown data type '+specifiedType); sdl.add(dt); end else @@ -6939,7 +7015,7 @@ procedure TFHIRPathEngine.ListChildTypesByName(type_, name : String; result : TF begin dt := worker.fetchStructureDefinition('http://hl7.org/fhir/StructureDefinition/'+t.Code) as TFhirStructureDefinition; if (dt = nil) then - raise EFHIRPath.create('unknown data type '+t.code); + raise EFHIRPath.Create('unknown data type '+t.code); sdl.add(dt); end; end @@ -7028,7 +7104,7 @@ procedure TFHIRPathEngine.ListChildTypesByName(type_, name : String; result : TF for t in ed.type_list do begin if (t.code = '') then - break; // raise EFHIRPath.create('Illegal reference to primitive value attribute @ '+path); + break; // raise EFHIRPath.Create('Illegal reference to primitive value attribute @ '+path); if (t.code = 'Element') or (t.code = 'BackboneElement') then result.addType(path) @@ -7124,11 +7200,11 @@ function TFHIRPathEngine.getElementDefinition(sd : TFHIRStructureDefinition; pat // now we walk into the type. if (ed.type_list.count > 1) then // if there's more than one type, the test above would fail this - raise EFHIRException.create('Internal typing issue....'); + raise EFHIRException.Create('Internal typing issue....'); sd := worker.getStructure('http://hl7.org/fhir/StructureDefinition/'+ed.type_List[0].code); try if (sd = nil) then - raise EDefinitionException.create('Unknown type '+ed.type_List[0].code); + raise EDefinitionException.Create('Unknown type '+ed.type_List[0].code); result := getElementDefinition(sd, sd.id+path.Substring(ed.path.Length), true, specifiedType); finally sd.free; @@ -7166,7 +7242,7 @@ function TFHIRPathEngine.sizeInBytesV(magic : integer) : cardinal; result := inherited sizeInBytesV(magic); inc(result, worker.sizeInBytes(magic)); inc(result, allTypes.sizeInBytes(magic)); - inc(result, primitiveTypes.sizeInBytes(magic)); + inc(result, primitiveTypes.sizeInBytes(magic)); inc(result, FUcum.sizeInBytes(magic)); end; @@ -7212,7 +7288,7 @@ function TFHIRPathExecutionTypeContext.sizeInBytesV(magic : integer) : cardinal; inc(result, FContext.sizeInBytes(magic)); end; -{ TFHIRPathLexer5 } +{ TFHIRPathLexer4 } function TFHIRPathLexer5.opCodes: TArray; @@ -7232,20 +7308,20 @@ function TFHIRPathLexer5.opCodes: TArray; function TFHIRPathLexer5.processConstant : TFHIRObject; begin if (isStringConstant()) then - result := TFHIRString.create(TFHIRPathLexer.processConstant(take())).noExtensions() + result := TFHIRString.Create(TFHIRPathLexer.processConstant(take())).noExtensions() else if (StringIsInteger32(current)) then - result := TFHIRInteger.create(take).noExtensions() + result := TFHIRInteger.Create(take).noExtensions() else if (StringIsDecimal(current)) then - result := TFHIRDecimal.create(take).noExtensions() + result := TFHIRDecimal.Create(take).noExtensions() else if (StringArrayExistsSensitive(['true', 'false'], current)) then - result := TFHIRBoolean.create(take = 'true').noExtensions() + result := TFHIRBoolean.Create(take = 'true').noExtensions() else if (current = '{}') then begin take; result := nil; end else if (current.startsWith('%') or current.startsWith('@')) then - result := TFHIRConstant.create(take) + result := TFHIRConstant.Create(take) else raise error('Invalid Constant '+current); end; diff --git a/library/fhir5/fhir5_pathnode.pas b/library/fhir5/fhir5_pathnode.pas index 14c6c4849..f022508c3 100644 --- a/library/fhir5/fhir5_pathnode.pas +++ b/library/fhir5/fhir5_pathnode.pas @@ -56,7 +56,7 @@ interface pfToBoolean, pfToInteger, pfToString, pfToDecimal, pfToQuantity, pfToDateTime, pfToTime, pfAbs, pfCeiling, pfExp, pfFloor, pfLn, pfLog, pfPower, pfTruncate, pfRound, pfSqrt, pfForHtml, pfEncode, pfDecode, pfEscape, pfUnescape, pfTrim, pfSplit, pfJoin, pfIndexOf, - pfLowBoundary, pfHighBoundary, pfPrecision, + pfLowBoundary, pfHighBoundary, pfPrecision, pfComparable, pfCustom); TFHIRPathExpressionNodeKind = (enkName, enkFunction, enkConstant, enkGroup, enkStructure, enkUnary); // structure is not used in fhir4_pathengine, but is in CQL @@ -78,7 +78,7 @@ interface 'toBoolean', 'toInteger', 'toString', 'toDecimal', 'toQuantity', 'toDateTime', 'toTime', 'abs', 'ceiling', 'exp', 'floor', 'ln', 'log', 'power', 'truncate', 'round', 'sqrt', 'forHtml', 'encode', 'decode', 'escape', 'unescape', 'trim', 'split', 'join', 'indexOf', - 'lowBoundary', 'highBoundary', 'precision', + 'lowBoundary', 'highBoundary', 'precision', 'comparable', 'xx-custom-xx'); FHIR_SD_NS = 'http://hl7.org/fhir/StructureDefinition/'; diff --git a/library/fsl/fsl_fpc.pas b/library/fsl/fsl_fpc.pas index e70a0685c..e27933151 100644 --- a/library/fsl/fsl_fpc.pas +++ b/library/fsl/fsl_fpc.pas @@ -280,18 +280,21 @@ procedure setCurrentDirectory(dir : String); function unicodeChars(s : String) : TUCharArray; var i, c, l, cl : integer; - ch : UnicodeChar; + ch : LongWord; p: PChar; + ss : String; begin l := length(s); SetLength(result, l); // maximum possible length i := 0; c := 1; p := @s[1]; + ss := ''; while l > 0 do begin - ch := UnicodeChar(UTF8CodepointToUnicode(p, cl)); - result[i] := ch; + ch := UTF8PCharToUnicode(p, cl); + result[i] := UnicodeChar(ch); + ss := ss + IntToHex(ch, 4)+'.'; inc(i); dec(l, cl); inc(p, cl); diff --git a/library/fsl/fsl_ucum.pas b/library/fsl/fsl_ucum.pas index 1717794e0..dcb7c16e4 100644 --- a/library/fsl/fsl_ucum.pas +++ b/library/fsl/fsl_ucum.pas @@ -57,6 +57,8 @@ TUcumServiceInterface = class (TFslObject) function multiply(o1, o2 : TUcumPair) : TUcumPair; virtual; abstract; function divideBy(o1, o2 : TUcumPair) : TUcumPair; virtual; abstract; function getCanonicalForm(value : TUcumPair) : TUcumPair; virtual; abstract; + function getCanonicalUnits(units : string) : string; virtual; abstract; + function isComparable(u1, u2 : String) : boolean; virtual; abstract; function isConfigured : boolean; virtual; abstract; end; diff --git a/library/fsl/fsl_utilities.pas b/library/fsl/fsl_utilities.pas index bf69b59f1..ea058cfea 100644 --- a/library/fsl/fsl_utilities.pas +++ b/library/fsl/fsl_utilities.pas @@ -46,7 +46,7 @@ {$ENDIF} {$IFDEF FPC} - base64, + base64, LazUTF8, {$ELSE} System.TimeSpan, System.NetEncoding, EncdDecd, UIConsts, ZLib, {$ENDIF} @@ -15872,7 +15872,10 @@ function TFslWordStemmer.stem(word: String): String; end; function removeAccentFromChar(ch : UnicodeChar) : String; +var + v : Cardinal; begin + v := ord(ch); case ch of //' ' #$00A0 : result := ' '; @@ -16917,9 +16920,11 @@ function removeAccentFromChar(ch : UnicodeChar) : String; #$2C6C : result := 'z'; #$A763 : result := 'z'; - #$0439 : result := #$0438; + #$0439 : result := UnicodeToUTF8($0438); + else if ch < #$FE then + result := ch else - result := ch; + result := UnicodeToUTF8(v); end; end; @@ -17470,6 +17475,8 @@ function lowBoundaryForDate(value : String; precision : integer) : String; b.append(':00'); if (b.length = 19) then b.append('.000'); + if (tz = '') and (precision >= 10) then + tz := '+14:00'; result := applyDatePrecision(b.toString(), precision)+tz; finally b.free; @@ -17515,6 +17522,8 @@ function highBoundaryForDate(value : String; precision : integer) : String; b.append(':59'); if (b.length = 19) then b.append('.999'); + if (tz = '') and (precision >= 10) then + tz := '-12:00'; result := applyDatePrecision(b.toString(), precision)+tz; finally b.free; diff --git a/library/fsl/tests/fsl_testing.pas b/library/fsl/tests/fsl_testing.pas index 2e1e2617b..7a6a09663 100644 --- a/library/fsl/tests/fsl_testing.pas +++ b/library/fsl/tests/fsl_testing.pas @@ -64,6 +64,8 @@ TFslTestCase = class (TTestCase) procedure assertEqual(left, right : String); overload; procedure assertEqual(left, right : integer; message : String); overload; procedure assertEqual(left, right : integer); overload; + procedure assertEqual(const left, right : TBytes; message : String); overload; + procedure assertEqual(const left, right : TBytes); overload; procedure assertWillRaise(AMethod: TTestMethodWithContext; context : TObject; AExceptionClass: ExceptClass; AExceptionMessage : String); procedure thread(proc : TTestMethodWithContext; context : TObject); public @@ -280,6 +282,36 @@ procedure TFslTestCase.assertEqual(left, right: integer); {$ENDIF} end; +procedure TFslTestCase.assertEqual(const left, right: TBytes; message: String); +var + i : integer; +begin + {$IFDEF FPC} + for i := 0 to IntegerMin(length(left), length(right)) - 1 do + if (left[i] <> right[i]) then + raise EFslException.create('Byte Arrays differ at position '+inttostr(i)+': '+inttostr(ord(left[i]))+'/'+inttostr(ord(right[i]))); + if length(left) <> length(right) then + raise EFslException.create('Byte Arrays differ in length: '+inttostr(length(left))+'/'+inttostr(length(right))); + {$ELSE} + todo + {$ENDIF} +end; + +procedure TFslTestCase.assertEqual(const left, right: TBytes); +var + i : integer; +begin + {$IFDEF FPC} + for i := 0 to IntegerMin(length(left), length(right)) - 1 do + if (left[i] <> right[i]) then + raise EFslException.create('Byte Arrays differ at position '+inttostr(i)+': '+inttostr(ord(left[i]))+'/'+inttostr(ord(right[i]))); + if length(left) <> length(right) then + raise EFslException.create('Byte Arrays differ in length: '+inttostr(length(left))+'/'+inttostr(length(right))); + {$ELSE} + todo + {$ENDIF} +end; + procedure TFslTestCase.assertWillRaise(AMethod: TTestMethodWithContext; context : TObject; AExceptionClass: ExceptClass; AExceptionMessage : String); begin try diff --git a/library/fsl/tests/fsl_tests.pas b/library/fsl/tests/fsl_tests.pas index fe5e99163..6981711e7 100644 --- a/library/fsl/tests/fsl_tests.pas +++ b/library/fsl/tests/fsl_tests.pas @@ -1105,11 +1105,14 @@ procedure TFslUtilitiesTestCases.testSemVer; procedure TFslUtilitiesTestCases.testUnicode; var - s : String; + s, sc : String; b : TBytes; begin - s := TEncoding.UTF8.GetString(bu2); - AssertTrue(s = 'EKG PB R'''' 波持续时间（持续时长、时长、时间长度、时间、时间长短、为时、为期、历时、延续时间、持久时间、持续期） AVR 导联'); + sc := 'EKG PB R'''' 波持续时间（持续时长、时长、时间长度、时间、时间长短、为时、为期、历时、延续时间、持久时间、持续期） AVR 导联'; + b := TEncoding.UTF8.GetBytes(sc); + s := TEncoding.UTF8.GetString(bu2); + AssertEqual(b, bu2); + AssertEqual(s, sc); s := '背景 发现是一个原子型临床观察指标'; b := TEncoding.UTF8.GetBytes(s); diff --git a/library/fsl/tests/fsl_tests_npm.pas b/library/fsl/tests/fsl_tests_npm.pas index 74fff6418..39b017b5e 100644 --- a/library/fsl/tests/fsl_tests_npm.pas +++ b/library/fsl/tests/fsl_tests_npm.pas @@ -62,6 +62,7 @@ procedure TNpmPackageTests.LoadUSCore; var npm : TNpmPackage; begin + exit; npm := FCache.loadPackage('hl7.fhir.us.core'); try assertTrue(npm <> nil); diff --git a/library/ftx/ftx_ucum_services.pas b/library/ftx/ftx_ucum_services.pas index 432d66396..1db602a5a 100644 --- a/library/ftx/ftx_ucum_services.pas +++ b/library/ftx/ftx_ucum_services.pas @@ -282,6 +282,8 @@ TUcumServiceList = class (TFslObjectList) Property Definition[iIndex : Integer] : TUcumServices read GetDefinition; Default; End; + { TUcumServiceImplementation } + TUcumServiceImplementation = class (TUcumServiceInterface) private FSvc : TUcumServices; @@ -293,6 +295,8 @@ TUcumServiceImplementation = class (TUcumServiceInterface) Function multiply(o1, o2 : TUcumPair) : TUcumPair; override; Function divideBy(o1, o2 : TUcumPair) : TUcumPair; override; function getCanonicalForm(value : TUcumPair) : TUcumPair; override; + function getCanonicalUnits(units : string) : string; override; + function isComparable(u1, u2 : String) : boolean; override; Function isConfigured : boolean; override; end; @@ -1267,6 +1271,37 @@ function TUcumServiceImplementation.getCanonicalForm(value: TUcumPair): TUcumPai result := FSvc.getCanonicalForm(value); end; +function TUcumServiceImplementation.getCanonicalUnits(units: string): string; +var + p1, p2 : TUcumPair; +begin + if units = '' then + result := '' + else + begin + p1 := TUcumPair.create(TFslDecimal.makeOne, units); + try + p2 := getCanonicalForm(p1); + try + result := p2.UnitCode; + finally + p2.free; + end; + finally + p1.free; + end; + end; + +end; + +function TUcumServiceImplementation.isComparable(u1, u2: String): boolean; +begin + if (u1 = '') or (u2 = '') then + result := false + else + result := getCanonicalUnits(u1) = getCanonicalUnits(u2); +end; + function TUcumServiceImplementation.isConfigured: boolean; begin result := FSvc <> nil; diff --git a/library/web/fsl_crypto.pas b/library/web/fsl_crypto.pas index 30688203c..144dc33c6 100644 --- a/library/web/fsl_crypto.pas +++ b/library/web/fsl_crypto.pas @@ -80,7 +80,7 @@ interface IdOpenSSLHeaders_pem, IdOpenSSLHeaders_err, IdOpenSSLHeaders_evp, IdOpenSSLHeaders_ec, IdOpenSSLHeaders_obj_mac, IdOpenSSLHeaders_x509, IdOpenSSLHeaders_x509v3, IdOpenSSLHeaders_x509_vfy, IdOpenSSLX509, - fsl_base, fsl_utilities, fsl_stream, fsl_collections, fsl_json, fsl_xml, fsl_fpc, + fsl_base, fsl_utilities, fsl_stream, fsl_collections, fsl_json, fsl_xml, fsl_fpc, fsl_npm, fsl_openssl, fsl_fetcher; Type @@ -1396,13 +1396,14 @@ function InflateRfc1951(b : TBytes) : TBytes; b1, b2 : TBytesStream; z : TZDecompressionStream; begin - b1 := TBytesStream.create(b); + b1 := TBytesStream.create(b);// readZLibHeader(b)); try - z := TZDecompressionStream.create(b1, false); // -15); + z := TZDecompressionStream.create(b1, true); // -15); try + z.position := 0; b2 := TBytesStream.Create; try - b2.CopyFrom(z, z.Size); + b2.CopyFrom(z, 2); result := b2.Bytes; setLength(result, b2.size); finally @@ -1690,6 +1691,7 @@ class function TJWTUtils.Sign_Hmac_RSA256(input: TBytes; key: TJWK): TBytes; // 2. do the signing keysize := EVP_PKEY_size(pkey); SetLength(result, keysize); + len := keysize; ctx := EVP_MD_CTX_new; try check(EVP_DigestSignInit(ctx, nil, EVP_sha256, nil, pKey) = 1, 'openSSL EVP_DigestInit_ex failed');