source: cprs/branches/GUI-config/EditTextU.pas@ 488

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

New WorldVistA Config Utility

File size: 5.8 KB
Line 
1unit EditTextU;
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, ExtCtrls;
32
33type
34 TEditTextForm = class(TForm)
35 Panel1: TPanel;
36 Memo: TMemo;
37 RevertBtn: TBitBtn;
38 ApplyBtn: TBitBtn;
39 DoneBtn: TBitBtn;
40 procedure FormCreate(Sender: TObject);
41 procedure FormDestroy(Sender: TObject);
42 procedure RevertBtnClick(Sender: TObject);
43 procedure ApplyBtnClick(Sender: TObject);
44 procedure DoneBtnClick(Sender: TObject);
45 procedure MemoChange(Sender: TObject);
46 procedure FormHide(Sender: TObject);
47 procedure FormClose(Sender: TObject; var Action: TCloseAction);
48 private
49 { Private declarations }
50 FCachedText : TStringList;
51 FFileNum,FFieldNum,FIENS : String;
52 function GetWPField(FileNum,FieldNum,IENS : string) : TStringList;
53 procedure PostWPField(Lines: TStrings; FileNum,FieldNum,IENS : string);
54 public
55 { Public declarations }
56 procedure PrepForm(FileNum,FieldNum,IENS : string);
57 end;
58
59var
60 EditTextForm: TEditTextForm;
61
62implementation
63
64uses FMErrorU, ORNet, ORFn, Trpcb;
65
66{$R *.dfm}
67
68 procedure TEditTextForm.PrepForm(FileNum,FieldNum,IENS : string);
69 begin
70 FFileNum := FileNum;
71 FFieldNum := FieldNum;
72 FIENS := IENS;
73 Memo.Lines.Clear;
74 Memo.Lines.Assign(GetWPField(FileNum,FieldNum,IENS));
75 ApplyBtn.Enabled := false;
76 RevertBtn.Enabled := false;
77 end;
78
79 procedure TEditTextForm.FormCreate(Sender: TObject);
80 begin
81 FCachedText := TStringList.Create;
82
83 end;
84
85 procedure TEditTextForm.FormDestroy(Sender: TObject);
86 begin
87 FCachedText.Free;
88 end;
89
90
91 function TEditTextForm.GetWPField(FileNum,FieldNum,IENS : string) : TStringList;
92 var RPCResult: string;
93 cmd : string;
94 lastLine : string;
95 begin
96 FCachedText.clear;
97 RPCBrokerV.Results.Clear;
98 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
99 RPCBrokerV.param[0].ptype := list;
100 cmd := 'GET ONE WP FIELD^' + FileNum + '^' + FieldNum + '^' + IENS;
101 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
102 RPCBrokerV.Call;
103 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
104 if piece(RPCResult,'^',1)='-1' then begin
105 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
106 FMErrorForm.PrepMessage;
107 FMErrorForm.ShowModal;
108 end else begin
109 FCachedText.Assign(RPCBrokerV.Results);
110 FCachedText.Delete(0);
111 lastLine := FCachedText.Strings[FCachedText.Count-1];
112 //I can't figure out where these are coming from...
113 if (lastLine='WORD-PROCESSING') or (lastLine = 'POINTER')
114 or (lastLine='FREE TEXT') then begin
115 FCachedText.Delete(FCachedText.Count-1);
116 end;
117 end;
118 result := FCachedText;
119 end;
120
121
122 procedure TEditTextForm.PostWPField(Lines: TStrings; FileNum,FieldNum,IENS : string);
123 var RPCResult: string;
124 cmd : string;
125 lastLine : string;
126 i : integer;
127 begin
128 RPCBrokerV.Results.Clear;
129 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
130 RPCBrokerV.param[0].ptype := list;
131 cmd := 'POST WP FIELD^' + FileNum + '^' + FieldNum + '^' + IENS;
132 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
133 for i := 0 to Lines.Count-1 do begin
134 RPCBrokerV.Param[0].Mult['"' + IntToStr(i+1) + '"'] := Lines.Strings[i];
135 end;
136 RPCBrokerV.Call;
137 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
138 if piece(RPCResult,'^',1)='-1' then begin
139 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
140 FMErrorForm.PrepMessage;
141 FMErrorForm.ShowModal;
142 end else begin
143 FCachedText.Assign(Lines);
144 end;
145 end;
146
147
148 procedure TEditTextForm.RevertBtnClick(Sender: TObject);
149 begin
150 if MessageDlg('Abort editing changes and revert to original?',mtWarning,mbOKCancel,0) = mrOK then begin
151 Memo.Lines.Assign(FCachedText);
152 end;
153 end;
154
155 procedure TEditTextForm.ApplyBtnClick(Sender: TObject);
156 begin
157 if FCachedText.Text <> Memo.Lines.Text then begin
158 //MessageDlg('Here I will post changes',mtInformation,[mbOK],0);
159 PostWPField(Memo.Lines,FFileNum,FFieldNum,FIENS);
160 end;
161 ApplyBtn.Enabled := false;
162 RevertBtn.Enabled := false;
163 end;
164
165 procedure TEditTextForm.DoneBtnClick(Sender: TObject);
166 begin
167 ApplyBtnClick(self);
168 ModalResult := mrOK;
169 end;
170
171 procedure TEditTextForm.MemoChange(Sender: TObject);
172 begin
173 ApplyBtn.Enabled := true;
174 RevertBtn.Enabled := true;
175 end;
176
177 procedure TEditTextForm.FormHide(Sender: TObject);
178 begin
179 ApplyBtnClick(self);
180 end;
181
182 procedure TEditTextForm.FormClose(Sender: TObject; var Action: TCloseAction);
183 begin
184 ApplyBtnClick(self);
185 end;
186
187end.
188
Note: See TracBrowser for help on using the repository browser.