Module

fPtSelDemog

Path

C:\CPRS\CPRS30\fPtSelDemog.pas

Last Modified

7/15/2014 3:26:38 PM

Initialization Code

initialization
  SpecifyFormIsNotADialog(TfrmPtSelDemog);

end.

Units Used in Interface

Name Comments
fBase508Form -

Units Used in Implementation

Name Comments
rCore -
uCombatVet -

Classes

Name Comments
TfrmPtSelDemog -

Procedures

Name Owner Declaration Scope Comments
ClearIDInfo TfrmPtSelDemog procedure ClearIDInfo; Public Clears controls with patient ID info (controls have '2' in their Tag property
FormCreate TfrmPtSelDemog procedure FormCreate(Sender: TObject); Public/Published -
FormDestroy TfrmPtSelDemog procedure FormDestroy(Sender: TObject); Public/Published -
FormShow TfrmPtSelDemog procedure FormShow(Sender: TObject); Public/Published -
NewWinProc TfrmPtSelDemog procedure NewWinProc(var Message: TMessage); Private -
ShowDemog TfrmPtSelDemog procedure ShowDemog(ItemID: string); Public Gets a record of patient indentifying information from the server and displays it
ToggleMemo TfrmPtSelDemog procedure ToggleMemo; Public -

Global Variables

Name Type Declaration Comments
frmPtSelDemog TfrmPtSelDemog frmPtSelDemog: TfrmPtSelDemog; -

Constants

Name Declaration Scope Comments
TAG_CLEAR 2 Global Labels to be cleared
TAG_HIDE 1 Global
Constants referencing the value of the tag property in components 

 labels to be hidden


Module Source

1     unit fPtSelDemog;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       StdCtrls, ExtCtrls, ORCtrls, fBase508Form, VA508AccessibilityManager;
8     
9     type
10      TfrmPtSelDemog = class(TfrmBase508Form)
11        orapnlMain: TORAutoPanel;
12        lblSSN: TStaticText;
13        lblPtSSN: TStaticText;
14        lblDOB: TStaticText;
15        lblPtDOB: TStaticText;
16        lblPtSex: TStaticText;
17        lblPtVet: TStaticText;
18        lblPtSC: TStaticText;
19        lblLocation: TStaticText;
20        lblPtRoomBed: TStaticText;
21        lblPtLocation: TStaticText;
22        lblRoomBed: TStaticText;
23        lblPtName: TStaticText;
24        Memo: TCaptionMemo;
25        lblCombatVet: TStaticText;
26        procedure FormCreate(Sender: TObject);
27        procedure FormDestroy(Sender: TObject);
28        procedure FormShow(Sender: TObject);
29      private
30        FLastDFN: string;
31        FOldWinProc :TWndMethod;
32        procedure NewWinProc(var Message: TMessage);
33      public
34        procedure ClearIDInfo;
35        procedure ShowDemog(ItemID: string);
36        procedure ToggleMemo;
37      end;
38    
39    var
40      frmPtSelDemog: TfrmPtSelDemog;
41    
42    implementation
43    
44    uses rCore, VA508AccessibilityRouter, uCombatVet;
45    
46    {$R *.DFM}
47    
48    const
49    { constants referencing the value of the tag property in components }
50      TAG_HIDE     =  1;                             // labels to be hidden
51      TAG_CLEAR    =  2;                             // labels to be cleared
52    
53    procedure TfrmPtSelDemog.ClearIDInfo;
54    { clears controls with patient ID info (controls have '2' in their Tag property }
55    var
56      i: Integer;
57    begin
58      FLastDFN := '';
59      with orapnlMain do
60      for i := 0 to ControlCount - 1 do
61      begin
62        if Controls[i].Tag = TAG_HIDE then Controls[i].Visible := False;
63        if Controls[i].Tag = TAG_CLEAR then with Controls[i] as TStaticText do Caption := '';
64      end;
65      Memo.Clear;
66    end;
67    
68    procedure TfrmPtSelDemog.ShowDemog(ItemID: string);
69    { gets a record of patient indentifying information from the server and displays it }
70    var
71      PtRec: TPtIDInfo;
72      i: Integer;
73      CV : TCombatVet;
74    begin
75      if ItemID = FLastDFN then Exit;
76      Memo.Clear;
77      FLastDFN := ItemID;
78      PtRec := GetPtIDInfo(ItemID);
79      with PtRec do
80      begin
81        Memo.Lines.Add(Name);
82        Memo.Lines.Add(lblSSN.Caption + ' ' + SSN + '.');
83        Memo.Lines.Add(lblDOB.Caption + ' ' + DOB + '.');
84        if Sex <> '' then
85          Memo.Lines.Add(Sex + '.');
86        if Vet <> '' then
87          Memo.Lines.Add(Vet + '.');
88        if SCsts <> '' then
89          Memo.Lines.Add(SCsts + '.');
90        if Location <> '' then
91          Memo.Lines.Add(lblLocation.Caption + ' ' + Location + '.');
92        if RoomBed <> '' then
93          Memo.Lines.Add(lblRoomBed.Caption + ' ' + RoomBed + '.');
94    
95        lblPtName.Caption     := Name;
96        lblPtSSN.Caption      := SSN;
97        lblPtDOB.Caption      := DOB;
98        lblPtSex.Caption      := Sex {+ ', age ' + Age};
99        lblPtSC.Caption       := SCSts;
100       lblPtVet.Caption      := Vet;
101       lblPtLocation.Caption := Location;
102       lblPtRoomBed.Caption  := RoomBed;
103     end;
104     with orapnlMain do for i := 0 to ControlCount - 1 do
105       if Controls[i].Tag = TAG_HIDE then Controls[i].Visible := True;
106     if lblPtLocation.Caption = '' then
107       lblLocation.Hide
108     else
109       lblLocation.Show;
110     if lblPtRoomBed.Caption = ''  then
111       lblRoomBed.Hide
112     else
113       lblRoomBed.Show;
114     CV := TCombatVet.Create(ItemID);
115     if CV.IsEligible then begin
116       lblCombatVet.Caption := 'CV ' + CV.ExpirationDate + ' ' + CV.OEF_OIF;
117       Memo.Lines.Add(lblCombatVet.Caption);
118     end else
119       lblCombatVet.Caption := '';
120     CV.Free;
121     Memo.SelectAll;
122   end;
123   
124   procedure TfrmPtSelDemog.ToggleMemo;
125   begin
126     if Memo.Visible then
127     begin
128       Memo.Hide;
129     end
130     else
131     begin
132       Memo.Show;
133       Memo.BringToFront;
134     end;
135   end;
136   
137   procedure TfrmPtSelDemog.FormCreate(Sender: TObject);
138   begin
139     FOldWinProc := orapnlMain.WindowProc;
140     orapnlMain.WindowProc := NewWinProc;
141   end;
142   
143   procedure TfrmPtSelDemog.NewWinProc(var Message: TMessage);
144   const
145     Gap = 4;
146     MaxFont = 10;
147     var uHeight:integer;
148   
149   
150   begin
151     if(assigned(FOldWinProc)) then FOldWinProc(Message);
152     if(Message.Msg = WM_Size) then
153     begin
154       if(lblPtSSN.Left < (lblSSN.Left+lblSSN.Width+Gap)) then
155         lblPtSSN.Left := (lblSSN.Left+lblSSN.Width+Gap);
156       if(lblPtDOB.Left < (lblDOB.Left+lblDOB.Width+Gap)) then
157         lblPtDOB.Left := (lblDOB.Left+lblDOB.Width+Gap);
158       if(lblPtSSN.Left < lblPtDOB.Left) then
159         lblPtSSN.Left := lblPtDOB.Left
160       else
161         lblPtDOB.Left := lblPtSSN.Left;
162   
163       if(lblPtLocation.Left < (lblLocation.Left+lblLocation.Width+Gap)) then
164         lblPtLocation.Left := (lblLocation.Left+lblLocation.Width+Gap);
165       if(lblPtRoomBed.Left < (lblRoomBed.Left+lblRoomBed.Width+Gap)) then
166         lblPtRoomBed.Left := (lblRoomBed.Left+lblRoomBed.Width+Gap);
167       if(lblPtLocation.Left < lblPtRoomBed.Left) then
168         lblPtLocation.Left := lblPtRoomBed.Left
169       else
170         lblPtRoomBed.Left := lblPtLocation.Left;
171     end;
172     if frmPtSelDemog.Canvas.Font.Size > MaxFont then
173     begin
174       uHeight         := frmPtSelDemog.Canvas.TextHeight(lblPtSSN.Caption)-2;
175       lblPtSSN.Top    := (lblPtName.Top + uHeight);
176       lblSSN.Top      := lblPtSSN.Top;
177       lblPtDOB.Height := uHeight;
178       lblPtDOB.Top    := (lblPtSSn.Top + uHeight);
179       lblDOB.Top      := lblPtDOB.Top;
180       lblPtSex.Height :=  uHeight;
181       lblPtSex.Top    := (lblPtDOB.Top + uHeight);
182       lblPtVet.Height :=  uHeight;
183       lblPtVet.Top    := (lblPtSex.Top + uHeight);
184       lblPtSC.Height  := uHeight;
185       lblPtSC.Top     :=  lblPtVet.Top;
186       lblLocation.Height := uHeight;
187       lblLocation.Top := ( lblPtVet.Top + uHeight);
188       lblPtLocation.Top := lblLocation.Top;
189       lblRoomBed.Height := uHeight;
190       lblRoomBed.Top    :=(lblLocation.Top + uHeight)+ 2;
191       lblPtRoomBed.Height := uHeight;
192       lblPtRoomBed.Top  := lblRoomBed.Top ;
193       lblCombatVet.Top := (lblRoomBed.Top + uHeight) + 2;
194     end;
195   end;
196   
197   procedure TfrmPtSelDemog.FormDestroy(Sender: TObject);
198   begin
199     orapnlMain.WindowProc := FOldWinProc;
200   end;
201   
202   procedure TfrmPtSelDemog.FormShow(Sender: TObject);
203   begin
204     inherited;
205     lblCombatVet.Caption := '';
206   end;
207   
208   initialization
209     SpecifyFormIsNotADialog(TfrmPtSelDemog);
210   
211   end.

Module Calls (2 levels)


fPtSelDemog
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├rCore
 │ └uCore
 └uCombatVet

Module Called-By (2 levels)


    fPtSelDemog
       fPtSel┘ 
     fFrame┤   
fPtSelOptns┤   
    fDupPts┘