Module

fConsultsView

Path

C:\CPRS\CPRS30\Consults\fConsultsView.pas

Last Modified

7/15/2014 3:26:34 PM

Initialization Code

initialization
   SvcList := TStringList.Create ;

Finalization Code

finalization
   SvcList.Free ;

end.

Units Used in Interface

Name Comments
fBase508Form -
uConsults -

Units Used in Implementation

Name Comments
rConsults -
rCore -
uCore -

Classes

Name Comments
TfrmConsultsView -

Procedures

Name Owner Declaration Scope Comments
cboServiceSelect TfrmConsultsView procedure cboServiceSelect(Sender: TObject); Public/Published -
cmdCancelClick TfrmConsultsView procedure cmdCancelClick(Sender: TObject); Public/Published -
cmdOKClick TfrmConsultsView procedure cmdOKClick(Sender: TObject); Public/Published -
popStatusSelectNoneClick TfrmConsultsView procedure popStatusSelectNoneClick(Sender: TObject); Public/Published -
treServiceChange TfrmConsultsView procedure treServiceChange(Sender: TObject; Node: TTreeNode); Public/Published -

Functions

Name Owner Declaration Scope Comments
SelectConsultsView - function SelectConsultsView(FontSize: Integer; CurrentContext: TSelectContext; var SelectContext: TSelectContext): boolean ; Interfaced Displays select form for Consults and returns a record of the selection

Global Variables

Name Type Declaration Comments
SvcInfo UnicodeString SvcInfo: string ; -
SvcList TStrings SvcList: TStrings ; -
uChanging Boolean uChanging: Boolean; -

Constants

Name Declaration Scope Comments
TX_DATE_ERR 'Enter valid beginning and ending dates or press Cancel.' Global -
TX_DATE_ERR_CAP 'Error in Date Range' Global -


Module Source

