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