Module

fConsultBS

Path

C:\CPRS\CPRS30\Consults\fConsultBS.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
TfrmConsultsByService -

Procedures

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

Functions

Name Owner Declaration Scope Comments
SelectService - function SelectService(FontSize: Integer; CurrentContext: TSelectContext; var ServiceContext: TServiceContext): boolean; Interfaced Displays service 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_SVC_CAP 'Missing Service' Global -
TX_SVC_TEXT 'Select a consult service or press Cancel.' Global -


Module Source

1     unit fConsultBS;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       ExtCtrls, ORCtrls, StdCtrls, ORFn, ComCtrls, uConsults, fBase508Form,
8       VA508AccessibilityManager;
9     
10    type
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    
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;
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;
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.

Module Calls (2 levels)


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

Module Called-By (2 levels)


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