Module

fVisit

Path

C:\CPRS\CPRS30\fVisit.pas

Last Modified

7/15/2014 3:26:40 PM

Units Used in Interface

Name Comments
fBase508Form -
rCore -
uCore -

Units Used in Implementation

Name Comments
rOptions -

Classes

Name Comments
TfrmVisit -

Procedures

Name Owner Declaration Scope Comments
cboLocationNeedData TfrmVisit procedure cboLocationNeedData(Sender: TObject; const StartFrom: string; Direction, InsertAt: Integer); Public/Published Callback for location combobox to list active locations
cmdCancelClick TfrmVisit procedure cmdCancelClick(Sender: TObject); Public/Published Cancel form - no change to visit information
cmdOKClick TfrmVisit procedure cmdOKClick(Sender: TObject); Public/Published Gather and validate visit information
FormCreate TfrmVisit procedure FormCreate(Sender: TObject); Public/Published
Procedure UpdateVisit(FontSize: Integer);
{displays visit selection form and directly updates the visit in Encounter }
var
  VisitUpdate: TVisitUpdate;
begin
  SelectVisit(FontSize, VisitUpdate);
  if VisitUpdate.Changed then
  begin
    Encounter.Location  := VisitUpdate.Location;
    Encounter.DateTime  := VisitUpdate.DateTime;
    Encounter.VisitCategory := VisitUpdate.VisitCategory;
    Encounter.StandAlone := VisitUpdate.StandAlone;
  end;
end;

procedure SelectVisit(FontSize: Integer; var VisitUpdate: TVisitUpdate);
{displays visit selection form and returns a record of the updated information }
var
  frmVisit: TfrmVisit;
  W, H: Integer;
begin
  frmVisit := TfrmVisit.Create(Application);
  try
    with frmVisit do
    begin
      Font.Size := FontSize;
      lblInstruct.Font.Size := FontSize;
      W := ClientWidth;
      H := ClientHeight;
      ResizeToFont(FontSize, W, H);
      ClientWidth  := W; pnlBase.Width  := W;
      ClientHeight := H; pnlBase.Height := W;
      frmVisit.ShowModal;
      with VisitUpdate do
      begin
        Changed := FChanged;
        DateTime := FDateTime;
        Location := FLocation;
        LocationName := FLocationName;
        VisitCategory := FVisitCategory;
        StandAlone := FStandAlone;
      end; {with VisitRec}
    end; {with frmVisit}
  finally
    frmVisit.Release;
  end;
end;


 initialize private fields and display appropriate visit selection controls
