| [459] | 1 | unit fConsultBS;
 | 
|---|
 | 2 | 
 | 
|---|
 | 3 | interface
 | 
|---|
 | 4 | 
 | 
|---|
 | 5 | uses
 | 
|---|
 | 6 |   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 | 
|---|
 | 7 |   ExtCtrls, ORCtrls, StdCtrls, ORFn, ComCtrls, uConsults;
 | 
|---|
 | 8 | 
 | 
|---|
 | 9 | type
 | 
|---|
 | 10 |   TfrmConsultsByService = class(TForm)
 | 
|---|
 | 11 |     pnlBase: TORAutoPanel;
 | 
|---|
 | 12 |     lblService: TLabel;
 | 
|---|
 | 13 |     radSort: TRadioGroup;
 | 
|---|
 | 14 |     cmdOK: TButton;
 | 
|---|
 | 15 |     cmdCancel: TButton;
 | 
|---|
 | 16 |     treService: TORTreeView;
 | 
|---|
 | 17 |     cboService: TORComboBox;
 | 
|---|
 | 18 |     procedure cmdCancelClick(Sender: TObject);
 | 
|---|
 | 19 |     procedure cmdOKClick(Sender: TObject);
 | 
|---|
 | 20 |     procedure treServiceChange(Sender: TObject; Node: TTreeNode);
 | 
|---|
 | 21 |     procedure cboServiceSelect(Sender: TObject);
 | 
|---|
 | 22 |   private
 | 
|---|
 | 23 |     FChanged: Boolean;
 | 
|---|
 | 24 |     FService: string;
 | 
|---|
 | 25 |     FServiceName: string;
 | 
|---|
 | 26 |     FAscending: Boolean;
 | 
|---|
 | 27 |     fConsultUser: boolean ;
 | 
|---|
 | 28 |   end;
 | 
|---|
 | 29 | 
 | 
|---|
 | 30 |   TServiceContext = record
 | 
|---|
 | 31 |     Changed: Boolean;
 | 
|---|
 | 32 |     Service: string;
 | 
|---|
 | 33 |     ServiceName: string;
 | 
|---|
 | 34 |     Ascending: Boolean;
 | 
|---|
 | 35 |     ConsultUser: Boolean ;
 | 
|---|
 | 36 |   end;
 | 
|---|
 | 37 | 
 | 
|---|
 | 38 | function SelectService(FontSize: Integer; CurrentContext: TSelectContext; var ServiceContext: TServiceContext): boolean;
 | 
|---|
 | 39 | 
 | 
|---|
 | 40 | implementation
 | 
|---|
 | 41 | 
 | 
|---|
 | 42 | {$R *.DFM}
 | 
|---|
 | 43 | 
 | 
|---|
 | 44 | uses rConsults, rCore, uCore;
 | 
|---|
 | 45 | 
 | 
|---|
 | 46 | var
 | 
|---|
 | 47 |   SvcList: TStrings ;
 | 
|---|
 | 48 |   SvcInfo: string ;
 | 
|---|
 | 49 |   uChanging: Boolean;
 | 
|---|
 | 50 | 
 | 
|---|
 | 51 | const
 | 
|---|
 | 52 |   TX_SVC_TEXT = 'Select a consult service or press Cancel.';
 | 
|---|
 | 53 |   TX_SVC_CAP = 'Missing Service';
 | 
|---|
 | 54 | 
 | 
|---|
 | 55 | function SelectService(FontSize: Integer; CurrentContext: TSelectContext; var ServiceContext: TServiceContext): boolean;
 | 
|---|
 | 56 | { displays service select form for consults and returns a record of the selection }
 | 
|---|
 | 57 | var
 | 
|---|
 | 58 |   frmConsultsByService: TfrmConsultsByService;
 | 
|---|
 | 59 |   W, H, i: Integer;
 | 
|---|
 | 60 |   CurrentService: string;
 | 
|---|
 | 61 | begin
 | 
|---|
 | 62 |   frmConsultsByService := TfrmConsultsByService.Create(Application);
 | 
|---|
 | 63 |   try
 | 
|---|
 | 64 |     with frmConsultsByService do
 | 
|---|
 | 65 |     begin
 | 
|---|
 | 66 |       Font.Size := FontSize;
 | 
|---|
 | 67 |       W := ClientWidth;
 | 
|---|
 | 68 |       H := ClientHeight;
 | 
|---|
 | 69 |       ResizeToFont(FontSize, W, H);
 | 
|---|
 | 70 |       ClientWidth  := W; pnlBase.Width  := W;
 | 
|---|
 | 71 |       ClientHeight := H; pnlBase.Height := H;
 | 
|---|
 | 72 |       FChanged := False;
 | 
|---|
 | 73 |       //SvcList.Assign(LoadServiceList(CN_SVC_LIST_DISP));                         {RV}
 | 
|---|
 | 74 |       SvcList.Assign(LoadServiceListWithSynonyms(CN_SVC_LIST_DISP));             {RV}
 | 
|---|
 | 75 |       SortByPiece(TStringList(SvcList), U, 2);                                   {RV}
 | 
|---|
 | 76 |       for i := 0 to SvcList.Count - 1 do
 | 
|---|
 | 77 |         if cboService.Items.IndexOf(Trim(Piece(SvcList.Strings[i], U, 2))) = -1 then   {RV}
 | 
|---|
 | 78 |         //if cboService.SelectByID(Piece(SvcList.Strings[i], U, 1)) = -1 then
 | 
|---|
 | 79 |           cboService.Items.Add(SvcList.Strings[i]);
 | 
|---|
 | 80 |       BuildServiceTree(treService, SvcList, '0', nil) ;
 | 
|---|
 | 81 |       with treService do
 | 
