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