| 1 | unit fPtSelDemog; | 
|---|
| 2 |  | 
|---|
| 3 | interface | 
|---|
| 4 |  | 
|---|
| 5 | //kt changed orapnlMain.Anchors.akBottom to false | 
|---|
| 6 | //kt ... it didn't do what I wanted.  Consider changing back later. | 
|---|
| 7 |  | 
|---|
| 8 | uses | 
|---|
| 9 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, | 
|---|
| 10 | StdCtrls, ExtCtrls, ORCtrls, DKLang; | 
|---|
| 11 |  | 
|---|
| 12 | type | 
|---|
| 13 | TfrmPtSelDemog = class(TForm) | 
|---|
| 14 | orapnlMain: TORAutoPanel; | 
|---|
| 15 | lblSSN: TStaticText; | 
|---|
| 16 | lblPtSSN: TStaticText; | 
|---|
| 17 | lblDOB: TStaticText; | 
|---|
| 18 | lblPtDOB: TStaticText; | 
|---|
| 19 | lblPtSex: TStaticText; | 
|---|
| 20 | lblPtVet: TStaticText; | 
|---|
| 21 | lblPtSC: TStaticText; | 
|---|
| 22 | lblLocation: TStaticText; | 
|---|
| 23 | lblPtRoomBed: TStaticText; | 
|---|
| 24 | lblPtLocation: TStaticText; | 
|---|
| 25 | lblRoomBed: TStaticText; | 
|---|
| 26 | lblPtName: TStaticText; | 
|---|
| 27 | Memo: TCaptionMemo; | 
|---|
| 28 | lblPtHRN: TStaticText; | 
|---|
| 29 | DKLanguageController1: TDKLanguageController; | 
|---|
| 30 | procedure FormCreate(Sender: TObject); | 
|---|
| 31 | procedure FormDestroy(Sender: TObject); | 
|---|
| 32 | private | 
|---|
| 33 | FLastDFN: string; | 
|---|
| 34 | FOldWinProc :TWndMethod; | 
|---|
| 35 | procedure NewWinProc(var Message: TMessage); | 
|---|
| 36 | public | 
|---|
| 37 | procedure ClearIDInfo; | 
|---|
| 38 | procedure ShowDemog(ItemID: string); | 
|---|
| 39 | procedure ToggleMemo; | 
|---|
| 40 | end; | 
|---|
| 41 |  | 
|---|
| 42 | var | 
|---|
| 43 | frmPtSelDemog: TfrmPtSelDemog; | 
|---|
| 44 |  | 
|---|
| 45 | implementation | 
|---|
| 46 |  | 
|---|
| 47 | uses rCore; | 
|---|
| 48 |  | 
|---|
| 49 | {$R *.DFM} | 
|---|
| 50 |  | 
|---|
| 51 | const | 
|---|
| 52 | { constants referencing the value of the tag property in components } | 
|---|
| 53 | TAG_HIDE     =  1;                             // labels to be hidden | 
|---|
| 54 | TAG_CLEAR    =  2;                             // labels to be cleared | 
|---|
| 55 |  | 
|---|
| 56 | procedure TfrmPtSelDemog.ClearIDInfo; | 
|---|
| 57 | { clears controls with patient ID info (controls have '2' in their Tag property } | 
|---|
| 58 | var | 
|---|
| 59 | i: Integer; | 
|---|
| 60 | begin | 
|---|
| 61 | FLastDFN := ''; | 
|---|
| 62 | with orapnlMain do | 
|---|
| 63 | for i := 0 to ControlCount - 1 do | 
|---|
| 64 | begin | 
|---|
| 65 | if Controls[i].Tag = TAG_HIDE then Controls[i].Visible := False; | 
|---|
| 66 | if Controls[i].Tag = TAG_CLEAR then with Controls[i] as TStaticText do Caption := ''; | 
|---|
| 67 | end; | 
|---|
| 68 | Memo.Clear; | 
|---|
| 69 | end; | 
|---|
| 70 |  | 
|---|
| 71 | procedure TfrmPtSelDemog.ShowDemog(ItemID: string); | 
|---|
| 72 | { gets a record of patient indentifying information from the server and displays it } | 
|---|
| 73 | var | 
|---|
| 74 | PtRec: TPtIDInfo; | 
|---|
| 75 | i: Integer; | 
|---|
| 76 |  | 
|---|
| 77 | begin | 
|---|
| 78 | if ItemID = FLastDFN then Exit; | 
|---|
| 79 | Memo.Clear; | 
|---|
| 80 | FLastDFN := ItemID; | 
|---|
| 81 | PtRec := GetPtIDInfo(ItemID); | 
|---|
| 82 | with PtRec do | 
|---|
| 83 | begin | 
|---|
| 84 | Memo.Lines.Add(Name); | 
|---|
| 85 | Memo.Lines.Add(lblSSN.Caption + ' ' + SSN + '.'); | 
|---|
| 86 | Memo.Lines.Add(lblDOB.Caption + ' ' + DOB + '.'); | 
|---|
| 87 | if Sex <> '' then | 
|---|
| 88 | Memo.Lines.Add(Sex + '.'); | 
|---|
| 89 | if Vet <> '' then | 
|---|
| 90 | Memo.Lines.Add(Vet + '.'); | 
|---|
| 91 | if SCsts <> '' then | 
|---|
| 92 | Memo.Lines.Add(SCsts + '.'); | 
|---|
| 93 | if Location <> '' then | 
|---|
| 94 | Memo.Lines.Add(lblLocation.Caption + ' ' + Location + '.'); | 
|---|
| 95 | if RoomBed <> '' then | 
|---|
| 96 | Memo.Lines.Add(lblRoomBed.Caption + ' ' + RoomBed + '.'); | 
|---|
| 97 |  | 
|---|
| 98 | lblPtName.Caption     := Name; | 
|---|
| 99 | lblPtSSN.Caption      := SSN; | 
|---|
| 100 | lblPtDOB.Caption      := DOB; | 
|---|
| 101 | lblPtSex.Caption      := Sex {+ ', age ' + Age}; | 
|---|
| 102 | lblPtSC.Caption       := SCSts; | 
|---|
| 103 | lblPtVet.Caption      := Vet; | 
|---|
| 104 | lblPtLocation.Caption := Location; | 
|---|
| 105 | lblPtRoomBed.Caption  := RoomBed; | 
|---|
| 106 | //VWPT | 
|---|
| 107 | if HRN <> '' then lblPtHRN.Caption      := 'HRN: '+HRN | 
|---|
| 108 | else    lblPtHRN.Caption :=''  ; | 
|---|
| 109 | end; | 
|---|
| 110 | with orapnlMain do for i := 0 to ControlCount - 1 do | 
|---|
| 111 | if Controls[i].Tag = TAG_HIDE then Controls[i].Visible := True; | 
|---|
| 112 | if lblPtLocation.Caption = '' then | 
|---|
| 113 | lblLocation.Hide | 
|---|
| 114 | else | 
|---|
| 115 | lblLocation.Show; | 
|---|
| 116 | if lblPtRoomBed.Caption = ''  then | 
|---|
| 117 | lblRoomBed.Hide | 
|---|
| 118 | else | 
|---|
| 119 | lblRoomBed.Show; | 
|---|
| 120 | Memo.SelectAll; | 
|---|
| 121 | end; | 
|---|
| 122 |  | 
|---|
| 123 | procedure TfrmPtSelDemog.ToggleMemo; | 
|---|
| 124 | begin | 
|---|
| 125 | if Memo.Visible then | 
|---|
| 126 | begin | 
|---|
| 127 | Memo.Hide; | 
|---|
| 128 | end | 
|---|
| 129 | else | 
|---|
| 130 | begin | 
|---|
| 131 | Memo.Show; | 
|---|
| 132 | Memo.BringToFront; | 
|---|
| 133 | end; | 
|---|
| 134 | end; | 
|---|
| 135 |  | 
|---|
| 136 | procedure TfrmPtSelDemog.FormCreate(Sender: TObject); | 
|---|
| 137 | begin | 
|---|
| 138 | FOldWinProc := orapnlMain.WindowProc; | 
|---|
| 139 | orapnlMain.WindowProc := NewWinProc; | 
|---|
| 140 | end; | 
|---|
| 141 |  | 
|---|
| 142 | procedure TfrmPtSelDemog.NewWinProc(var Message: TMessage); | 
|---|
| 143 | const | 
|---|
| 144 | Gap = 4; | 
|---|
| 145 |  | 
|---|
| 146 | begin | 
|---|
| 147 | if(assigned(FOldWinProc)) then FOldWinProc(Message); | 
|---|
| 148 | if(Message.Msg = WM_Size) then | 
|---|
| 149 | begin | 
|---|
| 150 | if(lblPtSSN.Left < (lblSSN.Left+lblSSN.Width+Gap)) then | 
|---|
| 151 | lblPtSSN.Left := (lblSSN.Left+lblSSN.Width+Gap); | 
|---|
| 152 | if(lblPtDOB.Left < (lblDOB.Left+lblDOB.Width+Gap)) then | 
|---|
| 153 | lblPtDOB.Left := (lblDOB.Left+lblDOB.Width+Gap); | 
|---|
| 154 | if(lblPtSSN.Left < lblPtDOB.Left) then | 
|---|
| 155 | lblPtSSN.Left := lblPtDOB.Left | 
|---|
| 156 | else | 
|---|
| 157 | lblPtDOB.Left := lblPtSSN.Left; | 
|---|
| 158 |  | 
|---|
| 159 | if(lblPtLocation.Left < (lblLocation.Left+lblLocation.Width+Gap)) then | 
|---|
| 160 | lblPtLocation.Left := (lblLocation.Left+lblLocation.Width+Gap); | 
|---|
| 161 | if(lblPtRoomBed.Left < (lblRoomBed.Left+lblRoomBed.Width+Gap)) then | 
|---|
| 162 | lblPtRoomBed.Left := (lblRoomBed.Left+lblRoomBed.Width+Gap); | 
|---|
| 163 | if(lblPtLocation.Left < lblPtRoomBed.Left) then | 
|---|
| 164 | lblPtLocation.Left := lblPtRoomBed.Left | 
|---|
| 165 | else | 
|---|
| 166 | lblPtRoomBed.Left := lblPtLocation.Left; | 
|---|
| 167 | end; | 
|---|
| 168 | end; | 
|---|
| 169 |  | 
|---|
| 170 | procedure TfrmPtSelDemog.FormDestroy(Sender: TObject); | 
|---|
| 171 | begin | 
|---|
| 172 | orapnlMain.WindowProc := FOldWinProc; | 
|---|
| 173 | end; | 
|---|
| 174 |  | 
|---|
| 175 | end. | 
|---|