source: cprs/trunk/CPRS-Chart/Encounter/fPCEBaseMain.pas@ 670

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

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