1     unit fConsultsView;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORFN,
7       StdCtrls, ExtCtrls, ORCtrls, ComCtrls, ORDtTm, uConsults, Menus, fBase508Form,
8       VA508AccessibilityManager;
9     
10    type
11      TfrmConsultsView = class(TfrmBase508Form)
12        pnlBase: TORAutoPanel;
13        lblBeginDate: TLabel;
14        calBeginDate: TORDateBox;
15        lblEndDate: TLabel;
16        calEndDate: TORDateBox;
17        radSort: TRadioGroup;
18        lblStatus: TLabel;
19        lstStatus: TORListBox;
20        lblService: TLabel;
21        cmdOK: TButton;
22        cmdCancel: TButton;
23        treService: TORTreeView;
24        cboService: TORComboBox;
25        cboGroupBy: TORComboBox;
26        Label1: TLabel;
27        popStatus: TPopupMenu;
28        popStatusSelectNone: TMenuItem;
29        procedure cmdOKClick(Sender: TObject);
30        procedure cmdCancelClick(Sender: TObject);
31        procedure treServiceChange(Sender: TObject; Node: TTreeNode);
32        procedure cboServiceSelect(Sender: TObject);
33        procedure popStatusSelectNoneClick(Sender: TObject);
34      private
35        FChanged: Boolean;
36        FBeginDate: string;
37        FEndDate: string;
38        FGroupBy: string;
39        FAscending: Boolean;
40        FService: string;
41        FServiceName: string;
42        FConsultUser: boolean ;
43        FStatus: string;
44        FStatusName: string;
45      end;
46    
47    function SelectConsultsView(FontSize: Integer; CurrentContext: TSelectContext; var SelectContext: TSelectContext): boolean ;
48    
49    var
50      uChanging: Boolean;
51      
52    implementation
53    
54    {$R *.DFM}
55    
56    uses rCore, uCore, rConsults;
57    
58    var
59      SvcList: TStrings ;
60      SvcInfo: string ;
61    
62    const
63       TX_DATE_ERR = 'Enter valid beginning and ending dates or press Cancel.';
64       TX_DATE_ERR_CAP = 'Error in Date Range';
65    
66    function SelectConsultsView(FontSize: Integer; CurrentContext: TSelectContext; var SelectContext: TSelectContext): boolean ;
67    { displays select form for Consults and returns a record of the selection }
68    var
69      frmConsultsView: TfrmConsultsView;
70      W, H, i, j: Integer;
71      CurrentStatus, CurrentBegin, CurrentEnd, CurrentService: string;
72    begin
73      frmConsultsView := TfrmConsultsView.Create(Application);
74      try
75        with frmConsultsView do
76        begin
77          Font.Size := FontSize;
78          W := ClientWidth;
79          H := ClientHeight;
80          ResizeToFont(FontSize, W, H);
81          ClientWidth  := W; pnlBase.Width  := W;
82          ClientHeight := H; pnlBase.Height := H;
83          FChanged := False;
84          with radSort do ItemIndex := 1;
85          //FastAssign(LoadServiceList(CN_SVC_LIST_DISP), SvcList);                         {RV}
86          FastAssign(LoadServiceListWithSynonyms(CN_SVC_LIST_DISP), SvcList);           {RV}
87          SortByPiece(TStringList(SvcList), U, 2);                                   {RV}
88          for i := 0 to SvcList.Count - 1 do
89            if cboService.Items.IndexOf(Trim(Piece(SvcList.Strings[i], U, 2))) = -1 then   {RV}
90            //if cboService.SelectByID(Piece(SvcList.Strings[i], U, 1)) = -1 then
91              cboService.Items.Add(SvcList.Strings[i]);
92          BuildServiceTree(treService, SvcList, '0', nil) ;
93          with treService do
94            for i:=0 to Items.Count-1 do
95              begin
96                if Items[i].Level > 0 then Items[i].Expanded := False else Items[i].Expanded := True;
97                TopItem := Items[0] ;
98                Selected := Items[0] ;
99              end ;
100         CurrentService := CurrentContext.Service;
101         if StrToIntDef(CurrentService, 0) > 0 then
102           begin
103             cboservice.SelectByID(CurrentService);
104             cboServiceSelect(frmConsultsView);
105           end;
106         FastAssign(SubSetOfStatus, lstStatus.Items);
107         CurrentStatus := CurrentContext.Status;
108         if CurrentStatus <> '' then with lstStatus do
109           begin
110             i := 1;
111             while Piece(CurrentStatus, ',', i) <> '' do
112               begin
113                 j := SelectByID(Piece(CurrentStatus, ',', i));
114                 if j > -1 then Selected[j] := True;
115                 Inc(i);
116               end;
117           end;
118         CurrentBegin := CurrentContext.BeginDate;
119         CurrentEnd := CurrentContext.EndDate;
120         if CurrentBegin <> '' then
121           calBeginDate.Text := CurrentBegin;
122         if CurrentEnd <> '' then
123           calEndDate.Text := CurrentEnd;
124         if calEndDate.Text = '' then calEndDate.Text := 'TODAY';
125         cboGroupBy.SelectByID(CurrentContext.GroupBy);
126         ShowModal;
127   
128         with SelectContext do
129          begin
130           Changed := FChanged;
131           BeginDate := FBeginDate;
132           EndDate := FEndDate;
133           Ascending := FAscending;
134           Service := FService;
135           ServiceName := FServiceName;
136           ConsultUser := FConsultUser ;
137           Status := FStatus;
138           StatusName := FStatusName;
139           GroupBy := FGroupBy;
140           Result := Changed ;
141         end;
142   
143       end; {with frmConsultsView}
144     finally
145       frmConsultsView.Release;
146     end;
147   end;
148   
149   procedure TfrmConsultsView.cmdOKClick(Sender: TObject);
150   var
151     bdate, edate: TFMDateTime;
152     i: integer;
153   begin
154     if calBeginDate.Text <> '' then
155        bdate := StrToFMDateTime(calBeginDate.Text)
156     else
157        bdate := 0 ;
158   
159     if calEndDate.Text <> '' then
160        edate   := StrToFMDateTime(calEndDate.Text)
161     else
162        edate := 0 ;
163   
164     if (bdate <= edate) then
165       begin
166         FAscending := radSort.ItemIndex = 0;
167         FBeginDate := calBeginDate.Text;
168         FEndDate := calEndDate.Text;
169       end
170     else
171       begin
172         InfoBox(TX_DATE_ERR, TX_DATE_ERR_CAP, MB_OK or MB_ICONWARNING);
173         Exit;
174       end;
175   
176     if treService.Selected <> nil then
177      begin
178        FService := Piece(SvcInfo,u,1) ;
179        FServiceName := Piece(SvcInfo,u,2) ;
180        FConsultUser := ConsultServiceUser(StrToIntDef(FService, 0), User.DUZ) ;
181      end
182     else
183        FService := '' ;
184   
185     if lstStatus.SelCount > 0 then
186      begin
187         with lstStatus do for i := 0 to Items.Count-1 do if Selected[i] then
188           begin
189             if Piece(Items[i], U, 1) <> '999' then
190               FStatus := FStatus + Piece(Items[i], U, 1) + ','
191             else
192               FStatus := FStatus + Piece(Items[i],U,3) ;
193             FStatusName := FStatusName + DisplayText[i] + ',' ;
194           end;
195         FStatus := Copy(FStatus, 1, Length(FStatus)-1);
196         FStatusName := Copy(FStatusName, 1, Length(FStatusName)-1);
197      end
198     else
199        FStatus := '' ;
200   
201     if cboGroupBy.ItemID <> '' then
202       FGroupBy := cboGroupBy.ItemID
203     else
204       FGroupBy := '';
205   
206     FChanged := True;
207     Close;
208   end;
209   
210   procedure TfrmConsultsView.cmdCancelClick(Sender: TObject);
211   begin
212     Close;
213   end;
214   
215   
216   procedure TfrmConsultsView.treServiceChange(Sender: TObject; Node: TTreeNode);
217   begin
218      if uChanging then Exit;
219      SvcInfo  := TORTreeNode(treService.Selected).StringData ;
220      cboService.ItemIndex := cboService.Items.IndexOf(Trim(treService.Selected.Text));  {RV}
221      //cboService.SelectByID(Piece(string(treService.Selected.Data), U, 1));
222   end;
223   
224   procedure TfrmConsultsView.cboServiceSelect(Sender: TObject);
225   var                                                                      
226     i: integer;                                                            
227   begin                                                                    
228     uChanging := True;
229     with treService do for i := 0 to Items.Count-1 do
230       begin                                                                
231         if Piece(TORTreeNode(Items[i]).StringData,U,1) = cboService.ItemID then
232           begin                                                            
233             Selected := Items[i];                                          
234             //treServiceChange(Self, Items[i]);
235             break;                                                         
236           end;                                                             
237       end;
238     uChanging := False;
239     SvcInfo  := TORTreeNode(treService.Selected).StringData ;
240   end;                                                                     
241   
242   procedure TfrmConsultsView.popStatusSelectNoneClick(Sender: TObject);
243   var
244     i: integer;
245   begin
246     with lstStatus do
247       begin
248         for i := 0 to Items.Count - 1 do
249           Selected[i] := False;
250         ItemIndex := -1;
251       end;
252   end;
253   
254   initialization
255      SvcList := TStringList.Create ;
256   
257   finalization
258      SvcList.Free ;
259   
260   end.

Module Calls (2 levels)


fConsultsView
 ├uConsults
 │ └uConst
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├rCore
 │ └uCore
 ├uCore...
 └rConsults
   ├rCore...
   ├uCore...
   ├uConsults...
   └uTIU

Module Called-By (2 levels)


      fConsultsView
        fConsults┘ 
         fFrame┤   
         fNotes┤   
     fPrintList┤   
fReminderDialog┤   
        fReview┤   
       fSurgery┤   
    fConsultAct┤   
      fCsltNote┘