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

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

Fixing uploads of PDF files

File size: 6.2 KB
Line 
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;
64 RPCBrokerV.Call;
65 if RPCBrokerV.Results.Count > 0 then begin
66 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
67 if piece(RPCResult,'^',1)='-1' then begin
68 MessageDlg(piece(RPCResult,'^',2),mtInformation,[mbOK],0);
69 Result := false;
70 end;
71 end;
72 if Result=false then exit;
73 InitORComboBox(cboResultList,'A','record');
74 end;
75
76 procedure TfrmSrchResults.InitORComboBox(ORComboBox: TORComboBox; initValue : string; boxtype : string);
77 begin
78 ORComboBox.Items.Clear;
79 ORComboBox.Text := ''; //initValue;
80 ORComboBox.InitLongList(initValue);
81 if ORComboBox.Items.Count > 0 then begin
82 ORComboBox.Text := Piece(ORComboBox.Items[0],'^',2);
83 end else begin
84 ORComboBox.Text := '<Begin by selecting ' + boxtype + '>';
85 end;
86 end;
87
88
89 function TfrmSrchResults.SubSetOfResults(JobNum: string;
90 const StartFrom: string;
91 Direction: Integer ): TStrings;
92
93 { returns a pointer to a list of file entries (for use in a long list box) -
94 The return value is a pointer to RPCBrokerV.Results, so the data must
95 be used BEFORE the next broker call! }
96 var
97 cmd,RPCResult : string;
98 begin
99 RPCBrokerV.remoteprocedure := 'TMG SEARCH CHANNEL';
100 RPCBrokerV.Param[0].Value := '.X'; // not used
101 RPCBrokerV.param[0].ptype := list;
102 cmd := 'RESULTS LIST SUBSET';
103 cmd := cmd + '^' + JobNum + '^' + StartFrom + '^' + IntToStr(Direction);
104 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
105 RPCBrokerV.Call;
106 if RPCBrokerV.Results.Count > 0 then begin
107 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
108 if piece(RPCResult,'^',1)='-1' then begin
109 // handle error...
110 end else begin
111 RPCBrokerV.Results.Delete(0);
112 if RPCBrokerV.Results.Count=0 then begin
113 //RPCBrokerV.Results.Add('0^<NO DATA>');
114 end;
115 end;
116 end;
117 Result := RPCBrokerV.Results;
118 end;
119
120 procedure TfrmSrchResults.cboResultListNeedData(Sender: TObject;
121 const StartFrom: String; Direction, InsertAt: Integer);
122 var Result : TStrings;
123 ORComboBox : TORComboBox;
124 begin
125 ORComboBox := TORComboBox(Sender);
126 Result := SubSetOfResults(FJobNum, StartFrom, Direction);
127 ORComboBox.ForDataUse(Result);
128 end;
129
130
131 procedure TfrmSrchResults.cboResultListChange(Sender: TObject);
132 var SelEntry : string;
133 begin
134 if cboResultList.ItemIndex >=0 then begin
135 SelEntry := cboResultList.Items[cboResultList.ItemIndex];
136 SelectedIEN := piece(SelEntry,'^',1);
137 SelectedName := piece(SelEntry,'^',2);
138 end else begin
139 SelectedIEN := '';
140 SelectedName := ''
141 end;
142 if FTargetFName = 'PATIENT' then begin
143 ShowDemog(SelectedIEN);
144 end else begin
145 Memo.Clear;
146 end;
147 end;
148
149 procedure TfrmSrchResults.btnSelectRecordClick(Sender: TObject);
150 begin
151 //Check that something is selected, etc.
152 if SelectedName = '' then begin
153 MessageDlg('Please Select a Record First.',mtInformation,[mbOK],0);
154 end else begin
155 ModalResult := mrOK;
156 //Self.Close;
157 end;
158 end;
159
160
161 procedure TfrmSrchResults.ShowDemog(ItemID: string);
162 { gets a record of patient indentifying information from the server and displays it }
163 var PtRec: TPtIDInfo;
164 begin
165 if ItemID = '' then begin
166 ClearDemog;
167 Exit;
168 end;
169 if ItemID = FLastDFN then Exit;
170 Memo.Clear;
171 FLastDFN := ItemID;
172 //Memo.Lines.Add('After integration into CPRS, Fix ShowDemog().')
173 PtRec := rCore.GetPtIDInfo(ItemID);
174 with PtRec do begin
175 Memo.Lines.Add(Name);
176 Memo.Lines.Add('SSN: ' + SSN + '.');
177 Memo.Lines.Add('DOB:' + DOB + '.');
178 if Sex <> '' then Memo.Lines.Add(Sex + '.');
179 if Location <> '' then
180 Memo.Lines.Add('Location: ' + Location + '.');
181 if RoomBed <> '' then
182 Memo.Lines.Add('Room: ' + RoomBed + '.');
183 if HRN <> '' then Memo.Lines.Add('HRN: ' + HRN + '.');
184 end;
185 end;
186
187 procedure TfrmSrchResults.ClearDemog;
188 begin
189 Memo.Lines.Clear;
190 FLastDFN := '';
191
192 end;
193
194 end.
195
Note: See TracBrowser for help on using the repository browser.