source: cprs/trunk/CPRS-Chart/fProbLex.pas@ 872

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

Upgrading to version 27

File size: 6.2 KB
Line 
1unit fProbLex;
2
3interface
4
5uses
6 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
7 Forms, Dialogs, ORFn, uProbs, StdCtrls, Buttons, ExtCtrls, ORctrls, uConst,
8 fAutoSz, uInit, fBase508Form, VA508AccessibilityManager;
9
10type
11 TfrmPLLex = class(TfrmBase508Form)
12 Label1: TLabel;
13 bbCan: TBitBtn;
14 bbOK: TBitBtn;
15 Panel1: TPanel;
16 Bevel1: TBevel;
17 lblstatus: TLabel;
18 ebLex: TCaptionEdit;
19 lbLex: TORListBox;
20 bbSearch: TBitBtn;
21 procedure FormClose(Sender: TObject; var Action: TCloseAction);
22 procedure bbOKClick(Sender: TObject);
23 procedure bbCanClick(Sender: TObject);
24 procedure FormCreate(Sender: TObject);
25 procedure ebLexKeyPress(Sender: TObject; var Key: Char);
26 procedure bbSearchClick(Sender: TObject);
27 procedure lbLexClick(Sender: TObject);
28 procedure FormShow(Sender: TObject);
29 private
30 { Private declarations }
31 public
32 { Public declarations }
33 end;
34
35
36implementation
37
38uses
39 fprobs, rProbs, fProbEdt;
40
41{$R *.DFM}
42
43var
44 ProblemList:TstringList;
45
46const
47 TX_CONTINUE_799 = 'A suitable term was not found based on user input and current defaults.'#13#10 +
48 'If you proceed with this nonspecific term, an ICD code of "799.9 - OTHER'#13#10 +
49 'UNKNOWN AND UNSPECIFIED CAUSE OF MORBIDITY OR MORTALITY" will be filed.'#13#10#13#10 +
50 'Use ';
51
52procedure TfrmPLLex.FormClose(Sender: TObject; var Action: TCloseAction);
53begin
54 ProblemList.free;
55 {frmProblems.lblProbList.Caption := frmProblems.pnlRight.Caption ;}
56 Release;
57end;
58
59procedure TfrmPLLex.bbOKClick(Sender: TObject);
60const
61 TX799 = '799.9';
62var
63 x, y: string;
64 i: integer;
65begin
66 if (ebLex.Text = '') and ((lbLex.itemindex < 0) or (lbLex.Items.Count = 0)) then
67 exit {bail out - nothing selected}
68 else if ((lbLex.itemindex < 0) or (lbLex.Items.Count = 0)) then
69 begin
70 if InfoBox(TX_CONTINUE_799 + UpperCase(ebLex.Text) + '?', 'Unresolved Entry',
71 MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) <> IDYES then Exit;
72 PLProblem:=u + ebLex.Text + u + TX799 + u;
73 end
74 else if (Piece(ProblemList[lbLex.ItemIndex], U, 3) = '') then
75 begin
76 if InfoBox(TX_CONTINUE_799 + UpperCase(lbLex.DisplayText[lbLex.ItemIndex]) + '?', 'Unresolved Entry',
77 MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) <> IDYES then Exit;
78 PLProblem:=u + lbLex.DisplayText[lbLex.ItemIndex] + u + TX799 + u;
79 end
80 else
81 begin
82 x := ProblemList[lbLex.ItemIndex];
83 y := Piece(x, U, 2);
84 i := Pos(' *', y);
85 if i > 0 then y := Copy(y, 1, i - 1);
86 SetPiece(x, U, 2, y);
87 PLProblem := x;
88 end;
89 if (not Application.Terminated) and (not uInit.TimedOut) then {prevents GPF if system close box is clicked
90 while frmDlgProbs is visible}
91 if Assigned(frmProblems) then PostMessage(frmProblems.Handle, UM_PLLex, 0, 0) ;
92 Close;
93end;
94
95procedure TfrmPLLex.bbCanClick(Sender: TObject);
96begin
97 PLProblem:='';
98 close;
99end;
100
101procedure TfrmPLLex.FormCreate(Sender: TObject);
102begin
103 PLProblem := '';
104 ProblemList:=TStringList.create;
105 ResizeAnchoredFormToFont(self);
106 //Resize bevel to center horizontally
107 Bevel1.Width := Panel1.ClientWidth - Bevel1.Left- Bevel1.Left;
108end;
109
110procedure TfrmPLLex.ebLexKeyPress(Sender: TObject; var Key: Char);
111begin
112 if key=#13 then
113 begin
114 bbSearchClick(Sender);
115 Key:=#0;
116 end
117 else
118 begin
119 lblStatus.caption:='';
120 lbLex.Items.clear;
121 end;
122 end;
123
124procedure TfrmPLLex.bbSearchClick(Sender: TObject);
125VAR
126 ALIST:Tstringlist;
127 v,Max, Found:string;
128 onlist: integer;
129procedure SetLexList(v:string);
130var {too bad ORCombo only allows 1 piece to be shown}
131 i, j: integer;
132 txt, term, code, sys, lin, x: String;
133begin
134 lbLex.Clear;
135 onlist:=-1;
136 for i:=0 to pred(ProblemList.count) do
137 begin
138 txt:=ProblemList[i];
139 Term:=Piece(txt,u,2);
140 code:=Piece(txt,u,3);
141 sys:=Piece(txt,u,5);
142 lin:=Piece(txt,u,1) + u + term + ' ' + sys ;
143 if code<>'' then lin:=lin + ':(' + code + ')';
144 //lin:=Piece(txt,u,1) + u + term {+ ' ' + sys} ;
145 //{if code<>'' then lin:=lin + ':(' + code + ')'; }
146 j := Pos(' *', Term);
147 if j > 0 then
148 x := UpperCase(Copy(Term, 1, j-1))
149 else
150 x := UpperCase(Term);
151 if (x=V) or (code=V) then onlist:=i;
152 lbLex.Items.add(lin);
153 end;
154 if onlist < 0 then
155 begin {Search term not in return list, so add it}
156 lbLex.Items.insert(0,(u + V) );
157 ProblemList.insert(0,(u + V + u + u));
158 lbLex.itemIndex:=0;
159 end
160 else
161 begin {search term is on return list, so highlight it}
162 lbLex.itemIndex:=onlist;
163 ActiveControl := bbOK;
164 end;
165 lbLex.SetFocus;
166end;
167
168begin {body}
169if ebLex.text='' then
170 begin
171 InfoBox('Enter a term to search for, then click "SEARCH"', 'Information', MB_OK or MB_ICONINFORMATION);
172 exit; {don't bother to drop if no text entered}
173 end ;
174Alist:=TStringList.create;
175try
176 if lblStatus.caption = '' then
177 begin
178 lblStatus.caption := 'Searching Lexicon...';
179 lblStatus.refresh;
180 end;
181 v:=uppercase(ebLex.text);
182 if (v<>'') and (lbLex.itemindex<1) then
183 begin
184 ProblemList.clear;
185 {FastAssign(ProblemLexiconSearch(v), Alist) ;}
186 FastAssign(OldProblemLexiconSearch(v, 100), Alist) ;
187 end;
188 if Alist.count > 0 then
189 begin
190 FastAssign(Alist, lbLex.Items);
191 FastAssign(Alist, ProblemList);
192 Max:=ProblemList[pred(ProblemList.count)]; {get max number found}
193 ProblemList.delete(pred(ProblemList.count)); {shed max# found}
194 SetLexList(V);
195 if onlist < 0 then
196 Found := inttostr(ProblemList.Count -1)
197 else
198 Found := inttostr(ProblemList.Count);
199 lblStatus.caption:='Search returned ' + Found + ' items.' +
200 ' out of a possible ' + Max;
201 lbLex.Itemindex := 0 ;
202 end
203 else
204 begin
205 lblStatus.caption:='No Entries Found for "' + ebLex.text + '"';
206 end ;
207 finally
208 Alist.free;
209 end;
210end;
211
212procedure TfrmPLLex.lbLexClick(Sender: TObject);
213begin
214 bbOKClick(sender);
215end;
216
217procedure TfrmPLLex.FormShow(Sender: TObject);
218begin
219 ebLex.setfocus;
220end;
221
222end.
Note: See TracBrowser for help on using the repository browser.