source: cprs/trunk/CPRS-Chart/Consults/fConsultBS.pas@ 480

Last change on this file since 480 was 456, checked in by Kevin Toppenberg, 16 years ago

Initial Upload of Official WV CPRS 1.0.26.76

File size: 5.3 KB
RevLine 
[456]1unit fConsultBS;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 ExtCtrls, ORCtrls, StdCtrls, ORFn, ComCtrls, uConsults;
8
9type
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
38function SelectService(FontSize: Integer; CurrentContext: TSelectContext; var ServiceContext: TServiceContext): boolean;
39
40implementation
41
42{$R *.DFM}
43
44uses rConsults, rCore, uCore;
45
46var
47 SvcList: TStrings ;
48 SvcInfo: string ;
49 uChanging: Boolean;
50
51const
52 TX_SVC_TEXT = 'Select a consult service or press Cancel.';
53 TX_SVC_CAP = 'Missing Service';
54
55function SelectService(FontSize: Integer; CurrentContext: TSelectContext; var ServiceContext: TServiceContext): boolean;
56{ displays service select form for consults and returns a record of the selection }
57var
58 frmConsultsByService: TfrmConsultsByService;
59 W, H, i: Integer;
60 CurrentService: string;
61begin
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;
110end;
111
112procedure TfrmConsultsByService.cmdCancelClick(Sender: TObject);
113begin
114 Close;
115end;
116
117procedure TfrmConsultsByService.cmdOKClick(Sender: TObject);
118begin
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;
130end;
131
132procedure TfrmConsultsByService.treServiceChange(Sender: TObject;
133 Node: TTreeNode);
134begin
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));
139end;
140
141procedure TfrmConsultsByService.cboServiceSelect(Sender: TObject);
142var
143 i: integer;
144begin
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 ;
157end;
158
159initialization
160 SvcList := TStringList.Create ;
161
162finalization
163 SvcList.Free ;
164
165end.
Note: See TracBrowser for help on using the repository browser.