source: cprs/branches/tmg-cprs/CPRS-Chart/Encounter/fGAF.pas@ 1802

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

Initial upload of TMG-CPRS 1.0.26.69

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