source: cprs/branches/tmg-cprs/CPRS-Chart/TMG_Extra/frmSearchResults.pas@ 1547

Last change on this file since 1547 was 801, checked in by Kevin Toppenberg, 14 years ago

Bug fixes. Improved Adding Image

File size: 6.2 KB
RevLine 
[800]1unit frmSearchResults;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, ORCtrls, StdCtrls, ORNet, ORFn, ComCtrls, Trpcb, Buttons,
8 ExtCtrls;
9
10type
11 TfrmSrchResults = class(TForm)
12 cboResultList: TORComboBox;
13 lblCaption: TLabel;
14 btnSelectRecord: TBitBtn;
15 btnCancel: TBitBtn;
16 pnlDetails: TPanel;
17 Memo: TMemo;
18 procedure cboResultListNeedData(Sender: TObject;
19 const StartFrom: String; Direction, InsertAt: Integer);
20 procedure cboResultListChange(Sender: TObject);
21 procedure btnSelectRecordClick(Sender: TObject);
22 private
23 { Private declarations }
24 FJobNum : string;
25 FTargetFName : string;
26 FLastDFN : string;
27 function SubSetOfResults(JobNum: string; const StartFrom: string; Direction: Integer): TStrings;
28 procedure ShowDemog(ItemID: string);
29 procedure ClearDemog;
30 procedure InitORComboBox(ORComboBox: TORComboBox; initValue : string; boxtype : string);
31 public
32 { Public declarations }
33 SelectedIEN : string; //used only as OUT parameters
34 SelectedName : string; //used only as OUT parameters
35 function PrepForm(JobNum, TargetFName, NumMatches, Fields: string) : Boolean;
36 end;
37
38var
39 frmSrchResults: TfrmSrchResults;
40
41implementation
42
43{$R *.dfm}
44
45 uses rcore;
46
47 function TfrmSrchResults.PrepForm(JobNum, TargetFName, NumMatches, Fields: string) : Boolean;
48 //Returns TRUE if OK, and FALSE if error
49 var
50 cmd,RPCResult : string;
51 begin
52 FJobNum := JobNum;
53 FTargetFName := TargetFName;
54 lblCaption.Caption := 'Select Desired Record from File '+ TargetFName + ' '
55 + NumMatches + ' found.';
56
57 Result := TRUE; //default
58 RPCBrokerV.remoteprocedure := 'TMG SEARCH CHANNEL';
59 RPCBrokerV.Param[0].Value := '.X'; // not used
60 RPCBrokerV.param[0].ptype := list;
61 cmd := 'PREP SUBSET';
62 cmd := cmd + '^' + JobNum + '^' + Fields;
63 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
[801]64 //RPCBrokerV.Call;
65 CallBroker;
[800]66 if RPCBrokerV.Results.Count > 0 then begin
67 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
68 if piece(RPCResult,'^',1)='-1' then begin
69 MessageDlg(piece(RPCResult,'^',2),mtInformation,[mbOK],0);
70 Result := false;
71 end;
72 end;
73 if Result=false then exit;
74 InitORComboBox(cboResultList,'A','record');
75 end;
76
77 procedure TfrmSrchResults.InitORComboBox(ORComboBox: TORComboBox; initValue : string; boxtype : string);
78 begin
79 ORComboBox.Items.Clear;
80 ORComboBox.Text := ''; //initValue;
81 ORComboBox.InitLongList(initValue);
82 if ORComboBox.Items.Count > 0 then begin
83 ORComboBox.Text := Piece(ORComboBox.Items[0],'^',2);
84 end else begin
85 ORComboBox.Text := '<Begin by selecting ' + boxtype + '>';
86 end;
87 end;
88
89
90 function TfrmSrchResults.SubSetOfResults(JobNum: string;
91 const StartFrom: string;
92 Direction: Integer ): TStrings;
93
94 { returns a pointer to a list of file entries (for use in a long list box) -
95 The return value is a pointer to RPCBrokerV.Results, so the data must
96 be used BEFORE the next broker call! }
97 var
98 cmd,RPCResult : string;
99 begin
100 RPCBrokerV.remoteprocedure := 'TMG SEARCH CHANNEL';
101 RPCBrokerV.Param[0].Value := '.X'; // not used
102 RPCBrokerV.param[0].ptype := list;
103 cmd := 'RESULTS LIST SUBSET';
104 cmd := cmd + '^' + JobNum + '^' + StartFrom + '^' + IntToStr(Direction);
105 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
[801]106 //RPCBrokerV.Call;
107 CallBroker;
[800]108 if RPCBrokerV.Results.Count > 0 then begin
109 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
110 if piece(RPCResult,'^',1)='-1' then begin
111 // handle error...
112 end else begin
113 RPCBrokerV.Results.Delete(0);
114 if RPCBrokerV.Results.Count=0 then begin
115 //RPCBrokerV.Results.Add('0^<NO DATA>');
116 end;
117 end;
118 end;
119 Result := RPCBrokerV.Results;
120 end;
121
122 procedure TfrmSrchResults.cboResultListNeedData(Sender: TObject;
123 const StartFrom: String; Direction, InsertAt: Integer);
124 var Result : TStrings;
125 ORComboBox : TORComboBox;
126 begin
127 ORComboBox := TORComboBox(Sender);
128 Result := SubSetOfResults(FJobNum, StartFrom, Direction);
129 ORComboBox.ForDataUse(Result);
130 end;
131
132
133 procedure TfrmSrchResults.cboResultListChange(Sender: TObject);
134 var SelEntry : string;
135 begin
136 if cboResultList.ItemIndex >=0 then begin
137 SelEntry := cboResultList.Items[cboResultList.ItemIndex];
138 SelectedIEN := piece(SelEntry,'^',1);
139 SelectedName := piece(SelEntry,'^',2);
140 end else begin
141 SelectedIEN := '';
142 SelectedName := ''
143 end;
144 if FTargetFName = 'PATIENT' then begin
145 ShowDemog(SelectedIEN);
146 end else begin
147 Memo.Clear;
148 end;
149 end;
150
151 procedure TfrmSrchResults.btnSelectRecordClick(Sender: TObject);
152 begin
153 //Check that something is selected, etc.
154 if SelectedName = '' then begin
155 MessageDlg('Please Select a Record First.',mtInformation,[mbOK],0);
156 end else begin
157 ModalResult := mrOK;
158 //Self.Close;
159 end;
160 end;
161
162
163 procedure TfrmSrchResults.ShowDemog(ItemID: string);
164 { gets a record of patient indentifying information from the server and displays it }
165 var PtRec: TPtIDInfo;
166 begin
167 if ItemID = '' then begin
168 ClearDemog;
169 Exit;
170 end;
171 if ItemID = FLastDFN then Exit;
172 Memo.Clear;
173 FLastDFN := ItemID;
174 //Memo.Lines.Add('After integration into CPRS, Fix ShowDemog().')
175 PtRec := rCore.GetPtIDInfo(ItemID);
176 with PtRec do begin
177 Memo.Lines.Add(Name);
178 Memo.Lines.Add('SSN: ' + SSN + '.');
179 Memo.Lines.Add('DOB:' + DOB + '.');
180 if Sex <> '' then Memo.Lines.Add(Sex + '.');
181 if Location <> '' then
182 Memo.Lines.Add('Location: ' + Location + '.');
183 if RoomBed <> '' then
184 Memo.Lines.Add('Room: ' + RoomBed + '.');
185 if HRN <> '' then Memo.Lines.Add('HRN: ' + HRN + '.');
186 end;
187 end;
188
189 procedure TfrmSrchResults.ClearDemog;
190 begin
191 Memo.Lines.Clear;
192 FLastDFN := '';
193
194 end;
195
196 end.
197
Note: See TracBrowser for help on using the repository browser.