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

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

New WorldVistA Config Utility

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
42 ORNet, ORFn, ORCtrls, Trpcb, FMErrorU, StrUtils;
43
44 procedure TPostForm.PrepForm(Changes : TStringList);
45 begin
46 FChanges.Clear;
47 FChanges.Assign(Changes);
48 LoadGrid(Changes);
49 end;
50
51 procedure TPostForm.LoadGrid(Changes : TStringList);
52 //Changes format:
53 // FileNum^IENS^FieldNum^FieldName^newValue^oldValue
54
55 var i : integer;
56 oneEntry : String;
57 fieldNum,
58 newValue : string;
59 begin
60 Grid.Cells[0,0] := 'File #';
61 Grid.ColWidths[0] := 35;
62
63 Grid.Cells[1,0] := 'Rec #';
64 Grid.ColWidths[1] := 35;
65
66 Grid.Cells[2,0] := 'Field';
67 Grid.ColWidths[2] := 125;
68
69 Grid.Cells[3,0] := 'Prior Value';
70 Grid.ColWidths[3] := 250;
71
72 Grid.Cells[4,0] := 'New Value';
73 Grid.ColWidths[4] := 250;
74
75 NewValue01 := ''; //default to no change;
76
77 Grid.RowCount := Changes.Count+1;
78 for i := 0 to Changes.Count-1 do begin
79 oneEntry := Changes.Strings[i];
80 fieldNum := Piece(OneEntry,'^',4);
81 newValue := Piece(OneEntry,'^',5);
82 Grid.Cells[0,i+1] := Piece(OneEntry,'^',1); //File Num
83 Grid.Cells[1,i+1] := Piece(OneEntry,'^',2); //IENS
84 Grid.Cells[2,i+1] := fieldNum; //Field
85 Grid.Cells[3,i+1] := Piece(OneEntry,'^',6); //Old Value
86 Grid.Cells[4,i+1] := newValue; //New Value
87 if fieldNum = '.01' then begin
88 NewValue01 := newValue;
89 end;
90 end;
91 end;
92
93 procedure TPostForm.PostBtnClick(Sender: TObject);
94 var RPCResult : string;
95 i : integer;
96 begin
97 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
98 RPCBrokerV.Param[0].Value := '.X'; // not used
99 RPCBrokerV.param[0].ptype := list;
100 RPCBrokerV.Param[0].Mult['"REQUEST"'] := 'POST DATA';
101 RPCBrokerV.Param[0].Mult.Sorted := false;
102 for i := 0 to FChanges.Count-1 do begin
103 // FileNum^IENS^FieldNum^FieldName^newValue^oldValue
104 RPCBrokerV.Param[0].Mult[IntToStr(i)] := FChanges.Strings[i];
105 end;
106 RPCBrokerV.Call;
107 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
108 if piece(RPCResult,'^',1)='1' then begin
109 PostResults.Assign(RPCBrokerV.Results);
110 end else begin
111 FMErrorForm.Memo.Text := RPCBrokerV.Results[1];
112 FMErrorForm.ShowModal;
113 ModalResult := mrNO; //signal error.
114 end;
115 end; //form will close here because of modalresult set for button
116
117 function TPostForm.GetNewIENS(oldIENS: string) : string;
118 //If posted data had IENS of +1 (or +5 etc) then there should be returned
119 //a new, actual, IENS in the database. This should be stored in PostResults
120 //in format of 4^1234, 2,4567 etc, for +4 --> converted to 1234, and +2 -->
121 //converted to 4567 etc.
122 //So this function will take input of +4, and return for example, 1234
123 //Or return '' if no match found.
124 var i : integer;
125 begin
126 result := '';
127 if Pos('+',oldIENS)=1 then begin
128 oldIENS := MidStr(oldIENS,2,999);
129 end;
130 if Pos(',',oldIENS)=length(oldIENS) then begin
131 oldIENS := MidStr(oldIENS,1,length(oldIENS)-1);
132 end;
133 for i := 0 to PostResults.Count-1 do begin
134 if piece(PostResults.Strings[i],'^',1)=oldIENS then begin
135 result := piece(PostResults.Strings[i],'^',2);
136 if result = 'Success' then result := '';
137 end;
138 end;
139 end;
140
141
142 procedure TPostForm.FormCreate(Sender: TObject);
143 begin
144 FChanges := TStringList.Create;
145 PostResults := TStringList.Create;
146 end;
147
148 procedure TPostForm.FormDestroy(Sender: TObject);
149 begin
150 FChanges.Free;
151 PostResults.Free;
152 end;
153
154 function TPostForm.SilentPost(Changes : TStringList) : TModalResult;
155 begin
156 FChanges.Clear;
157 FChanges.Assign(Changes);
158 PostBtnClick(self);
159 result := mrOK; //maybe later vary if there was a FM error...
160 end;
161
162 procedure TPostForm.CancelBtnClick(Sender: TObject);
163 begin
164 NewValue01 := '';
165 end;
166
167end.
168
Note: See TracBrowser for help on using the repository browser.