source: cprs/branches/tmg-cprs/CPRS-Chart/Encounter/fPCELex.pas@ 973

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

Initial upload of TMG-CPRS 1.0.26.69

File size: 4.2 KB
Line 
1//kt -- Modified with SourceScanner on 8/8/2007
2unit fPCELex;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 fAutoSz, StdCtrls, ORFn, ORCtrls, DKLang;
9
10type
11 TfrmPCELex = class(TfrmAutoSz)
12 txtSearch: TCaptionEdit;
13 cmdSearch: TButton;
14 cmdOK: TButton;
15 cmdCancel: TButton;
16 lblSearch: TLabel;
17 lblSelect: TLabel;
18 lstSelect: TORListBox;
19 procedure cmdSearchClick(Sender: TObject);
20 procedure cmdCancelClick(Sender: TObject);
21 procedure FormCreate(Sender: TObject);
22 procedure cmdOKClick(Sender: TObject);
23 procedure lstSelectClick(Sender: TObject);
24 procedure txtSearchChange(Sender: TObject);
25 procedure lstSelectDblClick(Sender: TObject);
26 private
27 FLexApp: Integer;
28 FCode: string;
29 FDate: TFMDateTime;
30 procedure SetApp(LexApp: Integer);
31 procedure SetDate(ADate: TFMDateTime);
32 end;
33
34procedure LexiconLookup(var Code: string; LexApp: Integer; ADate: TFMDateTime = 0);
35
36implementation
37
38{$R *.DFM}
39
40uses rPCE,UBAGlobals;
41
42procedure LexiconLookup(var Code: string; LexApp: Integer; ADate: TFMDateTime = 0);
43var
44 frmPCELex: TfrmPCELex;
45begin
46 frmPCELex := TfrmPCELex.Create(Application);
47 try
48 ResizeFormToFont(TForm(frmPCELex));
49 frmPCELex.SetApp(LexApp);
50 frmPCELex.SetDate(ADate);
51 frmPCELex.ShowModal;
52 Code := frmPCELex.FCode;
53 finally
54 frmPCELex.Free;
55 end;
56end;
57
58procedure TfrmPCELex.FormCreate(Sender: TObject);
59begin
60 inherited;
61 FCode := '';
62end;
63
64procedure TfrmPCELex.SetApp(LexApp: Integer);
65begin
66 FLexApp := LexApp;
67 case LexApp of
68 LX_ICD: begin
69// Caption := 'Lookup Diagnosis'; <-- original line. //kt 8/8/2007
70 Caption := DKLangConstW('fPCELex_Lookup_Diagnosis'); //kt added 8/8/2007
71// lblSearch.Caption := 'Search for Diagnosis'; <-- original line. //kt 8/8/2007
72 lblSearch.Caption := DKLangConstW('fPCELex_Search_for_Diagnosis'); //kt added 8/8/2007
73 end;
74 LX_CPT: begin
75// Caption := 'Lookup Procedure'; <-- original line. //kt 8/8/2007
76 Caption := DKLangConstW('fPCELex_Lookup_Procedure'); //kt added 8/8/2007
77// lblSearch.Caption := 'Search for Procedure'; <-- original line. //kt 8/8/2007
78 lblSearch.Caption := DKLangConstW('fPCELex_Search_for_Procedure'); //kt added 8/8/2007
79 end;
80 end;
81end;
82
83procedure TfrmPCELex.SetDate(ADate: TFMDateTime);
84begin
85 FDate := ADate;
86end;
87
88procedure TfrmPCELex.txtSearchChange(Sender: TObject);
89begin
90 inherited;
91 cmdSearch.Default := True;
92 cmdOK.Default := False;
93end;
94
95procedure TfrmPCELex.cmdSearchClick(Sender: TObject);
96begin
97 inherited;
98 if Length(txtSearch.Text) = 0 then Exit;
99//StatusText('Searching clinical lexicon...'); <-- original line. //kt 8/8/2007
100 StatusText(DKLangConstW('fPCELex_Searching_clinical_lexiconxxx')); //kt added 8/8/2007
101 ListLexicon(lstSelect.Items, txtSearch.Text, FLexApp, FDate);
102 if lstSelect.GetIEN(0) = -1 then
103 begin
104 lblSelect.Visible := False;
105 txtSearch.SetFocus;
106 txtSearch.SelectAll;
107 cmdOK.Default := False;
108 cmdSearch.Default := True;
109 end else
110 begin
111 lblSelect.Visible := True;
112 lstSelect.SetFocus;
113 cmdSearch.Default := False;
114 end;
115 StatusText('');
116end;
117
118procedure TfrmPCELex.lstSelectClick(Sender: TObject);
119begin
120 inherited;
121 if(lstSelect.ItemIndex > -1) and (lstSelect.ItemIEN > 0) then
122 begin
123 cmdSearch.Default := False;
124 cmdOK.Default := True;
125 end;
126end;
127
128procedure TfrmPCELex.cmdOKClick(Sender: TObject);
129begin
130 inherited;
131 if(lstSelect.ItemIndex = -1) or (lstSelect.ItemIEN <= 0) then Exit;
132 with lstSelect do
133 begin
134 if BAPersonalDX then
135 FCode := (LexiconToCode(ItemIEN, FLexApp, FDate) + U + DisplayText[ItemIndex] + U + IntToStr(ItemIEN) )
136 else
137 FCode := LexiconToCode(ItemIEN, FLexApp, FDate) + U + DisplayText[ItemIndex];
138 Close;
139 end;
140end;
141
142procedure TfrmPCELex.cmdCancelClick(Sender: TObject);
143begin
144 inherited;
145 FCode := '';
146 Close;
147end;
148
149procedure TfrmPCELex.lstSelectDblClick(Sender: TObject);
150begin
151 inherited;
152 lstSelectClick(Sender);
153 cmdOKClick(Sender);
154end;
155
156end.
157
Note: See TracBrowser for help on using the repository browser.