source: cprs/branches/GUI-config/CreateTemplateU.pas@ 893

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

New WorldVistA Config Utility
File size: 15.8 KB
RevLine 
[476]1unit CreateTemplateU;
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;
32
33type
34 TCreateTemplateForm = class(TForm)
35 BottomPanel: TPanel;
36 TopPanel: TPanel;
37 TemplateGrid: TStringGrid;
38 btnCancel: TBitBtn;
39 btnSave: TBitBtn;
40 Label1: TLabel;
41 btnOpen: TBitBtn;
42 btnAddField: TBitBtn;
43 cboAddField: TComboBox;
44 cboRemoveField: TComboBox;
45 btnDelField: TBitBtn;
46 btnDone: TBitBtn;
47 SaveDialog: TSaveDialog;
48 OpenDialog: TOpenDialog;
49 btnClear: TBitBtn;
50 procedure FormCreate(Sender: TObject);
51 procedure FormDestroy(Sender: TObject);
52 procedure btnAddFieldClick(Sender: TObject);
53 procedure btnDelFieldClick(Sender: TObject);
54 procedure btnSaveClick(Sender: TObject);
55 procedure btnOpenClick(Sender: TObject);
56 procedure btnClearClick(Sender: TObject);
57 procedure btnDoneClick(Sender: TObject);
58 private
59 { Private declarations }
60 BlankList : TStringList;
61 RequiredList, FieldsList : TStringList;
62 FFileNum : String;
63 FModified : boolean;
64 procedure LoadGrid(ReqList,FieldsList : TStringList);
65 procedure PrepLists(BlankList,ReqList,FieldsList : TStringList);
66 procedure LoadCombos(FieldsList : TStringList);
67 procedure AddRow(oneEntry : string; Fixed : boolean);
68 function MakeOneEntry(fldName,fldNum : string) : string;
69 procedure LoadTemplate(fileName : string);
70 procedure ClearGrid;
71 procedure ClearComboBoxes;
72 procedure MoveAddListToDelList(oneEntry : string);
73 function DoSaveClick : TModalResult;
74 public
75 { Public declarations }
76 procedure PrepForm (FileNum : String);
77 procedure GetNumName(oneEntry : string; var fldName,fldNum : string);
78 end;
79
80var
81 CreateTemplateForm: TCreateTemplateForm;
82
83implementation
84
85{$R *.dfm}
86 uses
87 SubFilesU, ORNet, ORFn, MainU, StrUtils;
88
89 procedure TCreateTemplateForm.PrepForm (FileNum : String);
90 begin
91 FFileNum := FileNum;
92 ClearComboBoxes;
93 PrepLists(BlankList,RequiredList,FieldsList);
94 LoadGrid(RequiredList,FieldsList);
95 LoadCombos(FieldsList);
96 FModified := false;
97 end;
98
99
100 procedure TCreateTemplateForm.ClearComboBoxes;
101 begin;
102 cboAddField.Items.Clear;
103 cboAddField.Text := '';
104 cboRemoveField.Items.Clear;
105 cboRemoveField.Text := '';
106 end;
107
108
109 procedure TCreateTemplateForm.PrepLists(BlankList,ReqList,FieldsList : TStringList);
110 var i,j : integer;
111 oneEntry : string;
112 fldName,fldNum,fldCodes : string;
113 tempS : string;
114 reqField : boolean;
115 begin
116 if BlankList.Count=0 then begin
117 MainForm.GetBlankFileInfo(FFileNum, BlankList); //returns: FileNum^^FieldNum^^FieldName^More DDInfo
118 end;
119 ReqList.Clear;
120 FieldsList.Clear;
121
122 //---- note: for now I am going to hard code the required fields in. ------
123 ReqList.Add('.01^'); //NAME
124 ReqList.Add('.02^'); //SEX
125 ReqList.Add('.03^'); //DOB
126 ReqList.Add('.09^'); //SSN
127 ReqList.Add('0^'); //A 'pseudoField', for use with Health Record number
128 ReqList.Add('.301^^NO'); //SERVICE CONNECTED? default should be NO
129 ReqList.Add('391^^NON-VETERAN (OTHER)'); //TYPE default should be NON-VETERAN (OTHER)
130 ReqList.Add('994^^NO'); //MULTIPLE BIRTH INDICATOR default should be NO
131 ReqList.Add('1901^^NO'); //VETERAN (Y/N)? default should be NO
132
133 for i:= 0 to BlankList.Count-1 do begin
134 oneEntry := BlankList.Strings[i];
135 if oneEntry = '1^Success' then begin //substitute status line with pseudoField, HRN
136 oneEntry:='^^0^^Health Record Number (HRN)^F'
137 end;
138 fldName := piece(oneEntry,'^',5);
139 fldNum := piece(oneEntry,'^',3);
140 fldCodes := piece(oneEntry,'^',6);
141 reqField := false;
142 for j := 0 to ReqList.Count-1 do begin
143 if Pos(fldNum+'^',ReqList.Strings[j])=1 then begin
144 tempS := ReqList.Strings[j];
145 SetPiece(tempS,'^',2,fldName);
146 ReqList.Strings[j] := tempS;
147 reqField := true;
148 break;
149 end;
150 end;
151 if reqField then continue;
152 if Pos('C',fldCodes)>0 then continue; //computed
153 if Pos('P',fldCodes)>0 then continue; //pointer to file
154 if MainForm.IsSubFile(fldCodes,tempS) then continue; //no subfiles (including WP fields)
155 if Pos('I',fldCodes)>0 then continue; //marked uneditable.
156
157 FieldsList.Add(fldNum+'^'+fldName);
158 end;
159 end;
160
161 procedure TCreateTemplateForm.LoadGrid(ReqList,FieldsList : TStringList);
162 var i : integer;
163 oneEntry : string;
164 begin
165 ClearGrid;
166 for i := 0 to ReqList.Count-1 do begin
167 oneEntry := ReqList.Strings[i];
168 AddRow(oneEntry,true);
169 end;
170 end;
171
172 procedure TCreateTemplateForm.ClearGrid;
173 begin
174 TemplateGrid.FixedCols := 0;
175 TemplateGrid.FixedRows := 1;
176 TemplateGrid.RowCount := 2;
177 TemplateGrid.Cells[0,0] := 'NAME:';
178 TemplateGrid.Cells[1,0] := 'NUMBER:';
179 TemplateGrid.Cells[2,0] := 'DEFAULT:';
180 TemplateGrid.Cells[0,1] := '';
181 TemplateGrid.Cells[1,1] := '';
182 TemplateGrid.Cells[2,1] := '';
183 TemplateGrid.ColWidths[0] := 300;
184 TemplateGrid.ColWidths[1] := 100;
185 TemplateGrid.ColWidths[0] := 300;
186// TemplateGrid
187 end;
188
189 procedure TCreateTemplateForm.AddRow(oneEntry : string; Fixed : boolean);
190 //oneEntry format: fldNum^fldName
191 //optional format: fldNum^fldName^DefaultValue
192 var i,j : integer;
193 fldName,fldNum : string;
194 defaultValue : string;
195 begin
196 GetNumName(oneEntry,fldName,fldNum);
197 defaultValue := piece(oneEntry,'^',3);
198 //Add : ensure row doesn't already exist;
199 for j := 0 to TemplateGrid.RowCount-1 do begin
200 if TemplateGrid.Cells[1,j] = fldNum then exit;
201 end;
202
203 i := TemplateGrid.RowCount-1;
204 if TemplateGrid.Cells[0,i] <> '' then begin
205 TemplateGrid.RowCount := TemplateGrid.RowCount + 1;
206 end;
207 i := TemplateGrid.RowCount-1;
208
209 TemplateGrid.Cells[0,i] := fldName;
210 TemplateGrid.Cells[1,i] := fldNum;
211 TemplateGrid.Cells[2,i] := defaultValue;
212 end;
213
214 procedure TCreateTemplateForm.LoadCombos(FieldsList : TStringList);
215 var i : integer;
216 oneEntry : string;
217 fldName,fldNum : string;
218 begin
219 cboAddField.Items.clear;
220 for i := 0 to FieldsList.Count-1 do begin
221 oneEntry := FieldsList.Strings[i];
222 GetNumName(oneEntry,fldName,fldNum);
223 cboAddField.Items.Add(MakeOneEntry(fldName,fldNum));
224 end;
225 cboAddField.ItemIndex := 0;
226 end;
227
228
229 procedure TCreateTemplateForm.FormCreate(Sender: TObject);
230 begin
231 BlankList := TStringList.create;
232 RequiredList := TStringList.create;
233 FieldsList := TStringList.create;
234 ClearGrid;
235 end;
236
237 procedure TCreateTemplateForm.FormDestroy(Sender: TObject);
238 begin
239 BlankList.Free;
240 RequiredList.Free;
241 FieldsList.Free;
242 end;
243
244 procedure TCreateTemplateForm.btnAddFieldClick(Sender: TObject);
245 var i : integer;
246 oneEntry,tempEntry : string;
247 fldName,fldNum : string;
248 exists: boolean;
249 begin
250 FModified := true;
251 oneEntry := cboAddField.Text;
252 if oneEntry = '' then exit;
253 GetNumName(oneEntry,fldName,fldNum);
254 if (fldNum = '') or (fldName = '') then exit;
255 tempEntry := fldNum + '^' + fldName;
256 //Add : ensure row doesn't already exist;
257 exists := false;
258 for i := 0 to TemplateGrid.RowCount-1 do begin
259 if TemplateGrid.Cells[1,i] = fldNum then begin
260 exists := true;
261 break;
262 end;
263 end;
264 if not exists then begin
265 AddRow(tempEntry,false);
266 MoveAddListToDelList(tempEntry);
267 end;
268 end;
269
270
271 procedure TCreateTemplateForm.MoveAddListToDelList(oneEntry : string);
272 //Move entry from Add list to delete list.
273 var i : integer;
274 fldName,fldNum : string;
275 tempEntry : string;
276 begin
277 GetNumName(oneEntry,fldName,fldNum);
278 tempEntry := MakeOneEntry(fldName,fldNum);
279 i := cboAddField.Items.IndexOf(tempEntry);
280 if i > -1 then cboAddField.Items.Delete(i);
281 if i < cboAddField.Items.Count then cboAddField.ItemIndex := i
282 else cboAddField.ItemIndex := cboAddField.Items.Count-1;
283 //if cboAddField.Items.Count > 0 then cboAddField.ItemIndex := 0 else cboAddField.ItemIndex := -1;
284
285 cboRemoveField.Items.Add(tempEntry);
286 cboRemoveField.ItemIndex := cboRemoveField.Items.Count - 1;
287 end;
288
289
290 procedure TCreateTemplateForm.GetNumName(oneEntry : string; var fldName,fldNum : string);
291 begin
292 if Pos('^',oneEntry)>0 then begin
293 fldNum := piece(oneEntry,'^',1);
294 fldName := piece(oneEntry,'^',2);
295 end else begin
296 fldNum := piece(oneEntry,'{',2);
297 fldNum := piece(fldNum,'}',1);
298 fldName := piece(oneEntry,'{',1);
299 fldName := Trim(fldName);
300 end;
301 end;
302
303 function TCreateTemplateForm.MakeOneEntry(fldName,fldNum : string) : string;
304 begin
305 result := fldName+' {'+fldNum+'}';
306 end;
307
308 procedure TCreateTemplateForm.btnDelFieldClick(Sender: TObject);
309 var
310 i : integer;
311 oneEntry : string;
312 fldName,fldNum : string;
313 delRow : integer;
314 begin
315 oneEntry := cboRemoveField.Text;
316 GetNumName(oneEntry,fldName,fldNum);
317 if fldNum = '' then exit;
318 delRow := -1;
319 for i := 1 to TemplateGrid.RowCount-1 do begin
320 if TemplateGrid.Cells[1,i] = fldNum then begin
321 delRow := i;
322 break;
323 end;
324 end;
325 if delRow = -1 then exit;
326 i := cboRemoveField.Items.IndexOf(oneEntry);
327 if i > -1 then cboRemoveField.Items.Delete(i);
328 cboRemoveField.ItemIndex := cboRemoveField.Items.Count - 1;
329 cboAddField.Items.Insert(0,oneEntry);
330 cboAddField.ItemIndex := 0;
331 for i := delRow to TemplateGrid.RowCount-2 do begin
332 TemplateGrid.Cells[0,i] := TemplateGrid.Cells[0,i+1];
333 TemplateGrid.Cells[1,i] := TemplateGrid.Cells[1,i+1];
334 end;
335 TemplateGrid.RowCount := TemplateGrid.RowCount -1;
336 end;
337
338 procedure TCreateTemplateForm.btnSaveClick(Sender: TObject);
339 begin
340 DoSaveClick;
341 MessageDlg('You have created an empty registration Template.'+#10+#13+
342 'Now you should EDIT IT with your favorite spreadsheet '+#10+#13+
343 'application (such as Microsoft Excel, or Open Office,) '+#10+#13+
344 'filling it with patient demographic data.'+#10+#13+
345 #10+#13+
346 'Hint #1: try just a few patients initially, to make sure'+#10+#13+
347 ' that all is working properly. Built in safeguards will'+#10+#13+
348 ' prevent duplicate registrations on subsequent runs.'+#10+#13+
349 #10+#13 {+
350 'Hint #2: Open Office tends to format the field number (e.g. ".01")'+#10+#13+
351 ' as a decimal, and converts it to '0.01'. This will prevent'+#10+#13+
352 ' successful upload. In general field numbers do NOT have a "0"'+#10+#13+
353 ' before a decimal (".")'
354 }
355 ,mtInformation,[mbOK],0);
356 end;
357
358 function TCreateTemplateForm.DoSaveClick : TModalResult;
359 var TemplateLines : TStringList;
360 row : integer;
361 Line1,Line2,SampleLine : string;
362 begin
363 Line1 := 'Field NAME:';
364 Line2 := 'Field NUMBER:';
365 SampleLine := 'Put a patient''s data on this row -->';
366 If SaveDialog.Execute then begin
367 TemplateLines := TStringList.Create;
368 for row := 1 to TemplateGrid.RowCount-2 do begin
369 Line1 := Line1 + #9 + '"' + TemplateGrid.Cells[0,row] + '"';
370 Line2 := Line2 + #9 + '"<'+TemplateGrid.Cells[1,row]+'>"';
371 SampleLine := SampleLine + #9 + '"' + TemplateGrid.Cells[2,row] + '"';
372 end;
373 TemplateLines.Add(Line1);
374 TemplateLines.Add(Line2);
375 TemplateLines.Add(SampleLine);
376 TemplateLines.Add(SampleLine);
377 TemplateLines.Add(SampleLine);
378 TemplateLines.Add('etc... (As many rows as needed)');
379 TemplateLines.Add(' ');
380 TemplateLines.Add('When done, save file and import with');
381 TemplateLines.Add(' the WorldVista Config Utility.');
382 TemplateLines.Add('Save in CSV format, using TAB as field');
383 TemplateLines.Add(' delimiter, and " as text delimiter.');
384 TemplateLines.SaveToFile(SaveDialog.FileName);
385 TemplateLines.Free;
386 Result := mrOK;
387 FModified := false;
388 end else begin
389 Result := mrCancel;
390 end;
391 end;
392
393 procedure TCreateTemplateForm.btnOpenClick(Sender: TObject);
394 begin
395 if OpenDialog.Execute then begin
396 LoadTemplate(OpenDialog.FileName);
397 end;
398 end;
399
400 procedure TCreateTemplateForm.LoadTemplate(fileName : string);
401 var Lines: TStringList;
402 Line1List,Line2List : TStringList;
403 oneLine : string;
404 i : integer;
405 fldName,fldNum : string;
406 oneEntry : string;
407 begin
408 Lines := TStringList.Create;
409 Line1List := TStringList.Create;
410 Line2List := TStringList.Create;
411 Lines.LoadFromFile(fileName);
412 if Lines.Count < 2 then begin
413 MessageDlg('Template file has less than 2 lines.'+#10+#13+
414 'Doesn''t appear to be valid template.', mtError,[mbOK],0);
415 exit;
416 end;
417 ClearGrid;
418 oneLine := Lines.Strings[0];
419 PiecesToList(oneLine, #9, Line1List);
420 oneLine := Lines.Strings[1];
421 PiecesToList(oneLine, #9, Line2List);
422 for i := 1 to Line1List.Count-1 do begin
423 fldName := Line1List.Strings[i];
424 if i < Line2List.Count then begin
425 fldNum := Line2List.Strings[i];
426 fldNum := AnsiReplaceStr(fldNum,'"<','');
427 fldNum := AnsiReplaceStr(fldNum,'>"','');
428 end else begin
429 fldNum := '??';
430 end;
431 oneEntry := fldNum+'^'+fldName;
432 AddRow(oneEntry,false);
433 MoveAddListToDelList(oneEntry);
434 end;
435 Lines.Free;
436 Line1List.Free;
437 Line2List.Free;
438 end;
439
440 procedure TCreateTemplateForm.btnClearClick(Sender: TObject);
441 begin
442 //add confirmation box.
443 if MessageDlg('Erase All Current Fields?',mtConfirmation,mbOKCancel,0) = mrOK then begin
444 PrepForm (FFileNum);
445 end;
446 end;
447
448 procedure TCreateTemplateForm.btnDoneClick(Sender: TObject);
449 var tempModal : TModalResult;
450 begin
451 if FModified then begin
452 tempModal := MessageDlg('Save Template Before Leaving?',mtConfirmation,mbYesNoCancel,0);
453 end else begin
454 tempModal := mrNo;
455 end;
456 case tempModal of
457 mrYes : begin
458 tempModal := DoSaveClick;
459 if tempModal = mrOK then ModalResult := mrOK;
460 //if tempModal = mrCancel, then do nothing.
461 end;
462 mrNo : ModalResult := mrOK;
463 mrCancel : // do nothing.
464 end; {case}
465 end;
466
467end.
468
Note: See TracBrowser for help on using the repository browser.