[456] | 1 | unit fPtSelDemog;
|
---|
| 2 |
|
---|
| 3 | interface
|
---|
| 4 |
|
---|
| 5 | uses
|
---|
| 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
[830] | 7 | StdCtrls, ExtCtrls, ORCtrls, fBase508Form, VA508AccessibilityManager;
|
---|
[456] | 8 |
|
---|
| 9 | type
|
---|
[830] | 10 | TfrmPtSelDemog = class(TfrmBase508Form)
|
---|
[456] | 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;
|
---|
[1679] | 25 | lblCombatVet: TStaticText;
|
---|
[456] | 26 | procedure FormCreate(Sender: TObject);
|
---|
| 27 | procedure FormDestroy(Sender: TObject);
|
---|
[1679] | 28 | procedure FormShow(Sender: TObject);
|
---|
[456] | 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 |
|
---|
[1679] | 44 | uses rCore, VA508AccessibilityRouter, uCombatVet;
|
---|
[456] | 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;
|
---|
[1679] | 73 | CV : TCombatVet;
|
---|
[456] | 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;
|
---|
[1679] | 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;
|
---|
[456] | 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;
|
---|
[830] | 146 | MaxFont = 10;
|
---|
| 147 | var uHeight:integer;
|
---|
[456] | 148 |
|
---|
[830] | 149 |
|
---|
[456] | 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;
|
---|
[830] | 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 ;
|
---|
[1679] | 193 | lblCombatVet.Top := (lblRoomBed.Top + uHeight) + 2;
|
---|
[830] | 194 | end;
|
---|
[456] | 195 | end;
|
---|
| 196 |
|
---|
| 197 | procedure TfrmPtSelDemog.FormDestroy(Sender: TObject);
|
---|
| 198 | begin
|
---|
| 199 | orapnlMain.WindowProc := FOldWinProc;
|
---|
| 200 | end;
|
---|
| 201 |
|
---|
[1679] | 202 | procedure TfrmPtSelDemog.FormShow(Sender: TObject);
|
---|
| 203 | begin
|
---|
| 204 | inherited;
|
---|
| 205 | lblCombatVet.Caption := '';
|
---|
| 206 | end;
|
---|
| 207 |
|
---|
[830] | 208 | initialization
|
---|
| 209 | SpecifyFormIsNotADialog(TfrmPtSelDemog);
|
---|
| 210 |
|
---|
[456] | 211 | end.
|
---|