source: cprs/branches/GUI-config/BatchAddU.pas@ 491

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

New WorldVistA Config Utility
File size: 15.1 KB
RevLine 
[476]1unit BatchAddU;
2 (*
3 WorldVistA Configuration Utility
4 (c) 8/2008 Kevin Toppenberg
5 Programmed by Kevin Toppenberg, Eddie Hagood
6
7 Family Physicians of Greeneville, PC
8 1410 Tusculum Blvd, Suite 2600
9 Greeneville, TN 37745
10 kdtop@yahoo.com
11
12 This library is free software; you can redistribute it and/or
13 modify it under the terms of the GNU Lesser General Public
14 License as published by the Free Software Foundation; either
15 version 2.1 of the License, or (at your option) any later version.
16
17 This library is distributed in the hope that it will be useful,
18 but WITHOUT ANY WARRANTY; without even the implied warranty of
19 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 Lesser General Public License for more details.
21
22 You should have received a copy of the GNU Lesser General Public
23 License along with this library; if not, write to the Free Software
24 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
25 *)
26
27interface
28
29uses
30 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
31 Dialogs, StdCtrls, Buttons, Grids, ExtCtrls, ComCtrls;
32
33type
34 TBatchAddForm = class(TForm)
35 Panel1: TPanel;
36 Panel2: TPanel;
37 BatchGrid: TStringGrid;
38 btnCreateTemplate: TBitBtn;
39 btnOpenDataFile: TBitBtn;
40 btnDoRegistration: TBitBtn;
41 btnClearGrid: TBitBtn;
42 OpenDialog: TOpenDialog;
43 btnDone: TBitBtn;
44 ProgressBar: TProgressBar;
45 btnSaveGrid: TBitBtn;
46 btnAbortRegistration: TBitBtn;
47 SaveDialog: TSaveDialog;
48 procedure btnCreateTemplateClick(Sender: TObject);
49 procedure btnClearGridClick(Sender: TObject);
50 procedure btnOpenDataFileClick(Sender: TObject);
51 function LTrim(s,subStr : string): string;
52 function RTrim(s,subStr : string): string;
53 function Trim(s,subStr : string): string;
54 procedure FormClose(Sender: TObject; var Action: TCloseAction);
55 procedure FormCreate(Sender: TObject);
56 procedure btnDoRegistrationClick(Sender: TObject);
57 procedure FormDestroy(Sender: TObject);
58 procedure btnAbortRegistrationClick(Sender: TObject);
59 procedure btnSaveGridClick(Sender: TObject);
60 procedure BatchGridSetEditText(Sender: TObject; ACol, ARow: Integer;
61 const Value: String);
62 private
63 { Private declarations }
64 FieldNumList : TStringList;
65 FAbortRegistration : boolean;
66 procedure ClearGrid;
67 procedure LoadData(fileName : string);
68 procedure AddHeaderCol(oneEntry : string);
69 procedure GetColFieldNums(List : TStringList);
70 function GetOneRow(row : integer; ColFields : TStringList) : string;
71 function RegisterOne(oneRow : string; Log : TStringList) : string;
72 procedure DelGridRow(BatchGrid : TStringGrid; row : integer);
73 public
74 { Public declarations }
75 end;
76
77var
78 BatchAddForm: TBatchAddForm;
79
80implementation
81
82uses CreateTemplateU, StrUtils,ORNet, ORFn, Trpcb, FMErrorU;
83
84const NOT_ADDED='(Not Added)';
85 ADD_ROW='Add-->';
86 ALREADY_ADDED='(Already Registered)';
87{$R *.dfm}
88
89 procedure TBatchAddForm.ClearGrid;
90 begin
91 BatchGrid.ColCount := 2;
92 BatchGrid.RowCount := 3;
93 BatchGrid.Cells[0,0] := 'Field NAME';
94 BatchGrid.Cells[0,1] := 'Field NUM';
95 BatchGrid.Cells[0,2] := '';
96 BatchGrid.Cells[1,0] := '';
97 BatchGrid.Cells[1,1] := '';
98 BatchGrid.Cells[1,2] := '';
99 end;
100
101
102 procedure TBatchAddForm.btnCreateTemplateClick(Sender: TObject);
103 begin
104 CreateTemplateForm.PrepForm('2');
105 CreateTemplateForm.ShowModal;
106 end;
107
108 procedure TBatchAddForm.btnClearGridClick(Sender: TObject);
109 begin
110 if MessageDlg('Clear All Patients?',mtConfirmation,mbOKCancel,0) = mrOK then begin
111 ClearGrid;
112 btnSaveGrid.Enabled := false;
113 btnDoRegistration.Enabled := false;
114 btnClearGrid.Enabled := false;
115 btnCreateTemplate.Enabled := true;
116 btnOpenDataFile.Enabled := true;
117 end;
118 end;
119
120 procedure TBatchAddForm.btnOpenDataFileClick(Sender: TObject);
121 begin
122 if OpenDialog.Execute then begin
123 LoadData(OpenDialog.FileName);
124 btnClearGrid.Enabled := true;
125 btnDoRegistration.Enabled := true;
126 btnCreateTemplate.Enabled := false;
127 btnOpenDataFile.Enabled := false;
128 end;
129 end;
130
131 function TBatchAddForm.RTrim(s,subStr : string): string;
132 var p,subLen : integer;
133 begin
134 result := s;
135 p := Pos(subStr,s);
136 subLen := length(subStr);
137 if p <> length(s)-subLen+1 then exit;
138 result := MidStr(s,1, length(s)-subLen);
139 end;
140
141
142 function TBatchAddForm.LTrim(s,subStr : string): string;
143 var p,subLen : integer;
144 begin
145 result := s;
146 p := Pos(subStr,s);
147 subLen := length(subStr);
148 if p <> 1 then exit;
149 result := MidStr(s,subLen+1,999);
150 end;
151
152 function TBatchAddForm.Trim(s,subStr : string): string;
153 begin
154 result := LTrim(s,subStr);
155 result := RTrim(result,subStr);
156 end;
157
158
159 procedure TBatchAddForm.LoadData(fileName : string);
160 var Data: TStringList;
161 Line1List: TStringList;
162 oneLine : string;
163 value : string;
164 row,i,j : integer;
165 fldName,fldNum : string;
166 dataFound : boolean;
167 oneEntry : string;
168 begin
169 Data := TStringList.Create;
170 Line1List := TStringList.Create;
171 Data.LoadFromFile(fileName);
172 if Data.Count < 3 then begin
173 MessageDlg('Template file has less than 3 lines.'+#10+#13+
174 'Doesn''t appear to be valid template'+#10+#13+
175 'filled with patient data. Please fill '+#10+#13+
176 'with patient demographics first.', mtError,[mbOK],0);
177 exit;
178 end;
179 ClearGrid;
180 //------- set up header rows (name and number) ------------------
181 oneLine := Data.Strings[0];
182 PiecesToList(oneLine, #9, Line1List);
183 oneLine := Data.Strings[1];
184 PiecesToList(oneLine, #9, FieldNumList);
185 for i := 1 to Line1List.Count-1 do begin
186 fldName := Trim(Line1List.Strings[i],'"');
187 if i < FieldNumList.Count then begin
188 fldNum := LTrim(FieldNumList.Strings[i],'"<');
189 fldNum := RTrim(fldNum,'>"');
190 end else begin
191 fldNum := '??';
192 end;
193 oneEntry := fldNum+'^'+fldName;
194 AddHeaderCol(oneEntry);
195 end;
196 //--------- now load data ----------------------
197 dataFound := true;
198 for i := 2 to Data.Count-1 do begin
199 if dataFound then begin
200 if BatchGrid.RowCount = 3 then begin
201 if BatchGrid.Cells[0,2] <> '' then BatchGrid.RowCount := BatchGrid.RowCount + 1;
202 end else begin
203 BatchGrid.RowCount := BatchGrid.RowCount + 1;
204 end;
205 end;
206 row := BatchGrid.RowCount-1;
207 oneLine := Data.Strings[i];
208 PiecesToList(oneLine, #9, Line1List);
209 BatchGrid.Cells[0,row] := ADD_ROW;
210 dataFound := false; //don't advance line if data row is empty.
211 for j := 1 to Line1List.Count-1 do begin //don't use first column of data file
212 value := Line1List.Strings[j];
213 value := Trim(value,'"');
214 if FieldNumList.Strings[j]='"<.09>"' then begin
215 value := LTrim(value,'<');
216 value := RTrim(value,'>');
217 end;
218 if value <> '' then dataFound := true;
219 BatchGrid.Cells[j,row]:= value;
220 end;
221 if (dataFound = false) and (i = Data.Count-1) then begin
222 BatchGrid.RowCount := BatchGrid.RowCount - 1;
223 end;
224 end;
225 Data.Free;
226 Line1List.Free;
227 end;
228
229 procedure TBatchAddForm.AddHeaderCol(oneEntry : string);
230 //oneEntry format: fldNum^fldName
231 var i : integer;
232 fldName,fldNum : string;
233 begin
234 CreateTemplateForm.GetNumName(oneEntry,fldName,fldNum);
235 i := BatchGrid.ColCount-1;
236 if BatchGrid.Cells[i,0] <> '' then begin
237 BatchGrid.ColCount := BatchGrid.ColCount + 1;
238 end;
239 i := BatchGrid.ColCount-1;
240
241 BatchGrid.Cells[i,0] := fldName;
242 BatchGrid.Cells[i,1] := fldNum;
243 end;
244
245
246 procedure TBatchAddForm.FormClose(Sender: TObject; var Action: TCloseAction);
247 begin
248 {
249 if MessageDlg('Leave Batch Registration? (Later check to ensure data was saved)',mtConfirmation,mbOKCancel,0) = mrOK then begin
250 Action := caHide;
251 end else begin
252 Action := caNone;
253 end;
254 }
255 end;
256
257 procedure TBatchAddForm.FormCreate(Sender: TObject);
258 begin
259 FieldNumList := TStringList.Create;
260 end;
261
262
263 procedure TBatchAddForm.btnDoRegistrationClick(Sender: TObject);
264 var row : integer;
265 ColFields : TStringList;
266 onePostEntry : string;
267 newIEN : string;
268 Log : TStringList;
269 Success,Failure,PreExisting : integer;
270 begin
271 btnOpenDataFile.Enabled := false;
272 btnClearGrid.Enabled := true;
273 btnAbortRegistration.Enabled := True;
274 btnClearGrid.Enabled := False;
275 btnSaveGrid.Enabled := False;
276
277 Log := TStringList.Create;
278 Success := 0;
279 Failure := 0;
280 PreExisting := 0;
281 FMErrorForm.Memo.Lines.clear;
282 ColFields := TStringList.Create;
283 GetColFieldNums(ColFields);
284 ProgressBar.Max := BatchGrid.RowCount-1;
285 FAbortRegistration := false; //abort button can change this.
286 for row := 2 to BatchGrid.RowCount-1 do begin
287 if FAbortRegistration = true then break;
288 ProgressBar.Position := row;
289 onePostEntry := GetOneRow(row,ColFields);
290 newIEN := RegisterOne(onePostEntry,Log);
291 BatchGrid.Cells[0,row] := newIEN;
292 if newIEN = NOT_ADDED then inc(Failure)
293 else if newIEN = ALREADY_ADDED then inc(PreExisting)
294 else inc(Success);
295 Application.ProcessMessages;
296 end;
297 ProgressBar.Position := 0;
298 ColFields.free;
299 MessageDlg(IntToStr(Success)+' successful registrations, '+#10+#13+
300 IntToStr(PreExisting)+' Patients were already registered,'+#10+#13+
301 IntToStr(Failure)+' failures.',
302 mtInformation,[mbOK],0);
303 for row := BatchGrid.RowCount-1 downto 2 do begin
304 if (BatchGrid.Cells[0,row] <> NOT_ADDED)
305 and (BatchGrid.Cells[0,row] <> ADD_ROW) then begin
306 DelGridRow(BatchGrid,row);
307 end;
308 end;
309 if Log.Count>0 then begin
310 FMErrorForm.Memo.Lines.Assign(Log);
311 FMErrorForm.PrepMessage;
312 FMErrorForm.ShowModal;
313 end;
314 Log.Free;
315 if (BatchGrid.RowCount=3)and(BatchGrid.Cells[0,2]='') then begin
316 btnSaveGrid.Enabled := false;
317 btnDoRegistration.Enabled := false;
318 btnClearGrid.Enabled := false;
319 btnCreateTemplate.Enabled := true;
320 btnOpenDataFile.Enabled := true;
321 btnAbortRegistration.Enabled := true;
322 end else begin
323 btnClearGrid.Enabled := true;
324 btnSaveGrid.Enabled := true;
325 btnAbortRegistration.Enabled := false;
326 end;
327 end;
328
329 function TBatchAddForm.RegisterOne(oneRow : string; Log : TStringList) : string;
330 var RPCResult : string;
331 Msg : string;
332 i : integer;
333 begin
334 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
335 RPCBrokerV.param[0].ptype := list;
336 RPCBrokerV.Param[0].Mult['"REQUEST"'] := 'REGISTER PATIENT^'+oneRow;
337 RPCBrokerV.Call;
338 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
339 Msg := piece(RPCResult,'^',2);
340 result := piece(RPCResult,'^',3);
341 if result = '' then result := NOT_ADDED;
342 if piece(RPCResult,'^',1)='-1' then begin
343 if Msg='Patient already registered' then begin
344 result := ALREADY_ADDED;
345 exit;
346 end;
347 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
348 FMErrorForm.PrepMessage; //Does some clean up of the message format
349 //FMErrorForm.ShowModal; //later just put these in log...
350 Log.Add('-----------------------------------------------');
351 Log.Add('There was a problem with registering a patient.');
352 //Log.Add('This was the data sent to the server: ');
353 //Log.Add(' '+oneRow);
354 for i:= 0 to FMErrorForm.Memo.Lines.Count-1 do begin
355 Log.Add(FMErrorForm.Memo.Lines.Strings[i]);
356 end;
357 Log.Add(' ');
358 FMErrorForm.Memo.Lines.Clear;
359 if Msg='Success (but see message)' then exit;
360 result := NOT_ADDED;
361 end;
362 end;
363
364 procedure TBatchAddForm.DelGridRow(BatchGrid : TStringGrid; row : integer);
365 var col : integer;
366 begin
367 if row >= BatchGrid.RowCount then exit;
368 repeat
369 if row = BatchGrid.RowCount-1 then begin
370 if BatchGrid.RowCount=3 then begin
371 for col := 0 to BatchGrid.ColCount-1 do begin
372 BatchGrid.Cells[col,row] := '';
373 end;
374 end else begin
375 BatchGrid.RowCount := BatchGrid.RowCount-1;
376 end;
377 exit;
378 end;
379 for col := 0 to BatchGrid.ColCount-1 do begin
380 BatchGrid.Cells[col,row] := BatchGrid.Cells[col,row+1]
381 end;
382 inc(row);
383 until (1=0);
384 end;
385
386 procedure TBatchAddForm.FormDestroy(Sender: TObject);
387 begin
388 FieldNumList.Free;
389 end;
390
391 procedure TBatchAddForm.GetColFieldNums(List : TStringList);
392 var i : integer;
393 begin
394 List.Clear;
395 List.Add(''); //fill 0'th column will null
396 for i := 1 to BatchGrid.ColCount-1 do begin
397 List.Add(BatchGrid.Cells[i,1]);
398 end;
399 end;
400
401 function TBatchAddForm.GetOneRow(row : integer; ColFields : TStringList) : string;
402 //Output format: FldNum1^Value1^fldNum2^Value2^FldNum3^Value3...
403 var i : integer;
404 oneValue : string;
405 begin
406 result := '';
407 if row >= BatchGrid.RowCount then exit;
408 for i := 1 to BatchGrid.ColCount-1 do begin
409 result := result + ColFields.Strings[i]+'^'+BatchGrid.Cells[i,row]+'^';
410 end;
411 end;
412
413 procedure TBatchAddForm.btnAbortRegistrationClick(Sender: TObject);
414 begin
415 FAbortRegistration := true;
416 end;
417
418 procedure TBatchAddForm.btnSaveGridClick(Sender: TObject);
419 var DataLines : TStringList;
420 Value : string;
421 row,col : integer;
422 Line : string;
423 begin
424 If SaveDialog.Execute then begin
425 DataLines := TStringList.Create;
426 for row := 0 to BatchGrid.RowCount-1 do begin
427 Line := '';
428 for col := 0 to BatchGrid.ColCount-1 do begin
429 Value := BatchGrid.Cells[col,row];
430 if Value = ADD_ROW then Value := ' ';
431 if (row=1)or((BatchGrid.Cells[col,1]='.09')and(row<>0)) then begin
432 Value := '<'+Value+'>'; //protect field numbers as text
433 end;
434 Line := Line + '"'+Value+'"' + #9
435 end;
436 DataLines.Add(Line);
437 end;
438 DataLines.Add(' ');
439 DataLines.Add('Add as many rows as needed)');
440 DataLines.Add(' ');
441 DataLines.Add('When done, save file and import with');
442 DataLines.Add(' the WorldVista Config Utility.');
443 DataLines.Add('Save in CSV format, using TAB as field');
444 DataLines.Add(' delimiter, and " as text delimiter.');
445 DataLines.SaveToFile(SaveDialog.FileName);
446 DataLines.Free;
447 end;
448 end;
449
450 procedure TBatchAddForm.BatchGridSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String);
451 begin
452 btnSaveGrid.Enabled := true;
453 end;
454
455end.
456
Note: See TracBrowser for help on using the repository browser.