source: cprs/branches/tmg-cprs/CPRS-Chart/Consults/fConsultBS.pas@ 1531

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

Initial upload of TMG-CPRS 1.0.26.69

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