1 | unit PostU;
|
---|
2 | (* WorldVistA Configuration Utility
|
---|
3 | (c) 8/2008. Released under LGPL
|
---|
4 | Programmed by Kevin Toppenberg, Eddie Hagood *)
|
---|
5 |
|
---|
6 | interface
|
---|
7 |
|
---|
8 | uses
|
---|
9 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
---|
10 | Dialogs, StdCtrls, Buttons, Grids, ExtCtrls;
|
---|
11 |
|
---|
12 | type
|
---|
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 |
|
---|
35 | var
|
---|
36 | PostForm: TPostForm;
|
---|
37 |
|
---|
38 | implementation
|
---|
39 |
|
---|
40 | {$R *.dfm}
|
---|
41 | uses
|
---|
42 | ORNet, ORFn, ORCtrls,
|
---|
43 | Trpcb, // needed for .ptype types
|
---|
44 | FMErrorU, StrUtils;
|
---|
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 |
|
---|
169 | end.
|
---|
170 |
|
---|