source: cprs/branches/tmg-cprs/CPRS-Chart/TMG_Extra/PostU.pas@ 1328

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

update

File size: 4.9 KB
Line 
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,
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 CallBroker;
110 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
111 if piece(RPCResult,'^',1)='1' then begin
112 PostResults.Assign(RPCBrokerV.Results);
113 end else begin
114 FMErrorForm.Memo.Text := RPCBrokerV.Results[1];
115 FMErrorForm.ShowModal;
116 ModalResult := mrNO; //signal error.
117 end;
118 end; //form will close here because of modalresult set for button
119
120 function TPostForm.GetNewIENS(oldIENS: string) : string;
121 //If posted data had IENS of +1 (or +5 etc) then there should be returned
122 //a new, actual, IENS in the database. This should be stored in PostResults
123 //in format of 4^1234, 2,4567 etc, for +4 --> converted to 1234, and +2 -->
124 //converted to 4567 etc.
125 //So this function will take input of +4, and return for example, 1234
126 //Or return '' if no match found.
127 var i : integer;
128 begin
129 result := '';
130 if Pos('+',oldIENS)=1 then begin
131 oldIENS := MidStr(oldIENS,2,999);
132 end;
133 if Pos(',',oldIENS)=length(oldIENS) then begin
134 oldIENS := MidStr(oldIENS,1,length(oldIENS)-1);
135 end;
136 for i := 0 to PostResults.Count-1 do begin
137 if piece(PostResults.Strings[i],'^',1)=oldIENS then begin
138 result := piece(PostResults.Strings[i],'^',2);
139 if result = 'Success' then result := '';
140 end;
141 end;
142 end;
143
144
145 procedure TPostForm.FormCreate(Sender: TObject);
146 begin
147 FChanges := TStringList.Create;
148 PostResults := TStringList.Create;
149 end;
150
151 procedure TPostForm.FormDestroy(Sender: TObject);
152 begin
153 FChanges.Free;
154 PostResults.Free;
155 end;
156
157 function TPostForm.SilentPost(Changes : TStringList) : TModalResult;
158 begin
159 FChanges.Clear;
160 FChanges.Assign(Changes);
161 PostBtnClick(self);
162 result := mrOK; //maybe later vary if there was a FM error...
163 end;
164
165 procedure TPostForm.CancelBtnClick(Sender: TObject);
166 begin
167 NewValue01 := '';
168 end;
169
170end.
171
Note: See TracBrowser for help on using the repository browser.