source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/Consults/fConsultBS.pas@ 1727

Last change on this file since 1727 was 829, checked in by Kevin Toppenberg, 14 years ago

Upgrade to version 27

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