Skip to content

Commit

Permalink
Merge pull request #178 from HealthIntersections/gg-202112-valueset-d…
Browse files Browse the repository at this point in the history 
…isplay

Gg 202112 valueset display
  • Loading branch information
@grahamegrieve
grahamegrieve authored Dec 13, 2021
2 parents 0cb782b + fee6979 commit 38e9c64
Show file tree
Hide file tree
Showing 11 changed files with 664 additions and 368 deletions.
3 changes: 2 additions & 1 deletion .gitignore
View file
Original file line number Diff line number Diff line change
Expand Up @@ -73,4 +73,5 @@ exec/Resources
/dependencies/Indy10-mod-static
/dependencies/indy-master
/release-notes.md
/install/build
/install/build
/release-notes-old.md
2 changes: 1 addition & 1 deletion build/linux-toolchain.sh
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,7 @@ echo "Get fpclazup"

mkdir tools

wget -q https://github.com/LongDirtyAnimAlf/Reiniero-fpcup/releases/download/v2.2.0b/fpclazup-x86_64-linux -O tools/fpclazup
wget -q https://github.com/LongDirtyAnimAlf/Reiniero-fpcup/releases/download/v2.2.0g/fpclazup-x86_64-linux -O tools/fpclazup

chmod +x tools/fpclazup

Expand Down
29 changes: 17 additions & 12 deletions library/ftx/fhir_valuesets.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -169,7 +169,7 @@ TValueSetWorker = class (TFslObject)
function sizeInBytesV(magic : integer) : cardinal; override;
procedure listDisplays(displays : TCodeDisplays; cs : TCodeSystemProvider; c: TCodeSystemProviderContext); overload;
procedure listDisplays(displays : TCodeDisplays; c: TFhirCodeSystemConceptW); overload;
procedure listDisplays(displays: TCodeDisplays; c: TFhirValueSetComposeIncludeConceptW); overload;
procedure listDisplays(displays: TCodeDisplays; c: TFhirValueSetComposeIncludeConceptW; vs : TFHIRValueSetW); overload;
public
constructor Create(factory : TFHIRFactory; getVS: TGetValueSetEvent; getCS : TGetProviderEvent; getVersions : TGetSystemVersionsEvent; txResources : TFslMetadataResourceList; languages : TIETFLanguageDefinitions); overload;
destructor Destroy; override;
Expand All @@ -185,7 +185,7 @@ TValueSetChecker = class (TValueSetWorker)
function determineSystem(code : String) : String;
function check(system, version, code : String; abstractOk, implySystem : boolean; displays : TCodeDisplays; var message, ver : String; var cause : TFhirIssueType; op : TFhirOperationOutcomeW; var contentMode : TFhirCodeSystemContentMode) : boolean; overload;
function findCode(cs : TFhirCodeSystemW; code: String; list : TFhirCodeSystemConceptListW; displays : TCodeDisplays; out isabstract : boolean): boolean;
function checkConceptSet(cs: TCodeSystemProvider; cset : TFhirValueSetComposeIncludeW; code : String; abstractOk : boolean; displays : TCodeDisplays; var message : String) : boolean;
function checkConceptSet(cs: TCodeSystemProvider; cset : TFhirValueSetComposeIncludeW; code : String; abstractOk : boolean; displays : TCodeDisplays; vs : TFHIRValueSetW; var message : String) : boolean;
procedure prepareConceptSet(desc: string; cc: TFhirValueSetComposeIncludeW);
function getName: String;
protected
Expand Down Expand Up @@ -220,7 +220,7 @@ TFHIRValueSetExpander = class (TValueSetWorker)
procedure handleDefine(cs : TFhirCodeSystemW; list : TFslList<TFhirValueSetExpansionContainsW>; map : TFslMap<TFhirValueSetExpansionContainsW>; limitCount : integer; source : TFhirValueSetCodeSystemW; defines : TFhirCodeSystemConceptListW; filter : TSearchFilterText; expansion : TFhirValueSetExpansionW; imports : TFslList<TFHIRImportedValueSet>);
procedure importValueSet(list : TFslList<TFhirValueSetExpansionContainsW>; map : TFslMap<TFhirValueSetExpansionContainsW>; vs : TFHIRValueSetW; expansion : TFhirValueSetExpansionW; imports : TFslList<TFHIRImportedValueSet>; offset : integer);
procedure excludeValueSet(list: TFslList<TFhirValueSetExpansionContainsW>; map: TFslMap<TFhirValueSetExpansionContainsW>; vs : TFHIRValueSetW; expansion : TFhirValueSetExpansionW; imports : TFslList<TFHIRImportedValueSet>; offset : integer);
procedure processCodes(doDelete : boolean; list : TFslList<TFhirValueSetExpansionContainsW>; map : TFslMap<TFhirValueSetExpansionContainsW>; limitCount : integer; cset : TFhirValueSetComposeIncludeW; filter : TSearchFilterText; dependencies : TStringList; expansion : TFhirValueSetExpansionW; var notClosed : boolean);
procedure processCodes(doDelete : boolean; list : TFslList<TFhirValueSetExpansionContainsW>; map : TFslMap<TFhirValueSetExpansionContainsW>; limitCount : integer; cset : TFhirValueSetComposeIncludeW; vsSrc : TFHIRValueSetW; filter : TSearchFilterText; dependencies : TStringList; expansion : TFhirValueSetExpansionW; var notClosed : boolean);
procedure handleCompose(list : TFslList<TFhirValueSetExpansionContainsW>; map : TFslMap<TFhirValueSetExpansionContainsW>; limitCount : integer; source : TFhirValueSetW; filter : TSearchFilterText; dependencies : TStringList; expansion : TFhirValueSetExpansionW; var notClosed : boolean);

