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