source: cprs/branches/foia-cprs/CPRS-Chart/Encounter/fGAF.pas@ 1154

Last change on this file since 1154 was 459, checked in by Kevin Toppenberg, 16 years ago

Adding foia-cprs branch

File size: 5.1 KB
RevLine 
[459]1unit fGAF;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 fPCEBase, StdCtrls, Buttons, ExtCtrls, Grids, ORFn, ORNet, ORCtrls,
8 ORDtTm, ComCtrls, fPCEBaseGrid, Menus;
9
10type
11 TfrmGAF = class(TfrmPCEBaseGrid)
12 lblGAF: TStaticText;
13 edtScore: TCaptionEdit;
14 udScore: TUpDown;
15 dteGAF: TORDateBox;
16 lblEntry: TStaticText;
17 lblScore: TLabel;
18 lblDate: TLabel;
19 lblDeterminedBy: TLabel;
20 cboGAFProvider: TORComboBox;
21 btnURL: TButton;
22 Spacer1: TLabel;
23 Spacer2: TLabel;
24 procedure cboGAFProviderNeedData(Sender: TObject; const StartFrom: String;
25 Direction, InsertAt: Integer);
26 procedure edtScoreChange(Sender: TObject);
27 procedure dteGAFExit(Sender: TObject);
28 procedure cboGAFProviderExit(Sender: TObject);
29 procedure FormActivate(Sender: TObject);
30 procedure FormShow(Sender: TObject);
31 procedure btnURLClick(Sender: TObject);
32 procedure FormCreate(Sender: TObject);
33 private
34 FDataLoaded: boolean;
35 procedure LoadScores;
36 function BADData(ShowMessage: boolean): boolean;
37 public
38 procedure AllowTabChange(var AllowChange: boolean); override;
39 procedure GetGAFScore(var Score: integer; var Date: TFMDateTime; var Staff: Int64);
40 end;
41
42function ValidGAFData(Score: integer; Date: TFMDateTime; Staff: Int64): boolean;
43
44var
45 frmGAF: TfrmGAF;
46
47implementation
48
49uses rPCE, rCore, uCore, uPCE, fEncounterFrame;
50
51{$R *.DFM}
52
53function ValidGAFData(Score: integer; Date: TFMDateTime; Staff: Int64): boolean;
54begin
55 if(Score < 1) or (Score > 100) or (Date <= 0) or (Staff = 0) then
56 Result := FALSE
57 else
58 Result := ((Patient.DateDied <= 0) or (Date <= Patient.DateDied));
59end;
60
61procedure TfrmGAF.LoadScores;
62var
63 i: integer;
64 tmp: string;
65
66begin
67 RecentGafScores(3);
68 if(RPCBrokerV.Results.Count > 0) and (RPCBrokerV.Results[0] = '[DATA]') then
69 begin
70 for i := 1 to RPCBrokerV.Results.Count-1 do
71 begin
72 tmp := RPCBrokerV.Results[i];
73 lbGrid.Items.Add(Piece(tmp,U,5) + U + Piece(Piece(tmp,U,2),NoPCEValue,1) + U +
74 Piece(tmp,U,7) + U + Piece(tmp,U,8));
75 end;
76 end;
77 if(lbGrid.Items.Count > 0) then
78 SyncGridData
79 else
80 lbGrid.Items.Add('No GAF scores found.');
81end;
82
83procedure TfrmGAF.cboGAFProviderNeedData(Sender: TObject;
84 const StartFrom: String; Direction, InsertAt: Integer);
85begin
86 inherited;
87 cboGAFProvider.ForDataUse(SubSetOfPersons(StartFrom, Direction));
88end;
89
90function TfrmGAF.BADData(ShowMessage: boolean): boolean;
91var
92 PName, msg: string;
93 GAFDate: TFMDateTime;
94 UIEN: Int64;
95
96begin
97 GAFDate := dteGAF.FMDateTime;
98 msg := ValidateGAFDate(GAFDate);
99 if(dteGAF.FMDateTime <> GAFDate) then
100 dteGAF.FMDateTime := GAFDate;
101
102 if(cboGAFProvider.ItemID = '') then
103 begin
104 if(msg <> '') then
105 msg := msg + CRLF;
106 msg := msg + 'A determining party is required to enter a GAF score.';
107 UIEN := uProviders.PCEProvider;
108 if(UIEN <> 0) then
109 begin
110 PName := uProviders.PCEProviderName;
111 msg := msg + ' Determined By changed to ' + PName + '.';
112 cboGAFProvider.SelectByIEN(UIEN);
113 if(cboGAFProvider.ItemID = '') then
114 begin
115 cboGAFProvider.InitLongList(PName);
116 cboGAFProvider.SelectByIEN(UIEN);
117 end;
118 end;
119 end;
120
121 if(ShowMessage and (msg <> '')) then
122 InfoBox(msg, 'Invalid GAF Data', MB_OK);
123
124 if(udScore.Position > udScore.Min) then
125 Result := (msg <> '')
126 else
127 Result := FALSE;
128end;
129
130procedure TfrmGAF.edtScoreChange(Sender: TObject);
131var
132 i: integer;
133
134begin
135 inherited;
136 i := StrToIntDef(edtScore.Text,udScore.Min);
137 if(i < udScore.Min) or (i > udScore.Max) then
138 i := udScore.Min;
139 udScore.Position := i;
140 edtScore.Text := IntToStr(i);
141 edtScore.SelStart := length(edtScore.Text);
142end;
143
144procedure TfrmGAF.dteGAFExit(Sender: TObject);
145begin
146 inherited;
147// BadData(TRUE);
148end;
149
150procedure TfrmGAF.cboGAFProviderExit(Sender: TObject);
151begin
152 inherited;
153 BadData(TRUE);
154end;
155
156procedure TfrmGAF.AllowTabChange(var AllowChange: boolean);
157begin
158 AllowChange := (not BadData(TRUE));
159end;
160
161procedure TfrmGAF.GetGAFScore(var Score: integer; var Date: TFMDateTime; var Staff: Int64);
162begin
163 Score := udScore.Position;
164 if(Score > 0) then BadData(TRUE);
165 Date := dteGAF.FMDateTime;
166 Staff := cboGAFProvider.ItemIEN;
167 if(not ValidGAFData(Score, Date, Staff)) then
168 begin
169 Score := 0;
170 Date := 0;
171 Staff := 0
172 end;
173end;
174
175procedure TfrmGAF.FormActivate(Sender: TObject);
176begin
177 inherited;
178 if(not FDataLoaded) then
179 begin
180 FDataLoaded := TRUE;
181 LoadScores;
182 cboGAFProvider.InitLongList(Encounter.ProviderName);
183 BadData(FALSE);
184 end;
185end;
186
187procedure TfrmGAF.FormShow(Sender: TObject);
188begin
189 inherited;
190 FormActivate(Sender);
191end;
192
193procedure TfrmGAF.btnURLClick(Sender: TObject);
194begin
195 inherited;
196 GotoWebPage(GAFURL);
197end;
198
199procedure TfrmGAF.FormCreate(Sender: TObject);
200begin
201 inherited;
202 FTabName := CT_GAFNm;
203 btnURL.Visible := (User.WebAccess and (GAFURL <> ''));
204end;
205
206end.
Note: See TracBrowser for help on using the repository browser.