| [476] | 1 | unit LookupU; | 
|---|
|  | 2 | (* | 
|---|
|  | 3 | WorldVistA Configuration Utility | 
|---|
|  | 4 | (c) 8/2008 Kevin Toppenberg | 
|---|
|  | 5 | Programmed by Kevin Toppenberg, Eddie Hagood | 
|---|
|  | 6 |  | 
|---|
|  | 7 | Family Physicians of Greeneville, PC | 
|---|
|  | 8 | 1410 Tusculum Blvd, Suite 2600 | 
|---|
|  | 9 | Greeneville, TN 37745 | 
|---|
|  | 10 | kdtop@yahoo.com | 
|---|
|  | 11 |  | 
|---|
|  | 12 | This library is free software; you can redistribute it and/or | 
|---|
|  | 13 | modify it under the terms of the GNU Lesser General Public | 
|---|
|  | 14 | License as published by the Free Software Foundation; either | 
|---|
|  | 15 | version 2.1 of the License, or (at your option) any later version. | 
|---|
|  | 16 |  | 
|---|
|  | 17 | This library is distributed in the hope that it will be useful, | 
|---|
|  | 18 | but WITHOUT ANY WARRANTY; without even the implied warranty of | 
|---|
|  | 19 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU | 
|---|
|  | 20 | Lesser General Public License for more details. | 
|---|
|  | 21 |  | 
|---|
|  | 22 | You should have received a copy of the GNU Lesser General Public | 
|---|
|  | 23 | License along with this library; if not, write to the Free Software | 
|---|
|  | 24 | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA | 
|---|
| [493] | 25 | *) | 
|---|
| [476] | 26 |  | 
|---|
|  | 27 | interface | 
|---|
|  | 28 |  | 
|---|
|  | 29 | uses | 
|---|
|  | 30 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, | 
|---|
|  | 31 | Dialogs, StdCtrls, ORCtrls, Buttons; | 
|---|
|  | 32 |  | 
|---|
|  | 33 | type | 
|---|
|  | 34 | TFieldLookupForm = class(TForm) | 
|---|
|  | 35 | ORComboBox: TORComboBox; | 
|---|
|  | 36 | OKBtn: TBitBtn; | 
|---|
|  | 37 | CancelBtn: TBitBtn; | 
|---|
|  | 38 | procedure ORComboBoxNeedData(Sender: TObject; const StartFrom: String; | 
|---|
|  | 39 | Direction, InsertAt: Integer); | 
|---|
|  | 40 | procedure FormShow(Sender: TObject); | 
|---|
|  | 41 | procedure ORComboBoxDblClick(Sender: TObject); | 
|---|
|  | 42 | private | 
|---|
|  | 43 | { Private declarations } | 
|---|
|  | 44 | FFileNum : String; | 
|---|
| [493] | 45 |  | 
|---|
| [476] | 46 | public | 
|---|
|  | 47 | { Public declarations } | 
|---|
|  | 48 | //procedure InitORComboBox(ORComboBox: TORComboBox; initValue : string); | 
|---|
|  | 49 | procedure PrepForm(FileNum,InitValue : string); | 
|---|
| [542] | 50 | function SubSetOfFile(FileNum: string; const StartFrom: string; | 
|---|
| [476] | 51 | Direction: Integer): TStrings; | 
|---|
|  | 52 | end; | 
|---|
|  | 53 |  | 
|---|
|  | 54 | var | 
|---|
|  | 55 | FieldLookupForm: TFieldLookupForm; | 
|---|
|  | 56 |  | 
|---|
|  | 57 | implementation | 
|---|
|  | 58 |  | 
|---|
|  | 59 | uses | 
|---|
| [542] | 60 | ORNet, ORFn, | 
|---|
|  | 61 | Trpcb,   //needed for .ptype types | 
|---|
|  | 62 | QControls, MainU; | 
|---|
| [476] | 63 | {$R *.dfm} | 
|---|
|  | 64 |  | 
|---|
|  | 65 | procedure TFieldLookupForm.ORComboBoxNeedData(Sender: TObject; | 
|---|
| [542] | 66 | const StartFrom: String; | 
|---|
| [476] | 67 | Direction, InsertAt: Integer); | 
|---|
|  | 68 | var | 
|---|
| [542] | 69 | Result : TStrings; | 
|---|
| [476] | 70 | begin | 
|---|
|  | 71 | Result := SubSetOfFile(FFileNum, StartFrom, Direction); | 
|---|
|  | 72 | TORComboBox(Sender).ForDataUse(Result); | 
|---|
|  | 73 | end; | 
|---|
|  | 74 |  | 
|---|
|  | 75 | { | 
|---|
|  | 76 | procedure TFieldLookupForm.InitORComboBox(ORComboBox: TORComboBox; initValue : string); | 
|---|
|  | 77 | begin | 
|---|
|  | 78 | ORComboBox.Text := initValue; | 
|---|
|  | 79 | ORComboBox.InitLongList(initValue); | 
|---|
|  | 80 | if ORComboBox.Items.Count > 0 then begin | 
|---|
|  | 81 | ORComboBox.Text := Piece(ORComboBox.Items[0],'^',2); | 
|---|
|  | 82 | end else begin | 
|---|
|  | 83 | ORComboBox.Text := '<Start Typing to Search>'; | 
|---|
|  | 84 | end; | 
|---|
|  | 85 | end; | 
|---|
|  | 86 | } | 
|---|
|  | 87 |  | 
|---|
|  | 88 | procedure TFieldLookupForm.PrepForm(FileNum,InitValue : string); | 
|---|
|  | 89 | begin | 
|---|
|  | 90 | FFileNum := FileNum; | 
|---|
|  | 91 | Self.Caption := 'Pick Entry from File # ' + FileNum; | 
|---|
|  | 92 | if (FileNum='200') and (InitValue='') then begin | 
|---|
|  | 93 | InitValue := MainForm.CurrentUserName; | 
|---|
|  | 94 | end; | 
|---|
|  | 95 | MainForm.InitORComboBox(ORComboBox,InitValue); | 
|---|
|  | 96 | end; | 
|---|
|  | 97 |  | 
|---|
|  | 98 |  | 
|---|
|  | 99 | function TFieldLookupForm.SubSetOfFile(FileNum: string; | 
|---|
|  | 100 | const StartFrom: string; | 
|---|
|  | 101 | Direction: Integer       ): TStrings; | 
|---|
|  | 102 |  | 
|---|
|  | 103 | { returns a pointer to a list of file entries (for use in a long list box) - | 
|---|
|  | 104 | The return value is a pointer to RPCBrokerV.Results, so the data must | 
|---|
|  | 105 | be used BEFORE the next broker call! } | 
|---|
|  | 106 | var | 
|---|
|  | 107 | cmd,RPCResult : string; | 
|---|
|  | 108 | begin | 
|---|
|  | 109 | RPCBrokerV.remoteprocedure := 'TMG CHANNEL'; | 
|---|
|  | 110 | RPCBrokerV.Param[0].Value := '.X';  // not used | 
|---|
|  | 111 | RPCBrokerV.param[0].ptype := list; | 
|---|
|  | 112 | cmd := 'FILE ENTRY SUBSET'; | 
|---|
|  | 113 | cmd := cmd + '^' + FileNum + '^' + StartFrom + '^' + IntToStr(Direction); | 
|---|
|  | 114 | RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd; | 
|---|
|  | 115 | RPCBrokerV.Call; | 
|---|
|  | 116 | RPCResult := RPCBrokerV.Results[0];    //returns:  error: -1;  success=1 | 
|---|
|  | 117 | if piece(RPCResult,'^',1)='-1' then begin | 
|---|
|  | 118 | // handle error... | 
|---|
|  | 119 | end else begin | 
|---|
|  | 120 | RPCBrokerV.Results.Delete(0); | 
|---|
|  | 121 | if RPCBrokerV.Results.Count=0 then begin | 
|---|
| [482] | 122 | //RPCBrokerV.Results.Add('0^<NO DATA>'); | 
|---|
| [476] | 123 | end; | 
|---|
|  | 124 | end; | 
|---|
|  | 125 | Result := RPCBrokerV.Results; | 
|---|
|  | 126 | end; | 
|---|
|  | 127 |  | 
|---|
|  | 128 | procedure TFieldLookupForm.FormShow(Sender: TObject); | 
|---|
|  | 129 | var mousePos : TPoint; | 
|---|
|  | 130 | begin | 
|---|
|  | 131 | GetCursorPos(mousePos); | 
|---|
|  | 132 | with FieldLookupForm do begin | 
|---|
|  | 133 | Top := mousePos.Y - 39; | 
|---|
|  | 134 | Left := mousePos.X - 15; | 
|---|
|  | 135 | if Left + Width > Screen.DesktopWidth then begin | 
|---|
|  | 136 | Left := Screen.DesktopWidth - Width; | 
|---|
|  | 137 | end; | 
|---|
|  | 138 | end; | 
|---|
|  | 139 | //    ORComboBox.DroppedDown := true; | 
|---|
|  | 140 | end; | 
|---|
|  | 141 |  | 
|---|
|  | 142 |  | 
|---|
|  | 143 | procedure TFieldLookupForm.ORComboBoxDblClick(Sender: TObject); | 
|---|
|  | 144 | begin | 
|---|
|  | 145 | Modalresult := mrOK;  //Close form, item should be selected (?) | 
|---|
|  | 146 | end; | 
|---|
|  | 147 |  | 
|---|
|  | 148 | end. | 
|---|
|  | 149 |  | 
|---|