| 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 |     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 | 
 | 
|---|
| 170 | end.
 | 
|---|
| 171 | 
 | 
|---|