source: cprs/branches/tmg-cprs/CPRS-Chart/fProbLex.pas@ 1725

Last change on this file since 1725 was 453, checked in by Kevin Toppenberg, 16 years ago

Initial upload of TMG-CPRS 1.0.26.69

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