| 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 |  | 
|---|