|---|
 | 82 |         for i := 0 to Items.Count-1 do
 | 
|---|
 | 83 |           begin
 | 
|---|
 | 84 |             if Items[i].Level > 0 then Items[i].Expanded := False else Items[i].Expanded := True;
 | 
|---|
 | 85 |             TopItem := Items[0] ;
 | 
|---|
 | 86 |             Selected := Items[0] ;
 | 
|---|
 | 87 |           end ;
 | 
|---|
 | 88 |       FAscending := CurrentContext.Ascending;
 | 
|---|
 | 89 |       radSort.ItemIndex := Ord(not FAscending);
 | 
|---|
 | 90 |       CurrentService := CurrentContext.Service;
 | 
|---|
 | 91 |       if StrToIntDef(CurrentService, 0) > 0 then
 | 
|---|
 | 92 |         begin
 | 
|---|
 | 93 |           cboservice.SelectByID(CurrentService);
 | 
|---|
 | 94 |           cboServiceSelect(frmConsultsByService);
 | 
|---|
 | 95 |         end;
 | 
|---|
 | 96 |       ShowModal;
 | 
|---|
 | 97 |       with ServiceContext do
 | 
|---|
 | 98 |       begin
 | 
|---|
 | 99 |         Changed := FChanged;
 | 
|---|
 | 100 |         Service := FService;
 | 
|---|
 | 101 |         ServiceName := FServiceName;
 | 
|---|
 | 102 |         Ascending := FAscending;
 | 
|---|
 | 103 |         ConsultUser := FConsultUser ;
 | 
|---|
 | 104 |         Result := Changed ;
 | 
|---|
 | 105 |       end; {with ServiceContext}
 | 
|---|
 | 106 |     end; {with frmConsultsByService}
 | 
|---|
 | 107 |   finally
 | 
|---|
 | 108 |     frmConsultsByService.Release;
 | 
|---|
 | 109 |   end;
 | 
|---|
 | 110 | end;
 | 
|---|
 | 111 | 
 | 
|---|
 | 112 | procedure TfrmConsultsByService.cmdCancelClick(Sender: TObject);
 | 
|---|
 | 113 | begin
 | 
|---|
 | 114 |   Close;
 | 
|---|
 | 115 | end;
 | 
|---|
 | 116 | 
 | 
|---|
 | 117 | procedure TfrmConsultsByService.cmdOKClick(Sender: TObject);
 | 
|---|
 | 118 | begin
 | 
|---|
 | 119 |   if (treService.Selected = nil) and (StrToIntDef(FService, 0) = 0 ) then
 | 
|---|
 | 120 |   begin
 | 
|---|
 | 121 |     InfoBox(TX_SVC_TEXT, TX_SVC_CAP, MB_OK or MB_ICONWARNING);
 | 
|---|
 | 122 |     Exit;
 | 
|---|
 | 123 |   end;
 | 
|---|
 | 124 |   FChanged     := True;
 | 
|---|
 | 125 |   FService     := Piece(SvcInfo,u,1);
 | 
|---|
 | 126 |   FServiceName := Piece(SvcInfo,u,2) ;
 | 
|---|
 | 127 |   FAscending   := (radSort.ItemIndex = 0);
 | 
|---|
 | 128 |   FConsultUser := ConsultServiceUser(StrToIntDef(FService, 0), User.DUZ) ;
 | 
|---|
 | 129 |   Close;
 | 
|---|
 | 130 | end;
 | 
|---|
 | 131 | 
 | 
|---|
 | 132 | procedure TfrmConsultsByService.treServiceChange(Sender: TObject;
 | 
|---|
 | 133 |   Node: TTreeNode);
 | 
|---|
 | 134 | begin
 | 
|---|
 | 135 |    if uChanging then Exit;
 | 
|---|
 | 136 |    SvcInfo  := TORTreeNode(treService.Selected).StringData ;
 | 
|---|
 | 137 |    cboService.ItemIndex := cboService.Items.IndexOf(Trim(treService.Selected.Text));  {RV}
 | 
|---|
 | 138 |    //cboService.SelectByID(Piece(string(treService.Selected.Data), U, 1));
 | 
|---|
 | 139 | end;
 | 
|---|
 | 140 | 
 | 
|---|
 | 141 | procedure TfrmConsultsByService.cboServiceSelect(Sender: TObject);
 | 
|---|
 | 142 | var
 | 
|---|
 | 143 |   i: integer;
 | 
|---|
 | 144 | begin                                                                    
 | 
|---|
 | 145 |   uChanging := True;
 | 
|---|
 | 146 |   with treService do for i := 0 to Items.Count-1 do
 | 
|---|
 | 147 |     begin                                                                
 | 
|---|
 | 148 |       if Piece(TORTreeNode(Items[i]).StringData, U, 1) = cboService.ItemID then
 | 
|---|
 | 149 |         begin                                                            
 | 
|---|
 | 150 |           Selected := Items[i];                                          
 | 
|---|
 | 151 |           //treServiceChange(Self, Items[i]);                              
 | 
|---|
 | 152 |           break;                                                         
 | 
|---|
 | 153 |         end;                                                             
 | 
|---|
 | 154 |     end;
 | 
|---|
 | 155 |   uChanging := False;
 | 
|---|
 | 156 |   SvcInfo  := TORTreeNode(treService.Selected).StringData ;
 | 
|---|
 | 157 | end;
 | 
|---|
 | 158 | 
 | 
|---|
 | 159 | initialization
 | 
|---|
 | 160 |    SvcList := TStringList.Create ;
 | 
|---|
 | 161 | 
 | 
|---|
 | 162 | finalization
 | 
|---|
 | 163 |    SvcList.Free ;
 | 
|---|
 | 164 | 
 | 
|---|
 | 165 | end.
 | 
|---|