unit LookupU; (* WorldVistA Configuration Utility (c) 8/2008 Kevin Toppenberg Programmed by Kevin Toppenberg, Eddie Hagood Family Physicians of Greeneville, PC 1410 Tusculum Blvd, Suite 2600 Greeneville, TN 37745 kdtop@yahoo.com This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ORCtrls, Buttons; type TFieldLookupForm = class(TForm) ORComboBox: TORComboBox; OKBtn: TBitBtn; CancelBtn: TBitBtn; procedure ORComboBoxNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); procedure FormShow(Sender: TObject); procedure ORComboBoxDblClick(Sender: TObject); private { Private declarations } FFileNum : String; public { Public declarations } //procedure InitORComboBox(ORComboBox: TORComboBox; initValue : string); procedure PrepForm(FileNum,InitValue : string); function SubSetOfFile(FileNum: string; const StartFrom: string; Direction: Integer): TStrings; end; var FieldLookupForm: TFieldLookupForm; implementation uses ORNet, ORFn, Trpcb, //needed for .ptype types QControls, MainU; {$R *.dfm} procedure TFieldLookupForm.ORComboBoxNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); var Result : TStrings; begin Result := SubSetOfFile(FFileNum, StartFrom, Direction); TORComboBox(Sender).ForDataUse(Result); end; { procedure TFieldLookupForm.InitORComboBox(ORComboBox: TORComboBox; initValue : string); begin ORComboBox.Text := initValue; ORComboBox.InitLongList(initValue); if ORComboBox.Items.Count > 0 then begin ORComboBox.Text := Piece(ORComboBox.Items[0],'^',2); end else begin ORComboBox.Text := ''; end; end; } procedure TFieldLookupForm.PrepForm(FileNum,InitValue : string); begin FFileNum := FileNum; Self.Caption := 'Pick Entry from File # ' + FileNum; if (FileNum='200') and (InitValue='') then begin InitValue := MainForm.CurrentUserName; end; MainForm.InitORComboBox(ORComboBox,InitValue); end; function TFieldLookupForm.SubSetOfFile(FileNum: string; const StartFrom: string; Direction: Integer ): TStrings; { returns a pointer to a list of file entries (for use in a long list box) - The return value is a pointer to RPCBrokerV.Results, so the data must be used BEFORE the next broker call! } var cmd,RPCResult : string; begin RPCBrokerV.remoteprocedure := 'TMG CHANNEL'; RPCBrokerV.Param[0].Value := '.X'; // not used RPCBrokerV.param[0].ptype := list; cmd := 'FILE ENTRY SUBSET'; cmd := cmd + '^' + FileNum + '^' + StartFrom + '^' + IntToStr(Direction); RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd; RPCBrokerV.Call; RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1 if piece(RPCResult,'^',1)='-1' then begin // handle error... end else begin RPCBrokerV.Results.Delete(0); if RPCBrokerV.Results.Count=0 then begin //RPCBrokerV.Results.Add('0^'); end; end; Result := RPCBrokerV.Results; end; procedure TFieldLookupForm.FormShow(Sender: TObject); var mousePos : TPoint; begin GetCursorPos(mousePos); with FieldLookupForm do begin Top := mousePos.Y - 39; Left := mousePos.X - 15; if Left + Width > Screen.DesktopWidth then begin Left := Screen.DesktopWidth - Width; end; end; // ORComboBox.DroppedDown := true; end; procedure TFieldLookupForm.ORComboBoxDblClick(Sender: TObject); begin Modalresult := mrOK; //Close form, item should be selected (?) end; end.