source: cprs/branches/tmg-cprs/CPRS-Chart/TMG_Extra/EditTextU.pas@ 1593

Last change on this file since 1593 was 793, checked in by Kevin Toppenberg, 14 years ago

update

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