[476] | 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
|
---|
[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 |
|
---|
| 169 | end.
|
---|
| 170 |
|
---|