source: cprs/branches/tmg-cprs/CPRS-Chart/Encounter/fPCEBaseMain.pas@ 1623

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

Initial upload of TMG-CPRS 1.0.26.69
File size: 13.6 KB
RevLine 
[453]1//kt -- Modified with SourceScanner on 8/8/2007
2unit fPCEBaseMain;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 fPCEBaseGrid, ComCtrls, StdCtrls, ORCtrls, ExtCtrls, Buttons, rPCE, uPCE,
9 CheckLst, ORFn, DKLang;
10
11type
12 TCopyItemsMethod = procedure(Dest: TStrings) of object;
13 TListSectionsProc = procedure(Dest: TStrings);
14
15 TfrmPCEBaseMain = class(TfrmPCEBaseGrid)
16 lbSection: TORListBox;
17 edtComment: TCaptionEdit;
18 lblSection: TLabel;
19 lblList: TLabel;
20 lblComment: TLabel;
21 btnRemove: TButton;
22 btnOther: TButton;
23 bvlMain: TBevel;
24 btnSelectAll: TButton;
25 lbxSection: TORListBox;
26 pnlMain: TPanel;
27 pnlLeft: TPanel;
28 splLeft: TSplitter;
29 procedure lbSectionClick(Sender: TObject);
30 procedure btnOtherClick(Sender: TObject);
31 procedure edtCommentExit(Sender: TObject);
32 procedure edtCommentChange(Sender: TObject);
33 procedure btnRemoveClick(Sender: TObject);
34 procedure clbListClick(Sender: TObject);
35 procedure lbGridSelect(Sender: TObject);
36 procedure FormDestroy(Sender: TObject);
37 procedure btnSelectAllClick(Sender: TObject);
38 procedure FormResize(Sender: TObject); virtual;
39 procedure clbListMouseDown(Sender: TObject; Button: TMouseButton;
40 Shift: TShiftState; X, Y: Integer);
41 procedure lbxSectionClickCheck(Sender: TObject; Index: Integer);
42 procedure splLeftMoved(Sender: TObject);
43 procedure edtCommentKeyPress(Sender: TObject; var Key: Char);
44 private
45 FCommentItem: integer;
46 FCommentChanged: boolean;
47 FUpdateCount: integer;
48 //FUpdatingGrid: boolean; moved to 'protected' so frmDiagnoses can see it (RV)
49 protected
50 FUpdatingGrid: boolean;
51 FPCEListCodesProc: TPCEListCodesProc;
52 FPCEItemClass: TPCEItemClass;
53 FPCECode: string;
54 FSplitterMove: boolean;
55 function GetCat: string;
56 procedure UpdateNewItemStr(var x: string); virtual;
57// procedure UpdateNewItem(APCEItem: TPCEItem); virtual;
58 procedure GridChanged; virtual;
59 procedure UpdateControls; override;
60 procedure BeginUpdate;
61 procedure EndUpdate;
62 function NotUpdating: boolean;
63 procedure CheckOffEntries;
64 procedure UpdateTabPos;
65 procedure Sync2Grid;
66 procedure Sync2Section;
67 public
68 procedure AllowTabChange(var AllowChange: boolean); override;
69 procedure InitTab(ACopyProc: TCopyItemsMethod; AListProc: TListSectionsProc);
70 end;
71
72var
73 frmPCEBaseMain: TfrmPCEBaseMain;
74
75const
76 LBCheckWidthSpace = 18;
77
78implementation
79
80uses fPCELex, fPCEOther, fEncounterFrame, fHFSearch;
81
82{$R *.DFM}
83
84procedure TfrmPCEBaseMain.lbSectionClick(Sender: TObject);
85begin
86 inherited;
87 ClearGrid;
88 FPCEListCodesProc(lbxSection.Items, lbSection.ItemIEN);
89 CheckOffEntries;
90end;
91
92procedure TfrmPCEBaseMain.UpdateNewItemStr(var x: string);
93begin
94end;
95
96procedure TfrmPCEBaseMain.GridChanged;
97var
98 i: integer;
99 tmpList: TStringList;
100begin
101 tmpList := TStringList.Create;
102 BeginUpdate;
103 try
104 SaveGridSelected;
105 tmpList.Assign(lbGrid.Items);
106 for i := 0 to lbGrid.Items.Count-1 do
107 begin
108 //lbGrid.Items[i] := TPCEItem(lbGrid.Items.Objects[i]).ItemStr; v22.5 - RV
109 tmpList[i] := TPCEItem(lbGrid.Items.Objects[i]).ItemStr;
110 tmpList.Objects[i] := lbGrid.Items.Objects[i];
111 end;
112 lbGrid.Items.Assign(tmpList);
113 RestoreGridSelected;
114 SyncGridData;
115 finally
116 EndUpdate;
117 tmpList.Free;
118 end;
119 UpdateControls;
120end;
121
122//procedure TfrmPCEBaseMain.UpdateNewItem(APCEItem: TPCEItem);
123//begin
124//end;
125
126procedure TfrmPCEBaseMain.btnOtherClick(Sender: TObject);
127var
128 x, Code: string;
129 APCEItem: TPCEItem;
130 SrchCode: integer;
131begin
132 inherited;
133 ClearGrid;
134 SrchCode := (Sender as TButton).Tag;
135 if(SrchCode <= LX_Threshold) then
136 LexiconLookup(Code, SrchCode)
137 else
138 if(SrchCode = PCE_HF) then
139 HFLookup(Code)
140 else
141 OtherLookup(Code, SrchCode);
142 btnOther.SetFocus;
143 if Code <> '' then
144 begin
145 x := FPCECode + U + Piece(Code, U, 1) + U + U + Piece(Code, U, 2);
146 if FPCEItemClass = TPCEProc then
147 SetPiece(x, U, pnumProvider, IntToStr(uProviders.PCEProvider));
148 UpdateNewItemStr(x);
149 APCEItem := FPCEItemClass.Create;
150 APCEItem.SetFromString(x);
151// UpdateNewItem(APCEItem);
152 GridIndex := lbGrid.Items.AddObject(APCEItem.ItemStr, APCEItem);
153 SyncGridData;
154 end;
155 UpdateControls;
156end;
157
158procedure TfrmPCEBaseMain.edtCommentExit(Sender: TObject);
159begin
160 inherited;
161 if(FCommentChanged) then
162 begin
163 FCommentChanged := FALSE;
164 if(FCommentItem >= 0) then
165 TPCEItem(lbGrid.Items.Objects[FCommentItem]).Comment := edtComment.text;
166 end;
167end;
168
169procedure TfrmPCEBaseMain.AllowTabChange(var AllowChange: boolean);
170begin
171 edtCommentExit(Self);
172end;
173
174procedure TfrmPCEBaseMain.edtCommentChange(Sender: TObject);
175begin
176 inherited;
177 FCommentItem := GridIndex;
178 FCommentChanged := TRUE;
179end;
180
181procedure TfrmPCEBaseMain.btnRemoveClick(Sender: TObject);
182var
183 i, j: Integer;
184 APCEItem: TPCEItem;
185 CurCategory: string;
186
187begin
188 inherited;
189 FUpdatingGrid := TRUE;
190 try
191 for i := lbGrid.Items.Count-1 downto 0 do if(lbGrid.Selected[i]) then
192 begin
193 CurCategory := GetCat;
194 APCEItem := TPCEDiag(lbGrid.Items.Objects[i]);
195 if APCEItem.Category = CurCategory then
196 begin
197 with APCEItem do for j := 0 to lbxSection.Items.Count - 1 do
198 if ORFn.Pieces(lbxSection.Items[j], U, 1, 2) = Code + U + Narrative then
199 lbxSection.Checked[j] := False;
200 end;
201 APCEItem.Free;
202 lbGrid.Items.Delete(i);
203 end;
204 ClearGrid;
205 finally
206 FUpdatingGrid := FALSE;
207 end;
208end;
209
210procedure TfrmPCEBaseMain.UpdateControls;
211var
212 CommentOK: boolean;
213
214begin
215 btnSelectAll.Enabled := (lbGrid.Items.Count > 0);
216 btnRemove.Enabled := (lbGrid.SelCount > 0);
217 if(NotUpdating) then
218 begin
219 BeginUpdate;
220 try
221 inherited;
222 CommentOK := (lbGrid.SelCount = 1);
223 lblComment.Enabled := CommentOK;
224 edtComment.Enabled := CommentOK;
225 if(CommentOK) then
226 edtComment.Text := TPCEItem(lbGrid.Items.Objects[GridIndex]).Comment
227 else
228 edtComment.Text := '';
229 finally
230 EndUpdate;
231 end;
232 end;
233end;
234
235procedure TfrmPCEBaseMain.clbListClick(Sender: TObject);
236begin
237 inherited;
238// with clbList do
239// if(ItemIndex >= 0) and (not(Checked[ItemIndex])) then
240// ClearGrid;
241end;
242
243procedure TfrmPCEBaseMain.lbGridSelect(Sender: TObject);
244begin
245 inherited;
246// clbList.ItemIndex := -1;
247 UpdateControls;
248end;
249
250procedure TfrmPCEBaseMain.FormDestroy(Sender: TObject);
251var
252 i:integer;
253
254begin
255 inherited;
256 with lbGrid.Items do for i := 0 to Count - 1 do TPCEItem(Objects[i]).Free;
257end;
258
259procedure TfrmPCEBaseMain.InitTab(ACopyProc: TCopyItemsMethod; AListProc: TListSectionsProc);
260begin
261 AListProc(lbSection.Items);
262 ACopyProc(lbGrid.Items);
263 lbSection.ItemIndex := 0;
264 lbSectionClick(lbSection);
265 ClearGrid;
266 GridChanged;
267// CheckOffEntries;
268end;
269
270procedure TfrmPCEBaseMain.BeginUpdate;
271begin
272 inc(FUpdateCount);
273end;
274
275procedure TfrmPCEBaseMain.EndUpdate;
276begin
277 if(FUpdateCount > 0) then
278 dec(FUpdateCount);
279end;
280
281function TfrmPCEBaseMain.NotUpdating: boolean;
282begin
283 Result := (FUpdateCount = 0);
284end;
285
286procedure TfrmPCEBaseMain.CheckOffEntries;
287{ TODO -oRich V. -cCode Set Versioning : Uncomment these lines to prevent acceptance of existing inactive DX codes. }
288(*const
289 TX_INACTIVE_ICD_CODE1 = 'The diagnosis of "';
290 TX_INACTIVE_ICD_CODE2 = '" entered for this encounter' + #13#10 + 'contains an inactive ICD code of "';
291 TX_INACTIVE_ICD_CODE3 = '" as of the encounter date, and will be removed.' + #13#10#13#10 +
292 'Please select another diagnosis.';
293 TC_INACTIVE_ICD_CODE = 'Diagnosis Contains Inactive Code';*)
294var
295 i, j: Integer;
296 CurCategory, CodeNarr: string;
297 APCEItem: TPCEItem;
298begin
299 FUpdatingGrid := TRUE;
300 try
301 if(lbSection.Items.Count < 1) then exit;
302 CurCategory := GetCat;
303 for i := lbGrid.Items.Count - 1 downto 0 do
304 begin
305 APCEItem := TPCEItem(lbGrid.Items.Objects[i]);
306 if APCEItem.Category = CurCategory then
307 begin
308 CodeNarr := APCEItem.Code + U + APCEItem.Narrative;
309 for j := 0 to lbxSection.Items.Count - 1 do
310 if ORFn.Pieces(lbxSection.Items[j], U, 1, 2) = CodeNarr then
311 begin
312{ TODO -oRich V. -cCode Set Versioning : Uncomment these lines to prevent acceptance of existing inactive DX codes. }
313//(* if (CurCategory = 'Problem List Items') and (Piece(lbxSection.Items[j], U, 5) = '#') then <-- original line. //kt 8/8/2007
314(* if (CurCategory = DKLangConstW('fPCEBaseMain_Problem_List_Items')) and (Piece(lbxSection.Items[j], U, 5) = '#') then //kt added 8/8/2007
315 begin
316 InfoBox(TX_INACTIVE_ICD_CODE1 + APCEItem.Narrative + TX_INACTIVE_ICD_CODE2 +
317 APCEItem.Code + TX_INACTIVE_ICD_CODE3, TC_INACTIVE_ICD_CODE, MB_ICONWARNING or MB_OK);
318 lbxSection.Checked[j] := False;
319 APCEItem.Free;
320 lbGrid.Items.Delete(i);
321 end
322 else*)
323 lbxSection.Checked[j] := True;
324 end;
325 end;
326 end;
327 finally
328 FUpdatingGrid := FALSE;
329 end;
330end;
331
332procedure TfrmPCEBaseMain.btnSelectAllClick(Sender: TObject);
333var
334 i: integer;
335
336begin
337 inherited;
338 BeginUpdate;
339 try
340 for i := 0 to lbGrid.Items.Count-1 do
341 lbGrid.Selected[i] := TRUE;
342 finally
343 EndUpdate;
344 end;
345 UpdateControls;
346end;
347
348procedure TfrmPCEBaseMain.FormResize(Sender: TObject);
349begin
350 if FSplitterMove then
351 FSplitterMove := FALSE
352 else
353 inherited;
354end;
355
356procedure TfrmPCEBaseMain.clbListMouseDown(Sender: TObject;
357 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
358begin
359 inherited;
360// if(Button <> mbLeft) then
361// clbList.Itemindex := clbList.itemAtPos(Point(X,Y), TRUE);
362end;
363
364function TfrmPCEBaseMain.GetCat: string;
365begin
366 Result := '';
367 if(lbSection.Items.Count > 0) and (lbSection.ItemIndex >= 0) then
368 Result := Piece(lbSection.Items[lbSection.ItemIndex], U, 2);
369end;
370
371procedure TfrmPCEBaseMain.lbxSectionClickCheck(Sender: TObject;
372 Index: Integer);
373var
374 i, j: Integer;
375 x, x0, CodeCatNarr: string;
376 APCEItem: TPCEItem;
377 Found, DoSync: boolean;
378
379begin
380 inherited;
381 if FUpdatingGrid or FClosing then exit;
382 DoSync := FALSE;
383 x0 := GetCat;
384 for i := 0 to lbxSection.Items.Count-1 do
385 begin
386 x := x0 + U + ORFn.Pieces(lbxSection.Items[i], U, 1, 2);
387 CodeCatNarr := Piece(x, U, 2) + U + Piece(x, U, 1) + U + Piece(x, U, 3);
388 Found := FALSE;
389 for j := lbGrid.Items.Count - 1 downto 0 do
390 begin
391 APCEItem := TPCEItem(lbGrid.Items.Objects[j]);
392 with APCEItem do if CodeCatNarr = Code + U + Category + U + Narrative then
393 begin
394 Found := TRUE;
395 if(lbxSection.Checked[i]) then break;
396 APCEItem.Free;
397 lbGrid.Items.Delete(j);
398 end;
399 end;
400 if(lbxSection.Checked[i] and (not Found)) then
401 begin
402 x := FPCECode + U + CodeCatNarr;
403 if FPCEItemClass = TPCEProc then
404 SetPiece(x, U, pnumProvider, IntToStr(uProviders.PCEProvider));
405 UpdateNewItemStr(x);
406 APCEItem := FPCEItemClass.Create;
407 APCEItem.SetFromString(x);
408 GridIndex := lbGrid.Items.AddObject(APCEItem.ItemStr, APCEItem);
409 DoSync := TRUE;
410 end;
411 end;
412 if(DoSync) then
413 SyncGridData;
414 UpdateControls;
415end;
416
417procedure TfrmPCEBaseMain.UpdateTabPos;
418begin
419 lbxSection.TabPositions := SectionString;
420end;
421
422procedure TfrmPCEBaseMain.splLeftMoved(Sender: TObject);
423begin
424 inherited;
425 lblList.Left := lbxSection.Left + pnlMain.Left;
426 FSplitterMove := TRUE;
427 FormResize(Sender);
428end;
429
430procedure TfrmPCEBaseMain.Sync2Grid;
431var
432 i, idx, cnt, NewIdx: Integer;
433 CodeNarr: string;
434 APCEItem: TPCEItem;
435
436begin
437 if(FUpdatingGrid or FClosing) then exit;
438 FUpdatingGrid := TRUE;
439 try
440 cnt := 0;
441 idx := -1;
442 for i := 0 to lbGrid.Items.Count - 1 do
443 begin
444 if(lbGrid.Selected[i]) then
445 begin
446 if(idx < 0) then idx := i;
447 inc(cnt);
448 if(cnt > 1) then break;
449 end;
450 end;
451 NewIdx := -1;
452 if(cnt = 1) then
453 begin
454 APCEItem := TPCEItem(lbGrid.Items.Objects[idx]);
455 if APCEItem.Category = GetCat then
456 begin
457 CodeNarr := APCEItem.Code + U + APCEItem.Narrative;
458 for i := 0 to lbxSection.Items.Count - 1 do
459 begin
460 if Pieces(lbxSection.Items[i], U, 1, 2) = CodeNarr then
461 begin
462 NewIdx := i;
463 break;
464 end;
465 end;
466 end;
467 end;
468 lbxSection.ItemIndex := NewIdx;
469 finally
470 FUpdatingGrid := FALSE;
471 end;
472end;
473
474procedure TfrmPCEBaseMain.Sync2Section;
475var
476 i, idx: Integer;
477 ACode: string;
478
479begin
480 if(FUpdatingGrid or FClosing) then exit;
481 FUpdatingGrid := TRUE;
482 try
483 idx := lbxSection.ItemIndex;
484 if(idx >= 0) then
485 ACode := GetCat + U + Pieces(lbxSection.Items[idx], U, 1, 2)
486 else
487 ACode := '~@^~@^@~';
488 for i := 0 to lbGrid.Items.Count - 1 do
489 begin
490 with TPCEItem(lbGrid.Items.Objects[i]) do
491 lbGrid.Selected[i] := (ACode = (Category + U + Code + U + Narrative));
492 end;
493 finally
494 FUpdatingGrid := FALSE;
495 end;
496end;
497
498procedure TfrmPCEBaseMain.edtCommentKeyPress(Sender: TObject;
499 var Key: Char);
500begin
501 inherited;
502 if (Key = '?') and
503 ((edtComment.Text = '') or (edtComment.SelStart = 0)) then
504 Key := #0;
505end;
506
507end.
Note: See TracBrowser for help on using the repository browser.