From 2a677594c315b02fef7a727649d90071e07dd476 Mon Sep 17 00:00:00 2001 From: Grahame Grieve Date: Tue, 15 Oct 2024 06:09:01 +0800 Subject: [PATCH 1/7] fix typo in sql --- library/ftx/ftx_loinc_services.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/library/ftx/ftx_loinc_services.pas b/library/ftx/ftx_loinc_services.pas index 719621acf..f79698068 100644 --- a/library/ftx/ftx_loinc_services.pas +++ b/library/ftx/ftx_loinc_services.pas @@ -1083,8 +1083,8 @@ function TLOINCServices.filter(forExpansion, forIteration : boolean; prop: Strin else if (FRelationships.ContainsKey(prop) and (op = foIn)) then begin s := commaListOfCodes(value); - result := FilterBySQL(c, d, 'select SourceKey as Key from Relationships where RelationshipTypeKey = '+FRelationships[prop]+' and TargetKey in (select CodeKey from Codes where Code in ('+s+') order by SourceKey ASC', - 'select count(SourceKey) from Relationships where RelationshipTypeKey = '+FRelationships[prop]+' and TargetKey in (select CodeKey from Codes where Code in ('+s+') and SourceKey = ', forExpansion) + result := FilterBySQL(c, d, 'select SourceKey as Key from Relationships where RelationshipTypeKey = '+FRelationships[prop]+' and TargetKey in (select CodeKey from Codes where Code in ('+s+')) order by SourceKey ASC', + 'select count(SourceKey) from Relationships where RelationshipTypeKey = '+FRelationships[prop]+' and TargetKey in (select CodeKey from Codes where Code in ('+s+')) and SourceKey = ', forExpansion) end else if (FProperties.ContainsKey(prop) and (op = foEqual)) then result := FilterBySQL(c, d, 'select CodeKey as Key from Properties, PropertyValues where Properties.PropertyTypeKey = '+FProperties[prop]+' and Properties.PropertyValueKey = PropertyValues.PropertyValueKey and PropertyValues.Value = '''+SQLWrapString(value)+''' COLLATE NOCASE order by CodeKey ASC', From cee9109411fe097aafc0be4710e93b34f036f9a5 Mon Sep 17 00:00:00 2001 From: Grahame Grieve Date: Thu, 17 Oct 2024 17:54:52 +0800 Subject: [PATCH 2/7] Support Api-Key header for http client requests --- library/fhir/fhir_client_http.pas | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/library/fhir/fhir_client_http.pas b/library/fhir/fhir_client_http.pas index b77fc3836..d63b8d6e9 100644 --- a/library/fhir/fhir_client_http.pas +++ b/library/fhir/fhir_client_http.pas @@ -61,6 +61,7 @@ TFHIRHTTPCommunicator = class (TFHIRClientCommunicator) FTerminated : boolean; FTimeout: cardinal; FBytesToTransfer: Int64; + FApiKey : String; indy : TIdHTTP; ssl : TIdOpenSSLIOHandlerClient; @@ -110,6 +111,7 @@ TFHIRHTTPCommunicator = class (TFHIRClientCommunicator) property username : String read FUsername write FUsername; property password : String read FPassword write FPassword; property timeout : cardinal read FTimeout write SetTimeout; + property ApiKey : String read FApiKey write FApiKey; function address : String; override; @@ -350,6 +352,8 @@ procedure TFHIRHTTPCommunicator.createClient; raise EFHIRException.Create('Unable to process proxy "'+proxy+'" - use address:port'); end; end; + if FApiKey <> '' then + indy.Request.CustomHeaders.add('Api-Key: '+FApiKey); ssl := TIdOpenSSLIOHandlerClient.Create(nil); indy.IOHandler := ssl; ssl.Options.TLSVersionMinimum := TIdOpenSSLVersion.TLSv1_2; From 60e665efc17fadf1f3ff24933748ab3cb31a2ce0 Mon Sep 17 00:00:00 2001 From: Grahame Grieve Date: Thu, 17 Oct 2024 17:56:57 +0800 Subject: [PATCH 3/7] improved logging for value set expansion operations --- library/fhir/fhir_common.pas | 8 + library/fhir/fhir_tx.pas | 85 ++++--- library/fsl/fsl_logging.pas | 61 +++++ library/ftx/fhir_codesystem_service.pas | 142 +++++------ library/ftx/fhir_valuesets.pas | 305 ++++++++++++------------ library/ftx/ftx_lang.pas | 96 ++++---- library/ftx/ftx_loinc_services.pas | 145 +++++------ library/ftx/ftx_sct_analysis.pas | 2 +- library/ftx/ftx_sct_services.pas | 110 ++++----- library/ftx/ftx_service.pas | 150 ++++++------ library/ftx/ftx_ucum_services.pas | 96 ++++---- server/database.pas | 29 ++- server/endpoint.pas | 8 +- server/endpoint_folder.pas | 10 +- server/endpoint_full.pas | 18 +- server/endpoint_icao.pas | 10 +- server/endpoint_loinc.pas | 10 +- server/endpoint_packages.pas | 10 +- server/endpoint_snomed.pas | 10 +- server/endpoint_storage.pas | 30 +-- server/endpoint_txsvr.pas | 6 +- server/endpoint_xig.pas | 10 +- server/operations.pas | 6 +- server/operations_r2.pas | 76 +++--- server/operations_r3.pas | 84 +++---- server/operations_r4.pas | 100 ++++---- server/operations_r4b.pas | 96 ++++---- server/operations_r5.pas | 96 ++++---- server/storage.pas | 14 +- server/tests/tests_cpt.pas | 132 +++++----- server/time_tracker.pas | 96 -------- server/tx/tx_acir.pas | 102 ++++---- server/tx/tx_areacode.pas | 98 ++++---- server/tx/tx_countrycode.pas | 100 ++++---- server/tx/tx_cpt.pas | 98 ++++---- server/tx/tx_hgvs.pas | 122 +++++----- server/tx/tx_icd11.pas | 22 +- server/tx/tx_iso_4217.pas | 100 ++++---- server/tx/tx_mimetypes.pas | 98 ++++---- server/tx/tx_ndc.pas | 112 ++++----- server/tx/tx_omop.pas | 106 ++++---- server/tx/tx_rxnorm.pas | 106 ++++---- server/tx/tx_unii.pas | 94 ++++---- server/tx/tx_uri.pas | 94 ++++---- server/tx/tx_us_states.pas | 100 ++++---- server/tx_manager.pas | 24 +- server/tx_operations.pas | 33 +-- server/tx_registry_spider.pas | 93 ++++++-- server/tx_server.pas | 124 ++++++---- server/tx_webserver.pas | 4 +- server/validator_r2.pas | 8 +- server/validator_r3.pas | 8 +- server/validator_r4.pas | 8 +- server/validator_r4b.pas | 8 +- server/validator_r5.pas | 8 +- 55 files changed, 1892 insertions(+), 1829 deletions(-) delete mode 100644 server/time_tracker.pas diff --git a/library/fhir/fhir_common.pas b/library/fhir/fhir_common.pas index 21434ad6e..8b4aa3f6d 100644 --- a/library/fhir/fhir_common.pas +++ b/library/fhir/fhir_common.pas @@ -1003,9 +1003,12 @@ TFHIRValueSetCodeSystemW = class (TFHIRXVersionElementWrapper) function concepts : TFhirCodeSystemConceptListW; virtual; abstract; end; + { TFhirValueSetW } + TFhirValueSetW = class (TFHIRMetadataResourceW) public function link : TFhirValueSetW; overload; + function clone : TFhirValueSetW; overload; function source : String; virtual; abstract; function checkCompose(place, role : String) : boolean; virtual; abstract; @@ -2266,6 +2269,11 @@ function TFhirValueSetW.link: TFhirValueSetW; result := TFhirValueSetW(inherited link); end; +function TFhirValueSetW.clone: TFhirValueSetW; +begin + result := TFhirValueSetW(inherited clone); +end; + { TFhirValueSetComposeIncludeFilterW } function TFhirValueSetComposeIncludeFilterW.link: TFhirValueSetComposeIncludeFilterW; diff --git a/library/fhir/fhir_tx.pas b/library/fhir/fhir_tx.pas index c313b9e42..c60ce2ebf 100644 --- a/library/fhir/fhir_tx.pas +++ b/library/fhir/fhir_tx.pas @@ -20,7 +20,7 @@ interface { TTerminologyOperationContext } - TTerminologyOperationContext = class (TFslObject) + TTerminologyOperationContext = class (TTxOperationContext) private FId : String; FStartTime : UInt64; @@ -28,22 +28,23 @@ TTerminologyOperationContext = class (TFslObject) FLangList : THTTPLanguageList; FI18n : TI18nSupport; FTimeLimit : Cardinal; - FNotes : TStringList; - FOwnsNotes : boolean; FOnGetCurrentRequestCount: TGetCurrentRequestCountEvent; + FTimeTracker: TFslTimeTracker; + procedure SetTimeTracker(AValue: TFslTimeTracker); public - constructor Create(i18n : TI18nSupport; id : String; langList : THTTPLanguageList; timeLimit : cardinal; getRequestCount : TGetCurrentRequestCountEvent); + constructor Create(i18n : TI18nSupport; id : String; langList : THTTPLanguageList; timeLimit : cardinal; getRequestCount : TGetCurrentRequestCountEvent; tt : TFslTimeTracker); destructor Destroy; override; property reqId : String read FId; + property TimeTracker : TFslTimeTracker read FTimeTracker write SetTimeTracker; function copy : TTerminologyOperationContext; function deadCheck(var time : integer) : boolean; procedure seeContext(vurl : String); procedure clearContexts; + procedure log(note : String); override; procedure addNote(vs : TFHIRValueSetW; note : String); - function notes : String; - function hasNotes : boolean; + function diagnostics : String; property OnGetCurrentRequestCount : TGetCurrentRequestCountEvent read FOnGetCurrentRequestCount write FOnGetCurrentRequestCount; class function renderCoded(system : TCodeSystemProvider) : String; overload; @@ -223,7 +224,7 @@ TTerminologyWorker = class (TFslObject) function findCodeSystem(url, version : String; params : TFHIRTxOperationParams; kinds : TFhirCodeSystemContentModeSet; nullOk : boolean) : TCodeSystemProvider; function listVersions(url : String) : String; procedure loadSupplements(cse: TFHIRCodeSystemEntry; url: String); - procedure checkSupplements(cs: TCodeSystemProvider; src: TFHIRXVersionElementWrapper); + procedure checkSupplements(opContext : TTxOperationContext; cs: TCodeSystemProvider; src: TFHIRXVersionElementWrapper); public constructor Create(factory : TFHIRFactory; opContext : TTerminologyOperationContext; getCS : TGetProviderEvent; getVersions : TGetSystemVersionsEvent; txResources : TFslMetadataResourceList; languages : TIETFLanguageDefinitions; i18n : TI18nSupport); overload; destructor Destroy; override; @@ -234,7 +235,7 @@ TTerminologyWorker = class (TFslObject) TFHIRCodeSystemInformationProvider = class (TTerminologyWorker) public - procedure lookupCode(coding : TFHIRCodingW; profile : TFHIRTxOperationParams; props : TArray; resp : TFHIRLookupOpResponseW); + procedure lookupCode(opContext : TTxOperationContext; coding : TFHIRCodingW; profile : TFHIRTxOperationParams; props : TArray; resp : TFHIRLookupOpResponseW); end; const @@ -246,7 +247,13 @@ implementation { TTerminologyOperationContext } -constructor TTerminologyOperationContext.Create(i18n: TI18nSupport; id : String; langList : THTTPLanguageList; timeLimit : cardinal; getRequestCount : TGetCurrentRequestCountEvent); +procedure TTerminologyOperationContext.SetTimeTracker(AValue: TFslTimeTracker); +begin + FTimeTracker.free; + FTimeTracker:=AValue; +end; + +constructor TTerminologyOperationContext.Create(i18n: TI18nSupport; id : String; langList : THTTPLanguageList; timeLimit : cardinal; getRequestCount : TGetCurrentRequestCountEvent; tt : TFslTimeTracker); begin inherited create; FI18n := i18n; @@ -256,28 +263,27 @@ constructor TTerminologyOperationContext.Create(i18n: TI18nSupport; id : String; FStartTime := GetTickCount64; FOnGetCurrentRequestCount := getRequestCount; FTimeLimit := timeLimit; - FNotes := TStringList.create; - FOwnsNotes := true; + if (tt = nil) then + FTimeTracker := TFslTimeTracker.create + else + FTimeTracker := tt; + FTimeTracker.step('tx-op'); end; destructor TTerminologyOperationContext.Destroy; begin - if FOwnsNotes then - FNotes.free; FLangList.free; FI18n.free; FContexts.free; + FTimeTracker.free; inherited Destroy; end; function TTerminologyOperationContext.copy: TTerminologyOperationContext; begin - result := TTerminologyOperationContext.create(FI18n.link, FId, FLangList.link, FTimeLimit, OnGetCurrentRequestCount); + result := TTerminologyOperationContext.create(FI18n.link, FId, FLangList.link, FTimeLimit, OnGetCurrentRequestCount, FTimeTracker.link); result.FContexts.assign(FContexts); result.FStartTime := FStartTime; - result.FNotes.free; - result.FOwnsNotes := false; - result.FNotes := FNotes; end; function TTerminologyOperationContext.deadCheck(var time : integer): boolean; @@ -325,24 +331,29 @@ procedure TTerminologyOperationContext.clearContexts; FContexts.clear; end; -procedure TTerminologyOperationContext.addNote(vs : TFHIRValueSetW; note: String); +procedure TTerminologyOperationContext.log(note: String); var s : string; begin - s := DescribePeriodMS(GetTickCount64 - FStartTime)+' '+vs.vurl+': '+note; - if false and UnderDebugger then + s := DescribePeriodMS(GetTickCount64 - FStartTime)+' '+note; + if UnderDebugger then Logging.log(s); - FNotes.add(s); + FTimeTracker.step(s); end; -function TTerminologyOperationContext.notes: String; +procedure TTerminologyOperationContext.addNote(vs : TFHIRValueSetW; note : String); +var + s : string; begin - result := FNotes.Text; + s := DescribePeriodMS(GetTickCount64 - FStartTime)+' '+vs.vurl+': '+note; + if UnderDebugger then + Logging.log(s); + FTimeTracker.step(s); end; -function TTerminologyOperationContext.hasNotes: boolean; +function TTerminologyOperationContext.diagnostics: String; begin - result := FNotes.Count > 0; + result := FTimeTracker.log; end; class function TTerminologyOperationContext.renderCoded(system: TCodeSystemProvider): String; @@ -525,7 +536,7 @@ function TTerminologyWorker.findCodeSystem(url, version: String; params: TFHIRTx function TTerminologyWorker.costDiags(e: ETooCostly): ETooCostly; begin - e.diagnostics := FOpContext.notes; + e.diagnostics := FOpContext.diagnostics; result := e; end; @@ -596,22 +607,22 @@ procedure TTerminologyWorker.loadSupplements(cse : TFHIRCodeSystemEntry; url : S end; end; -procedure TTerminologyWorker.checkSupplements(cs : TCodeSystemProvider; src : TFHIRXVersionElementWrapper); +procedure TTerminologyWorker.checkSupplements(opContext : TTxOperationContext; cs : TCodeSystemProvider; src : TFHIRXVersionElementWrapper); var ext : TFHIRExtensionW; i : integer; begin for ext in src.getExtensionsW(EXT_VSSUPPLEMENT).forEnum do - if not cs.hasSupplement(ext.valueAsString) then + if not cs.hasSupplement(opContext, ext.valueAsString) then raise ETerminologyError.create('ValueSet depends on supplement '''+ext.valueAsString+''' on '+cs.systemUri+' that is not known', itBusinessRule); for i := FRequiredSupplements.count - 1 downto 0 do - if cs.hasSupplement(FRequiredSupplements[i]) then + if cs.hasSupplement(opContext, FRequiredSupplements[i]) then FRequiredSupplements.delete(i); end; { TFHIRCodeSystemInformationProvider } -procedure TFHIRCodeSystemInformationProvider.lookupCode(coding: TFHIRCodingW; profile: TFHIRTxOperationParams; props: TArray; resp: TFHIRLookupOpResponseW); +procedure TFHIRCodeSystemInformationProvider.lookupCode(opContext : TTxOperationContext; coding: TFHIRCodingW; profile: TFHIRTxOperationParams; props: TArray; resp: TFHIRLookupOpResponseW); var provider : TCodeSystemProvider; ctxt : TCodeSystemProviderContext; @@ -637,12 +648,12 @@ procedure TFHIRCodeSystemInformationProvider.lookupCode(coding: TFHIRCodingW; pr s := provider.version; if (s <> '') then resp.version := s; - ctxt := provider.locate(coding.code); + ctxt := provider.locate(opContext, coding.code); try if ctxt = nil then raise ETerminologyError.Create('Unable to find code '+coding.code+' in '+coding.systemUri+' version '+s, itInvalid); - if (hasProp('abstract', true) and provider.IsAbstract(ctxt)) then + if (hasProp('abstract', true) and provider.IsAbstract(opContext, ctxt)) then begin p := resp.addProp('abstract'); p.value := FFactory.makeBoolean(true); @@ -650,16 +661,16 @@ procedure TFHIRCodeSystemInformationProvider.lookupCode(coding: TFHIRCodingW; pr if (hasProp('inactive', true)) then begin p := resp.addProp('inactive'); - p.value := FFactory.makeBoolean(provider.IsInactive(ctxt)); + p.value := FFactory.makeBoolean(provider.IsInactive(opContext, ctxt)); end; - if hasProp('definition', true) and (provider.Definition(ctxt) <> '') then + if hasProp('definition', true) and (provider.Definition(opContext, ctxt) <> '') then begin p := resp.addProp('definition'); - p.value := FFactory.makeString(provider.Definition(ctxt)); + p.value := FFactory.makeString(provider.Definition(opContext, ctxt)); end; resp.code := coding.code; - resp.display := provider.Display(ctxt, FlangList); - provider.extendLookup(FFactory, ctxt, FlangList, props, resp); + resp.display := provider.Display(opContext, ctxt, FlangList); + provider.extendLookup(opContext, FFactory, ctxt, FlangList, props, resp); finally ctxt.free; end; diff --git a/library/fsl/fsl_logging.pas b/library/fsl/fsl_logging.pas index fa350f57f..fefecb4c2 100644 --- a/library/fsl/fsl_logging.pas +++ b/library/fsl/fsl_logging.pas @@ -190,6 +190,24 @@ TLogging = class (TFslObject) var Logging : TLogging; +type + + { TFslTimeTracker } + + TFslTimeTracker = class (TFslObject) + private + FStart : int64; + FLast : Int64; + FLog : TFslStringBuilder; + public + constructor Create; override; + destructor Destroy; override; + function link : TFslTimeTracker; overload; + + procedure step(name : String); + function total : integer; + function log : String; + end; implementation @@ -827,6 +845,49 @@ function TLogging.sizeInBytesV(magic : integer) : cardinal; inc(result, (FWorkingLine.length * sizeof(char)) + 12); end; + +{ TFslTimeTracker } + +constructor TFslTimeTracker.Create; +begin + inherited; + FStart := GetTickCount64; + FLast := FStart; + FLog := TFslStringBuilder.create; + Flog.append('0 0 : start'#13#10); +end; + +destructor TFslTimeTracker.Destroy; +begin + FLog.free; + inherited; +end; + +function TFslTimeTracker.link: TFslTimeTracker; +begin + result := TFslTimeTracker(inherited Link); +end; + +function TFslTimeTracker.log : String; +begin + result := Flog.AsString; +end; + +procedure TFslTimeTracker.step(name: String); +var + t : int64; +begin + t := GetTickCount64; + Flog.append(inttostr(t-FStart)+' '+inttostr(t - FLast)+': '+name+#13#10); + FLast := t; +end; + +function TFslTimeTracker.total: integer; +begin + result := GetTickCount64 - FStart; +end; + + Initialization Logging := TLogging.Create; Finalization diff --git a/library/ftx/fhir_codesystem_service.pas b/library/ftx/fhir_codesystem_service.pas index 96d842a9c..58790daff 100644 --- a/library/ftx/fhir_codesystem_service.pas +++ b/library/ftx/fhir_codesystem_service.pas @@ -225,43 +225,43 @@ TFhirCodeSystemProvider = class (TCodeSystemProvider) function version(): String; override; function TotalCount : integer; override; function getPropertyDefinitions : TFslList; override; - function getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; - function getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; + function getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; + function getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; function systemUri() : String; override; - function getDisplay(code : String; langList : THTTPLanguageList):String; override; - function locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; overload; override; - function IsAbstract(context : TCodeSystemProviderContext) : boolean; override; - function IsInactive(context : TCodeSystemProviderContext) : boolean; override; - function getCodeStatus(context : TCodeSystemProviderContext) : String; override; - function Code(context : TCodeSystemProviderContext) : string; override; - function Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; - procedure Designations(context : TCodeSystemProviderContext; list : TConceptDesignations); override; - function getDefinition(code : String):String; override; - function Definition(context : TCodeSystemProviderContext) : string; override; - function itemWeight(context : TCodeSystemProviderContext) : string; override; - function deprecated(context : TCodeSystemProviderContext) : boolean; override; - function getExtensions(context : TCodeSystemProviderContext) : TFslList; override; - function getProperties(context : TCodeSystemProviderContext) : TFslList; override; - function parent(context : TCodeSystemProviderContext) : String; override; - function listCodes(ctxt : TCodeSystemProviderContext; altOpt : TAlternateCodeOptions) : TStringArray; override; + function getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; override; + function locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; overload; override; + function IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; override; + function IsInactive(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; override; + function getCodeStatus(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : String; override; + function Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + function Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; + procedure Designations(opContext : TTxOperationContext; context : TCodeSystemProviderContext; list : TConceptDesignations); override; + function getDefinition(opContext : TTxOperationContext; code : String):String; override; + function Definition(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + function itemWeight(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + function deprecated(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; override; + function getExtensions(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TFslList; override; + function getProperties(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TFslList; override; + function parent(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : String; override; + function listCodes(opContext : TTxOperationContext; ctxt : TCodeSystemProviderContext; altOpt : TAlternateCodeOptions) : TStringArray; override; function canParent : boolean; override; function hasAnyDisplays(langs : THTTPLanguageList) : boolean; override; - function hasSupplement(url : String) : boolean; override; - procedure listSupplements(ts : TStringList); override; - function filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; - function FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; override; - function filterSize(ctxt : TCodeSystemProviderFilterContext) : integer; override; - function FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; - function InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; - function locateIsA(code, parent : String; disallowSelf : boolean = false) : TCodeSystemProviderContext; override; - function filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; - function searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; overload; override; - function isNotClosed(textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; - procedure getCDSInfo(card : TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display : String); override; - procedure extendLookup(factory : TFHIRFactory; ctxt : TCodeSystemProviderContext; langList : THTTPLanguageList; props : TArray; resp : TFHIRLookupOpResponseW); override; - function subsumesTest(codeA, codeB : String) : String; override; - procedure defineFeatures(features : TFslList); override; + function hasSupplement(opContext : TTxOperationContext; url : String) : boolean; override; + procedure listSupplements(opContext : TTxOperationContext; ts : TStringList); override; + function filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; + function FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; override; + function filterSize(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : integer; override; + function FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; + function InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; + function locateIsA(opContext : TTxOperationContext; code, parent : String; disallowSelf : boolean = false) : TCodeSystemProviderContext; override; + function filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; + function searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; overload; override; + function isNotClosed(opContext : TTxOperationContext; textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; + procedure getCDSInfo(opContext : TTxOperationContext; card : TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display : String); override; + procedure extendLookup(opContext : TTxOperationContext; factory : TFHIRFactory; ctxt : TCodeSystemProviderContext; langList : THTTPLanguageList; props : TArray; resp : TFHIRLookupOpResponseW); override; + function subsumesTest(opContext : TTxOperationContext; codeA, codeB : String) : String; override; + procedure defineFeatures(opContext : TTxOperationContext; features : TFslList); override; procedure getStatus(out status: TPublicationStatus; out standardsStatus: String; out experimental : boolean); override; end; @@ -561,7 +561,7 @@ constructor TFhirCodeSystemProvider.Create(languages: TIETFLanguageDefinitions; setDefLang(FLanguages.parse(FCs.CodeSystem.language)); end; -procedure TFhirCodeSystemProvider.defineFeatures(features: TFslList); +procedure TFhirCodeSystemProvider.defineFeatures(opContext : TTxOperationContext; features: TFslList); begin features.Add(TFHIRFeature.fromString('rest.Codesystem:'+systemUri+'.filter', 'concept:is-a')); features.Add(TFHIRFeature.fromString('rest.Codesystem:'+systemUri+'.filter', 'concept:is-not-a')); @@ -576,22 +576,22 @@ procedure TFhirCodeSystemProvider.getStatus(out status: TPublicationStatus; out experimental := FCs.CodeSystem.experimental; end; -function TFhirCodeSystemProvider.Definition(context: TCodeSystemProviderContext): string; +function TFhirCodeSystemProvider.Definition(opContext : TTxOperationContext; context: TCodeSystemProviderContext): string; begin result := TFhirCodeSystemProviderContext(context).concept.definition; end; -function TFhirCodeSystemProvider.itemWeight(context: TCodeSystemProviderContext): string; +function TFhirCodeSystemProvider.itemWeight(opContext : TTxOperationContext; context: TCodeSystemProviderContext): string; begin Result := TFhirCodeSystemProviderContext(context).concept.itemWeight; end; -function TFhirCodeSystemProvider.deprecated(context: TCodeSystemProviderContext): boolean; +function TFhirCodeSystemProvider.deprecated(opContext : TTxOperationContext; context: TCodeSystemProviderContext): boolean; begin Result := FCs.CodeSystem.isDeprecated(TFhirCodeSystemProviderContext(context).concept); end; -function TFhirCodeSystemProvider.getExtensions(context: TCodeSystemProviderContext): TFslList; +function TFhirCodeSystemProvider.getExtensions(opContext : TTxOperationContext; context: TCodeSystemProviderContext): TFslList; var ctxt : TFhirCodeSystemProviderContext; ext : TFHIRExtensionW; @@ -618,7 +618,7 @@ function TFhirCodeSystemProvider.getExtensions(context: TCodeSystemProviderConte end; end; -function TFhirCodeSystemProvider.getProperties(context: TCodeSystemProviderContext): TFslList; +function TFhirCodeSystemProvider.getProperties(opContext : TTxOperationContext; context: TCodeSystemProviderContext): TFslList; var ctxt : TFhirCodeSystemProviderContext; cp : TFhirCodeSystemConceptPropertyW; @@ -665,7 +665,7 @@ function TFhirCodeSystemProvider.locateParent(ctxt : TFHIRCodeSystemConceptW; co end; end; -function TFhirCodeSystemProvider.parent(context: TCodeSystemProviderContext): String; +function TFhirCodeSystemProvider.parent(opContext : TTxOperationContext; context: TCodeSystemProviderContext): String; var ctxt : TFhirCodeSystemProviderContext; c : TFHIRCodeSystemConceptW; @@ -687,7 +687,7 @@ function TFhirCodeSystemProvider.parent(context: TCodeSystemProviderContext): St end; end; -function TFhirCodeSystemProvider.listCodes(ctxt: TCodeSystemProviderContext; altOpt: TAlternateCodeOptions): TStringArray; +function TFhirCodeSystemProvider.listCodes(opContext : TTxOperationContext; ctxt: TCodeSystemProviderContext; altOpt: TAlternateCodeOptions): TStringArray; var c : TFHIRCodeSystemConceptW; p : TFhirCodeSystemConceptPropertyW; @@ -738,7 +738,7 @@ function {TFhirCodeSystemProvider.}allCodes(context : pointer; concept: TFhirCod result := true; end; -function TFhirCodeSystemProvider.getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; +function TFhirCodeSystemProvider.getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; begin if context = nil then result := TCodeSystemIteratorContext.Create(nil, FCs.CodeSystem.conceptCount) @@ -746,7 +746,7 @@ function TFhirCodeSystemProvider.getIterator(context : TCodeSystemProviderContex result := TCodeSystemIteratorContext.Create(context.Link, TFhirCodeSystemProviderContext(context).concept.conceptCount + TFhirCodeSystemProviderContext(context).concept.extensionCount('http://hl7.org/fhir/StructureDefinition/codesystem-subsumes')); end; -function TFhirCodeSystemProvider.Code(context: TCodeSystemProviderContext): string; +function TFhirCodeSystemProvider.Code(opContext : TTxOperationContext; context: TCodeSystemProviderContext): string; begin result := TFhirCodeSystemProviderContext(context).concept.code; end; @@ -764,7 +764,7 @@ function spacer(s : String) : String; result := s+' '; end; -procedure TFhirCodeSystemProvider.getCDSInfo(card: TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display: String); +procedure TFhirCodeSystemProvider.getCDSInfo(opContext : TTxOperationContext; card: TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display: String); var b : TFslStringBuilder; ctxt : TFhirCodeSystemProviderContext; @@ -774,7 +774,7 @@ procedure TFhirCodeSystemProvider.getCDSInfo(card: TCDSHookCard; langList : THTT begin b := TFslStringBuilder.Create; try - ctxt := TFhirCodeSystemProviderContext(locate(code)); + ctxt := TFhirCodeSystemProviderContext(locate(opContext, code)); if ctxt = nil Then b.Append('Error: Code '+code+' not known') else @@ -831,7 +831,7 @@ procedure TFhirCodeSystemProvider.getCDSInfo(card: TCDSHookCard; langList : THTT b.free; end;end; -function TFhirCodeSystemProvider.getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; +function TFhirCodeSystemProvider.getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; var ex : TFhirExtensionW; code : String; @@ -866,7 +866,7 @@ function TFhirCodeSystemProvider.getNextContext(context : TCodeSystemIteratorCon context.next; end; -function TFhirCodeSystemProvider.Display(context: TCodeSystemProviderContext; langList : THTTPLanguageList): string; +function TFhirCodeSystemProvider.Display(opContext : TTxOperationContext; context: TCodeSystemProviderContext; langList : THTTPLanguageList): string; var ccd : TFhirCodeSystemConceptDesignationW; css : TFHIRCodeSystemW; @@ -895,7 +895,7 @@ function TFhirCodeSystemProvider.Display(context: TCodeSystemProviderContext; la end; end; -procedure TFhirCodeSystemProvider.Designations(context: TCodeSystemProviderContext; list: TConceptDesignations); +procedure TFhirCodeSystemProvider.Designations(opContext : TTxOperationContext; context: TCodeSystemProviderContext; list: TConceptDesignations); var ctxt : TFhirCodeSystemProviderContext; ccd : TFhirCodeSystemConceptDesignationW; @@ -925,7 +925,7 @@ procedure TFhirCodeSystemProvider.Designations(context: TCodeSystemProviderConte end; end; -function TFhirCodeSystemProvider.InFilter(ctxt: TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext): Boolean; +function TFhirCodeSystemProvider.InFilter(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext): Boolean; var cm : TFhirCodeSystemConceptMatch; c : TFhirCodeSystemConceptW; @@ -940,17 +940,17 @@ function TFhirCodeSystemProvider.InFilter(ctxt: TCodeSystemProviderFilterContext end; end; -function TFhirCodeSystemProvider.IsAbstract(context: TCodeSystemProviderContext): boolean; +function TFhirCodeSystemProvider.IsAbstract(opContext : TTxOperationContext; context: TCodeSystemProviderContext): boolean; begin result := FCs.CodeSystem.isAbstract(TFhirCodeSystemProviderContext(context).concept); end; -function TFhirCodeSystemProvider.IsInactive(context: TCodeSystemProviderContext): boolean; +function TFhirCodeSystemProvider.IsInactive(opContext : TTxOperationContext; context: TCodeSystemProviderContext): boolean; begin Result := FCs.CodeSystem.isInactive(TFhirCodeSystemProviderContext(context).concept); end; -function TFhirCodeSystemProvider.getCodeStatus(context: TCodeSystemProviderContext): String; +function TFhirCodeSystemProvider.getCodeStatus(opContext : TTxOperationContext; context: TCodeSystemProviderContext): String; begin Result := FCs.CodeSystem.codeStatus(TFhirCodeSystemProviderContext(context).concept); end; @@ -992,36 +992,36 @@ function TFhirCodeSystemProvider.sourcePackage: String; result := ''; end; -function TFhirCodeSystemProvider.isNotClosed(textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; +function TFhirCodeSystemProvider.isNotClosed(opContext : TTxOperationContext; textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; begin result := false; end; -function TFhirCodeSystemProvider.getDefinition(code: String): String; +function TFhirCodeSystemProvider.getDefinition(opContext : TTxOperationContext; code: String): String; var ctxt : TCodeSystemProviderContext; begin - ctxt := locate(code); + ctxt := locate(opContext, code); try if (ctxt = nil) then raise ETerminologyError.create('Unable to find '+code+' in '+systemUri, itUnknown) else - result := Definition(ctxt); + result := Definition(opContext, ctxt); finally ctxt.free; end; end; -function TFhirCodeSystemProvider.getDisplay(code: String; langList : THTTPLanguageList): String; +function TFhirCodeSystemProvider.getDisplay(opContext : TTxOperationContext; code: String; langList : THTTPLanguageList): String; var ctxt : TCodeSystemProviderContext; begin - ctxt := locate(code); + ctxt := locate(opContext, code); try if (ctxt = nil) then raise ETerminologyError.create('Unable to find '+code+' in '+systemUri, itUnknown) else - result := Display(ctxt, langList); + result := Display(opContext, ctxt, langList); finally ctxt.free; end; @@ -1103,7 +1103,7 @@ function TFhirCodeSystemProvider.hasPropForCode(code: String): boolean; end; -function TFhirCodeSystemProvider.hasSupplement(url: String): boolean; +function TFhirCodeSystemProvider.hasSupplement(opContext : TTxOperationContext; url: String): boolean; var cs : TFHIRCodeSystemW; begin @@ -1113,7 +1113,7 @@ function TFhirCodeSystemProvider.hasSupplement(url: String): boolean; exit(true); end; -procedure TFhirCodeSystemProvider.listSupplements(ts: TStringList); +procedure TFhirCodeSystemProvider.listSupplements(opContext : TTxOperationContext; ts: TStringList); var cs : TFHIRCodeSystemW; begin @@ -1201,7 +1201,7 @@ function hasProp(props : TArray; name : String; def : boolean) : boolean result := StringArrayExistsSensitive(props, name) or StringArrayExistsSensitive(props, '*'); end; -procedure TFhirCodeSystemProvider.extendLookup(factory : TFHIRFactory; ctxt: TCodeSystemProviderContext; langList : THTTPLanguageList; props: TArray; resp: TFHIRLookupOpResponseW); +procedure TFhirCodeSystemProvider.extendLookup(opContext : TTxOperationContext; factory : TFHIRFactory; ctxt: TCodeSystemProviderContext; langList : THTTPLanguageList; props: TArray; resp: TFHIRLookupOpResponseW); var concepts : TFhirCodeSystemConceptListW; cc, context : TFhirCodeSystemConceptW; @@ -1307,12 +1307,12 @@ procedure TFhirCodeSystemProvider.listChildrenByProperty(code: String; list, chi end; end; -function TFhirCodeSystemProvider.locate(code: String; altOpt : TAlternateCodeOptions; var message : String): TCodeSystemProviderContext; +function TFhirCodeSystemProvider.locate(opContext : TTxOperationContext; code: String; altOpt : TAlternateCodeOptions; var message : String): TCodeSystemProviderContext; begin result := DoLocate(code, altOpt); end; -function TFhirCodeSystemProvider.searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean): TCodeSystemProviderFilterContext; +function TFhirCodeSystemProvider.searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean): TCodeSystemProviderFilterContext; var res : TFhirCodeSystemProviderFilterContext; begin @@ -1326,7 +1326,7 @@ function TFhirCodeSystemProvider.searchFilter(filter : TSearchFilterText; prep : end; end; -function TFhirCodeSystemProvider.subsumesTest(codeA, codeB: String): String; +function TFhirCodeSystemProvider.subsumesTest(opContext : TTxOperationContext; codeA, codeB: String): String; var TFHIRCodeSystemEntry, cA, cB : TFhirCodeSystemConceptW; begin @@ -1595,7 +1595,7 @@ function toStringArray(value : String; ch : Char) : TStringArray; overload; result[i] := result[i].trim(); end; -function TFhirCodeSystemProvider.filter(forExpansion, forIteration : boolean; prop: String; op: TFhirFilterOperator; value: String; prep : TCodeSystemProviderFilterPreparationContext): TCodeSystemProviderFilterContext; +function TFhirCodeSystemProvider.filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop: String; op: TFhirFilterOperator; value: String; prep : TCodeSystemProviderFilterPreparationContext): TCodeSystemProviderFilterContext; var code : TFhirCodeSystemProviderContext; ts : TStringList; @@ -1787,18 +1787,18 @@ procedure TFhirCodeSystemProvider.FilterCodes(dest : TFhirCodeSystemProviderFilt end; end; -function TFhirCodeSystemProvider.FilterMore(ctxt: TCodeSystemProviderFilterContext): boolean; +function TFhirCodeSystemProvider.FilterMore(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): boolean; begin inc(TFhirCodeSystemProviderFilterContext(ctxt).ndx); result := TFhirCodeSystemProviderFilterContext(ctxt).ndx < TFhirCodeSystemProviderFilterContext(ctxt).concepts.Count; end; -function TFhirCodeSystemProvider.filterSize(ctxt: TCodeSystemProviderFilterContext): integer; +function TFhirCodeSystemProvider.filterSize(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): integer; begin result := TFhirCodeSystemProviderFilterContext(ctxt).concepts.Count; end; -function TFhirCodeSystemProvider.FilterConcept(ctxt: TCodeSystemProviderFilterContext): TCodeSystemProviderContext; +function TFhirCodeSystemProvider.FilterConcept(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): TCodeSystemProviderContext; var context : TFhirCodeSystemProviderFilterContext; begin @@ -1806,7 +1806,7 @@ function TFhirCodeSystemProvider.FilterConcept(ctxt: TCodeSystemProviderFilterCo result := TFhirCodeSystemProviderContext.Create(context.concepts[context.ndx].FItem.Link) end; -function TFhirCodeSystemProvider.filterLocate(ctxt: TCodeSystemProviderFilterContext; code: String; var message : String): TCodeSystemProviderContext; +function TFhirCodeSystemProvider.filterLocate(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext; code: String; var message : String): TCodeSystemProviderContext; var context : TFhirCodeSystemProviderFilterContext; i : integer; @@ -1832,7 +1832,7 @@ function hasParent(c, p : TFHIRCodeSystemCodeEntry) : boolean; exit(true); end; -function TFhirCodeSystemProvider.locateIsA(code, parent: String; disallowSelf: boolean = false): TCodeSystemProviderContext; +function TFhirCodeSystemProvider.locateIsA(opContext : TTxOperationContext; code, parent: String; disallowSelf: boolean = false): TCodeSystemProviderContext; var c, p : TFHIRCodeSystemCodeEntry; begin diff --git a/library/ftx/fhir_valuesets.pas b/library/ftx/fhir_valuesets.pas index b207bb405..37e4a39e0 100644 --- a/library/ftx/fhir_valuesets.pas +++ b/library/ftx/fhir_valuesets.pas @@ -130,7 +130,7 @@ TValueSetChecker = class (TValueSetWorker) function dispWarning : TIssueSeverity; function determineSystemFromExpansion(code: String): String; - function determineSystem(code : String) : String; + function determineSystem(opContext : TTxOperationContext; code : String) : String; function determineVersion(path, systemURI, versionVS, versionCoding : String; op : TFhirOperationOutcomeW; var message : String) : string; function check(path, system, version, code : String; abstractOk, inferSystem : boolean; displays : TConceptDesignations; unknownSystems : TStringList; var message, ver : String; var inactive : boolean; var normalForm : String; var vstatus : String; var cause : TFhirIssueType; op : TFhirOperationOutcomeW; vcc : TFHIRCodeableConceptW; params: TFHIRParametersW; var contentMode : TFhirCodeSystemContentMode; var impliedSystem : string; unkCodes, messages : TStringList; out defLang : TIETFLang) : TTrueFalseUnknown; overload; function findCode(cs : TFhirCodeSystemW; code: String; list : TFhirCodeSystemConceptListW; displays : TConceptDesignations; out isabstract : boolean): boolean; @@ -475,7 +475,7 @@ function TValueSetChecker.fixedSystemFromValueSet : String; end; end; -function TValueSetChecker.determineSystem(code: String): String; +function TValueSetChecker.determineSystem(opContext : TTxOperationContext; code: String): String; var vsi : TFhirValueSetComposeIncludeW; cs : TCodeSystemProvider; @@ -527,7 +527,7 @@ function TValueSetChecker.determineSystem(code: String): String; end else begin - loc := cs.locate(code, nil, msg); + loc := cs.locate(opContext, code, nil, msg); if loc <> nil then begin loc.free; @@ -719,14 +719,14 @@ procedure TValueSetChecker.prepareConceptSet(desc: string; cc: TFhirValueSetComp begin FOpContext.addNote(FValueSet, 'CodeSystem found: "'+TTerminologyOperationContext.renderCoded(cs)+'"'); for i := FRequiredSupplements.count - 1 downto 0 do - if cs.hasSupplement(FRequiredSupplements[i]) then + if cs.hasSupplement(FOpContext, FRequiredSupplements[i]) then FRequiredSupplements.delete(i); for ccf in cc.filters.forEnum do begin deadCheck('prepareConceptSet#2'); FFactory.checkNoModifiers(ccf, 'ValueSetChecker.prepare', desc + '.filter'); if not (('concept' = ccf.prop) and (ccf.Op in [foIsA, foDescendentOf])) then - if not cs.doesFilter(ccf.prop, ccf.Op, ccf.value) then + if not cs.doesFilter(FOpContext, ccf.prop, ccf.Op, ccf.value) then raise ETerminologyError.create('The filter "' + ccf.prop + ' ' + CODES_TFhirFilterOperator[ccf.Op] + ' ' + ccf.value + '" from the value set '+FValueSet.url+' was not understood in the context of ' + cs.systemUri, itNotSupported); end; end @@ -898,7 +898,7 @@ function TValueSetChecker.check(path, system, version, code: String; abstractOk, checkCanonicalStatus(path, op, cs, FValueSet); ver := cs.version; contentMode := cs.contentMode; - ctxt := cs.locate(code, nil, msg); + ctxt := cs.locate(FOpContext, code, nil, msg); if (ctxt = nil) then begin msg := ''; @@ -926,9 +926,9 @@ function TValueSetChecker.check(path, system, version, code: String; abstractOk, begin try if vcc <> nil then - vcc.addCoding(cs.systemUri, cs.version, cs.code(ctxt), cs.display(ctxt, FParams.Workinglanguages)); + vcc.addCoding(cs.systemUri, cs.version, cs.code(FOpContext, ctxt), cs.display(FOpContext, ctxt, FParams.Workinglanguages)); cause := itNull; - if not (abstractOk or not cs.IsAbstract(ctxt)) then + if not (abstractOk or not cs.IsAbstract(FOpContext, ctxt)) then begin result := bFalse; FLog := 'Abstract code when not allowed'; @@ -937,7 +937,7 @@ function TValueSetChecker.check(path, system, version, code: String; abstractOk, messages.add(msg); op.addIssue(isError, itBusinessRule, addToPath(path, 'code'), msg, oicCodeRule); end - else if ((FParams <> nil) and FParams.activeOnly and cs.isInactive(ctxt)) then + else if ((FParams <> nil) and FParams.activeOnly and cs.isInactive(FOpContext, ctxt)) then begin result := bFalse; FLog := 'Inactive code when not allowed'; @@ -950,18 +950,18 @@ function TValueSetChecker.check(path, system, version, code: String; abstractOk, begin FLog := 'found OK'; result := bTrue; - if (cs.Code(ctxt) <> code) then + if (cs.Code(FOpContext, ctxt) <> code) then begin - msg := FI18n.translate('CODE_CASE_DIFFERENCE', FParams.HTTPLanguages, [code, cs.Code(ctxt), cs.systemUri]); + msg := FI18n.translate('CODE_CASE_DIFFERENCE', FParams.HTTPLanguages, [code, cs.Code(FOpContext, ctxt), cs.systemUri]); messages.add(msg); op.addIssue(isWarning, itBusinessRule, addToPath(path, 'code'), msg, oicCodeRule); end; msg := cs.incompleteValidationMessage(ctxt, FParams.HTTPLanguages); if (msg <> '') then op.addIssue(isInformation, itInformational, addToPath(path, 'code'), msg, oicProcessingNote); - inactive := cs.IsInactive(ctxt); + inactive := cs.IsInactive(FOpContext, ctxt); if (inactive) then - vstatus := cs.getCodeStatus(ctxt); + vstatus := cs.getCodeStatus(FOpContext, ctxt); end; if (displays <> nil) then listDisplays(displays, cs, ctxt); @@ -1008,7 +1008,7 @@ function TValueSetChecker.check(path, system, version, code: String; abstractOk, checkCanonicalStatus(path, op, cs, FValueSet); ver := cs.version; contentMode := cs.contentMode; - ctxt := cs.locate(code); + ctxt := cs.locate(FOpContext, code); if (ctxt = nil) then begin unkCodes.add(system+'|'+version+'#'+code); @@ -1035,7 +1035,7 @@ function TValueSetChecker.check(path, system, version, code: String; abstractOk, begin try cause := itNull; - if not (abstractOk or not cs.IsAbstract(ctxt)) then + if not (abstractOk or not cs.IsAbstract(FOpContext, ctxt)) then begin result := bFalse; FLog := 'Abstract code when not allowed'; @@ -1044,7 +1044,7 @@ function TValueSetChecker.check(path, system, version, code: String; abstractOk, messages.add(msg); op.addIssue(isError, itBusinessRule, addToPath(path, 'code'), msg, oicCodeRule); end - else if ((FParams <> nil) and FParams.activeOnly and cs.isInactive(ctxt)) then + else if ((FParams <> nil) and FParams.activeOnly and cs.isInactive(FOpContext, ctxt)) then begin result := bFalse; FLog := 'Inactive code when not allowed'; @@ -1073,7 +1073,7 @@ function TValueSetChecker.check(path, system, version, code: String; abstractOk, // todo: we can never get here? if (system = '') and inferSystem then begin - system := determineSystem(code); + system := determineSystem(FOpContext, code); if (system = '') then begin message := FI18n.translate('UNABLE_TO_INFER_CODESYSTEM', FParams.HTTPLanguages, [code, FValueSet.vurl]); @@ -1175,7 +1175,7 @@ function TValueSetChecker.check(path, system, version, code: String; abstractOk, FOpContext.addNote(FValueSet, 'CodeSystem found: '+TTerminologyOperationContext.renderCoded(cs)+' for '+TTerminologyOperationContext.renderCoded(cc.systemUri, v)); checkCanonicalStatus(path, op, cs, FValueSet); ver := cs.version; - checkSupplements(cs, cc); + checkSupplements(FOpContext, cs, cc); contentMode := cs.contentMode; if ((system = SYSTEM_NOT_APPLICABLE) or (cs.systemUri = system)) and checkConceptSet(path, cs, cc, code, abstractOk, displays, FValueSet, message, inactive, normalForm, vstatus, op, vcc) then @@ -1221,7 +1221,7 @@ function TValueSetChecker.check(path, system, version, code: String; abstractOk, if (cs = nil) then raise ETerminologyError.Create('No Match for '+cc.systemUri+'|'+cc.version+' in '+FOthers.AsText, itUnknown); checkCanonicalStatus(path, op, cs, FValueSet); - checkSupplements(cs, cc); + checkSupplements(FOpContext, cs, cc); ver := cs.version; contentMode := cs.contentMode; excluded := ((system = SYSTEM_NOT_APPLICABLE) or (cs.systemUri = system)) and checkConceptSet(path, cs, cc, code, abstractOk, displays, FValueSet, message, inactive, normalForm, vstatus, op, vcc); @@ -1734,7 +1734,7 @@ function TValueSetChecker.check(issuePath : String; code: TFhirCodeableConceptW; else begin checkCanonicalStatus(path, op, prov, FValueSet); - ctxt := prov.locate(c.code, FAllAltCodes, message); + ctxt := prov.locate(FOpContext, c.code, FAllAltCodes, message); try if ctxt = nil then begin @@ -2012,7 +2012,7 @@ function TValueSetChecker.checkConceptSet(path : String; cs: TCodeSystemProvider result := false; if (not cset.hasConcepts) and (not cset.hasFilters) then begin - loc := cs.locate(code, FParams.altCodeRules, message); + loc := cs.locate(FOpContext, code, FParams.altCodeRules, message); try result := false; if loc = nil then @@ -2021,13 +2021,13 @@ function TValueSetChecker.checkConceptSet(path : String; cs: TCodeSystemProvider if (not FParams.membershipOnly) then op.addIssue(isError, itCodeInvalid, addToPath(path, 'code'), FI18n.translate('Unknown_Code_in_Version', FParams.HTTPLanguages, [code, cs.systemUri, cs.version]), oicInvalidCode) end - else if not (abstractOk or not cs.IsAbstract(loc)) then + else if not (abstractOk or not cs.IsAbstract(FOpContext, loc)) then begin FOpContext.addNote(FValueSet, 'Code "'+code+'" found in '+ TTerminologyOperationContext.renderCoded(cs)+' but is abstract'); if (not FParams.membershipOnly) then op.addIssue(isError, itBusinessRule, addToPath(path, 'code'), FI18n.translate('ABSTRACT_CODE_NOT_ALLOWED', FParams.HTTPLanguages, [cs.systemUri, code]), oicCodeRule) end - else if FValueSet.excludeInactives and cs.IsInactive(loc) then + else if FValueSet.excludeInactives and cs.IsInactive(FOpContext, loc) then begin FOpContext.addNote(FValueSet, 'Code "'+code+'" found in '+ TTerminologyOperationContext.renderCoded(cs)+' but is inactive'); op.addIssue(isError, itBusinessRule, addToPath(path, 'code'), FI18n.translate('STATUS_CODE_WARNING_CODE', FParams.HTTPLanguages, ['not active', code]), oicCodeRule); @@ -2036,40 +2036,40 @@ function TValueSetChecker.checkConceptSet(path : String; cs: TCodeSystemProvider begin inactive := true; if (inactive) then - vstatus := cs.getCodeStatus(loc); + vstatus := cs.getCodeStatus(FOpContext, loc); end; end - else if FParams.activeOnly and cs.IsInactive(loc) then + else if FParams.activeOnly and cs.IsInactive(FOpContext, loc) then begin FOpContext.addNote(FValueSet, 'Code "'+code+'" found in '+ TTerminologyOperationContext.renderCoded(cs)+' but is inactive'); result := false; inactive := true; - vstatus := cs.getCodeStatus(loc); + vstatus := cs.getCodeStatus(FOpContext, loc); op.addIssue(isError, itBusinessRule, addToPath(path, 'code'), FI18n.translate('STATUS_CODE_WARNING_CODE', FParams.HTTPLanguages, ['not active', code]), oicCodeRule); end else begin FOpContext.addNote(FValueSet, 'Code "'+code+'" found in '+ TTerminologyOperationContext.renderCoded(cs)); result := true; - if (cs.Code(loc) <> code) then + if (cs.Code(FOpContext, loc) <> code) then begin if (cs.version <> '') then - msg := FI18n.translate('CODE_CASE_DIFFERENCE', FParams.HTTPLanguages, [code, cs.Code(loc), cs.systemUri+'|'+cs.version]) + msg := FI18n.translate('CODE_CASE_DIFFERENCE', FParams.HTTPLanguages, [code, cs.Code(FOpContext, loc), cs.systemUri+'|'+cs.version]) else - msg := FI18n.translate('CODE_CASE_DIFFERENCE', FParams.HTTPLanguages, [code, cs.Code(loc), cs.systemUri]); + msg := FI18n.translate('CODE_CASE_DIFFERENCE', FParams.HTTPLanguages, [code, cs.Code(FOpContext, loc), cs.systemUri]); op.addIssue(isInformation, itBusinessRule, addToPath(path, 'code'), msg, oicCodeRule); - normalForm := cs.Code(loc); + normalForm := cs.Code(FOpContext, loc); end; msg := cs.incompleteValidationMessage(loc, FParams.HTTPLanguages); if (msg <> '') then op.addIssue(isInformation, itInformational, addToPath(path, 'code'), msg, oicProcessingNote); listDisplays(displays, cs, loc); - inactive := cs.IsInactive(loc); + inactive := cs.IsInactive(FOpContext, loc); if (inactive) then - vstatus := cs.getCodeStatus(loc); + vstatus := cs.getCodeStatus(FOpContext, loc); if vcc <> nil then - vcc.addCoding(cs.systemUri, cs.version, cs.code(loc), displays.preferredDisplay(FParams.workingLanguages)); + vcc.addCoding(cs.systemUri, cs.version, cs.code(FOpContext, loc), displays.preferredDisplay(FParams.workingLanguages)); exit; end; finally @@ -2083,31 +2083,31 @@ function TValueSetChecker.checkConceptSet(path : String; cs: TCodeSystemProvider c := cc.code; if (code = c) then begin - loc := cs.locate(code, FAllAltCodes); + loc := cs.locate(FOpContext, code, FAllAltCodes); try if Loc <> nil then begin FOpContext.addNote(FValueSet, 'Code "'+code+'" found in '+ TTerminologyOperationContext.renderCoded(cs)); listDisplays(displays, cs, loc); listDisplays(displays, cc, vs); - if not (abstractOk or not cs.IsAbstract(loc)) then + if not (abstractOk or not cs.IsAbstract(FOpContext, loc)) then begin if (not FParams.membershipOnly) then op.addIssue(isError, itBusinessRule, addToPath(path, 'code'), FI18n.translate('ABSTRACT_CODE_NOT_ALLOWED', FParams.HTTPLanguages, [cs.systemUri, code]), oicCodeRule) end - else if FValueSet.excludeInactives and cs.IsInactive(loc) then + else if FValueSet.excludeInactives and cs.IsInactive(FOpContext, loc) then begin result := false; if (not FParams.membershipOnly) then begin inactive := true; - vstatus := cs.getCodeStatus(loc); + vstatus := cs.getCodeStatus(FOpContext, loc); end end else begin if vcc <> nil then - vcc.addCoding(cs.systemUri, cs.version, cs.code(loc), displays.preferredDisplay(FParams.workingLanguages)); + vcc.addCoding(cs.systemUri, cs.version, cs.code(FOpContext, loc), displays.preferredDisplay(FParams.workingLanguages)); result := true; exit; end; @@ -2125,49 +2125,49 @@ function TValueSetChecker.checkConceptSet(path : String; cs: TCodeSystemProvider cfl := cset.filters; try SetLength(filters, cfl.count); - prep := cs.getPrepContext; + prep := cs.getPrepContext(FOpContext); try i := 0; for fc in cfl do begin deadCheck('checkConceptSet#2'); // gg - why? if ('concept' = fc.property_) and (fc.Op = FilterOperatorIsA) then - f := cs.filter(false, false, fc.prop, fc.Op, fc.value, prep); + f := cs.filter(FOpContext, false, false, fc.prop, fc.Op, fc.value, prep); if f = nil then raise ETerminologyError.create('The filter "'+fc.prop +' '+ CODES_TFhirFilterOperator[fc.Op]+ ' '+fc.value+'" from the value set '+vs.vurl+' was not understood in the context of '+cs.systemUri, itNotSupported); f.summary := '"'+fc.prop +' '+ CODES_TFhirFilterOperator[fc.Op]+ ' '+fc.value+'"'; filters[i] := f; inc(i); end; - if cs.prepare(prep) then // all are together, just query the first filter + if cs.prepare(FOpContext, prep) then // all are together, just query the first filter begin ctxt := filters[0]; - loc := cs.filterLocate(ctxt, code); + loc := cs.filterLocate(FOpContext, ctxt, code); try if Loc <> nil then begin listDisplays(displays, cs, loc); - if not (abstractOk or not cs.IsAbstract(loc)) then + if not (abstractOk or not cs.IsAbstract(FOpContext, loc)) then begin OpContext.addNote(FValueSet, 'Filter '+ctxt.summary+': Code "'+code+'" found in '+ TTerminologyOperationContext.renderCoded(cs)+' but is abstract'); if (not FParams.membershipOnly) then op.addIssue(isError, itBusinessRule, addToPath(path, 'code'), FI18n.translate('ABSTRACT_CODE_NOT_ALLOWED', FParams.HTTPLanguages, [cs.systemUri, code]), oicCodeRule) end - else if FValueSet.excludeInactives and cs.IsInactive(loc) then + else if FValueSet.excludeInactives and cs.IsInactive(FOpContext, loc) then begin result := false; OpContext.addNote(FValueSet, 'Filter '+ctxt.summary+': Code "'+code+'" found in '+ TTerminologyOperationContext.renderCoded(cs)+' but is inactive'); if (not FParams.membershipOnly) then begin inactive := true; - vstatus := cs.getCodeStatus(loc); + vstatus := cs.getCodeStatus(FOpContext, loc); end end else begin OpContext.addNote(FValueSet, 'Filter '+ctxt.summary+': Code "'+code+'" found in '+ TTerminologyOperationContext.renderCoded(cs)); if vcc <> nil then - vcc.addCoding(cs.systemUri, cs.version, cs.code(loc), displays.preferredDisplay(FParams.workingLanguages)); + vcc.addCoding(cs.systemUri, cs.version, cs.code(FOpContext, loc), displays.preferredDisplay(FParams.workingLanguages)); result := true; exit; end; @@ -2187,12 +2187,12 @@ function TValueSetChecker.checkConceptSet(path : String; cs: TCodeSystemProvider deadCheck('checkConceptSet#3'); if ('concept' = fc.prop) and (fc.Op in [foIsA, foDescendentOf]) then begin - loc := cs.locateIsA(code, fc.value, fc.Op = foDescendentOf); + loc := cs.locateIsA(FOpContext, code, fc.value, fc.Op = foDescendentOf); try if Loc <> nil then begin listDisplays(displays, cs, loc); - if not (abstractOk or not cs.IsAbstract(loc)) then + if not (abstractOk or not cs.IsAbstract(FOpContext, loc)) then begin OpContext.addNote(FValueSet, 'Filter "'+fc.prop +' '+ CODES_TFhirFilterOperator[fc.Op]+ ' '+fc.value+'": Code "'+code+'" found in '+ TTerminologyOperationContext.renderCoded(cs)+' but is abstract'); if (not FParams.membershipOnly) then @@ -2202,7 +2202,7 @@ function TValueSetChecker.checkConceptSet(path : String; cs: TCodeSystemProvider begin OpContext.addNote(FValueSet, 'Filter "'+fc.prop +' '+ CODES_TFhirFilterOperator[fc.Op]+ ' '+fc.value+'": Code "'+code+'" found in '+ TTerminologyOperationContext.renderCoded(cs)); if vcc <> nil then - vcc.addCoding(cs.systemUri, cs.version, cs.code(loc), displays.preferredDisplay(FParams.workingLanguages)); + vcc.addCoding(cs.systemUri, cs.version, cs.code(FOpContext, loc), displays.preferredDisplay(FParams.workingLanguages)); result := true; exit; end; @@ -2218,36 +2218,36 @@ function TValueSetChecker.checkConceptSet(path : String; cs: TCodeSystemProvider end else if ('concept' = fc.prop) and (fc.Op = foIsNotA) then begin - loc := cs.locateIsA(code, fc.value); + loc := cs.locateIsA(FOpContext, code, fc.value); try result := (loc = nil); if (result) then begin - loc := cs.locate(code, nil, msg); + loc := cs.locate(FOpContext, code, nil, msg); if Loc <> nil then begin listDisplays(displays, cs, loc); - if not (abstractOk or not cs.IsAbstract(loc)) then + if not (abstractOk or not cs.IsAbstract(FOpContext, loc)) then begin OpContext.addNote(FValueSet, 'Filter '+ctxt.summary+': Code "'+code+'" found in '+ TTerminologyOperationContext.renderCoded(cs)+' but is abstract'); if (not FParams.membershipOnly) then op.addIssue(isError, itBusinessRule, addToPath(path, 'code'), FI18n.translate('ABSTRACT_CODE_NOT_ALLOWED', FParams.HTTPLanguages, [cs.systemUri, code]), oicCodeRule) end - else if FValueSet.excludeInactives and cs.IsInactive(loc) then + else if FValueSet.excludeInactives and cs.IsInactive(FOpContext, loc) then begin OpContext.addNote(FValueSet, 'Filter '+ctxt.summary+': Code "'+code+'" found in '+ TTerminologyOperationContext.renderCoded(cs)+' but is inactive'); result := false; if (not FParams.membershipOnly) then begin inactive := true; - vstatus := cs.getCodeStatus(loc); + vstatus := cs.getCodeStatus(FOpContext, loc); end; end else begin OpContext.addNote(FValueSet, 'Filter '+ctxt.summary+': Code "'+code+'" found in '+ TTerminologyOperationContext.renderCoded(cs)); if vcc <> nil then - vcc.addCoding(cs.systemUri, cs.version, cs.code(loc), displays.preferredDisplay(FParams.workingLanguages)); + vcc.addCoding(cs.systemUri, cs.version, cs.code(FOpContext, loc), displays.preferredDisplay(FParams.workingLanguages)); result := true; exit; end; @@ -2263,34 +2263,34 @@ function TValueSetChecker.checkConceptSet(path : String; cs: TCodeSystemProvider begin ctxt := filters[i]; result := false; - loc := cs.filterLocate(ctxt, code, msg); + loc := cs.filterLocate(FOpContext, ctxt, code, msg); try if (loc = nil) and (message = '') then message := msg; if Loc <> nil then begin listDisplays(displays, cs, loc); - if not (abstractOk or not cs.IsAbstract(loc)) then + if not (abstractOk or not cs.IsAbstract(FOpContext, loc)) then begin OpContext.addNote(FValueSet, 'Filter '+ctxt.summary+': Code "'+code+'" found in '+ TTerminologyOperationContext.renderCoded(cs)+' but is abstract'); if (not FParams.membershipOnly) then op.addIssue(isError, itBusinessRule, addToPath(path, 'code'), FI18n.translate('ABSTRACT_CODE_NOT_ALLOWED', FParams.HTTPLanguages, [cs.systemUri, code]), oicCodeRule) end - else if FValueSet.excludeInactives and cs.IsInactive(loc) then + else if FValueSet.excludeInactives and cs.IsInactive(FOpContext, loc) then begin OpContext.addNote(FValueSet, 'Filter '+ctxt.summary+': Code "'+code+'" found in '+ TTerminologyOperationContext.renderCoded(cs)+' but is inactive'); result := false; if (not FParams.membershipOnly) then begin inactive := true; - vstatus := cs.getCodeStatus(loc); + vstatus := cs.getCodeStatus(FOpContext, loc); end; end else begin OpContext.addNote(FValueSet, 'Filter '+ctxt.summary+': Code "'+code+'" found in '+ TTerminologyOperationContext.renderCoded(cs)); if vcc <> nil then - vcc.addCoding(cs.systemUri, cs.version, cs.code(loc), displays.preferredDisplay(FParams.workingLanguages)); + vcc.addCoding(cs.systemUri, cs.version, cs.code(FOpContext, loc), displays.preferredDisplay(FParams.workingLanguages)); result := true; exit; end; @@ -2323,7 +2323,7 @@ function TValueSetChecker.checkExpansion(path: String; cs: TCodeSystemProvider; loc : TCodeSystemProviderContext; begin result := false; - loc := cs.locate(code, nil, message); + loc := cs.locate(FOpContext, code, nil, message); try result := false; if loc = nil then @@ -2331,7 +2331,7 @@ function TValueSetChecker.checkExpansion(path: String; cs: TCodeSystemProvider; if (not FParams.membershipOnly) then op.addIssue(isError, itCodeInvalid, addToPath(path, 'code'), FI18n.translate('Unknown_Code_in_Version', FParams.HTTPLanguages, [code, cs.systemUri, cs.version]), oicInvalidCode) end - else if not (abstractOk or not cs.IsAbstract(loc)) then + else if not (abstractOk or not cs.IsAbstract(FOpContext, loc)) then begin if (not FParams.membershipOnly) then op.addIssue(isError, itBusinessRule, addToPath(path, 'code'), FI18n.translate('ABSTRACT_CODE_NOT_ALLOWED', FParams.HTTPLanguages, [cs.systemUri, code]), oicCodeRule) @@ -2339,9 +2339,9 @@ function TValueSetChecker.checkExpansion(path: String; cs: TCodeSystemProvider; else begin result := true; - inactive := cs.IsInactive(loc); + inactive := cs.IsInactive(FOpContext, loc); if (inactive) then - vstatus := cs.getCodeStatus(loc); + vstatus := cs.getCodeStatus(FOpContext, loc); listDisplays(displays, cs, loc); exit; end; @@ -2496,6 +2496,7 @@ function TFHIRValueSetExpander.expand(source: TFHIRValueSetW; if (count > 0) and (offset = -1) then offset := 0; + opContext.log('start working'); DeadCheck('expand'); try ics := source.inlineCS; @@ -2553,6 +2554,7 @@ function TFHIRValueSetExpander.expand(source: TFHIRValueSetW; end; end; + opContext.log('finish up'); if notClosed then begin exp.addExtensionV('http://hl7.org/fhir/StructureDefinition/valueset-unclosed', FFactory.makeBoolean(true)); @@ -2713,7 +2715,7 @@ function TFHIRValueSetExpander.makeFilterForValueSet(cs: TCodeSystemProvider; vs begin for cf in inc.filters.forEnum do // will only cycle once begin - exit(cs.filter(true, false, cf.prop, cf.op, cf.value, nil)); + exit(cs.filter(FOpContext, true, false, cf.prop, cf.op, cf.value, nil)); end; end else @@ -2722,7 +2724,7 @@ function TFHIRValueSetExpander.makeFilterForValueSet(cs: TCodeSystemProvider; vs for cc in inc.concepts.forEnum do begin deadCheck('makeFilterForValueSet#2'); - TSpecialProviderFilterContextConcepts(result).add(cs.locate(cc.code, nil, message)); + TSpecialProviderFilterContextConcepts(result).add(cs.locate(FOpContext, cc.code, nil, message)); end; exit; end; @@ -2749,6 +2751,7 @@ procedure TFHIRValueSetExpander.handleCompose(source: TFhirValueSetW; filter : T vs.free; end; end; + opContext.log('compose #1'); for c in source.includes.forEnum do begin @@ -2761,6 +2764,7 @@ procedure TFHIRValueSetExpander.handleCompose(source: TFhirValueSetW; filter : T FHasExclusions := true; checkSource(c, expansion, filter, source.url); end; + opContext.log('compose #1'); for c in source.excludes.forEnum do begin @@ -2804,7 +2808,7 @@ procedure TFHIRValueSetExpander.handleDefine(cs : TFhirCodeSystemW; source : TFh procedure TValueSetWorker.listDisplays(displays : TConceptDesignations; cs : TCodeSystemProvider; c: TCodeSystemProviderContext); begin // list all known language displays - cs.Designations(c, displays); + cs.Designations(FOpContext, c, displays); displays.source := cs.link; end; @@ -3068,7 +3072,7 @@ function TFHIRValueSetExpander.includeCode(cs : TCodeSystemProvider; parent : TF begin ts := TStringList.create; try - cs.listSupplements(ts); + cs.listSupplements(FOpContext, ts); for vs in ts do begin if not expansion.hasParam('used-supplement', vs) then @@ -3266,7 +3270,7 @@ procedure TFHIRValueSetExpander.excludeCode(cs : TCodeSystemProvider; system, ve begin ts := TStringList.create; try - cs.listSupplements(ts); + cs.listSupplements(FOpContext, ts); for vs in ts do begin if not expansion.hasParam('used-supplement', vs) then @@ -3415,7 +3419,7 @@ procedure TFHIRValueSetExpander.checkSource(cset: TFhirValueSetComposeIncludeW; end else if filter.Null then // special case - add all the code system begin - if cs.isNotClosed(filter) then + if cs.isNotClosed(FOpContext, filter) then if cs.SpecialEnumeration <> '' then raise costDiags(ETooCostly.create('The code System "'+cs.systemUri+'" has a grammar, and cannot be enumerated directly. If an incomplete expansion is requested, a limited enumeration will be returned')) else @@ -3472,12 +3476,12 @@ procedure TFHIRValueSetExpander.includeCodes(cset: TFhirValueSetComposeIncludeW; begin ok := false; for t in (f as TSpecialProviderFilterContextConcepts).FList do - if cs.sameContext(t, c) then + if cs.sameContext(FOpContext, t, c) then ok := true; result := result and ok; end else - result := result and cs.InFilter(f, c); + result := result and cs.InFilter(FOpContext, f, c); end; end; begin @@ -3518,7 +3522,7 @@ procedure TFHIRValueSetExpander.includeCodes(cset: TFhirValueSetComposeIncludeW; cs := findCodeSystem(cset.systemUri, cset.version, FParams, [cscmComplete, cscmFragment], false); try //Logging.log('Processing '+vsId+',code system "'+cset.systemUri+'|'+cset.version+'", '+inttostr(cset.filterCount)+' filters, '+inttostr(cset.conceptCount)+' concepts'); - checkSupplements(cs, cset); + checkSupplements(FOpContext, cs, cset); checkCanonicalStatus(expansion, cs, FValueSet); sv := canonical(cs.systemUri, cs.version); if not expansion.hasParam('used-codesystem', sv) then @@ -3562,13 +3566,13 @@ procedure TFHIRValueSetExpander.includeCodes(cset: TFhirValueSetComposeIncludeW; end else if filter.Null then // special case - add all the code system begin - if cs.isNotClosed(filter) then + if cs.isNotClosed(FOpContext, filter) then if cs.SpecialEnumeration <> '' then raise costDiags(ETooCostly.create('The code System "'+cs.systemUri+'" has a grammar, and cannot be enumerated directly. If an incomplete expansion is requested, a limited enumeration will be returned')) else raise costDiags(ETooCostly.create('The code System "'+cs.systemUri+'" has a grammar, and cannot be enumerated directly')); - iter := cs.getIterator(nil); + iter := cs.getIterator(FOpContext, nil); try if valueSets.Empty and (FLimitCount > 0) and (iter.count > FLimitCount) and not (FParams.limitedExpansion) then raise costDiags(ETooCostly.create(FI18n.translate('VALUESET_TOO_COSTLY', FParams.HTTPLanguages, [vsSrc.url, '>'+inttostr(FLimitCount)]))); @@ -3576,7 +3580,7 @@ procedure TFHIRValueSetExpander.includeCodes(cset: TFhirValueSetComposeIncludeW; while iter.more do begin deadCheck('processCodes#3a'); - c := cs.getNextContext(iter); + c := cs.getNextContext(FOpContext, iter); try if passesFilters(c, 0) then inc(tcount, includeCodeAndDescendants(cs, c, expansion, valueSets, nil, excludeInactive, vsSrc.url)); @@ -3592,25 +3596,25 @@ procedure TFHIRValueSetExpander.includeCodes(cset: TFhirValueSetComposeIncludeW; else begin NoTotal; - if cs.isNotClosed(filter) then + if cs.isNotClosed(FOpContext, filter) then notClosed := true; - prep := cs.getPrepContext; + prep := cs.getPrepContext(FOpContext); try - ctxt := cs.searchFilter(filter, prep, false); + ctxt := cs.searchFilter(FOpContext, filter, prep, false); try - cs.prepare(prep); - while cs.FilterMore(ctxt) do + cs.prepare(FOpContext, prep); + while cs.FilterMore(FOpContext, ctxt) do begin deadCheck('processCodes#4'); - c := cs.FilterConcept(ctxt); + c := cs.FilterConcept(FOpContext, ctxt); try if passesFilters(c, 0) then begin cds := TConceptDesignations.Create(FFactory.link, FLanguages.link); try listDisplays(cds, cs, c); // cs.display(c, FParams.displayLanguage) - includeCode(cs, nil, cs.systemUri, cs.version, cs.code(c), cs.isAbstract(c), cs.isInactive(c), cs.deprecated(c), - cds, cs.definition(c), cs.itemWeight(c), expansion, valueSets, cs.getExtensions(c), nil, cs.getProperties(c), nil, excludeInactive, vsSrc.url); + includeCode(cs, nil, cs.systemUri, cs.version, cs.code(FOpContext, c), cs.isAbstract(FOpContext, c), cs.isInactive(FOpContext, c), cs.deprecated(FOpContext, c), + cds, cs.definition(FOpContext, c), cs.itemWeight(FOpContext, c), expansion, valueSets, cs.getExtensions(FOpContext, c), nil, cs.getProperties(FOpContext, c), nil, excludeInactive, vsSrc.url); finally cds.free; end; @@ -3638,9 +3642,9 @@ procedure TFHIRValueSetExpander.includeCodes(cset: TFhirValueSetComposeIncludeW; deadCheck('processCodes#3'); cds.Clear; FFactory.checkNoModifiers(cc, 'ValueSetExpander.processCodes', 'set concept reference'); - cctxt := cs.locate(cc.code, FAllAltCodes); + cctxt := cs.locate(FOpContext, cc.code, FAllAltCodes); try - if (cctxt <> nil) and (not FParams.activeOnly or not cs.IsInactive(cctxt)) and passesFilters(cctxt, 0) then + if (cctxt <> nil) and (not FParams.activeOnly or not cs.IsInactive(FOpContext, cctxt)) and passesFilters(cctxt, 0) then begin listDisplays(cds, cs, cctxt); listDisplays(cds, cc, vsSrc); @@ -3649,9 +3653,9 @@ procedure TFHIRValueSetExpander.includeCodes(cset: TFhirValueSetComposeIncludeW; inc(tcount); ov := cc.itemWeight; if ov = '' then - ov := cs.itemWeight(cctxt); - includeCode(cs, nil, cs.systemUri, cs.version, cc.code, cs.isAbstract(cctxt), cs.isInactive(cctxt), cs.deprecated(cctxt), cds, - cs.Definition(cctxt), ov, expansion, valueSets, cs.getExtensions(cctxt), cc.getAllExtensionsW, cs.getProperties(cctxt), nil, excludeInactive, vsSrc.url); + ov := cs.itemWeight(FOpContext, cctxt); + includeCode(cs, nil, cs.systemUri, cs.version, cc.code, cs.isAbstract(FOpContext, cctxt), cs.isInactive(FOpContext, cctxt), cs.deprecated(FOpContext, cctxt), cds, + cs.Definition(FOpContext, cctxt), ov, expansion, valueSets, cs.getExtensions(FOpContext, cctxt), cc.getAllExtensionsW, cs.getProperties(FOpContext, cctxt), nil, excludeInactive, vsSrc.url); end; end; finally @@ -3668,18 +3672,18 @@ procedure TFHIRValueSetExpander.includeCodes(cset: TFhirValueSetComposeIncludeW; begin fcl := cset.filters; try - prep := cs.getPrepContext; + prep := cs.getPrepContext(FOpContext); try offset := 0; if not filter.null then begin - filters.Insert(0, cs.searchFilter(filter, prep, true)); // this comes first, because it imposes order + filters.Insert(0, cs.searchFilter(FOpContext, filter, prep, true)); // this comes first, because it imposes order inc(offset); end; if cs.specialEnumeration <> '' then begin - filters.Insert(offset, cs.specialFilter(prep, true)); + filters.Insert(offset, cs.specialFilter(FOpContext, prep, true)); expansion.addExtensionV('http://hl7.org/fhir/StructureDefinition/valueset-toocostly', FFactory.makeBoolean(true)); notClosed := true; end; @@ -3688,44 +3692,44 @@ procedure TFHIRValueSetExpander.includeCodes(cset: TFhirValueSetComposeIncludeW; deadCheck('processCodes#4a'); fc := fcl[i]; ffactory.checkNoModifiers(fc, 'ValueSetExpander.processCodes', 'filter'); - f := cs.filter(true, i = 0, fc.prop, fc.Op, fc.value, prep); + f := cs.filter(FOpContext, true, i = 0, fc.prop, fc.Op, fc.value, prep); if f = nil then raise ETerminologyError.create('The filter "'+fc.prop +' '+ CODES_TFhirFilterOperator[fc.Op]+ ' '+fc.value+'" from the value set '+vsSrc.url+' was not understood in the context of '+cs.systemUri, itNotSupported); filters.Insert(offset, f); - if cs.isNotClosed(filter, f) then + if cs.isNotClosed(FOpContext, filter, f) then notClosed := true; if (cset.filterCount = 1) and (not excludeInactive) and not FParams.activeOnly then - AddToTotal(cs.filterSize(f)); + AddToTotal(cs.filterSize(FOpContext, f)); //else //NoTotal; end; - inner := cs.prepare(prep); + inner := cs.prepare(FOpContext, prep); count := 0; - While cs.FilterMore(filters[0]) do + While cs.FilterMore(FOpContext, filters[0]) do begin deadCheck('processCodes#5'); - c := cs.FilterConcept(filters[0]); + c := cs.FilterConcept(FOpContext, filters[0]); try - ok := (not FParams.activeOnly or not cs.IsInactive(c)) and (inner or passesFilters(c, 1)); + ok := (not FParams.activeOnly or not cs.IsInactive(FOpContext, c)) and (inner or passesFilters(c, 1)); if ok then begin inc(count); cds := TConceptDesignations.Create(FFactory.link, FLanguages.link); try - if passesImports(valueSets, cs.systemUri, cs.code(c), 0) then + if passesImports(valueSets, cs.systemUri, cs.code(FOpContext, c), 0) then begin listDisplays(cds, cs, c); if cs.canParent then - parent := FMap[key(cs.systemUri, cs.parent(c))] + parent := FMap[key(cs.systemUri, cs.parent(FOpContext, c))] else begin FCanBeHierarchy := false; parent := nil; end; - for code in cs.listCodes(c, FParams.altCodeRules) do - includeCode(cs, parent, cs.systemUri, cs.version, code, cs.isAbstract(c), cs.IsInactive(c), - cs.deprecated(c), cds, cs.definition(c), cs.itemWeight(c), expansion, nil, cs.getExtensions(c), nil, cs.getProperties(c), nil, excludeInactive, vsSrc.url); + for code in cs.listCodes(FOpContext, c, FParams.altCodeRules) do + includeCode(cs, parent, cs.systemUri, cs.version, code, cs.isAbstract(FOpContext, c), cs.IsInactive(FOpContext, c), + cs.deprecated(FOpContext, c), cds, cs.definition(FOpContext, c), cs.itemWeight(FOpContext, c), expansion, nil, cs.getExtensions(FOpContext, c), nil, cs.getProperties(FOpContext, c), nil, excludeInactive, vsSrc.url); end; finally cds.free; @@ -3793,12 +3797,12 @@ procedure TFHIRValueSetExpander.excludeCodes(cset: TFhirValueSetComposeIncludeW; begin ok := false; for t in (f as TSpecialProviderFilterContextConcepts).FList do - if cs.sameContext(t, c) then + if cs.sameContext(FOpContext, t, c) then ok := true; result := result and ok; end else - result := result and cs.InFilter(f, c); + result := result and cs.InFilter(FOpContext, f, c); end; end; begin @@ -3843,7 +3847,7 @@ procedure TFHIRValueSetExpander.excludeCodes(cset: TFhirValueSetComposeIncludeW; cs := findCodeSystem(cset.systemUri, cset.version, FParams, [cscmComplete, cscmFragment], false); try //Logging.log('Processing '+vsId+',code system "'+cset.systemUri+'|'+cset.version+'", '+inttostr(cset.filterCount)+' filters, '+inttostr(cset.conceptCount)+' concepts'); - checkSupplements(cs, cset); + checkSupplements(FOpContext, cs, cset); checkCanonicalStatus(expansion, cs, FValueSet); sv := canonical(cs.systemUri, cs.version); if not expansion.hasParam('used-codesystem', sv) then @@ -3874,6 +3878,7 @@ procedure TFHIRValueSetExpander.excludeCodes(cset: TFhirValueSetComposeIncludeW; if (not cset.hasConcepts) and (not cset.hasFilters) then begin + FOpContext.log('handle system'); if (cs.SpecialEnumeration <> '') and FParams.limitedExpansion and filters.Empty then begin base := expandValueSet(cs.SpecialEnumeration, '', filter.filter, dependencies, notClosed); @@ -3887,20 +3892,20 @@ procedure TFHIRValueSetExpander.excludeCodes(cset: TFhirValueSetComposeIncludeW; end else if filter.Null then // special case - add all the code system begin - if cs.isNotClosed(filter) then + if cs.isNotClosed(FOpContext, filter) then if cs.SpecialEnumeration <> '' then raise costDiags(ETooCostly.create('The code System "'+cs.systemUri+'" has a grammar, and cannot be enumerated directly. If an incomplete expansion is requested, a limited enumeration will be returned')) else raise costDiags(ETooCostly.create('The code System "'+cs.systemUri+'" has a grammar, and cannot be enumerated directly')); - iter := cs.getIterator(nil); + iter := cs.getIterator(FOpContext, nil); try if valueSets.Empty and (FLimitCount > 0) and (iter.count > FLimitCount) and not (FParams.limitedExpansion) then raise costDiags(ETooCostly.create(FI18n.translate('VALUESET_TOO_COSTLY', FParams.HTTPLanguages, [vsSrc.url, '>'+inttostr(FLimitCount)]))); while iter.more do begin deadCheck('processCodes#3a'); - c := cs.getNextContext(iter); + c := cs.getNextContext(FOpContext, iter); try if passesFilters(c, 0) then excludeCodeAndDescendants(cs, c, expansion, valueSets, excludeInactive, vsSrc.url); @@ -3915,23 +3920,23 @@ procedure TFHIRValueSetExpander.excludeCodes(cset: TFhirValueSetComposeIncludeW; else begin NoTotal; - if cs.isNotClosed(filter) then + if cs.isNotClosed(FOpContext, filter) then notClosed := true; - prep := cs.getPrepContext; + prep := cs.getPrepContext(FOpContext); try - ctxt := cs.searchFilter(filter, prep, false); + ctxt := cs.searchFilter(FOpContext, filter, prep, false); try - cs.prepare(prep); - while cs.FilterMore(ctxt) do + cs.prepare(FOpContext, prep); + while cs.FilterMore(FOpContext, ctxt) do begin deadCheck('processCodes#4'); - c := cs.FilterConcept(ctxt); + c := cs.FilterConcept(FOpContext, ctxt); try if passesFilters(c, 0) then begin cds := TConceptDesignations.Create(FFactory.link, FLanguages.link); try - excludeCode(cs, cs.systemUri, cs.version, cs.code(c), expansion, valueSets, vsSrc.url); + excludeCode(cs, cs.systemUri, cs.version, cs.code(FOpContext, c), expansion, valueSets, vsSrc.url); finally cds.free; end; @@ -3950,7 +3955,8 @@ procedure TFHIRValueSetExpander.excludeCodes(cset: TFhirValueSetComposeIncludeW; end; if (cset.hasConcepts) then - begin + begin + FOpContext.log('iterate concepts'); cds := TConceptDesignations.Create(FFactory.link, FLanguages.link); try for cc in cset.concepts.forEnum do @@ -3958,15 +3964,15 @@ procedure TFHIRValueSetExpander.excludeCodes(cset: TFhirValueSetComposeIncludeW; deadCheck('processCodes#3'); cds.Clear; FFactory.checkNoModifiers(cc, 'ValueSetExpander.processCodes', 'set concept reference'); - cctxt := cs.locate(cc.code, FAllAltCodes); + cctxt := cs.locate(FOpContext, cc.code, FAllAltCodes); try - if (cctxt <> nil) and (not FParams.activeOnly or not cs.IsInactive(cctxt)) and passesFilters(cctxt, 0) then + if (cctxt <> nil) and (not FParams.activeOnly or not cs.IsInactive(FOpContext, cctxt)) and passesFilters(cctxt, 0) then begin if filter.passes(cds) or filter.passes(cc.code) then begin ov := cc.itemWeight; if ov = '' then - ov := cs.itemWeight(cctxt); + ov := cs.itemWeight(FOpContext, cctxt); excludeCode(cs, cs.systemUri, cs.version, cc.code, expansion, valueSets, vsSrc.url); end; end; @@ -3981,20 +3987,21 @@ procedure TFHIRValueSetExpander.excludeCodes(cset: TFhirValueSetComposeIncludeW; if cset.hasFilters then begin + FOpContext.log('prep filters'); fcl := cset.filters; try - prep := cs.getPrepContext; + prep := cs.getPrepContext(FOpContext); try offset := 0; if not filter.null then begin - filters.Insert(0, cs.searchFilter(filter, prep, true)); // this comes first, because it imposes order + filters.Insert(0, cs.searchFilter(FOpContext, filter, prep, true)); // this comes first, because it imposes order inc(offset); end; if cs.specialEnumeration <> '' then begin - filters.Insert(offset, cs.specialFilter(prep, true)); + filters.Insert(offset, cs.specialFilter(FOpContext, prep, true)); expansion.addExtensionV('http://hl7.org/fhir/StructureDefinition/valueset-toocostly', FFactory.makeBoolean(true)); notClosed := true; end; @@ -4003,35 +4010,36 @@ procedure TFHIRValueSetExpander.excludeCodes(cset: TFhirValueSetComposeIncludeW; deadCheck('processCodes#4a'); fc := fcl[i]; ffactory.checkNoModifiers(fc, 'ValueSetExpander.processCodes', 'filter'); - f := cs.filter(true, i = 0, fc.prop, fc.Op, fc.value, prep); + f := cs.filter(FOpContext, true, i = 0, fc.prop, fc.Op, fc.value, prep); if f = nil then raise ETerminologyError.create('The filter "'+fc.prop +' '+ CODES_TFhirFilterOperator[fc.Op]+ ' '+fc.value+'" from the value set '+vsSrc.url+' was not understood in the context of '+cs.systemUri, itNotSupported); filters.Insert(offset, f); - if cs.isNotClosed(filter, f) then + if cs.isNotClosed(FOpContext, filter, f) then notClosed := true; end; - inner := cs.prepare(prep); + FOpContext.log('iterate filters'); + inner := cs.prepare(FOpContext, prep); count := 0; - While cs.FilterMore(filters[0]) do + While cs.FilterMore(FOpContext, filters[0]) do begin deadCheck('processCodes#5'); - c := cs.FilterConcept(filters[0]); + c := cs.FilterConcept(FOpContext, filters[0]); try - ok := (not FParams.activeOnly or not cs.IsInactive(c)) and (inner or passesFilters(c, 1)); + ok := (not FParams.activeOnly or not cs.IsInactive(FOpContext, c)) and (inner or passesFilters(c, 1)); if ok then begin inc(count); - if passesImports(valueSets, cs.systemUri, cs.code(c), 0) then + if passesImports(valueSets, cs.systemUri, cs.code(FOpContext, c), 0) then begin if cs.canParent then - parent := FMap[key(cs.systemUri, cs.parent(c))] + parent := FMap[key(cs.systemUri, cs.parent(FOpContext, c))] else begin FCanBeHierarchy := false; parent := nil; end; - for code in cs.listCodes(c, FParams.altCodeRules) do + for code in cs.listCodes(FOpContext, c, FParams.altCodeRules) do excludeCode(cs, cs.systemUri, cs.version, code, expansion, nil, vsSrc.url); end; end; @@ -4039,6 +4047,7 @@ procedure TFHIRValueSetExpander.excludeCodes(cset: TFhirValueSetComposeIncludeW; c.free; end; end; + FOpContext.log('iterate filters finished'); finally prep.free; end; @@ -4079,7 +4088,7 @@ function TFHIRValueSetExpander.includeCodeAndDescendants(cs: TCodeSystemProvider expansion.addParamUri('version', vs); ts := TStringList.create; try - cs.listSupplements(ts); + cs.listSupplements(FOpContext, ts); for vs in ts do begin deadCheck('processCodeAndDescendants'); @@ -4093,16 +4102,16 @@ function TFHIRValueSetExpander.includeCodeAndDescendants(cs: TCodeSystemProvider end; end; n := nil; - if (not FParams.excludeNotForUI or not cs.IsAbstract(context)) and (not FParams.activeOnly or not cs.isInActive(context)) then + if (not FParams.excludeNotForUI or not cs.IsAbstract(FOpContext, context)) and (not FParams.activeOnly or not cs.isInActive(FOpContext, context)) then begin cds := TConceptDesignations.Create(FFactory.link, FLanguages.link); try listDisplays(cds, cs, context); - for code in cs.listCodes(context, FParams.altCodeRules) do + for code in cs.listCodes(FOpContext, context, FParams.altCodeRules) do begin deadCheck('processCodeAndDescendants#2'); - t := includeCode(cs, parent, cs.systemUri, cs.version, code, cs.isAbstract(context), cs.IsInactive(context), cs.deprecated(context), cds, cs.definition(context), - cs.itemWeight(context), expansion, imports, cs.getExtensions(context), nil, cs.getProperties(context), nil, excludeInactive, srcUrl); + t := includeCode(cs, parent, cs.systemUri, cs.version, code, cs.isAbstract(FOpContext, context), cs.IsInactive(FOpContext, context), cs.deprecated(FOpContext, context), cds, cs.definition(FOpContext, context), + cs.itemWeight(FOpContext, context), expansion, imports, cs.getExtensions(FOpContext, context), nil, cs.getProperties(FOpContext, context), nil, excludeInactive, srcUrl); if (t <> nil) then inc(result); if (n = nil) then @@ -4114,12 +4123,12 @@ function TFHIRValueSetExpander.includeCodeAndDescendants(cs: TCodeSystemProvider end else n := parent; - iter := cs.getIterator(context); + iter := cs.getIterator(FOpContext, context); try while iter.more do begin deadCheck('processCodeAndDescendants#3'); - c := cs.getNextContext(iter); + c := cs.getNextContext(FOpContext, iter); try inc(result, includeCodeAndDescendants(cs, c, expansion, imports, n, excludeInactive, srcUrl)); finally @@ -4150,7 +4159,7 @@ procedure TFHIRValueSetExpander.excludeCodeAndDescendants(cs: TCodeSystemProvide expansion.addParamUri('version', vs); ts := TStringList.create; try - cs.listSupplements(ts); + cs.listSupplements(FOpContext, ts); for vs in ts do begin deadCheck('processCodeAndDescendants'); @@ -4163,12 +4172,12 @@ procedure TFHIRValueSetExpander.excludeCodeAndDescendants(cs: TCodeSystemProvide ts.free; end; end; - if (not FParams.excludeNotForUI or not cs.IsAbstract(context)) and (not FParams.activeOnly or not cs.isInActive(context)) then + if (not FParams.excludeNotForUI or not cs.IsAbstract(FOpContext, context)) and (not FParams.activeOnly or not cs.isInActive(FOpContext, context)) then begin cds := TConceptDesignations.Create(FFactory.link, FLanguages.link); try listDisplays(cds, cs, context); - for code in cs.listCodes(context, FParams.altCodeRules) do + for code in cs.listCodes(FOpContext, context, FParams.altCodeRules) do begin deadCheck('processCodeAndDescendants#2'); excludeCode(cs, cs.systemUri, cs.version, code, expansion, imports, srcUrl); @@ -4177,12 +4186,12 @@ procedure TFHIRValueSetExpander.excludeCodeAndDescendants(cs: TCodeSystemProvide cds.free; end; end; - iter := cs.getIterator(context); + iter := cs.getIterator(FOpContext, context); try while iter.more do begin deadCheck('processCodeAndDescendants#3'); - c := cs.getNextContext(iter); + c := cs.getNextContext(FOpContext, iter); try excludeCodeAndDescendants(cs, c, expansion, imports, excludeInactive, srcUrl); finally @@ -4209,11 +4218,11 @@ function TFHIRConceptMapTranslator.checkCode(op: TFhirOperationOutcomeW; langLis if cp <> nil then begin try - lct := cp.locate(code); + lct := cp.locate(FOpContext, code); try if (op.error('InstanceValidator', itInvalid, path, lct <> nil, 'Unknown Code ('+system+'#'+code+')')) then - result := op.warning('InstanceValidator', itInvalid, path, (display = '') or (display = cp.Display(lct, THTTPLanguageList(nil))), - 'Display for '+system+' code "'+code+'" should be "'+cp.Display(lct, THTTPLanguageList(nil))+'"'); + result := op.warning('InstanceValidator', itInvalid, path, (display = '') or (display = cp.Display(FOpContext, lct, THTTPLanguageList(nil))), + 'Display for '+system+' code "'+code+'" should be "'+cp.Display(FOpContext, lct, THTTPLanguageList(nil))+'"'); finally lct.free; end; diff --git a/library/ftx/ftx_lang.pas b/library/ftx/ftx_lang.pas index 29abae00b..430473fbf 100644 --- a/library/ftx/ftx_lang.pas +++ b/library/ftx/ftx_lang.pas @@ -77,34 +77,34 @@ TIETFLanguageCodeServices = class (TCodeSystemProvider) function description : String; override; function TotalCount : integer; override; - function getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; - function getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; + function getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; + function getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; function systemUri : String; override; function version : String; override; function name(context : TCodeSystemProviderContext) : String; override; - function getDisplay(code : String; langList : THTTPLanguageList):String; override; - function getDefinition(code : String):String; override; - function locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; - function locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; - function IsAbstract(context : TCodeSystemProviderContext) : boolean; override; - function Code(context : TCodeSystemProviderContext) : string; override; - function Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; - procedure Designations(context : TCodeSystemProviderContext; list : TConceptDesignations); override; - function Definition(context : TCodeSystemProviderContext) : string; override; - - function getPrepContext : TCodeSystemProviderFilterPreparationContext; override; - function prepare(prep : TCodeSystemProviderFilterPreparationContext) : boolean; override; - - function searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; - function filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; - function filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; - function FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; override; - function filterSize(ctxt : TCodeSystemProviderFilterContext) : integer; override; - function FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; - function InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; - function isNotClosed(textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; - - procedure defineFeatures(features : TFslList); override; + function getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; override; + function getDefinition(opContext : TTxOperationContext; code : String):String; override; + function locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; + function locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; + function IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; override; + function Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + function Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; + procedure Designations(opContext : TTxOperationContext; context : TCodeSystemProviderContext; list : TConceptDesignations); override; + function Definition(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + + function getPrepContext(opContext : TTxOperationContext) : TCodeSystemProviderFilterPreparationContext; override; + function prepare(opContext : TTxOperationContext; prep : TCodeSystemProviderFilterPreparationContext) : boolean; override; + + function searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; + function filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; + function filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; + function FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; override; + function filterSize(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : integer; override; + function FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; + function InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; + function isNotClosed(opContext : TTxOperationContext; textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; + + procedure defineFeatures(opContext : TTxOperationContext; features : TFslList); override; end; const @@ -115,7 +115,7 @@ implementation { TIETFLanguageCodeServices } -procedure TIETFLanguageCodeServices.defineFeatures(features: TFslList); +procedure TIETFLanguageCodeServices.defineFeatures(opContext : TTxOperationContext; features: TFslList); var s : string; begin @@ -138,12 +138,12 @@ function TIETFLanguageCodeServices.systemUri : String; result := URI_BCP47; end; -function TIETFLanguageCodeServices.getDefinition(code: String): String; +function TIETFLanguageCodeServices.getDefinition(opContext : TTxOperationContext; code: String): String; begin result := ''; end; -function TIETFLanguageCodeServices.getDisplay(code : String; langList : THTTPLanguageList):String; +function TIETFLanguageCodeServices.getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; var c : TIETFLang; msg : String; @@ -164,12 +164,12 @@ function TIETFLanguageCodeServices.getDisplay(code : String; langList : THTTPLan end; end; -function TIETFLanguageCodeServices.getPrepContext: TCodeSystemProviderFilterPreparationContext; +function TIETFLanguageCodeServices.getPrepContext(opContext : TTxOperationContext): TCodeSystemProviderFilterPreparationContext; begin result := nil; end; -procedure TIETFLanguageCodeServices.Designations(context: TCodeSystemProviderContext; list: TConceptDesignations); +procedure TIETFLanguageCodeServices.Designations(opContext : TTxOperationContext; context: TCodeSystemProviderContext; list: TConceptDesignations); var c : TIETFLanguageCodeConcept; msg : String; @@ -200,7 +200,7 @@ procedure TIETFLanguageCodeServices.Designations(context: TCodeSystemProviderCon end; -function TIETFLanguageCodeServices.locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; +function TIETFLanguageCodeServices.locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; var info : TIETFLang; begin @@ -212,12 +212,12 @@ function TIETFLanguageCodeServices.locate(code : String; altOpt : TAlternateCode end; -function TIETFLanguageCodeServices.Code(context : TCodeSystemProviderContext) : string; +function TIETFLanguageCodeServices.Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; begin result := TIETFLanguageCodeConcept(context).FInfo.code; end; -function TIETFLanguageCodeServices.Definition(context: TCodeSystemProviderContext): string; +function TIETFLanguageCodeServices.Definition(opContext : TTxOperationContext; context: TCodeSystemProviderContext): string; begin result := ''; end; @@ -228,7 +228,7 @@ function TIETFLanguageCodeServices.description: String; end; -function TIETFLanguageCodeServices.Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; +function TIETFLanguageCodeServices.Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; var ctxt : TIETFLanguageCodeConcept; begin @@ -236,15 +236,15 @@ function TIETFLanguageCodeServices.Display(context : TCodeSystemProviderContext; if (ctxt.FInfo = nil) then result := '' else - result := getDisplay(ctxt.FInfo.code, langList); + result := getDisplay(opContext, ctxt.FInfo.code, langList); end; -function TIETFLanguageCodeServices.IsAbstract(context : TCodeSystemProviderContext) : boolean; +function TIETFLanguageCodeServices.IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; begin result := false; // IETFLanguageCode doesn't do abstract end; -function TIETFLanguageCodeServices.isNotClosed(textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; +function TIETFLanguageCodeServices.isNotClosed(opContext : TTxOperationContext; textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; begin result := true; end; @@ -264,17 +264,17 @@ class function TIETFLanguageCodeServices.checkFile(sourceFile: String): String; end; end; -function TIETFLanguageCodeServices.getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; +function TIETFLanguageCodeServices.getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; begin result := TCodeSystemIteratorContext.Create(nil, 0); end; -function TIETFLanguageCodeServices.getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; +function TIETFLanguageCodeServices.getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; begin raise ETerminologyTodo.create('TIETFLanguageCodeServices.getcontext'); end; -function TIETFLanguageCodeServices.locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; +function TIETFLanguageCodeServices.locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; begin result := nil; // no subsumption end; @@ -285,17 +285,17 @@ function TIETFLanguageCodeServices.name(context: TCodeSystemProviderContext): St result := 'IETF langauge'; end; -function TIETFLanguageCodeServices.prepare(prep : TCodeSystemProviderFilterPreparationContext) : boolean; +function TIETFLanguageCodeServices.prepare(opContext : TTxOperationContext; prep : TCodeSystemProviderFilterPreparationContext) : boolean; begin result := false; end; -function TIETFLanguageCodeServices.searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; +function TIETFLanguageCodeServices.searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; begin raise ETerminologyTodo.create('TIETFLanguageCodeServices.searchFilter'); end; -function TIETFLanguageCodeServices.filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; +function TIETFLanguageCodeServices.filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; var i : integer; begin @@ -306,7 +306,7 @@ function TIETFLanguageCodeServices.filter(forExpansion, forIteration : boolean; raise ETerminologyError.Create('Not a supported filter', itInvalid); end; -function TIETFLanguageCodeServices.filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; +function TIETFLanguageCodeServices.filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; var cc : TIETFLanguageCodeConcept; filter : TIETFLanguageCodeFilter; @@ -342,22 +342,22 @@ function TIETFLanguageCodeServices.filterLocate(ctxt : TCodeSystemProviderFilter end; end; -function TIETFLanguageCodeServices.FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; +function TIETFLanguageCodeServices.FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; begin raise ETerminologyError.create('Language valuesets cannot be expanded as they are based on a grammar', itNotSupported); end; -function TIETFLanguageCodeServices.filterSize(ctxt: TCodeSystemProviderFilterContext): integer; +function TIETFLanguageCodeServices.filterSize(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): integer; begin raise ETerminologyError.create('Language valuesets cannot be expanded as they are based on a grammar', itNotSupported); end; -function TIETFLanguageCodeServices.FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; +function TIETFLanguageCodeServices.FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; begin raise ETerminologyTodo.create('TIETFLanguageCodeServices.FilterConcept'); end; -function TIETFLanguageCodeServices.InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; +function TIETFLanguageCodeServices.InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; begin raise ETerminologyTodo.create('TIETFLanguageCodeServices.InFilter'); end; diff --git a/library/ftx/ftx_loinc_services.pas b/library/ftx/ftx_loinc_services.pas index f79698068..7a828934b 100644 --- a/library/ftx/ftx_loinc_services.pas +++ b/library/ftx/ftx_loinc_services.pas @@ -182,7 +182,7 @@ TLOINCServices = class (TCodeSystemProvider) FProperties : TDictionary; FStatusKeys : TDictionary; function commaListOfCodes(source: String): String; - function filterBySQL(c : TFDBConnection; d, sql, lsql : String; forExpansion : boolean) : TCodeSystemProviderFilterContext; + function filterBySQL(opContext : TTxOperationContext; c : TFDBConnection; d, sql, lsql : String; forExpansion : boolean) : TCodeSystemProviderFilterContext; protected function sizeInBytesV(magic : integer) : cardinal; override; public @@ -195,37 +195,37 @@ TLOINCServices = class (TCodeSystemProvider) function description : String; override; function TotalCount : integer; override; - function getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; - function getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; + function getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; + function getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; //function findMAConcept(code : String) : Cardinal; function systemUri : String; override; function version : String; override; function name(context : TCodeSystemProviderContext) : String; override; - function getDisplay(code : String; langList : THTTPLanguageList):String; override; - function locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; - function sameContext(a, b : TCodeSystemProviderContext) : boolean; override; - function IsAbstract(context : TCodeSystemProviderContext) : boolean; override; - function Code(context : TCodeSystemProviderContext) : string; override; - function Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; - procedure Designations(context : TCodeSystemProviderContext; list : TConceptDesignations); override; - function doesFilter(prop : String; op : TFhirFilterOperator; value : String) : boolean; override; - function getPrepContext : TCodeSystemProviderFilterPreparationContext; override; - function filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; - function FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; override; - function filterSize(ctxt : TCodeSystemProviderFilterContext) : integer; override; - function FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; - function filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; - function InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; - function locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; - function searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; overload; override; + function getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; override; + function locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; + function sameContext(opContext : TTxOperationContext; a, b : TCodeSystemProviderContext) : boolean; override; + function IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; override; + function Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + function Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; + procedure Designations(opContext : TTxOperationContext; context : TCodeSystemProviderContext; list : TConceptDesignations); override; + function doesFilter(opContext : TTxOperationContext; prop : String; op : TFhirFilterOperator; value : String) : boolean; override; + function getPrepContext(opContext : TTxOperationContext) : TCodeSystemProviderFilterPreparationContext; override; + function filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; + function FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; override; + function filterSize(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : integer; override; + function FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; + function filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; + function InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; + function locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; + function searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; overload; override; function buildValueSet(factory : TFHIRFactory; id : String) : TFhirValueSetW; - function getDefinition(code : String):String; override; - function Definition(context : TCodeSystemProviderContext) : string; override; - function isNotClosed(textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; - procedure getCDSInfo(card : TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display : String); override; - procedure extendLookup(factory : TFHIRFactory; ctxt : TCodeSystemProviderContext; langList : THTTPLanguageList; props : TArray; resp : TFHIRLookupOpResponseW); override; + function getDefinition(opContext : TTxOperationContext; code : String):String; override; + function Definition(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + function isNotClosed(opContext : TTxOperationContext; textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; + procedure getCDSInfo(opContext : TTxOperationContext; card : TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display : String); override; + procedure extendLookup(opContext : TTxOperationContext; factory : TFHIRFactory; ctxt : TCodeSystemProviderContext; langList : THTTPLanguageList; props : TArray; resp : TFHIRLookupOpResponseW); override; //function subsumes(codeA, codeB : String) : String; override; - procedure defineFeatures(features : TFslList); override; + procedure defineFeatures(opContext : TTxOperationContext; features : TFslList); override; property DB : TFDBManager read FDB; @@ -343,7 +343,7 @@ function TLOINCServices.Link: TLOINCServices; result := TLOINCServices(inherited Link); end; -procedure TLOINCServices.defineFeatures(features: TFslList); +procedure TLOINCServices.defineFeatures(opContext : TTxOperationContext; features: TFslList); begin features.Add(TFHIRFeature.fromString('rest.Codesystem:'+systemUri+'.filter', 'SCALE_TYP:equals')); features.Add(TFHIRFeature.fromString('rest.Codesystem:'+systemUri+'.filter', 'SCALE_TYP:equals')); @@ -365,12 +365,12 @@ procedure TLOINCServices.defineFeatures(features: TFslList); features.Add(TFHIRFeature.fromString('rest.Codesystem:'+systemUri+'.filter', 'TYPE:equals')); end; -function TLOINCServices.Definition(context: TCodeSystemProviderContext): string; +function TLOINCServices.Definition(opContext : TTxOperationContext; context: TCodeSystemProviderContext): string; begin result := ''; end; -function TLOINCServices.isNotClosed(textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; +function TLOINCServices.isNotClosed(opContext : TTxOperationContext; textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; begin result := false; end; @@ -502,7 +502,7 @@ class function TLOINCServices.checkFile(const sFilename: String): String; end; end; -function TLOINCServices.searchFilter(filter: TSearchFilterText; prep: TCodeSystemProviderFilterPreparationContext; sort: boolean): TCodeSystemProviderFilterContext; +function TLOINCServices.searchFilter(opContext : TTxOperationContext; filter: TSearchFilterText; prep: TCodeSystemProviderFilterPreparationContext; sort: boolean): TCodeSystemProviderFilterContext; begin raise Exception.create('Not done yet'); end; @@ -512,7 +512,7 @@ function TLOINCServices.sizeInBytesV(magic : integer) : cardinal; result := inherited sizeInBytesV(magic); end; -procedure TLOINCServices.getCDSInfo(card: TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display: String); +procedure TLOINCServices.getCDSInfo(opContext : TTxOperationContext; card: TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display: String); begin //b := TFslStringBuilder.Create; //try @@ -714,7 +714,7 @@ function TLOINCServices.buildValueSet(factory : TFHIRFactory; id: String): TFhir end; end; -function TLOINCServices.getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; +function TLOINCServices.getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; var ctxt : TLoincProviderContext; c : TFDBConnection; @@ -740,7 +740,7 @@ function TLOINCServices.getIterator(context : TCodeSystemProviderContext) : TCod end; -function TLOINCServices.getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; +function TLOINCServices.getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; var ctxt : TLoincIteratorContext; i, k : integer; @@ -757,12 +757,12 @@ function TLOINCServices.getNextContext(context : TCodeSystemIteratorContext) : T context.next; end; -function TLOINCServices.Code(context: TCodeSystemProviderContext): string; +function TLOINCServices.Code(opContext : TTxOperationContext; context: TCodeSystemProviderContext): string; begin result := (context as TLoincProviderContext).code; end; -function TLOINCServices.Display(context: TCodeSystemProviderContext; langList : THTTPLanguageList): string; +function TLOINCServices.Display(opContext : TTxOperationContext; context: TCodeSystemProviderContext; langList : THTTPLanguageList): string; var displays : TFslList; c : TFDBConnection; @@ -808,7 +808,7 @@ function TLOINCServices.Display(context: TCodeSystemProviderContext; langList : end; end; -procedure TLOINCServices.Designations(context: TCodeSystemProviderContext; list: TConceptDesignations); +procedure TLOINCServices.Designations(opContext : TTxOperationContext; context: TCodeSystemProviderContext; list: TConceptDesignations); var c : TFDBConnection; ctxt : TLoincProviderContext; @@ -867,7 +867,7 @@ procedure TLOINCServices.Designations(context: TCodeSystemProviderContext; list: end; end; -function TLOINCServices.doesFilter(prop: String; op: TFhirFilterOperator; value: String): boolean; +function TLOINCServices.doesFilter(opContext : TTxOperationContext; prop: String; op: TFhirFilterOperator; value: String): boolean; var ts : TStringList; reg : TRegularExpression; @@ -905,12 +905,12 @@ function TLOINCServices.doesFilter(prop: String; op: TFhirFilterOperator; value: result := false; end; -function TLOINCServices.getPrepContext: TCodeSystemProviderFilterPreparationContext; +function TLOINCServices.getPrepContext(opContext : TTxOperationContext): TCodeSystemProviderFilterPreparationContext; begin result := TLOINCPrep.Create; end; -procedure TLOINCServices.extendLookup(factory : TFHIRFactory; ctxt: TCodeSystemProviderContext; langList : THTTPLanguageList; props: TArray; resp: TFHIRLookupOpResponseW); +procedure TLOINCServices.extendLookup(opContext : TTxOperationContext; factory : TFHIRFactory; ctxt: TCodeSystemProviderContext; langList : THTTPLanguageList; props: TArray; resp: TFHIRLookupOpResponseW); var c : TFDBConnection; begin @@ -966,12 +966,12 @@ procedure TLOINCServices.extendLookup(factory : TFHIRFactory; ctxt: TCodeSystemP end; -function TLOINCServices.getDefinition(code: String): String; +function TLOINCServices.getDefinition(opContext : TTxOperationContext; code: String): String; begin result := ''; end; -function TLOINCServices.getDisplay(code: String; langList : THTTPLanguageList): String; +function TLOINCServices.getDisplay(opContext : TTxOperationContext; code: String; langList : THTTPLanguageList): String; var ctxt : TLoincProviderContext; begin @@ -979,22 +979,22 @@ function TLOINCServices.getDisplay(code: String; langList : THTTPLanguageList): if (ctxt = nil) then result := '' else - result := Display(ctxt, langList); + result := Display(opContext, ctxt, langList); end; -function TLOINCServices.IsAbstract(context: TCodeSystemProviderContext): boolean; +function TLOINCServices.IsAbstract(opContext : TTxOperationContext; context: TCodeSystemProviderContext): boolean; begin result := false; // loinc don't do abstract end; -function TLOINCServices.locate(code: String; altOpt : TAlternateCodeOptions; var message: String): TCodeSystemProviderContext; +function TLOINCServices.locate(opContext : TTxOperationContext; code: String; altOpt : TAlternateCodeOptions; var message: String): TCodeSystemProviderContext; begin result := FCodes[code].link; end; -function TLOINCServices.sameContext(a, b: TCodeSystemProviderContext): boolean; +function TLOINCServices.sameContext(opContext : TTxOperationContext; a, b: TCodeSystemProviderContext): boolean; begin - Result:=inherited sameContext(a, b); + Result:=inherited sameContext(opContext, a, b); end; function TLOINCServices.systemUri: String; @@ -1012,12 +1012,12 @@ function TLOINCServices.version: String; result := FVersion; end; -function TLOINCServices.InFilter(ctxt: TCodeSystemProviderFilterContext; concept: TCodeSystemProviderContext): Boolean; +function TLOINCServices.InFilter(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext; concept: TCodeSystemProviderContext): Boolean; begin result := (ctxt as TLoincFilterHolder).HasKey((concept as TLoincProviderContext).Key); end; -function TLOINCServices.filterBySQL(c : TFDBConnection; d, sql, lsql: String; forExpansion : boolean): TCodeSystemProviderFilterContext; +function TLOINCServices.filterBySQL(opContext : TTxOperationContext; c : TFDBConnection; d, sql, lsql: String; forExpansion : boolean): TCodeSystemProviderFilterContext; var keys : TKeyArray; l : integer; @@ -1042,6 +1042,7 @@ function TLOINCServices.filterBySQL(c : TFDBConnection; d, sql, lsql: String; fo end; c.terminate; t := GetTickCount64-t; + opContext.log('LOINC filter: '+inttostr(l)+' rows for '+d+' ('+DescribePeriodMS(t)+', sql = '+sql+')'); if (UnderDebugger) or (t > 1000) then Logging.log('LOINC filter: '+inttostr(l)+' rows for '+d+' ('+DescribePeriodMS(t)+', sql = '+sql+')'); end; @@ -1062,7 +1063,7 @@ function TLOINCServices.commaListOfCodes(source : String) : String; CommaAdd(result, ''''+sqlWrapString(s)+'''') end; -function TLOINCServices.filter(forExpansion, forIteration : boolean; prop: String; op: TFhirFilterOperator; value: String; prep: TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; +function TLOINCServices.filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop: String; op: TFhirFilterOperator; value: String; prep: TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; var c : TFDBConnection; ts : TStringList; @@ -1075,47 +1076,47 @@ function TLOINCServices.filter(forExpansion, forIteration : boolean; prop: Strin try if (FRelationships.ContainsKey(prop) and (op = foEqual)) then if FCodes.ContainsKey(value) then - result := FilterBySQL(c, d, 'select SourceKey as Key from Relationships where RelationshipTypeKey = '+FRelationships[prop]+' and TargetKey in (select CodeKey from Codes where Code = '''+sqlwrapString(value)+''') order by SourceKey ASC', + result := FilterBySQL(opContext, c, d, 'select SourceKey as Key from Relationships where RelationshipTypeKey = '+FRelationships[prop]+' and TargetKey in (select CodeKey from Codes where Code = '''+sqlwrapString(value)+''') order by SourceKey ASC', 'select count(SourceKey) from Relationships where RelationshipTypeKey = '+FRelationships[prop]+' and TargetKey in (select CodeKey from Codes where Code = '''+sqlwrapString(value)+''') and SourceKey = ', forExpansion) else - result := FilterBySQL(c, d, 'select SourceKey as Key from Relationships where RelationshipTypeKey = '+FRelationships[prop]+' and TargetKey in (select CodeKey from Codes where Description = '''+sqlwrapString(value)+''' COLLATE NOCASE) order by SourceKey ASC', + result := FilterBySQL(opContext, c, d, 'select SourceKey as Key from Relationships where RelationshipTypeKey = '+FRelationships[prop]+' and TargetKey in (select CodeKey from Codes where Description = '''+sqlwrapString(value)+''' COLLATE NOCASE) order by SourceKey ASC', 'select count(SourceKey) from Relationships where RelationshipTypeKey = '+FRelationships[prop]+' and TargetKey in (select CodeKey from Codes where Description = '''+sqlwrapString(value)+''' COLLATE NOCASE) and SourceKey = ', forExpansion) else if (FRelationships.ContainsKey(prop) and (op = foIn)) then begin s := commaListOfCodes(value); - result := FilterBySQL(c, d, 'select SourceKey as Key from Relationships where RelationshipTypeKey = '+FRelationships[prop]+' and TargetKey in (select CodeKey from Codes where Code in ('+s+')) order by SourceKey ASC', + result := FilterBySQL(opContext, c, d, 'select SourceKey as Key from Relationships where RelationshipTypeKey = '+FRelationships[prop]+' and TargetKey in (select CodeKey from Codes where Code in ('+s+')) order by SourceKey ASC', 'select count(SourceKey) from Relationships where RelationshipTypeKey = '+FRelationships[prop]+' and TargetKey in (select CodeKey from Codes where Code in ('+s+')) and SourceKey = ', forExpansion) end else if (FProperties.ContainsKey(prop) and (op = foEqual)) then - result := FilterBySQL(c, d, 'select CodeKey as Key from Properties, PropertyValues where Properties.PropertyTypeKey = '+FProperties[prop]+' and Properties.PropertyValueKey = PropertyValues.PropertyValueKey and PropertyValues.Value = '''+SQLWrapString(value)+''' COLLATE NOCASE order by CodeKey ASC', + result := FilterBySQL(opContext, c, d, 'select CodeKey as Key from Properties, PropertyValues where Properties.PropertyTypeKey = '+FProperties[prop]+' and Properties.PropertyValueKey = PropertyValues.PropertyValueKey and PropertyValues.Value = '''+SQLWrapString(value)+''' COLLATE NOCASE order by CodeKey ASC', 'select count(CodeKey) from Properties, PropertyValues where Properties.PropertyTypeKey = '+FProperties[prop]+' and Properties.PropertyValueKey = PropertyValues.PropertyValueKey and PropertyValues.Value = '''+SQLWrapString(value)+''' COLLATE NOCASE and CodeKey = ', forExpansion) else if (FProperties.ContainsKey(prop) and (op = foIn)) then begin s := commaListOfCodes(value); - result := FilterBySQL(c, d, 'select CodeKey as Key from Properties, PropertyValues where Properties.PropertyTypeKey = '+FProperties[prop]+' and Properties.PropertyValueKey = PropertyValues.PropertyValueKey and PropertyValues.Value in ('+s+') COLLATE NOCASE order by CodeKey ASC', + result := FilterBySQL(opContext, c, d, 'select CodeKey as Key from Properties, PropertyValues where Properties.PropertyTypeKey = '+FProperties[prop]+' and Properties.PropertyValueKey = PropertyValues.PropertyValueKey and PropertyValues.Value in ('+s+') COLLATE NOCASE order by CodeKey ASC', 'select count(CodeKey) from Properties, PropertyValues where Properties.PropertyTypeKey = '+FProperties[prop]+' and Properties.PropertyValueKey = PropertyValues.PropertyValueKey and PropertyValues.Value in ('+s+') COLLATE NOCASE and CodeKey = ', forExpansion) end else if (FRelationships.ContainsKey(prop) and (op = foExists)) then if FCodes.ContainsKey(value) then - result := FilterBySQL(c, d, 'select SourceKey as Key from Relationships where RelationshipTypeKey = '+FRelationships[prop]+' and exists (select CodeKey from Codes where (Code = '''+sqlwrapString(value)+''')) order by SourceKey ASC', + result := FilterBySQL(opContext, c, d, 'select SourceKey as Key from Relationships where RelationshipTypeKey = '+FRelationships[prop]+' and exists (select CodeKey from Codes where (Code = '''+sqlwrapString(value)+''')) order by SourceKey ASC', 'select count(SourceKey) from Relationships where RelationshipTypeKey = '+FRelationships[prop]+' and exists (select CodeKey from Codes where (Code = '''+sqlwrapString(value)+''')) and SourceKey = ', forExpansion) else - result := FilterBySQL(c, d, 'select SourceKey as Key from Relationships where RelationshipTypeKey = '+FRelationships[prop]+' and exists (select CodeKey from Codes where (Description = '''+sqlwrapString(value)+''' COLLATE NOCASE)) order by SourceKey ASC', + result := FilterBySQL(opContext, c, d, 'select SourceKey as Key from Relationships where RelationshipTypeKey = '+FRelationships[prop]+' and exists (select CodeKey from Codes where (Description = '''+sqlwrapString(value)+''' COLLATE NOCASE)) order by SourceKey ASC', 'select count(SourceKey) from Relationships where RelationshipTypeKey = '+FRelationships[prop]+' and exists (select CodeKey from Codes where (Description = '''+sqlwrapString(value)+''' COLLATE NOCASE)) and SourceKey = ', forExpansion) else if (FRelationships.ContainsKey(prop) and (op = foIn)) then begin s := commaListOfCodes(value); - result := FilterBySQL(c, d, 'select SourceKey as Key from Relationships where RelationshipTypeKey = '+FRelationships[prop]+' and exists (select CodeKey from Codes where (Code in ('+s+'))) order by SourceKey ASC', + result := FilterBySQL(opContext, c, d, 'select SourceKey as Key from Relationships where RelationshipTypeKey = '+FRelationships[prop]+' and exists (select CodeKey from Codes where (Code in ('+s+'))) order by SourceKey ASC', 'select count(SourceKey) from Relationships where RelationshipTypeKey = '+FRelationships[prop]+' and exists (select CodeKey from Codes where (Code in ('+sqlwrapString(value)+'))) and SourceKey = ', forExpansion) end else if (FProperties.ContainsKey(prop) and (op = foExists)) then - result := FilterBySQL(c, d, 'select distinct CodeKey as Key from Properties where Properties.PropertyTypeKey = '+FProperties[prop]+' order by CodeKey ASC', + result := FilterBySQL(opContext, c, d, 'select distinct CodeKey as Key from Properties where Properties.PropertyTypeKey = '+FProperties[prop]+' order by CodeKey ASC', 'select count(CodeKey) from Properties where Properties.PropertyTypeKey = '+FProperties[prop]+' and CodeKey = ', forExpansion) else if (prop = 'STATUS') and (op = foEqual)and (FStatusKeys.ContainsKey(value)) then - result := FilterBySQL(c, d, 'select CodeKey as Key from Codes where StatusKey = '+FStatusKeys[value]+' order by CodeKey ASC', + result := FilterBySQL(opContext, c, d, 'select CodeKey as Key from Codes where StatusKey = '+FStatusKeys[value]+' order by CodeKey ASC', 'select count(CodeKey) from Codes where StatusKey = '+FStatusKeys[value]+' and CodeKey = ', forExpansion) else if (prop = 'LIST') and (op = foEqual) and (FCodes.ContainsKey(value)) then - result := FilterBySQL(c, d, 'select TargetKey as Key from Relationships where RelationshipTypeKey = '+FRelationships['Answer']+' and SourceKey in (select CodeKey from Codes where (Code = '''+sqlwrapString(value)+''')) order by SourceKey ASC', + result := FilterBySQL(opContext, c, d, 'select TargetKey as Key from Relationships where RelationshipTypeKey = '+FRelationships['Answer']+' and SourceKey in (select CodeKey from Codes where (Code = '''+sqlwrapString(value)+''')) order by SourceKey ASC', 'select count(TargetKey) from Relationships where RelationshipTypeKey = '+FRelationships['Answer']+' and SourceKey in (select CodeKey from Codes where (Code = '''+sqlwrapString(value)+''')) and TargetKey = ', forExpansion) else if (FRelationships.ContainsKey(prop)) and (op = foRegex) then begin @@ -1128,7 +1129,7 @@ function TLOINCServices.filter(forExpansion, forIteration : boolean; prop: Strin if reg.IsMatch(c.ColStringByName['Description']) then ts.add(c.ColStringByName['Key']); c.terminate; - result := FilterBySQL(c, d, 'select SourceKey as Key from Relationships where RelationshipTypeKey = '+FRelationships[prop]+' and TargetKey in ('+ts.CommaText+') order by SourceKey ASC', + result := FilterBySQL(opContext, c, d, 'select SourceKey as Key from Relationships where RelationshipTypeKey = '+FRelationships[prop]+' and TargetKey in ('+ts.CommaText+') order by SourceKey ASC', 'select count(SourceKey) from Relationships where RelationshipTypeKey = '+FRelationships[prop]+' and TargetKey in ('+ts.CommaText+') and SourceKey = ', forExpansion) finally ts.free; @@ -1148,7 +1149,7 @@ function TLOINCServices.filter(forExpansion, forIteration : boolean; prop: Strin if reg.IsMatch(c.ColStringByName['Value']) then ts.add(c.ColStringByName['PropertyValueKey']); c.terminate; - result := FilterBySQL(c, d, 'select CodeKey as Key from Properties where PropertyTypeKey = '+FProperties[prop]+' and PropertyValueKey in ('+ts.CommaText+') order by CodeKey ASC', + result := FilterBySQL(opContext, c, d, 'select CodeKey as Key from Properties where PropertyTypeKey = '+FProperties[prop]+' and PropertyValueKey in ('+ts.CommaText+') order by CodeKey ASC', 'select count(CodeKey) from Properties where PropertyTypeKey = '+FProperties[prop]+' and PropertyValueKey in ('+ts.CommaText+') and CodeKey = ', forExpansion) finally ts.free; @@ -1158,22 +1159,22 @@ function TLOINCServices.filter(forExpansion, forIteration : boolean; prop: Strin end; end else if (prop = 'concept') and (op in [foIsA, foDescendentOf]) then - result := FilterBySQL(c, d, 'select DescendentKey as Key from Closure where AncestorKey in (select CodeKey from Codes where Code = '''+sqlwrapString(value)+''') order by DescendentKey ASC', + result := FilterBySQL(opContext, c, d, 'select DescendentKey as Key from Closure where AncestorKey in (select CodeKey from Codes where Code = '''+sqlwrapString(value)+''') order by DescendentKey ASC', 'select count(DescendentKey) from Closure where AncestorKey in (select CodeKey from Codes where Code = '''+sqlwrapString(value)+''') and DescendentKey = ', forExpansion) else if (prop = 'concept') and (op in [foEqual]) then // work around for misuse in VSAC - result := FilterBySQL(c, d, 'select CodeKey as Key from Codes where Code = '''+sqlwrapString(value)+''' order by CodeKey ASC', + result := FilterBySQL(opContext, c, d, 'select CodeKey as Key from Codes where Code = '''+sqlwrapString(value)+''' order by CodeKey ASC', 'select count(CodeKey) from Codes where Code = '''+sqlwrapString(value)+''' and CodeKey = ''', forExpansion) else if (prop = 'concept') and (op in [foIn]) then // work around for misuse in VSAC begin s := commaListOfCodes(value); - result := FilterBySQL(c, d, 'select CodeKey as Key from Codes where Code in ('+s+') order by CodeKey ASC', + result := FilterBySQL(opContext, c, d, 'select CodeKey as Key from Codes where Code in ('+s+') order by CodeKey ASC', 'select count(CodeKey) from Codes where Code in ('+s+') and CodeKey = ''', forExpansion) end else if (prop = 'copyright') and (op = foEqual) and (value = 'LOINC') then - result := FilterBySQL(c, d, 'select CodeKey as Key from Codes where not CodeKey in (select CodeKey from Properties where PropertyTypeKey = 9) order by CodeKey ASC', + result := FilterBySQL(opContext, c, d, 'select CodeKey as Key from Codes where not CodeKey in (select CodeKey from Properties where PropertyTypeKey = 9) order by CodeKey ASC', 'select count(CodeKey) from Codes where not CodeKey in (select CodeKey from Properties where PropertyTypeKey = 9) and CodeKey = ', forExpansion) else if (prop = 'copyright') and (op = foEqual) and (value = '3rdParty') then - result := FilterBySQL(c, d, 'select CodeKey as Key from Codes where CodeKey in (select CodeKey from Properties where PropertyTypeKey = 9) order by CodeKey ASC', + result := FilterBySQL(opContext, c, d, 'select CodeKey as Key from Codes where CodeKey in (select CodeKey from Properties where PropertyTypeKey = 9) order by CodeKey ASC', 'select count(CodeKey) from Codes where CodeKey in (select CodeKey from Properties where PropertyTypeKey = 9) and CodeKey = ', forExpansion) else result := nil; @@ -1188,7 +1189,7 @@ function TLOINCServices.filter(forExpansion, forIteration : boolean; prop: Strin end; end; -function TLOINCServices.FilterConcept(ctxt: TCodeSystemProviderFilterContext): TCodeSystemProviderContext; +function TLOINCServices.FilterConcept(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): TCodeSystemProviderContext; var ndx : integer; context : TLoincFilterHolder; @@ -1198,7 +1199,7 @@ function TLOINCServices.FilterConcept(ctxt: TCodeSystemProviderFilterContext): T result := FCodeList[ndx].link; end; -function TLOINCServices.FilterMore(ctxt: TCodeSystemProviderFilterContext): boolean; +function TLOINCServices.FilterMore(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): boolean; var context : TLoincFilterHolder; begin @@ -1207,7 +1208,7 @@ function TLOINCServices.FilterMore(ctxt: TCodeSystemProviderFilterContext): bool result := context.FCursor <= Length(context.FKeys); end; -function TLOINCServices.filterSize(ctxt: TCodeSystemProviderFilterContext): integer; +function TLOINCServices.filterSize(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): integer; var context : TLoincFilterHolder; begin @@ -1215,7 +1216,7 @@ function TLOINCServices.filterSize(ctxt: TCodeSystemProviderFilterContext): inte result := Length(context.FKeys); end; -function TLOINCServices.locateIsA(code, parent: String; disallowParent : boolean = false): TCodeSystemProviderContext; +function TLOINCServices.locateIsA(opContext : TTxOperationContext; code, parent: String; disallowParent : boolean = false): TCodeSystemProviderContext; begin result := nil; // cause loinc don't do subsumption end; @@ -1225,7 +1226,7 @@ function TLOINCServices.name(context: TCodeSystemProviderContext): String; result := 'LOINC'; end; -function TLOINCServices.filterLocate(ctxt: TCodeSystemProviderFilterContext; code: String; var message: String): TCodeSystemProviderContext; +function TLOINCServices.filterLocate(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext; code: String; var message: String): TCodeSystemProviderContext; var ci : TLoincProviderContext; fi : TLoincFilterHolder; diff --git a/library/ftx/ftx_sct_analysis.pas b/library/ftx/ftx_sct_analysis.pas index d5e08811b..060b6981d 100644 --- a/library/ftx/ftx_sct_analysis.pas +++ b/library/ftx/ftx_sct_analysis.pas @@ -186,7 +186,7 @@ procedure TSnomedAnalysis.assess(b: TFslStringBuilder; id: String); b.Append('">'); b.Append(id); b.Append(' '); - b.Append(FormatTextToXML(FSnomed.getDisplay(id, nil), xmlText)); + b.Append(FormatTextToXML(FSnomed.getDisplay(nil, id, nil), xmlText)); b.append('.'); b.Append(inttostr(length(alldesc))); b.AppendLine(' rows'); diff --git a/library/ftx/ftx_sct_services.pas b/library/ftx/ftx_sct_services.pas index a0a099fb0..9f1ffa915 100644 --- a/library/ftx/ftx_sct_services.pas +++ b/library/ftx/ftx_sct_services.pas @@ -724,38 +724,38 @@ TSnomedProvider = class (TCodeSystemProvider) function description : String; override; function TotalCount : integer; override; - function getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; - function getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; + function getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; + function getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; function systemUri : String; override; function version : String; override; function name(context : TCodeSystemProviderContext) : String; override; - function getDisplay(code : String; langList : THTTPLanguageList):String; override; - function locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; - function sameContext(a, b : TCodeSystemProviderContext) : boolean; override; - function IsAbstract(context : TCodeSystemProviderContext) : boolean; override; - function Code(context : TCodeSystemProviderContext) : string; override; - function Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; - procedure Designations(context : TCodeSystemProviderContext; list : TConceptDesignations); override; - function filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; - function FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; override; - function filterSize(ctxt : TCodeSystemProviderFilterContext) : integer; override; - function FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; - function locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; - function filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; - function InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; - function searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; overload; override; - function getDefinition(code : String):String; override; - function Definition(context : TCodeSystemProviderContext) : string; override; - function isNotClosed(textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; - procedure extendLookup(factory : TFHIRFactory; ctxt : TCodeSystemProviderContext; langList : THTTPLanguageList; props : TArray; resp : TFHIRLookupOpResponseW); override; - function subsumesTest(codeA, codeB : String) : String; overload; override; - procedure getCDSInfo(card : TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display : String); override; - function IsInactive(context : TCodeSystemProviderContext) : boolean; override; - function getCodeStatus(context : TCodeSystemProviderContext) : String; override; + function getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; override; + function locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; + function sameContext(opContext : TTxOperationContext; a, b : TCodeSystemProviderContext) : boolean; override; + function IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; override; + function Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + function Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; + procedure Designations(opContext : TTxOperationContext; context : TCodeSystemProviderContext; list : TConceptDesignations); override; + function filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; + function FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; override; + function filterSize(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : integer; override; + function FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; + function locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; + function filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; + function InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; + function searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; overload; override; + function getDefinition(opContext : TTxOperationContext; code : String):String; override; + function Definition(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + function isNotClosed(opContext : TTxOperationContext; textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; + procedure extendLookup(opContext : TTxOperationContext; factory : TFHIRFactory; ctxt : TCodeSystemProviderContext; langList : THTTPLanguageList; props : TArray; resp : TFHIRLookupOpResponseW); override; + function subsumesTest(opContext : TTxOperationContext; codeA, codeB : String) : String; overload; override; + procedure getCDSInfo(opContext : TTxOperationContext; card : TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display : String); override; + function IsInactive(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; override; + function getCodeStatus(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : String; override; function incompleteValidationMessage(context : TCodeSystemProviderContext; langs : THTTPLanguageList) : String; override; function defToThisVersion(specifiedVersion : String) : boolean; override; - procedure defineFeatures(features : TFslList); override; + procedure defineFeatures(opContext : TTxOperationContext; features : TFslList); override; function versionIsMoreDetailed(v1, v2 : String): boolean; override; property Services : TSnomedServices read FSct; @@ -4741,7 +4741,7 @@ function TSnomedProvider.description: String; result := 'SNOMED CT '+FSCt.EditionName; end; -procedure TSnomedProvider.defineFeatures(features: TFslList); +procedure TSnomedProvider.defineFeatures(opContext : TTxOperationContext; features: TFslList); begin features.Add(TFHIRFeature.fromString('rest.Codesystem:'+systemUri+'.filter', 'concept:is-a')); features.Add(TFHIRFeature.fromString('rest.Codesystem:'+systemUri+'.filter', 'concept:descends')); @@ -4753,12 +4753,12 @@ function TSnomedProvider.versionIsMoreDetailed(v1, v2: String): boolean; result := (v2 <> '') and v2.startsWith(v1); end; -function TSnomedProvider.Definition(context: TCodeSystemProviderContext): string; +function TSnomedProvider.Definition(opContext : TTxOperationContext; context: TCodeSystemProviderContext): string; begin result := ''; end; -function TSnomedProvider.getDefinition(code: String): String; +function TSnomedProvider.getDefinition(opContext : TTxOperationContext; code: String): String; begin result := ''; end; @@ -4777,7 +4777,7 @@ function TSnomedProvider.defToThisVersion(specifiedVersion: String): boolean; result := sv[1] < tv[1]; end; -function TSnomedProvider.searchFilter(filter: TSearchFilterText; prep: TCodeSystemProviderFilterPreparationContext; sort: boolean): TCodeSystemProviderFilterContext; +function TSnomedProvider.searchFilter(opContext : TTxOperationContext; filter: TSearchFilterText; prep: TCodeSystemProviderFilterPreparationContext; sort: boolean): TCodeSystemProviderFilterContext; var res : TSnomedFilterContext; begin @@ -4790,7 +4790,7 @@ function TSnomedProvider.searchFilter(filter: TSearchFilterText; prep: TCodeSyst end; end; -procedure TSnomedProvider.getCDSInfo(card: TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display: String); +procedure TSnomedProvider.getCDSInfo(opContext : TTxOperationContext; card: TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display: String); var b : TFslStringBuilder; Identity : UInt64; @@ -4881,7 +4881,7 @@ procedure TSnomedProvider.getCDSInfo(card: TCDSHookCard; langList : THTTPLanguag end; end; -function TSnomedProvider.subsumesTest(codeA, codeB: String): String; +function TSnomedProvider.subsumesTest(opContext : TTxOperationContext; codeA, codeB: String): String; var exprA, exprB : TSnomedExpression; b1, b2 : boolean; @@ -4922,7 +4922,7 @@ function TSnomedProvider.subsumesTest(codeA, codeB: String): String; end; end; -function TSnomedProvider.getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; +function TSnomedProvider.getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; var i : integer; Identity : UInt64; @@ -4959,7 +4959,7 @@ function TSnomedProvider.getIterator(context : TCodeSystemProviderContext) : TCo result := TCodeSystemIteratorContext.Create(context.Link, ndx); end; -function TSnomedProvider.Code(context: TCodeSystemProviderContext): string; +function TSnomedProvider.Code(opContext : TTxOperationContext; context: TCodeSystemProviderContext): string; var Identity : UInt64; Flags : Byte; @@ -4980,7 +4980,7 @@ function TSnomedProvider.Code(context: TCodeSystemProviderContext): string; end; end; -function TSnomedProvider.getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; +function TSnomedProvider.getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; var i, c : integer; Identity : UInt64; @@ -5026,7 +5026,7 @@ function TSnomedProvider.getNextContext(context : TCodeSystemIteratorContext) : end; end; -function TSnomedProvider.Display(context: TCodeSystemProviderContext; langList : THTTPLanguageList): string; +function TSnomedProvider.Display(opContext : TTxOperationContext; context: TCodeSystemProviderContext; langList : THTTPLanguageList): string; var Identity : UInt64; Flags : Byte; @@ -5049,7 +5049,7 @@ function TSnomedProvider.Display(context: TCodeSystemProviderContext; langList : end; end; -procedure TSnomedProvider.Designations(context: TCodeSystemProviderContext; list: TConceptDesignations); +procedure TSnomedProvider.Designations(opContext : TTxOperationContext; context: TCodeSystemProviderContext; list: TConceptDesignations); var ctxt : TSnomedExpressionContext; begin @@ -5063,7 +5063,7 @@ procedure TSnomedProvider.Designations(context: TCodeSystemProviderContext; list FSct.ListDisplayNames(list, TSnomedExpressionContext(ctxt).reference, 0, $FF); end; -procedure TSnomedProvider.extendLookup(factory : TFHIRFactory; ctxt: TCodeSystemProviderContext; langList : THTTPLanguageList; props : TArray; resp : TFHIRLookupOpResponseW); +procedure TSnomedProvider.extendLookup(opContext : TTxOperationContext; factory : TFHIRFactory; ctxt: TCodeSystemProviderContext; langList : THTTPLanguageList; props : TArray; resp : TFHIRLookupOpResponseW); var Identity : UInt64; Flags, bLang : Byte; @@ -5172,27 +5172,27 @@ procedure TSnomedProvider.extendLookup(factory : TFHIRFactory; ctxt: TCodeSystem end; end; -function TSnomedProvider.getDisplay(code: String; langList : THTTPLanguageList): String; +function TSnomedProvider.getDisplay(opContext : TTxOperationContext; code: String; langList : THTTPLanguageList): String; var ctxt : TCodeSystemProviderContext; begin - ctxt := locate(code); + ctxt := locate(opContext, code); try if (ctxt = nil) then raise ETerminologyError.create('Unable to find '+code+' in '+systemUri, itInvalid) else - result := Display(ctxt, langList); + result := Display(opContext, ctxt, langList); finally ctxt.free; end; end; -function TSnomedProvider.IsAbstract(context: TCodeSystemProviderContext): boolean; +function TSnomedProvider.IsAbstract(opContext : TTxOperationContext; context: TCodeSystemProviderContext): boolean; begin result := false; // snomed don't do abstract? end; -function TSnomedProvider.IsInactive(context: TCodeSystemProviderContext): boolean; +function TSnomedProvider.IsInactive(opContext : TTxOperationContext; context: TCodeSystemProviderContext): boolean; begin if TSnomedExpressionContext(context).isComplex then result := false // not sure what to do here? @@ -5200,7 +5200,7 @@ function TSnomedProvider.IsInactive(context: TCodeSystemProviderContext): boolea result := not FSct.IsActive(TSnomedExpressionContext(context).reference); end; -function TSnomedProvider.getCodeStatus(context: TCodeSystemProviderContext): String; +function TSnomedProvider.getCodeStatus(opContext : TTxOperationContext; context: TCodeSystemProviderContext): String; begin if TSnomedExpressionContext(context).isComplex then result := '' @@ -5218,12 +5218,12 @@ function TSnomedProvider.incompleteValidationMessage(context : TCodeSystemProvid result := ''; end; -function TSnomedProvider.isNotClosed(textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; +function TSnomedProvider.isNotClosed(opContext : TTxOperationContext; textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; begin result := true; end; -function TSnomedProvider.locate(code: String; altOpt : TAlternateCodeOptions; var message : String): TCodeSystemProviderContext; +function TSnomedProvider.locate(opContext : TTxOperationContext; code: String; altOpt : TAlternateCodeOptions; var message : String): TCodeSystemProviderContext; var iId : UInt64; index : cardinal; @@ -5265,7 +5265,7 @@ function TSnomedProvider.version: String; result := FSct.FVersionUri; end; -function TSnomedProvider.filter(forExpansion, forIteration : boolean; prop: String; op: TFhirFilterOperator; value: String; prep : TCodeSystemProviderFilterPreparationContext): TCodeSystemProviderFilterContext; +function TSnomedProvider.filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop: String; op: TFhirFilterOperator; value: String; prep : TCodeSystemProviderFilterPreparationContext): TCodeSystemProviderFilterContext; var id : UInt64; begin @@ -5281,7 +5281,7 @@ function TSnomedProvider.filter(forExpansion, forIteration : boolean; prop: Stri result := FSct.filterEquals(id) end; -function TSnomedProvider.FilterConcept(ctxt: TCodeSystemProviderFilterContext): TCodeSystemProviderContext; +function TSnomedProvider.FilterConcept(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): TCodeSystemProviderContext; begin if Length(TSnomedFilterContext(ctxt).matches) > 0 then result := TSnomedExpressionContext.create(TSnomedFilterContext(ctxt).Matches[TSnomedFilterContext(ctxt).ndx-1].index) @@ -5291,7 +5291,7 @@ function TSnomedProvider.FilterConcept(ctxt: TCodeSystemProviderFilterContext): result := TSnomedExpressionContext.create(TSnomedFilterContext(ctxt).descendants[TSnomedFilterContext(ctxt).ndx-1]); end; -function TSnomedProvider.InFilter(ctxt: TCodeSystemProviderFilterContext; concept: TCodeSystemProviderContext): Boolean; +function TSnomedProvider.InFilter(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext; concept: TCodeSystemProviderContext): Boolean; var index : integer; begin @@ -5301,7 +5301,7 @@ function TSnomedProvider.InFilter(ctxt: TCodeSystemProviderFilterContext; concep result := FindCardinalInArray(TSnomedFilterContext(ctxt).descendants, TSnomedExpressionContext(concept).reference, index) end; -function TSnomedProvider.FilterMore(ctxt: TCodeSystemProviderFilterContext): boolean; +function TSnomedProvider.FilterMore(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): boolean; begin inc(TSnomedFilterContext(ctxt).ndx); if Length(TSnomedFilterContext(ctxt).matches) > 0 then @@ -5312,7 +5312,7 @@ function TSnomedProvider.FilterMore(ctxt: TCodeSystemProviderFilterContext): boo result := TSnomedFilterContext(ctxt).ndx <= Length(TSnomedFilterContext(ctxt).descendants); end; -function TSnomedProvider.filterSize(ctxt: TCodeSystemProviderFilterContext): integer; +function TSnomedProvider.filterSize(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): integer; begin if Length(TSnomedFilterContext(ctxt).matches) > 0 then result := Length(TSnomedFilterContext(ctxt).matches) @@ -5322,7 +5322,7 @@ function TSnomedProvider.filterSize(ctxt: TCodeSystemProviderFilterContext): int result := Length(TSnomedFilterContext(ctxt).descendants); end; -function TSnomedProvider.filterLocate(ctxt: TCodeSystemProviderFilterContext; code: String; var message : String): TCodeSystemProviderContext; +function TSnomedProvider.filterLocate(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext; code: String; var message : String): TCodeSystemProviderContext; var c : TSnomedFilterContext; index : integer; @@ -5330,7 +5330,7 @@ function TSnomedProvider.filterLocate(ctxt: TCodeSystemProviderFilterContext; co ok : boolean; begin c := TSnomedFilterContext(ctxt); - concept := locate(code, nil, message); + concept := locate(opContext, code, nil, message); try message := ''; if concept = nil then @@ -5348,7 +5348,7 @@ function TSnomedProvider.filterLocate(ctxt: TCodeSystemProviderFilterContext; co end; end; -function TSnomedProvider.locateIsA(code, parent: String; disallowParent : boolean = false): TCodeSystemProviderContext; +function TSnomedProvider.locateIsA(opContext : TTxOperationContext; code, parent: String; disallowParent : boolean = false): TCodeSystemProviderContext; var ic, ip : Cardinal; begin @@ -5365,7 +5365,7 @@ function TSnomedProvider.name(context: TCodeSystemProviderContext): String; result := 'SNOMED CT'; end; -function TSnomedProvider.sameContext(a, b: TCodeSystemProviderContext): boolean; +function TSnomedProvider.sameContext(opContext : TTxOperationContext; a, b: TCodeSystemProviderContext): boolean; begin result := (a is TSnomedExpressionContext) and (b is TSnomedExpressionContext) and ((a as TSnomedExpressionContext).FSource = (b as TSnomedExpressionContext).FSource); end; diff --git a/library/ftx/ftx_service.pas b/library/ftx/ftx_service.pas index 092087065..3d1961e4a 100644 --- a/library/ftx/ftx_service.pas +++ b/library/ftx/ftx_service.pas @@ -64,6 +64,11 @@ ETerminologyError = class (EFslException) // problem in terminology operation TFhirFilterOperator = fhir_common.TFilterOperator; + TTxOperationContext = class abstract (TFslObject) + public + procedure log(note : String); virtual; abstract; + end; + TCodeSystemProviderContext = class (TFslObject) public function Link : TCodeSystemProviderContext; overload; @@ -247,60 +252,60 @@ TCodeSystemProvider = class abstract (TFslObject) function sourcePackage : String; virtual; function TotalCount : integer; virtual; abstract; function getPropertyDefinitions : TFslList; virtual; - function getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; virtual; abstract; - function getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; virtual; abstract; + function getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; virtual; abstract; + function getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; virtual; abstract; function systemUri() : String; virtual; abstract; function version() : String; virtual; function defLang() : TIETFLang; virtual; function hasAnyDisplays(disp : THTTPLanguageList) : boolean; virtual; function name(context : TCodeSystemProviderContext) : String; virtual; - function getDisplay(code : String; langList : THTTPLanguageList):String; virtual; abstract; - function getDefinition(code : String):String; virtual; abstract; - function locate(code : String; altOpt : TAlternateCodeOptions= nil) : TCodeSystemProviderContext; overload; virtual; - function locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; overload; virtual; abstract; - function sameContext(a, b : TCodeSystemProviderContext) : boolean; virtual; - function locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; virtual; abstract; - function IsAbstract(context : TCodeSystemProviderContext) : boolean; virtual; abstract; - function IsInactive(context : TCodeSystemProviderContext) : boolean; overload; virtual; - function getCodeStatus(context : TCodeSystemProviderContext) : String; overload; virtual; - function deprecated(context : TCodeSystemProviderContext) : boolean; overload; virtual; - function IsInactive(code : String) : boolean; overload; virtual; - function Code(context : TCodeSystemProviderContext) : string; virtual; abstract; - function Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; overload; virtual; abstract; - function Display(context : TCodeSystemProviderContext; lang : TFslList) : string; overload; - function Definition(context : TCodeSystemProviderContext) : string; virtual; abstract; - function itemWeight(context : TCodeSystemProviderContext) : string; virtual; - procedure Designations(context : TCodeSystemProviderContext; list : TConceptDesignations); overload; virtual; abstract; // get all displays for all languages - function getExtensions(context : TCodeSystemProviderContext) : TFslList; virtual; - function getProperties(context : TCodeSystemProviderContext) : TFslList; virtual; - function listCodes(ctxt : TCodeSystemProviderContext; altOpt : TAlternateCodeOptions) : TStringArray; virtual; - function parent(context : TCodeSystemProviderContext) : String; virtual; // return if there is one and only one + function getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; virtual; abstract; + function getDefinition(opContext : TTxOperationContext; code : String):String; virtual; abstract; + function locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions= nil) : TCodeSystemProviderContext; overload; virtual; + function locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; overload; virtual; abstract; + function sameContext(opContext : TTxOperationContext; a, b : TCodeSystemProviderContext) : boolean; virtual; + function locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; virtual; abstract; + function IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; virtual; abstract; + function IsInactive(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; overload; virtual; + function getCodeStatus(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : String; overload; virtual; + function deprecated(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; overload; virtual; + function IsInactive(opContext : TTxOperationContext; code : String) : boolean; overload; virtual; + function Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; virtual; abstract; + function Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; overload; virtual; abstract; + function Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; lang : TFslList) : string; overload; + function Definition(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; virtual; abstract; + function itemWeight(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; virtual; + procedure Designations(opContext : TTxOperationContext; context : TCodeSystemProviderContext; list : TConceptDesignations); overload; virtual; abstract; // get all displays for all languages + function getExtensions(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TFslList; virtual; + function getProperties(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TFslList; virtual; + function listCodes(opContext : TTxOperationContext; ctxt : TCodeSystemProviderContext; altOpt : TAlternateCodeOptions) : TStringArray; virtual; + function parent(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : String; virtual; // return if there is one and only one function canParent : boolean; virtual; - function doesFilter(prop : String; op : TFhirFilterOperator; value : String) : boolean; virtual; + function doesFilter(opContext : TTxOperationContext; prop : String; op : TFhirFilterOperator; value : String) : boolean; virtual; function incompleteValidationMessage(context : TCodeSystemProviderContext; langs : THTTPLanguageList) : String; virtual; - function hasSupplement(url : String) : boolean; virtual; - procedure listSupplements(ts : TStringList); virtual; - function getPrepContext : TCodeSystemProviderFilterPreparationContext; virtual; - function searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; virtual; abstract; - function specialFilter(prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; virtual; - function filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; virtual; abstract; - function prepare(prep : TCodeSystemProviderFilterPreparationContext) : boolean; virtual; // true if the underlying provider collapsed multiple filters - function filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; overload; virtual; abstract; - function filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String) : TCodeSystemProviderContext; overload; virtual; - function FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; virtual; abstract; - function filterSize(ctxt : TCodeSystemProviderFilterContext) : integer; overload; virtual; abstract; - function FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; virtual; abstract; - function InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; virtual; abstract; - function isNotClosed(textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; virtual; abstract; - procedure extendLookup(factory : TFHIRFactory; ctxt : TCodeSystemProviderContext; langList : THTTPLanguageList; props : TArray; resp : TFHIRLookupOpResponseW); virtual; - function subsumesTest(codeA, codeB : String) : String; virtual; + function hasSupplement(opContext : TTxOperationContext; url : String) : boolean; virtual; + procedure listSupplements(opContext : TTxOperationContext; ts : TStringList); virtual; + function getPrepContext(opContext : TTxOperationContext) : TCodeSystemProviderFilterPreparationContext; virtual; + function searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; virtual; abstract; + function specialFilter(opContext : TTxOperationContext; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; virtual; + function filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; virtual; abstract; + function prepare(opContext : TTxOperationContext; prep : TCodeSystemProviderFilterPreparationContext) : boolean; virtual; // true if the underlying provider collapsed multiple filters + function filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; overload; virtual; abstract; + function filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String) : TCodeSystemProviderContext; overload; virtual; + function FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; virtual; abstract; + function filterSize(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : integer; overload; virtual; abstract; + function FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; virtual; abstract; + function InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; virtual; abstract; + function isNotClosed(opContext : TTxOperationContext; textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; virtual; abstract; + procedure extendLookup(opContext : TTxOperationContext; factory : TFHIRFactory; ctxt : TCodeSystemProviderContext; langList : THTTPLanguageList; props : TArray; resp : TFHIRLookupOpResponseW); virtual; + function subsumesTest(opContext : TTxOperationContext; codeA, codeB : String) : String; virtual; function SpecialEnumeration : String; virtual; - procedure defineFeatures(features : TFslList); virtual; abstract; + procedure defineFeatures(opContext : TTxOperationContext; features : TFslList); virtual; abstract; function versionIsMoreDetailed(v1, v2 : String): boolean; virtual; procedure getStatus(out status: TPublicationStatus; out standardsStatus: String; out experimental : boolean); virtual; - procedure getCDSInfo(card : TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display : String); virtual; + procedure getCDSInfo(opContext : TTxOperationContext; card : TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display : String); virtual; procedure RecordUse(count : integer = 1); procedure checkReady; virtual; @@ -310,6 +315,7 @@ TCodeSystemProvider = class abstract (TFslObject) const CODES_TDisplayCheckingStyle : Array [TDisplayCheckingStyle] of String = ('Exact', 'CaseInsensitive', 'Normalised'); + implementation { TAlternateCodeOptions } @@ -916,12 +922,12 @@ destructor TCodeSystemProvider.Destroy; inherited; end; -function TCodeSystemProvider.doesFilter(prop: String; op: TFhirFilterOperator; value: String): boolean; +function TCodeSystemProvider.doesFilter(opContext : TTxOperationContext; prop: String; op: TFhirFilterOperator; value: String): boolean; var ctxt : TCodeSystemProviderFilterContext; begin result := false; - ctxt := filter(false, true, prop, op, value, nil); + ctxt := filter(opContext, false, true, prop, op, value, nil); try result := ctxt <> nil; finally @@ -934,51 +940,51 @@ function TCodeSystemProvider.incompleteValidationMessage(context: TCodeSystemPro result := ''; end; -procedure TCodeSystemProvider.extendLookup(factory : TFHIRFactory; ctxt: TCodeSystemProviderContext; langList : THTTPLanguageList; props : TArray; resp : TFHIRLookupOpResponseW); +procedure TCodeSystemProvider.extendLookup(opContext : TTxOperationContext; factory : TFHIRFactory; ctxt: TCodeSystemProviderContext; langList : THTTPLanguageList; props : TArray; resp : TFHIRLookupOpResponseW); begin // nothing here end; -function TCodeSystemProvider.filterLocate(ctxt: TCodeSystemProviderFilterContext; code: String): TCodeSystemProviderContext; +function TCodeSystemProvider.filterLocate(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext; code: String): TCodeSystemProviderContext; var msg : String; begin - result := filterLocate(ctxt, code, msg); + result := filterLocate(opContext, ctxt, code, msg); end; -procedure TCodeSystemProvider.getCDSInfo(card: TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display: String); +procedure TCodeSystemProvider.getCDSInfo(opContext : TTxOperationContext; card: TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display: String); begin card.summary := 'No CDSHook Implementation for code system '+systemUri+' for code '+code+' ('+display+')'; end; -function TCodeSystemProvider.getPrepContext: TCodeSystemProviderFilterPreparationContext; +function TCodeSystemProvider.getPrepContext(opContext : TTxOperationContext): TCodeSystemProviderFilterPreparationContext; begin result := nil; end; -function TCodeSystemProvider.hasSupplement(url: String): boolean; +function TCodeSystemProvider.hasSupplement(opContext : TTxOperationContext; url: String): boolean; begin result := false; end; -procedure TCodeSystemProvider.listSupplements(ts: TStringList); +procedure TCodeSystemProvider.listSupplements(opContext : TTxOperationContext; ts: TStringList); begin // nothing end; -function TCodeSystemProvider.IsInactive(code: String): boolean; +function TCodeSystemProvider.IsInactive(opContext : TTxOperationContext; code: String): boolean; var ctxt : TCodeSystemProviderContext; begin - ctxt := locate(code); + ctxt := locate(opContext, code); try - result := IsInactive(ctxt); + result := IsInactive(opContext, ctxt); finally ctxt.free; end; end; -function TCodeSystemProvider.Display(context: TCodeSystemProviderContext; lang : TFslList): string; +function TCodeSystemProvider.Display(opContext : TTxOperationContext; context: TCodeSystemProviderContext; lang : TFslList): string; var hl : THTTPLanguageList; l : TIETFLang; @@ -987,13 +993,13 @@ function TCodeSystemProvider.Display(context: TCodeSystemProviderContext; lang : try for l in lang do hl.addCode(l.code); - result := display(context, hl); + result := display(opContext, context, hl); finally hl.free; end; end; -function TCodeSystemProvider.itemWeight(context: TCodeSystemProviderContext): string; +function TCodeSystemProvider.itemWeight(opContext : TTxOperationContext; context: TCodeSystemProviderContext): string; begin result := ''; end; @@ -1018,17 +1024,17 @@ function TCodeSystemProvider.getPropertyDefinitions: TFslList; +function TCodeSystemProvider.getExtensions(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TFslList; begin result := nil; end; -function TCodeSystemProvider.getProperties(context: TCodeSystemProviderContext): TFslList; +function TCodeSystemProvider.getProperties(opContext : TTxOperationContext; context: TCodeSystemProviderContext): TFslList; begin result := nil end; -function TCodeSystemProvider.listCodes(ctxt: TCodeSystemProviderContext; altOpt: TAlternateCodeOptions): TStringArray; +function TCodeSystemProvider.listCodes(opContext : TTxOperationContext; ctxt: TCodeSystemProviderContext; altOpt: TAlternateCodeOptions): TStringArray; begin SetLength(result, 1); - result[0] := code(ctxt); + result[0] := code(opContext, ctxt); end; -function TCodeSystemProvider.parent(context: TCodeSystemProviderContext): String; +function TCodeSystemProvider.parent(opContext : TTxOperationContext; context: TCodeSystemProviderContext): String; begin result := ''; end; @@ -1224,6 +1230,8 @@ function TSearchFilterText.passes(stems: TFslStringList; var rating : double): b rating := 0; if FStems.Count = 0 then result := true + else if stems = nil then + result := false else begin all := true; diff --git a/library/ftx/ftx_ucum_services.pas b/library/ftx/ftx_ucum_services.pas index 1cce08f2b..dc4f1bf76 100644 --- a/library/ftx/ftx_ucum_services.pas +++ b/library/ftx/ftx_ucum_services.pas @@ -235,33 +235,33 @@ TUcumServices = class (TCodeSystemProvider) function description : String; override; function TotalCount : integer; override; - function getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; - function getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; + function getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; + function getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; function systemUri : String; override; function version : String; override; function name(context : TCodeSystemProviderContext) : String; override; - function getDisplay(code : String; langList : THTTPLanguageList):String; override; - function locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; - function IsAbstract(context : TCodeSystemProviderContext) : boolean; override; - function Code(context : TCodeSystemProviderContext) : string; override; - function Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; - procedure Designations(context : TCodeSystemProviderContext; list : TConceptDesignations); override; - function filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; - function FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; override; - function filterSize(ctxt : TCodeSystemProviderFilterContext) : integer; override; - function FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; - function locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; - function InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; - function filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; - function getPrepContext : TCodeSystemProviderFilterPreparationContext; override; - function specialFilter(prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; - function searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; overload; override; - function getDefinition(code : String):String; override; - function Definition(context : TCodeSystemProviderContext) : string; override; - function isNotClosed(textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; + function getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; override; + function locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; + function IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; override; + function Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + function Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; + procedure Designations(opContext : TTxOperationContext; context : TCodeSystemProviderContext; list : TConceptDesignations); override; + function filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; + function FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; override; + function filterSize(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : integer; override; + function FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; + function locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; + function InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; + function filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; + function getPrepContext(opContext : TTxOperationContext) : TCodeSystemProviderFilterPreparationContext; override; + function specialFilter(opContext : TTxOperationContext; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; + function searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; overload; override; + function getDefinition(opContext : TTxOperationContext; code : String):String; override; + function Definition(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + function isNotClosed(opContext : TTxOperationContext; textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; function SpecialEnumeration : String; override; - procedure getCDSInfo(card : TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display : String); override; - procedure defineFeatures(features : TFslList); override; + procedure getCDSInfo(opContext : TTxOperationContext; card : TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display : String); override; + procedure defineFeatures(opContext : TTxOperationContext; features : TFslList); override; //function subsumes(codeA, codeB : String) : String; override; End; @@ -447,12 +447,12 @@ constructor TUcumServices.Create(languages : TIETFLanguageDefinitions; i18n : TI FHandlers.Register; end; -procedure TUcumServices.defineFeatures(features: TFslList); +procedure TUcumServices.defineFeatures(opContext : TTxOperationContext; features: TFslList); begin features.Add(TFHIRFeature.fromString('rest.Codesystem:'+systemUri+'.filter', 'canonical:equals')); end; -function TUcumServices.Definition(context: TCodeSystemProviderContext): string; +function TUcumServices.Definition(opContext : TTxOperationContext; context: TCodeSystemProviderContext): string; begin result := ''; end; @@ -525,7 +525,7 @@ function TUcumServices.getCanonicalUnits(code: String): String; End; end; -procedure TUcumServices.getCDSInfo(card: TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display: String); +procedure TUcumServices.getCDSInfo(opContext : TTxOperationContext; card: TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display: String); var s : String; b : TFslStringBuilder; @@ -564,7 +564,7 @@ function TUcumServices.getDefinedForms(code: String): TFslMap; End; end; -function TUcumServices.getDefinition(code: String): String; +function TUcumServices.getDefinition(opContext : TTxOperationContext; code: String): String; begin result := ''; end; @@ -580,7 +580,7 @@ procedure TUcumServices.getCommonUnits(propertyName: String; oList : TFslStringL oList.Assign(p.CommonUnits); end; -function TUcumServices.getPrepContext: TCodeSystemProviderFilterPreparationContext; +function TUcumServices.getPrepContext(opContext : TTxOperationContext): TCodeSystemProviderFilterPreparationContext; begin result := nil; end; @@ -629,7 +629,7 @@ function TUcumServices.search(kind: TConceptKind; text: String; isRegex: Boolean End; end; -function TUcumServices.searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean): TCodeSystemProviderFilterContext; +function TUcumServices.searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean): TCodeSystemProviderFilterContext; begin raise ETerminologyError.Create('to do', itException); end; @@ -860,12 +860,12 @@ function TUcumServiceList.sizeInBytesV(magic : integer) : cardinal; inc(result, FDefinition.sizeInBytes(magic)); end; -function TUcumServices.getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; +function TUcumServices.getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; begin result := TCodeSystemIteratorContext.Create(nil, 0); end; -function TUcumServices.Code(context: TCodeSystemProviderContext): string; +function TUcumServices.Code(opContext : TTxOperationContext; context: TCodeSystemProviderContext): string; begin if context = nil then result := '' @@ -873,23 +873,23 @@ function TUcumServices.Code(context: TCodeSystemProviderContext): string; result := TUCUMContext(context).concept.code; end; -function TUcumServices.getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; +function TUcumServices.getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; begin raise ETerminologyError.Create('not safe', itInvalid); // result := nil; end; -function TUcumServices.Display(context: TCodeSystemProviderContext; langList : THTTPLanguageList): string; +function TUcumServices.Display(opContext : TTxOperationContext; context: TCodeSystemProviderContext; langList : THTTPLanguageList): string; begin if context = nil then result := '' else - result := getDisplay(TUCUMContext(context).concept.code, langList); + result := getDisplay(opContext, TUCUMContext(context).concept.code, langList); end; -procedure TUcumServices.Designations(context: TCodeSystemProviderContext; list: TConceptDesignations); +procedure TUcumServices.Designations(opContext : TTxOperationContext; context: TCodeSystemProviderContext; list: TConceptDesignations); begin - list.addDesignation(true, true, '', Code(context).Trim); + list.addDesignation(true, true, '', Code(opContext, context).Trim); end; function TUcumServices.divideBy(o1, o2: TUcumPair): TUcumPair; @@ -915,7 +915,7 @@ function TUcumServices.divideBy(o1, o2: TUcumPair): TUcumPair; End; end; -function TUcumServices.getDisplay(code: String; langList : THTTPLanguageList): String; +function TUcumServices.getDisplay(opContext : TTxOperationContext; code: String; langList : THTTPLanguageList): String; var inc : TFhirValueSetComposeIncludeW; cc : TFhirValueSetComposeIncludeConceptW; @@ -1001,7 +1001,7 @@ class function TUcumServices.checkFile(sFilename: String): String; end; end; -function TUcumServices.InFilter(ctxt: TCodeSystemProviderFilterContext; concept: TCodeSystemProviderContext): Boolean; +function TUcumServices.InFilter(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext; concept: TCodeSystemProviderContext): Boolean; var code : String; context : TUcumFilterContext; @@ -1011,17 +1011,17 @@ function TUcumServices.InFilter(ctxt: TCodeSystemProviderFilterContext; concept: result := validateCanonicalUnits(code, context.canonical) = ''; end; -function TUcumServices.IsAbstract(context: TCodeSystemProviderContext): boolean; +function TUcumServices.IsAbstract(opContext : TTxOperationContext; context: TCodeSystemProviderContext): boolean; begin result := false; end; -function TUcumServices.isNotClosed(textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; +function TUcumServices.isNotClosed(opContext : TTxOperationContext; textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; begin result := true; end; -function TUcumServices.locate(code: String; altOpt : TAlternateCodeOptions; var message : String): TCodeSystemProviderContext; +function TUcumServices.locate(opContext : TTxOperationContext; code: String; altOpt : TAlternateCodeOptions; var message : String): TCodeSystemProviderContext; var s : String; begin @@ -1035,7 +1035,7 @@ function TUcumServices.locate(code: String; altOpt : TAlternateCodeOptions; var end; end; -function TUcumServices.specialFilter(prep: TCodeSystemProviderFilterPreparationContext; sort: boolean): TCodeSystemProviderFilterContext; +function TUcumServices.specialFilter(opContext : TTxOperationContext; prep: TCodeSystemProviderFilterPreparationContext; sort: boolean): TCodeSystemProviderFilterContext; begin result := TUcumFilterContext.create('') end; @@ -1051,7 +1051,7 @@ function TUcumServices.TotalCount: integer; result := 0; end; -function TUcumServices.filter(forExpansion, forIteration : boolean; prop: String; op: TFhirFilterOperator; value: String; prep : TCodeSystemProviderFilterPreparationContext): TCodeSystemProviderFilterContext; +function TUcumServices.filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop: String; op: TFhirFilterOperator; value: String; prep : TCodeSystemProviderFilterPreparationContext): TCodeSystemProviderFilterContext; begin if (prop = 'canonical') and (op in [foEqual]) then result := TUcumFilterContext.create(value) @@ -1059,7 +1059,7 @@ function TUcumServices.filter(forExpansion, forIteration : boolean; prop: String result := nil; end; -function TUcumServices.FilterConcept(ctxt: TCodeSystemProviderFilterContext): TCodeSystemProviderContext; +function TUcumServices.FilterConcept(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): TCodeSystemProviderContext; var context : TUcumFilterContext; begin @@ -1067,7 +1067,7 @@ function TUcumServices.FilterConcept(ctxt: TCodeSystemProviderFilterContext): TC result := TUCUMContext.create(FCommonUnitList[context.FCursor].link); end; -function TUcumServices.FilterMore(ctxt: TCodeSystemProviderFilterContext): boolean; +function TUcumServices.FilterMore(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): boolean; var context : TUcumFilterContext; begin @@ -1076,17 +1076,17 @@ function TUcumServices.FilterMore(ctxt: TCodeSystemProviderFilterContext): boole result := context.FCursor < FCommonUnitList.count; end; -function TUcumServices.filterSize(ctxt: TCodeSystemProviderFilterContext): integer; +function TUcumServices.filterSize(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): integer; begin result := FCommonUnitList.count; end; -function TUcumServices.filterLocate(ctxt: TCodeSystemProviderFilterContext; code: String; var message : String): TCodeSystemProviderContext; +function TUcumServices.filterLocate(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext; code: String; var message : String): TCodeSystemProviderContext; begin result := nil; end; -function TUcumServices.locateIsA(code, parent: String; disallowParent : boolean = false): TCodeSystemProviderContext; +function TUcumServices.locateIsA(opContext : TTxOperationContext; code, parent: String; disallowParent : boolean = false): TCodeSystemProviderContext; begin result := nil; end; diff --git a/server/database.pas b/server/database.pas index 651a25184..a56545464 100644 --- a/server/database.pas +++ b/server/database.pas @@ -34,7 +34,7 @@ interface uses SysUtils, Classes, IniFiles, Generics.Collections, - fsl_base, fsl_threads, fsl_utilities, fsl_stream, fsl_xml, fsl_crypto, fsl_collections, fsl_json, + fsl_base, fsl_threads, fsl_utilities, fsl_stream, fsl_xml, fsl_crypto, fsl_collections, fsl_json, fsl_logging, fsl_versions, fdb_manager, fdb_dialects, fsl_http, fsl_graphql, @@ -45,7 +45,7 @@ interface fhir_tx, fhir_valuesets, fhir_diff, fhir_graphql, fhir_codegen, ftx_service, tx_server, ftx_ucum_services, fsl_scim, scim_server, - indexing, session, subscriptions, security, obsservation_stats, bundlebuilder, time_tracker, search, + indexing, session, subscriptions, security, obsservation_stats, bundlebuilder, search, closuremanager, graph_definition, tags, utilities, database_installer, mpi_search, server_context, storage, server_constants; @@ -207,7 +207,7 @@ TFHIRNativeOperationEngine = class (TFHIROperationEngine) function ExecuteValidation(request: TFHIRRequest; response : TFHIRResponse; opDesc : String) : boolean; override; function ExecuteTransaction(context : TOperationContext; request: TFHIRRequest; response : TFHIRResponse) : String; override; procedure ExecuteBatch(context : TOperationContext; request: TFHIRRequest; response : TFHIRResponse); override; - function ExecuteOperation(context : TOperationContext; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function ExecuteOperation(context : TOperationContext; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; procedure registerOperations; virtual; abstract; procedure adjustReferences(request : TFHIRRequest; resp : TFHIRResponse; te : TFHIRTransactionEntry; base : String; entry : TFHIRBundleEntryW; ids : TFHIRTransactionEntryList); virtual; abstract; @@ -446,7 +446,6 @@ implementation uses IdMessage, IdSMTP, - fsl_logging, tx_manager, tx_operations; function chooseFile(fReal, fDev : String) : String; @@ -3873,12 +3872,12 @@ procedure TFHIRNativeOperationEngine.ExecuteBatch(context : TOperationContext; r mem : TFslMemoryStream; comp : TFHIRComposer; m : TVCLStream; - tt : TTimeTracker; + tt : TFslTimeTracker; begin try req := factory.wrapBundle(request.resource.Link); resp := factory.wrapBundle(factory.makeResource('Bundle')); - tt := TTimeTracker.Create; + tt := TFslTimeTracker.Create; try resp.type_ := btBatchResponse; resp.id := NewGuidId; @@ -3962,7 +3961,7 @@ procedure TFHIRNativeOperationEngine.ExecuteBatch(context : TOperationContext; r end; end; -function TFHIRNativeOperationEngine.ExecuteOperation(context : TOperationContext; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFHIRNativeOperationEngine.ExecuteOperation(context : TOperationContext; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; begin if request.OperationName = 'graphql' then begin @@ -4862,7 +4861,7 @@ procedure TFHIRNativeOperationEngine.storeResources(list : TFslList nil) then - result := ServerContext.TerminologyServer.ExpandVS(vs, '', '', profile, '', dependencies, limit, count, offset, nil, false) + result := ServerContext.TerminologyServer.ExpandVS(vs, '', '', profile, '', dependencies, limit, count, offset, nil, false, false, nil) else begin if ServerContext.TerminologyServer.isKnownValueSet(ref, vs) then - result := ServerContext.TerminologyServer.ExpandVS(vs, '', ref, profile, '', dependencies, limit, count, offset, nil, false) + result := ServerContext.TerminologyServer.ExpandVS(vs, '', ref, profile, '', dependencies, limit, count, offset, nil, false, false, nil) else begin vs := ServerContext.TerminologyServer.getValueSetByUrl(ref, ''); @@ -5879,7 +5878,7 @@ function TFHIRNativeStorageService.ExpandVS(vs: TFHIRValueSetW; ref: string; lan if vs = nil then result := nil else - result := ServerContext.TerminologyServer.ExpandVS(vs, '', ref, profile, '', dependencies, limit, count, offset, nil, false) + result := ServerContext.TerminologyServer.ExpandVS(vs, '', ref, profile, '', dependencies, limit, count, offset, nil, false, false, nil) end; end; finally @@ -7673,7 +7672,7 @@ function TFHIRNativeStorageService.LookupCode(system, version, code: String): St prov := ServerContext.TerminologyServer.getProvider(system, version, params); try if prov <> nil then - result := prov.getDisplay(code, ServerContext.ValidatorContext.langList); + result := prov.getDisplay(nil, code, ServerContext.ValidatorContext.langList); finally prov.free; end; diff --git a/server/endpoint.pas b/server/endpoint.pas index 8da8ff933..c8b0198cf 100644 --- a/server/endpoint.pas +++ b/server/endpoint.pas @@ -38,11 +38,11 @@ interface {$ENDIF} SysUtils, Classes, Generics.Collections, IdCustomHTTPServer, IdContext, IdOpenSSLX509, - fsl_base, fsl_threads, fsl_crypto, fsl_stream, fsl_utilities, fsl_http, fsl_json, fsl_npm_cache, fsl_i18n, + fsl_base, fsl_threads, fsl_crypto, fsl_stream, fsl_utilities, fsl_http, fsl_json, fsl_npm_cache, fsl_i18n, fsl_logging, fdb_manager, fhir_objects, server_config, utilities, session, tx_manager, kernel_thread, - web_event, web_base, web_cache, time_tracker, server_stats; + web_event, web_base, web_cache, server_stats; type TFHIRWebServerClientInfo = class(TFslObject) @@ -114,8 +114,8 @@ TFhirWebServerEndpoint = class abstract (TFHIRWebServerBase) property OnReturnFileSource : TWebReturnDirectFileEvent read FOnReturnFileSource write FOnReturnFileSource; property OnProcessFile : TWebProcessFileEvent read FOnProcessFile write FOnProcessFile; - function PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TTimeTracker) : String; virtual; abstract; - function SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert : TIdOpenSSLX509; id : String; tt : TTimeTracker) : String; virtual; abstract; + function PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TFslTimeTracker) : String; virtual; abstract; + function SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert : TIdOpenSSLX509; id : String; tt : TFslTimeTracker) : String; virtual; abstract; function description : string; virtual; abstract; end; diff --git a/server/endpoint_folder.pas b/server/endpoint_folder.pas index 8d140ac02..db5a656e3 100644 --- a/server/endpoint_folder.pas +++ b/server/endpoint_folder.pas @@ -42,7 +42,7 @@ interface fdb_manager, fhir_objects, server_config, utilities, server_constants, - tx_manager, telnet_server, time_tracker, server_stats, + tx_manager, telnet_server, server_stats, web_base, endpoint; type @@ -64,8 +64,8 @@ TFolderWebServer = class (TFhirWebServerEndpoint) function description : String; override; function logId : string; override; - function PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TTimeTracker) : String; override; - function SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert : TIdOpenSSLX509; id : String; tt : TTimeTracker) : String; override; + function PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TFslTimeTracker) : String; override; + function SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert : TIdOpenSSLX509; id : String; tt : TFslTimeTracker) : String; override; end; { TFolderWebEndPoint } @@ -240,7 +240,7 @@ function TFolderWebServer.logId: string; result := 'FF'; end; -function TFolderWebServer.PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id: String; tt : TTimeTracker): String; +function TFolderWebServer.PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id: String; tt : TFslTimeTracker): String; begin countRequest; if request.CommandType <> hcGET then @@ -249,7 +249,7 @@ function TFolderWebServer.PlainRequest(AContext: TIdContext; ip : String; reques result := doRequest(AContext, request, response, id, false); end; -function TFolderWebServer.SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert: TIdOpenSSLX509; id: String; tt : TTimeTracker): String; +function TFolderWebServer.SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert: TIdOpenSSLX509; id: String; tt : TFslTimeTracker): String; begin countRequest; if request.CommandType = hcPUT then diff --git a/server/endpoint_full.pas b/server/endpoint_full.pas index 6f4fc2eb8..673f8fef9 100644 --- a/server/endpoint_full.pas +++ b/server/endpoint_full.pas @@ -61,7 +61,7 @@ interface scim_server, telnet_server, session, security, jwt, database_installer, server_version, server_config, utilities, bundlebuilder, html_builder, server_constants, server_context, auth_manager, - storage, database, time_tracker, kernel_thread, server_stats, + storage, database, kernel_thread, server_stats, server_factory, indexing, subscriptions, web_base, endpoint, endpoint_storage; @@ -484,7 +484,7 @@ procedure TFullServerEndPoint.Transaction(bundle: TFHIRBundleW; init: boolean; n Context: TOperationContext; op: TFHIROperationEngine; t: UInt64; - tt : TTimeTracker; + tt : TFslTimeTracker; begin Context := TOperationContext.Create(mode, logLevel); try @@ -500,7 +500,7 @@ procedure TFullServerEndPoint.Transaction(bundle: TFHIRBundleW; init: boolean; n // GJSHost.registry := FContext.EventScriptRegistry.link; resp := TFHIRResponse.Create(FServerContext.ValidatorContext.link); - tt := TTimeTracker.create; + tt := TFslTimeTracker.create; try t := GetTickCount64; req.internalRequestId := FServerContext.Globals.nextRequestId; @@ -1222,13 +1222,13 @@ function TFullServerWebEndPoint.DoSearch(Session: TFHIRSession; rtype: string; l request: TFHIRRequest; response: TFHIRResponse; Context: TOperationContext; - tt : TTimeTracker; + tt : TFslTimeTracker; begin request := TFHIRRequest.Create(self.Context.ValidatorContext.link, roRest, self.Context.Indexes.Compartments.link); Context := TOperationContext.Create; try response := TFHIRResponse.Create(self.Context.ValidatorContext.link); - tt := TTimeTracker.Create; + tt := TFslTimeTracker.Create; try request.Session := Session.link; request.ResourceName := rtype; @@ -1480,7 +1480,7 @@ function TFullServerWebEndPoint.GetResource(Session: TFHIRSession; rtype: string request: TFHIRRequest; response: TFHIRResponse; Context: TOperationContext; - tt : TTimeTracker; + tt : TFslTimeTracker; begin request := TFHIRRequest.Create(self.Context.ValidatorContext.link, roRest, self.Context.Indexes.Compartments.link); response := TFHIRResponse.Create(self.Context.ValidatorContext.link); @@ -1503,7 +1503,7 @@ function TFullServerWebEndPoint.GetResource(Session: TFHIRSession; rtype: string request.SubId := ver; end; Context := TOperationContext.Create; - tt := TTimeTracker.create; + tt := TFslTimeTracker.create; try ProcessRequest(Context, request, response, tt); finally @@ -1651,7 +1651,7 @@ function TFullServerWebEndPoint.HandleWebPost(request: TFHIRRequest; response: T p: THTTPParameters; prsr: TFHIRParser; Context: TOperationContext; - tt : TTimeTracker; + tt : TFslTimeTracker; begin StringSplit(request.id, '/', typ, s); StringSplit(s, '/', id, ver); @@ -1672,7 +1672,7 @@ function TFullServerWebEndPoint.HandleWebPost(request: TFHIRRequest; response: T try s := p['source']; prsr.Source := TStringStream.Create(s, TEncoding.UTF8); - tt := TTimeTracker.create; + tt := TFslTimeTracker.create; try prsr.Parse; request.resource := prsr.resource.link; diff --git a/server/endpoint_icao.pas b/server/endpoint_icao.pas index 560c3f198..13e7e0216 100644 --- a/server/endpoint_icao.pas +++ b/server/endpoint_icao.pas @@ -42,7 +42,7 @@ interface fsl_utilities, fsl_stream, fsl_crypto, fsl_http, fsl_threads, fsl_i18n, fsl_logging, fhir_objects, fhir_icao, fsl_web_stream, fhir4_factory, fhir4_ips, - utilities, server_config, time_tracker, storage, server_stats, + utilities, server_config, storage, server_stats, web_base, endpoint, healthcard_generator; type @@ -76,8 +76,8 @@ TICAOWebServer = class (TFhirWebServerEndpoint) function description : String; override; function logId : string; override; - function PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TTimeTracker) : String; override; - function SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert : TIdOpenSSLX509; id : String; tt : TTimeTracker) : String; override; + function PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TFslTimeTracker) : String; override; + function SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert : TIdOpenSSLX509; id : String; tt : TFslTimeTracker) : String; override; end; { TICAOWebEndPoint } @@ -466,7 +466,7 @@ function TICAOWebServer.logId: string; result := 'SC'; end; -function TICAOWebServer.PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id: String; tt : TTimeTracker): String; +function TICAOWebServer.PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id: String; tt : TFslTimeTracker): String; var path, tgt : String; begin @@ -551,7 +551,7 @@ procedure TICAOWebServer.processIPS(request: TIdHTTPRequestInfo; response: TIdHT end; end; -function TICAOWebServer.SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert: TIdOpenSSLX509; id: String; tt : TTimeTracker): String; +function TICAOWebServer.SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert: TIdOpenSSLX509; id: String; tt : TFslTimeTracker): String; var s : TStream; params, ct : String; diff --git a/server/endpoint_loinc.pas b/server/endpoint_loinc.pas index f790d138d..4d41bf8d4 100644 --- a/server/endpoint_loinc.pas +++ b/server/endpoint_loinc.pas @@ -43,7 +43,7 @@ interface ftx_loinc_services, ftx_loinc_publisher, fhir_objects, server_config, utilities, server_constants, - tx_manager, telnet_server, time_tracker, server_stats, + tx_manager, telnet_server, server_stats, web_base, endpoint; type @@ -58,8 +58,8 @@ TLoincWebServer = class (TFhirWebServerEndpoint) function link : TLoincWebServer; overload; function description : String; override; - function PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TTimeTracker) : String; override; - function SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert : TIdOpenSSLX509; id : String; tt : TTimeTracker) : String; override; + function PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TFslTimeTracker) : String; override; + function SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert : TIdOpenSSLX509; id : String; tt : TFslTimeTracker) : String; override; function logId : string; override; end; @@ -275,7 +275,7 @@ function TLoincWebServer.logId: string; result := 'LN'; end; -function TLoincWebServer.PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id: String; tt : TTimeTracker): String; +function TLoincWebServer.PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id: String; tt : TFslTimeTracker): String; begin countRequest; result := doRequest(AContext, request, response, id, false); @@ -295,7 +295,7 @@ procedure TLoincWebServer.returnContent(request: TIdHTTPRequestInfo; response: T end; end; -function TLoincWebServer.SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert: TIdOpenSSLX509; id: String; tt : TTimeTracker): String; +function TLoincWebServer.SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert: TIdOpenSSLX509; id: String; tt : TFslTimeTracker): String; begin countRequest; result := doRequest(AContext, request, response, id, true); diff --git a/server/endpoint_packages.pas b/server/endpoint_packages.pas index a5e9a0b8e..8340a0695 100644 --- a/server/endpoint_packages.pas +++ b/server/endpoint_packages.pas @@ -42,7 +42,7 @@ interface server_config, utilities, database_installer, telnet_server, - tx_manager, time_tracker, kernel_thread, server_stats, + tx_manager, kernel_thread, server_stats, web_event, web_base, endpoint, session; type @@ -113,8 +113,8 @@ TFHIRPackageWebServer = class (TFhirWebServerEndpoint) property scanning : boolean read FScanning write SetScanning; property SystemToken : String read FSystemToken write FSystemToken; - function PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TTimeTracker) : String; override; - function SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert : TIdOpenSSLX509; id : String; tt : TTimeTracker) : String; override; + function PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TFslTimeTracker) : String; override; + function SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert : TIdOpenSSLX509; id : String; tt : TFslTimeTracker) : String; override; function logId : string; override; end; @@ -1465,7 +1465,7 @@ function TFHIRPackageWebServer.serveCreatePackage(request: TIdHTTPRequestInfo; r end; end; -function TFHIRPackageWebServer.PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TTimeTracker) : String; +function TFHIRPackageWebServer.PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TFslTimeTracker) : String; begin countRequest; result := doRequest(AContext, request, response, id, false); @@ -1627,7 +1627,7 @@ constructor TFHIRPackageWebServer.Create(code, path: String; common: TFHIRWebSer FCrawlerLog['status'] := 'No crawl has completed yet'; end; -function TFHIRPackageWebServer.SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert: TIdOpenSSLX509; id: String; tt : TTimeTracker): String; +function TFHIRPackageWebServer.SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert: TIdOpenSSLX509; id: String; tt : TFslTimeTracker): String; begin countRequest; result := doRequest(AContext, request, response, id, true); diff --git a/server/endpoint_snomed.pas b/server/endpoint_snomed.pas index e3c839e1f..7ca5965fb 100644 --- a/server/endpoint_snomed.pas +++ b/server/endpoint_snomed.pas @@ -40,7 +40,7 @@ interface ftx_service, ftx_sct_services, ftx_sct_publisher, ftx_sct_analysis, ftx_sct_expressions, fhir_objects, server_config, utilities, server_constants, - tx_manager, telnet_server, time_tracker, server_stats, + tx_manager, telnet_server, server_stats, web_base, endpoint; type @@ -58,8 +58,8 @@ TSnomedWebServer = class (TFhirWebServerEndpoint) function logId : string; override; function description : String; override; - function PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TTimeTracker) : String; override; - function SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert : TIdOpenSSLX509; id : String; tt : TTimeTracker) : String; override; + function PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TFslTimeTracker) : String; override; + function SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert : TIdOpenSSLX509; id : String; tt : TFslTimeTracker) : String; override; end; { TSnomedWebEndPoint } @@ -322,7 +322,7 @@ function TSnomedWebServer.logId: string; result := 'SN'; end; -function TSnomedWebServer.PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id: String; tt : TTimeTracker): String; +function TSnomedWebServer.PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id: String; tt : TFslTimeTracker): String; begin countRequest; result := doRequest(AContext, request, response, id, false); @@ -342,7 +342,7 @@ procedure TSnomedWebServer.returnContent(request: TIdHTTPRequestInfo; response: end; end; -function TSnomedWebServer.SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert: TIdOpenSSLX509; id: String; tt : TTimeTracker): String; +function TSnomedWebServer.SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert: TIdOpenSSLX509; id: String; tt : TFslTimeTracker): String; begin countRequest; result := doRequest(AContext, request, response, id, true); diff --git a/server/endpoint_storage.pas b/server/endpoint_storage.pas index ffc4828c2..8020ed00c 100644 --- a/server/endpoint_storage.pas +++ b/server/endpoint_storage.pas @@ -47,7 +47,7 @@ interface ftx_service, server_config, utilities, bundlebuilder, reverse_client, security, html_builder, storage, user_manager, session, auth_manager, server_context, server_constants, - tx_manager, tx_webserver, telnet_server, time_tracker, server_stats, + tx_manager, tx_webserver, telnet_server, server_stats, web_base, web_cache, endpoint; const @@ -157,7 +157,7 @@ TStorageWebEndpoint = class (TFhirWebServerEndpoint) {$ENDIF} procedure SetTerminologyWebServer(const Value: TTerminologyWebServer); Procedure HandleOWinToken(AContext: TIdContext; secure: boolean; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo); - function HandleRequest(AContext: TIdContext; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; ssl, secure: boolean; path: String; logId : String; esession: TFHIRSession; cert: TIdOpenSSLX509; tt : TTimeTracker) : String; + function HandleRequest(AContext: TIdContext; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; ssl, secure: boolean; path: String; logId : String; esession: TFHIRSession; cert: TIdOpenSSLX509; tt : TFslTimeTracker) : String; procedure ReturnSecureFile(request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; Session: TFHIRSession; claimed, actual, logid: String; secure: boolean; variables: TFslMap = nil); Procedure ProcessScimRequest(AContext: TIdContext; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; prefix : String); Procedure ReadTags(header: String; request: TFHIRRequest); overload; @@ -168,7 +168,7 @@ TStorageWebEndpoint = class (TFhirWebServerEndpoint) function readVersion(mt : String) : TFHIRVersion; function BuildRequest(const langList : THTTPLanguageList; sBaseURL, sHost, sRawHost, sOrigin, sClient, sContentLocation, sCommand, sResource, sContentType, sContentAccept, sContentEncoding, sCookie, provenance, sBearer: String; oPostStream: TStream; oResponse: TFHIRResponse; var aFormat: TFHIRFormat; var redirect: boolean; form: TMimeMessage; - bAuth, secure: boolean; out relativeReferenceAdjustment: integer; var style : TFHIROutputStyle; Session: TFHIRSession; cert: TIdOpenSSLX509; tt : TTimeTracker): TFHIRRequest; + bAuth, secure: boolean; out relativeReferenceAdjustment: integer; var style : TFHIROutputStyle; Session: TFHIRSession; cert: TIdOpenSSLX509; tt : TFslTimeTracker): TFHIRRequest; Procedure ProcessOutput(start : UInt64; oRequest: TFHIRRequest; oResponse: TFHIRResponse; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; relativeReferenceAdjustment: integer; style : TFHIROutputStyle; gzip, cache: boolean; summary : String); procedure SendError(response: TIdHTTPResponseInfo; logid : string; status: word; format: TFHIRFormat; langList : THTTPLanguageList; message, url: String; e: exception; Session: TFHIRSession; addLogins: boolean; path: String; relativeReferenceAdjustment: integer; code: TFHIRIssueType; diagnostics : String = ''); function processProvenanceHeader(header : String; langList : THTTPLanguageList): TFhirProvenanceW; @@ -195,7 +195,7 @@ TStorageWebEndpoint = class (TFhirWebServerEndpoint) procedure GetWebUILink(resource: TFhirResourceV; base, statedType, id, ver: String; var link, text: String); virtual; abstract; Function ProcessZip(langList : THTTPLanguageList; oStream: TStream; name, base: String; init: boolean; ini: TFHIRServerConfigFile; Context: TOperationContext; var cursor: integer): TFHIRBundleW; virtual; abstract; function DoSearch(Session: TFHIRSession; rtype: string; langList : THTTPLanguageList; params: String): TFHIRBundleW; virtual; abstract; - function ProcessRequest(Context: TOperationContext; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; + function ProcessRequest(Context: TOperationContext; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; procedure returnContent(request : TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; path: String; secure : boolean; title, content : String); overload; function processContent(path: String; secure : boolean; title, content : String) : String; @@ -218,8 +218,8 @@ TStorageWebEndpoint = class (TFhirWebServerEndpoint) Procedure ReturnProcessedFile(request : TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; Session: TFHIRSession; claimed, actual: String; secure: boolean; variables: TFslMap = nil); overload; procedure CheckAsyncTasks; - function PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TTimeTracker) : String; override; - function SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert : TIdOpenSSLX509; id : String; tt : TTimeTracker) : String; override; + function PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TFslTimeTracker) : String; override; + function SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert : TIdOpenSSLX509; id : String; tt : TFslTimeTracker) : String; override; end; { TStorageEndPoint } @@ -516,7 +516,7 @@ function TFHIRWebServerCommunicator.fetchResource(command, url : String; resourc req : TFHIRRequest; resp : TFHIRResponse; dummy : integer; - tt : TTimeTracker; + tt : TFslTimeTracker; l, r : String; begin ctxt := TOperationContext.Create(opmInternal); @@ -533,7 +533,7 @@ function TFHIRWebServerCommunicator.fetchResource(command, url : String; resourc req.resource := resource.link; resp := TFHIRResponse.Create(FEndPoint.Context.ValidatorContext.link); - tt := TTimeTracker.Create; + tt := TFslTimeTracker.Create; try FEndPoint.ProcessRequest(ctxt, req, resp, tt); result := resp.Resource.link; @@ -599,7 +599,7 @@ procedure TAsyncTaskThread.Execute; t: UInt64; us, cs: String; ctxt : TOperationContext; - tt : TTimeTracker; + tt : TFslTimeTracker; begin t := 0; @@ -624,7 +624,7 @@ procedure TAsyncTaskThread.Execute; status(atsProcessing, 'Processing'); Logging.log('Start Task ('+inttostr(key)+'): ' + cs + ', type=' + request.ResourceName + ', id=' + request.id + ', ' + us + ', params=' + request.Parameters.Source); op := FServer.Context.Storage.createOperationContext(request.langList.link); - tt := TTimeTracker.Create; + tt := TFslTimeTracker.Create; try try op.OnPopulateConformance := FServer.PopulateConformance; @@ -843,7 +843,7 @@ procedure TStorageWebEndpoint.SetTerminologyWebServer(const Value: TTerminologyW FTerminologyWebServer := Value; end; -function TStorageWebEndpoint.PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TTimeTracker) : String; +function TStorageWebEndpoint.PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TFslTimeTracker) : String; var Session: TFHIRSession; c: integer; @@ -982,7 +982,7 @@ procedure TStorageWebEndpoint.HandleOWinToken(AContext: TIdContext; secure: bool function TStorageWebEndpoint.SecureRequest(AContext: TIdContext; ip: String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; - cert: TIdOpenSSLX509; id: String; tt: TTimeTracker): String; + cert: TIdOpenSSLX509; id: String; tt: TFslTimeTracker): String; var Session: TFHIRSession; check: boolean; @@ -1207,7 +1207,7 @@ procedure TStorageWebEndpoint.ReturnProcessedFile(request : TIdHTTPRequestInfo; end; end; -function TStorageWebEndpoint.HandleRequest(AContext: TIdContext; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; ssl, secure: boolean; path: String; logId : String; esession: TFHIRSession; cert: TIdOpenSSLX509; tt : TTimeTracker) : String; +function TStorageWebEndpoint.HandleRequest(AContext: TIdContext; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; ssl, secure: boolean; path: String; logId : String; esession: TFHIRSession; cert: TIdOpenSSLX509; tt : TFslTimeTracker) : String; var sHost, sRawHost, token, url: string; oRequest: TFHIRRequest; @@ -1738,7 +1738,7 @@ function TStorageWebEndpoint.CheckSessionOK(Session: TFHIRSession; ip: string): self.Context.SessionManager.EndSession(Session.Cookie, ip); end; -function TStorageWebEndpoint.ProcessRequest(Context: TOperationContext; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TStorageWebEndpoint.ProcessRequest(Context: TOperationContext; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var op: TFHIROperationEngine; t: UInt64; @@ -1796,7 +1796,7 @@ function TStorageWebEndpoint.BuildRequest(const langList: THTTPLanguageList; sBa var aFormat: TFHIRFormat; var redirect: boolean; form: TMimeMessage; bAuth, secure: boolean; out relativeReferenceAdjustment: integer; var style: TFHIROutputStyle; Session: TFHIRSession; cert: TIdOpenSSLX509; - tt: TTimeTracker): TFHIRRequest; + tt: TFslTimeTracker): TFHIRRequest; Var sURL, Msg: String; oRequest: TFHIRRequest; diff --git a/server/endpoint_txsvr.pas b/server/endpoint_txsvr.pas index 7792d5d48..7a9801773 100644 --- a/server/endpoint_txsvr.pas +++ b/server/endpoint_txsvr.pas @@ -51,7 +51,7 @@ interface fhir_indexing, search_base, database_installer, tx_manager, tx_server, tx_operations, operations, storage, server_context, session, user_manager, server_config, bundlebuilder, - utilities, security, indexing, server_factory, subscriptions, time_tracker, + utilities, security, indexing, server_factory, subscriptions, telnet_server, kernel_thread, server_stats, xig_provider, web_server, web_base, endpoint, endpoint_storage; @@ -896,7 +896,7 @@ function TTerminologyServerOperationEngine.ExecuteTransaction(context: TOperatio oplist : TStringList; s : String; i : integer; - tt : TTimeTracker; + tt : TFslTimeTracker; start : UInt64; begin start := GetTickCount64; @@ -909,7 +909,7 @@ function TTerminologyServerOperationEngine.ExecuteTransaction(context: TOperatio begin req := factory.wrapBundle(request.resource.Link); resp := factory.wrapBundle(factory.makeResource('Bundle')); - tt := TTimeTracker.create; + tt := TFslTimeTracker.create; try resp.type_ := btBatchResponse; resp.id := NewGuidId; diff --git a/server/endpoint_xig.pas b/server/endpoint_xig.pas index 0210560e2..16a14bbd4 100644 --- a/server/endpoint_xig.pas +++ b/server/endpoint_xig.pas @@ -38,7 +38,7 @@ interface fsl_base, fsl_utilities, fsl_json, fsl_i18n, fsl_http, fsl_html, fsl_fetcher, fsl_logging, fsl_threads, fhir_objects, fhir_xhtml, fdb_manager, fdb_sqlite3, - utilities, server_config, tx_manager, time_tracker, kernel_thread, + utilities, server_config, tx_manager, kernel_thread, web_base, endpoint, server_stats; type @@ -126,8 +126,8 @@ TFHIRXIGWebServer = class (TFhirWebServerEndpoint) function link : TFHIRXIGWebServer; overload; function description : String; override; - function PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TTimeTracker) : String; override; - function SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert : TIdOpenSSLX509; id : String; tt : TTimeTracker) : String; override; + function PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TFslTimeTracker) : String; override; + function SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert : TIdOpenSSLX509; id : String; tt : TFslTimeTracker) : String; override; function logId : string; override; end; @@ -1501,7 +1501,7 @@ function TFHIRXIGWebServer.logId: string; result := 'xig'; end; -function TFHIRXIGWebServer.PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TTimeTracker) : String; +function TFHIRXIGWebServer.PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TFslTimeTracker) : String; begin countRequest; result := doRequest(AContext, request, response, id, false); @@ -1551,7 +1551,7 @@ function TFHIRXIGWebServer.doRequest(AContext: TIdContext; request: TIdHTTPReque end; end; -function TFHIRXIGWebServer.SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert: TIdOpenSSLX509; id: String; tt : TTimeTracker): String; +function TFHIRXIGWebServer.SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert: TIdOpenSSLX509; id: String; tt : TFslTimeTracker): String; begin countRequest; result := doRequest(AContext, request, response, id, true); diff --git a/server/operations.pas b/server/operations.pas index 691fa62c2..98921165d 100644 --- a/server/operations.pas +++ b/server/operations.pas @@ -34,7 +34,7 @@ interface uses SysUtils, Classes, - fsl_base, + fsl_base, fsl_logging, fhir_factory, fhir_common, session, storage, time_tracker; @@ -47,7 +47,7 @@ TFhirVersionsOperation = class (TFhirOperation) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; @@ -61,7 +61,7 @@ function TFhirVersionsOperation.CreateDefinition(base: String): TFHIROperationDe result := nil; end; -function TFhirVersionsOperation.Execute(context: TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirVersionsOperation.Execute(context: TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var p : TFhirParametersW; begin diff --git a/server/operations_r2.pas b/server/operations_r2.pas index d0465456d..a3697405f 100644 --- a/server/operations_r2.pas +++ b/server/operations_r2.pas @@ -34,7 +34,7 @@ interface uses SysUtils, - fsl_base, fsl_utilities, fsl_json, fsl_lang, + fsl_base, fsl_utilities, fsl_json, fsl_lang, fsl_logging, fsl_http, fdb_manager, fhir_objects, fhir_factory, fhir_common, fhir_xhtml, fhir_validator, fhir_parser, fhir_utilities, fhir_uris, @@ -44,7 +44,7 @@ interface fhir_codegen, fhir_diff, tx_operations, ftx_ucum_services, operations, - session, tags, storage, database, obsservation_stats, time_tracker, + session, tags, storage, database, obsservation_stats, bundlebuilder, validator_r2, security, subscriptions, search; type @@ -77,7 +77,7 @@ TFhirGenerateQAOperation = class (TFhirNativeOperationR2) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function HandlesRequest(request : TFHIRRequest) : boolean; override; end; @@ -89,7 +89,7 @@ TFhirGenerateJWTOperation = class (TFhirNativeOperationR2) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function HandlesRequest(request : TFHIRRequest) : boolean; override; end; @@ -101,7 +101,7 @@ TFhirGenerateCodeOperation = class (TFhirNativeOperationR2) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function HandlesRequest(request : TFHIRRequest) : boolean; override; end; @@ -114,7 +114,7 @@ TFhirHandleQAPostOperation = class (TFhirNativeOperationR2) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirQuestionnaireGenerationOperation = class (TFhirNativeOperationR2) @@ -125,7 +125,7 @@ TFhirQuestionnaireGenerationOperation = class (TFhirNativeOperationR2) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirEverythingOperation = class (TFhirNativeOperationR2) @@ -133,7 +133,7 @@ TFhirEverythingOperation = class (TFhirNativeOperationR2) function resourceName : String; virtual; abstract; function isPrimaryResource(request: TFHIRRequest; rtype, id : String) : boolean; virtual; public - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirPatientEverythingOperation = class (TFhirEverythingOperation) @@ -186,7 +186,7 @@ TFhirGenerateDocumentOperation = class (TFhirNativeOperationR2) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirValidationOperation = class (TFhirNativeOperationR2) @@ -197,7 +197,7 @@ TFhirValidationOperation = class (TFhirNativeOperationR2) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -209,7 +209,7 @@ TFhirProcessClaimOperation = class (TFhirNativeOperationR2) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirGenerateSnapshotOperation = class (TFhirNativeOperationR2) @@ -220,7 +220,7 @@ TFhirGenerateSnapshotOperation = class (TFhirNativeOperationR2) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirGenerateTemplateOperation = class (TFhirNativeOperationR2) @@ -231,7 +231,7 @@ TFhirGenerateTemplateOperation = class (TFhirNativeOperationR2) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirGenerateNarrativeOperation = class (TFhirNativeOperationR2) @@ -242,7 +242,7 @@ TFhirGenerateNarrativeOperation = class (TFhirNativeOperationR2) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirSuggestKeyWordsOperation = class (TFhirNativeOperationR2) @@ -253,7 +253,7 @@ TFhirSuggestKeyWordsOperation = class (TFhirNativeOperationR2) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirGetMetaDataOperation = class (TFhirNativeOperationR2) @@ -264,7 +264,7 @@ TFhirGetMetaDataOperation = class (TFhirNativeOperationR2) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -276,7 +276,7 @@ TFhirAddMetaDataOperation = class (TFhirNativeOperationR2) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -288,7 +288,7 @@ TFhirDeleteMetaDataOperation = class (TFhirNativeOperationR2) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -300,7 +300,7 @@ TFhirDiffOperation = class (TFhirNativeOperationR2) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -312,7 +312,7 @@ TFhirConvertOperation = class (TFhirNativeOperationR2) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -770,7 +770,7 @@ function TFhirGenerateQAOperation.CreateDefinition(base : String): TFHIROperatio result := nil; end; -function TFhirGenerateQAOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateQAOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; begin result := '??qa'; end; @@ -807,7 +807,7 @@ function TFhirGenerateJWTOperation.CreateDefinition(base : String): TFHIROperati result := nil; end; -function TFhirGenerateJWTOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateJWTOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var jwt : String; pIn : TFhirParameters; @@ -887,7 +887,7 @@ function TFhirGenerateCodeOperation.CreateDefinition(base : String): TFHIROperat result := nil; end; -function TFhirGenerateCodeOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateCodeOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var res : TFHIRResourceV; codegen : TFHIRCodeGenerator; @@ -978,7 +978,7 @@ function TFhirHandleQAPostOperation.CreateDefinition(base : String): TFHIROperat result := nil; end; -function TFhirHandleQAPostOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirHandleQAPostOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; begin result := 'Handle QA Post'; end; @@ -1010,7 +1010,7 @@ function TFhirQuestionnaireGenerationOperation.CreateDefinition(base : String): result := nil; end; -function TFhirQuestionnaireGenerationOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirQuestionnaireGenerationOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var profile : TFHirStructureDefinition; op : TFHIROperationOutcomeW; @@ -1155,7 +1155,7 @@ function TFhirValidationOperation.CreateDefinition(base : String): TFHIROperatio result := nil; end; -function TFhirValidationOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirValidationOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; type TValidationOperationMode = (vomGeneral, vomCreate, vomUpdate, vomDelete); var outcome : TFHIROperationOutcomeW; @@ -1272,7 +1272,7 @@ function TFhirValidationOperation.isWrite: boolean; { TFhirEverythingOperation } -function TFhirEverythingOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirEverythingOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var bundle : TFHIRBundleBuilder; entry : TFHIRBundleEntryW; @@ -1412,7 +1412,7 @@ function TFhirProcessClaimOperation.CreateDefinition(base: String): TFHIROperati result := nil; end; -function TFhirProcessClaimOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirProcessClaimOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var resourceKey, versionKey : integer; params : TFhirParametersW; @@ -1510,7 +1510,7 @@ function TFhirGenerateSnapshotOperation.CreateDefinition(base: String): TFHIROpe result := nil; end; -function TFhirGenerateSnapshotOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateSnapshotOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var params : TFhirParameters; sdParam, sdBase : TFhirStructureDefinition; @@ -1623,7 +1623,7 @@ function TFhirGenerateTemplateOperation.CreateDefinition(base: String): TFHIROpe result := nil; end; -function TFhirGenerateTemplateOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateTemplateOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var profile : TFHirStructureDefinition; resourceKey, versionKey : integer; @@ -1726,7 +1726,7 @@ function TFhirGenerateNarrativeOperation.CreateDefinition(base: String): TFHIROp result := nil; end; -function TFhirGenerateNarrativeOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateNarrativeOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var narr : TFHIRNarrativeGenerator; r : TFHIRResourceV; @@ -1791,7 +1791,7 @@ function TFhirSuggestKeyWordsOperation.CreateDefinition(base: String): TFHIROper result := nil; end; -function TFhirSuggestKeyWordsOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirSuggestKeyWordsOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; begin result := 'Key Words'; raise EFHIRException.CreateLang('NOT_DONE_YET', request.langList); @@ -1824,7 +1824,7 @@ function TFhirGetMetaDataOperation.CreateDefinition(base: String): TFHIROperatio result := nil end; -function TFhirGetMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGetMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var ok : boolean; meta : TFHIRMeta; @@ -1965,7 +1965,7 @@ function TFhirAddMetaDataOperation.CreateDefinition(base: String): TFHIROperatio result := nil; end; -function TFhirAddMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirAddMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var resourceKey : Integer; resourceVersionKey : Integer; @@ -2131,7 +2131,7 @@ function TFhirDeleteMetaDataOperation.CreateDefinition(base: String): TFHIROpera result := nil; end; -function TFhirDeleteMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirDeleteMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var resourceKey : Integer; resourceVersionKey : Integer; @@ -2302,7 +2302,7 @@ function TFhirDiffOperation.CreateDefinition(base: String): TFHIROperationDefini result := nil; end; -function TFhirDiffOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirDiffOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var resourceKey : Integer; versionKey : Integer; @@ -2398,7 +2398,7 @@ function TFhirConvertOperation.CreateDefinition(base: String): TFHIROperationDef result := nil; end; -function TFhirConvertOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirConvertOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; begin result := 'Convert Op'; try @@ -2709,7 +2709,7 @@ function TFhirGenerateDocumentOperation.CreateDefinition(base: String): TFHIROpe result := nil end; -function TFhirGenerateDocumentOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateDocumentOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var composition : TFhirComposition; bundle : TFHIRBundle; diff --git a/server/operations_r3.pas b/server/operations_r3.pas index 2c8798bc3..0f3455e64 100644 --- a/server/operations_r3.pas +++ b/server/operations_r3.pas @@ -34,7 +34,7 @@ interface uses SysUtils, Classes, - fsl_base, fsl_utilities, fsl_json, fsl_lang, + fsl_base, fsl_utilities, fsl_json, fsl_lang, fsl_logging, fsl_http, fdb_manager, fhir_objects, fhir_factory, fhir_common, fhir_xhtml, fhir_validator, fhir_parser, fhir_utilities, fhir_uris, @@ -43,7 +43,7 @@ interface fhir_codegen, fhir_diff, tx_operations, ftx_ucum_services, operations, - session, tags, storage, database, obsservation_stats, search, time_tracker, + session, tags, storage, database, obsservation_stats, search, bundlebuilder, validator_r3, security, subscriptions; type @@ -76,7 +76,7 @@ TFhirGenerateQAOperation = class (TFhirNativeOperationR3) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function HandlesRequest(request : TFHIRRequest) : boolean; override; end; @@ -88,7 +88,7 @@ TFhirGenerateJWTOperation = class (TFhirNativeOperationR3) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function HandlesRequest(request : TFHIRRequest) : boolean; override; end; @@ -100,7 +100,7 @@ TFhirGenerateCodeOperation = class (TFhirNativeOperationR3) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function HandlesRequest(request : TFHIRRequest) : boolean; override; end; @@ -113,7 +113,7 @@ TFhirHandleQAPostOperation = class (TFhirNativeOperationR3) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirQuestionnaireGenerationOperation = class (TFhirNativeOperationR3) @@ -124,7 +124,7 @@ TFhirQuestionnaireGenerationOperation = class (TFhirNativeOperationR3) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirEverythingOperation = class (TFhirNativeOperationR3) @@ -132,7 +132,7 @@ TFhirEverythingOperation = class (TFhirNativeOperationR3) function resourceName : String; virtual; abstract; function isPrimaryResource(request: TFHIRRequest; rtype, id : String) : boolean; virtual; public - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirPatientEverythingOperation = class (TFhirEverythingOperation) @@ -185,7 +185,7 @@ TFhirGenerateDocumentOperation = class (TFhirNativeOperationR3) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirValidationOperation = class (TFhirNativeOperationR3) @@ -196,7 +196,7 @@ TFhirValidationOperation = class (TFhirNativeOperationR3) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -208,7 +208,7 @@ TFhirProcessClaimOperation = class (TFhirNativeOperationR3) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirGenerateSnapshotOperation = class (TFhirNativeOperationR3) @@ -219,7 +219,7 @@ TFhirGenerateSnapshotOperation = class (TFhirNativeOperationR3) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirGenerateTemplateOperation = class (TFhirNativeOperationR3) @@ -230,7 +230,7 @@ TFhirGenerateTemplateOperation = class (TFhirNativeOperationR3) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirGenerateNarrativeOperation = class (TFhirNativeOperationR3) @@ -241,7 +241,7 @@ TFhirGenerateNarrativeOperation = class (TFhirNativeOperationR3) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirSuggestKeyWordsOperation = class (TFhirNativeOperationR3) @@ -252,7 +252,7 @@ TFhirSuggestKeyWordsOperation = class (TFhirNativeOperationR3) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirGetMetaDataOperation = class (TFhirNativeOperationR3) @@ -263,7 +263,7 @@ TFhirGetMetaDataOperation = class (TFhirNativeOperationR3) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -275,7 +275,7 @@ TFhirAddMetaDataOperation = class (TFhirNativeOperationR3) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -287,7 +287,7 @@ TFhirDeleteMetaDataOperation = class (TFhirNativeOperationR3) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -299,7 +299,7 @@ TFhirDiffOperation = class (TFhirNativeOperationR3) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -311,7 +311,7 @@ TFhirConvertOperation = class (TFhirNativeOperationR3) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -325,7 +325,7 @@ TFhirObservationStatsOperation = class (TFhirNativeOperationR3) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -337,7 +337,7 @@ TFhirObservationLastNOperation = class (TFhirNativeOperationR3) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -838,7 +838,7 @@ function TFhirGenerateQAOperation.CreateDefinition(base : String): TFHIROperatio result := nil; end; -function TFhirGenerateQAOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateQAOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; begin result := '??qa'; end; @@ -875,7 +875,7 @@ function TFhirGenerateJWTOperation.CreateDefinition(base : String): TFHIROperati result := nil; end; -function TFhirGenerateJWTOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateJWTOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var jwt : String; pIn : TFhirParameters; @@ -955,7 +955,7 @@ function TFhirGenerateCodeOperation.CreateDefinition(base : String): TFHIROperat result := nil; end; -function TFhirGenerateCodeOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateCodeOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var res : TFHIRResourceV; codegen : TFHIRCodeGenerator; @@ -1046,7 +1046,7 @@ function TFhirHandleQAPostOperation.CreateDefinition(base : String): TFHIROperat result := nil; end; -function TFhirHandleQAPostOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirHandleQAPostOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; begin result := '??qap'; end; @@ -1078,7 +1078,7 @@ function TFhirQuestionnaireGenerationOperation.CreateDefinition(base : String): result := nil; end; -function TFhirQuestionnaireGenerationOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirQuestionnaireGenerationOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var profile : TFHirStructureDefinition; op : TFHIROperationOutcomeW; @@ -1223,7 +1223,7 @@ function TFhirValidationOperation.CreateDefinition(base : String): TFHIROperatio result := nil; end; -function TFhirValidationOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirValidationOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; type TValidationOperationMode = (vomGeneral, vomCreate, vomUpdate, vomDelete); var @@ -1341,7 +1341,7 @@ function TFhirValidationOperation.isWrite: boolean; { TFhirEverythingOperation } -function TFhirEverythingOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirEverythingOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var bundle : TFHIRBundleBuilder; entry : TFHIRBundleEntryW; @@ -1481,7 +1481,7 @@ function TFhirProcessClaimOperation.CreateDefinition(base: String): TFHIROperati result := nil; end; -function TFhirProcessClaimOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirProcessClaimOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var resourceKey, versionKey : integer; params : TFhirParametersW; @@ -1579,7 +1579,7 @@ function TFhirGenerateSnapshotOperation.CreateDefinition(base: String): TFHIROpe result := nil; end; -function TFhirGenerateSnapshotOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateSnapshotOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var params : TFhirParameters; sdParam, sdBase : TFhirStructureDefinition; @@ -1692,7 +1692,7 @@ function TFhirGenerateTemplateOperation.CreateDefinition(base: String): TFHIROpe result := nil; end; -function TFhirGenerateTemplateOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateTemplateOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var profile : TFHirStructureDefinition; resourceKey, versionKey : integer; @@ -1795,7 +1795,7 @@ function TFhirGenerateNarrativeOperation.CreateDefinition(base: String): TFHIROp result := nil; end; -function TFhirGenerateNarrativeOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateNarrativeOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var narr : TFHIRNarrativeGenerator; r : TFHIRResourceV; @@ -1860,7 +1860,7 @@ function TFhirSuggestKeyWordsOperation.CreateDefinition(base: String): TFHIROper result := nil; end; -function TFhirSuggestKeyWordsOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirSuggestKeyWordsOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; begin result := '??key'; raise EFHIRException.CreateLang('NOT_DONE_YET', request.langList); @@ -1893,7 +1893,7 @@ function TFhirGetMetaDataOperation.CreateDefinition(base: String): TFHIROperatio result := nil end; -function TFhirGetMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGetMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var ok : boolean; meta : TFHIRMeta; @@ -2034,7 +2034,7 @@ function TFhirAddMetaDataOperation.CreateDefinition(base: String): TFHIROperatio result := nil; end; -function TFhirAddMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirAddMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var resourceKey : Integer; resourceVersionKey : Integer; @@ -2200,7 +2200,7 @@ function TFhirDeleteMetaDataOperation.CreateDefinition(base: String): TFHIROpera result := nil; end; -function TFhirDeleteMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirDeleteMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var resourceKey : Integer; resourceVersionKey : Integer; @@ -2371,7 +2371,7 @@ function TFhirDiffOperation.CreateDefinition(base: String): TFHIROperationDefini result := nil; end; -function TFhirDiffOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirDiffOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var resourceKey : Integer; versionKey : Integer; @@ -2466,7 +2466,7 @@ function TFhirConvertOperation.CreateDefinition(base: String): TFHIROperationDef result := nil; end; -function TFhirConvertOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirConvertOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; begin result := '??cnv'; try @@ -2543,7 +2543,7 @@ function TFhirObservationStatsOperation.CreateDefinition(base : String): TFHIROp result := nil; end; -function TFhirObservationStatsOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirObservationStatsOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var req : TFHIRStatsOpRequest; s : string; @@ -2657,7 +2657,7 @@ function TFhirObservationLastNOperation.CreateDefinition(base : String): TFHIROp result := nil; end; -function TFhirObservationLastNOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirObservationLastNOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var sp : TSearchProcessor; conn : TFDBConnection; @@ -3057,7 +3057,7 @@ function TFhirGenerateDocumentOperation.CreateDefinition(base: String): TFHIROpe result := nil end; -function TFhirGenerateDocumentOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateDocumentOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var composition : TFhirComposition; bundle : TFHIRBundle; diff --git a/server/operations_r4.pas b/server/operations_r4.pas index a1a17bcbd..1109ea73b 100644 --- a/server/operations_r4.pas +++ b/server/operations_r4.pas @@ -34,7 +34,7 @@ interface uses SysUtils, Classes, - fsl_base, fsl_utilities, fsl_json, fsl_lang, + fsl_base, fsl_utilities, fsl_json, fsl_lang, fsl_logging, fsl_http, fdb_manager, fhir_objects, fhir_factory, fhir_common, fhir_xhtml, fhir_validator, fhir_parser, fhir_utilities, fhir_uris, @@ -43,7 +43,7 @@ interface fhir_codegen, fhir_diff, fhir_healthcard, tx_operations, ftx_ucum_services, operations, - session, tags, storage, database, obsservation_stats, search, time_tracker, + session, tags, storage, database, obsservation_stats, search, bundlebuilder, validator_r4, security, subscriptions, server_context, healthcard_generator; type @@ -79,7 +79,7 @@ TFhirGenerateQAOperation = class (TFhirNativeOperationR4) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function HandlesRequest(request : TFHIRRequest) : boolean; override; end; @@ -91,7 +91,7 @@ TFhirGenerateJWTOperation = class (TFhirNativeOperationR4) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function HandlesRequest(request : TFHIRRequest) : boolean; override; end; @@ -103,7 +103,7 @@ TFhirGraphFetchOperation = class (TFhirNativeOperationR4) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -115,7 +115,7 @@ TFhirGenerateCodeOperation = class (TFhirNativeOperationR4) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function HandlesRequest(request : TFHIRRequest) : boolean; override; end; @@ -128,7 +128,7 @@ TFhirHandleQAPostOperation = class (TFhirNativeOperationR4) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirQuestionnaireGenerationOperation = class (TFhirNativeOperationR4) @@ -139,7 +139,7 @@ TFhirQuestionnaireGenerationOperation = class (TFhirNativeOperationR4) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirEverythingOperation = class (TFhirNativeOperationR4) @@ -147,7 +147,7 @@ TFhirEverythingOperation = class (TFhirNativeOperationR4) function resourceName : String; virtual; abstract; function isPrimaryResource(request: TFHIRRequest; rtype, id : String) : boolean; virtual; public - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirPatientEverythingOperation = class (TFhirEverythingOperation) @@ -200,7 +200,7 @@ TFhirGenerateDocumentOperation = class (TFhirNativeOperationR4) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirValidationOperation = class (TFhirNativeOperationR4) @@ -211,7 +211,7 @@ TFhirValidationOperation = class (TFhirNativeOperationR4) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -223,7 +223,7 @@ TFhirProcessClaimOperation = class (TFhirNativeOperationR4) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirGenerateSnapshotOperation = class (TFhirNativeOperationR4) @@ -234,7 +234,7 @@ TFhirGenerateSnapshotOperation = class (TFhirNativeOperationR4) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirGenerateTemplateOperation = class (TFhirNativeOperationR4) @@ -245,7 +245,7 @@ TFhirGenerateTemplateOperation = class (TFhirNativeOperationR4) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirGenerateNarrativeOperation = class (TFhirNativeOperationR4) @@ -256,7 +256,7 @@ TFhirGenerateNarrativeOperation = class (TFhirNativeOperationR4) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirSuggestKeyWordsOperation = class (TFhirNativeOperationR4) @@ -267,7 +267,7 @@ TFhirSuggestKeyWordsOperation = class (TFhirNativeOperationR4) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirGetMetaDataOperation = class (TFhirNativeOperationR4) @@ -278,7 +278,7 @@ TFhirGetMetaDataOperation = class (TFhirNativeOperationR4) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -290,7 +290,7 @@ TFhirAddMetaDataOperation = class (TFhirNativeOperationR4) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -304,7 +304,7 @@ TFhirFeatureNegotiation = class (TFhirNativeOperationR4) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -316,7 +316,7 @@ TFhirDeleteMetaDataOperation = class (TFhirNativeOperationR4) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -328,7 +328,7 @@ TFhirDiffOperation = class (TFhirNativeOperationR4) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -340,7 +340,7 @@ TFhirConvertOperation = class (TFhirNativeOperationR4) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -352,7 +352,7 @@ TFhirTransformOperation = class (TFhirNativeOperationR4) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -366,7 +366,7 @@ TFhirObservationStatsOperation = class (TFhirNativeOperationR4) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -378,7 +378,7 @@ TFhirObservationLastNOperation = class (TFhirNativeOperationR4) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -390,7 +390,7 @@ TFhirHealthCardOperation = class (TFhirNativeOperationR4) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -923,7 +923,7 @@ function TFhirGenerateQAOperation.CreateDefinition(base : String): TFHIROperatio result := nil; end; -function TFhirGenerateQAOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateQAOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; begin result := '??qagen'; end; @@ -960,7 +960,7 @@ function TFhirGenerateJWTOperation.CreateDefinition(base : String): TFHIROperati result := nil; end; -function TFhirGenerateJWTOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateJWTOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var jwt : String; pIn : TFhirParameters; @@ -1040,7 +1040,7 @@ function TFhirGenerateCodeOperation.CreateDefinition(base : String): TFHIROperat result := nil; end; -function TFhirGenerateCodeOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateCodeOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var res : TFHIRResourceV; codegen : TFHIRCodeGenerator; @@ -1131,7 +1131,7 @@ function TFhirHandleQAPostOperation.CreateDefinition(base : String): TFHIROperat result := nil; end; -function TFhirHandleQAPostOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirHandleQAPostOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; begin result := '??qap'; end; @@ -1163,7 +1163,7 @@ function TFhirQuestionnaireGenerationOperation.CreateDefinition(base : String): result := nil; end; -function TFhirQuestionnaireGenerationOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirQuestionnaireGenerationOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var profile : TFHirStructureDefinition; op : TFHIROperationOutcomeW; @@ -1308,7 +1308,7 @@ function TFhirValidationOperation.CreateDefinition(base : String): TFHIROperatio result := nil; end; -function TFhirValidationOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirValidationOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; type TValidationOperationMode = (vomGeneral, vomCreate, vomUpdate, vomDelete); var @@ -1426,7 +1426,7 @@ function TFhirValidationOperation.isWrite: boolean; { TFhirEverythingOperation } -function TFhirEverythingOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirEverythingOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var bundle : TFHIRBundleBuilder; entry : TFHIRBundleEntryW; @@ -1566,7 +1566,7 @@ function TFhirProcessClaimOperation.CreateDefinition(base: String): TFHIROperati result := nil; end; -function TFhirProcessClaimOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirProcessClaimOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var resourceKey, versionKey : integer; params : TFhirParametersW; @@ -1664,7 +1664,7 @@ function TFhirGenerateSnapshotOperation.CreateDefinition(base: String): TFHIROpe result := nil; end; -function TFhirGenerateSnapshotOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateSnapshotOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var params : TFhirParameters; sdParam, sdBase : TFhirStructureDefinition; @@ -1778,7 +1778,7 @@ function TFhirGenerateTemplateOperation.CreateDefinition(base: String): TFHIROpe result := nil; end; -function TFhirGenerateTemplateOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateTemplateOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var profile : TFHirStructureDefinition; resourceKey, versionKey : integer; @@ -1881,7 +1881,7 @@ function TFhirGenerateNarrativeOperation.CreateDefinition(base: String): TFHIROp result := nil; end; -function TFhirGenerateNarrativeOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateNarrativeOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var narr : TFHIRNarrativeGenerator; r : TFHIRResourceV; @@ -1946,7 +1946,7 @@ function TFhirSuggestKeyWordsOperation.CreateDefinition(base: String): TFHIROper result := nil; end; -function TFhirSuggestKeyWordsOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirSuggestKeyWordsOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; begin result := '??key'; raise EFHIRException.CreateLang('NOT_DONE_YET', request.langList); @@ -1979,7 +1979,7 @@ function TFhirGetMetaDataOperation.CreateDefinition(base: String): TFHIROperatio result := nil end; -function TFhirGetMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGetMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var ok : boolean; meta : TFHIRMeta; @@ -2119,7 +2119,7 @@ function TFhirAddMetaDataOperation.CreateDefinition(base: String): TFHIROperatio result := nil; end; -function TFhirAddMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirAddMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var resourceKey : Integer; resourceVersionKey : Integer; @@ -2305,7 +2305,7 @@ function TFhirFeatureNegotiation.CreateDefinition(base: String): TFHIROperationD Result := nil; end; -function TFhirFeatureNegotiation.Execute(context: TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt: TTimeTracker): String; +function TFhirFeatureNegotiation.Execute(context: TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt: TFslTimeTracker): String; begin raise EFslException.create('not done yet'); end; @@ -2322,7 +2322,7 @@ function TFhirDeleteMetaDataOperation.CreateDefinition(base: String): TFHIROpera result := nil; end; -function TFhirDeleteMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirDeleteMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var resourceKey : Integer; resourceVersionKey : Integer; @@ -2493,7 +2493,7 @@ function TFhirDiffOperation.CreateDefinition(base: String): TFHIROperationDefini result := nil; end; -function TFhirDiffOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirDiffOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var resourceKey : Integer; versionKey : Integer; @@ -2588,7 +2588,7 @@ function TFhirConvertOperation.CreateDefinition(base: String): TFHIROperationDef result := nil; end; -function TFhirConvertOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirConvertOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; begin result := '??cnv'; try @@ -2665,7 +2665,7 @@ function TFhirObservationStatsOperation.CreateDefinition(base : String): TFHIROp result := nil; end; -function TFhirObservationStatsOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirObservationStatsOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var req : TFHIRStatsOpRequest; s : string; @@ -2779,7 +2779,7 @@ function TFhirObservationLastNOperation.CreateDefinition(base : String): TFHIROp result := nil; end; -function TFhirObservationLastNOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirObservationLastNOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var sp : TSearchProcessor; conn : TFDBConnection; @@ -3048,7 +3048,7 @@ function TFhirGraphFetchOperation.CreateDefinition(base : String): TFHIROperatio result := nil; end; -function TFhirGraphFetchOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGraphFetchOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var gd : TFHIRGraphDefinition; resourceKey, versionKey : integer; @@ -3292,7 +3292,7 @@ function TFhirGenerateDocumentOperation.CreateDefinition(base: String): TFHIROpe result := nil end; -function TFhirGenerateDocumentOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateDocumentOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var composition : TFhirComposition; bundle : TFHIRBundle; @@ -3454,7 +3454,7 @@ function TFhirTransformOperation.CreateDefinition(base: String): TFHIROperationD result := nil; end; -function TFhirTransformOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirTransformOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var params : TFHIRTransformOpRequest; rkey, versionKey : integer; @@ -3943,7 +3943,7 @@ function TFhirHealthCardOperation.CreateDefinition(base: String): TFHIROperation result := nil; end; -function TFhirHealthCardOperation.Execute(context: TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker): String; +function TFhirHealthCardOperation.Execute(context: TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker): String; var gen : THealthCardGenerator; p : TFhirParameters; diff --git a/server/operations_r4b.pas b/server/operations_r4b.pas index 3ec2cbabe..f9a494ff1 100644 --- a/server/operations_r4b.pas +++ b/server/operations_r4b.pas @@ -34,7 +34,7 @@ interface uses SysUtils, Classes, - fsl_base, fsl_utilities, fsl_json, fsl_lang, + fsl_base, fsl_utilities, fsl_json, fsl_lang, fsl_logging, fsl_http, fdb_manager, fhir_objects, fhir_factory, fhir_common, fhir_xhtml, fhir_validator, fhir_parser, fhir_utilities, fhir_uris, @@ -43,7 +43,7 @@ interface fhir_codegen, fhir_diff, fhir_healthcard, tx_operations, ftx_ucum_services, operations, - session, tags, storage, database, obsservation_stats, search, time_tracker, + session, tags, storage, database, obsservation_stats, search, bundlebuilder, validator_r4B, security, subscriptions, server_context, healthcard_generator; type @@ -79,7 +79,7 @@ TFhirGenerateQAOperation = class (TFhirNativeOperationR4B) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function HandlesRequest(request : TFHIRRequest) : boolean; override; end; @@ -91,7 +91,7 @@ TFhirGenerateJWTOperation = class (TFhirNativeOperationR4B) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function HandlesRequest(request : TFHIRRequest) : boolean; override; end; @@ -103,7 +103,7 @@ TFhirGraphFetchOperation = class (TFhirNativeOperationR4B) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -115,7 +115,7 @@ TFhirGenerateCodeOperation = class (TFhirNativeOperationR4B) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function HandlesRequest(request : TFHIRRequest) : boolean; override; end; @@ -128,7 +128,7 @@ TFhirHandleQAPostOperation = class (TFhirNativeOperationR4B) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirQuestionnaireGenerationOperation = class (TFhirNativeOperationR4B) @@ -139,7 +139,7 @@ TFhirQuestionnaireGenerationOperation = class (TFhirNativeOperationR4B) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirEverythingOperation = class (TFhirNativeOperationR4B) @@ -147,7 +147,7 @@ TFhirEverythingOperation = class (TFhirNativeOperationR4B) function resourceName : String; virtual; abstract; function isPrimaryResource(request: TFHIRRequest; rtype, id : String) : boolean; virtual; public - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirPatientEverythingOperation = class (TFhirEverythingOperation) @@ -200,7 +200,7 @@ TFhirGenerateDocumentOperation = class (TFhirNativeOperationR4B) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirValidationOperation = class (TFhirNativeOperationR4B) @@ -211,7 +211,7 @@ TFhirValidationOperation = class (TFhirNativeOperationR4B) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -223,7 +223,7 @@ TFhirProcessClaimOperation = class (TFhirNativeOperationR4B) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirGenerateSnapshotOperation = class (TFhirNativeOperationR4B) @@ -234,7 +234,7 @@ TFhirGenerateSnapshotOperation = class (TFhirNativeOperationR4B) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirGenerateTemplateOperation = class (TFhirNativeOperationR4B) @@ -245,7 +245,7 @@ TFhirGenerateTemplateOperation = class (TFhirNativeOperationR4B) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirGenerateNarrativeOperation = class (TFhirNativeOperationR4B) @@ -256,7 +256,7 @@ TFhirGenerateNarrativeOperation = class (TFhirNativeOperationR4B) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirSuggestKeyWordsOperation = class (TFhirNativeOperationR4B) @@ -267,7 +267,7 @@ TFhirSuggestKeyWordsOperation = class (TFhirNativeOperationR4B) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirGetMetaDataOperation = class (TFhirNativeOperationR4B) @@ -278,7 +278,7 @@ TFhirGetMetaDataOperation = class (TFhirNativeOperationR4B) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -290,7 +290,7 @@ TFhirAddMetaDataOperation = class (TFhirNativeOperationR4B) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -302,7 +302,7 @@ TFhirDeleteMetaDataOperation = class (TFhirNativeOperationR4B) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -314,7 +314,7 @@ TFhirDiffOperation = class (TFhirNativeOperationR4B) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -326,7 +326,7 @@ TFhirConvertOperation = class (TFhirNativeOperationR4B) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -338,7 +338,7 @@ TFhirTransformOperation = class (TFhirNativeOperationR4B) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -352,7 +352,7 @@ TFhirObservationStatsOperation = class (TFhirNativeOperationR4B) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -364,7 +364,7 @@ TFhirObservationLastNOperation = class (TFhirNativeOperationR4B) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -376,7 +376,7 @@ TFhirHealthCardOperation = class (TFhirNativeOperationR4B) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -908,7 +908,7 @@ function TFhirGenerateQAOperation.CreateDefinition(base : String): TFHIROperatio result := nil; end; -function TFhirGenerateQAOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateQAOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; begin result := '??qagen'; end; @@ -945,7 +945,7 @@ function TFhirGenerateJWTOperation.CreateDefinition(base : String): TFHIROperati result := nil; end; -function TFhirGenerateJWTOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateJWTOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var jwt : String; pIn : TFhirParameters; @@ -1025,7 +1025,7 @@ function TFhirGenerateCodeOperation.CreateDefinition(base : String): TFHIROperat result := nil; end; -function TFhirGenerateCodeOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateCodeOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var res : TFHIRResourceV; codegen : TFHIRCodeGenerator; @@ -1116,7 +1116,7 @@ function TFhirHandleQAPostOperation.CreateDefinition(base : String): TFHIROperat result := nil; end; -function TFhirHandleQAPostOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirHandleQAPostOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; begin result := '??qap'; end; @@ -1148,7 +1148,7 @@ function TFhirQuestionnaireGenerationOperation.CreateDefinition(base : String): result := nil; end; -function TFhirQuestionnaireGenerationOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirQuestionnaireGenerationOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var profile : TFHirStructureDefinition; op : TFHIROperationOutcomeW; @@ -1293,7 +1293,7 @@ function TFhirValidationOperation.CreateDefinition(base : String): TFHIROperatio result := nil; end; -function TFhirValidationOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirValidationOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; type TValidationOperationMode = (vomGeneral, vomCreate, vomUpdate, vomDelete); var @@ -1411,7 +1411,7 @@ function TFhirValidationOperation.isWrite: boolean; { TFhirEverythingOperation } -function TFhirEverythingOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirEverythingOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var bundle : TFHIRBundleBuilder; entry : TFHIRBundleEntryW; @@ -1551,7 +1551,7 @@ function TFhirProcessClaimOperation.CreateDefinition(base: String): TFHIROperati result := nil; end; -function TFhirProcessClaimOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirProcessClaimOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var resourceKey, versionKey : integer; params : TFhirParametersW; @@ -1649,7 +1649,7 @@ function TFhirGenerateSnapshotOperation.CreateDefinition(base: String): TFHIROpe result := nil; end; -function TFhirGenerateSnapshotOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateSnapshotOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var params : TFhirParameters; sdParam, sdBase : TFhirStructureDefinition; @@ -1763,7 +1763,7 @@ function TFhirGenerateTemplateOperation.CreateDefinition(base: String): TFHIROpe result := nil; end; -function TFhirGenerateTemplateOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateTemplateOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var profile : TFHirStructureDefinition; resourceKey, versionKey : integer; @@ -1866,7 +1866,7 @@ function TFhirGenerateNarrativeOperation.CreateDefinition(base: String): TFHIROp result := nil; end; -function TFhirGenerateNarrativeOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateNarrativeOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var narr : TFHIRNarrativeGenerator; r : TFHIRResourceV; @@ -1931,7 +1931,7 @@ function TFhirSuggestKeyWordsOperation.CreateDefinition(base: String): TFHIROper result := nil; end; -function TFhirSuggestKeyWordsOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirSuggestKeyWordsOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; begin result := '??key'; raise EFHIRException.CreateLang('NOT_DONE_YET', request.langList); @@ -1964,7 +1964,7 @@ function TFhirGetMetaDataOperation.CreateDefinition(base: String): TFHIROperatio result := nil end; -function TFhirGetMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGetMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var ok : boolean; meta : TFHIRMeta; @@ -2104,7 +2104,7 @@ function TFhirAddMetaDataOperation.CreateDefinition(base: String): TFHIROperatio result := nil; end; -function TFhirAddMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirAddMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var resourceKey : Integer; resourceVersionKey : Integer; @@ -2270,7 +2270,7 @@ function TFhirDeleteMetaDataOperation.CreateDefinition(base: String): TFHIROpera result := nil; end; -function TFhirDeleteMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirDeleteMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var resourceKey : Integer; resourceVersionKey : Integer; @@ -2441,7 +2441,7 @@ function TFhirDiffOperation.CreateDefinition(base: String): TFHIROperationDefini result := nil; end; -function TFhirDiffOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirDiffOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var resourceKey : Integer; versionKey : Integer; @@ -2536,7 +2536,7 @@ function TFhirConvertOperation.CreateDefinition(base: String): TFHIROperationDef result := nil; end; -function TFhirConvertOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirConvertOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; begin result := '??cnv'; try @@ -2613,7 +2613,7 @@ function TFhirObservationStatsOperation.CreateDefinition(base : String): TFHIROp result := nil; end; -function TFhirObservationStatsOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirObservationStatsOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var req : TFHIRStatsOpRequest; s : string; @@ -2727,7 +2727,7 @@ function TFhirObservationLastNOperation.CreateDefinition(base : String): TFHIROp result := nil; end; -function TFhirObservationLastNOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirObservationLastNOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var sp : TSearchProcessor; conn : TFDBConnection; @@ -2996,7 +2996,7 @@ function TFhirGraphFetchOperation.CreateDefinition(base : String): TFHIROperatio result := nil; end; -function TFhirGraphFetchOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGraphFetchOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var gd : TFHIRGraphDefinition; resourceKey, versionKey : integer; @@ -3240,7 +3240,7 @@ function TFhirGenerateDocumentOperation.CreateDefinition(base: String): TFHIROpe result := nil end; -function TFhirGenerateDocumentOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateDocumentOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var composition : TFhirComposition; bundle : TFHIRBundle; @@ -3402,7 +3402,7 @@ function TFhirTransformOperation.CreateDefinition(base: String): TFHIROperationD result := nil; end; -function TFhirTransformOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirTransformOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var params : TFHIRTransformOpRequest; rkey, versionKey : integer; @@ -3891,7 +3891,7 @@ function TFhirHealthCardOperation.CreateDefinition(base: String): TFHIROperation result := nil; end; -function TFhirHealthCardOperation.Execute(context: TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker): String; +function TFhirHealthCardOperation.Execute(context: TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker): String; var gen : THealthCardGenerator; p : TFhirParameters; diff --git a/server/operations_r5.pas b/server/operations_r5.pas index 2b6ac51c4..162a0f463 100644 --- a/server/operations_r5.pas +++ b/server/operations_r5.pas @@ -34,7 +34,7 @@ interface uses SysUtils, Classes, - fsl_base, fsl_utilities, fsl_json, fsl_lang, + fsl_base, fsl_utilities, fsl_json, fsl_lang, fsl_logging, fsl_http, fdb_manager, fhir_objects, fhir_factory, fhir_common, fhir_xhtml, fhir_validator, fhir_parser, fhir_utilities, fhir_uris, @@ -43,7 +43,7 @@ interface fhir_codegen, fhir_diff, fhir_features, tx_operations, ftx_ucum_services, operations, - session, tags, storage, database, obsservation_stats, search, time_tracker, + session, tags, storage, database, obsservation_stats, search, bundlebuilder, validator_r5, security, subscriptions, server_context; type @@ -76,7 +76,7 @@ TFhirGenerateQAOperation = class (TFhirNativeOperationR5) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function HandlesRequest(request : TFHIRRequest) : boolean; override; end; @@ -88,7 +88,7 @@ TFhirGenerateJWTOperation = class (TFhirNativeOperationR5) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function HandlesRequest(request : TFHIRRequest) : boolean; override; end; @@ -100,7 +100,7 @@ TFhirGraphFetchOperation = class (TFhirNativeOperationR5) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -112,7 +112,7 @@ TFhirGenerateCodeOperation = class (TFhirNativeOperationR5) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function HandlesRequest(request : TFHIRRequest) : boolean; override; end; @@ -125,7 +125,7 @@ TFhirHandleQAPostOperation = class (TFhirNativeOperationR5) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirQuestionnaireGenerationOperation = class (TFhirNativeOperationR5) @@ -136,7 +136,7 @@ TFhirQuestionnaireGenerationOperation = class (TFhirNativeOperationR5) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirEverythingOperation = class (TFhirNativeOperationR5) @@ -144,7 +144,7 @@ TFhirEverythingOperation = class (TFhirNativeOperationR5) function resourceName : String; virtual; abstract; function isPrimaryResource(request: TFHIRRequest; rtype, id : String) : boolean; virtual; public - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirPatientEverythingOperation = class (TFhirEverythingOperation) @@ -197,7 +197,7 @@ TFhirGenerateDocumentOperation = class (TFhirNativeOperationR5) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirValidationOperation = class (TFhirNativeOperationR5) @@ -208,7 +208,7 @@ TFhirValidationOperation = class (TFhirNativeOperationR5) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -220,7 +220,7 @@ TFhirProcessClaimOperation = class (TFhirNativeOperationR5) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirGenerateSnapshotOperation = class (TFhirNativeOperationR5) @@ -231,7 +231,7 @@ TFhirGenerateSnapshotOperation = class (TFhirNativeOperationR5) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirGenerateTemplateOperation = class (TFhirNativeOperationR5) @@ -242,7 +242,7 @@ TFhirGenerateTemplateOperation = class (TFhirNativeOperationR5) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirGenerateNarrativeOperation = class (TFhirNativeOperationR5) @@ -253,7 +253,7 @@ TFhirGenerateNarrativeOperation = class (TFhirNativeOperationR5) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirSuggestKeyWordsOperation = class (TFhirNativeOperationR5) @@ -264,7 +264,7 @@ TFhirSuggestKeyWordsOperation = class (TFhirNativeOperationR5) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; end; TFhirGetMetaDataOperation = class (TFhirNativeOperationR5) @@ -275,7 +275,7 @@ TFhirGetMetaDataOperation = class (TFhirNativeOperationR5) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -287,7 +287,7 @@ TFhirAddMetaDataOperation = class (TFhirNativeOperationR5) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -299,7 +299,7 @@ TFhirDeleteMetaDataOperation = class (TFhirNativeOperationR5) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -311,7 +311,7 @@ TFhirDiffOperation = class (TFhirNativeOperationR5) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -323,7 +323,7 @@ TFhirConvertOperation = class (TFhirNativeOperationR5) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -335,7 +335,7 @@ TFhirTransformOperation = class (TFhirNativeOperationR5) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -349,7 +349,7 @@ TFhirObservationStatsOperation = class (TFhirNativeOperationR5) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -361,7 +361,7 @@ TFhirObservationLastNOperation = class (TFhirNativeOperationR5) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -373,7 +373,7 @@ TFhirFeatureOperation = class (TFhirNativeOperationR5) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -873,7 +873,7 @@ function TFhirGenerateQAOperation.CreateDefinition(base : String): TFHIROperatio result := nil; end; -function TFhirGenerateQAOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateQAOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; begin result := '??qagen'; end; @@ -910,7 +910,7 @@ function TFhirGenerateJWTOperation.CreateDefinition(base : String): TFHIROperati result := nil; end; -function TFhirGenerateJWTOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateJWTOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var jwt : String; pIn : TFhirParameters; @@ -990,7 +990,7 @@ function TFhirGenerateCodeOperation.CreateDefinition(base : String): TFHIROperat result := nil; end; -function TFhirGenerateCodeOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateCodeOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var res : TFHIRResourceV; codegen : TFHIRCodeGenerator; @@ -1081,7 +1081,7 @@ function TFhirHandleQAPostOperation.CreateDefinition(base : String): TFHIROperat result := nil; end; -function TFhirHandleQAPostOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirHandleQAPostOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; begin result := '??qap'; end; @@ -1113,7 +1113,7 @@ function TFhirQuestionnaireGenerationOperation.CreateDefinition(base : String): result := nil; end; -function TFhirQuestionnaireGenerationOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirQuestionnaireGenerationOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var profile : TFHirStructureDefinition; op : TFHIROperationOutcomeW; @@ -1258,7 +1258,7 @@ function TFhirValidationOperation.CreateDefinition(base : String): TFHIROperatio result := nil; end; -function TFhirValidationOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirValidationOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; type TValidationOperationMode = (vomGeneral, vomCreate, vomUpdate, vomDelete); var @@ -1376,7 +1376,7 @@ function TFhirValidationOperation.isWrite: boolean; { TFhirEverythingOperation } -function TFhirEverythingOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirEverythingOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var bundle : TFHIRBundleBuilder; entry : TFHIRBundleEntryW; @@ -1516,7 +1516,7 @@ function TFhirProcessClaimOperation.CreateDefinition(base: String): TFHIROperati result := nil; end; -function TFhirProcessClaimOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirProcessClaimOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var resourceKey, versionKey : integer; params : TFhirParametersW; @@ -1614,7 +1614,7 @@ function TFhirGenerateSnapshotOperation.CreateDefinition(base: String): TFHIROpe result := nil; end; -function TFhirGenerateSnapshotOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateSnapshotOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var params : TFhirParameters; sdParam, sdBase : TFhirStructureDefinition; @@ -1728,7 +1728,7 @@ function TFhirGenerateTemplateOperation.CreateDefinition(base: String): TFHIROpe result := nil; end; -function TFhirGenerateTemplateOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateTemplateOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var profile : TFHirStructureDefinition; resourceKey, versionKey : integer; @@ -1831,7 +1831,7 @@ function TFhirGenerateNarrativeOperation.CreateDefinition(base: String): TFHIROp result := nil; end; -function TFhirGenerateNarrativeOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateNarrativeOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var narr : TFHIRNarrativeGenerator; r : TFHIRResourceV; @@ -1896,7 +1896,7 @@ function TFhirSuggestKeyWordsOperation.CreateDefinition(base: String): TFHIROper result := nil; end; -function TFhirSuggestKeyWordsOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirSuggestKeyWordsOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; begin result := '??key'; raise EFHIRException.CreateLang('NOT_DONE_YET', request.langList); @@ -1929,7 +1929,7 @@ function TFhirGetMetaDataOperation.CreateDefinition(base: String): TFHIROperatio result := nil end; -function TFhirGetMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGetMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var ok : boolean; meta : TFHIRMeta; @@ -2069,7 +2069,7 @@ function TFhirAddMetaDataOperation.CreateDefinition(base: String): TFHIROperatio result := nil; end; -function TFhirAddMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirAddMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var resourceKey : Integer; resourceVersionKey : Integer; @@ -2235,7 +2235,7 @@ function TFhirDeleteMetaDataOperation.CreateDefinition(base: String): TFHIROpera result := nil; end; -function TFhirDeleteMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirDeleteMetaDataOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var resourceKey : Integer; resourceVersionKey : Integer; @@ -2406,7 +2406,7 @@ function TFhirDiffOperation.CreateDefinition(base: String): TFHIROperationDefini result := nil; end; -function TFhirDiffOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirDiffOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var resourceKey : Integer; versionKey : Integer; @@ -2501,7 +2501,7 @@ function TFhirConvertOperation.CreateDefinition(base: String): TFHIROperationDef result := nil; end; -function TFhirConvertOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirConvertOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; begin result := '??cnv'; try @@ -2578,7 +2578,7 @@ function TFhirObservationStatsOperation.CreateDefinition(base : String): TFHIROp result := nil; end; -function TFhirObservationStatsOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirObservationStatsOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var req : TFHIRStatsOpRequest; s : string; @@ -2692,7 +2692,7 @@ function TFhirObservationLastNOperation.CreateDefinition(base : String): TFHIROp result := nil; end; -function TFhirObservationLastNOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirObservationLastNOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var sp : TSearchProcessor; conn : TFDBConnection; @@ -2961,7 +2961,7 @@ function TFhirGraphFetchOperation.CreateDefinition(base : String): TFHIROperatio result := nil; end; -function TFhirGraphFetchOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGraphFetchOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var gd : TFHIRGraphDefinition; resourceKey, versionKey : integer; @@ -3205,7 +3205,7 @@ function TFhirGenerateDocumentOperation.CreateDefinition(base: String): TFHIROpe result := nil end; -function TFhirGenerateDocumentOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirGenerateDocumentOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var composition : TFhirComposition; bundle : TFHIRBundle; @@ -3367,7 +3367,7 @@ function TFhirTransformOperation.CreateDefinition(base: String): TFHIROperationD result := nil; end; -function TFhirTransformOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirTransformOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var params : TFHIRTransformOpRequest; rkey, versionKey : integer; @@ -3849,7 +3849,7 @@ function TFhirFeatureOperation.CreateDefinition(base: String): TFHIROperationDef result := nil; end; -function TFhirFeatureOperation.Execute(context: TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker): String; +function TFhirFeatureOperation.Execute(context: TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker): String; var p : TFhirParameters; fl : TFslList; diff --git a/server/storage.pas b/server/storage.pas index d80ff820d..eaad007d9 100644 --- a/server/storage.pas +++ b/server/storage.pas @@ -42,7 +42,7 @@ interface fhir_client, fhir_cdshooks, session, fhir_indexing, fhir_graphql, fhir_features, - html_builder, subscriptions, utilities, server_constants, indexing, bundlebuilder, time_tracker, + html_builder, subscriptions, utilities, server_constants, indexing, bundlebuilder, client_cache_manager, tx_version; Type @@ -97,7 +97,7 @@ TFhirOperation = class abstract (TFslObject) function Types : TArray; virtual; function HandlesRequest(request : TFHIRRequest) : boolean; virtual; function CreateDefinition(base : String) : TFHIROperationDefinitionW; virtual; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; virtual; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; virtual; function formalURL : String; virtual; end; @@ -225,7 +225,7 @@ TFHIROperationEngine = class (TFslObject) function ExecuteValidation(request: TFHIRRequest; response : TFHIRResponse; opDesc : String) : boolean; virtual; function ExecuteTransaction(context : TOperationContext; request: TFHIRRequest; response : TFHIRResponse) : String; virtual; procedure ExecuteBatch(context : TOperationContext; request: TFHIRRequest; response : TFHIRResponse); virtual; - function ExecuteOperation(context : TOperationContext; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; virtual; + function ExecuteOperation(context : TOperationContext; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; virtual; procedure BuildSearchForm(request: TFHIRRequest; response: TFHIRResponse); public constructor Create(Storage : TFHIRStorageService; ServerContext : TFslObject; langList : THTTPLanguageList); @@ -246,7 +246,7 @@ TFHIROperationEngine = class (TFslObject) function opAllowed(resource : string; command : TFHIRCommandType) : Boolean; virtual; function check(response : TFHIRResponse; test : boolean; code : Integer; langList : THTTPLanguageList; message : String; issueCode : TFhirIssueType) : Boolean; virtual; - Function Execute(context : TOperationContext; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; virtual; + Function Execute(context : TOperationContext; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; virtual; function LookupReference(context : TFHIRRequest; id : String) : TResourceWithReference; virtual; abstract; function getResourcesByParam(aType : string; name, value : string; var needSecure : boolean): TFslList; virtual; function FindResource(aType, sId : String; options : TFindResourceOptions; var resourceKey, versionKey : integer; request: TFHIRRequest; response: TFHIRResponse; sessionCompartments : TFslList): boolean; virtual; @@ -731,7 +731,7 @@ procedure TFHIROperationEngine.deadCheck(start : UInt64); end; -function TFHIROperationEngine.Execute(context: TOperationContext; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker): String; +function TFHIROperationEngine.Execute(context: TOperationContext; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker): String; begin InterlockedIncrement(GCounterFHIRRequests); try @@ -1174,7 +1174,7 @@ procedure TFHIROperationEngine.ExecuteHistory(request: TFHIRRequest; response: T raise EFHIRException.Create('This server does not implement the "History" function'); end; -function TFHIROperationEngine.ExecuteOperation(context: TOperationContext; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFHIROperationEngine.ExecuteOperation(context: TOperationContext; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var i : integer; op : TFhirOperation; @@ -1825,7 +1825,7 @@ destructor TFhirOperation.Destroy; inherited; end; -function TFhirOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; begin result := ''; // nothing diff --git a/server/tests/tests_cpt.pas b/server/tests/tests_cpt.pas index aacce21cd..e66785984 100644 --- a/server/tests/tests_cpt.pas +++ b/server/tests/tests_cpt.pas @@ -108,10 +108,10 @@ procedure TCPTTests.TestCode; ctxt : TCodeSystemProviderContext; msg : String; begin - ctxt := FCPT.locate('99202', nil, msg); + ctxt := FCPT.locate(nil, '99202', nil, msg); try assertTrue(ctxt <> nil); - assertEqual('Office or other outpatient visit for the evaluation and management of a new patient, which '+'requires a medically appropriate history and/or examination and straightforward medical decision making. When using time for code selection, 15-29 minutes of total time is spent on the date of the encounter.', FCPT.Display(ctxt, nil)); + assertEqual('Office or other outpatient visit for the evaluation and management of a new patient, which '+'requires a medically appropriate history and/or examination and straightforward medical decision making. When using time for code selection, 15-29 minutes of total time is spent on the date of the encounter.', FCPT.Display(nil, ctxt, nil)); finally ctxt.free; end; @@ -123,7 +123,7 @@ procedure TCPTTests.TestCodeX; ctxt : TCodeSystemProviderContext; msg : String; begin - ctxt := FCPT.locate('99201', nil, msg); + ctxt := FCPT.locate(nil, '99201', nil, msg); try assertTrue(ctxt = nil); assertTrue(msg <> ''); @@ -137,10 +137,10 @@ procedure TCPTTests.TestCodeMod; ctxt : TCodeSystemProviderContext; msg : String; begin - ctxt := FCPT.locate('99202:P1', nil, msg); + ctxt := FCPT.locate(nil, '99202:P1', nil, msg); try assertTrue(ctxt <> nil); - assertEqual('', FCPT.Display(ctxt, nil)); + assertEqual('', FCPT.Display(nil, ctxt, nil)); finally ctxt.free; end; @@ -151,7 +151,7 @@ procedure TCPTTests.TestCodeModX1; ctxt : TCodeSystemProviderContext; msg : String; begin - ctxt := FCPT.locate('99202:P1-P1', nil, msg); + ctxt := FCPT.locate(nil, '99202:P1-P1', nil, msg); try assertTrue(ctxt = nil); assertTrue(msg <> ''); @@ -166,13 +166,13 @@ procedure TCPTTests.TestIterator; c : TCodeSystemProviderContext; s : String; begin - iter := FCPT.getIterator(nil); + iter := FCPT.getIterator(nil, nil); try while iter.more do begin - c := FCPT.getNextContext(iter); + c := FCPT.getNextContext(nil, iter); try - s := FCPT.code(c); + s := FCPT.code(nil, c); AssertTrue(StringArrayExists(['metadata-kinds', 'metadata-designations', '99202', '99203', '0001A', '99252', '25', '95', 'P1', '1P', 'F1'], s), 'Unexpected code '+s); finally c.free; @@ -191,17 +191,17 @@ procedure TCPTTests.TestModifierFilter; s, msg, log : String; begin log := ''; - filter := FCPT.filter(true, true, 'modifier', foEqual, 'true', nil); + filter := FCPT.filter(nil, true, true, 'modifier', foEqual, 'true', nil); try AssertTrue(filter <> nil); - AssertFalse(FCPT.isNotClosed(nil, filter)); + AssertFalse(FCPT.isNotClosed(nil, nil, filter)); c := 0; - while FCPT.FilterMore(filter) do + while FCPT.FilterMore(nil, filter) do begin inc(c); - ctxt := FCPT.FilterConcept(filter); + ctxt := FCPT.FilterConcept(nil, filter); try - s := FCPT.code(ctxt); + s := FCPT.code(nil, ctxt); CommaAdd(log, s); AssertTrue(StringArrayExists(['25', '95', 'P1', '1P', 'F1'], s), 'Unexpected code '+s); finally @@ -209,21 +209,21 @@ procedure TCPTTests.TestModifierFilter; end; end; AssertEqual(5, c, 'only found '+log); - ctxt := FCPT.locate('99202', nil, msg); + ctxt := FCPT.locate(nil, '99202', nil, msg); try - AssertFalse(FCPT.inFilter(filter, ctxt)); + AssertFalse(FCPT.inFilter(nil, filter, ctxt)); finally ctxt.free; end; - ctxt := FCPT.locate('P1', nil, msg); + ctxt := FCPT.locate(nil, 'P1', nil, msg); try - AssertTrue(FCPT.inFilter(filter, ctxt)); + AssertTrue(FCPT.inFilter(nil, filter, ctxt)); finally ctxt.free; end; - ctxt := FCPT.locate('99202:P1', nil, msg); + ctxt := FCPT.locate(nil, '99202:P1', nil, msg); try - AssertFalse(FCPT.inFilter(filter, ctxt)); + AssertFalse(FCPT.inFilter(nil, filter, ctxt)); finally ctxt.free; end; @@ -240,17 +240,17 @@ procedure TCPTTests.TestBaseFilter; s, msg, log : String; begin log := ''; - filter := FCPT.filter(true, true, 'modifier', foEqual, 'false', nil); + filter := FCPT.filter(nil, true, true, 'modifier', foEqual, 'false', nil); try AssertTrue(filter <> Nil); - AssertFalse(FCPT.isNotClosed(nil, filter)); + AssertFalse(FCPT.isNotClosed(nil, nil, filter)); c := 0; - while FCPT.FilterMore(filter) do + while FCPT.FilterMore(nil, filter) do begin inc(c); - ctxt := FCPT.FilterConcept(filter); + ctxt := FCPT.FilterConcept(nil, filter); try - s := FCPT.code(ctxt); + s := FCPT.code(nil, ctxt); CommaAdd(log, s); AssertTrue(StringArrayExists(['99202', '99203', '0001A', '99252'], s), 'Unexpected code '+s); finally @@ -258,21 +258,21 @@ procedure TCPTTests.TestBaseFilter; end; end; AssertEqual(4, c, 'only found '+log); - ctxt := FCPT.locate('99202', nil, msg); + ctxt := FCPT.locate(nil, '99202', nil, msg); try - AssertTrue(FCPT.inFilter(filter, ctxt)); + AssertTrue(FCPT.inFilter(nil, filter, ctxt)); finally ctxt.free; end; - ctxt := FCPT.locate('P1', nil, msg); + ctxt := FCPT.locate(nil, 'P1', nil, msg); try - AssertFalse(FCPT.inFilter(filter, ctxt)); + AssertFalse(FCPT.inFilter(nil, filter, ctxt)); finally ctxt.free; end; - ctxt := FCPT.locate('99202:P1', nil, msg); + ctxt := FCPT.locate(nil, '99202:P1', nil, msg); try - AssertFalse(FCPT.inFilter(filter, ctxt)); + AssertFalse(FCPT.inFilter(nil, filter, ctxt)); finally ctxt.free; end; @@ -289,17 +289,17 @@ procedure TCPTTests.TestUnModifiedFilter; s, msg, log : String; begin log := ''; - filter := FCPT.filter(true, true, 'modified', foEqual, 'false', nil); + filter := FCPT.filter(nil, true, true, 'modified', foEqual, 'false', nil); try AssertTrue(filter <> nil); - AssertFalse(FCPT.isNotClosed(nil, filter)); + AssertFalse(FCPT.isNotClosed(nil, nil, filter)); c := 0; - while FCPT.FilterMore(filter) do + while FCPT.FilterMore(nil, filter) do begin inc(c); - ctxt := FCPT.FilterConcept(filter); + ctxt := FCPT.FilterConcept(nil, filter); try - s := FCPT.code(ctxt); + s := FCPT.code(nil, ctxt); CommaAdd(log, s); AssertTrue(StringArrayExists(['99202', '99203', '0001A', '99252', '25', 'P1', '1P', 'F1', '95'], s), 'Unexpected code '+s); finally @@ -307,21 +307,21 @@ procedure TCPTTests.TestUnModifiedFilter; end; end; AssertEqual(9, c, 'only found '+log); - ctxt := FCPT.locate('99202', nil, msg); + ctxt := FCPT.locate(nil, '99202', nil, msg); try - AssertTrue(FCPT.inFilter(filter, ctxt)); + AssertTrue(FCPT.inFilter(nil, filter, ctxt)); finally ctxt.free; end; - ctxt := FCPT.locate('P1', nil, msg); + ctxt := FCPT.locate(nil, 'P1', nil, msg); try - AssertTrue(FCPT.inFilter(filter, ctxt)); + AssertTrue(FCPT.inFilter(nil, filter, ctxt)); finally ctxt.free; end; - ctxt := FCPT.locate('99202:P1', nil, msg); + ctxt := FCPT.locate(nil, '99202:P1', nil, msg); try - AssertFalse(FCPT.inFilter(filter, ctxt)); + AssertFalse(FCPT.inFilter(nil, filter, ctxt)); finally ctxt.free; end; @@ -337,29 +337,29 @@ procedure TCPTTests.TestModifiedFilter; c : integer; s, msg : String; begin - filter := FCPT.filter(true, true, 'modified', foEqual, 'true', nil); + filter := FCPT.filter(nil, true, true, 'modified', foEqual, 'true', nil); try AssertTrue(filter <> nil); - AssertTrue(FCPT.isNotClosed(nil, filter)); + AssertTrue(FCPT.isNotClosed(nil, nil, filter)); c := 0; - while FCPT.FilterMore(filter) do + while FCPT.FilterMore(nil, filter) do inc(c); AssertEqual(0, c); - ctxt := FCPT.locate('99202', nil, msg); + ctxt := FCPT.locate(nil, '99202', nil, msg); try - AssertFalse(FCPT.inFilter(filter, ctxt)); + AssertFalse(FCPT.inFilter(nil, filter, ctxt)); finally ctxt.free; end; - ctxt := FCPT.locate('P1', nil, msg); + ctxt := FCPT.locate(nil, 'P1', nil, msg); try - AssertFalse(FCPT.inFilter(filter, ctxt)); + AssertFalse(FCPT.inFilter(nil, filter, ctxt)); finally ctxt.free; end; - ctxt := FCPT.locate('99202:P1', nil, msg); + ctxt := FCPT.locate(nil, '99202:P1', nil, msg); try - AssertTrue(FCPT.inFilter(filter, ctxt)); + AssertTrue(FCPT.inFilter(nil, filter, ctxt)); finally ctxt.free; end; @@ -377,17 +377,17 @@ procedure TCPTTests.TestKindFilter; s, msg, log: String; begin log := ''; - filter := FCPT.filter(true, true, 'kind', foEqual, 'code', nil); + filter := FCPT.filter(nil, true, true, 'kind', foEqual, 'code', nil); try AssertTrue(filter <> nil); - AssertFalse(FCPT.isNotClosed(nil, filter)); + AssertFalse(FCPT.isNotClosed(nil, nil, filter)); c := 0; - while FCPT.FilterMore(filter) do + while FCPT.FilterMore(nil, filter) do begin inc(c); - ctxt := FCPT.FilterConcept(filter); + ctxt := FCPT.FilterConcept(nil, filter); try - s := FCPT.code(ctxt); + s := FCPT.code(nil, ctxt); CommaAdd(log, s); AssertTrue(StringArrayExists(['99202', '99203', '99252'], s), 'Unexpected code '+s); finally @@ -395,21 +395,21 @@ procedure TCPTTests.TestKindFilter; end; end; AssertEqual(3, c, 'only found '+log); - ctxt := FCPT.locate('99202', nil, msg); + ctxt := FCPT.locate(nil, '99202', nil, msg); try - AssertTrue(FCPT.inFilter(filter, ctxt)); + AssertTrue(FCPT.inFilter(nil, filter, ctxt)); finally ctxt.free; end; - ctxt := FCPT.locate('P1', nil, msg); + ctxt := FCPT.locate(nil, 'P1', nil, msg); try - AssertFalse(FCPT.inFilter(filter, ctxt)); + AssertFalse(FCPT.inFilter(nil, filter, ctxt)); finally ctxt.free; end; - ctxt := FCPT.locate('99202:P1', nil, msg); + ctxt := FCPT.locate(nil, '99202:P1', nil, msg); try - AssertFalse(FCPT.inFilter(filter, ctxt)); + AssertFalse(FCPT.inFilter(nil, filter, ctxt)); finally ctxt.free; end; @@ -423,11 +423,11 @@ procedure TCPTTests.TestExpression1; ctxt : TCodeSystemProviderContext; msg : String; begin - ctxt := FCPT.locate('99202:25', nil, msg); + ctxt := FCPT.locate(nil, '99202:25', nil, msg); try assertTrue(ctxt <> nil); assertTrue(msg = ''); - assertEqual('', FCPT.Display(ctxt, nil)); + assertEqual('', FCPT.Display(nil, ctxt, nil)); finally ctxt.free; end; @@ -438,11 +438,11 @@ procedure TCPTTests.TestExpression2; ctxt : TCodeSystemProviderContext; msg : String; begin - ctxt := FCPT.locate('99252:95', nil, msg); + ctxt := FCPT.locate(nil, '99252:95', nil, msg); try assertTrue(ctxt = nil); assertEqual('The modifier 95 cannot be used with the code 99252 as it is not designated for telemedicine', msg); - assertEqual('', FCPT.Display(ctxt, nil)); + assertEqual('', FCPT.Display(nil, ctxt, nil)); finally ctxt.free; end; diff --git a/server/time_tracker.pas b/server/time_tracker.pas deleted file mode 100644 index 5e0603b0a..000000000 --- a/server/time_tracker.pas +++ /dev/null @@ -1,96 +0,0 @@ -unit time_tracker; - -{ -Copyright (c) 2001-2021, Health Intersections Pty Ltd (http://www.healthintersections.com.au) -All rights reserved. - -Redistribution and use in source and binary forms, with or without modification, -are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright notice, this - list of conditions and the following disclaimer. - * Redistributions in binary form must reproduce the above copyright notice, - this list of conditions and the following disclaimer in the documentation - and/or other materials provided with the distribution. - * Neither the name of HL7 nor the names of its contributors may be used to - endorse or promote products derived from this software without specific - prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND -ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. -IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, -INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT -NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -POSSIBILITY OF SUCH DAMAGE. -} - -{$i fhir.inc} - -interface - -uses - SysUtils, Classes, - fsl_base, fsl_utilities, fsl_logging; - -type - TTimeTracker = class (TFslObject) - private - FStart : int64; - FLast : Int64; -// FPoints : TStringList; - public - constructor Create; override; - destructor Destroy; override; - - procedure step(name : String); - function total : integer; - function log : String; - end; - -implementation - -{ TTimeTracker } - -constructor TTimeTracker.Create; -begin - inherited; - FStart := GetTickCount64; - FLast := FStart; -// FPoints := TStringList.Create; -end; - -destructor TTimeTracker.Destroy; -begin -// FPoints.free; - inherited; -end; - -function TTimeTracker.log : String; -var - s : String; -begin - result := ''; -// for s in FPoints do -// CommaAdd(result, s); -// Logging.log('~~~ '+v); -end; - -procedure TTimeTracker.step(name: String); -var - t : int64; -begin - t := GetTickCount64; -// FPoints.Add(name+': '+StringPadLeft(inttostr(t - FLast), ' ', 5)); - FLast := t; -end; - -function TTimeTracker.total: integer; -begin - result := GetTickCount64 - FStart; -end; - -end. diff --git a/server/tx/tx_acir.pas b/server/tx/tx_acir.pas index 549da4312..b7b3a2ff0 100644 --- a/server/tx/tx_acir.pas +++ b/server/tx/tx_acir.pas @@ -81,36 +81,36 @@ TACIRServices = class (TCodeSystemProvider) function description : String; override; function TotalCount : integer; override; - function getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; - function getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; + function getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; + function getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; function systemUri : String; override; function version : String; override; function name(context : TCodeSystemProviderContext) : String; override; - function getDisplay(code : String; langList : THTTPLanguageList):String; override; - function getDefinition(code : String):String; override; - function locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; - function locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; - function IsAbstract(context : TCodeSystemProviderContext) : boolean; override; - function Code(context : TCodeSystemProviderContext) : string; override; - function Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; - procedure Designations(context : TCodeSystemProviderContext; list : TConceptDesignations); override; - function Definition(context : TCodeSystemProviderContext) : string; override; - - function getPrepContext : TCodeSystemProviderFilterPreparationContext; override; - function prepare(prep : TCodeSystemProviderFilterPreparationContext) : boolean; override; - - function searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; - function filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; - function filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; - function FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; override; - function filterSize(ctxt : TCodeSystemProviderFilterContext) : integer; override; - function FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; - function InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; - function isNotClosed(textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; - - function subsumesTest(codeA, codeB : String) : String; override; - - procedure defineFeatures(features : TFslList); override; + function getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; override; + function getDefinition(opContext : TTxOperationContext; code : String):String; override; + function locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; + function locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; + function IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; override; + function Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + function Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; + procedure Designations(opContext : TTxOperationContext; context : TCodeSystemProviderContext; list : TConceptDesignations); override; + function Definition(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + + function getPrepContext(opContext : TTxOperationContext) : TCodeSystemProviderFilterPreparationContext; override; + function prepare(opContext : TTxOperationContext; prep : TCodeSystemProviderFilterPreparationContext) : boolean; override; + + function searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; + function filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; + function filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; + function FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; override; + function filterSize(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : integer; override; + function FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; + function InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; + function isNotClosed(opContext : TTxOperationContext; textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; + + function subsumesTest(opContext : TTxOperationContext; codeA, codeB : String) : String; override; + + procedure defineFeatures(opContext : TTxOperationContext; features : TFslList); override; end; implementation @@ -128,7 +128,7 @@ constructor TACIRServices.Create(languages: TIETFLanguageDefinitions; i18n : TI1 end; -procedure TACIRServices.defineFeatures(features: TFslList); +procedure TACIRServices.defineFeatures(opContext : TTxOperationContext; features: TFslList); begin end; @@ -148,17 +148,17 @@ function TACIRServices.systemUri : String; result := 'urn:oid:1.2.36.1.2001.1005.17'; end; -function TACIRServices.getDefinition(code: String): String; +function TACIRServices.getDefinition(opContext : TTxOperationContext; code: String): String; begin result := FMap[code].definition; end; -function TACIRServices.getDisplay(code : String; langList : THTTPLanguageList):String; +function TACIRServices.getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; begin result := FMap[code].display.Trim; end; -function TACIRServices.getPrepContext: TCodeSystemProviderFilterPreparationContext; +function TACIRServices.getPrepContext(opContext : TTxOperationContext): TCodeSystemProviderFilterPreparationContext; begin result := nil; end; @@ -245,18 +245,18 @@ procedure TACIRServices.load; FMap.AddOrSetValue(c.code, c.link); end; -function TACIRServices.locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; +function TACIRServices.locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; begin result := FMap[code].link; end; -function TACIRServices.Code(context : TCodeSystemProviderContext) : string; +function TACIRServices.Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; begin result := TACIRConcept(context).FCode; end; -function TACIRServices.Definition(context: TCodeSystemProviderContext): string; +function TACIRServices.Definition(opContext : TTxOperationContext; context: TCodeSystemProviderContext): string; begin result := ''; end; @@ -273,22 +273,22 @@ destructor TACIRServices.Destroy; inherited; end; -function TACIRServices.Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; +function TACIRServices.Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; begin result := TACIRConcept(context).Display.Trim; end; -procedure TACIRServices.Designations(context: TCodeSystemProviderContext; list: TConceptDesignations); +procedure TACIRServices.Designations(opContext : TTxOperationContext; context: TCodeSystemProviderContext; list: TConceptDesignations); begin - list.addDesignation(true, true, '', Display(context, nil)); + list.addDesignation(true, true, '', Display(opContext, context, nil)); end; -function TACIRServices.IsAbstract(context : TCodeSystemProviderContext) : boolean; +function TACIRServices.IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; begin result := false; // ACIR doesn't do abstract end; -function TACIRServices.isNotClosed(textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; +function TACIRServices.isNotClosed(opContext : TTxOperationContext; textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; begin result := false; end; @@ -298,7 +298,7 @@ function TACIRServices.Link: TACIRServices; result := TACIRServices(Inherited Link); end; -function TACIRServices.getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; +function TACIRServices.getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; begin if context = nil then result := TCodeSystemIteratorContext.Create(nil, totalcount) @@ -306,13 +306,13 @@ function TACIRServices.getIterator(context : TCodeSystemProviderContext) : TCode result := TCodeSystemIteratorContext.Create(nil, 0); // no children end; -function TACIRServices.getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; +function TACIRServices.getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; begin result := FList[context.current].link; context.next; end; -function TACIRServices.locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; +function TACIRServices.locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; begin raise ETerminologySetup.Create('locateIsA not supported by ACIR'); // ACIR doesn't have formal subsumption property, so this is not used end; @@ -323,47 +323,47 @@ function TACIRServices.name(context: TCodeSystemProviderContext): String; result := 'ACIR'; end; -function TACIRServices.prepare(prep : TCodeSystemProviderFilterPreparationContext) : boolean; +function TACIRServices.prepare(opContext : TTxOperationContext; prep : TCodeSystemProviderFilterPreparationContext) : boolean; begin raise ETerminologyTodo.Create('TACIRServices.prepare'); end; -function TACIRServices.searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; +function TACIRServices.searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; begin raise ETerminologyTodo.Create('TACIRServices.searchFilter'); end; -function TACIRServices.subsumesTest(codeA, codeB: String): String; +function TACIRServices.subsumesTest(opContext : TTxOperationContext; codeA, codeB: String): String; begin result := 'not-subsumed'; end; -function TACIRServices.filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; +function TACIRServices.filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; begin raise ETerminologyTodo.Create('TACIRServices.filter'); end; -function TACIRServices.filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; +function TACIRServices.filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; begin raise ETerminologyTodo.Create('TACIRServices.filterLocate'); end; -function TACIRServices.FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; +function TACIRServices.FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; begin raise ETerminologyTodo.Create('TACIRServices.FilterMore'); end; -function TACIRServices.filterSize(ctxt: TCodeSystemProviderFilterContext): integer; +function TACIRServices.filterSize(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): integer; begin raise ETerminologyTodo.Create('TACIRServices.FilterMore'); end; -function TACIRServices.FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; +function TACIRServices.FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; begin raise ETerminologyTodo.Create('TACIRServices.FilterConcept'); end; -function TACIRServices.InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; +function TACIRServices.InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; begin raise ETerminologyTodo.Create('TACIRServices.InFilter'); end; diff --git a/server/tx/tx_areacode.pas b/server/tx/tx_areacode.pas index 25b6da930..037089b52 100644 --- a/server/tx/tx_areacode.pas +++ b/server/tx/tx_areacode.pas @@ -77,32 +77,32 @@ TAreaCodeServices = class (TCodeSystemProvider) function description : String; override; function TotalCount : integer; override; - function getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; - function getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; + function getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; + function getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; function systemUri : String; override; - function getDisplay(code : String; langList : THTTPLanguageList):String; override; - function getDefinition(code : String):String; override; - function locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; - function locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; - function IsAbstract(context : TCodeSystemProviderContext) : boolean; override; - function Code(context : TCodeSystemProviderContext) : string; override; - function Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; - procedure Designations(context : TCodeSystemProviderContext; list : TConceptDesignations); override; - function Definition(context : TCodeSystemProviderContext) : string; override; - - function getPrepContext : TCodeSystemProviderFilterPreparationContext; override; - function prepare(prep : TCodeSystemProviderFilterPreparationContext) : boolean; override; - - function searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; - function filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; - function filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; - function FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; override; - function filterSize(ctxt : TCodeSystemProviderFilterContext) : integer; override; - function FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; - function InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; - function isNotClosed(textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; - function subsumesTest(codeA, codeB : String) : String; override; - procedure defineFeatures(features : TFslList); override; + function getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; override; + function getDefinition(opContext : TTxOperationContext; code : String):String; override; + function locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; + function locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; + function IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; override; + function Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + function Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; + procedure Designations(opContext : TTxOperationContext; context : TCodeSystemProviderContext; list : TConceptDesignations); override; + function Definition(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + + function getPrepContext(opContext : TTxOperationContext) : TCodeSystemProviderFilterPreparationContext; override; + function prepare(opContext : TTxOperationContext; prep : TCodeSystemProviderFilterPreparationContext) : boolean; override; + + function searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; + function filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; + function filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; + function FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; override; + function filterSize(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : integer; override; + function FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; + function InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; + function isNotClosed(opContext : TTxOperationContext; textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; + function subsumesTest(opContext : TTxOperationContext; codeA, codeB : String) : String; override; + procedure defineFeatures(opContext : TTxOperationContext; features : TFslList); override; end; implementation @@ -119,7 +119,7 @@ constructor TAreaCodeServices.Create(languages: TIETFLanguageDefinitions; i18n : end; -procedure TAreaCodeServices.defineFeatures(features: TFslList); +procedure TAreaCodeServices.defineFeatures(opContext : TTxOperationContext; features: TFslList); begin features.Add(TFHIRFeature.fromString('rest.Codesystem:'+systemUri+'.filter', 'type:equals')); features.Add(TFHIRFeature.fromString('rest.Codesystem:'+systemUri+'.filter', 'type:equals')); @@ -136,12 +136,12 @@ function TAreaCodeServices.systemUri : String; result := 'http://unstats.un.org/unsd/methods/m49/m49.htm'; end; -function TAreaCodeServices.getDefinition(code: String): String; +function TAreaCodeServices.getDefinition(opContext : TTxOperationContext; code: String): String; begin result := ''; end; -function TAreaCodeServices.getDisplay(code : String; langList : THTTPLanguageList):String; +function TAreaCodeServices.getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; var v : TAreaCodeConcept; begin @@ -152,7 +152,7 @@ function TAreaCodeServices.getDisplay(code : String; langList : THTTPLanguageLis result := v.display; end; -function TAreaCodeServices.getPrepContext: TCodeSystemProviderFilterPreparationContext; +function TAreaCodeServices.getPrepContext(opContext : TTxOperationContext): TCodeSystemProviderFilterPreparationContext; begin result := nil; end; @@ -450,18 +450,18 @@ c.class_ := class_; doload('061', 'Polynesia', '', 'region'); end; -function TAreaCodeServices.locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; +function TAreaCodeServices.locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; begin result := FMap[code].link; end; -function TAreaCodeServices.Code(context : TCodeSystemProviderContext) : string; +function TAreaCodeServices.Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; begin result := TAreaCodeConcept(context).code; end; -function TAreaCodeServices.Definition(context: TCodeSystemProviderContext): string; +function TAreaCodeServices.Definition(opContext : TTxOperationContext; context: TCodeSystemProviderContext): string; begin result := ''; end; @@ -478,22 +478,22 @@ destructor TAreaCodeServices.Destroy; inherited; end; -function TAreaCodeServices.Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; +function TAreaCodeServices.Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; begin result := TAreaCodeConcept(context).display; end; -procedure TAreaCodeServices.Designations(context: TCodeSystemProviderContext; list: TConceptDesignations); +procedure TAreaCodeServices.Designations(opContext : TTxOperationContext; context: TCodeSystemProviderContext; list: TConceptDesignations); begin - list.addDesignation(true, true, '', Display(context, nil)); + list.addDesignation(true, true, '', Display(opContext, context, nil)); end; -function TAreaCodeServices.IsAbstract(context : TCodeSystemProviderContext) : boolean; +function TAreaCodeServices.IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; begin result := false; // AreaCode doesn't do abstract end; -function TAreaCodeServices.isNotClosed(textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; +function TAreaCodeServices.isNotClosed(opContext : TTxOperationContext; textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; begin result := false; end; @@ -503,7 +503,7 @@ function TAreaCodeServices.Link: TAreaCodeServices; result := TAreaCodeServices(Inherited Link); end; -function TAreaCodeServices.getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; +function TAreaCodeServices.getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; begin if (context = nil) then result := TCodeSystemIteratorContext.Create(nil, TotalCount) @@ -511,35 +511,35 @@ function TAreaCodeServices.getIterator(context : TCodeSystemProviderContext) : T result := TCodeSystemIteratorContext.Create(nil, 0); // no children end; -function TAreaCodeServices.getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; +function TAreaCodeServices.getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; begin result := FCodes[context.current].link; context.next; end; -function TAreaCodeServices.locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; +function TAreaCodeServices.locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; begin raise ETerminologyError.Create('locateIsA not supported by AreaCode', itNotSupported); // AreaCode doesn't have formal subsumption property, so this is not used end; -function TAreaCodeServices.prepare(prep : TCodeSystemProviderFilterPreparationContext) : boolean; +function TAreaCodeServices.prepare(opContext : TTxOperationContext; prep : TCodeSystemProviderFilterPreparationContext) : boolean; begin // nothing result := false; end; -function TAreaCodeServices.searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; +function TAreaCodeServices.searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; begin raise ETerminologyTodo.Create('TAreaCodeServices.searchFilter'); end; -function TAreaCodeServices.subsumesTest(codeA, codeB: String): String; +function TAreaCodeServices.subsumesTest(opContext : TTxOperationContext; codeA, codeB: String): String; begin result := 'not-subsumed'; end; -function TAreaCodeServices.filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; +function TAreaCodeServices.filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; var res : TAreaCodeConceptFilter; c : TAreaCodeConcept; @@ -560,7 +560,7 @@ function TAreaCodeServices.filter(forExpansion, forIteration : boolean; prop : S raise ETerminologyError.Create('the filter '+prop+' '+CODES_TFhirFilterOperator[op]+' = '+value+' is not supported for '+systemUri, itNotSupported); end; -function TAreaCodeServices.filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; +function TAreaCodeServices.filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; var filter : TAreaCodeConceptFilter; c : TAreaCodeConcept; @@ -572,23 +572,23 @@ function TAreaCodeServices.filterLocate(ctxt : TCodeSystemProviderFilterContext; exit(c.link); end; -function TAreaCodeServices.FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; +function TAreaCodeServices.FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; begin TAreaCodeConceptFilter(ctxt).FCursor := TAreaCodeConceptFilter(ctxt).FCursor + 1; result := TAreaCodeConceptFilter(ctxt).FCursor < TAreaCodeConceptFilter(ctxt).FList.Count; end; -function TAreaCodeServices.filterSize(ctxt: TCodeSystemProviderFilterContext): integer; +function TAreaCodeServices.filterSize(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): integer; begin result := TAreaCodeConceptFilter(ctxt).FList.Count; end; -function TAreaCodeServices.FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; +function TAreaCodeServices.FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; begin result := TAreaCodeConceptFilter(ctxt).FList[TAreaCodeConceptFilter(ctxt).FCursor].link; end; -function TAreaCodeServices.InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; +function TAreaCodeServices.InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; begin raise ETerminologyTodo.Create('TAreaCodeServices.InFilter'); end; diff --git a/server/tx/tx_countrycode.pas b/server/tx/tx_countrycode.pas index 98062fcf6..986bb2249 100644 --- a/server/tx/tx_countrycode.pas +++ b/server/tx/tx_countrycode.pas @@ -75,34 +75,34 @@ TCountryCodeServices = class (TCodeSystemProvider) function description : String; override; function TotalCount : integer; override; - function getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; - function getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; + function getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; + function getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; function systemUri : String; override; function version : String; override; - function getDisplay(code : String; langList : THTTPLanguageList):String; override; - function getDefinition(code : String):String; override; - function locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; - function locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; - function IsAbstract(context : TCodeSystemProviderContext) : boolean; override; - function Code(context : TCodeSystemProviderContext) : string; override; - function Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; - procedure Designations(context : TCodeSystemProviderContext; list : TConceptDesignations); override; - function Definition(context : TCodeSystemProviderContext) : string; override; - - function getPrepContext : TCodeSystemProviderFilterPreparationContext; override; - function prepare(prep : TCodeSystemProviderFilterPreparationContext) : boolean; override; - - function searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; - function filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; - function filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; - function FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; override; - function filterSize(ctxt : TCodeSystemProviderFilterContext) : integer; override; - function FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; - function InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; - function isNotClosed(textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; - function subsumesTest(codeA, codeB : String) : String; override; - - procedure defineFeatures(features : TFslList); override; + function getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; override; + function getDefinition(opContext : TTxOperationContext; code : String):String; override; + function locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; + function locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; + function IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; override; + function Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + function Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; + procedure Designations(opContext : TTxOperationContext; context : TCodeSystemProviderContext; list : TConceptDesignations); override; + function Definition(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + + function getPrepContext(opContext : TTxOperationContext) : TCodeSystemProviderFilterPreparationContext; override; + function prepare(opContext : TTxOperationContext; prep : TCodeSystemProviderFilterPreparationContext) : boolean; override; + + function searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; + function filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; + function filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; + function FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; override; + function filterSize(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : integer; override; + function FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; + function InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; + function isNotClosed(opContext : TTxOperationContext; textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; + function subsumesTest(opContext : TTxOperationContext; codeA, codeB : String) : String; override; + + procedure defineFeatures(opContext : TTxOperationContext; features : TFslList); override; end; implementation @@ -119,7 +119,7 @@ constructor TCountryCodeServices.Create(languages: TIETFLanguageDefinitions; i18 end; -procedure TCountryCodeServices.defineFeatures(features: TFslList); +procedure TCountryCodeServices.defineFeatures(opContext : TTxOperationContext; features: TFslList); begin features.Add(TFHIRFeature.fromString('rest.Codesystem:'+systemUri+'.filter', 'code:regex')); end; @@ -140,17 +140,17 @@ function TCountryCodeServices.systemUri : String; result := URI_3166; end; -function TCountryCodeServices.getDefinition(code: String): String; +function TCountryCodeServices.getDefinition(opContext : TTxOperationContext; code: String): String; begin result := ''; end; -function TCountryCodeServices.getDisplay(code : String; langList : THTTPLanguageList):String; +function TCountryCodeServices.getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; begin result := FMap[code].display.Trim; end; -function TCountryCodeServices.getPrepContext: TCodeSystemProviderFilterPreparationContext; +function TCountryCodeServices.getPrepContext(opContext : TTxOperationContext): TCodeSystemProviderFilterPreparationContext; begin result := nil; end; @@ -924,18 +924,18 @@ procedure TCountryCodeServices.load; end; -function TCountryCodeServices.locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; +function TCountryCodeServices.locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; begin result := FMap[code].link; end; -function TCountryCodeServices.Code(context : TCodeSystemProviderContext) : string; +function TCountryCodeServices.Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; begin result := TCountryCodeConcept(context).code; end; -function TCountryCodeServices.Definition(context: TCodeSystemProviderContext): string; +function TCountryCodeServices.Definition(opContext : TTxOperationContext; context: TCodeSystemProviderContext): string; begin result := ''; end; @@ -952,22 +952,22 @@ destructor TCountryCodeServices.Destroy; inherited; end; -function TCountryCodeServices.Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; +function TCountryCodeServices.Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; begin result := TCountryCodeConcept(context).display.Trim; end; -procedure TCountryCodeServices.Designations(context: TCodeSystemProviderContext; list: TConceptDesignations); +procedure TCountryCodeServices.Designations(opContext : TTxOperationContext; context: TCodeSystemProviderContext; list: TConceptDesignations); begin - list.addDesignation(true, true, '', Display(context, nil)); + list.addDesignation(true, true, '', Display(opContext, context, nil)); end; -function TCountryCodeServices.IsAbstract(context : TCodeSystemProviderContext) : boolean; +function TCountryCodeServices.IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; begin result := false; // CountryCode doesn't do abstract end; -function TCountryCodeServices.isNotClosed(textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; +function TCountryCodeServices.isNotClosed(opContext : TTxOperationContext; textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; begin result := false; end; @@ -977,7 +977,7 @@ function TCountryCodeServices.Link: TCountryCodeServices; result := TCountryCodeServices(Inherited Link); end; -function TCountryCodeServices.getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; +function TCountryCodeServices.getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; begin if (context = nil) then result := TCodeSystemIteratorContext.Create(nil, TotalCount) @@ -985,35 +985,35 @@ function TCountryCodeServices.getIterator(context : TCodeSystemProviderContext) result := TCodeSystemIteratorContext.Create(nil, 0); // no children end; -function TCountryCodeServices.getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; +function TCountryCodeServices.getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; begin result := FCodes[context.current].link; context.next; end; -function TCountryCodeServices.locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; +function TCountryCodeServices.locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; begin result := nil; // no subsumption end; -function TCountryCodeServices.prepare(prep : TCodeSystemProviderFilterPreparationContext) : boolean; +function TCountryCodeServices.prepare(opContext : TTxOperationContext; prep : TCodeSystemProviderFilterPreparationContext) : boolean; begin // nothing result := false; end; -function TCountryCodeServices.searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; +function TCountryCodeServices.searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; begin raise ETerminologyTodo.Create('TCountryCodeServices.searchFilter'); end; -function TCountryCodeServices.subsumesTest(codeA, codeB: String): String; +function TCountryCodeServices.subsumesTest(opContext : TTxOperationContext; codeA, codeB: String): String; begin result := 'not-subsumed'; end; -function TCountryCodeServices.filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; +function TCountryCodeServices.filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; var regex : TRegularExpression; list : TCountryCodeConceptFilter; @@ -1040,28 +1040,28 @@ function TCountryCodeServices.filter(forExpansion, forIteration : boolean; prop raise ETerminologyError.Create('the filter '+prop+' '+CODES_TFhirFilterOperator[op]+' = '+value+' is not supported for '+systemUri, itNotSupported); end; -function TCountryCodeServices.filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; +function TCountryCodeServices.filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; begin result := FMap[code].link; end; -function TCountryCodeServices.FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; +function TCountryCodeServices.FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; begin TCountryCodeConceptFilter(ctxt).FCursor := TCountryCodeConceptFilter(ctxt).FCursor + 1; result := TCountryCodeConceptFilter(ctxt).FCursor < TCountryCodeConceptFilter(ctxt).FList.Count; end; -function TCountryCodeServices.filterSize(ctxt: TCodeSystemProviderFilterContext): integer; +function TCountryCodeServices.filterSize(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): integer; begin result := TCountryCodeConceptFilter(ctxt).FList.Count; end; -function TCountryCodeServices.FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; +function TCountryCodeServices.FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; begin result := TCountryCodeConceptFilter(ctxt).FList[TCountryCodeConceptFilter(ctxt).FCursor].link; end; -function TCountryCodeServices.InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; +function TCountryCodeServices.InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; begin raise ETerminologyTodo.Create('TCountryCodeServices.InFilter'); end; diff --git a/server/tx/tx_cpt.pas b/server/tx/tx_cpt.pas index 5f4aed099..ff6cbf92f 100644 --- a/server/tx/tx_cpt.pas +++ b/server/tx/tx_cpt.pas @@ -166,32 +166,32 @@ TCPTServices = class (TCodeSystemProvider) function name(context : TCodeSystemProviderContext) : String; override; function description : String; override; function TotalCount : integer; override; - function getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; - function getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; - function getDisplay(code : String; langList : THTTPLanguageList):String; override; - function getDefinition(code : String):String; override; - function locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; - function locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; - function sameContext(a, b : TCodeSystemProviderContext) : boolean; override; - function IsAbstract(context : TCodeSystemProviderContext) : boolean; override; - function Code(context : TCodeSystemProviderContext) : string; override; - function Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; - procedure Designations(context : TCodeSystemProviderContext; list : TConceptDesignations); override; - function Definition(context : TCodeSystemProviderContext) : string; override; - - function searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; - function filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; - function filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; - function FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; override; - function filterSize(ctxt : TCodeSystemProviderFilterContext) : integer; override; - function FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; - function InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; - function isNotClosed(textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; - procedure getCDSInfo(card : TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display : String); override; - procedure extendLookup(factory : TFHIRFactory; ctxt : TCodeSystemProviderContext; langList : THTTPLanguageList; props : TArray; resp : TFHIRLookupOpResponseW); override; + function getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; + function getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; + function getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; override; + function getDefinition(opContext : TTxOperationContext; code : String):String; override; + function locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; + function locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; + function sameContext(opContext : TTxOperationContext; a, b : TCodeSystemProviderContext) : boolean; override; + function IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; override; + function Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + function Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; + procedure Designations(opContext : TTxOperationContext; context : TCodeSystemProviderContext; list : TConceptDesignations); override; + function Definition(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + + function searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; + function filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; + function filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; + function FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; override; + function filterSize(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : integer; override; + function FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; + function InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; + function isNotClosed(opContext : TTxOperationContext; textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; + procedure getCDSInfo(opContext : TTxOperationContext; card : TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display : String); override; + procedure extendLookup(opContext : TTxOperationContext; factory : TFHIRFactory; ctxt : TCodeSystemProviderContext; langList : THTTPLanguageList; props : TArray; resp : TFHIRLookupOpResponseW); override; //function subsumes(codeA, codeB : String) : String; override; - procedure defineFeatures(features : TFslList); override; + procedure defineFeatures(opContext : TTxOperationContext; features : TFslList); override; end; implementation @@ -645,7 +645,7 @@ function TCPTServices.TotalCount : integer; result := FMap.Count; end; -function TCPTServices.locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; +function TCPTServices.locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; begin if code.Contains(':') then begin @@ -659,7 +659,7 @@ function TCPTServices.locate(code : String; altOpt : TAlternateCodeOptions; var end; end; -function TCPTServices.getDisplay(code : String; langList : THTTPLanguageList):String; +function TCPTServices.getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; var c : TCPTConcept; begin @@ -670,7 +670,7 @@ function TCPTServices.getDisplay(code : String; langList : THTTPLanguageList):St result := c.designations[0].value; end; -function TCPTServices.getDefinition(code : String):String; +function TCPTServices.getDefinition(opContext : TTxOperationContext; code : String):String; var c : TCPTConcept; begin @@ -682,17 +682,17 @@ function TCPTServices.getDefinition(code : String):String; end; -function TCPTServices.locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; +function TCPTServices.locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; begin result := nil; end; -function TCPTServices.sameContext(a, b : TCodeSystemProviderContext) : boolean; +function TCPTServices.sameContext(opContext : TTxOperationContext; a, b : TCodeSystemProviderContext) : boolean; begin result := a = b; end; -function TCPTServices.IsAbstract(context : TCodeSystemProviderContext) : boolean; +function TCPTServices.IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; var e : TCPTExpression; c : TCPTConcept; @@ -709,7 +709,7 @@ function TCPTServices.IsAbstract(context : TCodeSystemProviderContext) : boolean end; end; -function TCPTServices.Code(context : TCodeSystemProviderContext) : string; +function TCPTServices.Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; var e : TCPTExpression; c : TCPTConcept; @@ -726,7 +726,7 @@ function TCPTServices.Code(context : TCodeSystemProviderContext) : string; end; end; -function TCPTServices.Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; +function TCPTServices.Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; var e : TCPTExpression; c : TCPTConcept; @@ -748,7 +748,7 @@ function TCPTServices.Display(context : TCodeSystemProviderContext; langList : T end; end; -procedure TCPTServices.Designations(context : TCodeSystemProviderContext; list : TConceptDesignations); +procedure TCPTServices.Designations(opContext : TTxOperationContext; context : TCodeSystemProviderContext; list : TConceptDesignations); var c : TCPTConcept; d : TCPTConceptDesignation; @@ -768,16 +768,16 @@ procedure TCPTServices.Designations(context : TCodeSystemProviderContext; list : end; end; -function TCPTServices.Definition(context : TCodeSystemProviderContext) : string; +function TCPTServices.Definition(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; begin - result := Display(context, nil); + result := Display(opContext, context, nil); end; -procedure TCPTServices.getCDSInfo(card : TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display : String); +procedure TCPTServices.getCDSInfo(opContext : TTxOperationContext; card : TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display : String); begin end; -procedure TCPTServices.extendLookup(factory : TFHIRFactory; ctxt : TCodeSystemProviderContext; langList : THTTPLanguageList; props : TArray; resp : TFHIRLookupOpResponseW); +procedure TCPTServices.extendLookup(opContext : TTxOperationContext; factory : TFHIRFactory; ctxt : TCodeSystemProviderContext; langList : THTTPLanguageList; props : TArray; resp : TFHIRLookupOpResponseW); var c : TCPTConcept; @@ -790,7 +790,7 @@ procedure TCPTServices.extendLookup(factory : TFHIRFactory; ctxt : TCodeSystemPr if (ctxt is TCPTExpression) then begin e := (ctxt as TCPTExpression); - extendLookup(factory, e.focus, langList, props, resp); + extendLookup(opContext, factory, e.focus, langList, props, resp); for c in e.modifiers do begin pp := resp.addProp('modifier'); @@ -825,7 +825,7 @@ procedure TCPTServices.extendLookup(factory : TFHIRFactory; ctxt : TCodeSystemPr end; -function TCPTServices.getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; +function TCPTServices.getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; begin if (context = nil) then result := TCPTIteratorContext.Create(FList.link) @@ -833,7 +833,7 @@ function TCPTServices.getIterator(context : TCodeSystemProviderContext) : TCodeS result := TCPTIteratorContext.Create(nil); end; -function TCPTServices.getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; +function TCPTServices.getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; var c : TCPTIteratorContext; begin @@ -846,12 +846,12 @@ function TCPTServices.getNextContext(context : TCodeSystemIteratorContext) : TCo end; -function TCPTServices.searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; +function TCPTServices.searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; begin raise ETerminologyError.Create('Not supported yet', itBusinessRule); end; -function TCPTServices.filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; +function TCPTServices.filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; var list : TFslList; item : TCPTConcept; @@ -897,7 +897,7 @@ function TCPTServices.filter(forExpansion, forIteration : boolean; prop : String result := nil; end; -function TCPTServices.filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; +function TCPTServices.filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; var fc : TCPTFilterContext; c : TCPTConcept; @@ -909,7 +909,7 @@ function TCPTServices.filterLocate(ctxt : TCodeSystemProviderFilterContext; code exit(c.link); end; -function TCPTServices.FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; +function TCPTServices.FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; var fc : TCPTFilterContext; begin @@ -918,7 +918,7 @@ function TCPTServices.FilterMore(ctxt : TCodeSystemProviderFilterContext) : bool result := (fc.Index < fc.Flist.count); end; -function TCPTServices.filterSize(ctxt: TCodeSystemProviderFilterContext): integer; +function TCPTServices.filterSize(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): integer; var fc : TCPTFilterContext; begin @@ -926,7 +926,7 @@ function TCPTServices.filterSize(ctxt: TCodeSystemProviderFilterContext): intege result := fc.Flist.count; end; -function TCPTServices.FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; +function TCPTServices.FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; var fc : TCPTFilterContext; begin @@ -934,7 +934,7 @@ function TCPTServices.FilterConcept(ctxt : TCodeSystemProviderFilterContext): TC result := fc.FList[fc.index].link; end; -function TCPTServices.InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; +function TCPTServices.InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; var fc : TCPTFilterContext; e : TCPTExpression; @@ -954,7 +954,7 @@ function TCPTServices.InFilter(ctxt : TCodeSystemProviderFilterContext; concept end; end; -function TCPTServices.isNotClosed(textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; +function TCPTServices.isNotClosed(opContext : TTxOperationContext; textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; var fc : TCPTFilterContext; begin @@ -967,7 +967,7 @@ function TCPTServices.isNotClosed(textFilter : TSearchFilterText; propFilter : T end; end; -procedure TCPTServices.defineFeatures(features : TFslList); +procedure TCPTServices.defineFeatures(opContext : TTxOperationContext; features : TFslList); begin // nothing end; diff --git a/server/tx/tx_hgvs.pas b/server/tx/tx_hgvs.pas index ae6c7d42c..4905b8188 100644 --- a/server/tx/tx_hgvs.pas +++ b/server/tx/tx_hgvs.pas @@ -58,43 +58,43 @@ THGVSProvider = class (TCodeSystemProvider) function description : String; override; function TotalCount : integer; override; - function getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; - function getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; + function getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; + function getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; function systemUri : String; override; function version : String; override; function name(context : TCodeSystemProviderContext) : String; override; - function getDisplay(code : String; langList : THTTPLanguageList):String; override; - function getDefinition(code : String):String; override; - function locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; overload; override; - function locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; - function IsAbstract(context : TCodeSystemProviderContext) : boolean; override; - function IsInactive(context : TCodeSystemProviderContext) : boolean; override; - function Code(context : TCodeSystemProviderContext) : string; override; - function Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; - function Definition(context : TCodeSystemProviderContext) : string; override; - procedure Designations(context : TCodeSystemProviderContext; list : TConceptDesignations); overload; override; - function doesFilter(prop : String; op : TFhirFilterOperator; value : String) : boolean; override; - - function getPrepContext : TCodeSystemProviderFilterPreparationContext; override; - function searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; - function specialFilter(prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; - function filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; - function prepare(prep : TCodeSystemProviderFilterPreparationContext) : boolean; override; // true if the underlying provider collapsed multiple filters - function filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; overload; override; - function filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String) : TCodeSystemProviderContext; overload; override; - function FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; override; - function filterSize(ctxt : TCodeSystemProviderFilterContext) : integer; override; - function FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; - function InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; - function isNotClosed(textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; - procedure extendLookup(factory : TFHIRFactory; ctxt : TCodeSystemProviderContext; langList : THTTPLanguageList; props : TArray; resp : TFHIRLookupOpResponseW); override; - function subsumesTest(codeA, codeB : String) : String; override; + function getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; override; + function getDefinition(opContext : TTxOperationContext; code : String):String; override; + function locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; overload; override; + function locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; + function IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; override; + function IsInactive(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; override; + function Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + function Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; + function Definition(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + procedure Designations(opContext : TTxOperationContext; context : TCodeSystemProviderContext; list : TConceptDesignations); overload; override; + function doesFilter(opContext : TTxOperationContext; prop : String; op : TFhirFilterOperator; value : String) : boolean; override; + + function getPrepContext(opContext : TTxOperationContext) : TCodeSystemProviderFilterPreparationContext; override; + function searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; + function specialFilter(opContext : TTxOperationContext; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; + function filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; + function prepare(opContext : TTxOperationContext; prep : TCodeSystemProviderFilterPreparationContext) : boolean; override; // true if the underlying provider collapsed multiple filters + function filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; overload; override; + function filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String) : TCodeSystemProviderContext; overload; override; + function FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; override; + function filterSize(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : integer; override; + function FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; + function InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; + function isNotClosed(opContext : TTxOperationContext; textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; + procedure extendLookup(opContext : TTxOperationContext; factory : TFHIRFactory; ctxt : TCodeSystemProviderContext; langList : THTTPLanguageList; props : TArray; resp : TFHIRLookupOpResponseW); override; + function subsumesTest(opContext : TTxOperationContext; codeA, codeB : String) : String; override; function SpecialEnumeration : String; override; - procedure getCDSInfo(card : TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display : String); override; + procedure getCDSInfo(opContext : TTxOperationContext; card : TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display : String); override; function defToThisVersion(specifiedVersion : String) : boolean; override; - procedure defineFeatures(features : TFslList); override; + procedure defineFeatures(opContext : TTxOperationContext; features : TFslList); override; end; implementation @@ -102,21 +102,21 @@ implementation { THGVSProvider } -procedure THGVSProvider.defineFeatures(features: TFslList); +procedure THGVSProvider.defineFeatures(opContext : TTxOperationContext; features: TFslList); begin end; -function THGVSProvider.getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; +function THGVSProvider.getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; begin result := TCodeSystemIteratorContext.Create(nil, 0); end; -function THGVSProvider.Code(context: TCodeSystemProviderContext): string; +function THGVSProvider.Code(opContext : TTxOperationContext; context: TCodeSystemProviderContext): string; begin result := (Context as THGVSCode).code; end; -function THGVSProvider.Definition(context: TCodeSystemProviderContext): string; +function THGVSProvider.Definition(opContext : TTxOperationContext; context: TCodeSystemProviderContext): string; begin result := ''; end; @@ -131,98 +131,98 @@ function THGVSProvider.description: String; result := 'HGVS codes'; end; -function THGVSProvider.Display(context: TCodeSystemProviderContext; langList : THTTPLanguageList): string; +function THGVSProvider.Display(opContext : TTxOperationContext; context: TCodeSystemProviderContext; langList : THTTPLanguageList): string; begin - result := Code(Context); + result := Code(opContext, Context); end; -procedure THGVSProvider.Designations(context: TCodeSystemProviderContext; list: TConceptDesignations); +procedure THGVSProvider.Designations(opContext : TTxOperationContext; context: TCodeSystemProviderContext; list: TConceptDesignations); begin - list.addDesignation(true, true, '', code(context)); + list.addDesignation(true, true, '', code(opContext, context)); end; -function THGVSProvider.doesFilter(prop: String; op: TFhirFilterOperator; value: String): boolean; +function THGVSProvider.doesFilter(opContext : TTxOperationContext; prop: String; op: TFhirFilterOperator; value: String): boolean; begin result := false; end; -procedure THGVSProvider.extendLookup(factory: TFHIRFactory; ctxt: TCodeSystemProviderContext; langList : THTTPLanguageList; props: TArray; resp: TFHIRLookupOpResponseW); +procedure THGVSProvider.extendLookup(opContext : TTxOperationContext; factory: TFHIRFactory; ctxt: TCodeSystemProviderContext; langList : THTTPLanguageList; props: TArray; resp: TFHIRLookupOpResponseW); begin // nothing end; -function THGVSProvider.filter(forExpansion, forIteration : boolean; prop: String; op: TFhirFilterOperator; value: String; prep: TCodeSystemProviderFilterPreparationContext): TCodeSystemProviderFilterContext; +function THGVSProvider.filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop: String; op: TFhirFilterOperator; value: String; prep: TCodeSystemProviderFilterPreparationContext): TCodeSystemProviderFilterContext; begin raise ETerminologyError.Create('Filters are not supported for HGVS', itNotSupported); end; -function THGVSProvider.FilterConcept(ctxt: TCodeSystemProviderFilterContext): TCodeSystemProviderContext; +function THGVSProvider.FilterConcept(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): TCodeSystemProviderContext; begin raise ETerminologyError.Create('Filters are not supported for HGVS', itNotSupported); end; -function THGVSProvider.filterLocate(ctxt: TCodeSystemProviderFilterContext; code: String): TCodeSystemProviderContext; +function THGVSProvider.filterLocate(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext; code: String): TCodeSystemProviderContext; begin raise ETerminologyError.Create('Filters are not supported for HGVS', itNotSupported); end; -function THGVSProvider.filterLocate(ctxt: TCodeSystemProviderFilterContext; code: String; var message: String): TCodeSystemProviderContext; +function THGVSProvider.filterLocate(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext; code: String; var message: String): TCodeSystemProviderContext; begin raise ETerminologyError.Create('Filters are not supported for HGVS', itNotSupported); end; -function THGVSProvider.FilterMore(ctxt: TCodeSystemProviderFilterContext): boolean; +function THGVSProvider.FilterMore(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): boolean; begin raise ETerminologyError.Create('Filters are not supported for HGVS', itNotSupported); end; -function THGVSProvider.filterSize(ctxt: TCodeSystemProviderFilterContext): integer; +function THGVSProvider.filterSize(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): integer; begin raise ETerminologyError.Create('Filters are not supported for HGVS', itNotSupported); end; -procedure THGVSProvider.getCDSInfo(card: TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display: String); +procedure THGVSProvider.getCDSInfo(opContext : TTxOperationContext; card: TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display: String); begin // nothing end; -function THGVSProvider.getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; +function THGVSProvider.getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; begin result := nil; context.next; end; -function THGVSProvider.getDefinition(code: String): String; +function THGVSProvider.getDefinition(opContext : TTxOperationContext; code: String): String; begin result := ''; end; -function THGVSProvider.getDisplay(code: String; langList : THTTPLanguageList): String; +function THGVSProvider.getDisplay(opContext : TTxOperationContext; code: String; langList : THTTPLanguageList): String; begin result := code; end; -function THGVSProvider.getPrepContext: TCodeSystemProviderFilterPreparationContext; +function THGVSProvider.getPrepContext(opContext : TTxOperationContext): TCodeSystemProviderFilterPreparationContext; begin result := nil; end; -function THGVSProvider.InFilter(ctxt: TCodeSystemProviderFilterContext; concept: TCodeSystemProviderContext): Boolean; +function THGVSProvider.InFilter(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext; concept: TCodeSystemProviderContext): Boolean; begin raise ETerminologyError.Create('Filters are not supported for HGVS', itNotSupported); end; -function THGVSProvider.IsAbstract(context: TCodeSystemProviderContext): boolean; +function THGVSProvider.IsAbstract(opContext : TTxOperationContext; context: TCodeSystemProviderContext): boolean; begin result := false; end; -function THGVSProvider.IsInactive(context: TCodeSystemProviderContext): boolean; +function THGVSProvider.IsInactive(opContext : TTxOperationContext; context: TCodeSystemProviderContext): boolean; begin result := false; end; -function THGVSProvider.isNotClosed(textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; +function THGVSProvider.isNotClosed(opContext : TTxOperationContext; textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; begin result := false; end; @@ -232,7 +232,7 @@ function THGVSProvider.link: THGVSProvider; result := THGVSProvider(inherited link); end; -function THGVSProvider.locate(code: String; altOpt : TAlternateCodeOptions; var message: String): TCodeSystemProviderContext; +function THGVSProvider.locate(opContext : TTxOperationContext; code: String; altOpt : TAlternateCodeOptions; var message: String): TCodeSystemProviderContext; var json, o : TJsonObject; begin @@ -260,7 +260,7 @@ function THGVSProvider.locate(code: String; altOpt : TAlternateCodeOptions; var end; end; -function THGVSProvider.locateIsA(code, parent: String; disallowParent : boolean = false): TCodeSystemProviderContext; +function THGVSProvider.locateIsA(opContext : TTxOperationContext; code, parent: String; disallowParent : boolean = false): TCodeSystemProviderContext; begin result := nil; end; @@ -270,12 +270,12 @@ function THGVSProvider.name(context: TCodeSystemProviderContext): String; result := 'HGVS'; end; -function THGVSProvider.prepare(prep: TCodeSystemProviderFilterPreparationContext): boolean; +function THGVSProvider.prepare(opContext : TTxOperationContext; prep: TCodeSystemProviderFilterPreparationContext): boolean; begin raise ETerminologyError.Create('Filters are not supported for HGVS', itNotSupported); end; -function THGVSProvider.searchFilter(filter: TSearchFilterText; prep: TCodeSystemProviderFilterPreparationContext; sort: boolean): TCodeSystemProviderFilterContext; +function THGVSProvider.searchFilter(opContext : TTxOperationContext; filter: TSearchFilterText; prep: TCodeSystemProviderFilterPreparationContext; sort: boolean): TCodeSystemProviderFilterContext; begin raise ETerminologyError.Create('Filters are not supported for HGVS', itNotSupported); end; @@ -285,12 +285,12 @@ function THGVSProvider.SpecialEnumeration: String; result := ''; end; -function THGVSProvider.specialFilter(prep: TCodeSystemProviderFilterPreparationContext; sort: boolean): TCodeSystemProviderFilterContext; +function THGVSProvider.specialFilter(opContext : TTxOperationContext; prep: TCodeSystemProviderFilterPreparationContext; sort: boolean): TCodeSystemProviderFilterContext; begin raise ETerminologyError.Create('Filters are not supported for HGVS', itNotSupported); end; -function THGVSProvider.subsumesTest(codeA, codeB: String): String; +function THGVSProvider.subsumesTest(opContext : TTxOperationContext; codeA, codeB: String): String; begin raise ETerminologyError.Create('Subsumption is not supported for HGVS', itNotSupported); end; diff --git a/server/tx/tx_icd11.pas b/server/tx/tx_icd11.pas index 8e58eeb62..78fa08c32 100644 --- a/server/tx/tx_icd11.pas +++ b/server/tx/tx_icd11.pas @@ -67,24 +67,24 @@ TICD11Provider = class (TCodeSystemProvider) function description : String; override; function TotalCount : integer; override; - function getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; - function getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; + function getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; + function getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; function systemUri : String; override; function version : String; override; function name(context : TCodeSystemProviderContext) : String; override; - function getDisplay(code : String; langList : THTTPLanguageList):String; override; + function getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; override; function getDefinition(code : String):String; override; - function locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; overload; override; - function locate(code : String; altOpt : TAlternateCodeOptions= nil) : TCodeSystemProviderContext; overload; override; + function locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; overload; override; + function locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions= nil) : TCodeSystemProviderContext; overload; override; function locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; - function IsAbstract(context : TCodeSystemProviderContext) : boolean; override; + function IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; override; function IsInactive(context : TCodeSystemProviderContext) : boolean; override; - function Code(context : TCodeSystemProviderContext) : string; override; - function Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; + function Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + function Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; function Definition(context : TCodeSystemProviderContext) : string; override; function itemWeight(context : TCodeSystemProviderContext) : string; override; - procedure Designations(context : TCodeSystemProviderContext; list : TConceptDesignations); overload; override; - function doesFilter(prop : String; op : TFhirFilterOperator; value : String) : boolean; override; + procedure Designations(opContext : TTxOperationContext; context : TCodeSystemProviderContext; list : TConceptDesignations); overload; override; + function doesFilter(opContext : TTxOperationContext; prop : String; op : TFhirFilterOperator; value : String) : boolean; override; function getPrepContext : TCodeSystemProviderFilterPreparationContext; override; function searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; @@ -205,7 +205,7 @@ function TICD11Provider.getDefinition(code: String): String; result := ''; end; -function TICD11Provider.getDisplay(code: String; langList : THTTPLanguageList): String; +function TICD11Provider.getDisplay(opContext : TTxOperationContext; code: String; langList : THTTPLanguageList): String; begin result := ''; end; diff --git a/server/tx/tx_iso_4217.pas b/server/tx/tx_iso_4217.pas index 11374847c..ac5ee850e 100644 --- a/server/tx/tx_iso_4217.pas +++ b/server/tx/tx_iso_4217.pas @@ -80,33 +80,33 @@ TIso4217Services = class (TCodeSystemProvider) function description : String; override; function TotalCount : integer; override; - function getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; - function getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; + function getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; + function getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; function systemUri : String; override; - function getDisplay(code : String; langList : THTTPLanguageList):String; override; - function getDefinition(code : String):String; override; - function locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; - function locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; - function IsAbstract(context : TCodeSystemProviderContext) : boolean; override; - function Code(context : TCodeSystemProviderContext) : string; override; - function Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; - procedure Designations(context : TCodeSystemProviderContext; list : TConceptDesignations); override; - function Definition(context : TCodeSystemProviderContext) : string; override; - - function getPrepContext : TCodeSystemProviderFilterPreparationContext; override; - function prepare(prep : TCodeSystemProviderFilterPreparationContext) : boolean; override; - - function searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; - function filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; - function filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; - function FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; override; - function filterSize(ctxt : TCodeSystemProviderFilterContext) : integer; override; - function FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; - function InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; - function isNotClosed(textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; - function subsumesTest(codeA, codeB : String) : String; override; - - procedure defineFeatures(features : TFslList); override; + function getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; override; + function getDefinition(opContext : TTxOperationContext; code : String):String; override; + function locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; + function locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; + function IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; override; + function Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + function Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; + procedure Designations(opContext : TTxOperationContext; context : TCodeSystemProviderContext; list : TConceptDesignations); override; + function Definition(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + + function getPrepContext(opContext : TTxOperationContext) : TCodeSystemProviderFilterPreparationContext; override; + function prepare(opContext : TTxOperationContext; prep : TCodeSystemProviderFilterPreparationContext) : boolean; override; + + function searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; + function filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; + function filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; + function FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; override; + function filterSize(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : integer; override; + function FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; + function InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; + function isNotClosed(opContext : TTxOperationContext; textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; + function subsumesTest(opContext : TTxOperationContext; codeA, codeB : String) : String; override; + + procedure defineFeatures(opContext : TTxOperationContext; features : TFslList); override; end; @@ -121,7 +121,7 @@ constructor TIso4217Services.Create(languages: TIETFLanguageDefinitions; i18n : end; -procedure TIso4217Services.defineFeatures(features: TFslList); +procedure TIso4217Services.defineFeatures(opContext : TTxOperationContext; features: TFslList); begin features.Add(TFHIRFeature.fromString('rest.Codesystem:'+systemUri+'.filter', 'decimals:equals')); end; @@ -137,22 +137,22 @@ function TIso4217Services.systemUri : String; result := 'urn:iso:std:iso:4217'; end; -function TIso4217Services.getDefinition(code: String): String; +function TIso4217Services.getDefinition(opContext : TTxOperationContext; code: String): String; begin result := ''; end; -function TIso4217Services.getDisplay(code : String; langList : THTTPLanguageList):String; +function TIso4217Services.getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; begin result := FCurrencies.Map[code].display.Trim; end; -function TIso4217Services.getPrepContext: TCodeSystemProviderFilterPreparationContext; +function TIso4217Services.getPrepContext(opContext : TTxOperationContext): TCodeSystemProviderFilterPreparationContext; begin result := nil; end; -function TIso4217Services.locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; +function TIso4217Services.locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; var c : TIso4217Currency; begin @@ -163,12 +163,12 @@ function TIso4217Services.locate(code : String; altOpt : TAlternateCodeOptions; result := TIso4217Concept.Create(c.link); end; -function TIso4217Services.Code(context : TCodeSystemProviderContext) : string; +function TIso4217Services.Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; begin result := TIso4217Concept(context).code; end; -function TIso4217Services.Definition(context: TCodeSystemProviderContext): string; +function TIso4217Services.Definition(opContext : TTxOperationContext; context: TCodeSystemProviderContext): string; begin result := ''; end; @@ -184,22 +184,22 @@ destructor TIso4217Services.Destroy; inherited; end; -function TIso4217Services.Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; +function TIso4217Services.Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; begin result := TIso4217Concept(context).display.Trim; end; -procedure TIso4217Services.Designations(context: TCodeSystemProviderContext; list: TConceptDesignations); +procedure TIso4217Services.Designations(opContext : TTxOperationContext; context: TCodeSystemProviderContext; list: TConceptDesignations); begin - list.addDesignation(true, true, '', Display(context, nil)); + list.addDesignation(true, true, '', Display(opContext, context, nil)); end; -function TIso4217Services.IsAbstract(context : TCodeSystemProviderContext) : boolean; +function TIso4217Services.IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; begin result := false; // 4217 doesn't do abstract end; -function TIso4217Services.isNotClosed(textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; +function TIso4217Services.isNotClosed(opContext : TTxOperationContext; textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; begin result := false; end; @@ -209,7 +209,7 @@ function TIso4217Services.Link: TIso4217Services; result := TIso4217Services(Inherited Link); end; -function TIso4217Services.getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; +function TIso4217Services.getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; begin if (context = nil) then result := TCodeSystemIteratorContext.Create(nil, TotalCount) @@ -217,35 +217,35 @@ function TIso4217Services.getIterator(context : TCodeSystemProviderContext) : TC result := TCodeSystemIteratorContext.Create(nil, 0); // no children end; -function TIso4217Services.getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; +function TIso4217Services.getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; begin result := TIso4217Concept.Create(FCurrencies.Codes[context.current].link); context.next; end; -function TIso4217Services.locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; +function TIso4217Services.locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; begin raise ETerminologyError.Create('locateIsA not supported by Iso4217', itNotSupported); // Iso4217 doesn't have formal subsumption property, so this is not used end; -function TIso4217Services.prepare(prep : TCodeSystemProviderFilterPreparationContext) : boolean; +function TIso4217Services.prepare(opContext : TTxOperationContext; prep : TCodeSystemProviderFilterPreparationContext) : boolean; begin // nothing result := false; end; -function TIso4217Services.searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; +function TIso4217Services.searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; begin raise ETerminologyTodo.Create('TIso4217Services.searchFilter'); end; -function TIso4217Services.subsumesTest(codeA, codeB: String): String; +function TIso4217Services.subsumesTest(opContext : TTxOperationContext; codeA, codeB: String): String; begin result := 'not-subsumed'; end; -function TIso4217Services.filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; +function TIso4217Services.filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; var res : TIso4217ConceptFilter; c : TIso4217Currency; @@ -266,28 +266,28 @@ function TIso4217Services.filter(forExpansion, forIteration : boolean; prop : St raise ETerminologyError.Create('the filter '+prop+' '+CODES_TFhirFilterOperator[op]+' = '+value+' is not supported for '+systemUri, itNotSupported); end; -function TIso4217Services.filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; +function TIso4217Services.filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; begin raise ETerminologyTodo.Create('TIso4217Services.filterLocate'); end; -function TIso4217Services.FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; +function TIso4217Services.FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; begin TIso4217ConceptFilter(ctxt).FCursor := TIso4217ConceptFilter(ctxt).FCursor + 1; result := TIso4217ConceptFilter(ctxt).FCursor < TIso4217ConceptFilter(ctxt).FList.Count; end; -function TIso4217Services.filterSize(ctxt: TCodeSystemProviderFilterContext): integer; +function TIso4217Services.filterSize(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): integer; begin result := TIso4217ConceptFilter(ctxt).FList.Count; end; -function TIso4217Services.FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; +function TIso4217Services.FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; begin result := TIso4217ConceptFilter(ctxt).FList[TIso4217ConceptFilter(ctxt).FCursor].link; end; -function TIso4217Services.InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; +function TIso4217Services.InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; begin raise ETerminologyTodo.Create('TIso4217Services.InFilter'); end; diff --git a/server/tx/tx_mimetypes.pas b/server/tx/tx_mimetypes.pas index cd366d3a3..56bc58b3b 100644 --- a/server/tx/tx_mimetypes.pas +++ b/server/tx/tx_mimetypes.pas @@ -60,34 +60,34 @@ TMimeTypeCodeServices = class (TCodeSystemProvider) function description : String; override; function TotalCount : integer; override; - function getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; - function getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; + function getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; + function getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; function systemUri : String; override; function version : String; override; function name(context : TCodeSystemProviderContext) : String; override; - function getDisplay(code : String; langList : THTTPLanguageList):String; override; - function getDefinition(code : String):String; override; - function locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; - function locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; - function IsAbstract(context : TCodeSystemProviderContext) : boolean; override; - function Code(context : TCodeSystemProviderContext) : string; override; - function Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; - procedure Designations(context : TCodeSystemProviderContext; list : TConceptDesignations); override; - function Definition(context : TCodeSystemProviderContext) : string; override; - - function getPrepContext : TCodeSystemProviderFilterPreparationContext; override; - function prepare(prep : TCodeSystemProviderFilterPreparationContext) : boolean; override; - - function searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; - function filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; - function filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; - function FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; override; - function filterSize(ctxt : TCodeSystemProviderFilterContext) : integer; override; - function FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; - function InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; - function isNotClosed(textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; - - procedure defineFeatures(features : TFslList); override; + function getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; override; + function getDefinition(opContext : TTxOperationContext; code : String):String; override; + function locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; + function locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; + function IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; override; + function Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + function Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; + procedure Designations(opContext : TTxOperationContext; context : TCodeSystemProviderContext; list : TConceptDesignations); override; + function Definition(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + + function getPrepContext(opContext : TTxOperationContext) : TCodeSystemProviderFilterPreparationContext; override; + function prepare(opContext : TTxOperationContext; prep : TCodeSystemProviderFilterPreparationContext) : boolean; override; + + function searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; + function filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; + function filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; + function FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; override; + function filterSize(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : integer; override; + function FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; + function InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; + function isNotClosed(opContext : TTxOperationContext; textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; + + procedure defineFeatures(opContext : TTxOperationContext; features : TFslList); override; end; implementation @@ -95,7 +95,7 @@ implementation { TMimeTypeCodeServices } -procedure TMimeTypeCodeServices.defineFeatures(features: TFslList); +procedure TMimeTypeCodeServices.defineFeatures(opContext : TTxOperationContext; features: TFslList); begin end; @@ -115,22 +115,22 @@ function TMimeTypeCodeServices.systemUri : String; result := URI_BCP13; end; -function TMimeTypeCodeServices.getDefinition(code: String): String; +function TMimeTypeCodeServices.getDefinition(opContext : TTxOperationContext; code: String): String; begin result := ''; end; -function TMimeTypeCodeServices.getDisplay(code : String; langList : THTTPLanguageList):String; +function TMimeTypeCodeServices.getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; begin result := code.Trim; end; -function TMimeTypeCodeServices.getPrepContext: TCodeSystemProviderFilterPreparationContext; +function TMimeTypeCodeServices.getPrepContext(opContext : TTxOperationContext): TCodeSystemProviderFilterPreparationContext; begin result := nil; end; -function TMimeTypeCodeServices.locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; +function TMimeTypeCodeServices.locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; var mt : TMimeContentType; begin @@ -145,12 +145,12 @@ function TMimeTypeCodeServices.locate(code : String; altOpt : TAlternateCodeOpti end; end; -function TMimeTypeCodeServices.Code(context : TCodeSystemProviderContext) : string; +function TMimeTypeCodeServices.Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; begin result := TMTCodeSystemProviderContext(context).mt.source; end; -function TMimeTypeCodeServices.Definition(context: TCodeSystemProviderContext): string; +function TMimeTypeCodeServices.Definition(opContext : TTxOperationContext; context: TCodeSystemProviderContext): string; begin result := ''; end; @@ -165,22 +165,22 @@ destructor TMimeTypeCodeServices.Destroy; inherited; end; -function TMimeTypeCodeServices.Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; +function TMimeTypeCodeServices.Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; begin - result := getDisplay(TMTCodeSystemProviderContext(context).mt.source, langList); + result := getDisplay(opContext, TMTCodeSystemProviderContext(context).mt.source, langList); end; -procedure TMimeTypeCodeServices.Designations(context: TCodeSystemProviderContext; list: TConceptDesignations); +procedure TMimeTypeCodeServices.Designations(opContext : TTxOperationContext; context: TCodeSystemProviderContext; list: TConceptDesignations); begin - list.addDesignation(true, true, '', Display(context, nil)); + list.addDesignation(true, true, '', Display(opContext, context, nil)); end; -function TMimeTypeCodeServices.IsAbstract(context : TCodeSystemProviderContext) : boolean; +function TMimeTypeCodeServices.IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; begin result := false; // MimeTypeCode doesn't do abstract end; -function TMimeTypeCodeServices.isNotClosed(textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; +function TMimeTypeCodeServices.isNotClosed(opContext : TTxOperationContext; textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; begin result := true; end; @@ -190,17 +190,17 @@ function TMimeTypeCodeServices.Link: TMimeTypeCodeServices; result := TMimeTypeCodeServices(Inherited Link); end; -function TMimeTypeCodeServices.getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; +function TMimeTypeCodeServices.getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; begin result := TCodeSystemIteratorContext.Create(nil, 0); end; -function TMimeTypeCodeServices.getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; +function TMimeTypeCodeServices.getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; begin raise ETerminologyTodo.Create('TMimeTypeCodeServices.getcontext'); end; -function TMimeTypeCodeServices.locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; +function TMimeTypeCodeServices.locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; begin result := nil; // no subsumption end; @@ -211,42 +211,42 @@ function TMimeTypeCodeServices.name(context: TCodeSystemProviderContext): String result := 'IETF langauge'; end; -function TMimeTypeCodeServices.prepare(prep : TCodeSystemProviderFilterPreparationContext) : boolean; +function TMimeTypeCodeServices.prepare(opContext : TTxOperationContext; prep : TCodeSystemProviderFilterPreparationContext) : boolean; begin result := false; end; -function TMimeTypeCodeServices.searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; +function TMimeTypeCodeServices.searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; begin raise ETerminologyTodo.Create('TMimeTypeCodeServices.searchFilter'); end; -function TMimeTypeCodeServices.filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; +function TMimeTypeCodeServices.filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; begin raise ETerminologyError.Create('Not a supported filter', itNotSupported); end; -function TMimeTypeCodeServices.filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; +function TMimeTypeCodeServices.filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; begin result := nil; end; -function TMimeTypeCodeServices.FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; +function TMimeTypeCodeServices.FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; begin raise ETerminologyTodo.Create('TMimeTypeCodeServices.FilterMore'); end; -function TMimeTypeCodeServices.filterSize(ctxt: TCodeSystemProviderFilterContext): integer; +function TMimeTypeCodeServices.filterSize(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): integer; begin raise ETerminologyTodo.Create('TMimeTypeCodeServices.FilterSize'); end; -function TMimeTypeCodeServices.FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; +function TMimeTypeCodeServices.FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; begin raise ETerminologyTodo.Create('TMimeTypeCodeServices.FilterConcept'); end; -function TMimeTypeCodeServices.InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; +function TMimeTypeCodeServices.InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; begin raise ETerminologyTodo.Create('TMimeTypeCodeServices.InFilter'); end; diff --git a/server/tx/tx_ndc.pas b/server/tx/tx_ndc.pas index 907ff1711..12b4d67dc 100644 --- a/server/tx/tx_ndc.pas +++ b/server/tx/tx_ndc.pas @@ -236,35 +236,35 @@ TNDCServices = class (TCodeSystemProvider) function description : String; override; function TotalCount : integer; override; - function getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; - function getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; + function getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; + function getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; function systemUri : String; override; - function getDisplay(code : String; langList : THTTPLanguageList):String; override; - function getDefinition(code : String):String; override; - function locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; - function locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; - function IsAbstract(context : TCodeSystemProviderContext) : boolean; override; - function Code(context : TCodeSystemProviderContext) : string; override; - function Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; - procedure Designations(context : TCodeSystemProviderContext; list : TConceptDesignations); override; - function Definition(context : TCodeSystemProviderContext) : string; override; - - function getPrepContext : TCodeSystemProviderFilterPreparationContext; override; - function prepare(prep : TCodeSystemProviderFilterPreparationContext) : boolean; override; - - function searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; - function doesFilter(prop : String; op : TFhirFilterOperator; value : String) : boolean; override; - function filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; - function filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; - function FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; override; - function filterSize(ctxt : TCodeSystemProviderFilterContext) : integer; override; - function FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; - function InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; - function isNotClosed(textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; - procedure getCDSInfo(card : TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display : String); override; - procedure extendLookup(factory : TFHIRFactory; ctxt : TCodeSystemProviderContext; langList : THTTPLanguageList; props : TArray; resp : TFHIRLookupOpResponseW); override; - - procedure defineFeatures(features : TFslList); override; + function getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; override; + function getDefinition(opContext : TTxOperationContext; code : String):String; override; + function locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; + function locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; + function IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; override; + function Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + function Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; + procedure Designations(opContext : TTxOperationContext; context : TCodeSystemProviderContext; list : TConceptDesignations); override; + function Definition(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + + function getPrepContext(opContext : TTxOperationContext) : TCodeSystemProviderFilterPreparationContext; override; + function prepare(opContext : TTxOperationContext; prep : TCodeSystemProviderFilterPreparationContext) : boolean; override; + + function searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; + function doesFilter(opContext : TTxOperationContext; prop : String; op : TFhirFilterOperator; value : String) : boolean; override; + function filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; + function filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; + function FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; override; + function filterSize(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : integer; override; + function FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; + function InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; + function isNotClosed(opContext : TTxOperationContext; textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; + procedure getCDSInfo(opContext : TTxOperationContext; card : TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display : String); override; + procedure extendLookup(opContext : TTxOperationContext; factory : TFHIRFactory; ctxt : TCodeSystemProviderContext; langList : THTTPLanguageList; props : TArray; resp : TFHIRLookupOpResponseW); override; + + procedure defineFeatures(opContext : TTxOperationContext; features : TFslList); override; end; implementation @@ -834,7 +834,7 @@ constructor TNDCServices.Create(languages : TIETFLanguageDefinitions; i18n : TI1 load(); end; -procedure TNDCServices.defineFeatures(features: TFslList); +procedure TNDCServices.defineFeatures(opContext : TTxOperationContext; features: TFslList); begin end; @@ -903,7 +903,7 @@ procedure TNDCServices.load; end; end; -function TNDCServices.Code(context: TCodeSystemProviderContext): string; +function TNDCServices.Code(opContext : TTxOperationContext; context: TCodeSystemProviderContext): string; var c : string; code : TNDCProviderContext; @@ -932,7 +932,7 @@ function TNDCServices.Code(context: TCodeSystemProviderContext): string; end; end; -function TNDCServices.getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; +function TNDCServices.getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; var conn : TFDBConnection; iter : TNDCIteratorContext; @@ -964,7 +964,7 @@ function TNDCServices.getIterator(context : TCodeSystemProviderContext) : TCodeS result := TCodeSystemIteratorContext.Create(nil, 0); end; -function TNDCServices.getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; +function TNDCServices.getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; var iter : TNDCIteratorContext; ctxt : TNDCProviderContext; @@ -1000,7 +1000,7 @@ function TNDCServices.getNextContext(context : TCodeSystemIteratorContext) : TCo iter.FConn.Prepare; iter.FConn.Execute; iter.FMore := iter.FConn.FetchNext; - result := getNextContext(iter); + result := getNextContext(opContext, iter); exit; end; end @@ -1017,7 +1017,7 @@ function TNDCServices.getNextContext(context : TCodeSystemIteratorContext) : TCo end; end; -function TNDCServices.Definition(context: TCodeSystemProviderContext): string; +function TNDCServices.Definition(opContext : TTxOperationContext; context: TCodeSystemProviderContext): string; begin result := ''; end; @@ -1027,7 +1027,7 @@ function TNDCServices.description: String; result := 'NDC Codes'; end; -function TNDCServices.Display(context: TCodeSystemProviderContext; langList : THTTPLanguageList): string; +function TNDCServices.Display(opContext : TTxOperationContext; context: TCodeSystemProviderContext; langList : THTTPLanguageList): string; var c : string; code : TNDCProviderContext; @@ -1071,17 +1071,17 @@ function TNDCServices.Display(context: TCodeSystemProviderContext; langList : TH end; end; -procedure TNDCServices.Designations(context: TCodeSystemProviderContext; list: TConceptDesignations); +procedure TNDCServices.Designations(opContext : TTxOperationContext; context: TCodeSystemProviderContext; list: TConceptDesignations); begin - list.addDesignation(true, true, '', Display(context, nil)); + list.addDesignation(true, true, '', Display(opContext, context, nil)); end; -function TNDCServices.doesFilter(prop: String; op: TFhirFilterOperator; value: String): boolean; +function TNDCServices.doesFilter(opContext : TTxOperationContext; prop: String; op: TFhirFilterOperator; value: String): boolean; begin result := (prop = 'code-type') and (op = foEqual) and StringArrayExistsSensitive(['10-digit', '11-digit', 'product'], value); end; -procedure TNDCServices.extendLookup(factory: TFHIRFactory; ctxt: TCodeSystemProviderContext; langList : THTTPLanguageList; props: TArray; resp: TFHIRLookupOpResponseW); +procedure TNDCServices.extendLookup(opContext : TTxOperationContext; factory: TFHIRFactory; ctxt: TCodeSystemProviderContext; langList : THTTPLanguageList; props: TArray; resp: TFHIRLookupOpResponseW); var code : TNDCProviderContext; conn : TFDBConnection; @@ -1136,7 +1136,7 @@ procedure TNDCServices.extendLookup(factory: TFHIRFactory; ctxt: TCodeSystemProv end; end; -function TNDCServices.filter(forExpansion, forIteration : boolean; prop: String; op: TFhirFilterOperator; value: String; prep: TCodeSystemProviderFilterPreparationContext): TCodeSystemProviderFilterContext; +function TNDCServices.filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop: String; op: TFhirFilterOperator; value: String; prep: TCodeSystemProviderFilterPreparationContext): TCodeSystemProviderFilterContext; var ctxt : TNDCFilterPreparationContext; res : TNDCFilterContext; @@ -1172,7 +1172,7 @@ function TNDCServices.filter(forExpansion, forIteration : boolean; prop: String; end; end; -function TNDCServices.FilterConcept(ctxt: TCodeSystemProviderFilterContext): TCodeSystemProviderContext; +function TNDCServices.FilterConcept(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): TCodeSystemProviderContext; var context : TNDCFilterContext; res : TNDCProviderContext; @@ -1194,7 +1194,7 @@ function TNDCServices.FilterConcept(ctxt: TCodeSystemProviderFilterContext): TCo end; end; -function TNDCServices.filterLocate(ctxt: TCodeSystemProviderFilterContext; code: String; var message: String): TCodeSystemProviderContext; +function TNDCServices.filterLocate(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext; code: String; var message: String): TCodeSystemProviderContext; var context : TNDCFilterContext; res : TNDCProviderContext; @@ -1235,7 +1235,7 @@ function TNDCServices.filterLocate(ctxt: TCodeSystemProviderFilterContext; code: end; end; -function TNDCServices.FilterMore(ctxt: TCodeSystemProviderFilterContext): boolean; +function TNDCServices.FilterMore(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): boolean; var context : TNDCFilterContext; begin @@ -1243,7 +1243,7 @@ function TNDCServices.FilterMore(ctxt: TCodeSystemProviderFilterContext): boolea result := context.FConn.FetchNext; end; -function TNDCServices.filterSize(ctxt: TCodeSystemProviderFilterContext): integer; +function TNDCServices.filterSize(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): integer; var context : TNDCFilterContext; begin @@ -1251,17 +1251,17 @@ function TNDCServices.filterSize(ctxt: TCodeSystemProviderFilterContext): intege result := context.FConn.RowsAffected; // todo end; -procedure TNDCServices.getCDSInfo(card: TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display: String); +procedure TNDCServices.getCDSInfo(opContext : TTxOperationContext; card: TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display: String); begin raise ETerminologyTodo.Create('Not done yet: TNDCServices.getCDSInfo'); end; -function TNDCServices.getDefinition(code: String): String; +function TNDCServices.getDefinition(opContext : TTxOperationContext; code: String): String; begin - result := getDisplay(code, nil); + result := getDisplay(opContext, code, nil); end; -function TNDCServices.getDisplay(code : String; langList : THTTPLanguageList): String; +function TNDCServices.getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList): String; var c : string; conn : TFDBConnection; @@ -1295,12 +1295,12 @@ function TNDCServices.getDisplay(code : String; langList : THTTPLanguageList): S result := c; end; -function TNDCServices.getPrepContext: TCodeSystemProviderFilterPreparationContext; +function TNDCServices.getPrepContext(opContext : TTxOperationContext): TCodeSystemProviderFilterPreparationContext; begin result := TNDCFilterPreparationContext.Create; end; -function TNDCServices.InFilter(ctxt: TCodeSystemProviderFilterContext; concept: TCodeSystemProviderContext): Boolean; +function TNDCServices.InFilter(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext; concept: TCodeSystemProviderContext): Boolean; var context : TNDCFilterContext; res : TNDCProviderContext; @@ -1317,17 +1317,17 @@ function TNDCServices.InFilter(ctxt: TCodeSystemProviderFilterContext; concept: end; end; -function TNDCServices.IsAbstract(context: TCodeSystemProviderContext): boolean; +function TNDCServices.IsAbstract(opContext : TTxOperationContext; context: TCodeSystemProviderContext): boolean; begin result := false; end; -function TNDCServices.isNotClosed(textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; +function TNDCServices.isNotClosed(opContext : TTxOperationContext; textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; begin result := false; end; -function TNDCServices.locate(code: String; altOpt : TAlternateCodeOptions; var message: String): TCodeSystemProviderContext; +function TNDCServices.locate(opContext : TTxOperationContext; code: String; altOpt : TAlternateCodeOptions; var message: String): TCodeSystemProviderContext; var c : TNDCProviderContext; k : integer; @@ -1367,7 +1367,7 @@ function TNDCServices.locate(code: String; altOpt : TAlternateCodeOptions; var m end; end; -function TNDCServices.locateIsA(code, parent: String; disallowParent : boolean = false): TCodeSystemProviderContext; +function TNDCServices.locateIsA(opContext : TTxOperationContext; code, parent: String; disallowParent : boolean = false): TCodeSystemProviderContext; begin raise ETerminologyTodo.Create('Not done yet: TNDCServices.locateIsA'); end; @@ -1385,7 +1385,7 @@ function TNDCServices.productDisplay(conn: TFDBConnection): String; result := conn.ColStringByName['TradeName']+' '+conn.ColStringByName['Suffix']+' (product)'; end; -function TNDCServices.prepare(prep: TCodeSystemProviderFilterPreparationContext): boolean; +function TNDCServices.prepare(opContext : TTxOperationContext; prep: TCodeSystemProviderFilterPreparationContext): boolean; var ctxt : TNDCFilterPreparationContext; begin @@ -1393,7 +1393,7 @@ function TNDCServices.prepare(prep: TCodeSystemProviderFilterPreparationContext) result := false; end; -function TNDCServices.searchFilter(filter: TSearchFilterText; prep: TCodeSystemProviderFilterPreparationContext; sort: boolean): TCodeSystemProviderFilterContext; +function TNDCServices.searchFilter(opContext : TTxOperationContext; filter: TSearchFilterText; prep: TCodeSystemProviderFilterPreparationContext; sort: boolean): TCodeSystemProviderFilterContext; begin raise ETerminologyTodo.Create('Not done yet: TNDCServices.searchFilter'); end; diff --git a/server/tx/tx_omop.pas b/server/tx/tx_omop.pas index 6b70fa6fa..a0f2582e4 100644 --- a/server/tx/tx_omop.pas +++ b/server/tx/tx_omop.pas @@ -86,35 +86,35 @@ TOMOPServices = class (TCodeSystemProvider) function name(context : TCodeSystemProviderContext) : String; override; function description : String; override; function TotalCount : integer; override; - function getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; - function getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; - function getDisplay(code : String; langList : THTTPLanguageList):String; override; - function getDefinition(code : String):String; override; - function locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; - function locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; - function sameContext(a, b : TCodeSystemProviderContext) : boolean; override; - function IsAbstract(context : TCodeSystemProviderContext) : boolean; override; - function Code(context : TCodeSystemProviderContext) : string; override; - function Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; - procedure Designations(context : TCodeSystemProviderContext; list : TConceptDesignations); override; - function Definition(context : TCodeSystemProviderContext) : string; override; - - function getPrepContext : TCodeSystemProviderFilterPreparationContext; override; - function prepare(prep : TCodeSystemProviderFilterPreparationContext) : boolean; override; - - function searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; - function filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; - function filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; - function FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; override; - function filterSize(ctxt : TCodeSystemProviderFilterContext) : integer; override; - function FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; - function InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; - function isNotClosed(textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; - procedure getCDSInfo(card : TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display : String); override; - procedure extendLookup(factory : TFHIRFactory; ctxt : TCodeSystemProviderContext; langList : THTTPLanguageList; props : TArray; resp : TFHIRLookupOpResponseW); override; + function getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; + function getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; + function getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; override; + function getDefinition(opContext : TTxOperationContext; code : String):String; override; + function locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; + function locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; + function sameContext(opContext : TTxOperationContext; a, b : TCodeSystemProviderContext) : boolean; override; + function IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; override; + function Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + function Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; + procedure Designations(opContext : TTxOperationContext; context : TCodeSystemProviderContext; list : TConceptDesignations); override; + function Definition(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + + function getPrepContext(opContext : TTxOperationContext) : TCodeSystemProviderFilterPreparationContext; override; + function prepare(opContext : TTxOperationContext; prep : TCodeSystemProviderFilterPreparationContext) : boolean; override; + + function searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; + function filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; + function filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; + function FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; override; + function filterSize(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : integer; override; + function FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; + function InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; + function isNotClosed(opContext : TTxOperationContext; textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; + procedure getCDSInfo(opContext : TTxOperationContext; card : TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display : String); override; + procedure extendLookup(opContext : TTxOperationContext; factory : TFHIRFactory; ctxt : TCodeSystemProviderContext; langList : THTTPLanguageList; props : TArray; resp : TFHIRLookupOpResponseW); override; //function subsumes(codeA, codeB : String) : String; override; - procedure defineFeatures(features : TFslList); override; + procedure defineFeatures(opContext : TTxOperationContext; features : TFslList); override; end; @@ -215,12 +215,12 @@ function TOMOPServices.TotalCount: integer; result := db.countSql('Select count(*) from Concepts', 'TotalCount'); end; -function TOMOPServices.getDisplay(code: String; langList : THTTPLanguageList): String; +function TOMOPServices.getDisplay(opContext : TTxOperationContext; code: String; langList : THTTPLanguageList): String; var c : TOMOPConcept; msg : String; begin - c := locate(code, nil, msg) as TOMOPConcept; + c := locate(opContext, code, nil, msg) as TOMOPConcept; try if c <> nil then result := c.Display @@ -231,12 +231,12 @@ function TOMOPServices.getDisplay(code: String; langList : THTTPLanguageList): S end; end; -function TOMOPServices.getDefinition(code: String): String; +function TOMOPServices.getDefinition(opContext : TTxOperationContext; code: String): String; begin result := ''; end; -function TOMOPServices.locate(code: String; altOpt : TAlternateCodeOptions; var message: String): TCodeSystemProviderContext; +function TOMOPServices.locate(opContext : TTxOperationContext; code: String; altOpt : TAlternateCodeOptions; var message: String): TCodeSystemProviderContext; var conn : TFDBConnection; c : TOMOPConcept; @@ -271,17 +271,17 @@ function TOMOPServices.locate(code: String; altOpt : TAlternateCodeOptions; var end; end; -function TOMOPServices.locateIsA(code, parent: String; disallowParent: boolean): TCodeSystemProviderContext; +function TOMOPServices.locateIsA(opContext : TTxOperationContext; code, parent: String; disallowParent: boolean): TCodeSystemProviderContext; begin result := nil; // none end; -function TOMOPServices.sameContext(a, b: TCodeSystemProviderContext): boolean; +function TOMOPServices.sameContext(opContext : TTxOperationContext; a, b: TCodeSystemProviderContext): boolean; begin result := (a is TOMOPConcept) and (b is TOMOPConcept) and ((a as TOMOPConcept).code = (b as TOMOPConcept).code); end; -function TOMOPServices.getIterator(context: TCodeSystemProviderContext): TCodeSystemIteratorContext; +function TOMOPServices.getIterator(opContext : TTxOperationContext; context: TCodeSystemProviderContext): TCodeSystemIteratorContext; var qry : TFDBConnection; begin @@ -299,17 +299,17 @@ function TOMOPServices.getIterator(context: TCodeSystemProviderContext): TCodeSy end; end; -function TOMOPServices.getNextContext(context: TCodeSystemIteratorContext): TCodeSystemProviderContext; +function TOMOPServices.getNextContext(opContext : TTxOperationContext; context: TCodeSystemIteratorContext): TCodeSystemProviderContext; begin raise ETerminologyError.Create('getNextContext not supported by RXNorm', itException); // only used when iterating the entire code system. and RxNorm is too big end; -function TOMOPServices.IsAbstract(context: TCodeSystemProviderContext): boolean; +function TOMOPServices.IsAbstract(opContext : TTxOperationContext; context: TCodeSystemProviderContext): boolean; begin result := false; end; -function TOMOPServices.Code(context: TCodeSystemProviderContext): string; +function TOMOPServices.Code(opContext : TTxOperationContext; context: TCodeSystemProviderContext): string; begin if (context is TOMOPConcept) then result := (context as TOMOPConcept).code @@ -317,7 +317,7 @@ function TOMOPServices.Code(context: TCodeSystemProviderContext): string; result := ''; end; -function TOMOPServices.Display(context: TCodeSystemProviderContext; langList : THTTPLanguageList): string; +function TOMOPServices.Display(opContext : TTxOperationContext; context: TCodeSystemProviderContext; langList : THTTPLanguageList): string; begin if (context is TOMOPConcept) then result := (context as TOMOPConcept).display @@ -325,7 +325,7 @@ function TOMOPServices.Display(context: TCodeSystemProviderContext; langList : T result := ''; end; -procedure TOMOPServices.Designations(context: TCodeSystemProviderContext; list: TConceptDesignations); +procedure TOMOPServices.Designations(opContext : TTxOperationContext; context: TCodeSystemProviderContext; list: TConceptDesignations); var conn : TFDBConnection; begin @@ -351,27 +351,27 @@ procedure TOMOPServices.Designations(context: TCodeSystemProviderContext; list: end; end; -function TOMOPServices.Definition(context: TCodeSystemProviderContext): string; +function TOMOPServices.Definition(opContext : TTxOperationContext; context: TCodeSystemProviderContext): string; begin result := ''; end; -function TOMOPServices.getPrepContext: TCodeSystemProviderFilterPreparationContext; +function TOMOPServices.getPrepContext(opContext : TTxOperationContext): TCodeSystemProviderFilterPreparationContext; begin result := nil; end; -function TOMOPServices.prepare(prep: TCodeSystemProviderFilterPreparationContext): boolean; +function TOMOPServices.prepare(opContext : TTxOperationContext; prep: TCodeSystemProviderFilterPreparationContext): boolean; begin result := false; end; -function TOMOPServices.searchFilter(filter: TSearchFilterText; prep: TCodeSystemProviderFilterPreparationContext; sort: boolean): TCodeSystemProviderFilterContext; +function TOMOPServices.searchFilter(opContext : TTxOperationContext; filter: TSearchFilterText; prep: TCodeSystemProviderFilterPreparationContext; sort: boolean): TCodeSystemProviderFilterContext; begin raise ETerminologyError.Create('not done yet: searchFilter', itBusinessRule); end; -function TOMOPServices.filter(forExpansion, forIteration: boolean; prop: String; op: TFhirFilterOperator; value: String; prep: TCodeSystemProviderFilterPreparationContext): TCodeSystemProviderFilterContext; +function TOMOPServices.filter(opContext : TTxOperationContext; forExpansion, forIteration: boolean; prop: String; op: TFhirFilterOperator; value: String; prep: TCodeSystemProviderFilterPreparationContext): TCodeSystemProviderFilterContext; var f : TOMOPFilter; begin @@ -392,22 +392,22 @@ function TOMOPServices.filter(forExpansion, forIteration: boolean; prop: String; raise ETerminologyError.Create('filter "'+prop+' '+CODES_TFhirFilterOperator[op]+' '+value+'" not understood for OMOP', itBusinessRule); end; -function TOMOPServices.filterLocate(ctxt: TCodeSystemProviderFilterContext; code: String; var message: String): TCodeSystemProviderContext; +function TOMOPServices.filterLocate(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext; code: String; var message: String): TCodeSystemProviderContext; begin raise ETerminologyError.Create('not done yet: filterLocate', itBusinessRule); end; -function TOMOPServices.FilterMore(ctxt: TCodeSystemProviderFilterContext): boolean; +function TOMOPServices.FilterMore(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): boolean; begin result := (ctxt as TOMOPFilter).Conn.FetchNext; end; -function TOMOPServices.filterSize(ctxt: TCodeSystemProviderFilterContext): integer; +function TOMOPServices.filterSize(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): integer; begin result := (ctxt as TOMOPFilter).Conn.RowsAffected; end; -function TOMOPServices.FilterConcept(ctxt: TCodeSystemProviderFilterContext): TCodeSystemProviderContext; +function TOMOPServices.FilterConcept(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): TCodeSystemProviderContext; var conn : TFDBConnection; c : TOMOPConcept; @@ -424,22 +424,22 @@ function TOMOPServices.FilterConcept(ctxt: TCodeSystemProviderFilterContext): TC end; end; -function TOMOPServices.InFilter(ctxt: TCodeSystemProviderFilterContext; concept: TCodeSystemProviderContext): Boolean; +function TOMOPServices.InFilter(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext; concept: TCodeSystemProviderContext): Boolean; begin raise ETerminologyError.Create('not done yet: InFilter', itBusinessRule); end; -function TOMOPServices.isNotClosed(textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; +function TOMOPServices.isNotClosed(opContext : TTxOperationContext; textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; begin result := false; end; -procedure TOMOPServices.getCDSInfo(card: TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display: String); +procedure TOMOPServices.getCDSInfo(opContext : TTxOperationContext; card: TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display: String); begin raise ETerminologyError.Create('not done yet: getCDSInfo', itBusinessRule); end; -procedure TOMOPServices.extendLookup(factory: TFHIRFactory; ctxt: TCodeSystemProviderContext; langList : THTTPLanguageList; props: TArray; resp: TFHIRLookupOpResponseW); +procedure TOMOPServices.extendLookup(opContext : TTxOperationContext; factory: TFHIRFactory; ctxt: TCodeSystemProviderContext; langList : THTTPLanguageList; props: TArray; resp: TFHIRLookupOpResponseW); var conn : TFDBConnection; begin @@ -463,7 +463,7 @@ procedure TOMOPServices.extendLookup(factory: TFHIRFactory; ctxt: TCodeSystemPro end; end; -procedure TOMOPServices.defineFeatures(features: TFslList); +procedure TOMOPServices.defineFeatures(opContext : TTxOperationContext; features: TFslList); begin raise ETerminologyError.Create('not done yet: defineFeatures', itBusinessRule); end; diff --git a/server/tx/tx_rxnorm.pas b/server/tx/tx_rxnorm.pas index 0116b8f1e..4a2d57a8f 100644 --- a/server/tx/tx_rxnorm.pas +++ b/server/tx/tx_rxnorm.pas @@ -92,36 +92,36 @@ TUMLSServices = class (TCodeSystemProvider) class function checkDB(conn : TFDBConnection) : String; function TotalCount : integer; override; - function getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; - function getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; - function getDisplay(code : String; langList : THTTPLanguageList):String; override; - function getDefinition(code : String):String; override; - function locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; - function locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; - function sameContext(a, b : TCodeSystemProviderContext) : boolean; override; - function IsAbstract(context : TCodeSystemProviderContext) : boolean; override; - function Code(context : TCodeSystemProviderContext) : string; override; - function Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; - procedure Designations(context : TCodeSystemProviderContext; list : TConceptDesignations); override; - function Definition(context : TCodeSystemProviderContext) : string; override; + function getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; + function getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; + function getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; override; + function getDefinition(opContext : TTxOperationContext; code : String):String; override; + function locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; + function locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; + function sameContext(opContext : TTxOperationContext; a, b : TCodeSystemProviderContext) : boolean; override; + function IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; override; + function Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + function Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; + procedure Designations(opContext : TTxOperationContext; context : TCodeSystemProviderContext; list : TConceptDesignations); override; + function Definition(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; function version : String; override; - function getPrepContext : TCodeSystemProviderFilterPreparationContext; override; - function prepare(prep : TCodeSystemProviderFilterPreparationContext) : boolean; override; - - function searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; - function filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; - function filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; - function FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; override; - function filterSize(ctxt : TCodeSystemProviderFilterContext) : integer; override; - function FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; - function InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; - function isNotClosed(textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; - procedure getCDSInfo(card : TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display : String); override; - procedure extendLookup(factory : TFHIRFactory; ctxt : TCodeSystemProviderContext; langList : THTTPLanguageList; props : TArray; resp : TFHIRLookupOpResponseW); override; + function getPrepContext(opContext : TTxOperationContext) : TCodeSystemProviderFilterPreparationContext; override; + function prepare(opContext : TTxOperationContext; prep : TCodeSystemProviderFilterPreparationContext) : boolean; override; + + function searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; + function filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; + function filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; + function FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; override; + function filterSize(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : integer; override; + function FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; + function InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; + function isNotClosed(opContext : TTxOperationContext; textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; + procedure getCDSInfo(opContext : TTxOperationContext; card : TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display : String); override; + procedure extendLookup(opContext : TTxOperationContext; factory : TFHIRFactory; ctxt : TCodeSystemProviderContext; langList : THTTPLanguageList; props : TArray; resp : TFHIRLookupOpResponseW); override; //function subsumes(codeA, codeB : String) : String; override; - procedure defineFeatures(features : TFslList); override; + procedure defineFeatures(opContext : TTxOperationContext; features : TFslList); override; end; TRxNormServices = class (TUMLSServices) @@ -495,7 +495,7 @@ constructor TUMLSServices.Create(languages : TIETFLanguageDefinitions; i18n : TI Logging.log('Load RxNorm metadata #4'); end; -procedure TUMLSServices.defineFeatures(features: TFslList); +procedure TUMLSServices.defineFeatures(opContext : TTxOperationContext; features: TFslList); begin features.Add(TFHIRFeature.fromString('rest.Codesystem:'+systemUri+'.filter', 'TTY:in')); features.Add(TFHIRFeature.fromString('rest.Codesystem:'+systemUri+'.filter', 'STY:equals')); @@ -528,12 +528,12 @@ function TUMLSServices.TotalCount : integer; end; -function TUMLSServices.getDefinition(code: String): String; +function TUMLSServices.getDefinition(opContext : TTxOperationContext; code: String): String; begin result := ''; end; -function TUMLSServices.getDisplay(code : String; langList : THTTPLanguageList):String; +function TUMLSServices.getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; var qry : TFDBConnection; begin @@ -556,7 +556,7 @@ function TUMLSServices.getDisplay(code : String; langList : THTTPLanguageList):S end; end; -function TUMLSServices.getPrepContext: TCodeSystemProviderFilterPreparationContext; +function TUMLSServices.getPrepContext(opContext : TTxOperationContext): TCodeSystemProviderFilterPreparationContext; begin result := TUMLSPrep.Create; end; @@ -597,7 +597,7 @@ procedure TUMLSServices.load(list: TStringList; sql: String); end; end; -function TUMLSServices.locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; +function TUMLSServices.locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; var qry : TFDBConnection; res : TUMLSConcept; @@ -639,12 +639,12 @@ function TUMLSServices.locate(code : String; altOpt : TAlternateCodeOptions; var end; -function TUMLSServices.Code(context : TCodeSystemProviderContext) : string; +function TUMLSServices.Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; begin result := TUMLSConcept(context).FCode; end; -function TUMLSServices.Definition(context: TCodeSystemProviderContext): string; +function TUMLSServices.Definition(opContext : TTxOperationContext; context: TCodeSystemProviderContext): string; begin result := ''; end; @@ -662,18 +662,18 @@ destructor TUMLSServices.Destroy; inherited; end; -function TUMLSServices.Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; +function TUMLSServices.Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; begin result := TUMLSConcept(context).FDisplay.Trim; end; -procedure TUMLSServices.Designations(context: TCodeSystemProviderContext; list: TConceptDesignations); +procedure TUMLSServices.Designations(opContext : TTxOperationContext; context: TCodeSystemProviderContext; list: TConceptDesignations); begin - list.addDesignation(true, true, '', Display(context, nil)); + list.addDesignation(true, true, '', Display(opContext, context, nil)); list.addDesignation(false, true, '', TUMLSConcept(context).FOthers); end; -procedure TUMLSServices.extendLookup(factory : TFHIRFactory; ctxt: TCodeSystemProviderContext; langList : THTTPLanguageList; props: TArray; resp: TFHIRLookupOpResponseW); +procedure TUMLSServices.extendLookup(opContext : TTxOperationContext; factory : TFHIRFactory; ctxt: TCodeSystemProviderContext; langList : THTTPLanguageList; props: TArray; resp: TFHIRLookupOpResponseW); var qry : TFDBConnection; b : boolean; @@ -712,7 +712,7 @@ procedure TUMLSServices.extendLookup(factory : TFHIRFactory; ctxt: TCodeSystemPr end; list := TConceptDesignations.Create(Factory.link, FLanguages.link); try - Designations(ctxt, list); + Designations(opContext, ctxt, list); for cd in list.designations do begin p := resp.addProp('other.display'); @@ -723,12 +723,12 @@ procedure TUMLSServices.extendLookup(factory : TFHIRFactory; ctxt: TCodeSystemPr end; end; -function TUMLSServices.IsAbstract(context : TCodeSystemProviderContext) : boolean; +function TUMLSServices.IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; begin result := false; // RxNorm doesn't do abstract? end; -function TUMLSServices.isNotClosed(textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; +function TUMLSServices.isNotClosed(opContext : TTxOperationContext; textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; begin result := false; end; @@ -753,7 +753,7 @@ class function TUMLSServices.checkDB(conn: TFDBConnection): String; end; end; -function TUMLSServices.getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; +function TUMLSServices.getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; var qry : TFDBConnection; begin @@ -771,7 +771,7 @@ function TUMLSServices.getIterator(context : TCodeSystemProviderContext) : TCode end; end; -procedure TUMLSServices.getCDSInfo(card: TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display: String); +procedure TUMLSServices.getCDSInfo(opContext : TTxOperationContext; card: TCDSHookCard; langList : THTTPLanguageList; baseURL, code, display: String); begin // b.Append(#13#10+'This term definition is derived from SNOMED CT, which is copyright ) 2002+ International Health Terminology Standards Development Organisation (IHTSDO)'#13#10); card.detail := 'Not done yet'; @@ -782,18 +782,18 @@ function TUMLSServices.getCodeField: String; result := 'RXCUI'; end; -function TUMLSServices.getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; +function TUMLSServices.getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; begin raise ETerminologyError.Create('getNextContext not supported by RXNorm', itException); // only used when iterating the entire code system. and RxNorm is too big end; -function TUMLSServices.locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; +function TUMLSServices.locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; begin result := nil; // todo: no sumbsumption? end; -function TUMLSServices.prepare(prep : TCodeSystemProviderFilterPreparationContext) : boolean; +function TUMLSServices.prepare(opContext : TTxOperationContext; prep : TCodeSystemProviderFilterPreparationContext) : boolean; var sql1 : string; sql2 : String; @@ -828,12 +828,12 @@ function TUMLSServices.prepare(prep : TCodeSystemProviderFilterPreparationContex filter.qry.Execute; end; -function TUMLSServices.sameContext(a, b: TCodeSystemProviderContext): boolean; +function TUMLSServices.sameContext(opContext : TTxOperationContext; a, b: TCodeSystemProviderContext): boolean; begin result := (a is TUMLSConcept) and (b is TUMLSConcept) and ((a as TUMLSConcept).FCode = (b as TUMLSConcept).FCode); end; -function TUMLSServices.searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; +function TUMLSServices.searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; var s : String; i : integer; @@ -873,7 +873,7 @@ function TUMLSServices.searchFilter(filter : TSearchFilterText; prep : TCodeSyst end; end; -function TUMLSServices.filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; +function TUMLSServices.filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; var res : TUMLSFilter; ok : boolean; @@ -920,7 +920,7 @@ function TUMLSServices.filter(forExpansion, forIteration : boolean; prop : Strin end; end; -function TUMLSServices.filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; +function TUMLSServices.filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; var qry : TFDBConnection; res : TUMLSConcept; @@ -956,7 +956,7 @@ function TUMLSServices.filterLocate(ctxt : TCodeSystemProviderFilterContext; cod end; end; -function TUMLSServices.FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; +function TUMLSServices.FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; var filter : TUMLSFilter; begin @@ -972,7 +972,7 @@ function TUMLSServices.FilterMore(ctxt : TCodeSystemProviderFilterContext) : boo result := filter.qry.FetchNext; end; -function TUMLSServices.filterSize(ctxt: TCodeSystemProviderFilterContext): integer; +function TUMLSServices.filterSize(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): integer; var filter : TUMLSFilter; begin @@ -988,7 +988,7 @@ function TUMLSServices.filterSize(ctxt: TCodeSystemProviderFilterContext): integ result := filter.qry.RowsAffected; // todo: check this end; -function TUMLSServices.FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; +function TUMLSServices.FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; var filter : TUMLSFilter; res : TUMLSConcept; @@ -1004,7 +1004,7 @@ function TUMLSServices.FilterConcept(ctxt : TCodeSystemProviderFilterContext): T end; end; -function TUMLSServices.InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; +function TUMLSServices.InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; begin raise ETerminologyError.Create('Error in internal logic - filter not prepped?', itException); end; diff --git a/server/tx/tx_unii.pas b/server/tx/tx_unii.pas index 456537dc3..4ee54d6cb 100644 --- a/server/tx/tx_unii.pas +++ b/server/tx/tx_unii.pas @@ -77,35 +77,35 @@ TUniiServices = class (TCodeSystemProvider) class function checkDB(conn : TFDBConnection) : String; function TotalCount : integer; override; - function getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; - function getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; + function getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; + function getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; function version : String; override; function name(context : TCodeSystemProviderContext) : String; override; function systemUri : String; override; - function getDisplay(code : String; langList : THTTPLanguageList):String; override; - function getDefinition(code : String):String; override; - function locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; - function locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; - function IsAbstract(context : TCodeSystemProviderContext) : boolean; override; - function Code(context : TCodeSystemProviderContext) : string; override; - function Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; - procedure Designations(context : TCodeSystemProviderContext; list : TConceptDesignations); override; - function Definition(context : TCodeSystemProviderContext) : string; override; - - function getPrepContext : TCodeSystemProviderFilterPreparationContext; override; - function prepare(prep : TCodeSystemProviderFilterPreparationContext) : boolean; override; + function getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; override; + function getDefinition(opContext : TTxOperationContext; code : String):String; override; + function locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; + function locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; + function IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; override; + function Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + function Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; + procedure Designations(opContext : TTxOperationContext; context : TCodeSystemProviderContext; list : TConceptDesignations); override; + function Definition(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + + function getPrepContext(opContext : TTxOperationContext) : TCodeSystemProviderFilterPreparationContext; override; + function prepare(opContext : TTxOperationContext; prep : TCodeSystemProviderFilterPreparationContext) : boolean; override; function description : String; override; - function searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; - function filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; - function filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; - function FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; override; - function filterSize(ctxt : TCodeSystemProviderFilterContext) : integer; override; - function FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; - function InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; - function isNotClosed(textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; - - procedure defineFeatures(features : TFslList); override; + function searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; + function filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; + function filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; + function FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; override; + function filterSize(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : integer; override; + function FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; + function InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; + function isNotClosed(opContext : TTxOperationContext; textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; + + procedure defineFeatures(opContext : TTxOperationContext; features : TFslList); override; end; Procedure ImportUnii(filename, version : String; dbm : TFDBManager; callback : TWorkProgressEvent); @@ -141,7 +141,7 @@ constructor TUniiServices.Create(languages : TIETFLanguageDefinitions; i18n : TI end; -procedure TUniiServices.defineFeatures(features: TFslList); +procedure TUniiServices.defineFeatures(opContext : TTxOperationContext; features: TFslList); begin end; @@ -182,12 +182,12 @@ function TUniiServices.systemUri : String; result := URI_UNII; end; -function TUniiServices.getDefinition(code: String): String; +function TUniiServices.getDefinition(opContext : TTxOperationContext; code: String): String; begin result := ''; end; -function TUniiServices.getDisplay(code : String; langList : THTTPLanguageList):String; +function TUniiServices.getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; var qry : TFDBConnection; begin @@ -211,7 +211,7 @@ function TUniiServices.getDisplay(code : String; langList : THTTPLanguageList):S end; end; -function TUniiServices.getPrepContext: TCodeSystemProviderFilterPreparationContext; +function TUniiServices.getPrepContext(opContext : TTxOperationContext): TCodeSystemProviderFilterPreparationContext; begin raise ETerminologyTodo.Create('TUniiServices.getPrepContext'); end; @@ -299,7 +299,7 @@ function TUniiServices.getPrepContext: TCodeSystemProviderFilterPreparationConte end; end; -function TUniiServices.locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; +function TUniiServices.locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; var qry : TFDBConnection; res : TUniiConcept; @@ -349,12 +349,12 @@ function TUniiServices.locate(code : String; altOpt : TAlternateCodeOptions; var end; -function TUniiServices.Code(context : TCodeSystemProviderContext) : string; +function TUniiServices.Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; begin result := TUniiConcept(context).FCode; end; -function TUniiServices.Definition(context: TCodeSystemProviderContext): string; +function TUniiServices.Definition(opContext : TTxOperationContext; context: TCodeSystemProviderContext): string; begin result := ''; end; @@ -370,23 +370,23 @@ destructor TUniiServices.Destroy; inherited; end; -function TUniiServices.Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; +function TUniiServices.Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; begin result := TUniiConcept(context).FDisplay.trim; end; -procedure TUniiServices.Designations(context: TCodeSystemProviderContext; list: TConceptDesignations); +procedure TUniiServices.Designations(opContext : TTxOperationContext; context: TCodeSystemProviderContext; list: TConceptDesignations); begin - list.addDesignation(true, true, '', Display(context, nil)); + list.addDesignation(true, true, '', Display(opContext, context, nil)); list.addDesignation(false, true, '', TUniiConcept(context).FOthers); end; -function TUniiServices.IsAbstract(context : TCodeSystemProviderContext) : boolean; +function TUniiServices.IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; begin result := false; // Unii doesn't do abstract end; -function TUniiServices.isNotClosed(textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; +function TUniiServices.isNotClosed(opContext : TTxOperationContext; textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; begin result := false; end; @@ -411,17 +411,17 @@ class function TUniiServices.checkDB(conn: TFDBConnection): String; end; end; -function TUniiServices.getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; +function TUniiServices.getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; begin result := TCodeSystemIteratorContext.Create(nil, 0); // no children end; -function TUniiServices.getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; +function TUniiServices.getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; begin raise ETerminologyTodo.Create('TUniiServices.getcontext'); end; -function TUniiServices.locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; +function TUniiServices.locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; begin raise ETerminologyError.Create('locateIsA not supported by Unii', itNotSupported); // Unii doesn't have formal subsumption property, so this is not used end; @@ -432,42 +432,42 @@ function TUniiServices.name(context: TCodeSystemProviderContext): String; result := 'UNII'; end; -function TUniiServices.prepare(prep : TCodeSystemProviderFilterPreparationContext) : boolean; +function TUniiServices.prepare(opContext : TTxOperationContext; prep : TCodeSystemProviderFilterPreparationContext) : boolean; begin raise ETerminologyTodo.Create('TUniiServices.prepare'); end; -function TUniiServices.searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; +function TUniiServices.searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; begin raise ETerminologyTodo.Create('TUniiServices.searchFilter'); end; -function TUniiServices.filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; +function TUniiServices.filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; begin raise ETerminologyTodo.Create('TUniiServices.filter'); end; -function TUniiServices.filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; +function TUniiServices.filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; begin raise ETerminologyTodo.Create('TUniiServices.filterLocate'); end; -function TUniiServices.FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; +function TUniiServices.FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; begin raise ETerminologyTodo.Create('TUniiServices.FilterMore'); end; -function TUniiServices.filterSize(ctxt: TCodeSystemProviderFilterContext): integer; +function TUniiServices.filterSize(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): integer; begin raise ETerminologyTodo.Create('TUniiServices.FilterMore'); end; -function TUniiServices.FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; +function TUniiServices.FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; begin raise ETerminologyTodo.Create('TUniiServices.FilterConcept'); end; -function TUniiServices.InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; +function TUniiServices.InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; begin raise ETerminologyTodo.Create('TUniiServices.InFilter'); end; diff --git a/server/tx/tx_uri.pas b/server/tx/tx_uri.pas index 16a3e0621..50fcee1cf 100644 --- a/server/tx/tx_uri.pas +++ b/server/tx/tx_uri.pas @@ -56,34 +56,34 @@ TUriServices = class (TCodeSystemProvider) function description : String; override; function TotalCount : integer; override; - function getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; - function getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; + function getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; + function getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; function systemUri : String; override; function version : String; override; function name(context : TCodeSystemProviderContext) : String; override; - function getDisplay(code : String; langList : THTTPLanguageList):String; override; - function getDefinition(code : String):String; override; - function locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; - function locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; - function IsAbstract(context : TCodeSystemProviderContext) : boolean; override; - function Code(context : TCodeSystemProviderContext) : string; override; - function Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; - procedure Designations(context : TCodeSystemProviderContext; list : TConceptDesignations); override; - function Definition(context : TCodeSystemProviderContext) : string; override; - - function getPrepContext : TCodeSystemProviderFilterPreparationContext; override; - function prepare(prep : TCodeSystemProviderFilterPreparationContext) : boolean; override; - - function searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; - function filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; - function filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; - function FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; override; - function filterSize(ctxt : TCodeSystemProviderFilterContext) : integer; override; - function FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; - function InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; - function isNotClosed(textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; - - procedure defineFeatures(features : TFslList); override; + function getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; override; + function getDefinition(opContext : TTxOperationContext; code : String):String; override; + function locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; + function locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; + function IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; override; + function Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + function Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; + procedure Designations(opContext : TTxOperationContext; context : TCodeSystemProviderContext; list : TConceptDesignations); override; + function Definition(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + + function getPrepContext(opContext : TTxOperationContext) : TCodeSystemProviderFilterPreparationContext; override; + function prepare(opContext : TTxOperationContext; prep : TCodeSystemProviderFilterPreparationContext) : boolean; override; + + function searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; + function filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; + function filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; + function FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; override; + function filterSize(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : integer; override; + function FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; + function InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; + function isNotClosed(opContext : TTxOperationContext; textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; + + procedure defineFeatures(opContext : TTxOperationContext; features : TFslList); override; end; implementation @@ -106,37 +106,37 @@ function TUriServices.systemUri : String; result := URI_URIs; end; -function TUriServices.getDefinition(code: String): String; +function TUriServices.getDefinition(opContext : TTxOperationContext; code: String): String; begin result := ''; end; -function TUriServices.getDisplay(code : String; langList : THTTPLanguageList):String; +function TUriServices.getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; begin result := ''; end; -function TUriServices.getPrepContext: TCodeSystemProviderFilterPreparationContext; +function TUriServices.getPrepContext(opContext : TTxOperationContext): TCodeSystemProviderFilterPreparationContext; begin raise ETerminologyTodo.Create('TUriServices.getPrepContext'); end; -function TUriServices.locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; +function TUriServices.locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; begin result := TUriHolder.Create(code); end; -function TUriServices.Code(context : TCodeSystemProviderContext) : string; +function TUriServices.Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; begin result := TUriHolder(context).url; end; -procedure TUriServices.defineFeatures(features: TFslList); +procedure TUriServices.defineFeatures(opContext : TTxOperationContext; features: TFslList); begin end; -function TUriServices.Definition(context: TCodeSystemProviderContext): string; +function TUriServices.Definition(opContext : TTxOperationContext; context: TCodeSystemProviderContext): string; begin result := ''; end; @@ -146,21 +146,21 @@ function TUriServices.description: String; result := 'URIs'; end; -function TUriServices.Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; +function TUriServices.Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; begin result := ''; end; -procedure TUriServices.Designations(context: TCodeSystemProviderContext; list: TConceptDesignations); +procedure TUriServices.Designations(opContext : TTxOperationContext; context: TCodeSystemProviderContext; list: TConceptDesignations); begin end; -function TUriServices.IsAbstract(context : TCodeSystemProviderContext) : boolean; +function TUriServices.IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; begin result := false; // Uri doesn't do abstract end; -function TUriServices.isNotClosed(textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; +function TUriServices.isNotClosed(opContext : TTxOperationContext; textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; begin result := true; end; @@ -170,17 +170,17 @@ function TUriServices.Link: TUriServices; result := TUriServices(Inherited Link); end; -function TUriServices.getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; +function TUriServices.getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; begin result := TCodeSystemIteratorContext.Create(nil, 0); // no children end; -function TUriServices.getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; +function TUriServices.getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; begin raise ETerminologyTodo.Create('TUriServices.getcontext'); end; -function TUriServices.locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; +function TUriServices.locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; begin raise ETerminologyError.Create('locateIsA not supported by Uri', itNotSupported); // Uri doesn't have formal subsumption property, so this is not used end; @@ -191,42 +191,42 @@ function TUriServices.name(context: TCodeSystemProviderContext): String; result := 'Internal URI services'; end; -function TUriServices.prepare(prep : TCodeSystemProviderFilterPreparationContext) : boolean; +function TUriServices.prepare(opContext : TTxOperationContext; prep : TCodeSystemProviderFilterPreparationContext) : boolean; begin raise ETerminologyTodo.Create('TUriServices.prepare'); end; -function TUriServices.searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; +function TUriServices.searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; begin raise ETerminologyTodo.Create('TUriServices.searchFilter'); end; -function TUriServices.filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; +function TUriServices.filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; begin raise ETerminologyTodo.Create('TUriServices.filter'); end; -function TUriServices.filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; +function TUriServices.filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; begin raise ETerminologyTodo.Create('TUriServices.filterLocate'); end; -function TUriServices.FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; +function TUriServices.FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; begin raise ETerminologyTodo.Create('TUriServices.FilterMore'); end; -function TUriServices.filterSize(ctxt: TCodeSystemProviderFilterContext): integer; +function TUriServices.filterSize(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): integer; begin raise ETerminologyTodo.Create('TUriServices.FilterSize'); end; -function TUriServices.FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; +function TUriServices.FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; begin raise ETerminologyTodo.Create('TUriServices.FilterConcept'); end; -function TUriServices.InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; +function TUriServices.InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; begin raise ETerminologyTodo.Create('TUriServices.InFilter'); end; diff --git a/server/tx/tx_us_states.pas b/server/tx/tx_us_states.pas index e2124e478..1cd176db9 100644 --- a/server/tx/tx_us_states.pas +++ b/server/tx/tx_us_states.pas @@ -75,33 +75,33 @@ TUSStateServices = class (TCodeSystemProvider) function description : String; override; function TotalCount : integer; override; - function getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; - function getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; + function getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; override; + function getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; override; function systemUri : String; override; - function getDisplay(code : String; langList : THTTPLanguageList):String; override; - function getDefinition(code : String):String; override; - function locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; - function locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; - function IsAbstract(context : TCodeSystemProviderContext) : boolean; override; - function Code(context : TCodeSystemProviderContext) : string; override; - function Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; - procedure Designations(context : TCodeSystemProviderContext; list : TConceptDesignations); override; - function Definition(context : TCodeSystemProviderContext) : string; override; - - function getPrepContext : TCodeSystemProviderFilterPreparationContext; override; - function prepare(prep : TCodeSystemProviderFilterPreparationContext) : boolean; override; - - function searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; - function filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; - function filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; - function FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; override; - function filterSize(ctxt : TCodeSystemProviderFilterContext) : integer; override; - function FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; - function InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; - function isNotClosed(textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; - function subsumesTest(codeA, codeB : String) : String; override; - - procedure defineFeatures(features : TFslList); override; + function getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; override; + function getDefinition(opContext : TTxOperationContext; code : String):String; override; + function locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; override; + function locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; override; + function IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; override; + function Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + function Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; override; + procedure Designations(opContext : TTxOperationContext; context : TCodeSystemProviderContext; list : TConceptDesignations); override; + function Definition(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; override; + + function getPrepContext(opContext : TTxOperationContext) : TCodeSystemProviderFilterPreparationContext; override; + function prepare(opContext : TTxOperationContext; prep : TCodeSystemProviderFilterPreparationContext) : boolean; override; + + function searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; override; + function filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; override; + function filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; override; + function FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; override; + function filterSize(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : integer; override; + function FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; override; + function InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; override; + function isNotClosed(opContext : TTxOperationContext; textFilter : TSearchFilterText; propFilter : TCodeSystemProviderFilterContext = nil) : boolean; override; + function subsumesTest(opContext : TTxOperationContext; codeA, codeB : String) : String; override; + + procedure defineFeatures(opContext : TTxOperationContext; features : TFslList); override; end; implementation @@ -118,7 +118,7 @@ constructor TUSStateServices.Create(languages: TIETFLanguageDefinitions; i18n : end; -procedure TUSStateServices.defineFeatures(features: TFslList); +procedure TUSStateServices.defineFeatures(opContext : TTxOperationContext; features: TFslList); begin end; @@ -133,12 +133,12 @@ function TUSStateServices.systemUri : String; result := 'https://www.usps.com/'; end; -function TUSStateServices.getDefinition(code: String): String; +function TUSStateServices.getDefinition(opContext : TTxOperationContext; code: String): String; begin result := ''; end; -function TUSStateServices.getDisplay(code : String; langList : THTTPLanguageList):String; +function TUSStateServices.getDisplay(opContext : TTxOperationContext; code : String; langList : THTTPLanguageList):String; var v : TUSStateConcept; begin @@ -148,7 +148,7 @@ function TUSStateServices.getDisplay(code : String; langList : THTTPLanguageList result := ''; end; -function TUSStateServices.getPrepContext: TCodeSystemProviderFilterPreparationContext; +function TUSStateServices.getPrepContext(opContext : TTxOperationContext): TCodeSystemProviderFilterPreparationContext; begin result := nil; end; @@ -234,18 +234,18 @@ procedure TUSStateServices.load; doLoad('AA', 'Armed Forces Americas (except Canada)'); end; -function TUSStateServices.locate(code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; +function TUSStateServices.locate(opContext : TTxOperationContext; code : String; altOpt : TAlternateCodeOptions; var message : String) : TCodeSystemProviderContext; begin result := FMap[code].link; end; -function TUSStateServices.Code(context : TCodeSystemProviderContext) : string; +function TUSStateServices.Code(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : string; begin result := TUSStateConcept(context).code; end; -function TUSStateServices.Definition(context: TCodeSystemProviderContext): string; +function TUSStateServices.Definition(opContext : TTxOperationContext; context: TCodeSystemProviderContext): string; begin result := ''; end; @@ -262,22 +262,22 @@ destructor TUSStateServices.Destroy; inherited; end; -function TUSStateServices.Display(context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; +function TUSStateServices.Display(opContext : TTxOperationContext; context : TCodeSystemProviderContext; langList : THTTPLanguageList) : string; begin result := TUSStateConcept(context).display.Trim; end; -procedure TUSStateServices.Designations(context: TCodeSystemProviderContext; list: TConceptDesignations); +procedure TUSStateServices.Designations(opContext : TTxOperationContext; context: TCodeSystemProviderContext; list: TConceptDesignations); begin - list.addDesignation(true, true, '', Display(context, nil)); + list.addDesignation(true, true, '', Display(opContext, context, nil)); end; -function TUSStateServices.IsAbstract(context : TCodeSystemProviderContext) : boolean; +function TUSStateServices.IsAbstract(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : boolean; begin result := false; // USState doesn't do abstract end; -function TUSStateServices.isNotClosed(textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; +function TUSStateServices.isNotClosed(opContext : TTxOperationContext; textFilter: TSearchFilterText; propFilter: TCodeSystemProviderFilterContext): boolean; begin result := false; end; @@ -287,7 +287,7 @@ function TUSStateServices.Link: TUSStateServices; result := TUSStateServices(Inherited Link); end; -function TUSStateServices.getIterator(context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; +function TUSStateServices.getIterator(opContext : TTxOperationContext; context : TCodeSystemProviderContext) : TCodeSystemIteratorContext; begin if (context = nil) then result := TCodeSystemIteratorContext.Create(nil, TotalCount) @@ -295,61 +295,61 @@ function TUSStateServices.getIterator(context : TCodeSystemProviderContext) : TC result := TCodeSystemIteratorContext.Create(nil, 0); // no children end; -function TUSStateServices.getNextContext(context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; +function TUSStateServices.getNextContext(opContext : TTxOperationContext; context : TCodeSystemIteratorContext) : TCodeSystemProviderContext; begin result := FCodes[context.current].link; context.next; end; -function TUSStateServices.locateIsA(code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; +function TUSStateServices.locateIsA(opContext : TTxOperationContext; code, parent : String; disallowParent : boolean = false) : TCodeSystemProviderContext; begin raise ETerminologyError.Create('locateIsA not supported by USState', itNotSupported); // USState doesn't have formal subsumption property, so this is not used end; -function TUSStateServices.prepare(prep : TCodeSystemProviderFilterPreparationContext) : boolean; +function TUSStateServices.prepare(opContext : TTxOperationContext; prep : TCodeSystemProviderFilterPreparationContext) : boolean; begin // nothing result := false; end; -function TUSStateServices.searchFilter(filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; +function TUSStateServices.searchFilter(opContext : TTxOperationContext; filter : TSearchFilterText; prep : TCodeSystemProviderFilterPreparationContext; sort : boolean) : TCodeSystemProviderFilterContext; begin raise ETerminologyTodo.Create('TUSStateServices.searchFilter'); end; -function TUSStateServices.subsumesTest(codeA, codeB: String): String; +function TUSStateServices.subsumesTest(opContext : TTxOperationContext; codeA, codeB: String): String; begin result := 'not-subsumed'; end; -function TUSStateServices.filter(forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; +function TUSStateServices.filter(opContext : TTxOperationContext; forExpansion, forIteration : boolean; prop : String; op : TFhirFilterOperator; value : String; prep : TCodeSystemProviderFilterPreparationContext) : TCodeSystemProviderFilterContext; begin raise ETerminologyError.Create('the filter '+prop+' '+CODES_TFhirFilterOperator[op]+' = '+value+' is not supported for '+systemUri, itNotSupported); end; -function TUSStateServices.filterLocate(ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; +function TUSStateServices.filterLocate(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; code : String; var message : String) : TCodeSystemProviderContext; begin raise ETerminologyTodo.Create('TUSStateServices.filterLocate'); end; -function TUSStateServices.FilterMore(ctxt : TCodeSystemProviderFilterContext) : boolean; +function TUSStateServices.FilterMore(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext) : boolean; begin TUSStateConceptFilter(ctxt).FCursor := TUSStateConceptFilter(ctxt).FCursor + 1; result := TUSStateConceptFilter(ctxt).FCursor < TUSStateConceptFilter(ctxt).FList.Count; end; -function TUSStateServices.filterSize(ctxt: TCodeSystemProviderFilterContext): integer; +function TUSStateServices.filterSize(opContext : TTxOperationContext; ctxt: TCodeSystemProviderFilterContext): integer; begin result := TUSStateConceptFilter(ctxt).FList.Count; end; -function TUSStateServices.FilterConcept(ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; +function TUSStateServices.FilterConcept(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext): TCodeSystemProviderContext; begin result := TUSStateConceptFilter(ctxt).FList[TUSStateConceptFilter(ctxt).FCursor].link; end; -function TUSStateServices.InFilter(ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; +function TUSStateServices.InFilter(opContext : TTxOperationContext; ctxt : TCodeSystemProviderFilterContext; concept : TCodeSystemProviderContext) : Boolean; begin raise ETerminologyTodo.Create('TUSStateServices.InFilter'); end; diff --git a/server/tx_manager.pas b/server/tx_manager.pas index 91b2eb2f8..5259e55ad 100644 --- a/server/tx_manager.pas +++ b/server/tx_manager.pas @@ -576,7 +576,7 @@ function TTerminologyServerStore.subsumes(cs: TFhirCodeSystemW; codeA, codeB: TF prov := getProvider(cs, nil); try - result := prov.subsumesTest(codeA.code, codeB.code); + result := prov.subsumesTest(nil, codeA.code, codeB.code); finally prov.free; end; @@ -1536,7 +1536,7 @@ function TTerminologyServerStore.subsumes(uri1, code1, uri2, code2: String): boo if prov <> nil then begin try - loc := prov.locateIsA(code2, code1); + loc := prov.locateIsA(nil, code2, code1); result := Loc <> nil; loc.free; finally @@ -1586,32 +1586,32 @@ procedure TCommonTerminologies.defineFeatures(features: TFslList); sp : TSnomedProvider; begin if FLoinc <> nil then - FLoinc.defineFeatures(features); + FLoinc.defineFeatures(nil, features); if FDefSnomed <> nil then begin sp := TSnomedProvider.Create(FDefSnomed.link, FI18n.link, nil); try - sp.defineFeatures(features); + sp.defineFeatures(nil, features); finally sp.free; end; end; if FUcum <> nil then - FUcum.defineFeatures(features); + FUcum.defineFeatures(nil, features); if FRxNorm <> nil then - FRxNorm.defineFeatures(features); + FRxNorm.defineFeatures(nil, features); if FUnii <> nil then - FUnii.defineFeatures(features); + FUnii.defineFeatures(nil, features); if FCPT <> nil then - FCPT.defineFeatures(features); + FCPT.defineFeatures(nil, features); if FOMOP <> nil then - FOMOP.defineFeatures(features); + FOMOP.defineFeatures(nil, features); if FACIR <> nil then - FACIR.defineFeatures(features); + FACIR.defineFeatures(nil, features); if FNDFRT <> nil then - FNDFRT.defineFeatures(features); + FNDFRT.defineFeatures(nil, features); if FNDC <> nil then - FNDC.defineFeatures(features); + FNDC.defineFeatures(nil, features); end; destructor TCommonTerminologies.Destroy; diff --git a/server/tx_operations.pas b/server/tx_operations.pas index b5711bc87..53d9aacbd 100644 --- a/server/tx_operations.pas +++ b/server/tx_operations.pas @@ -69,7 +69,7 @@ TFhirExpandValueSetOperation = class (TFhirTerminologyOperation) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -84,7 +84,7 @@ TFhirValueSetValidationOperation = class (TFhirTerminologyOperation) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -110,7 +110,7 @@ TFhirSubsumesOperation = class (TFhirTerminologyOperation) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -128,7 +128,7 @@ TFhirConceptMapTranslationOperation = class (TFhirTerminologyOperation) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -141,7 +141,7 @@ TFhirLookupCodeSystemOperation = class (TFhirTerminologyOperation) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -156,7 +156,7 @@ TFhirConceptMapClosureOperation = class (TFhirTerminologyOperation) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; @@ -176,7 +176,7 @@ TFhirFeatureNegotiation = class (TFhirOperation) function Name : String; override; function Types : TArray; override; function CreateDefinition(base : String) : TFHIROperationDefinitionW; override; - function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TTimeTracker) : String; override; + function Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response : TFHIRResponse; tt : TFslTimeTracker) : String; override; function formalURL : String; override; end; {$ENDIF} @@ -239,7 +239,7 @@ function TFhirExpandValueSetOperation.CreateDefinition(base : String): TFHIROper result := nil; end; -function TFhirExpandValueSetOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirExpandValueSetOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var vs, dst : TFHIRValueSetW; resourceKey, versionKey : integer; @@ -353,7 +353,8 @@ function TFhirExpandValueSetOperation.Execute(context : TOperationContext; manag if (txResources = nil) then txResources := processAdditionalResources(context, manager, nil, params); - dst := FServer.expandVS(vs, request.internalRequestId, cacheId, profile, filter, limit, count, offset, txResources, params.str('no-cache') = 'please'); + dst := FServer.expandVS(vs, request.internalRequestId, cacheId, profile, filter, limit, count, offset, txResources, + params.str('no-cache') = 'please', params.str('diagnostics') = 'true', tt); try response.HTTPCode := 200; response.Message := 'OK'; @@ -446,7 +447,7 @@ function canonicalMatches(mr : TFHIRMetadataResourceW; canonical, version : Stri result := (mr.url = l) and ((r = '') or (r = mr.version)); end; -function TFhirValueSetValidationOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirValueSetValidationOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var vs : TFHIRValueSetW; resourceKey, versionKey : integer; @@ -561,7 +562,7 @@ function TFhirValueSetValidationOperation.Execute(context : TOperationContext; m if txResources = nil then txResources := processAdditionalResources(context, manager, nil, params); - pout := FServer.validate(request.id, issuePath, vs, coded, profile, abstractOk, inferSystem, mode, txResources, summary); + pout := FServer.validate(request.id, issuePath, vs, coded, profile, abstractOk, inferSystem, mode, txResources, summary, tt); end; if summary <> '' then result := result + ': '+summary; @@ -800,7 +801,7 @@ procedure TFhirConceptMapTranslationOperation.findConceptMap(list : TFslList; // op : TFhirOperationOutcome; @@ -919,7 +920,7 @@ function TFhirLookupCodeSystemOperation.CreateDefinition(base : String): TFHIROp result := nil; end; -function TFhirLookupCodeSystemOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirLookupCodeSystemOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var req : TFHIRLookupOpRequestW; resp : TFHIRLookupOpResponseW; @@ -1042,7 +1043,7 @@ function TFhirConceptMapClosureOperation.CreateDefinition(base: String): TFHIROp result := nil; end; -function TFhirConceptMapClosureOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirConceptMapClosureOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var params : TFhirParametersW; p : TFhirParametersParameterW; @@ -1190,7 +1191,7 @@ function TFhirSubsumesOperation.CreateDefinition(base : String): TFHIROperationD result := nil; end; -function TFhirSubsumesOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TTimeTracker) : String; +function TFhirSubsumesOperation.Execute(context : TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt : TFslTimeTracker) : String; var req : TFHIRSubsumesOpRequestW; resp : TFHIRSubsumesOpResponseW; @@ -1720,7 +1721,7 @@ function TFhirFeatureNegotiation.CreateDefinition(base: String): TFHIROperationD Result := nil; end; -function TFhirFeatureNegotiation.Execute(context: TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt: TTimeTracker): String; +function TFhirFeatureNegotiation.Execute(context: TOperationContext; manager: TFHIROperationEngine; request: TFHIRRequest; response: TFHIRResponse; tt: TFslTimeTracker): String; var features : TFslList; feature : TFhirFeatureQueryItem; diff --git a/server/tx_registry_spider.pas b/server/tx_registry_spider.pas index c312dfead..0b518c332 100644 --- a/server/tx_registry_spider.pas +++ b/server/tx_registry_spider.pas @@ -41,10 +41,12 @@ interface fhir3_client, fhir3_types, fhir3_resources_base, fhir3_resources, fhir3_resources_canonical, fhir3_utilities, fhir4_client, fhir4_types, fhir4_resources_base, fhir4_resources, fhir4_resources_canonical, fhir4_utilities, fhir5_client, fhir5_types, fhir5_resources_base, fhir5_resources, fhir5_resources_canonical, fhir5_enums, fhir5_utilities, - tx_registry_model; + tx_registry_model, + server_config; const - MASTER_URL = 'https://fhir.github.io/ig-registry/tx-servers.json'; + //MASTER_URL = 'https://fhir.github.io/ig-registry/tx-servers.json'; + MASTER_URL = 'file:/Users/grahamegrieve/work/ig-registry/tx-servers.json'; EMAIL_DAYS_LIMIT = 7; Type @@ -81,22 +83,24 @@ TTxRegistryScanner = class (TFslObject) FIni : TIniFile; FZulip : TZulipTracker; FLogFileName : String; + FAdmin : TFHIRServerConfigSection; procedure DoSendEmail(dest, subj, body : String); procedure log(msg, source : String; error : boolean); function fetchUrl(url, mimetype : string) : TBytes; function fetchJson(url : string) : TJsonObject; + function makeHTTP(url, code : String) : TFHIRHTTPCommunicator; - procedure processServerVersionR3(version, source, url : String; ver : TServerVersionInformation); - procedure processServerVersionR4(version, source, url : String; ver : TServerVersionInformation); - procedure processServerVersionR5(version, source, url : String; ver : TServerVersionInformation); + procedure processServerVersionR3(version, source, url, code : String; ver : TServerVersionInformation); + procedure processServerVersionR4(version, source, url, code : String; ver : TServerVersionInformation); + procedure processServerVersionR5(version, source, url, code : String; ver : TServerVersionInformation); procedure processServerVersion(source : String; srvr: TServerInformation; obj : TJsonObject; ver : TServerVersionInformation); procedure processServer(source : String; obj : TJsonObject; srvr : TServerInformation); procedure processRegistry(obj : TJsonObject; reg : TServerRegistry); public - constructor Create(zulip : TZulipTracker); + constructor Create(zulip : TZulipTracker; admin : TFHIRServerConfigSection); destructor Destroy; override; procedure update(name : String; info : TServerRegistries); @@ -115,17 +119,19 @@ function fix(url : String) : String; { TTxRegistryScanner } -constructor TTxRegistryScanner.Create(zulip: TZulipTracker); +constructor TTxRegistryScanner.Create(zulip: TZulipTracker; admin : TFHIRServerConfigSection); begin inherited Create; FZulip := zulip; FAddress := MASTER_URL; FLogFileName := FilePath(['[tmp]', 'tx-registry-spider.log']); + FAdmin := admin; end; destructor TTxRegistryScanner.Destroy; begin FZulip.free; + FAdmin.free; inherited; end; @@ -163,6 +169,29 @@ function TTxRegistryScanner.fetchJson(url: string): TJsonObject; result := TJSONParser.Parse(fetchUrl(url, 'application/json')); end; +function TTxRegistryScanner.makeHTTP(url, code: String): TFHIRHTTPCommunicator; +var + s : String; +begin + result := TFHIRHTTPCommunicator.Create(url); + try + s := FAdmin[url].value; + if (s = '') then + s := FAdmin[code].value; + + if (s <> '') then + begin + if (s.startsWith('apikey:')) then + result.ApiKey := s.subString(7) + else + raise EFslException.create('unable to understand '+s); + end; + result.link; + finally + result.free; + end; +end; + procedure TTxRegistryScanner.log(msg, source: String; error : boolean); begin if error then @@ -339,9 +368,9 @@ procedure TTxRegistryScanner.processServerVersion(source: String; srvr: TServerI v := TSemanticVersion.fromString(obj.str['version']); try case v.Major of - 3: processServerVersionR3(obj.str['version'], source, obj.str['url'], ver); - 4: processServerVersionR4(obj.str['version'], source, obj.str['url'], ver); - 5: processServerVersionR5(obj.str['version'], source, obj.str['url'], ver); + 3: processServerVersionR3(obj.str['version'], source, obj.str['url'], srvr.Code, ver); + 4: processServerVersionR4(obj.str['version'], source, obj.str['url'], srvr.Code, ver); + 5: processServerVersionR5(obj.str['version'], source, obj.str['url'], srvr.Code, ver); else log('Exception processing server: '+srvr.Name+'@'+srvr.address+' : Version '+obj.str['version']+' not supported', source, false); end; @@ -363,7 +392,7 @@ procedure TTxRegistryScanner.processServerVersion(source: String; srvr: TServerI end; end; -procedure TTxRegistryScanner.processServerVersionR4(version, source, url : String; ver : TServerVersionInformation); +procedure TTxRegistryScanner.processServerVersionR4(version, source, url, code: String; ver : TServerVersionInformation); var client : TFhirClient4; cs : fhir4_resources_canonical.TFhirCapabilityStatement; @@ -377,7 +406,7 @@ procedure TTxRegistryScanner.processServerVersionR4(version, source, url : Strin vs : fhir4_resources.TFHIRValueSet; begin try - client := TFhirClient4.Create(nil, nil, TFHIRHTTPCommunicator.Create(url)); + client := TFhirClient4.Create(nil, nil, makeHTTP(url, code)); try client.Logger := TTextFileLogger.create(FLogFileName); client.format := ffJson; @@ -391,16 +420,28 @@ procedure TTxRegistryScanner.processServerVersionR4(version, source, url : Strin for cc in csr.security.serviceList do begin if (cc.hasCode('http://hl7.org/fhir/restful-security-service', 'OAuth')) then - ver.Security := ver.Security + [ssOAuth] - else if (cc.hasCode('http://hl7.org/fhir/restful-security-service', 'SMART-on-FHIR')) then - ver.Security := ver.Security + [ssSmart] - else if (cc.hasCode('http://hl7.org/fhir/restful-security-service', 'Basic')) then - ver.Security := ver.Security + [ssPassword] - else if (cc.hasCode('http://hl7.org/fhir/restful-security-service', 'Certificates')) then - ver.Security := ver.Security + [ssCert] - else if (cc.hasCode('http://hl7.org/fhir/restful-security-service', 'Token')) then - ver.Security := ver.Security + [ssToken] - else if (cc.hasCode('http://hl7.org/fhir/restful-security-service', 'Open')) then + ver.Security := ver.Security + [ssOAuth]; + if (cc.hasCode('http://hl7.org/fhir/restful-security-service', 'SMART-on-FHIR')) then + ver.Security := ver.Security + [ssSmart]; + if (cc.hasCode('http://hl7.org/fhir/restful-security-service', 'Basic')) then + ver.Security := ver.Security + [ssPassword]; + if (cc.hasCode('http://hl7.org/fhir/restful-security-service', 'Certificates')) then + ver.Security := ver.Security + [ssCert]; + if (cc.hasCode('http://hl7.org/fhir/restful-security-service', 'Token')) then + ver.Security := ver.Security + [ssToken]; + if (cc.hasCode('http://hl7.org/fhir/restful-security-service', 'Open')) then + ver.Security := ver.Security + [ssOpen]; + if (cc.hasCode('http://terminology.hl7.org/CodeSystem/restful-security-service', 'OAuth')) then + ver.Security := ver.Security + [ssOAuth]; + if (cc.hasCode('http://terminology.hl7.org/CodeSystem/restful-security-service', 'SMART-on-FHIR')) then + ver.Security := ver.Security + [ssSmart]; + if (cc.hasCode('http://terminology.hl7.org/CodeSystem/restful-security-service', 'Basic')) then + ver.Security := ver.Security + [ssPassword]; + if (cc.hasCode('http://terminology.hl7.org/CodeSystem/restful-security-service', 'Certificates')) then + ver.Security := ver.Security + [ssCert]; + if (cc.hasCode('http://terminology.hl7.org/CodeSystem/restful-security-service', 'Token')) then + ver.Security := ver.Security + [ssToken]; + if (cc.hasCode('http://terminology.hl7.org/CodeSystem/restful-security-service', 'Open')) then ver.Security := ver.Security + [ssOpen]; end; end; @@ -439,7 +480,7 @@ procedure TTxRegistryScanner.processServerVersionR4(version, source, url : Strin end; end; -procedure TTxRegistryScanner.processServerVersionR5(version, source, url : String; ver : TServerVersionInformation); +procedure TTxRegistryScanner.processServerVersionR5(version, source, url, code : String; ver : TServerVersionInformation); var client : TFhirClient5; cs : fhir5_resources_canonical.TFhirCapabilityStatement; @@ -452,7 +493,7 @@ procedure TTxRegistryScanner.processServerVersionR5(version, source, url : Strin be : fhir5_resources.TFhirBundleEntry; vs : fhir5_resources.TFHIRValueSet; begin - client := TFhirClient5.Create(nil, nil, TFHIRHTTPCommunicator.Create(url)); + client := TFhirClient5.Create(nil, nil, makeHTTP(url, code)); try client.Logger := TTextFileLogger.create(FilePath(['[tmp]', 'tx-registry-spider.log'])); client.format := ffJson; @@ -510,7 +551,7 @@ procedure TTxRegistryScanner.processServerVersionR5(version, source, url : Strin end; end; -procedure TTxRegistryScanner.processServerVersionR3(version, source, url : String; ver : TServerVersionInformation); +procedure TTxRegistryScanner.processServerVersionR3(version, source, url, code : String; ver : TServerVersionInformation); var client : TFhirClient3; cs : fhir3_resources_canonical.TFhirCapabilityStatement; @@ -524,7 +565,7 @@ procedure TTxRegistryScanner.processServerVersionR3(version, source, url : Strin vs : fhir3_resources.TFHIRValueSet; n : String; begin - client := TFhirClient3.Create(nil, nil, TFHIRHTTPCommunicator.Create(url)); + client := TFhirClient3.Create(nil, nil, makeHTTP(url, code)); try client.Logger := TTextFileLogger.create(FilePath(['[tmp]', 'tx-registry-spider.log'])); client.format := ffJson; diff --git a/server/tx_server.pas b/server/tx_server.pas index a8d9cb75c..56b75de2e 100644 --- a/server/tx_server.pas +++ b/server/tx_server.pas @@ -40,7 +40,7 @@ interface uses SysUtils, Classes, IniFiles, Generics.Collections, - fsl_base, fsl_utilities, fsl_collections, fsl_http, fsl_threads, fsl_i18n, + fsl_base, fsl_utilities, fsl_collections, fsl_http, fsl_threads, fsl_i18n, fsl_logging, fdb_manager, fhir_objects, fhir_common, fhir_cdshooks, fhir_factory, fhir_features, fhir_uris, fhir_tx, fhir_valuesets, @@ -126,24 +126,24 @@ TTerminologyServer = class (TTerminologyServerStore) function isKnownValueSet(id : String; out vs : TFhirValueSetW): Boolean; // given a value set, expand it - function expandVS(vs : TFhirValueSetW; reqId, cacheId : String; profile : TFHIRTxOperationParams; textFilter : String; limit, count, offset : integer; txResources : TFslMetadataResourceList; noCacheThisOne : boolean) : TFhirValueSetW; overload; - function expandVS(vs : TFhirValueSetW; reqId, cacheId : String; profile : TFHIRTxOperationParams; opContext : TTerminologyOperationContext; textFilter : String; limit, count, offset : integer; txResources : TFslMetadataResourceList; noCacheThisOne : boolean) : TFhirValueSetW; overload; - function expandVS(reqId, uri, version : String; profile : TFHIRTxOperationParams; textFilter : String; limit, count, offset : integer; txResources : TFslMetadataResourceList; noCacheThisOne : boolean) : TFhirValueSetW; overload; + function expandVS(vs : TFhirValueSetW; reqId, cacheId : String; profile : TFHIRTxOperationParams; textFilter : String; limit, count, offset : integer; txResources : TFslMetadataResourceList; noCacheThisOne, diagnostics : boolean; tt : TFslTimeTracker) : TFhirValueSetW; overload; + function expandVS(vs : TFhirValueSetW; reqId, cacheId : String; profile : TFHIRTxOperationParams; opContext : TTerminologyOperationContext; textFilter : String; limit, count, offset : integer; txResources : TFslMetadataResourceList; noCacheThisOne, diagnostics : boolean; tt : TFslTimeTracker) : TFhirValueSetW; overload; + function expandVS(reqId, uri, version : String; profile : TFHIRTxOperationParams; textFilter : String; limit, count, offset : integer; txResources : TFslMetadataResourceList; noCacheThisOne, diagnostics : boolean; tt : TFslTimeTracker) : TFhirValueSetW; overload; // these are internal services - not for use outside the terminology server - function expandVS(reqId, uri, version: String; profile : TFHIRTxOperationParams; textFilter : String; dependencies : TStringList; limit, count, offset : integer; txResources : TFslMetadataResourceList; noCacheThisOne : boolean) : TFhirValueSetW; overload; - function expandVS(reqId, uri, version: String; profile : TFHIRTxOperationParams; opContext : TTerminologyOperationContext; textFilter : String; dependencies : TStringList; limit, count, offset : integer; txResources : TFslMetadataResourceList; noCacheThisOne : boolean) : TFhirValueSetW; overload; - function expandVS(vs: TFhirValueSetW; reqId, cacheId : String; profile : TFHIRTxOperationParams; textFilter : String; dependencies : TStringList; limit, count, offset : integer; txResources : TFslMetadataResourceList; noCacheThisOne : boolean): TFhirValueSetW; overload; - function expandVS(vs: TFhirValueSetW; reqId, cacheId : String; profile : TFHIRTxOperationParams; opContext : TTerminologyOperationContext; textFilter : String; dependencies : TStringList; limit, count, offset : integer; txResources : TFslMetadataResourceList; noCacheThisOne : boolean): TFhirValueSetW; overload; + function expandVS(reqId, uri, version: String; profile : TFHIRTxOperationParams; textFilter : String; dependencies : TStringList; limit, count, offset : integer; txResources : TFslMetadataResourceList; noCacheThisOne, diagnostics : boolean; tt : TFslTimeTracker) : TFhirValueSetW; overload; + function expandVS(reqId, uri, version: String; profile : TFHIRTxOperationParams; opContext : TTerminologyOperationContext; textFilter : String; dependencies : TStringList; limit, count, offset : integer; txResources : TFslMetadataResourceList; noCacheThisOne, diagnostics : boolean; tt : TFslTimeTracker) : TFhirValueSetW; overload; + function expandVS(vs: TFhirValueSetW; reqId, cacheId : String; profile : TFHIRTxOperationParams; textFilter : String; dependencies : TStringList; limit, count, offset : integer; txResources : TFslMetadataResourceList; noCacheThisOne, diagnostics : boolean; tt : TFslTimeTracker): TFhirValueSetW; overload; + function expandVS(vs: TFhirValueSetW; reqId, cacheId : String; profile : TFHIRTxOperationParams; opContext : TTerminologyOperationContext; textFilter : String; dependencies : TStringList; limit, count, offset : integer; txResources : TFslMetadataResourceList; noCacheThisOne, diagnostics : boolean; tt : TFslTimeTracker): TFhirValueSetW; overload; procedure lookupCode(coding : TFHIRCodingW; reqId : String; profile : TFHIRTxOperationParams; langList : THTTPLanguageList; props : TArray; resp : TFHIRLookupOpResponseW; txResources : TFslMetadataResourceList); - function validate(reqId : String; vs : TFhirValueSetW; coding : TFHIRCodingW; profile : TFHIRTxOperationParams; abstractOk, inferSystem : boolean; txResources : TFslMetadataResourceList; var summary : string) : TFhirParametersW; overload; - function validate(reqId, issuePath : String; vs : TFhirValueSetW; coded : TFhirCodeableConceptW; profile : TFHIRTxOperationParams; abstractOk, inferSystem: boolean; mode : TValidationCheckMode; txResources : TFslMetadataResourceList; var summary : string) : TFhirParametersW; overload; + function validate(reqId : String; vs : TFhirValueSetW; coding : TFHIRCodingW; profile : TFHIRTxOperationParams; abstractOk, inferSystem : boolean; txResources : TFslMetadataResourceList; var summary : string; tt : TFslTimeTracker) : TFhirParametersW; overload; + function validate(reqId, issuePath : String; vs : TFhirValueSetW; coded : TFhirCodeableConceptW; profile : TFHIRTxOperationParams; abstractOk, inferSystem: boolean; mode : TValidationCheckMode; txResources : TFslMetadataResourceList; var summary : string; tt : TFslTimeTracker) : TFhirParametersW; overload; function codeInValueSet(c : TFHIRCodingW; valueSet : String) : boolean; function translate(langList : THTTPLanguageList; reqId : String; cml : TFslList; coding : TFHIRCodingW; params : TFhirParametersW; txResources : TFslMetadataResourceList; profile : TFhirTxOperationParams): TFhirParametersW; overload; function translate(langList : THTTPLanguageList; source : TFhirValueSetW; coding : TFHIRCodingW; target : TFhirValueSetW; params : TFhirParametersW; txResources : TFslMetadataResourceList; profile : TFhirTxOperationParams) : TFhirParametersW; overload; function translate(langList : THTTPLanguageList; source : TFhirValueSetW; coded : TFhirCodeableConceptW; target : TFhirValueSetW; params : TFhirParametersW; txResources : TFslMetadataResourceList; profile : TFhirTxOperationParams) : TFhirParametersW; overload; - Function MakeChecker(reqId, uri, version : string; profile : TFHIRTxOperationParams) : TValueSetChecker; + Function MakeChecker(reqId, uri, version : string; profile : TFHIRTxOperationParams; tt : TFslTimeTracker) : TValueSetChecker; function getDisplayForCode(langList : THTTPLanguageList; system, version, code : String): String; function checkCode(op : TFhirOperationOutcomeW; langList : THTTPLanguageList; path : string; code : string; system, version : string; display : string) : boolean; function isValidCode(system, code : String) : boolean; @@ -175,9 +175,6 @@ TTerminologyServer = class (TTerminologyServerStore) implementation -uses - fsl_logging; - { TCachedItem } constructor TCachedItem.Create(expires: TDateTime); @@ -281,12 +278,18 @@ procedure TTerminologyServer.LoadClosures; procedure TTerminologyServer.lookupCode(coding : TFHIRCodingW; reqId : String; profile : TFHIRTxOperationParams; langList : THTTPLanguageList; props : TArray; resp : TFHIRLookupOpResponseW; txResources : TFslMetadataResourceList); var worker : TFHIRCodeSystemInformationProvider; + tt : TFslTimeTracker; begin - worker := TFHIRCodeSystemInformationProvider.Create(Factory.link, TTerminologyOperationContext.Create(I18n.link, reqId, profile.HTTPLanguages.link, LOOKUP_DEAD_TIME_SECS, OnGetCurrentRequestCount), workerGetProvider, workerGetVersions, txResources.link, CommonTerminologies.Languages.link, i18n.link); + tt := TFslTimeTracker.create; try - worker.lookupCode(coding, profile, props, resp); + worker := TFHIRCodeSystemInformationProvider.Create(Factory.link, TTerminologyOperationContext.Create(I18n.link, reqId, profile.HTTPLanguages.link, LOOKUP_DEAD_TIME_SECS, OnGetCurrentRequestCount, tt.link), workerGetProvider, workerGetVersions, txResources.link, CommonTerminologies.Languages.link, i18n.link); + try + worker.lookupCode(nil, coding, profile, props, resp); + finally + worker.free; + end; finally - worker.free; + tt.free; end; end; @@ -338,18 +341,18 @@ procedure TTerminologyServer.invalidateVS(id: String); end; end; -function TTerminologyServer.expandVS(vs: TFhirValueSetW; reqId, cacheId : String; profile : TFHIRTxOperationParams; textFilter : String; limit, count, offset : integer; txResources : TFslMetadataResourceList; noCacheThisOne : boolean): TFhirValueSetW; +function TTerminologyServer.expandVS(vs: TFhirValueSetW; reqId, cacheId : String; profile : TFHIRTxOperationParams; textFilter : String; limit, count, offset : integer; txResources : TFslMetadataResourceList; noCacheThisOne, diagnostics : boolean; tt : TFslTimeTracker): TFhirValueSetW; begin - result := expandVS(vs, reqId, cacheId, profile, nil, textFilter, limit, count, offset, txResources, noCacheThisOne); + result := expandVS(vs, reqId, cacheId, profile, nil, textFilter, limit, count, offset, txResources, noCacheThisOne, diagnostics, tt); end; -function TTerminologyServer.expandVS(vs: TFhirValueSetW; reqId, cacheId : String; profile : TFHIRTxOperationParams; opContext : TTerminologyOperationContext; textFilter : String; limit, count, offset : integer; txResources : TFslMetadataResourceList; noCacheThisOne : boolean): TFhirValueSetW; +function TTerminologyServer.expandVS(vs: TFhirValueSetW; reqId, cacheId : String; profile : TFHIRTxOperationParams; opContext : TTerminologyOperationContext; textFilter : String; limit, count, offset : integer; txResources : TFslMetadataResourceList; noCacheThisOne, diagnostics : boolean; tt : TFslTimeTracker): TFhirValueSetW; var ts : TStringList; begin ts := TStringList.Create; try - result := expandVS(vs, reqId, cacheId, profile, opContext, textFilter, ts, limit, count, offset, txResources, noCacheThisOne); + result := expandVS(vs, reqId, cacheId, profile, opContext, textFilter, ts, limit, count, offset, txResources, noCacheThisOne, diagnostics, tt); finally ts.free; end; @@ -391,13 +394,13 @@ function hashTx(list : TFslMetadataResourceList) : String; end; function TTerminologyServer.expandVS(vs: TFhirValueSetW; reqId, cacheId : String; profile : TFHIRTxOperationParams; textFilter : String; dependencies : TStringList; - limit, count, offset : integer; txResources : TFslMetadataResourceList; noCacheThisOne : boolean): TFhirValueSetW; + limit, count, offset : integer; txResources : TFslMetadataResourceList; noCacheThisOne, diagnostics : boolean; tt : TFslTimeTracker): TFhirValueSetW; begin - result := expandVS(vs, reqId, cacheId, profile, nil, textFilter, dependencies, limit, count, offset, txResources, noCacheThisOne); + result := expandVS(vs, reqId, cacheId, profile, nil, textFilter, dependencies, limit, count, offset, txResources, noCacheThisOne, diagnostics, tt) ; end; function TTerminologyServer.expandVS(vs: TFhirValueSetW; reqId, cacheId : String; profile : TFHIRTxOperationParams; opContext : TTerminologyOperationContext; textFilter : String; dependencies : TStringList; - limit, count, offset : integer; txResources : TFslMetadataResourceList; noCacheThisOne : boolean): TFhirValueSetW; + limit, count, offset : integer; txResources : TFslMetadataResourceList; noCacheThisOne, diagnostics : boolean; tt : TFslTimeTracker): TFhirValueSetW; var s, d, key: String; p : TArray; @@ -422,10 +425,11 @@ function TTerminologyServer.expandVS(vs: TFhirValueSetW; reqId, cacheId : String FLock.Unlock; end; end; + tt.step('not in cache'); if result = nil then begin if opContext = nil then - exp := TFHIRValueSetExpander.Create(Factory.link, TTerminologyOperationContext.Create(I18n.link, reqId, profile.HTTPLanguages.link, EXPANSION_DEAD_TIME_SECS, OnGetCurrentRequestCount), workerGetDefinition, workerGetProvider, workerGetVersions, workerGetExpansion, txResources.link, CommonTerminologies.Languages.link, i18n.link) + exp := TFHIRValueSetExpander.Create(Factory.link, TTerminologyOperationContext.Create(I18n.link, reqId, profile.HTTPLanguages.link, EXPANSION_DEAD_TIME_SECS, OnGetCurrentRequestCount, tt.link), workerGetDefinition, workerGetProvider, workerGetVersions, workerGetExpansion, txResources.link, CommonTerminologies.Languages.link, i18n.link) else exp := TFHIRValueSetExpander.Create(Factory.link, opContext.copy, workerGetDefinition, workerGetProvider, workerGetVersions, workerGetExpansion, txResources.link, CommonTerminologies.Languages.link, i18n.link); try @@ -434,12 +438,13 @@ function TTerminologyServer.expandVS(vs: TFhirValueSetW; reqId, cacheId : String begin if FCaching then begin + tt.step('add to cache'); FLock.Lock('expandVS.2'); try dt := now + FCacheDwellTime; if not FExpansions.ContainsKey(key) then begin - FExpansions.AddOrSetValue(key, TCachedValueSet.Create(dt, result.Link)); + FExpansions.AddOrSetValue(key, TCachedValueSet.Create(dt, result.clone)); // in addition, we trace the dependencies so we can expire the cache d := ''; for s in dependencies do @@ -453,7 +458,10 @@ function TTerminologyServer.expandVS(vs: TFhirValueSetW; reqId, cacheId : String FLock.Unlock; end; end; + tt.step('added to cache'); end; + if (diagnostics) then + result.expansion.addParamStr('diagnostics', exp.opContext.diagnostics); finally exp.free; end; @@ -484,7 +492,7 @@ function TTerminologyServer.findCanonicalResources(bundle: TFHIRBundleBuilder; end; end; -function TTerminologyServer.expandVS(reqId, uri, version: String; profile : TFHIRTxOperationParams; textFilter : String; limit, count, offset : integer; txResources : TFslMetadataResourceList; noCacheThisOne : boolean): TFhirValueSetW; +function TTerminologyServer.expandVS(reqId, uri, version: String; profile : TFHIRTxOperationParams; textFilter : String; limit, count, offset : integer; txResources : TFslMetadataResourceList; noCacheThisOne, diagnostics : boolean; tt : TFslTimeTracker): TFhirValueSetW; var vs : TFhirValueSetW; ts : TStringList; @@ -493,7 +501,7 @@ function TTerminologyServer.expandVS(reqId, uri, version: String; profile : TFHI try vs := getValueSetByUrl(uri, version, txResources); try - result := expandVS(vs, reqId, uri, profile, nil, textFilter, ts, limit, count, offset.MaxValue, txResources, noCacheThisOne); + result := expandVS(vs, reqId, uri, profile, nil, textFilter, ts, limit, count, offset.MaxValue, txResources, noCacheThisOne, diagnostics, tt); finally vs.free; end; @@ -502,12 +510,12 @@ function TTerminologyServer.expandVS(reqId, uri, version: String; profile : TFHI end; end; -function TTerminologyServer.expandVS(reqId, uri, version: String; profile : TFHIRTxOperationParams; textFilter : String; dependencies: TStringList; limit, count, offset : integer; txResources : TFslMetadataResourceList; noCacheThisOne : boolean): TFhirValueSetW; +function TTerminologyServer.expandVS(reqId, uri, version: String; profile : TFHIRTxOperationParams; textFilter : String; dependencies: TStringList; limit, count, offset : integer; txResources : TFslMetadataResourceList; noCacheThisOne, diagnostics : boolean; tt : TFslTimeTracker): TFhirValueSetW; begin - result := expandVS(reqId, uri, version, profile, nil, textFilter, dependencies, limit, count, offset, txResources, noCacheThisOne); + result := expandVS(reqId, uri, version, profile, nil, textFilter, dependencies, limit, count, offset, txResources, noCacheThisOne, diagnostics, tt); end; -function TTerminologyServer.expandVS(reqId, uri, version: String; profile : TFHIRTxOperationParams; opContext : TTerminologyOperationContext; textFilter : String; dependencies: TStringList; limit, count, offset : integer; txResources : TFslMetadataResourceList; noCacheThisOne : boolean): TFhirValueSetW; +function TTerminologyServer.expandVS(reqId, uri, version: String; profile : TFHIRTxOperationParams; opContext : TTerminologyOperationContext; textFilter : String; dependencies: TStringList; limit, count, offset : integer; txResources : TFslMetadataResourceList; noCacheThisOne, diagnostics : boolean; tt : TFslTimeTracker): TFhirValueSetW; var vs : TFhirValueSetW; begin @@ -515,7 +523,7 @@ function TTerminologyServer.expandVS(reqId, uri, version: String; profile : TFHI try if vs = nil then raise ETerminologyError.Create('Unable to find value set "'+uri+'"', itUnknown); - result := expandVS(vs, reqId, uri, profile, opContext, textFilter, limit, count, offset, txResources, noCacheThisOne); + result := expandVS(vs, reqId, uri, profile, opContext, textFilter, limit, count, offset, txResources, noCacheThisOne, diagnostics, tt); finally vs.free; end; @@ -589,11 +597,11 @@ function TTerminologyServer.isKnownValueSet(id: String; out vs: TFhirValueSetW): result := vs <> nil; end; -function TTerminologyServer.MakeChecker(reqId, uri, version: string; profile : TFHIRTxOperationParams): TValueSetChecker; +function TTerminologyServer.MakeChecker(reqId, uri, version: string; profile : TFHIRTxOperationParams; tt : TFslTimeTracker): TValueSetChecker; var vs : TFhirValueSetW; begin - result := TValueSetChecker.Create(Factory.link, TTerminologyOperationContext.Create(I18n.link, reqId, profile.HTTPLanguages.link, VALIDATION_DEAD_TIME_SECS, OnGetCurrentRequestCount), workerGetDefinition, workerGetProvider, workerGetVersions, workerGetExpansion, nil, CommonTerminologies.Languages.link, uri, i18n.link); + result := TValueSetChecker.Create(Factory.link, TTerminologyOperationContext.Create(I18n.link, reqId, profile.HTTPLanguages.link, VALIDATION_DEAD_TIME_SECS, OnGetCurrentRequestCount, tt.link), workerGetDefinition, workerGetProvider, workerGetVersions, workerGetExpansion, nil, CommonTerminologies.Languages.link, uri, i18n.link); try vs := getValueSetByUrl(uri, version); try @@ -645,7 +653,7 @@ procedure TTerminologyServer.processCoding(coding : TFHIRCodingW; params : TFhir params.addParamStr('display', coding.display); end; -function TTerminologyServer.validate(reqId : String; vs : TFhirValueSetW; coding : TFHIRCodingW; profile : TFHIRTxOperationParams; abstractOk, inferSystem : boolean; txResources : TFslMetadataResourceList; var summary : string) : TFhirParametersW; +function TTerminologyServer.validate(reqId : String; vs : TFhirValueSetW; coding : TFHIRCodingW; profile : TFHIRTxOperationParams; abstractOk, inferSystem : boolean; txResources : TFslMetadataResourceList; var summary : string; tt : TFslTimeTracker) : TFhirParametersW; var check : TValueSetChecker; unknownValueSets : TStringList; @@ -657,7 +665,7 @@ function TTerminologyServer.validate(reqId : String; vs : TFhirValueSetW; coding try unknownValueSets := TStringList.create; - check := TValueSetChecker.Create(Factory.link, TTerminologyOperationContext.Create(I18n.link, reqId, profile.HTTPLanguages.link, VALIDATION_DEAD_TIME_SECS, OnGetCurrentRequestCount), workerGetDefinition, workerGetProvider, workerGetVersions, workerGetExpansion, txResources.link, CommonTerminologies.Languages.link, vs.url, i18n.link); + check := TValueSetChecker.Create(Factory.link, TTerminologyOperationContext.Create(I18n.link, reqId, profile.HTTPLanguages.link, VALIDATION_DEAD_TIME_SECS, OnGetCurrentRequestCount, tt.link), workerGetDefinition, workerGetProvider, workerGetVersions, workerGetExpansion, txResources.link, CommonTerminologies.Languages.link, vs.url, i18n.link); try unknownValueSets.Sorted := true; unknownValueSets.Duplicates := dupIgnore; @@ -689,7 +697,7 @@ function TTerminologyServer.validate(reqId : String; vs : TFhirValueSetW; coding end; -function TTerminologyServer.validate(reqId, issuePath : String; vs : TFhirValueSetW; coded : TFhirCodeableConceptW; profile : TFHIRTxOperationParams; abstractOk, inferSystem : boolean; mode : TValidationCheckMode; txResources : TFslMetadataResourceList; var summary : string) : TFhirParametersW; +function TTerminologyServer.validate(reqId, issuePath : String; vs : TFhirValueSetW; coded : TFhirCodeableConceptW; profile : TFHIRTxOperationParams; abstractOk, inferSystem : boolean; mode : TValidationCheckMode; txResources : TFslMetadataResourceList; var summary : string; tt : TFslTimeTracker) : TFhirParametersW; var check : TValueSetChecker; coding : TFhirCodingW; @@ -704,7 +712,7 @@ function TTerminologyServer.validate(reqId, issuePath : String; vs : TFhirValueS try unknownValueSets := TStringList.create; - check := TValueSetChecker.Create(Factory.link, TTerminologyOperationContext.Create(I18n.link, reqId, profile.HTTPLanguages.link, VALIDATION_DEAD_TIME_SECS, OnGetCurrentRequestCount), workerGetDefinition, workerGetProvider, workerGetVersions, workerGetExpansion, txResources.link, CommonTerminologies.Languages.link, vs.url, i18n.link); + check := TValueSetChecker.Create(Factory.link, TTerminologyOperationContext.Create(I18n.link, reqId, profile.HTTPLanguages.link, VALIDATION_DEAD_TIME_SECS, OnGetCurrentRequestCount, tt.link), workerGetDefinition, workerGetProvider, workerGetVersions, workerGetExpansion, txResources.link, CommonTerminologies.Languages.link, vs.url, i18n.link); try unknownValueSets.Sorted := true; unknownValueSets.Duplicates := dupIgnore; @@ -730,8 +738,8 @@ function TTerminologyServer.validate(reqId, issuePath : String; vs : TFhirValueS end; result := check.check(issuePath, coded, abstractOk, inferSystem, mode); summary := check.log; - if check.opContext.hasNotes and profile.diagnostics then - result.addParamStr('diagnostics', check.opContext.notes); + if profile.diagnostics then + result.addParamStr('diagnostics', check.opContext.diagnostics); finally check.free; end; @@ -747,7 +755,7 @@ function TTerminologyServer.workerGetDefinition(sender: TObject; url, version: S function TTerminologyServer.workerGetExpansion(sender: TObject; opContext : TTerminologyOperationContext; url, version, filter: String; params: TFHIRTxOperationParams; dependencies: TStringList; additionalResources : TFslMetadataResourceList; limit: integer; noCacheThisOne : boolean): TFHIRValueSetW; begin - result := expandVS(opContext.reqId, url, version, params, opContext, filter, dependencies, limit, -1, -1, additionalResources, noCacheThisOne); + result := expandVS(opContext.reqId, url, version, params, opContext, filter, dependencies, limit, -1, -1, additionalResources, noCacheThisOne, false, nil); end; function TTerminologyServer.workerGetProvider(sender: TObject; url, version: String; params: TFHIRTxOperationParams; nullOk : boolean): TCodeSystemProvider; @@ -793,7 +801,7 @@ function TTerminologyServer.checkCode(op : TFhirOperationOutcomeW; langList : TH end else if system.StartsWith(URI_LOINC) and (CommonTerminologies.Loinc <> nil) then begin - d := CommonTerminologies.Loinc.getDisplay(code, langList); + d := CommonTerminologies.Loinc.getDisplay(nil, code, langList); if op.warning('InstanceValidator', itInvalid, path, d <> '', 'The LOINC code "'+code+'" is unknown') then result := op.warning('InstanceValidator', itInvalid, path, (display = '') or (display = d), 'Display for Loinc Code "'+code+'" should be "'+d+'"'); end @@ -809,11 +817,11 @@ function TTerminologyServer.checkCode(op : TFhirOperationOutcomeW; langList : TH if cp <> nil then begin try - lct := cp.locate(code); + lct := cp.locate(nil, code); try if (op.error('InstanceValidator', itInvalid, path, lct <> nil, 'Unknown Code ('+system+'#'+code+')')) then - result := op.warning('InstanceValidator', itInvalid, path, (display = '') or (display = cp.Display(lct, THTTPLanguageList(nil))), - 'Display for '+system+' code "'+code+'" should be "'+cp.Display(lct, THTTPLanguageList(nil))+'"'); + result := op.warning('InstanceValidator', itInvalid, path, (display = '') or (display = cp.Display(nil, lct, THTTPLanguageList(nil))), + 'Display for '+system+' code "'+code+'" should be "'+cp.Display(nil, lct, THTTPLanguageList(nil))+'"'); finally lct.free; end; @@ -886,7 +894,9 @@ function TTerminologyServer.codeInValueSet(c : TFHIRCodingW; valueSet: String): p : TFhirParametersW; profile : TFHIRTxOperationParams; summary : string; + tt : TFslTimeTracker; begin + tt := TFslTimeTracker.create; vs := getValueSetByUrl(valueSet, '', nil); try if (vs = nil) then @@ -894,7 +904,7 @@ function TTerminologyServer.codeInValueSet(c : TFHIRCodingW; valueSet: String): profile := TFHIRTxOperationParams.Create; try profile.membershipOnly := true; - p := validate('', vs, c, profile, true, false, nil, summary); + p := validate('', vs, c, profile, true, false, nil, summary, tt); try result := p.bool('result'); finally @@ -905,6 +915,7 @@ function TTerminologyServer.codeInValueSet(c : TFHIRCodingW; valueSet: String): end; finally vs.free; + tt.free; end; end; @@ -1047,7 +1058,7 @@ function TTerminologyServer.getDisplayForCode(langList : THTTPLanguageList; syst provider := getProvider(system, version, nil, true); if provider <> nil then try - result := provider.getDisplay(code, langList); + result := provider.getDisplay(nil, code, langList); finally provider.free; end; @@ -1063,7 +1074,7 @@ procedure TTerminologyServer.getCodeView(langList : THTTPLanguageList; coding: T begin try card := response.addCard; - cs.getCDSInfo(card, langList, webBase, coding.code, coding.display); + cs.getCDSInfo(nil, card, langList, webBase, coding.code, coding.display); finally cs.free; end; @@ -1127,7 +1138,7 @@ function TTerminologyServer.isValidCode(system, code: String): boolean; else begin try - lct := cp.locate(code); + lct := cp.locate(nil, code); try result := lct <> nil; finally @@ -1435,6 +1446,7 @@ procedure TTerminologyServer.processConcept(ConceptKey: integer; URL, version, C vs : TFhirValueSetW; val : TValuesetChecker; profile : TFHIRTxOperationParams; + tt : TFslTimeTracker; begin conn2.SQL := 'select ValueSetKey, URL from ValueSets'; conn2.Prepare; @@ -1446,10 +1458,11 @@ procedure TTerminologyServer.processConcept(ConceptKey: integer; URL, version, C conn3.ExecSQL('Update ValueSets set NeedsIndexing = 0, Error = ''Unable to find definition'' where ValueSetKey = '+conn2.ColStringByName['ValueSetKey']) else try + tt := TFslTimeTracker.create; profile := TFHIRTxOperationParams.Create; try try - val := TValueSetChecker.Create(Factory.link, TTerminologyOperationContext.Create(I18n.link, '', profile.HTTPLanguages.link, VALIDATION_DEAD_TIME_SECS, OnGetCurrentRequestCount), workerGetDefinition, workerGetProvider, workerGetVersions, workerGetExpansion, nil, CommonTerminologies.Languages.link, vs.url, i18n.link); + val := TValueSetChecker.Create(Factory.link, TTerminologyOperationContext.Create(I18n.link, '', profile.HTTPLanguages.link, VALIDATION_DEAD_TIME_SECS, OnGetCurrentRequestCount, tt.link), workerGetDefinition, workerGetProvider, workerGetVersions, workerGetExpansion, nil, CommonTerminologies.Languages.link, vs.url, i18n.link); try val.prepare(vs, profile, nil); if val.check('code', URL, version, code, true, false, nil) <> bTrue then @@ -1464,6 +1477,7 @@ procedure TTerminologyServer.processConcept(ConceptKey: integer; URL, version, C end; finally profile.free; + tt.free; end; except on e : Exception do @@ -1482,16 +1496,18 @@ procedure TTerminologyServer.processValueSet(ValueSetKey: integer; URL: String; val : TValuesetChecker; system, version, code : String; profile : TFHIRTxOperationParams; + tt : TFslTimeTracker; begin vs := getValueSetByURL(URL, ''); if vs = nil then conn2.ExecSQL('Update ValueSets set NeedsIndexing = 0, Error = ''Unable to find definition'' where ValueSetKey = '+inttostr(valuesetKey)) else try + tt := TFslTimeTracker.create;; profile := TFHIRTxOperationParams.defaultProfile; try try - val := TValueSetChecker.Create(Factory.link, TTerminologyOperationContext.Create(I18n.link, '', profile.HTTPLanguages.link, VALIDATION_DEAD_TIME_SECS, OnGetCurrentRequestCount), workerGetDefinition, workerGetProvider, workerGetVersions, workerGetExpansion, nil, CommonTerminologies.Languages.link, vs.url, i18n.link); + val := TValueSetChecker.Create(Factory.link, TTerminologyOperationContext.Create(I18n.link, '', profile.HTTPLanguages.link, VALIDATION_DEAD_TIME_SECS, OnGetCurrentRequestCount, tt.link), workerGetDefinition, workerGetProvider, workerGetVersions, workerGetExpansion, nil, CommonTerminologies.Languages.link, vs.url, i18n.link); try val.prepare(vs, profile, nil); conn2.SQL := 'select ConceptKey, URL, Code from Concepts'; @@ -1519,6 +1535,7 @@ procedure TTerminologyServer.processValueSet(ValueSetKey: integer; URL: String; end; finally profile.free; + tt.free; end; except on e : Exception do @@ -1558,12 +1575,15 @@ procedure TTerminologyServer.Unload; function TTerminologyServer.translate(langList : THTTPLanguageList; reqId : String; cml : TFslList; coding: TFHIRCodingW; params : TFhirParametersW; txResources : TFslMetadataResourceList; profile : TFhirTxOperationParams): TFhirParametersW; var worker : TFHIRConceptMapTranslator; + tt : TFslTimeTracker; begin - worker := TFHIRConceptMapTranslator.Create(Factory.link, TTerminologyOperationContext.Create(I18n.link, reqId, profile.HTTPLanguages.link, LOOKUP_DEAD_TIME_SECS, OnGetCurrentRequestCount), workerGetProvider, workerGetVersions, txResources.link, CommonTerminologies.Languages.link, i18n.link); + tt := TFslTimeTracker.create; + worker := TFHIRConceptMapTranslator.Create(Factory.link, TTerminologyOperationContext.Create(I18n.link, reqId, profile.HTTPLanguages.link, LOOKUP_DEAD_TIME_SECS, OnGetCurrentRequestCount, tt.link), workerGetProvider, workerGetVersions, txResources.link, CommonTerminologies.Languages.link, i18n.link); try result := worker.translate(langList, reqId, cml, coding, params, profile); finally worker.free; + tt.free; end; end; diff --git a/server/tx_webserver.pas b/server/tx_webserver.pas index 18ed57731..4ad180403 100644 --- a/server/tx_webserver.pas +++ b/server/tx_webserver.pas @@ -502,7 +502,7 @@ function TTerminologyWebServer.processExpand(pm: THTTPParameters; langList : THT profile.HTTPLanguages := langList.link; try - res := FServer.expandVS(vs, '', vs.url, profile, pm['filter'], 1000, 0, 0, nil, false); + res := FServer.expandVS(vs, '', vs.url, profile, pm['filter'], 1000, 0, 0, nil, false, false, nil); try result := asHtml(res.Resource)+#13#10; // if (not profile.includeDefinition) then @@ -962,7 +962,7 @@ function TTerminologyWebServer.processValidate(pm: THTTPParameters): String; coding.version := pm['version']; coding.code := pm['code']; coding.display := pm['display']; - res := FServer.validate('', vs, coding, nil, pm['abstract'] = '1', (pm['implySystem'] = '1') or (pm['inferSystem'] = '1'), nil, summary); + res := FServer.validate('', vs, coding, nil, pm['abstract'] = '1', (pm['implySystem'] = '1') or (pm['inferSystem'] = '1'), nil, summary, nil); try result := '
'+paramsAsHtml(res)+'
'#13 + #10'
'+asJson(res.Resource)+'
'#13#10+'
'+asXml(res.Resource)+'
' diff --git a/server/validator_r2.pas b/server/validator_r2.pas index 5a7ac5b51..0c2e7b5f2 100644 --- a/server/validator_r2.pas +++ b/server/validator_r2.pas @@ -160,7 +160,7 @@ function TFHIRServerWorkerContextR2.validateCode(system, version, code: String; c.systemUri := system; c.code := code; c.version := version; - p := FTerminologyServer.validate('', vsw, c, FProfile, false, true, nil, summary); + p := FTerminologyServer.validate('', vsw, c, FProfile, false, true, nil, summary, nil); try result := TValidationResult.Create; try @@ -246,7 +246,7 @@ function TFHIRServerWorkerContextR2.expand(vs : TFhirValueSet; options : TExpans limit := 0; if expOptLimited in options then limit := 100; - res := FTerminologyServer.expandVS(vsw, '', '', FProfile, '', limit, 0, 0, nil, false); + res := FTerminologyServer.expandVS(vsw, '', '', FProfile, '', limit, 0, 0, nil, false, false, nil); try result := res.Resource as TFhirValueSet; finally @@ -305,7 +305,7 @@ function TFHIRServerWorkerContextR2.validateCode(code: TFHIRCoding; vs: TFhirVal try c := factory.wrapCoding(code.Link); try - p := FTerminologyServer.validate('', vsw, c, nil, false, true, nil, summary); + p := FTerminologyServer.validate('', vsw, c, nil, false, true, nil, summary, nil); try result.Message := p.str('message'); if p.bool('result') then @@ -341,7 +341,7 @@ function TFHIRServerWorkerContextR2.validateCode(code: TFHIRCodeableConcept; vs: try c := factory.wrapCodeableConcept(code.Link); try - p := FTerminologyServer.validate('', 'CodeableConcept', vsw, c, FProfile, false, true, vcmCodeableConcept, nil, summary); + p := FTerminologyServer.validate('', 'CodeableConcept', vsw, c, FProfile, false, true, vcmCodeableConcept, nil, summary, nil); try result.Message := p.str('message'); if p.bool('result') then diff --git a/server/validator_r3.pas b/server/validator_r3.pas index 8a75e27d5..52821a0b4 100644 --- a/server/validator_r3.pas +++ b/server/validator_r3.pas @@ -244,7 +244,7 @@ function TFHIRServerWorkerContextR3.validateCode(system, version, code: String; c.systemUri := system; c.code := code; c.version := version; - p := FTerminologyServer.validate('', vsw, c, FProfile, false, true, nil, summary); + p := FTerminologyServer.validate('', vsw, c, FProfile, false, true, nil, summary, nil); try result := TValidationResult.Create; try @@ -330,7 +330,7 @@ function TFHIRServerWorkerContextR3.expand(vs : TFhirValueSet; options : TExpans limit := 0; if expOptLimited in options then limit := 100; - res := FTerminologyServer.expandVS(vsw, '', '', FProfile, '', limit, 0, 0, nil, false); + res := FTerminologyServer.expandVS(vsw, '', '', FProfile, '', limit, 0, 0, nil, false, false, nil); try result := res.Resource as TFhirValueSet; finally @@ -389,7 +389,7 @@ function TFHIRServerWorkerContextR3.validateCode(code: TFHIRCoding; vs: TFhirVal try c := factory.wrapCoding(code.Link); try - p := FTerminologyServer.validate('', vsw, c, FProfile, false, true, nil, summary); + p := FTerminologyServer.validate('', vsw, c, FProfile, false, true, nil, summary, nil); try result.Message := p.str('message'); if p.bool('result') then @@ -425,7 +425,7 @@ function TFHIRServerWorkerContextR3.validateCode(code: TFHIRCodeableConcept; vs: try c := factory.wrapCodeableConcept(code.Link); try - p := FTerminologyServer.validate('', 'CodeableConcept', vsw, c, FProfile, false, true, vcmCodeableConcept, nil, summary); + p := FTerminologyServer.validate('', 'CodeableConcept', vsw, c, FProfile, false, true, vcmCodeableConcept, nil, summary, nil); try result.Message := p.str('message'); if p.bool('result') then diff --git a/server/validator_r4.pas b/server/validator_r4.pas index eee7ad233..a2e11b135 100644 --- a/server/validator_r4.pas +++ b/server/validator_r4.pas @@ -243,7 +243,7 @@ function TFHIRServerWorkerContextR4.validateCode(system, version, code: String; c.systemUri := system; c.code := code; c.version := version; - p := FTerminologyServer.validate('', vsw, c, FProfile, false, true, nil, summary); + p := FTerminologyServer.validate('', vsw, c, FProfile, false, true, nil, summary, nil); try result := TValidationResult.Create; try @@ -329,7 +329,7 @@ function TFHIRServerWorkerContextR4.expand(vs : TFhirValueSet; options : TExpans limit := 0; if expOptLimited in options then limit := 100; - res := FTerminologyServer.expandVS(vsw, '', '', FProfile, '', limit, 0, 0, nil, false); + res := FTerminologyServer.expandVS(vsw, '', '', FProfile, '', limit, 0, 0, nil, false, false, nil); try result := res.Resource as TFhirValueSet; finally @@ -388,7 +388,7 @@ function TFHIRServerWorkerContextR4.validateCode(code: TFHIRCoding; vs: TFhirVal try c := factory.wrapCoding(code.Link); try - p := FTerminologyServer.validate('', vsw, c, nil, false, true, nil, summary); + p := FTerminologyServer.validate('', vsw, c, nil, false, true, nil, summary, nil); try result.Message := p.str('message'); if p.bool('result') then @@ -424,7 +424,7 @@ function TFHIRServerWorkerContextR4.validateCode(code: TFHIRCodeableConcept; vs: try c := factory.wrapCodeableConcept(code.Link); try - p := FTerminologyServer.validate('', 'CodeableConcept', vsw, c, FProfile, false, true, vcmCodeableConcept, nil, summary); + p := FTerminologyServer.validate('', 'CodeableConcept', vsw, c, FProfile, false, true, vcmCodeableConcept, nil, summary, nil); try result.Message := p.str('message'); if p.bool('result') then diff --git a/server/validator_r4b.pas b/server/validator_r4b.pas index 9f9f7fafc..ca73b9fc4 100644 --- a/server/validator_r4b.pas +++ b/server/validator_r4b.pas @@ -243,7 +243,7 @@ function TFHIRServerWorkerContextR4B.validateCode(system, version, code: String; c.systemUri := system; c.code := code; c.version := version; - p := FTerminologyServer.validate('', vsw, c, FProfile, false, true, nil, summary); + p := FTerminologyServer.validate('', vsw, c, FProfile, false, true, nil, summary, nil); try result := TValidationResult.Create; try @@ -329,7 +329,7 @@ function TFHIRServerWorkerContextR4B.expand(vs : TFhirValueSet; options : TExpan limit := 0; if expOptLimited in options then limit := 100; - res := FTerminologyServer.expandVS(vsw, '', '', FProfile, '', limit, 0, 0, nil, false); + res := FTerminologyServer.expandVS(vsw, '', '', FProfile, '', limit, 0, 0, nil, false, false, nil); try result := res.Resource as TFhirValueSet; finally @@ -388,7 +388,7 @@ function TFHIRServerWorkerContextR4B.validateCode(code: TFHIRCoding; vs: TFhirVa try c := factory.wrapCoding(code.Link); try - p := FTerminologyServer.validate('', vsw, c, nil, false, true, nil, summary); + p := FTerminologyServer.validate('', vsw, c, nil, false, true, nil, summary, nil); try result.Message := p.str('message'); if p.bool('result') then @@ -424,7 +424,7 @@ function TFHIRServerWorkerContextR4B.validateCode(code: TFHIRCodeableConcept; vs try c := factory.wrapCodeableConcept(code.Link); try - p := FTerminologyServer.validate('', 'CodeableConcept', vsw, c, FProfile, false, true, vcmCodeableConcept, nil, summary); + p := FTerminologyServer.validate('', 'CodeableConcept', vsw, c, FProfile, false, true, vcmCodeableConcept, nil, summary, nil); try result.Message := p.str('message'); if p.bool('result') then diff --git a/server/validator_r5.pas b/server/validator_r5.pas index a8aa1ceff..8c592958a 100644 --- a/server/validator_r5.pas +++ b/server/validator_r5.pas @@ -243,7 +243,7 @@ function TFHIRServerWorkerContextR5.validateCode(system, version, code: String; c.systemUri := system; c.code := code; c.version := version; - p := FTerminologyServer.validate('', vsw, c, FProfile, false, true, nil, summary); + p := FTerminologyServer.validate('', vsw, c, FProfile, false, true, nil, summary, nil); try result := TValidationResult.Create; try @@ -329,7 +329,7 @@ function TFHIRServerWorkerContextR5.expand(vs : TFhirValueSet; options : TExpans limit := 0; if expOptLimited in options then limit := 100; - res := FTerminologyServer.expandVS(vsw, '', '', FProfile, '', limit, 0, 0, nil, false); + res := FTerminologyServer.expandVS(vsw, '', '', FProfile, '', limit, 0, 0, nil, false, false, nil); try result := res.Resource as TFhirValueSet; finally @@ -388,7 +388,7 @@ function TFHIRServerWorkerContextR5.validateCode(code: TFHIRCoding; vs: TFhirVal try c := factory.wrapCoding(code.Link); try - p := FTerminologyServer.validate('', vsw, c, nil, false, true, nil, summary); + p := FTerminologyServer.validate('', vsw, c, nil, false, true, nil, summary, nil); try result.Message := p.str('message'); if p.bool('result') then @@ -424,7 +424,7 @@ function TFHIRServerWorkerContextR5.validateCode(code: TFHIRCodeableConcept; vs: try c := factory.wrapCodeableConcept(code.Link); try - p := FTerminologyServer.validate('', 'CodeableConcept', vsw, c, FProfile, false, true, vcmCodeableConcept, nil, summary); + p := FTerminologyServer.validate('', 'CodeableConcept', vsw, c, FProfile, false, true, vcmCodeableConcept, nil, summary, nil); try result.Message := p.str('message'); if p.bool('result') then From 350e8ec92fab2cdbe938087b5a6c19fb3473891f Mon Sep 17 00:00:00 2001 From: Grahame Grieve Date: Thu, 17 Oct 2024 17:57:23 +0800 Subject: [PATCH 4/7] Support authentication on the tx-registry servers --- library/web/fsl_fetcher.pas | 4 ++++ server/endpoint_txregistry.pas | 12 ++++++------ server/web_server.pas | 14 +++++++------- server/zero_config.pas | 10 ++++++++++ 4 files changed, 27 insertions(+), 13 deletions(-) diff --git a/library/web/fsl_fetcher.pas b/library/web/fsl_fetcher.pas index 4cbf4e3e4..dd454e432 100644 --- a/library/web/fsl_fetcher.pas +++ b/library/web/fsl_fetcher.pas @@ -134,7 +134,11 @@ procedure TInternetFetcher.Fetch; oFtp : TIdFTP; begin if StringStartsWith(url, 'file:') Then + begin + if (url.contains('?')) then + url := url.substring(0, url.indexof('?')); FBuffer.LoadFromFileName(Copy(url, 6, $FFFF)) + end else Begin oUri := TIdURI.Create(url); diff --git a/server/endpoint_txregistry.pas b/server/endpoint_txregistry.pas index 604e3ca0a..b143c000b 100644 --- a/server/endpoint_txregistry.pas +++ b/server/endpoint_txregistry.pas @@ -40,7 +40,7 @@ interface tx_registry_spider, tx_registry_model, server_config, utilities, telnet_server, - tx_manager, time_tracker, kernel_thread, server_stats, + tx_manager, kernel_thread, server_stats, web_event, web_base, endpoint, session; const @@ -100,8 +100,8 @@ TFHIRTxRegistryWebServer = class (TFhirWebServerEndpoint) property NextScan : TDateTime read FNextScan write FNextScan; property scanning : boolean read FScanning write SetScanning; - function PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TTimeTracker) : String; override; - function SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert : TIdOpenSSLX509; id : String; tt : TTimeTracker) : String; override; + function PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TFslTimeTracker) : String; override; + function SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert : TIdOpenSSLX509; id : String; tt : TFslTimeTracker) : String; override; function logId : string; override; end; @@ -303,7 +303,7 @@ procedure TTxRegistryUpdaterThread.RunUpdater; upd : TTxRegistryScanner; new, existing : TServerRegistries; begin - upd := TTxRegistryScanner.Create(FZulip.link); + upd := TTxRegistryScanner.Create(FZulip.link, FEndPoint.Settings.Ini.admin.link); try upd.address := FEndPoint.FAddress; upd.OnSendEmail := doSendEmail; @@ -769,7 +769,7 @@ function TFHIRTxRegistryWebServer.logId: string; result := 'TXR'; end; -function TFHIRTxRegistryWebServer.PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TTimeTracker) : String; +function TFHIRTxRegistryWebServer.PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TFslTimeTracker) : String; begin countRequest; result := doRequest(AContext, request, response, id, false); @@ -832,7 +832,7 @@ function TFHIRTxRegistryWebServer.doRequest(AContext: TIdContext; request: TIdHT end; end; -function TFHIRTxRegistryWebServer.SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert: TIdOpenSSLX509; id: String; tt : TTimeTracker): String; +function TFHIRTxRegistryWebServer.SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert: TIdOpenSSLX509; id: String; tt : TFslTimeTracker): String; begin countRequest; result := doRequest(AContext, request, response, id, true); diff --git a/server/web_server.pas b/server/web_server.pas index 1b6972cc2..7b50785f9 100644 --- a/server/web_server.pas +++ b/server/web_server.pas @@ -96,7 +96,7 @@ scim_server, auth_manager, reverse_client, cds_hooks_server, web_source, analytics, bundlebuilder, server_factory, user_manager, server_context, server_constants, utilities, jwt, usage_stats, - subscriptions, twilio, time_tracker, + subscriptions, twilio, web_base, endpoint, endpoint_storage; Type @@ -224,7 +224,7 @@ TFHIRWebServerExtension = class abstract (TFHIRPathEngineExtension) Procedure PlainRequest(AContext: TIdContext; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo); Procedure SecureRequest(AContext: TIdContext; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo); - Procedure logOutput(AContext: TIdContext; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : string; tt : TTimeTracker; secure : boolean; epn, summ : string); + Procedure logOutput(AContext: TIdContext; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : string; tt : TFslTimeTracker; secure : boolean; epn, summ : string); Procedure StartServer(); Procedure StopServer; @@ -745,7 +745,7 @@ function letterForOp(request : TIdHTTPRequestInfo) : String; procedure TFhirWebServer.logOutput(AContext: TIdContext; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id: string; - tt: TTimeTracker; secure: boolean; epn, summ: string); + tt: TFslTimeTracker; secure: boolean; epn, summ: string); function mimeType(mt : String) : String; var f : TFHIRFormat; @@ -802,7 +802,7 @@ procedure TFhirWebServer.PlainRequest(AContext: TIdContext; ep : TFhirWebServerEndpoint; ok : boolean; epn, cid, ip : String; - tt : TTimeTracker; + tt : TFslTimeTracker; ci : TFHIRHTTPConnectionInfo; begin ci := TFHIRHTTPConnectionInfo.create(request, AContext); @@ -821,7 +821,7 @@ procedure TFhirWebServer.PlainRequest(AContext: TIdContext; begin ip := getClientIP(AContext, request); ci.FClientIP := ip; - tt := TTimeTracker.Create; + tt := TFslTimeTracker.Create; try InterlockedIncrement(GCounterWebRequests); SetThreadStatus('Processing '+request.Document); @@ -993,7 +993,7 @@ procedure TFhirWebServer.SecureRequest(AContext: TIdContext; var cert: TIdOpenSSLX509; id, summ : String; - tt : TTimeTracker; + tt : TFslTimeTracker; ok : boolean; ep: TFhirWebServerEndpoint; epn, ip: String; @@ -1013,7 +1013,7 @@ procedure TFhirWebServer.SecureRequest(AContext: TIdContext; begin ip := getClientIP(AContext, request); ci.FClientIP := ip; - tt := TTimeTracker.Create; + tt := TFslTimeTracker.Create; try InterlockedIncrement(GCounterWebRequests); cert := nil; // (AContext.Connection.IOHandler as TIdSSLIOHandlerSocketOpenSSL).SSLSocket.PeerCert; diff --git a/server/zero_config.pas b/server/zero_config.pas index 21fab25ca..f183db0d9 100644 --- a/server/zero_config.pas +++ b/server/zero_config.pas @@ -215,6 +215,7 @@ procedure TConfigurationBuilder.buildConfig(fn: String; local : TCustomIniFile); sct : TFHIRServerConfigSection; ep, o : TJsonObject; lwi, mode : String; + ts : TStringList; begin rn := 1; if FileExists(fn) then @@ -259,6 +260,15 @@ procedure TConfigurationBuilder.buildConfig(fn: String; local : TCustomIniFile); cfg.service['package-cache'].value := ExtractFilePath(fn); cfg.admin['scim-salt'].value := NewGuidId; + ts := TStringList.create; + try + local.ReadSection('server-auth', ts); + for n in ts do + cfg.admin[n].value := local.ReadString('server-auth', n, ''); + finally + ts.free; + end; + for n in FFiles.Keys do begin sct := cfg.section['terminologies'].section[PathTitle(n)]; From 01fbd35c4639fa471610e04e1aea1d10c0506573 Mon Sep 17 00:00:00 2001 From: Grahame Grieve Date: Fri, 18 Oct 2024 06:22:45 +0800 Subject: [PATCH 5/7] fix access violation --- server/tx_server.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/server/tx_server.pas b/server/tx_server.pas index 56b75de2e..52ab25186 100644 --- a/server/tx_server.pas +++ b/server/tx_server.pas @@ -755,7 +755,7 @@ function TTerminologyServer.workerGetDefinition(sender: TObject; url, version: S function TTerminologyServer.workerGetExpansion(sender: TObject; opContext : TTerminologyOperationContext; url, version, filter: String; params: TFHIRTxOperationParams; dependencies: TStringList; additionalResources : TFslMetadataResourceList; limit: integer; noCacheThisOne : boolean): TFHIRValueSetW; begin - result := expandVS(opContext.reqId, url, version, params, opContext, filter, dependencies, limit, -1, -1, additionalResources, noCacheThisOne, false, nil); + result := expandVS(opContext.reqId, url, version, params, opContext, filter, dependencies, limit, -1, -1, additionalResources, noCacheThisOne, false, opContext.TimeTracker); end; function TTerminologyServer.workerGetProvider(sender: TObject; url, version: String; params: TFHIRTxOperationParams; nullOk : boolean): TCodeSystemProvider; From 65d83b58ba34bf9d6ef10218451468452ae17b96 Mon Sep 17 00:00:00 2001 From: Grahame Grieve Date: Fri, 18 Oct 2024 06:42:39 +0800 Subject: [PATCH 6/7] Make tx-reg master server configurable --- server/endpoint_txregistry.pas | 3 +-- server/tx_registry_spider.pas | 9 ++++++--- server/zero_config.pas | 1 + 3 files changed, 8 insertions(+), 5 deletions(-) diff --git a/server/endpoint_txregistry.pas b/server/endpoint_txregistry.pas index b143c000b..4f679918e 100644 --- a/server/endpoint_txregistry.pas +++ b/server/endpoint_txregistry.pas @@ -76,7 +76,6 @@ TFHIRTxRegistryWebServer = class (TFhirWebServerEndpoint) FNextScan : TDateTIme; FScanning: boolean; FInfo : TServerRegistries; - FAddress : String; procedure populate(json: TJsonObject; srvr: TServerInformation; ver: TServerVersionInformation); function status : String; @@ -147,7 +146,7 @@ constructor TTxRegistryServerEndPoint.Create(config : TFHIRServerConfigSection; s : String; begin inherited Create(config, settings, nil, common, nil, i18n); - s := config['folder'].value; + s := settings.Ini.admin['tx-reg'].value; FAddress := s; if (FAddress = '') then FAddress := MASTER_URL; diff --git a/server/tx_registry_spider.pas b/server/tx_registry_spider.pas index 0b518c332..92c0831f2 100644 --- a/server/tx_registry_spider.pas +++ b/server/tx_registry_spider.pas @@ -45,8 +45,8 @@ interface server_config; const - //MASTER_URL = 'https://fhir.github.io/ig-registry/tx-servers.json'; - MASTER_URL = 'file:/Users/grahamegrieve/work/ig-registry/tx-servers.json'; + MASTER_URL = 'https://fhir.github.io/ig-registry/tx-servers.json'; + //MASTER_URL = 'file:/Users/grahamegrieve/work/ig-registry/tx-servers.json'; EMAIL_DAYS_LIMIT = 7; Type @@ -123,7 +123,10 @@ constructor TTxRegistryScanner.Create(zulip: TZulipTracker; admin : TFHIRServerC begin inherited Create; FZulip := zulip; - FAddress := MASTER_URL; + if (admin['tx-reg'].value <> '') then + FAddress := admin['tx-reg'].value + else + FAddress := MASTER_URL; FLogFileName := FilePath(['[tmp]', 'tx-registry-spider.log']); FAdmin := admin; end; diff --git a/server/zero_config.pas b/server/zero_config.pas index f183db0d9..5e6d44a92 100644 --- a/server/zero_config.pas +++ b/server/zero_config.pas @@ -247,6 +247,7 @@ procedure TConfigurationBuilder.buildConfig(fn: String; local : TCustomIniFile); cfg.web['telnet-password'].value := def(local.ReadString('config', 'telnet-pword', NewGuidId), cfg.web['telnet-password'].value, ''); cfg.web['robots.txt'].value := def(local.ReadString('web', 'robots.txt', ''), cfg.web['robots.txt'].value, ''); cfg.admin['log-folder'].value := def(local.ReadString('web', 'logFolder', ''), cfg.admin['log-folder'].value, ''); + cfg.admin['tx-reg'].value := def(local.ReadString('web', 'tx-reg', ''), cfg.admin['tx-reg'].value, ''); cfg.admin['email'].value := def(local.ReadString('config', 'email', ''), cfg.admin['email'].value, 'noone@fhir.org'); cfg.admin['ownername'].value := def(local.ReadString('config', 'user', ''), cfg.admin['ownername'].value, 'Local User'); cfg.service['max-memory'].value := def(local.ReadString('config', 'max-memory', ''), cfg.service['max-memory'].value, '0'); From e76a81c3b032984602b4556aa14cb8214f5aadaa Mon Sep 17 00:00:00 2001 From: Grahame Grieve Date: Fri, 18 Oct 2024 07:41:25 +0800 Subject: [PATCH 7/7] fix compile error --- server/operations.pas | 2 +- server/tx_operations.pas | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/server/operations.pas b/server/operations.pas index 98921165d..04630ebce 100644 --- a/server/operations.pas +++ b/server/operations.pas @@ -36,7 +36,7 @@ interface SysUtils, Classes, fsl_base, fsl_logging, fhir_factory, fhir_common, - session, storage, time_tracker; + session, storage; type TFhirVersionsOperation = class (TFhirOperation) diff --git a/server/tx_operations.pas b/server/tx_operations.pas index 53d9aacbd..8e8e53d18 100644 --- a/server/tx_operations.pas +++ b/server/tx_operations.pas @@ -38,7 +38,7 @@ interface fdb_manager, fhir_objects, fhir_utilities, fhir_common, fhir_factory, fhir_tx, fhir_valuesets, - session, storage, ftx_service, tx_manager, tx_server, closuremanager, time_tracker; + session, storage, ftx_service, tx_manager, tx_server, closuremanager; type TLoadCodedType = (lctCS, lctVS, lctCMSrc, lctCMTgt);