radSelectorClick TfrmVisit procedure radSelectorClick(Sender: TObject); Public/Published Change visit data entry according to the radiobutton selected (appts, admissions, new visit

Constants

Name Declaration Scope Comments
TAG_SEL_ADMIT 2 Global -
TAG_SEL_CLINIC 1 Global -
TAG_SEL_NEW 3 Global -


Module Source

1     unit fVisit;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       ExtCtrls, ORCtrls, ORDtTm, ORFn, StdCtrls, rCore, uCore, fBase508Form,
8       VA508AccessibilityManager;
9     
10    type
11      TfrmVisit = class(TfrmBase508Form)
12        pnlBase: TORAutoPanel;
13        lblInstruct: TStaticText;
14        radAppt: TRadioButton;
15        radAdmit: TRadioButton;
16        radNewVisit: TRadioButton;
17        lstVisit: TORListBox;
18        lblSelect: TLabel;
19        pnlVisit: TORAutoPanel;
20        cboLocation: TORComboBox;
21        timVisitDate: TORDateBox;
22        lblVisitDate: TLabel;
23        cmdOK: TButton;
24        cmdCancel: TButton;
25        grpCategory: TGroupBox;
26        ckbHistorical: TCheckBox;
27        procedure radSelectorClick(Sender: TObject);
28        procedure cboLocationNeedData(Sender: TObject; const StartFrom: string;
29          Direction, InsertAt: Integer);
30        procedure cmdCancelClick(Sender: TObject);
31        procedure cmdOKClick(Sender: TObject);
32        procedure FormCreate(Sender: TObject);
33      private
34        { Private declarations }
35        FChanged: Boolean;
36        FDateTime: TFMDateTime;
37        FLocation: Integer;
38        FLocationName: string;
39        FVisitCategory: Char;
40        FStandAlone: Boolean;
41      public
42        { Public declarations }
43      end;
44    
45    (*
46    procedure SelectVisit(FontSize: Integer; var VisitUpdate: TVisitUpdate);
47    procedure UpdateVisit(FontSize: Integer);
48    *)
49    
50    implementation
51    
52    {$R *.DFM}
53    
54    uses
55      rOptions;
56    
57    const
58      TAG_SEL_CLINIC = 1;
59      TAG_SEL_ADMIT  = 2;
60      TAG_SEL_NEW    = 3;
61    
62    type
63      TVisitUpdate = record
64        Changed: Boolean;
65        DateTime: TFMDateTime;
66        Location: Integer;
67        LocationName: string;
68        VisitCategory: Char;
69        StandAlone: Boolean;
70      end;
71    
72    (*
73    procedure UpdateVisit(FontSize: Integer);
74    { displays visit selection form and directly updates the visit in Encounter }
75    var
76      VisitUpdate: TVisitUpdate;
77    begin
78      SelectVisit(FontSize, VisitUpdate);
79      if VisitUpdate.Changed then
80      begin
81        Encounter.Location  := VisitUpdate.Location;
82        Encounter.DateTime  := VisitUpdate.DateTime;
83        Encounter.VisitCategory := VisitUpdate.VisitCategory;
84        Encounter.StandAlone := VisitUpdate.StandAlone;
85      end;
86    end;
87    
88    procedure SelectVisit(FontSize: Integer; var VisitUpdate: TVisitUpdate);
89    { displays visit selection form and returns a record of the updated information }
90    var
91      frmVisit: TfrmVisit;
92      W, H: Integer;
93    begin
94      frmVisit := TfrmVisit.Create(Application);
95      try
96        with frmVisit do
97        begin
98          Font.Size := FontSize;
99          lblInstruct.Font.Size := FontSize;
100         W := ClientWidth;
101         H := ClientHeight;
102         ResizeToFont(FontSize, W, H);
103         ClientWidth  := W; pnlBase.Width  := W;
104         ClientHeight := H; pnlBase.Height := W;
105         frmVisit.ShowModal;
106         with VisitUpdate do
107         begin
108           Changed := FChanged;
109           DateTime := FDateTime;
110           Location := FLocation;
111           LocationName := FLocationName;
112           VisitCategory := FVisitCategory;
113           StandAlone := FStandAlone;
114         end; {with VisitRec}
115       end; {with frmVisit}
116     finally
117       frmVisit.Release;
118     end;
119   end;
120   *)
121   
122   procedure TfrmVisit.FormCreate(Sender: TObject);
123   { initialize private fields and display appropriate visit selection controls }
124   begin
125     FChanged := False;
126     radSelectorClick(radAppt);
127     if lstVisit.Items.Count = 0 then
128     begin
129       radNewVisit.Checked := True;
130       radSelectorClick(radNewVisit);
131     end;
132   end;
133   
134   procedure TfrmVisit.radSelectorClick(Sender: TObject);
135   { change visit data entry according to the radiobutton selected (appts, admissions, new visit }
136   var
137     i: Integer;
138     ADateFrom, ADateThru: TDateTime;
139     BDateFrom, BDateThru: Integer;
140   begin
141     if not TRadioButton(Sender).Checked then Exit;
142     lstVisit.Clear;
143     lblVisitDate.Hide;
144     case TRadioButton(Sender).Tag of
145       TAG_SEL_CLINIC: begin
146                         lblSelect.Caption := 'Clinic Appointments';
147                         rpcGetRangeForEncs(BDateFrom, BDateThru, False); // Get user's current date range settings.
148                         ADateFrom := (FMDateTimeToDateTime(FMToday) - BDateFrom);
149                         ADateThru := (FMDateTimeToDateTime(FMToday) + BDateThru);
150                         ADateFrom := DateTimeToFMDateTime(ADateFrom);
151                         ADateThru:= DateTimeToFMDateTime(ADateThru) + 0.2359;
152                         ListApptAll(lstVisit.Items, Patient.DFN, ADateFrom, ADateThru);
153                         pnlVisit.Hide;
154                         lstVisit.Show;
155                       end;
156       TAG_SEL_ADMIT:  begin
157                         lblSelect.Caption := 'Hospital Admissions';
158                         ListAdmitAll(lstVisit.Items, Patient.DFN);
159                         pnlVisit.Hide;
160                         lstVisit.Show;
161                       end;
162       TAG_SEL_NEW:    begin
163                         lblSelect.Caption := 'Visit Location';
164                         with cboLocation do
165                         begin
166                           InitLongList(Encounter.LocationName);
167                           for i := 0 to Items.Count - 1 do
168                             if StrToIntDef(Piece(Items[i], U, 1),0) = Encounter.Location then
169                             begin
170                               ItemIndex := i;
171                               break;
172                             end;
173                         end;
174                         lstVisit.Hide;
175                         lblVisitDate.Show;
176                         pnlVisit.Show;
177                       end;
178     end;
179     lstVisit.Caption := lblSelect.Caption;
180   end;
181   
182   procedure TfrmVisit.cboLocationNeedData(Sender: TObject; const StartFrom: string;
183     Direction, InsertAt: Integer);
184   { callback for location combobox to list active locations }
185   begin
186     //cboLocation.ForDataUse(SubSetOfLocations(StartFrom, Direction));
187     cboLocation.ForDataUse(SubSetOfClinics(StartFrom, Direction));
188   end;
189   
190   procedure TfrmVisit.cmdOKClick(Sender: TObject);
191   { gather and validate visit information }
192   const
193     VST_CAPTION  = 'Unable to Select Visit';
194     VST_LOCATION = 'A visit LOCATION has not been selected.';
195     VST_DATETIME = 'A valid date/time has not been entered.';
196     VST_NOTIME   = 'A valid time has not been entered.';
197     VST_SELECT   = 'An appointment/hospitalization has not been entered';
198   begin
199     FStandAlone := False;
200     if radNewVisit.Checked then
201     begin
202       if cboLocation.ItemIndex < 0 then
203       begin
204         InfoBox(VST_LOCATION, VST_CAPTION, MB_OK);
205         Exit;
206       end;
207       FDateTime := StrToFMDateTime(timVisitDate.Text);
208       if not (FDateTime > 0) then
209       begin
210         InfoBox(VST_DATETIME, VST_CAPTION, MB_OK);
211         Exit;
212       end;
213       if(pos('.',FloatToStr(FDateTime))=0) then
214       begin
215         InfoBox(VST_NOTIME, VST_CAPTION, MB_OK);
216         Exit;
217       end;
218       with cboLocation do
219       begin
220         FLocation := ItemIEN;
221         FLocationName := DisplayText[ItemIndex];
222       end;
223   
224       //Changed 12/30/97 ISL/RAB
225       if ckbHistorical.state = cbchecked then FVisitCategory := 'E'
226       else FVisitCategory := 'A';
227   
228       FChanged := True;
229   
230       //ISL/RAB  1/15/98  The following line has been changed so procedures will
231       //         not be required for historical visits.
232       if (FVisitCategory = 'A') then FStandAlone := True;
233     end else
234     begin
235       if lstVisit.ItemIndex < 0 then
236       begin
237         InfoBox(VST_SELECT, VST_CAPTION, MB_OK);
238         Exit;
239       end;
240       with lstVisit do
241       begin
242         FDateTime := MakeFMDateTime(ItemID);
243         FLocation := StrToIntDef(Piece(Items[ItemIndex], U, 2), 0);
244         FLocationName := Piece(Items[ItemIndex], U, 3);
245         if(radAdmit.Checked) then
246           FVisitCategory := 'H'
247         else
248           FVisitCategory := 'A';
249         FChanged := True;
250       end;
251     end;
252     Close;
253   end;
254   
255   procedure TfrmVisit.cmdCancelClick(Sender: TObject);
256   { cancel form - no change to visit information }
257   begin
258     FChanged := False;
259     Close;
260   end;
261   
262   end.

Module Calls (2 levels)


fVisit
 ├rCore
 │ └uCore
 ├uCore...
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 └rOptions
   └rCore...

Module Called-By (2 levels)

-