[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
|
---|
| 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 |
|
---|
| 167 | end.
|
---|
| 168 |
|
---|