Ignore:
Timestamp:
Jul 7, 2010, 4:51:54 PM (14 years ago)
Author:
Kevin Toppenberg
Message:

Upgrading to version 27

File:
1 edited

Legend:

Unmodified
Added
Removed

  • cprs/trunk/CPRS-Chart/fGraphProfiles.pas

    r456 r830  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   ComCtrls, StdCtrls, ExtCtrls, CheckLst, ORCtrls, ORFn, uGraphs, uCore;
     7  ComCtrls, StdCtrls, ExtCtrls, CheckLst, ORCtrls, ORFn, uGraphs, rCore, uCore,
     8  fBase508Form, VA508AccessibilityManager;
    89
    910type
    10   TfrmGraphProfiles = class(TForm)
     11  TfrmGraphProfiles = class(TfrmBase508Form)
    1112    btnAdd: TButton;
    1213    btnAddAll: TButton;
    … …  
    2829    lblSelection: TLabel;
    2930    lblSelectionInfo: TLabel;
    30     lblSource: TLabel;
    3131    lstActualItems: TORListBox;
    3232    lstDrugClass: TListBox;
    3333    lstItemsDisplayed: TORListBox;
    34     lstItemsTopSelection: TORListBox;
     34    lstItemsSelection: TORListBox;
    3535    lstScratch: TListBox;
    36     lstSource: TORListBox;
    3736    lstTests: TListBox;
    3837    pnlApply: TPanel;
    … …  
    4746    lblSave: TLabel;
    4847    lblClose: TLabel;
     48    lblUser: TLabel;
     49    pnlAllSources: TPanel;
     50    pnlSources: TPanel;
     51    lblSource: TLabel;
     52    lstSources: TORListBox;
     53    pnlOtherSources: TPanel;
     54    pnlOtherSourcesUser: TPanel;
     55    lblOtherPersons: TLabel;
     56    cboUser: TORComboBox;
     57    pnlOtherSourcesBottom: TPanel;
     58    lstOtherSources: TORListBox;
     59    btnViews: TButton;
     60    btnDefinitions: TButton;
     61    pnlOtherViews: TPanel;
     62    lblOtherViews: TLabel;
     63    lblSelectOthers: TLabel;
     64    splViews: TSplitter;
    4965    procedure FormCreate(Sender: TObject);
    5066    procedure FormShow(Sender: TObject);
    … …  
    5268
    5369    procedure btnClearClick(Sender: TObject);
    54     procedure btnDeleteClick(Sender: TObject);
    5570    procedure btnCloseClick(Sender: TObject);
    56     procedure btnRemoveClick(Sender: TObject);
     71    procedure btnDefinitionsClick(Sender: TObject);
    5772    procedure btnRemoveAllClick(Sender: TObject);
    5873    procedure btnRemoveOneClick(Sender: TObject);
    59     procedure btnRenameClick(Sender: TObject);
    60     procedure btnSaveClick(Sender: TObject);
    61 
    62     procedure radSourceAllClick(Sender: TObject);
    63 
     74    procedure btnViewsClick(Sender: TObject);
    6475    procedure cboAllItemsClick(Sender: TObject);
    6576    procedure cboAllItemsChange(Sender: TObject);
    6677    procedure cboAllItemsNeedData(Sender: TObject; const StartFrom: String;
    6778      Direction, InsertAt: Integer);
     79    procedure cboUserClick(Sender: TObject);
     80    procedure cboUserNeedData(Sender: TObject; const StartFrom: string;
     81      Direction, InsertAt: Integer);
    6882    procedure lstItemsDisplayedChange(Sender: TObject);
    6983    procedure lstItemsDisplayedDblClick(Sender: TObject);
    70     procedure lstSourceChange(Sender: TObject);
    71     procedure lstSourceDblClick(Sender: TObject);
     84    procedure lstSourcesChange(Sender: TObject);
     85    procedure lstSourcesDblClick(Sender: TObject);
     86    procedure lstSourcesEnter(Sender: TObject);
     87    procedure lstSourcesExit(Sender: TObject);
     88    procedure radSourceAllClick(Sender: TObject);
     89
     90    procedure btnDeleteClick(Sender: TObject);
     91    procedure btnRenameClick(Sender: TObject);
     92    procedure btnSaveClick(Sender: TObject);
    7293
    7394    procedure AddToList(aItem: string; aListBox: TORListBox);
    … …  
    7596      aListBox: TORListBox; var addtolist: boolean);
    7697    procedure AssignHints;
    77     procedure AssignProfile(aList: TStrings; aProfile: string);
     98    procedure AssignProfile(aList: TStrings; aProfile: string; UserNum: integer; allitems: boolean);
     99    procedure AssignProfilePre(aList: TStrings; var aProfile: string; UserNum: integer);
     100    procedure AssignProfilePost(aList: TStrings; var aProfile, typedata: string);
    78101    procedure CheckPublic;
    79     procedure FillSource;
    80 
    81     function ProfileExists(aName: string; aType: integer): boolean;
     102    procedure FillSource(aList: TORListBox);
     103    function ProfileExists(aName, aType: string): boolean;
     104    procedure btnAddAllClick(Sender: TObject);
    82105  private
    83     { Private declarations }
    84106    FHintPauseTime: integer;
    85107    FPublicEditor: boolean;
    … …  
    88110    procedure wmNCLButtonDown(var Msg: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
    89111  public
    90     { Public declarations }
     112    procedure AllItemsAfter(var filetype, typedata: string);
     113    procedure AllItemsBefore(var typedata: string);
     114    procedure IDProfile(var profilename, proftype: string);
     115    procedure ListBoxSetup(Sender: TObject);
     116    procedure ComboBoxSetup(Sender: TObject);
     117    procedure Report(aListBox: TORListBox);
     118    function GetProfileName(infotitle, info: string; var newprofilename: string): boolean;
    91119  end;
    92120
    … …  
    94122  frmGraphProfiles: TfrmGraphProfiles;
    95123
    96 procedure DialogOptionsGraphProfiles(topvalue, leftvalue, fontsize: integer;
    97   var actiontype: boolean);
    98 procedure DialogGraphProfiles(fontsize: integer;  var actionOK: boolean;
     124procedure DialogOptionsGraphProfiles(var actiontype: boolean);
     125procedure DialogGraphProfiles(var actionOK: boolean;
    99126  var checkaction: boolean; aGraphSetting: TGraphSetting;
    100127  var aProfname, aProfilestring, aSection: string;
    … …  
    107134
    108135uses
    109   rGraphs;
    110 
    111 procedure DialogOptionsGraphProfiles(topvalue, leftvalue, fontsize: integer;
    112   var actiontype: boolean);
     136  rGraphs, fGraphData, fGraphOthers, fRptBox, VAUtils;
     137
     138procedure DialogOptionsGraphProfiles(var actiontype: boolean);
    113139// create the form and make it modal, return an action
    114140var
    115141  FGraphSetting: TGraphSetting;
    116   aList, AllTypes: TStrings;
    117   dfntype, listline, settings, settings1, t1, t2: string;
     142  settings: string;
    118143  actionOK, checkaction: boolean;
    119   counter, i: integer;
     144  counter: integer;
    120145  aSelections, profile, profilestring, section: string;
    121146begin
    122   aList := TStringList.Create;
    123   FastAssign(rpcGetGraphSettings, aList);
    124   if aList.Count < 1 then
    125   begin
    126     showmessage('CPRS is not configured for graphing.');
    127     aList.Free;
     147  if (GtslData = nil) then
     148  begin
     149    ShowMsg(TXT_NOGRAPHING);
    128150    exit;
    129151  end;
    130   t1 := aList[0]; t2 := aList[1];   // t1 are personal, t2 public settings
    131   if length(t1) > 0 then settings := t1
    132   else settings := t2;
    133   SetPiece(settings, '|', 8, Piece(t2, '|', 8));
    134   settings1 := Piece(settings, '|', 1);
    135   Alltypes := TStringList.Create;
    136   FastAssign(rpcGetTypes('0', true), AllTypes);
    137   for i := 0 to AllTypes.Count - 1 do
    138   begin
    139     listline := AllTypes[i];
    140     dfntype := UpperCase(Piece(listline, '^', 1));
    141     SetPiece(listline, '^', 1, dfntype);
    142     AllTypes[i] := listline;
    143   end;
     152  settings := GetCurrentSetting;
    144153  FGraphSetting := GraphSettingsInit(settings);
    145154  checkaction := false;
    … …  
    148157  counter := BIG_NUMBER;
    149158  aSelections :='';
    150   DialogGraphProfiles(fontsize, actionOK, checkaction, FGraphSetting,
     159  DialogGraphProfiles(actionOK, checkaction, FGraphSetting,
    151160    profile, profilestring, section, Patient.DFN, counter, aSelections);
    152161  FGraphSetting.Free;
    153   aList.Free;
    154 end;
    155 
    156 procedure DialogGraphProfiles(fontsize: integer;  var actionOK: boolean;
     162end;
     163
     164procedure DialogGraphProfiles(var actionOK: boolean;
    157165  var checkaction: boolean; aGraphSetting: TGraphSetting;
    158166  var aProfname, aProfilestring, aSection: string;
    … …  
    161169var
    162170  i: integer;
    163   counter, profile, profileitem, profiletype: string;
     171  astring, counter, profile, profileitem, profiletype, profiletext: string;
    164172  frmGraphProfiles: TfrmGraphProfiles;
    165173begin
    … …  
    181189      end;
    182190      if length(aSelections) > 0 then
    183         lstSource.Items.Insert(0, '-3^<current selections>^' + aSelections);
     191      begin
     192        if GtslViews.Count = 0 then
     193          GtslViews.Insert(0, VIEW_CURRENT + '^<current selections>^' + aSelections)
     194        else if Piece(GtslViews[0], '^', 1) <> VIEW_CURRENT then
     195          GtslViews.Insert(0, VIEW_CURRENT + '^<current selections>^' + aSelections)
     196        else if GtslViews.Count > 0 then
     197          GtslViews[0] := VIEW_CURRENT + '^<current selections>^' + aSelections;
     198      end;
    184199      ResizeAnchoredFormToFont(frmGraphProfiles);
    185200      ShowModal;
    186201      actionOK := (btnClose.Tag = 1);
     202      profiletext := '';
    187203      aProfname := '';
    188204      if actionOK then
    … …  
    197213        for i := 0 to Items.Count - 1 do
    198214        begin
    199           profiletype := Piece(Items[i], '^', 1);
    200           profileitem := Piece(Items[i], '^', 2);
     215          astring := Items[i];
     216          profiletext := profiletext + Piece(astring, '^', 3) + '^';
     217          profiletype := Piece(astring, '^', 1);
     218          if profiletype = '8925' then
     219            profileitem := UpperCase(Piece(astring, '^', 3))
     220          else
     221            profileitem := Piece(astring, '^', 2);
    201222          profile := profile + profiletype + '~' + profileitem + '~|';
    202223        end;
    203         aCounter := aCounter + 1;
    204         counter := inttostr(aCounter);
    205         aProfileString := '^<view' + counter + '>^' + profile;
     224        if (GtslViews.Count > 0) and (Piece(GtslViews[0], '^', 1) = VIEW_CURRENT) then
     225          counter := inttostr(GtslViews.Count)
     226        else
     227          counter := inttostr(GtslViews.Count + 1);
     228        aProfileString := '<view' + counter + '>^' + profile + '^' + profiletext;
     229        GtslViews.Add(aProfileString);
     230        aCounter := strtointdef(counter, BIG_NUMBER);
    206231        with aGraphSetting do
    207232        begin
    … …  
    214239          ItemsForDisplay := lstActualItems.Items;
    215240        end;
    216      end;
     241      end;
    217242    end;
    218243  finally
    … …  
    223248procedure TfrmGraphProfiles.FormCreate(Sender: TObject);
    224249begin
    225   FillSource;
    226   FPublicEditor := rpcPublicEdit;
     250  FPublicEditor := GraphPublicEditor;
    227251end;
    228252
    229253procedure TfrmGraphProfiles.FormShow(Sender: TObject);
    230254begin
     255  if GtslData = nil then
     256  begin
     257    radSourceAll.Checked := true;
     258    //radSourcePat.Enabled := false;
     259  end
     260  else if GtslData.Count < 1 then
     261  begin
     262    radSourceAll.Checked := true;
     263    //radSourcePat.Enabled := false;
     264  end;
    231265  cboAllItems.Visible := radSourceAll.Checked;
     266  FillSource(lstSources);
     267  cboUser.InitLongList('');
    232268  FHintPauseTime := Application.HintHidePause;
    233269  Application.HintHidePause := 9000; // uses a longer hint pause time
    234270end;
    235271
     272procedure TfrmGraphProfiles.FormClose(Sender: TObject; var Action: TCloseAction);
     273begin
     274  Application.HintHidePause := FHintPauseTime;
     275end;
     276
     277procedure TfrmGraphProfiles.radSourceAllClick(Sender: TObject);
     278var
     279  dfn: string;
     280begin
     281  if Sender = radSourceAll then
     282  begin
     283    lstItemsSelection.Visible := false;
     284    cboAllItems.Visible := true;
     285  end
     286  else
     287  begin
     288    if radSourcePat.Tag = 0 then
     289    begin
     290      dfn := lblClose.Hint;
     291      FastAssign(rpcGetAllItems(dfn), lstTests.Items);  // items for patient
     292      FastAssign(rpcGetItems('50.605', dfn), lstDrugClass.Items);
     293      radSourcePat.Tag := 1;
     294    end;
     295    cboAllItems.Visible := false;
     296    lstItemsSelection.Visible := true;
     297  end;
     298  if lstSources.ItemIndex > 0 then
     299  begin
     300    lstSources.Tag := BIG_NUMBER;
     301    lstSourcesChange(lstSources);
     302  end
     303  else if lstSources.ItemIndex > 0 then
     304  begin
     305    lstOtherSources.Tag := BIG_NUMBER;
     306    lstSourcesChange(lstOtherSources);
     307  end;
     308end;
     309
     310procedure TfrmGraphProfiles.lstSourcesChange(Sender: TObject);
     311var
     312  UserNum: int64;
     313  filetype, typedata: string;
     314  aListBox, oppositeListBox: TORListBox;
     315  viewselected: boolean;
     316begin
     317  CheckPublic;
     318  aListBox := (Sender as TORListBox);
     319  if aListBox = lstSources then
     320  begin
     321    oppositeListBox := lstOtherSources;
     322    UserNum := User.DUZ;
     323  end
     324  else
     325  begin
     326    oppositeListBox := lstSources;
     327    UserNum := cboUser.ItemID;
     328  end;
     329  if aListBox.Tag <> BIG_NUMBER then
     330    exit;
     331  oppositeListBox.ItemIndex := -1;
     332  cboAllItems.Items.Clear;
     333  cboAllItems.Text := '';
     334  if aListBox.ItemIndex = -1 then exit;
     335  typedata :=  aListBox.Items[aListBox.ItemIndex];
     336  if pos(LLS_FRONT, typedata) > 0 then  // <clear all selections>
     337  begin
     338    lstItemsSelection.Clear;
     339    cboAllItems.Items.Clear;
     340    cboAllItems.Text := '';
     341    exit;
     342  end;
     343  filetype := Piece(typedata, '^', 1);
     344  if (filetype = VIEW_PERSONAL)
     345  or (filetype = VIEW_PUBLIC)
     346  or (filetype = VIEW_LABS)
     347  or (filetype = VIEW_TEMPORARY)
     348  or (filetype = VIEW_CURRENT) then
     349  begin
     350    RadSourceAll.Checked := true;
     351    RadSourcePat.Enabled := false;
     352    AssignProfile(cboAllItems.Items, typedata, UserNum, false);
     353    FastAssign(cboAllItems.Items, lstItemsSelection.Items);
     354    viewselected := true;
     355  end
     356  else
     357  begin
     358    RadSourcePat.Enabled := true;
     359    AllItemsBefore(typedata);
     360    AllItemsAfter(filetype, typedata);
     361    viewselected := false;
     362  end;
     363  lstItemsSelection.Visible := viewselected or radSourcePat.Checked;
     364  cboAllItems.Visible := not lstItemsSelection.Visible;
     365  cboAllItemsChange(cboAllItems);
     366end;
     367
     368procedure TfrmGraphProfiles.lstSourcesEnter(Sender: TObject);
     369begin
     370  (Sender as TORListBox).Tag := BIG_NUMBER;
     371end;
     372
     373procedure TfrmGraphProfiles.lstSourcesExit(Sender: TObject);
     374begin
     375  (Sender as TORListBox).Tag := 0;
     376end;
     377
     378procedure TfrmGraphProfiles.lstSourcesDblClick(Sender: TObject);
     379begin
     380  if cboAllItems.Visible then
     381  begin
     382    if cboAllItems.Items.Count < 1 then exit;
     383    cboAllItems.ItemIndex := 0;
     384    cboAllItemsClick(cboAllItems);
     385  end
     386  else
     387  begin
     388    if lstItemsSelection.Items.Count < 1 then exit;
     389    //lstItemsSelection.Selected[0] := true;
     390    cboAllItemsClick(lstItemsSelection);
     391    btnAddAllClick(self);
     392  end;
     393end;
     394
     395procedure TfrmGraphProfiles.cboUserClick(Sender: TObject);
     396begin
     397  FillSource(lstOtherSources);
     398  if cboUser.ItemIndex <> -1 then
     399    lblOtherViews.Caption := cboUser.DisplayText[cboUser.ItemIndex] + ' Views:'
     400  else
     401    lblOtherViews.Caption := 'Other Views:'
     402end;
     403
     404procedure TfrmGraphProfiles.cboUserNeedData(Sender: TObject;
     405  const StartFrom: string; Direction, InsertAt: Integer);
     406begin
     407  cboUser.ForDataUse(SubSetOfPersons(StartFrom, Direction));
     408end;
     409
     410procedure TfrmGraphProfiles.cboAllItemsChange(Sender: TObject);
     411//var
     412 //astring: string;
     413begin
     414 if (Sender is TORListBox) then
     415   btnClear.Enabled := btnSave.Enabled or ((Sender as TORListBox).Items.Count > 0)
     416 else if (Sender is TORComboBox) then
     417   btnClear.Enabled := btnSave.Enabled or ((Sender as TORComboBox).Items.Count > 0);
     418 if lstItemsSelection.Visible then
     419 begin
     420   btnAddAll.Enabled := lstItemsSelection.Items.Count > 0;
     421   btnAdd.Enabled := lstItemsSelection.ItemIndex > -1;
     422   //if btnAdd.Enabled then
     423     //astring := lstItemsSelection.Items[lstItemsSelection.ItemIndex];
     424 end
     425 else
     426 begin
     427   btnAddAll.Enabled := cboAllItems.Items.Count > 0;
     428   btnAdd.Enabled := cboAllItems.ItemIndex > -1;
     429 end;
     430end;
     431
     432procedure TfrmGraphProfiles.cboAllItemsClick(Sender: TObject);
     433var
     434  i: integer;
     435begin
     436  if Sender is TButton then
     437  begin
     438    if lstItemsSelection.Visible then
     439    begin
     440      if Sender = btnAddAll then
     441      begin
     442        for i := 0 to lstItemsSelection.Items.Count - 1 do
     443        begin
     444          lstItemsSelection.Selected[i] := true;
     445          lstItemsSelection.ItemIndex := i;
     446          ListBoxSetup(lstItemsSelection);
     447        end;
     448        lstItemsSelection.Clear;
     449      end
     450      else
     451      begin
     452        lstItemsDisplayed.ItemIndex := 0;
     453        ListBoxSetup(lstItemsSelection);
     454      end;
     455      lstItemsDisplayedChange(self);
     456      CheckToClear;
     457      exit;
     458    end
     459    else
     460    begin
     461      if Sender = btnAdd then
     462      begin
     463        ComboBoxSetup(cboAllItems);
     464        lstItemsDisplayedChange(self);
     465        CheckToClear;
     466        exit;
     467      end;
     468    end;
     469  end;
     470  if (Sender is TORComboBox) then
     471    ComboBoxSetup(Sender)
     472  else if (Sender is TORListBox) then
     473    ListBoxSetup(Sender)
     474  else exit;
     475  lstItemsDisplayedChange(self);
     476  CheckToClear;
     477end;
     478
     479procedure TfrmGraphProfiles.cboAllItemsNeedData(Sender: TObject;
     480  const StartFrom: String; Direction, InsertAt: Integer);
     481var
     482  filetype: string;
     483begin
     484  if lstSources.ItemIndex = -1 then exit;
     485  filetype := Piece(lstSources.Items[lstSources.ItemIndex], '^', 1);
     486  cboAllItems.ForDataUse(rpcLookupItems(filetype, StartFrom, Direction));
     487end;
     488
     489procedure TfrmGraphProfiles.lstItemsDisplayedChange(Sender: TObject);
     490begin
     491 btnSave.Enabled := lstItemsDisplayed.Items.Count > 0;
     492 btnSavePublic.Enabled := btnSave.Enabled and FPublicEditor;
     493 btnRemoveAll.Enabled := btnSave.Enabled;
     494 btnAdd.Enabled := (cboAllItems.Visible and (cboAllItems.ItemIndex > -1))
     495   or (lstItemsSelection.Visible and (lstItemsSelection.ItemIndex > -1));
     496 btnRemoveOne.Enabled :=  btnSave.Enabled and (lstItemsDisplayed.ItemIndex > -1);
     497 btnClear.Enabled := btnSave.Enabled or (lstItemsSelection.Items.Count > 0);
     498 if btnSave.Enabled and pnlApply.Visible then btnClose.Caption := 'Close and Display'
     499 else btnClose.Caption := 'Close';
     500end;
     501
     502procedure TfrmGraphProfiles.lstItemsDisplayedDblClick(Sender: TObject);
     503var
     504  line: string;
     505begin
     506  if lstItemsDisplayed.ItemIndex < 0 then exit;
     507  line := lstItemsDisplayed.Items[lstItemsDisplayed.ItemIndex];
     508  lstItemsDisplayed.Items.Delete(lstItemsDisplayed.ItemIndex);
     509  QualifierDelete(line);
     510  lstItemsDisplayedChange(self);
     511end;
     512
     513procedure TfrmGraphProfiles.btnAddAllClick(Sender: TObject);
     514begin
     515  if cboAllItems.Visible then
     516  begin
     517    if cboAllItems.Items.Count < 1 then exit;
     518    cboAllItems.ItemIndex := 0;
     519    cboAllItemsClick(cboAllItems);
     520  end
     521  else
     522  begin
     523    if lstItemsSelection.Items.Count < 1 then exit;
     524    cboAllItemsClick(btnAddAll);
     525  end;
     526end;
     527
     528procedure TfrmGraphProfiles.btnRemoveOneClick(Sender: TObject);
     529begin
     530  lstItemsDisplayedDblClick(self);
     531  CheckToClear;
     532end;
     533
     534procedure TfrmGraphProfiles.btnRemoveAllClick(Sender: TObject);
     535begin
     536  lstItemsDisplayed.Clear;
     537  lstItemsDisplayedChange(self);
     538  CheckToClear;
     539end;
     540
     541procedure TfrmGraphProfiles.btnDefinitionsClick(Sender: TObject);
     542var
     543  firstpublic, firstpersonal, firstlabs: boolean;
     544  i, j: integer;
     545  aLine, aProfile, filetype, aString, front, back, piece2: string;
     546  aList, templist: TStringList;
     547begin
     548  front := Piece(LLS_FRONT, '^', 2);
     549  back := Piece(LLS_BACK, '^', 1);
     550  templist := TStringList.Create;
     551  aList := TStringList.Create;
     552  lstScratch.Clear;
     553  lstScratch.Sorted := false;
     554  firstpublic := true;
     555  firstpersonal := true;
     556  firstlabs := true;
     557  for i := 0 to lstSources.Items.Count - 1 do
     558  begin
     559    aLine :=  lstSources.Items[i];
     560    filetype := Piece(aLine, '^', 1);
     561    aProfile := Piece(aLine, '^', 2);
     562    if (filetype = VIEW_PERSONAL)
     563    or (filetype = VIEW_PUBLIC)
     564    or (filetype = VIEW_LABS) then
     565    begin
     566      if (filetype = VIEW_PUBLIC) and firstpublic then
     567      begin
     568        templist.Add(' ');
     569        templist.Add(front + copy('Public Views' + back, 0, 60));
     570        firstpublic := false;
     571      end
     572      else
     573      if (filetype = VIEW_PERSONAL) and firstpersonal then
     574      begin
     575        templist.Add(' ');
     576        templist.Add(front + copy('Personal Views' + back, 0, 60));
     577        firstpersonal := false;
     578      end
     579      else
     580      if (filetype = VIEW_LABS) and firstlabs then
     581      begin
     582        templist.Add(' ');
     583        templist.Add(front + copy('Lab Groups' + back, 0, 60));
     584        firstlabs := false;
     585      end;
     586      AssignProfile(aList, aLine, User.DUZ, true);
     587      templist.Add(aProfile);
     588      for j := 0 to aList.Count - 1 do
     589      begin
     590        aLine := aList[j];
     591        piece2 := Piece(aLine, '^', 2);
     592        if strtointdef(copy(piece2, 0, 1), -1) > 0 then
     593        begin
     594          aString := Piece(aLine, '^', 3);
     595          if copy(aString, 0, 1) = '_' then
     596            aString := copy(aString, 2, length(aString));
     597          templist.Add('   ' + aString);
     598        end
     599        else
     600        begin
     601
     602        end;
     603      end;
     604    end;
     605  end;
     606  if cboUser.ItemIndex > -1 then
     607  begin
     608    firstpersonal := true;
     609    firstlabs := true;
     610    templist.Add('');
     611    templist.Add('');
     612    templist.Add('Views and Lab Groups for ' + cboUser.Text);
     613    for i := 0 to lstOtherSources.Items.Count - 1 do
     614    begin
     615      aLine :=  lstOtherSources.Items[i];
     616      filetype := Piece(aLine, '^', 1);
     617      aProfile := Piece(aLine, '^', 2);
     618      if (filetype = VIEW_PERSONAL)
     619      or (filetype = VIEW_LABS) then
     620      begin
     621        if (filetype = VIEW_PERSONAL) and firstpersonal then
     622        begin
     623          templist.Add(' ');
     624          templist.Add(front + copy('Views' + back, 0, 60));
     625          firstpersonal := false;
     626        end
     627        else
     628        if (filetype = VIEW_LABS) and firstlabs then
     629        begin
     630          templist.Add(' ');
     631          templist.Add(front + copy('Lab Groups' + back, 0, 60));
     632          firstlabs := false;
     633        end;
     634        AssignProfile(aList, aLine, cboUser.ItemID, true);
     635        templist.Add(aProfile);
     636        for j := 0 to aList.Count - 1 do
     637        begin
     638          aLine := aList[j];
     639          piece2 := Piece(aLine, '^', 2);
     640          if strtointdef(copy(piece2, 0, 1), -1) > 0 then
     641          begin
     642            aString := Piece(aLine, '^', 3);
     643            if copy(aString, 0, 1) = '_' then
     644              aString := copy(aString, 2, length(aString));
     645            templist.Add('   ' + aString);
     646          end;
     647        end;
     648      end;
     649    end;
     650  end;
     651  templist.Insert(0, 'Definitions of Views and Lab Groups');
     652  templist.Insert(1, '');
     653  templist.Insert(2,'Your Personal Views, Public Views, and Lab Groups');
     654  ReportBox(templist, 'Views and Lab Groups', true);
     655  templist.Free;
     656  aList.Free;
     657end;
     658
    236659procedure TfrmGraphProfiles.btnClearClick(Sender: TObject);
    237660begin
    238661  lstItemsDisplayed.Items.Clear;
    239   lstItemsTopSelection.Items.Clear;
     662  lstItemsSelection.Items.Clear;
    240663  cboAllItems.Items.Clear;
    241664  cboAllItems.Text :='';
    242665  lstItemsDisplayedChange(self);
    243666  cboAllItemsChange(self);
    244   lstSource.ItemIndex := -1;
     667  lstSources.ItemIndex := -1;
     668  lstOtherSources.ItemIndex := -1;
    245669end;
    246670
    … …  
    250674  info, profilename, profname, proftype: string;
    251675begin
    252   if lstSource.ItemIndex < 0 then
    253   begin
    254     showmessage('You must select a valid View for deletion.');
     676  if lstSources.ItemIndex < 0 then
     677  begin
     678    ShowMsg('You must select a valid View for deletion.');
    255679    exit;
    256680  end;
    257681  publicview := false;
    258682  profilename := '';
    259   info := lstSource.Items[lstSource.ItemIndex];
     683  info := lstSources.Items[lstSources.ItemIndex];
    260684  proftype := Piece(info, '^', 1);
    261685  profname := Piece(info, '^', 2);
    262   if proftype = '-1' then
     686  if proftype = VIEW_PERSONAL then
    263687    profilename := profname
    264   else if (proftype = '-2') and FPublicEditor then
     688  else if (proftype = VIEW_PUBLIC) and FPublicEditor then
    265689  begin
    266690    profilename := profname;
    … …  
    269693  else
    270694  begin
    271     showmessage('You must select a valid View for deletion.');
     695    ShowMsg('You must select a valid View for deletion.');
    272696    exit;
    273697  end;
    … …  
    299723  btnClearClick(self);
    300724  lstItemsDisplayed.Items.Clear;
    301   lstItemsTopSelection.Items.Clear;
     725  lstItemsSelection.Items.Clear;
    302726  cboAllItems.Items.Clear;
    303727  cboAllItems.Text :='';
    304   FormCreate(self);
     728  GraphDataOnUser;
     729  FormShow(self);
    305730  lstItemsDisplayedChange(self);
    306731  btnDelete.Enabled := false;
    307732  btnRename.Enabled := false;
     733  if lstSources.Count > 0 then
     734    lstSources.ItemIndex := 0;
    308735end;
    309736
    … …  
    311738var
    312739  profentered, publicview: boolean;
    313   i, match: integer;
    314   aName, aType, info, infotitle: string;
    315   newprofilename, profilename, profname, proftype: string;
    316 begin
    317   if lstSource.ItemIndex < 0 then
    318   begin
    319     showmessage('You must select a valid View to rename.');
     740  i, j: integer;
     741  astring, info, infotitle, newprofilename, profile, profileitem, profilename, profiletype, profname, proftype: string;
     742  aList: TStrings;
     743begin
     744  if lstSources.ItemIndex < 0 then
     745  begin
     746    ShowMsg('You must select a valid View to rename.');
    320747    exit;
    321748  end;
    322749  publicview := false;
    323750  profilename := '';
    324   info := lstSource.Items[lstSource.ItemIndex];
     751  info := lstSources.Items[lstSources.ItemIndex];
    325752  proftype := Piece(info, '^', 1);
    326753  profname := Piece(info, '^', 2);
    327   if proftype = '-1' then
     754  if proftype = VIEW_PERSONAL then
    328755    profilename := profname
    329   else if (proftype = '-2') and FPublicEditor then
     756  else if (proftype = VIEW_PUBLIC) and FPublicEditor then
    330757  begin
    331758    profilename := profname;
    … …  
    334761  else
    335762  begin
    336     showmessage('You must select a valid View to rename.');
     763    ShowMsg('You must select a valid View to rename.');
    337764  end;
    338765  btnRemoveAllClick(self);
    339   lstSourceDblClick(self);
     766  lstSourcesDblClick(self);
    340767  if publicview then
    341768  begin
    … …  
    349776    info := 'Enter a new name for ' + profilename + '.'
    350777  end;
    351   profentered := InputQuery(infotitle, info, newprofilename);
     778  profentered := GetProfileName(infotitle, info, newprofilename);
    352779  if not profentered then exit;
    353   if newprofilename = '' then exit;
    354780  info := '';
    355   if not ProfileExists(newprofilename, -2) and publicview then
     781  if not ProfileExists(newprofilename, VIEW_PUBLIC) and publicview then
    356782    info := 'The Public View, ' + profilename + ', will be changed to '
    357783      + newprofilename + #13 + 'Is this OK?'
    358   else if not ProfileExists(newprofilename, -1) then
     784  else if not ProfileExists(newprofilename, VIEW_PERSONAL) then
    359785    info := 'Your Personal View, ' + profilename + ', will be changed to '
    360786      + newprofilename + #13 + 'Is this OK?';
    361787  if length(info) > 0 then
    362   begin
    363788    if MessageDlg(info, mtConfirmation, [mbYes, mbNo], 0) <> mrYes then exit;
    364     if publicview then
    365     begin
    366       FastAssign(rpcGetGraphProfiles(UpperCase(profilename), '1', 1), lstScratch.Items);
    367       rpcDeleteGraphProfile(UpperCase(profilename), '1');
    368       rpcSetGraphProfile(newprofilename, '1', lstScratch.Items);
    369       btnClose.Tag := 1;
    370       proftype := '-2';
    371     end
     789  aList := TStringList.Create;
     790  profile := '';
     791  aList.Clear;
     792  j := 1;
     793  with lstItemsDisplayed do
     794  for i := 0 to Items.Count - 1 do
     795  begin
     796    astring := Items[i];
     797    profiletype := Piece(astring, '^', 1);
     798    if profiletype = '8925' then
     799      profileitem := UpperCase(Piece(astring, '^', 3))
    372800    else
    373     begin
    374       FastAssign(rpcGetGraphProfiles(UpperCase(profilename), '0', 1), lstScratch.Items);
    375       rpcDeleteGraphProfile(UpperCase(profilename), '0');
    376       rpcSetGraphProfile(newprofilename, '0', lstScratch.Items);
    377       btnClose.Tag := 1;
    378       proftype := '-1';
    379     end;
    380   end;
    381   if length(newprofilename) > 0 then
    382     lblSave.Hint := newprofilename;
    383   btnClearClick(self);
    384   lstScratch.Items.Clear;
    385   lstSource.Items.Clear;
    386   FormCreate(btnSave);
    387   match := -1;
    388   profilename := UpperCase(newprofilename);
    389   for i := lstSource.Items.Count - 1 downto 0 do
    390   begin
    391     info := lstSource.Items[i];
    392     aType := Piece(info, '^', 1);
    393     aName := Piece(info, '^', 2);
    394     if (UpperCase(aName) = newprofilename) and (aType = proftype) then
    395     begin
    396       match := i;
    397       break;
    398     end;
    399   end;
    400   if match = -1 then exit;
    401   lstSource.ItemIndex := match;
    402   lstSourceChange(self);
    403 end;
    404 
    405 procedure TfrmGraphProfiles.btnCloseClick(Sender: TObject);
    406 begin
    407   if lstItemsDisplayed.Items.Count > 0 then
     801      profileitem := Piece(astring, '^', 2);
     802    profile := profile + profiletype + '~' + profileitem + '~|';
     803    j := j + 1;
     804    if (j mod 10) = 0 then
     805      if length(profile) > 0 then
     806      begin
     807        aList.Add(UpperCase(profile));
     808        profile := '';
     809      end;
     810  end;
     811  if length(profile) > 0 then
     812  begin
     813    aList.Add(UpperCase(profile));
     814    profile := '';
     815  end;
     816  if publicview then
     817  begin
     818    proftype := VIEW_PUBLIC;
     819    rpcDeleteGraphProfile(UpperCase(profilename), '1');
     820    rpcSetGraphProfile(newprofilename, '1', aList);
    408821    btnClose.Tag := 1;
    409   Close;
    410 end;
    411 
    412 procedure TfrmGraphProfiles.btnRemoveClick(Sender: TObject);
    413 begin
    414   if lstItemsDisplayed.ItemIndex < 0 then exit;
    415   lstItemsDisplayed.Items.Delete(lstItemsDisplayed.ItemIndex);
    416   CheckToClear;
    417 end;
    418 
    419 procedure TfrmGraphProfiles.btnRemoveAllClick(Sender: TObject);
    420 begin
    421   lstItemsDisplayed.Clear;
    422   lstItemsDisplayedChange(self);
    423   CheckToClear;
    424 end;
    425 
    426 procedure TfrmGraphProfiles.btnRemoveOneClick(Sender: TObject);
    427 begin
    428   lstItemsDisplayedDblClick(self);
    429   CheckToClear;
    430 end;
    431 
    432 procedure TfrmGraphProfiles.CheckToClear;
    433 begin
    434   if cboAllItems.Visible and (cboAllItems.Items.Count = 0) then
    435    lstSource.ItemIndex := -1
    436   else if lstItemsTopSelection.Visible and (lstItemsTopSelection.Items.Count = 0) then
    437    lstSource.ItemIndex := -1;
    438   if lstSource.ItemIndex = -1 then
    439   begin
    440     btnAdd.Enabled := false;
    441     btnAddAll.Enabled := false;
    442   end;
     822  end
     823  else
     824  begin
     825    proftype := VIEW_PERSONAL;
     826    rpcDeleteGraphProfile(UpperCase(profilename), '0');
     827    rpcSetGraphProfile(newprofilename, '0', aList);
     828    btnClose.Tag := 1;
     829  end;
     830  aList.Free;
     831  IDProfile(newprofilename, proftype);
    443832end;
    444833
    … …  
    446835var
    447836  profentered, puplicedit: boolean;
    448   i, j, match: integer;
    449   aName, aType, info, infotitle, profile, profileitem, profilename, profiletype, profname, proftype: string;
     837  i, j: integer;
     838  astring, info, infotitle, profile, profileitem, profilename, profiletype, profname, proftype: string;
    450839  aList: TStrings;
    451840begin
    … …  
    453842  if lstItemsDisplayed.Items.Count < 1 then exit;
    454843  profilename := '';
    455   if lstSource.ItemIndex > -1 then
    456   begin
    457     info := lstSource.Items[lstSource.ItemIndex];
    458     proftype := Piece(info, '^', 1);
    459     profname := Piece(info, '^', 2);
    460     profilename := profname;
     844  if lstSources.ItemIndex > -1 then
     845  begin
     846    info := lstSources.Items[lstSources.ItemIndex];
     847    if pos(LLS_FRONT, info) < 1 then
     848    begin
     849      proftype := Piece(info, '^', 1);
     850      profname := Piece(info, '^', 2);
     851      profilename := profname;
     852    end;
    461853  end;
    462854  if puplicedit then
    … …  
    472864      + #13 + 'If you are editing a View, enter the View''s name to overwrite it.';
    473865  end;
    474   profentered := InputQuery(infotitle, info, profilename);
     866  profentered := GetProfileName(infotitle, info, profilename);
    475867  if not profentered then exit;
    476   if profilename = '' then exit;
    477   if (length(profilename) < 3) or (length(profilename) > 30) then
    478   begin
    479     showmessage('Not accepted - names of views must be 3-30 characters.');
    480     exit;
    481   end;
    482868  info := '';
    483   if ProfileExists(profilename, -2) and FPublicEditor and puplicedit then
     869  if ProfileExists(profilename, VIEW_PUBLIC) and FPublicEditor and puplicedit then
    484870    info := 'The Public View, ' + profilename + ', will be overwritten.'
    485871      + #13 + 'Is this OK?'
    486   else if ProfileExists(profilename, -1) and (not puplicedit) then
     872  else if ProfileExists(profilename, VIEW_PERSONAL) and (not puplicedit) then
    487873    info := 'Your Personal View, ' + profilename + ', will be overwritten.'
    488874      + #13 + 'Is this OK?';
    … …  
    496882  for i := 0 to Items.Count - 1 do
    497883  begin
    498     profiletype := Piece(Items[i], '^', 1);
    499     profileitem := Piece(Items[i], '^', 2);
     884    astring := Items[i];
     885    profiletype := Piece(astring, '^', 1);
     886    if profiletype = '8925' then
     887      profileitem := UpperCase(Piece(astring, '^', 3))
     888    else
     889      profileitem := Piece(astring, '^', 2);
    500890    profile := profile + profiletype + '~' + profileitem + '~|';
    501     j := j +1;
     891    j := j + 1;
    502892    if (j mod 10) = 0 then
    503893      if length(profile) > 0 then
    … …  
    514904  if puplicedit then
    515905  begin
    516     proftype := '-2';
     906    proftype := VIEW_PUBLIC;
    517907    rpcSetGraphProfile(profilename, '1', aList);
    518908    btnClose.Tag := 1;
    … …  
    520910  else
    521911  begin
    522     proftype := '-1';
     912    proftype := VIEW_PERSONAL;
    523913    rpcSetGraphProfile(profilename, '0', aList);
    524914    btnClose.Tag := 1;
    525915  end;
    526   if length(profilename) > 0 then
    527     lblSave.Hint := profilename;
    528   btnClearClick(self);
    529   lstScratch.Items.Clear;
    530   lstSource.Items.Clear;
    531   FormCreate(btnSave);
    532   match := -1;
    533   profilename := UpperCase(profilename);
    534   for i := lstSource.Items.Count - 1 downto 0 do
    535   begin
    536     info := lstSource.Items[i];
    537     aType := Piece(info, '^', 1);
    538     aName := Piece(info, '^', 2);
    539     if (UpperCase(aName) = profilename) and (aType = proftype) then
    540     begin
    541       match := i;
    542       break;
    543     end;
    544   end;
    545916  aList.Free;
    546   if match = -1 then exit;
    547   lstSource.ItemIndex := match;
    548   lstSourceChange(self);
     917  IDProfile(profilename, proftype);
     918end;
     919
     920procedure TfrmGraphProfiles.btnCloseClick(Sender: TObject);
     921begin
     922  if lstItemsDisplayed.Items.Count > 0 then
     923    btnClose.Tag := 1;
     924  Close;
     925end;
     926
     927procedure TfrmGraphProfiles.btnViewsClick(Sender: TObject);
     928begin             // not used
     929  pnlOtherSources.Visible := not pnlOtherSources.Visible;
     930  if pnlOtherSources.Visible then
     931    btnViews.Caption := 'Hide other views'
     932  else
     933    btnViews.Caption := 'Show other views';
     934  DialogGraphOthers(1);
    549935end;
    550936
    … …  
    553939  typedata: string;
    554940begin
    555   if lstSource.ItemIndex = -1 then
     941  if lstSources.ItemIndex = -1 then
    556942  begin
    557943    btnDelete.Enabled := false;
    … …  
    559945    exit;
    560946  end;
    561   typedata :=  lstSource.Items[lstSource.ItemIndex];
    562   btnDelete.Enabled := (Piece(typedata, '^', 1) = '-1')
    563                     or ((Piece(typedata, '^', 1) = '-2') and FPublicEditor);
     947  typedata :=  lstSources.Items[lstSources.ItemIndex];
     948  btnDelete.Enabled := (Piece(typedata, '^', 1) = VIEW_PERSONAL)
     949                    or ((Piece(typedata, '^', 1) = VIEW_PUBLIC) and FPublicEditor);
    564950  btnRename.Enabled := btnDelete.Enabled;
    565951end;
    566952
    567 procedure TfrmGraphProfiles.radSourceAllClick(Sender: TObject);
    568 var
    569   dfn: string;
    570 begin
    571   if Sender = radSourceAll then
    572   begin
    573     lstItemsTopSelection.Visible := false;
    574     cboAllItems.Visible := true;
    575   end
    576   else
    577   begin
    578     if radSourcePat.Tag = 0 then
    579     begin
    580       dfn := lblClose.Hint;
    581       FastAssign(rpcGetAllItems(dfn), lstTests.Items);  //*** using a DFN, get all items
    582       FastAssign(rpcGetItems('50.605', dfn), lstDrugClass.Items);
    583       radSourcePat.Tag := 1;
    584     end;
    585     cboAllItems.Visible := false;
    586     lstItemsTopSelection.Visible := true;
    587   end;
    588   lstSourceChange(self);
    589 end;
    590 
    591 procedure TfrmGraphProfiles.cboAllItemsClick(Sender: TObject);
     953procedure TfrmGraphProfiles.ListBoxSetup(Sender: TObject);
    592954var
    593955  profileselected: boolean;
    594956  i: integer;
    595   first, profileitem, selection, subtype: string;
    596 begin
    597   if Sender is TButton then
    598   begin
    599     if lstItemsTopSelection.Visible then
    600     begin
    601       if Sender = btnAddAll then
    602         lstItemsTopSelection.ItemIndex := 0;
    603       Sender := lstItemsTopSelection;
    604     end
    605     else
    606     begin
    607       if Sender = btnAddAll then
    608         cboAllItems.ItemIndex := 0;
    609       Sender := cboAllItems;
    610     end;
    611   end;
    612   if Sender is TORListBox then
     957  selection, first, profileitem: string;
     958begin
    613959  with (Sender as TORListBox) do
    614960  begin
    … …  
    632978    else
    633979      AddToList(selection, lstItemsDisplayed);
    634     if ItemIndex = 0 then Clear;        //profile or type <any>
     980    //if ItemIndex = 0 then Clear;        //profile or type <any>
    635981    ItemIndex := -1;
    636   end
    637   else if Sender is TORComboBox then
     982  end;
     983end;
     984
     985procedure TfrmGraphProfiles.ComboBoxSetup(Sender: TObject);
     986var
     987  profileselected: boolean;
     988  i: integer;
     989  selection, first, profileitem, subtype: string;
     990begin
    638991  with (Sender as TORComboBox) do
    639992  begin
    … …  
    6691022    if ItemIndex = 0 then Clear;        //profile or type <any>
    6701023    ItemIndex := -1;
    671   end
    672   else exit;
    673   lstItemsDisplayedChange(self);
    674   CheckToClear;
    675 end;
    676 
    677 procedure TfrmGraphProfiles.cboAllItemsChange(Sender: TObject);
    678 begin
    679  if (Sender is TORListBox) then
    680    btnClear.Enabled := btnSave.Enabled or ((Sender as TORListBox).Items.Count > 0)
    681  else if (Sender is TORComboBox) then
    682    btnClear.Enabled := btnSave.Enabled or ((Sender as TORComboBox).Items.Count > 0);
    683  if lstItemsTopSelection.Visible then
    684  begin
    685    btnAddAll.Enabled := lstItemsTopSelection.Items.Count > 0;
    686    btnAdd.Enabled := lstItemsTopSelection.ItemIndex > -1;
    687  end
    688  else
    689  begin
    690    btnAddAll.Enabled := cboAllItems.Items.Count > 0;
    691    btnAdd.Enabled := cboAllItems.ItemIndex > -1;
    692  end;
    693 end;
    694 
    695 procedure TfrmGraphProfiles.cboAllItemsNeedData(Sender: TObject;
    696   const StartFrom: String; Direction, InsertAt: Integer);
    697 var
    698   filetype: string;
    699 begin
    700   if lstSource.ItemIndex = -1 then exit;
    701   filetype := Piece(lstSource.Items[lstSource.ItemIndex], '^', 1);
    702   cboAllItems.ForDataUse(rpcLookupItems(filetype, StartFrom, Direction));
    703 end;
    704 
    705 procedure TfrmGraphProfiles.lstItemsDisplayedChange(Sender: TObject);
    706 begin
    707  btnSave.Enabled := lstItemsDisplayed.Items.Count > 0;
    708  btnSavePublic.Enabled := btnSave.Enabled and FPublicEditor;
    709  btnRemoveAll.Enabled := btnSave.Enabled;
    710  btnAdd.Enabled := (cboAllItems.Visible and (cboAllItems.ItemIndex > -1))
    711    or (lstItemsTopSelection.Visible and (lstItemsTopSelection.ItemIndex > -1));
    712  btnRemoveOne.Enabled :=  btnSave.Enabled and (lstItemsDisplayed.ItemIndex > -1);
    713  btnClear.Enabled := btnSave.Enabled or (lstItemsTopSelection.Items.Count > 0);
    714  if btnSave.Enabled and pnlApply.Visible then btnClose.Caption := 'Close and Display'
    715  else btnClose.Caption := 'Close';
    716 end;
    717 
    718 procedure TfrmGraphProfiles.lstItemsDisplayedDblClick(Sender: TObject);
    719 var
    720   line: string;
    721 begin
    722   if lstItemsDisplayed.ItemIndex < 0 then exit;
    723   line := lstItemsDisplayed.Items[lstItemsDisplayed.ItemIndex];
    724   lstItemsDisplayed.Items.Delete(lstItemsDisplayed.ItemIndex);
    725   QualifierDelete(line);
    726   lstItemsDisplayedChange(self);
     1024  end;
     1025end;
     1026
     1027procedure TfrmGraphProfiles.Report(aListBox: TORListBox);
     1028var
     1029  profileselected: boolean;
     1030  i: integer;
     1031  selection, first, profileitem, subtype: string;
     1032begin
     1033  with aListBox do
     1034  begin
     1035    if ItemIndex < 0 then exit;
     1036    selection := Items[ItemIndex];
     1037    subtype := Piece(Items[0], '^', 3);
     1038    subtype := Piece(subtype, ':', 2);
     1039    subtype := copy(subtype, 2, length(subtype));
     1040    subtype := Piece(subtype, ' ', 1);
     1041    if UpperCase(copy(selection, 1, 5)) = '63AP;' then
     1042        selection := copy(selection, 1, 4) + '^A;' + copy(selection, 6, 1) + ';'
     1043        + Piece(selection, '^', 2) + '^' + subtype + ': ' + Piece(selection, '^', 3)
     1044    else if UpperCase(copy(selection, 1, 5)) = '63MI;' then
     1045        selection := copy(selection, 1, 4) + '^M;' + copy(selection, 6, 1) + ';'
     1046        + Piece(selection, '^', 2) + '^' + subtype + ': ' + Piece(selection, '^', 3);
     1047    if length(Piece(selection, '_', 2)) > 0 then
     1048      selection := Piece(selection, '_', 1) + ' ' + Piece(selection, '_', 2);
     1049    first := Piece(selection, '^', 1);
     1050    if first = '' then exit;     // line
     1051    profileselected := strtointdef(Piece(selection, '^', 2), 0) < 0;
     1052    if profileselected then
     1053    begin
     1054      for i := 2 to Items.Count - 1 do
     1055      begin
     1056        profileitem := Items[i];
     1057        if length(Piece(profileitem, '_', 2)) > 0 then
     1058          profileitem := Piece(profileitem, '_', 1) + ' ' + Piece(profileitem, '_', 2);   //*****???? ^
     1059        AddToList(profileitem, lstItemsDisplayed);
     1060      end;
     1061    end
     1062    else
     1063      AddToList(selection, lstItemsDisplayed);
     1064    if ItemIndex = 0 then Clear;        //profile or type <any>
     1065    ItemIndex := -1;
     1066  end;
     1067end;
     1068
     1069procedure TfrmGraphProfiles.CheckToClear;
     1070begin
     1071  if (cboAllItems.Visible and (cboAllItems.Items.Count = 0))
     1072  or (lstItemsSelection.Visible and (lstItemsSelection.Items.Count = 0)) then
     1073  begin
     1074    lstSources.ItemIndex := -1;
     1075    lstOtherSources.ItemIndex := -1;
     1076    btnAdd.Enabled := false;
     1077    btnAddAll.Enabled := false;
     1078  end;
    7271079end;
    7281080
    … …  
    7461098end;
    7471099
    748 procedure TfrmGraphProfiles.lstSourceChange(Sender: TObject);
     1100procedure TfrmGraphProfiles.AllItemsBefore(var typedata: string);
    7491101var
    7501102  i: integer;
    751   filetype, itemdata, typedata: string;
    752 begin
    753   cboAllItems.Items.Clear;
    754   cboAllItems.Text := '';
    755   CheckPublic;
    756   if lstSource.ItemIndex = -1 then exit;
    757   typedata :=  lstSource.Items[lstSource.ItemIndex];
    758   if typedata = LLS_LINE then
    759   begin
    760     cboAllItems.Items.Clear;
    761     cboAllItems.Text := '';
    762     exit;
    763   end;
    764   filetype := Piece(typedata, '^', 1);
    765   if filetype = '-1' then
    766     AssignProfile(cboAllItems.Items, typedata)
    767   else
    768   if filetype = '-2' then
    769     AssignProfile(cboAllItems.Items, typedata)
    770   else
    771   if filetype = '-3' then   // current selections
    772   begin
    773     AssignProfile(cboAllItems.Items, typedata);
    774   end
    775   else
     1103begin
    7761104  with cboAllItems.Items do
    7771105  begin
    … …  
    7831111    if Piece(typedata, '^', 2) = '63AP' then
    7841112    begin
    785       for i := 0 to lstSource.Items.Count - 1 do
    786       if copy(lstSource.Items[i], 1, 5) = '63AP;' then
    787       begin
    788         typedata := lstSource.Items[i];
     1113      for i := 0 to lstSources.Items.Count - 1 do
     1114      if copy(lstSources.Items[i], 1, 5) = '63AP;' then
     1115      begin
     1116        typedata := lstSources.Items[i];
    7891117        typedata := '0^' + Piece(typedata, '^', 1) + '^ ' + Piece(typedata, '^', 2) + ' <any>';
    7901118        Add(typedata);
    … …  
    7931121    else if Piece(typedata, '^', 2) ='63MI' then
    7941122    begin
    795       for i := 0 to lstSource.Items.Count - 1 do
    796       if copy(lstSource.Items[i], 1, 5) = '63MI;' then
    797       begin
    798         typedata := lstSource.Items[i];
     1123      for i := 0 to lstSources.Items.Count - 1 do
     1124      if copy(lstSources.Items[i], 1, 5) = '63MI;' then
     1125      begin
     1126        typedata := lstSources.Items[i];
    7991127        typedata := '0^' + Piece(typedata, '^', 1) + '^ ' + Piece(typedata, '^', 2) + ' <any>';
    8001128        Add(typedata);
    … …  
    8021130    end;
    8031131  end;
    804   cboAllItemsChange(cboAllItems);
    805   CheckPublic;
    806   if lstSource.ItemIndex = -1 then exit;
    807   typedata :=  lstSource.Items[lstSource.ItemIndex];
    808   if typedata = LLS_LINE then
    809   begin
    810     lstItemsTopSelection.Clear;
    811     exit;
    812   end;
    813   filetype := Piece(typedata, '^', 1);
    814   if filetype = '-1' then
    815     AssignProfile(lstItemsTopSelection.Items, typedata)
    816   else
    817   if filetype = '-2' then
    818     AssignProfile(lstItemsTopSelection.Items, typedata)
    819   else
    820   if filetype = '-3' then
    821   begin
    822     AssignProfile(lstItemsTopSelection.Items, typedata);
    823   end
    824   else
    825   with lstItemsTopSelection.Items do
     1132end;
     1133
     1134procedure TfrmGraphProfiles.AllItemsAfter(var filetype, typedata: string);
     1135var
     1136  i: integer;
     1137  itemdata, itemname: string;
     1138begin
     1139  with lstItemsSelection.Items do
    8261140  begin
    8271141    Clear;
    828     lstItemsTopSelection.Sorted := true;
    829     typedata := '0^' + Piece(typedata, '^', 1) + '^ ' + Piece(typedata, '^', 2) + ' <any>';
     1142    lstItemsSelection.Sorted := true;
     1143    itemname := Piece(typedata, '^', 3);
     1144    if copy(itemname, 1, 1) = ' ' then
     1145    begin
     1146      itemname := copy(itemname, 2, length(itemname));   // strip preceding space
     1147      typedata := '0^' + Piece(typedata, '^', 2) + '^ ' + itemname;
     1148    end
     1149    else
     1150      typedata := '0^' + Piece(typedata, '^', 1) + '^ ' + itemname;
    8301151    Insert(0, typedata);
    8311152    Insert(1, '^' + LLS_LINE);
    832     if filetype = '63AP' then
    833     begin
    834       lstItemsTopSelection.Sorted := false;
    835       for i := 0 to lstSource.Items.Count - 1 do
    836       if copy(lstSource.Items[i], 1, 5) = '63AP;' then
    837       begin
    838         typedata := lstSource.Items[i];
     1153    if filetype = '63AP' then                         // finish subitems ***********
     1154    begin
     1155      lstItemsSelection.Sorted := false;
     1156      for i := 0 to lstSources.Items.Count - 1 do
     1157      if copy(lstSources.Items[i], 1, 5) = '63AP;' then
     1158      begin
     1159        typedata := lstSources.Items[i];
    8391160        typedata := '0^' + Piece(typedata, '^', 1) + '^ ' + Piece(typedata, '^', 2) + ' <any>';
    8401161        Add(typedata);
    … …  
    8431164    else if filetype ='63MI' then
    8441165    begin
    845       lstItemsTopSelection.Sorted := false;
    846       for i := 0 to lstSource.Items.Count - 1 do
    847       if copy(lstSource.Items[i], 1, 5) = '63MI;' then
    848       begin
    849         typedata := lstSource.Items[i];
     1166      lstItemsSelection.Sorted := false;
     1167      for i := 0 to lstSources.Items.Count - 1 do
     1168      if copy(lstSources.Items[i], 1, 5) = '63MI;' then
     1169      begin
     1170        typedata := lstSources.Items[i];
    8501171        typedata := '0^' + Piece(typedata, '^', 1) + '^ ' + Piece(typedata, '^', 2) + ' <any>';
    8511172        Add(typedata);
    … …  
    8861207        Add(itemdata);
    8871208    end;
    888     cboAllItemsChange(lstItemsTopSelection);
    889   end;
    890 end;
    891 
    892 procedure TfrmGraphProfiles.lstSourceDblClick(Sender: TObject);
    893 begin
    894   if cboAllItems.Visible then
    895   begin
    896     if cboAllItems.Items.Count < 1 then exit;
    897     cboAllItems.ItemIndex := 0;
    898     cboAllItemsClick(cboAllItems);
    899   end
    900   else
    901   begin
    902     if lstItemsTopSelection.Items.Count < 1 then exit;
    903     lstItemsTopSelection.Selected[0] := true;
    904     cboAllItemsClick(lstItemsTopSelection);
     1209    cboAllItemsChange(lstItemsSelection);
    9051210  end;
    9061211end;
    … …  
    9901295end;
    9911296
    992 procedure TfrmGraphProfiles.AssignProfile(aList: TStrings; aProfile: string);
    993 var
    994   ext, stop: boolean;
    995   i, j, k: integer;
    996   dfn, itemname, itemnums, itempart, itempart1, itempart2, itemtest, typedata, teststring: string;
    997 begin
    998   ext := radSourceAll.Checked;
    999   if ext then
    1000   begin
    1001     if Piece(aProfile, '^', 1) = '-2' then
    1002       FastAssign(rpcGetGraphProfiles(UpperCase(Piece(aProfile, '^', 2)), '1', 1), aList)
    1003     else
    1004 
    1005     if Piece(aProfile, '^', 1) = '-3' then   // current selection on list
    1006     begin
    1007       if radSourcePat.Tag = 0 then
    1008       begin
    1009         dfn := lblClose.Hint;
    1010         FastAssign(rpcGetAllItems(dfn), lstTests.Items);  //*** using a DFN, get all items
    1011         FastAssign(rpcGetItems('50.605', dfn), lstDrugClass.Items);
    1012         radSourcePat.Tag := 1;
    1013       end;
    1014       typedata := '0^-1^ ' + Piece(aProfile, '^', 2);
    1015       aProfile := Piece(aProfile, '^', 3);
    1016       aList.Clear;
    1017       aList.Add(typedata);
    1018       aList.Add('^' + LLS_LINE);
    1019       for i := 1 to BIG_NUMBER do
    1020       begin
    1021         itempart := Piece(aProfile, '|', i);
    1022         if itempart = '' then exit;
    1023         itempart1 := Piece(itempart, '~', 1);
    1024         itempart2 := Piece(itempart, '~', 2);
    1025         itemnums := itempart1 + '^' + itempart2;
    1026         itemname := '';
    1027         for k := 0 to lstTests.Items.Count - 1 do
    1028         begin
    1029           itemtest := UpperCase(Pieces(lstTests.Items[k], '^', 1, 2));
    1030           if itemtest = itemnums then
    1031           begin
    1032             itemname := Piece(lstTests.Items[k], '^', 3);
    1033             itemnums := itemnums + '^' + itemname;
    1034             aList.Add(itemnums);
    1035             break;
    1036           end;
    1037         end;
    1038       end;
    1039     end
    1040 
    1041     else
    1042       FastAssign(rpcGetGraphProfiles(UpperCase(Piece(aProfile, '^', 2)), '0', 1), aList);
    1043     for i := 0 to aList.Count -1 do
    1044     begin
    1045       teststring := aList[i];
    1046       if Piece(teststring, '^', 1) = '0' then
    1047         aList[i] := '0^' + Piece(teststring, '^', 2) + '^_' + Piece(teststring, '^', 3);
     1297procedure TfrmGraphProfiles.AssignProfile(aList: TStrings; aProfile: string; UserNum: integer; allitems: boolean);
     1298var
     1299  i, k: integer;
     1300  preprofile, typedata, typepart, typeone, typetwo, testname, teststring: string;
     1301  itempart, itempart1, itempart2, itemnums, itemname, itemtest: string;
     1302begin
     1303  preprofile := aProfile;
     1304  aList.Clear;
     1305  if Piece(aProfile, '^', 1) = VIEW_TEMPORARY then
     1306  begin
     1307    typedata := Piece(aProfile, '^', 3);
     1308    for i := 1 to BIG_NUMBER do
     1309    begin
     1310      typepart := Piece(typedata, '|', i);
     1311      if typepart = '' then
     1312        break;
     1313      testname := Piece(aProfile, '^', i + 3);
     1314      typeone := Piece(typepart, '~', 1);
     1315      typetwo := Piece(typepart, '~', 2);
     1316      aList.Add(typeone + '^' + typetwo + '^' + testname);
    10481317    end;
    10491318    typedata := '0^' + Piece(aProfile, '^', 1) + '^ ' + Piece(aProfile, '^', 2);
    … …  
    10521321    exit;
    10531322  end;
    1054   if Piece(aProfile, '^', 1) = '-2' then
    1055   begin
    1056     FastAssign(rpcGetGraphProfiles(UpperCase(Piece(aProfile, '^', 2)), '1', 0), lstScratch.Items);
     1323  if Piece(aProfile, '^', 1) = VIEW_CURRENT then   // current selection on list
     1324  begin
    10571325    typedata := '0^-1^ ' + Piece(aProfile, '^', 2);
    1058   end
    1059   else
    1060   if Piece(aProfile, '^', 1) = '-3' then   // current selection on list
     1326    aProfile := Piece(aProfile, '^', 3);
     1327    aList.Add(typedata);
     1328    aList.Add('^' + LLS_LINE);
     1329    for i := 1 to BIG_NUMBER do
     1330    begin
     1331      itempart := Piece(aProfile, '|', i);
     1332      if itempart = '' then exit;
     1333      itempart1 := Piece(itempart, '~', 1);
     1334      itempart2 := Piece(itempart, '~', 2);
     1335      itemnums := itempart1 + '^' + itempart2;
     1336      itemname := '';
     1337      for k := 0 to GtslItems.Count - 1 do
     1338      begin
     1339        itemtest := UpperCase(Pieces(GtslItems[k], '^', 1, 2));
     1340        if Piece(itemtest, '^', 1) = '63' then
     1341          itemtest := Piece(itemtest, '.', 1);   // works ok but could also remove spec parens on name
     1342        if itemtest = itemnums then
     1343        begin
     1344          itemname := Piece(GtslItems[k], '^', 4);
     1345          itemnums := itemnums + '^' + itemname;
     1346          aList.Add(itemnums);
     1347          break;
     1348        end;
     1349      end;
     1350    end;
     1351    typedata := '0^' + Piece(aProfile, '^', 1) + '^ ' + Piece(aProfile, '^', 2);
     1352    aList.Insert(0, typedata);
     1353    aList.Insert(1, '^' + LLS_LINE);
     1354    exit;
     1355  end;
     1356  if radSourceAll.Checked or allitems then
     1357  begin
     1358    AssignProfilePre(aList, aProfile, UserNum);
     1359    for i := 0 to aList.Count - 1 do
     1360    begin
     1361      teststring := aList[i];
     1362      if Piece(teststring, '^', 1) = '0' then
     1363        aList[i] := '0^' + Piece(teststring, '^', 2) + '^_' + Piece(teststring, '^', 3);
     1364    end;
     1365    exit;
     1366  end;
     1367  if Piece(aProfile, '^', 1) = VIEW_LABS then
    10611368  begin
    10621369    lstScratch.Items.Clear;
    1063     lstScratch.Items.Add(Piece(aProfile, '^', 3));
     1370    FastAssign(GetATestGroup(strtointdef(Piece(Piece(aProfile, '^', 2), ')', 1), -1), UserNum), aList);
     1371    for i  := 0 to aList.Count - 1 do
     1372      aList[i] := '63^' + aList[i];
     1373  end
     1374  else
     1375  if Piece(aProfile, '^', 1) = VIEW_PUBLIC then
     1376  begin
     1377    FastAssign(GetGraphProfiles(UpperCase(Piece(aProfile, '^', 2)), '1', 0, 0), lstScratch.Items);
    10641378    typedata := '0^-1^ ' + Piece(aProfile, '^', 2);
    1065     aProfile := '-1^' + Piece(aProfile, '^', 2) + '^';
    1066   end
    1067   else
    1068   begin
    1069     FastAssign(rpcGetGraphProfiles(UpperCase(Piece(aProfile, '^', 2)), '0', 0), lstScratch.Items);
     1379  end
     1380  else
     1381  begin
     1382    FastAssign(GetGraphProfiles(UpperCase(Piece(aProfile, '^', 2)), '0', 0, UserNum), lstScratch.Items);
    10701383    typedata := '0^' + Piece(aProfile, '^', 1) + '^ ' + Piece(aProfile, '^', 2);
    10711384  end;
     1385  if Piece(aProfile, '^', 1) = VIEW_LABS then
     1386    exit;
    10721387  for i := 0 to lstScratch.Items.Count - 1 do
    10731388    aProfile := aProfile + lstScratch.Items[i];
    10741389  aProfile := Piece(aProfile, '^', 3);
     1390  AssignProfilePost(aList, aProfile, typedata);
     1391end;
     1392
     1393procedure TfrmGraphProfiles.AssignProfilePre(aList: TStrings; var aProfile: string; UserNum: integer);
     1394var
     1395  i: integer;
     1396begin
     1397  if Piece(aProfile, '^', 1) = VIEW_LABS then
     1398  begin
     1399    FastAssign(GetATestGroup(strtointdef(Piece(Piece(aProfile, '^', 2), ')', 1), -1), UserNum), aList);
     1400    for i  := 0 to aList.Count - 1 do
     1401      aList[i] := '63^' + aList[i];
     1402  end
     1403  else
     1404  if Piece(aProfile, '^', 1) = VIEW_PUBLIC then
     1405    FastAssign(GetGraphProfiles(UpperCase(Piece(aProfile, '^', 2)), '1', 1, 0), aList)
     1406  else
     1407  if Piece(aProfile, '^', 1) = VIEW_PERSONAL then
     1408    FastAssign(GetGraphProfiles(UpperCase(Piece(aProfile, '^', 2)), '0', 1, UserNum), aList)
     1409  else
     1410    FastAssign(GetGraphProfiles(UpperCase(Piece(aProfile, '^', 2)), '0', 1, UserNum), aList);
     1411end;
     1412
     1413procedure TfrmGraphProfiles.AssignProfilePost(aList: TStrings; var aProfile, typedata: string);
     1414var
     1415  stop: boolean;
     1416  i, j, k: integer;
     1417  itempart, itempart1, itempart2, itemnums, itemname, itemtest: string;
     1418begin
    10751419  aList.Clear;
    10761420  aList.Add(typedata);
    … …  
    10861430    if itempart1 = '0' then
    10871431    begin
    1088       for j := 0 to lstSource.Items.Count - 1 do
    1089         if itempart2 = Piece(lstSource.Items[j], '^', 1) then
     1432      for j := 0 to lstSources.Items.Count - 1 do
     1433        if itempart2 = Piece(lstSources.Items[j], '^', 1) then
    10901434        begin
    1091           itemname := Piece(lstSource.Items[j], '^', 2);
     1435          itemname := Piece(lstSources.Items[j], '^', 2);
    10921436          break;
    10931437        end;
    … …  
    11271471end;
    11281472
    1129 procedure TfrmGraphProfiles.FillSource;
    1130 var
    1131   i: integer;
    1132   dfntype, listline: string;
    1133 begin
    1134   with lstSource do
    1135   begin
     1473procedure TfrmGraphProfiles.FillSource(aList: TORListBox);
     1474var
     1475  i, UserNum: integer;
     1476  dfntype, firstline, listline: string;
     1477begin
     1478  with aList do
     1479  begin
     1480    Clear;
     1481    firstline := '';
    11361482    Sorted := true;
    11371483    OnClick := OnChange;     // turn off onchange event when loading
    11381484    OnChange := nil;
    1139     FastAssign(rpcGetTypes('0', true), Items);
    1140     for i := 0 to Items.Count - 1 do
    1141     begin
    1142       listline := Items[i];
    1143       dfntype := UpperCase(Piece(listline, '^', 1));
    1144       SetPiece(listline, '^', 1, dfntype);
    1145       Items[i] := listline;
    1146     end;
    1147     //Items.Add('50.605^Drug Class');
     1485    if aList = lstSources then                  // user
     1486    begin
     1487      FastAssign(rpcGetTypes('0', true), Items);   //*** use GtslAllTypes ???
     1488      for i := 0 to Items.Count - 1 do
     1489      begin
     1490        listline := Items[i];
     1491        dfntype := UpperCase(Piece(listline, '^', 1));
     1492        SetPiece(listline, '^', 1, dfntype);
     1493        Items[i] := listline;
     1494      end;
     1495      Sorted := false;
     1496      Items.Insert(0, LLS_FRONT + copy('Types' + LLS_BACK, 0, 30) + '^0');
     1497      UserNum := User.DUZ;
     1498      if GtslViews.Count > 0 then
     1499      begin
     1500        Items.Add(LLS_FRONT + copy('Temporary Views' + LLS_BACK, 0, 30) + '^0');
     1501        for i := 0 to GtslViews.Count - 1 do
     1502        begin
     1503          listline := GtslViews[i];
     1504          if Piece(listline, '^', 1) = VIEW_CURRENT then
     1505            Items.Add(listline)
     1506          else
     1507            Items.Add(VIEW_TEMPORARY + '^' + listline + '^');
     1508        end;
     1509      end;
     1510    end
     1511    else                                         // other user
     1512    begin
     1513      UserNum := cboUser.ItemIEN;
     1514      Sorted := false;
     1515    end;
     1516    FastAssign(GetGraphProfiles('1', '0', 0, UserNum), lstScratch.Items);
     1517    lstScratch.Sorted := true;
     1518    if lstScratch.Items.Count > 0 then
     1519    begin
     1520      Items.Add(LLS_FRONT + copy('Personal Views' + LLS_BACK, 0, 30) + '^0');
     1521      for i := 0 to lstScratch.Items.Count - 1 do
     1522        Items.Add(VIEW_PERSONAL + '^' + lstScratch.Items[i] + '^');
     1523    end;
     1524    FastAssign(GetGraphProfiles('1', '1', 0, 0), lstScratch.Items);
     1525    lstScratch.Sorted := true;
     1526    if (lstScratch.Items.Count > 0) and (aList = lstSources) then
     1527    begin
     1528      Items.Add(LLS_FRONT + copy('Public Views' + LLS_BACK, 0, 30) + '^0');
     1529      for i := 0 to lstScratch.Items.Count - 1 do
     1530        Items.Add(VIEW_PUBLIC + '^' + lstScratch.Items[i] + '^');
     1531    end;
     1532    FastAssign(rpcTestGroups(UserNum), lstScratch.Items);
     1533    lstScratch.Sorted := true;
     1534    if lstScratch.Items.Count > 0 then
     1535    begin
     1536      Items.Add(LLS_FRONT + copy('Lab Groups' + LLS_BACK, 0, 30) + '^0');
     1537      for i := 0 to lstScratch.Items.Count - 1 do
     1538        Items.Add(VIEW_LABS + '^' + Piece(lstScratch.Items[i], '^', 2) + '^' + Piece(lstScratch.Items[i], '^', 1));
     1539    end;
    11481540    OnChange := OnClick;
    11491541    OnClick := nil;
    1150     Sorted := false;
    1151     FastAssign(rpcGetGraphProfiles('1', '0', 0), lstScratch.Items);
    1152     if lstScratch.Items.Count > 0 then
    1153     begin
    1154       Items.Add(LLS_LINE);
    1155       for i := 0 to lstScratch.Items.Count - 1 do
    1156         Items.Add('-1^' + lstScratch.Items[i] + '^');
    1157     end;
    1158     FastAssign(rpcGetGraphProfiles('1', '1', 0), lstScratch.Items);
    1159     if lstScratch.Items.Count > 0 then
    1160     begin
    1161       Items.Add(LLS_LINE);
    1162       for i := 0 to lstScratch.Items.Count - 1 do
    1163         Items.Add('-2^' + lstScratch.Items[i] + '^');
    1164     end;
    1165   end;
    1166 end;
    1167 
    1168 function TfrmGraphProfiles.ProfileExists(aName: string; aType: integer): boolean;
    1169 var
    1170   i, sourcetype: integer;
    1171   info, profilename: string;
     1542  end;
     1543end;
     1544
     1545function TfrmGraphProfiles.ProfileExists(aName, aType: string): boolean;
     1546var
     1547  i: integer;
     1548  info, sourcetype, profilename: string;
    11721549begin
    11731550  Result := false;
    11741551  aName := UpperCase(aName);
    1175   for i := lstSource.Items.Count - 1 downto 0 do
    1176   begin
    1177     info := lstSource.Items[i];
     1552  for i := lstSources.Items.Count - 1 downto 0 do
     1553  begin
     1554    info := lstSources.Items[i];
    11781555    profilename := Piece(info, '^', 2);
    1179     sourcetype := strtointdef(Piece(info, '^', 1), 0);
     1556    sourcetype := Piece(info, '^', 1);
    11801557    if (UpperCase(profilename) = aName) and (aType = sourcetype) then
    11811558    begin
    … …  
    11961573  lblSelectionInfo.Hint := HINT_SELECTION_INFO;
    11971574  lblSource.Hint := HINT_SOURCE;
    1198   lstSource.Hint := HINT_SOURCE;
     1575  lstSources.Hint := HINT_SOURCE;
     1576  pnlSources.Hint := HINT_SOURCE;
     1577  pnlAllSources.Hint := HINT_SOURCE;
     1578  splViews.Hint := HINT_SOURCE;
     1579  lblSelectOthers.Hint := HINT_OTHER_SOURCE;
     1580  lblOtherViews.Hint := HINT_OTHER_SOURCE;
     1581  lstOtherSources.Hint := HINT_OTHER_SOURCE;
     1582  pnlOtherSources.Hint := HINT_OTHER_SOURCE;
     1583  pnlOtherSourcesBottom.Hint := HINT_OTHER_SOURCE;
     1584  pnlOtherViews.Hint := HINT_OTHER_SOURCE;
     1585  lblOtherViews.Hint := HINT_OTHER_SOURCE;
     1586  lblSelectOthers.Hint := HINT_OTHER_SOURCE;
     1587  lblOtherPersons.Hint := HINT_OTHERS;
     1588  cboUser.Hint := HINT_OTHERS;
     1589  pnlOtherSourcesUser.Hint := HINT_OTHERS;
     1590  btnDefinitions.Hint := HINT_BTN_DEFINITION;
    11991591  lblSelection.Hint := HINT_SELECTION;
    1200   lstItemsTopSelection.Hint := HINT_SELECTION;
     1592  lstItemsSelection.Hint := HINT_SELECTION;
    12011593  cboAllItems.Hint := HINT_SELECTION;
    12021594  lblDisplay.Hint := HINT_DISPLAY;
    … …  
    12211613    Msg.Result := 0; // ignore biHelp border icon
    12221614    AssignHints;
    1223     ShowMessage('Help is now available.' + #13 +
     1615    ShowMsg('Help is now available.' + #13 +
    12241616                'By pausing over a list or control, hints will appear.');
    12251617  end
    … …  
    12281620end;
    12291621
    1230 procedure TfrmGraphProfiles.FormClose(Sender: TObject;
    1231   var Action: TCloseAction);
    1232 begin
    1233   Application.HintHidePause := FHintPauseTime;
     1622function TfrmGraphProfiles.GetProfileName(infotitle, info: string; var newprofilename: string): boolean;
     1623begin
     1624  Result := InputQuery(infotitle, info, newprofilename);
     1625  if not Result then exit;
     1626  if newprofilename = '' then
     1627  begin
     1628    Result := false;
     1629    exit;
     1630  end;
     1631  if (length(newprofilename) < 3)
     1632  or (length(newprofilename) > 30)
     1633  or (Pos('^', newprofilename) > 0)
     1634  or (Pos('|', newprofilename) > 0)
     1635  or (Pos('~', newprofilename) > 0) then
     1636  begin
     1637    ShowMsg('Not accepted - names of views must be 3-30 characters.');
     1638    Result := false;
     1639    exit;
     1640  end;
     1641end;
     1642
     1643procedure TfrmGraphProfiles.IDProfile(var profilename, proftype: string);
     1644var
     1645  i, match: integer;
     1646  info, aName, aType: string;
     1647begin
     1648  if length(profilename) > 0 then
     1649    lblSave.Hint := profilename;
     1650  //btnClearClick(self);
     1651  lstScratch.Items.Clear;
     1652  lstSources.Items.Clear;
     1653  GraphDataOnUser;
     1654  FormShow(btnSave);
     1655  match := -1;
     1656  profilename := UpperCase(profilename);
     1657  for i := lstSources.Items.Count - 1 downto 0 do
     1658  begin
     1659    info := lstSources.Items[i];
     1660    aType := Piece(info, '^', 1);
     1661    aName := Piece(info, '^', 2);
     1662    if (UpperCase(aName) = profilename) and (aType = proftype) then
     1663    begin
     1664      match := i;
     1665      break;
     1666    end;
     1667  end;
     1668  if match = -1 then exit;
     1669  lstSources.ItemIndex := match;
     1670  lstSources.Tag := BIG_NUMBER;
     1671  lstSourcesChange(lstSources);
    12341672end;
    12351673
Note: See TracChangeset for help on using the changeset viewer.