function passesImports(imports : TFslList<TFHIRImportedValueSet>; system, code : String; offset : integer) : boolean;
Expand Down Expand Up @@ -769,7 +769,7 @@ function TValueSetChecker.check(system, version, code : String; abstractOk, impl
raise ETerminologyError.create('Value Set Validation depends on supplement '+s+' on '+cs.systemUri(nil)+' that is not known');
end;

result := ((system = SYSTEM_NOT_APPLICABLE) or (cs.systemUri(nil) = system)) and checkConceptSet(cs, cc, code, abstractOk, displays, message);
result := ((system = SYSTEM_NOT_APPLICABLE) or (cs.systemUri(nil) = system)) and checkConceptSet(cs, cc, code, abstractOk, displays, FValueSet, message);
end
else
result := false;
Expand Down Expand Up @@ -799,7 +799,7 @@ function TValueSetChecker.check(system, version, code : String; abstractOk, impl
if not cs.hasSupplement(s) then
raise ETerminologyError.create('Value Set Validation depends on supplement '+s+' on '+cs.systemUri(nil)+' that is not known');
end;
excluded := ((system = SYSTEM_NOT_APPLICABLE) or (cs.systemUri(nil) = system)) and checkConceptSet(cs, cc, code, abstractOk, displays, message);
excluded := ((system = SYSTEM_NOT_APPLICABLE) or (cs.systemUri(nil) = system)) and checkConceptSet(cs, cc, code, abstractOk, displays, FValueSet, message);
end;
for s in cc.valueSets do
begin
Expand Down Expand Up @@ -1082,7 +1082,7 @@ function TValueSetChecker.check(system, version, code: String; implySystem : boo
cs.Close(ctxt);
end;

function TValueSetChecker.checkConceptSet(cs: TCodeSystemProvider; cset : TFhirValueSetComposeIncludeW; code: String; abstractOk : boolean; displays : TCodeDisplays; var message : String): boolean;
function TValueSetChecker.checkConceptSet(cs: TCodeSystemProvider; cset : TFhirValueSetComposeIncludeW; code: String; abstractOk : boolean; displays : TCodeDisplays; vs : TFHIRValueSetW; var message : String): boolean;
var
i : integer;
fc : TFhirValueSetComposeIncludeFilterW;
Expand Down Expand Up @@ -1117,7 +1117,7 @@ function TValueSetChecker.checkConceptSet(cs: TCodeSystemProvider; cset : TFhirV
if Loc <> nil then
begin
listDisplays(displays, cs, loc);
listDisplays(displays, cc);
listDisplays(displays, cc, vs);
result := (abstractOk or not cs.IsAbstract(loc));
cs.close(loc);
exit;
Expand Down Expand Up @@ -1463,9 +1463,9 @@ procedure TFHIRValueSetExpander.handleCompose(list: TFslList<TFhirValueSetExpans
checkSource(c, expansion, limitCount, filter);

for c in source.includes.forEnum do
processCodes(false, list, map, limitCount, c, filter, dependencies, expansion, notClosed);
processCodes(false, list, map, limitCount, c, source, filter, dependencies, expansion, notClosed);
for c in source.excludes.forEnum do
processCodes(true, list, map, limitCount, c, filter, dependencies, expansion, notClosed);
processCodes(true, list, map, limitCount, c, source, filter, dependencies, expansion, notClosed);
end;

procedure TFHIRValueSetExpander.handleDefine(cs : TFhirCodeSystemW; list : TFslList<TFhirValueSetExpansionContainsW>; map : TFslMap<TFhirValueSetExpansionContainsW>; limitCount : integer; source : TFhirValueSetCodeSystemW; defines : TFhirCodeSystemConceptListW; filter : TSearchFilterText; expansion : TFhirValueSetExpansionW; imports : TFslList<TFHIRImportedValueSet>);
Expand Down Expand Up @@ -1506,11 +1506,16 @@ procedure TValueSetWorker.listDisplays(displays : TCodeDisplays; c: TFhirCodeSys
displays.see(ccd.language, ccd.value);
end;

procedure TValueSetWorker.listDisplays(displays : TCodeDisplays; c: TFhirValueSetComposeIncludeConceptW);
procedure TValueSetWorker.listDisplays(displays : TCodeDisplays; c: TFhirValueSetComposeIncludeConceptW; vs : TFHIRValueSetW);
var
cd : TFhirValueSetComposeIncludeConceptDesignationW;
first : boolean;
begin
if c.display <> '' then
begin
displays.Clear;
displays.see(vs.language, c.display, true);
end;
first := true;
for cd in c.designations.forEnum do
begin
Expand Down Expand Up @@ -1813,7 +1818,7 @@ procedure TFHIRValueSetExpander.checkSource(cset: TFhirValueSetComposeIncludeW;
end;
end;

procedure TFHIRValueSetExpander.processCodes(doDelete : boolean; list: TFslList<TFhirValueSetExpansionContainsW>; map: TFslMap<TFhirValueSetExpansionContainsW>; limitCount : integer; cset: TFhirValueSetComposeIncludeW; filter : TSearchFilterText; dependencies : TStringList; expansion : TFhirValueSetExpansionW; var notClosed : boolean);
procedure TFHIRValueSetExpander.processCodes(doDelete : boolean; list: TFslList<TFhirValueSetExpansionContainsW>; map: TFslMap<TFhirValueSetExpansionContainsW>; limitCount : integer; cset: TFhirValueSetComposeIncludeW; vsSrc : TFHIRValueSetW; filter : TSearchFilterText; dependencies : TStringList; expansion : TFhirValueSetExpansionW; var notClosed : boolean);
var
cs : TCodeSystemProvider;
i, count, offset : integer;
Expand Down Expand Up @@ -1986,7 +1991,7 @@ procedure TFHIRValueSetExpander.processCodes(doDelete : boolean; list: TFslList<
if (cctxt <> nil) and (not FParams.activeOnly or not cs.IsInactive(cctxt)) and passesFilters(cctxt, 0) then
begin
listDisplays(cds, cs, cctxt);
listDisplays(cds, cc);
listDisplays(cds, cc, vsSrc);
if filter.passes(cds) or filter.passes(cc.code) then
processCode(doDelete, limitCount, list, map, cs.systemUri(nil), cs.version(nil), cc.code, cds, cs.Definition(cctxt), expansion, valueSets);
end;
Expand Down
95 changes: 94 additions & 1 deletion library/fui/fui_lcl_managers.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -61,12 +61,31 @@

TControlOperation = (copNone, copAdd, copAddSet, copEdit, copDelete, copUp, copDown, copReload, copExecute, copRefresh, copStop, copCopy, copUpdate);

{ TControlEntryMenuItem }

TControlEntryMenuItem = class (TFslObject)
private
FMenuItem: TMenuItem;
FMode: String;
FOp: TControlOperation;
public
function link : TControlEntryMenuItem; overload;

property menuItem : TMenuItem read FMenuItem write FMenuItem;
property op : TControlOperation read FOp write FOp;
property mode : String read FMode write FMode;
end;

TControlEntry = class (TFslObject)
private
FControl: TControl;
FMode: String;
FOp: TControlOperation;
FMenuItems : TFslList<TControlEntryMenuItem>;
FMenu : TPopupMenu;
public
destructor Destroy; override;

function link : TControlEntry; overload;


Expand All @@ -93,6 +112,7 @@ TListOrTreeManagerBase = class abstract (TFslObject)
procedure doControl(sender : TObject); virtual; abstract;
procedure doMnuClick(Sender: TObject); virtual; abstract;
procedure updateControls(op : TControlOperation; allowed : boolean);
procedure updateMenuControls;
procedure SetImages(AValue: TImagelist); virtual;
public
constructor Create; override;
Expand All @@ -106,7 +126,9 @@ TListOrTreeManagerBase = class abstract (TFslObject)
procedure getCopyModes(modes : TStringList); virtual;

procedure registerControl(c : TControl; op : TControlOperation; mode : String = '');
function registerMenuEntry(caption : String; imageIndex : integer; op : TControlOperation; mode : String = '') : TMenuItem;
function registerControlForMenu(c : TControl; menu : TPopupMenu) : TControlEntry;
function registerMenuEntry(caption : String; imageIndex : integer; op : TControlOperation; mode : String = '') : TMenuItem; overload;
function registerMenuEntry(grp : TControlEntry; caption : String; imageIndex : integer; op : TControlOperation; mode : String = '') : TMenuItem; overload;
function registerSubMenuEntry(parent : TMenuItem; caption : String; imageIndex : integer; op : TControlOperation; mode : String = '') : TMenuItem;
end;

Expand Down Expand Up @@ -555,6 +577,13 @@ TPanelStack = class (TFslObject)

Implementation

{ TControlEntryMenuItem }

function TControlEntryMenuItem.link: TControlEntryMenuItem;
begin
result := TControlEntryMenuItem(inherited link);
end;

{ TPanelStackSubPanel }

constructor TPanelStackSubPanel.create(container, heading: TPanel);
Expand Down Expand Up @@ -679,6 +708,12 @@ procedure TObjectManager.registerControl(propName: String; control: TCheckBox);

{ TControlEntry }

destructor TControlEntry.Destroy;
begin
FMenuItems.Free;
inherited Destroy;
end;

function TControlEntry.link: TControlEntry;
begin
result := TControlEntry(inherited link);
Expand Down Expand Up @@ -727,6 +762,20 @@ procedure TListOrTreeManagerBase.registerControl(c : TControl; op : TControlOper
end;
end;

function TListOrTreeManagerBase.registerControlForMenu(c: TControl; menu : TPopupMenu): TControlEntry;
begin
result := TControlEntry.create;
try
result.control := c;
result.op := copNone;
result.FMenu := menu;
c.enabled := false;
FControls.add(result.link);
finally
result.free;
end;
end;

function TListOrTreeManagerBase.registerMenuEntry(caption: String; imageIndex: integer; op: TControlOperation; mode : String = '') : TMenuItem;
var
list : TStringList;
Expand Down Expand Up @@ -758,6 +807,22 @@ function TListOrTreeManagerBase.registerMenuEntry(caption: String; imageIndex: i
end;
end;

function TListOrTreeManagerBase.registerMenuEntry(grp: TControlEntry; caption: String; imageIndex: integer; op: TControlOperation; mode: String): TMenuItem;
var
list : TStringList;
i : integer;
begin
result := TMenuItem.create(nil);
grp.FMenu.Items.add(result);
result.caption := caption;
result.imageIndex := imageIndex;
result.Tag := Integer(op);
if mode <> '' then
result.name := 'mnuMode'+mode;
if op <> copNone then
result.OnClick := doMnuClick;
end;

function TListOrTreeManagerBase.registerSubMenuEntry(parent: TMenuItem; caption: String; imageIndex: integer; op: TControlOperation; mode: String): TMenuItem;
begin
result := TMenuItem.create(nil);
Expand All @@ -783,13 +848,38 @@ procedure TListOrTreeManagerBase.updateControls(op: TControlOperation; allowed:
i : integer;
begin
for entry in FControls do
begin
if entry.op = op then
entry.control.enabled := allowed;
if (entry.FMenu <> nil) then
for i := 0 to entry.FMenu.Items.Count - 1 do
if (TControlOperation(entry.FMenu.Items[i].tag) = op) then
entry.FMenu.Items[i].enabled := allowed;
end;
for i := 0 to FPopup.Items.Count - 1 do
if (TControlOperation(FPopup.Items[i].tag) = op) then
FPopup.Items[i].enabled := allowed;
end;

procedure TListOrTreeManagerBase.updateMenuControls;
var
entry : TControlEntry;
i : integer;
ok : boolean;
begin
for entry in FControls do
begin
if (entry.FMenu <> nil) then
begin
ok := false;
for i := 0 to entry.FMenu.Items.Count - 1 do
if entry.FMenu.Items[i].Enabled then
ok := true;
entry.control.Enabled := ok;
end;
end;
end;

{ TListManager }

constructor TListManager<T>.Create;
Expand Down Expand Up @@ -973,6 +1063,7 @@ procedure TListManager<T>.updateStatus;
updateControls(copUpdate, opUpdate in ops);
updateControls(copStop, opStop in ops);
updateControls(copCopy, FHasCopy);
updateMenuControls();
FCanEdit := opEdit in ops;

focusItemChange(focus);
Expand Down Expand Up @@ -2011,6 +2102,7 @@ procedure TTreeManager<T>.updateStatus;
updateControls(copUpdate, opUpdate in ops);
updateControls(copStop, opStop in ops);
updateControls(copCopy, FHasCopy);
updateMenuControls;
FCanEdit := opEdit in ops;

focusItemChange(focus);
Expand Down Expand Up @@ -2536,6 +2628,7 @@ procedure TVTreeManager<T>.updateStatus;
updateControls(copUpdate, opUpdate in ops);
updateControls(copStop, opStop in ops);
updateControls(copCopy, FHasCopy);
updateMenuControls;
FCanEdit := opEdit in ops;

focusItemChange(focus);
Expand Down
7 changes: 5 additions & 2 deletions server/client_cache_manager.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -118,8 +118,11 @@ procedure TClientCacheManagerEntry.update(list: TFslMetadataResourceList);
FList.RemoveAll(remove);
for i in list do
begin
FSize := FSize + i.sizeInBytes(magic);
FList.Add(i.link);
if (i.url <> '') then
begin
FSize := FSize + i.sizeInBytes(magic);
FList.Add(i.link);
end;
end;
finally
remove.Free;
Expand Down
Binary file modified server/fhirserver.res
View file
Binary file not shown.
3 changes: 1 addition & 2 deletions toolkit2/fhirtoolkit.lpi
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
Expand All @@ -16,9 +17,7 @@
<VersionInfo>
<UseVersionInfo Value="True"/>
<MajorVersionNr Value="2"/>
<MinorVersionNr Value="0"/>
<RevisionNr Value="9"/>
<Attributes pvaDebug="False"/>
</VersionInfo>
<BuildModes>
<Item Name="default" Default="True"/>
Expand Down
Loading

0 comments on commit 38e9c64

Please sign in to comment.