source: cprs/branches/GUI-config/PostU.pas@ 1719

Last change on this file since 1719 was 542, checked in by Kevin Toppenberg, 15 years ago

v1.1 Fixes Access/Verify code issues

File size: 4.9 KB
RevLine 
[476]1unit PostU;
2(* WorldVistA Configuration Utility
3 (c) 8/2008. Released under LGPL
4 Programmed by Kevin Toppenberg, Eddie Hagood *)
5
6interface
7
8uses
9 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
10 Dialogs, StdCtrls, Buttons, Grids, ExtCtrls;
11
12type
13 TPostForm = class(TForm)
14 Panel1: TPanel;
15 Grid: TStringGrid;
16 CancelBtn: TBitBtn;
17 PostBtn: TBitBtn;
18 procedure PostBtnClick(Sender: TObject);
19 procedure FormCreate(Sender: TObject);
20 procedure FormDestroy(Sender: TObject);
21 procedure CancelBtnClick(Sender: TObject);
22 private
23 { Private declarations }
24 FChanges : TStringList;
25 procedure LoadGrid(Changes : TStringList);
26 public
27 { Public declarations }
28 PostResults : TStringList;
29 NewValue01 : string;
30 procedure PrepForm(Changes : TStringList);
31 function SilentPost(Changes : TStringList) : TModalResult;
32 function GetNewIENS(oldIENS: string) : string;
33 end;
34
35var
36 PostForm: TPostForm;
37
38implementation
39
40{$R *.dfm}
41uses
[542]42 ORNet, ORFn, ORCtrls,
43 Trpcb, // needed for .ptype types
44 FMErrorU, StrUtils;
[476]45
46 procedure TPostForm.PrepForm(Changes : TStringList);
47 begin
48 FChanges.Clear;
49 FChanges.Assign(Changes);
50 LoadGrid(Changes);
51 end;
52
53 procedure TPostForm.LoadGrid(Changes : TStringList);
54 //Changes format:
55 // FileNum^IENS^FieldNum^FieldName^newValue^oldValue
56
57 var i : integer;
58 oneEntry : String;
59 fieldNum,
60 newValue : string;
61 begin
62 Grid.Cells[0,0] := 'File #';
63 Grid.ColWidths[0] := 35;
64
65 Grid.Cells[1,0] := 'Rec #';
66 Grid.ColWidths[1] := 35;
67
68 Grid.Cells[2,0] := 'Field';
69 Grid.ColWidths[2] := 125;
70
71 Grid.Cells[3,0] := 'Prior Value';
72 Grid.ColWidths[3] := 250;
73
74 Grid.Cells[4,0] := 'New Value';
75 Grid.ColWidths[4] := 250;
76
77 NewValue01 := ''; //default to no change;
78
79 Grid.RowCount := Changes.Count+1;
80 for i := 0 to Changes.Count-1 do begin
81 oneEntry := Changes.Strings[i];
82 fieldNum := Piece(OneEntry,'^',4);
83 newValue := Piece(OneEntry,'^',5);
84 Grid.Cells[0,i+1] := Piece(OneEntry,'^',1); //File Num
85 Grid.Cells[1,i+1] := Piece(OneEntry,'^',2); //IENS
86 Grid.Cells[2,i+1] := fieldNum; //Field
87 Grid.Cells[3,i+1] := Piece(OneEntry,'^',6); //Old Value
88 Grid.Cells[4,i+1] := newValue; //New Value
89 if fieldNum = '.01' then begin
90 NewValue01 := newValue;
91 end;
92 end;
93 end;
94
95 procedure TPostForm.PostBtnClick(Sender: TObject);
96 var RPCResult : string;
97 i : integer;
98 begin
99 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
100 RPCBrokerV.Param[0].Value := '.X'; // not used
101 RPCBrokerV.param[0].ptype := list;
102 RPCBrokerV.Param[0].Mult['"REQUEST"'] := 'POST DATA';
103 RPCBrokerV.Param[0].Mult.Sorted := false;
104 for i := 0 to FChanges.Count-1 do begin
105 // FileNum^IENS^FieldNum^FieldName^newValue^oldValue
106 RPCBrokerV.Param[0].Mult[IntToStr(i)] := FChanges.Strings[i];
107 end;
108 RPCBrokerV.Call;
109 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
110 if piece(RPCResult,'^',1)='1' then begin
111 PostResults.Assign(RPCBrokerV.Results);
112 end else begin
113 FMErrorForm.Memo.Text := RPCBrokerV.Results[1];
114 FMErrorForm.ShowModal;
115 ModalResult := mrNO; //signal error.
116 end;
117 end; //form will close here because of modalresult set for button
118
119 function TPostForm.GetNewIENS(oldIENS: string) : string;
120 //If posted data had IENS of +1 (or +5 etc) then there should be returned
121 //a new, actual, IENS in the database. This should be stored in PostResults
122 //in format of 4^1234, 2,4567 etc, for +4 --> converted to 1234, and +2 -->
123 //converted to 4567 etc.
124 //So this function will take input of +4, and return for example, 1234
125 //Or return '' if no match found.
126 var i : integer;
127 begin
128 result := '';
129 if Pos('+',oldIENS)=1 then begin
130 oldIENS := MidStr(oldIENS,2,999);
131 end;
132 if Pos(',',oldIENS)=length(oldIENS) then begin
133 oldIENS := MidStr(oldIENS,1,length(oldIENS)-1);
134 end;
135 for i := 0 to PostResults.Count-1 do begin
136 if piece(PostResults.Strings[i],'^',1)=oldIENS then begin
137 result := piece(PostResults.Strings[i],'^',2);
138 if result = 'Success' then result := '';
139 end;
140 end;
141 end;
142
143
144 procedure TPostForm.FormCreate(Sender: TObject);
145 begin
146 FChanges := TStringList.Create;
147 PostResults := TStringList.Create;
148 end;
149
150 procedure TPostForm.FormDestroy(Sender: TObject);
151 begin
152 FChanges.Free;
153 PostResults.Free;
154 end;
155
156 function TPostForm.SilentPost(Changes : TStringList) : TModalResult;
157 begin
158 FChanges.Clear;
159 FChanges.Assign(Changes);
160 PostBtnClick(self);
161 result := mrOK; //maybe later vary if there was a FM error...
162 end;
163
164 procedure TPostForm.CancelBtnClick(Sender: TObject);
165 begin
166 NewValue01 := '';
167 end;
168
169end.
170
Note: See TracBrowser for help on using the repository browser.