source: cprs/branches/foia-cprs/CPRS-Chart/fDCSumm.pas@ 459

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

Adding foia-cprs branch
File size: 117.5 KB
Line 
1unit fDCSumm;
2
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 fHSplit, StdCtrls, ExtCtrls, Menus, ComCtrls, ORCtrls, ORFn, uConst, ORDtTm,
9 uPCE, ORClasses, fDrawers, rDCSumm, uDocTree, uDCSumm, uTIU, fPrintList;
10
11type
12 TfrmDCSumm = class(TfrmHSplit)
13 mnuSumms: TMainMenu;
14 mnuView: TMenuItem;
15 mnuViewChart: TMenuItem;
16 mnuChartReports: TMenuItem;
17 mnuChartLabs: TMenuItem;
18 mnuChartDCSumm: TMenuItem;
19 mnuChartCslts: TMenuItem;
20 mnuChartSumms: TMenuItem;
21 mnuChartOrders: TMenuItem;
22 mnuChartMeds: TMenuItem;
23 mnuChartProbs: TMenuItem;
24 mnuChartCover: TMenuItem;
25 Z1: TMenuItem;
26 mnuViewDetail: TMenuItem;
27 mnuAct: TMenuItem;
28 mnuActNew: TMenuItem;
29 Z2: TMenuItem;
30 mnuActSave: TMenuItem;
31 mnuActDelete: TMenuItem;
32 mnuActEdit: TMenuItem;
33 mnuActSign: TMenuItem;
34 mnuActAddend: TMenuItem;
35 lblSumms: TOROffsetLabel;
36 pnlRead: TPanel;
37 lblTitle: TOROffsetLabel;
38 memSumm: TRichEdit;
39 pnlWrite: TPanel;
40 memNewSumm: TRichEdit;
41 Z3: TMenuItem;
42 mnuViewAll: TMenuItem;
43 mnuViewByAuthor: TMenuItem;
44 mnuViewByDate: TMenuItem;
45 mnuViewUncosigned: TMenuItem;
46 mnuViewUnsigned: TMenuItem;
47 mnuActSignList: TMenuItem;
48 cmdNewSumm: TORAlignButton;
49 lblSpace1: TLabel;
50 cmdPCE: TORAlignButton;
51 popSummMemo: TPopupMenu;
52 popSummMemoCut: TMenuItem;
53 popSummMemoCopy: TMenuItem;
54 popSummMemoPaste: TMenuItem;
55 Z10: TMenuItem;
56 popSummMemoSignList: TMenuItem;
57 popSummMemoDelete: TMenuItem;
58 popSummMemoEdit: TMenuItem;
59 popSummMemoSave: TMenuItem;
60 popSummMemoSign: TMenuItem;
61 popSummList: TPopupMenu;
62 popSummListAll: TMenuItem;
63 popSummListByAuthor: TMenuItem;
64 popSummListByDate: TMenuItem;
65 popSummListUncosigned: TMenuItem;
66 popSummListUnsigned: TMenuItem;
67 pnlFields: TORAutoPanel;
68 sptVert: TSplitter;
69 memPCEShow: TRichEdit;
70 mnuActIdentifyAddlSigners: TMenuItem;
71 popSummMemoAddlSign: TMenuItem;
72 Z11: TMenuItem;
73 popSummMemoSpell: TMenuItem;
74 popSummMemoGrammar: TMenuItem;
75 mnuViewCustom: TMenuItem;
76 N1: TMenuItem;
77 mnuViewSaveAsDefault: TMenuItem;
78 mnuViewReturnToDefault: TMenuItem;
79 pnlDrawers: TPanel;
80 lstSumms: TORListBox;
81 N2: TMenuItem;
82 popSummMemoTemplate: TMenuItem;
83 mnuOptions: TMenuItem;
84 mnuEditTemplates: TMenuItem;
85 mnuNewTemplate: TMenuItem;
86 splDrawers: TSplitter;
87 N3: TMenuItem;
88 mnuEditSharedTemplates: TMenuItem;
89 mnuNewSharedTemplate: TMenuItem;
90 timAutoSave: TTimer;
91 cmdChange: TButton;
92 lblNewTitle: TStaticText;
93 lblVisit: TStaticText;
94 lblRefDate: TStaticText;
95 lblCosigner: TStaticText;
96 lblDictator: TStaticText;
97 lblDischarge: TStaticText;
98 popSummMemoPaste2: TMenuItem;
99 popSummMemoReformat: TMenuItem;
100 Z4: TMenuItem;
101 mnuActChange: TMenuItem;
102 mnuActLoadBoiler: TMenuItem;
103 bvlNewTitle: TBevel;
104 popSummMemoSaveContinue: TMenuItem;
105 N4: TMenuItem;
106 mnuEditDialgFields: TMenuItem;
107 lvSumms: TCaptionListView;
108 sptList: TSplitter;
109 N5: TMenuItem;
110 popSummListExpandSelected: TMenuItem;
111 popSummListExpandAll: TMenuItem;
112 popSummListCollapseSelected: TMenuItem;
113 popSummListCollapseAll: TMenuItem;
114 tvSumms: TORTreeView;
115 popSummListCustom: TMenuItem;
116 N6: TMenuItem;
117 popSummListDetachFromIDParent: TMenuItem;
118 mnuActDetachFromIDParent: TMenuItem;
119 popSummListAddIDEntry: TMenuItem;
120 mnuActAddIDEntry: TMenuItem;
121 N7: TMenuItem;
122 mnuIconLegend: TMenuItem;
123 dlgFindText: TFindDialog;
124 popSummMemoFind: TMenuItem;
125 dlgReplaceText: TReplaceDialog;
126 N8: TMenuItem;
127 popSummMemoReplace: TMenuItem;
128 mnuChartSurgery: TMenuItem;
129 mnuActAttachtoIDParent: TMenuItem;
130 popSummListAttachtoIDParent: TMenuItem;
131 popSummMemoAddend: TMenuItem;
132 N9: TMenuItem;
133 popSummMemoPreview: TMenuItem;
134 popSummMemoInsTemplate: TMenuItem;
135 popSummMemoEncounter: TMenuItem;
136 procedure mnuChartTabClick(Sender: TObject);
137 procedure lstSummsClick(Sender: TObject);
138 procedure pnlRightResize(Sender: TObject);
139 procedure cmdNewSummClick(Sender: TObject);
140 procedure memNewSummChange(Sender: TObject);
141 procedure mnuActNewClick(Sender: TObject);
142 procedure mnuActAddIDEntryClick(Sender: TObject);
143 procedure mnuActSaveClick(Sender: TObject);
144 procedure mnuViewClick(Sender: TObject);
145 procedure mnuActAddendClick(Sender: TObject);
146 procedure mnuActDetachFromIDParentClick(Sender: TObject);
147 procedure mnuActSignListClick(Sender: TObject);
148 procedure mnuActDeleteClick(Sender: TObject);
149 procedure mnuActEditClick(Sender: TObject);
150 procedure mnuActSignClick(Sender: TObject);
151 procedure cmdOrdersClick(Sender: TObject);
152 procedure cmdPCEClick(Sender: TObject);
153 procedure popSummMemoCutClick(Sender: TObject);
154 procedure popSummMemoCopyClick(Sender: TObject);
155 procedure popSummMemoPasteClick(Sender: TObject);
156 procedure popSummMemoPopup(Sender: TObject);
157 procedure pnlWriteResize(Sender: TObject);
158 procedure FormCreate(Sender: TObject);
159 procedure mnuViewDetailClick(Sender: TObject);
160 procedure FormClose(Sender: TObject; var Action: TCloseAction);
161 procedure mnuActIdentifyAddlSignersClick(Sender: TObject);
162 procedure popSummMemoAddlSignClick(Sender: TObject);
163 procedure popSummMemoSpellClick(Sender: TObject);
164 procedure popSummMemoGrammarClick(Sender: TObject);
165 procedure mnuViewSaveAsDefaultClick(Sender: TObject);
166 procedure mnuViewReturntoDefaultClick(Sender: TObject);
167 procedure popSummMemoTemplateClick(Sender: TObject);
168 procedure mnuNewTemplateClick(Sender: TObject);
169 procedure mnuEditTemplatesClick(Sender: TObject);
170 procedure mnuOptionsClick(Sender: TObject);
171 procedure mnuEditSharedTemplatesClick(Sender: TObject);
172 procedure mnuNewSharedTemplateClick(Sender: TObject);
173 procedure FormDestroy(Sender: TObject);
174 procedure timAutoSaveTimer(Sender: TObject);
175 procedure cmdChangeClick(Sender: TObject);
176 procedure popSummMemoReformatClick(Sender: TObject);
177 procedure mnuActChangeClick(Sender: TObject);
178 procedure mnuActLoadBoilerClick(Sender: TObject);
179 procedure popSummMemoSaveContinueClick(Sender: TObject);
180 procedure mnuEditDialgFieldsClick(Sender: TObject);
181 procedure tvSummsChange(Sender: TObject; Node: TTreeNode);
182 procedure tvSummsClick(Sender: TObject);
183 procedure tvSummsCollapsed(Sender: TObject; Node: TTreeNode);
184 procedure tvSummsExpanded(Sender: TObject; Node: TTreeNode);
185 procedure tvSummsStartDrag(Sender: TObject;
186 var DragObject: TDragObject);
187 procedure tvSummsDragDrop(Sender, Source: TObject; X, Y: Integer);
188 procedure tvSummsDragOver(Sender, Source: TObject; X, Y: Integer;
189 State: TDragState; var Accept: Boolean);
190 procedure lvSummsColumnClick(Sender: TObject; Column: TListColumn);
191 procedure lvSummsCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
192 procedure lvSummsSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
193 procedure popSummListExpandAllClick(Sender: TObject);
194 procedure popSummListCollapseAllClick(Sender: TObject);
195 procedure popSummListExpandSelectedClick(Sender: TObject);
196 procedure popSummListCollapseSelectedClick(Sender: TObject);
197 procedure popSummListPopup(Sender: TObject);
198 procedure lvSummsResize(Sender: TObject);
199 procedure mnuIconLegendClick(Sender: TObject);
200 procedure popSummMemoFindClick(Sender: TObject);
201 procedure dlgFindTextFind(Sender: TObject);
202 procedure dlgReplaceTextReplace(Sender: TObject);
203 procedure dlgReplaceTextFind(Sender: TObject);
204 procedure popSummMemoReplaceClick(Sender: TObject);
205 procedure mnuActAttachtoIDParentClick(Sender: TObject);
206 procedure memNewSummKeyUp(Sender: TObject; var Key: Word;
207 Shift: TShiftState);
208 procedure sptHorzCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean);
209 procedure popSummMemoPreviewClick(Sender: TObject);
210 procedure popSummMemoInsTemplateClick(Sender: TObject);
211 procedure tvSummsAddition(Sender: TObject; Node: TTreeNode);
212 procedure tvSummsDeletion(Sender: TObject; Node: TTreeNode);
213 private
214 FEditingIndex: Integer; // index of Summary being currently edited
215 FChanged: Boolean; // true if any text has changed in the Summary
216 FEditCtrl: TCustomEdit;
217 FDischargeDate: TFMDateTime;
218 FSilent: Boolean;
219 FCurrentContext: TTIUContext;
220 FDefaultContext: TTIUContext;
221 FImageFlag: TBitmap;
222 FEditDCSumm: TEditDCSummRec;
223 FShowAdmissions: Boolean;
224 FVerifySummTitle: Integer;
225 FDocList: TStringList;
226 FConfirmed: boolean;
227 FDeleted: boolean;
228 FLastSummID: string;
229 function NoSummSelected : Boolean;
230 procedure ClearEditControls;
231 function StartNewEdit(NewNoteType: integer): Boolean;
232 procedure DoAutoSave;
233 function LacksRequiredForCreate: Boolean;
234 function GetTitleText(AnIndex: Integer): string;
235 //function MakeTitleText(IsAddendum: Boolean = False): string;
236 procedure SetEditingIndex(const Value: Integer);
237 procedure DisplayPCE;
238 function LockSumm(AnIEN: Int64): Boolean;
239 procedure InsertAddendum;
240 procedure InsertNewSumm(IsIDChild: boolean; AnIDParent: integer);
241 procedure LoadForEdit(PreserveValues: Boolean);
242 procedure RemovePCEFromChanges(IEN: Int64; AVisitStr: string = '');
243 procedure SaveEditedSumm(var Saved: Boolean);
244 procedure SaveCurrentSumm(var Saved: Boolean);
245 procedure ShowPCEControls(ShouldShow: Boolean);
246 function TitleText(AnIndex: Integer): string;
247 procedure ProcessNotifications;
248 procedure SetViewContext(AContext: TTIUContext);
249 function GetDrawers: TFrmDrawers;
250 property EditingIndex: Integer read FEditingIndex write SetEditingIndex;
251 function VerifySummTitle: Boolean;
252 // added for treeview - see also uDocTree.pas
253 procedure LoadSumms;
254 procedure UpdateTreeView(DocList: TStringList; Tree: TORTreeView);
255 procedure EnableDisableIDNotes;
256 procedure DoAttachIDChild(AChild, AParent: TORTreeNode);
257 function SetSummTreeLabel(AContext: TTIUContext): string;
258 public
259 function AllowContextChange(var WhyNot: string): Boolean; override;
260 procedure ClearPtData; override;
261 procedure DisplayPage; override;
262 procedure RequestPrint; override;
263 procedure RequestMultiplePrint(AForm: TfrmPrintList);
264 procedure SetFontSize(NewFontSize: Integer); override;
265 procedure SaveSignItem(const ItemID, ESCode: string);
266 procedure LstSummsToPrint;
267 published
268 property Drawers: TFrmDrawers read GetDrawers; // Keep Drawers published
269 end;
270
271var
272 frmDCSumm: TfrmDCSumm;
273
274implementation
275
276{$R *.DFM}
277
278uses fFrame, fVisit, fEncnt, rCore, uCore, fNoteBA, fNoteBD, fSignItem, fEncounterFrame,
279 rPCE, Clipbrd, fNotePrt, fAddlSigners, fNoteDR, uSpell, rVitals, fTIUView,
280 fTemplateEditor, rTIU, fDCSummProps, fNotesBP, fTemplateFieldEditor, uTemplates,
281 fReminderDialog, dShared, rTemplates, fIconLegend, fNoteIDParents,
282 uAccessibleTreeView, uAccessibleTreeNode, fTemplateDialog;
283
284const
285 NA_CREATE = 0; // New Summ action - create new Summ
286 NA_SHOW = 1; // New Summ action - show current
287 NA_SAVECREATE = 2; // New Summ action - save current then create
288
289 TYP_DC_SUMM = 244;
290 DC_NEW_SUMM = -50; // Holder IEN for a new Summary
291 DC_ADDENDUM = -60; // Holder IEN for a new addendum
292
293 DC_ACT_NEW_SUMM = 2;
294 DC_ACT_ADDENDUM = 3;
295 DC_ACT_EDIT_SUMM = 4;
296 DC_ACT_ID_ENTRY = 5;
297
298 TX_NEED_VISIT = 'A visit is required before creating a new Discharge Summary.';
299 TX_NO_VISIT = 'Insufficient Visit Information';
300 TX_BOILERPLT = 'You have modified the text of this Discharge Summary. Changing the title will' +
301 ' discard the Discharge Summary text.' + CRLF + 'Do you wish to continue?';
302 TX_NEWTITLE = 'Change Discharge Summary Title';
303 TX_REQD_SUMM = 'The following information is required to save a Discharge Summary - ' + CRLF;
304 TX_REQD_ADDM = 'The following information is required to save an addendum - ' + CRLF;
305 TX_REQD_COSIG = CRLF + 'Attending Physician';
306 TX_REQ2 = CRLF + CRLF +
307 'It is recommended that these fields be entered before continuing' + CRLF +
308 'to prevent losing the summary should the application time out.';
309 TX_CREATE_ERR = 'Error Creating Summary';
310 TX_UPDATE_ERR = 'Error Updating Summary';
311 TX_NO_NOTE = 'No Discharge Summary is currently being edited';
312 TX_SAVE_NOTE = 'Save Discharge Summary';
313 TX_ADDEND_NO = 'Cannot make an addendum to a Summary that is being edited';
314 TX_DEL_OK = CRLF + CRLF + 'Delete this Discharge Summary?';
315 TX_DEL_ERR = 'Unable to Delete Summary';
316 TX_SIGN = 'Sign Summary';
317 TX_COSIGN = 'Cosign Summary';
318 TX_SIGN_ERR = 'Unable to Sign Summary';
319
320 TX_NOSUMM = 'No Discharge Summary is currently selected.';
321 TX_NOSUMM_CAP = 'No Summary Selected';
322 TX_NOPRT_NEW = 'This Discharge Summary may not be printed until it is saved';
323 TX_NOPRT_NEW_CAP = 'Save Discharge Summary';
324 TX_NOT_INPATIENT = 'Discharge Summaries are only applicable to hospital admissions.';
325 TX_NO_ADMISSION_CAP = 'No hospital admission was selected';
326 TX_NO_ALERT = 'There is insufficient information to process this alert.' + CRLF +
327 'Either the alert has already been deleted, or it contained invalid data.' + CRLF + CRLF +
328 'Click the NEXT button if you wish to continue processing more alerts.';
329 TX_CAP_NO_ALERT = 'Unable to Process Alert';
330 TX_NO_FUTURE_DT = 'A Reference Date/Time in the future is not allowed.';
331 TX_RELEASE = 'Do you want to release this summary from DRAFT mode to UNSIGNED' + CRLF +
332 'status? This does not release the summary as the official,' + CRLF +
333 'completed Discharge Summary until it is COSIGNED.';
334 //'Do you want to release this discharge summary?';
335 TC_RELEASE = 'Release Document';
336 TX_NEW_SAVE1 = 'You are currently editing:' + CRLF + CRLF;
337 TX_NEW_SAVE2 = CRLF + CRLF + 'Do you wish to save this summary and begin a new one?';
338 TX_NEW_SAVE3 = CRLF + CRLF + 'Do you wish to save this summary and begin a new addendum?';
339 TX_NEW_SAVE4 = CRLF + CRLF + 'Do you wish to save this summary and edit the one selected?';
340 TX_NEW_SAVE5 = CRLF + CRLF + 'Do you wish to save this summary and begin a new Interdisciplinary entry?';
341 TC_NEW_SAVE2 = 'Create New Summary';
342 TC_NEW_SAVE3 = 'Create New Addendum';
343 TC_NEW_SAVE4 = 'Edit Different Summary';
344 TC_NEW_SAVE5 = 'Create New Interdisciplinary Entry';
345 TC_NO_LOCK = 'Unable to Lock Summary';
346 TX_EMPTY_SUMM = CRLF + CRLF + 'This discharge summary contains no text and will not be saved.' + CRLF +
347 'Do you wish to delete this discharge summary?';
348 TC_EMPTY_SUMM = 'Empty Note';
349 TX_EMPTY_SUMM1 = 'This document contains no text and can not be signed.';
350 TX_ABSAVE = 'It appears the session terminated abnormally when this' + CRLF +
351 'note was last edited. Some text may not have been saved.' + CRLF + CRLF +
352 'Do you wish to continue and sign the note?';
353 TC_ABSAVE = 'Possible Missing Text';
354 TX_NO_BOIL = 'There is no boilerplate text associated with this title.';
355 TC_NO_BOIL = 'Load Boilerplate Text';
356 TX_BLR_CLEAR = 'Do you want to clear the previously loaded boilerplate text?';
357 TC_BLR_CLEAR = 'Clear Previous Boilerplate Text';
358 TX_MISSING_FIELDS = 'This document can not be saved. An ATTENDING must first be entered.';
359 TC_MISSING_FIELDS = 'Unable to save';
360 TX_DETACH_CNF = 'Confirm Detachment';
361 TX_DETACH_FAILURE = 'Detach failed';
362 TX_RETRACT_CAP = 'Retraction Notice';
363 TX_RETRACT = 'This document will now be RETRACTED. As Such, it has been removed' +CRLF +
364 ' from public view, and from typical Releases of Information,' +CRLF +
365 ' but will remain indefinitely discoverable to HIMS.' +CRLF +CRLF;
366 TX_AUTH_SIGNED = 'Author has not signed, are you SURE you want to sign.' +CRLF;
367
368var
369 uPCEShow, uPCEEdit: TPCEData;
370 ViewContext: Integer;
371 frmDrawers: TfrmDrawers;
372 uDCSummContext: TTIUContext;
373 ColumnToSort: Integer;
374 ColumnSortForward: Boolean;
375 uChanging: Boolean;
376 uIDNotesActive: Boolean;
377
378{ TPage common methods --------------------------------------------------------------------- }
379
380function TfrmDCSumm.AllowContextChange(var WhyNot: string): Boolean;
381begin
382 dlgFindText.CloseDialog;
383 Result := inherited AllowContextChange(WhyNot); // sets result = true
384 if Assigned(frmTemplateDialog) then
385 if Screen.ActiveForm = frmTemplateDialog then
386 //if (fsModal in frmTemplateDialog.FormState) then
387 case BOOLCHAR[frmFrame.CCOWContextChanging] of
388 '1': begin
389 WhyNot := 'A template in progress will be aborted. ';
390 Result := False;
391 end;
392 '0': begin
393 if WhyNot = 'COMMIT' then
394 begin
395 FSilent := True;
396 frmTemplateDialog.Silent := True;
397 frmTemplateDialog.ModalResult := mrCancel;
398 end;
399 end;
400 end;
401 if EditingIndex <> -1 then
402 case BOOLCHAR[frmFrame.CCOWContextChanging] of
403 '1': begin
404 if memNewSumm.GetTextLen > 0 then
405 WhyNot := WhyNot + 'A discharge summary in progress will be saved as unsigned. '
406 else
407 WhyNot := WhyNot + 'An empty discharge summary in progress will be deleted. ';
408 Result := False;
409 end;
410 '0': begin
411 if WhyNot = 'COMMIT' then FSilent := True;
412 SaveCurrentSumm(Result);
413 end;
414 end;
415 if Assigned(frmEncounterFrame) then
416 if Screen.ActiveForm = frmEncounterFrame then
417 //if (fsModal in frmEncounterFrame.FormState) then
418 case BOOLCHAR[frmFrame.CCOWContextChanging] of
419 '1': begin
420 WhyNot := WhyNot + 'Encounter information being edited will not be saved';
421 Result := False;
422 end;
423 '0': begin
424 if WhyNot = 'COMMIT' then
425 begin
426 FSilent := True;
427 frmEncounterFrame.Abort := False;
428 frmEncounterFrame.Cancel := True;
429 end;
430 end;
431 end;
432end;
433
434procedure TfrmDCSumm.LstSummsToPrint;
435var
436 AParentID: string;
437 SavedDocID: string;
438 Saved: boolean;
439begin
440 inherited;
441 if lstSumms.ItemIEN = 0 then exit;
442 SavedDocID := lstSumms.ItemID;
443 if EditingIndex <> -1 then
444 begin
445 SaveCurrentSumm(Saved);
446 if not Saved then Exit;
447 LoadSumms;
448 with tvSumms do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
449 end;
450 if tvSumms.Selected = nil then exit;
451 AParentID := frmPrintList.SelectParentFromList(tvSumms,CT_DCSUMM);
452 if AParentID = '' then exit;
453 with tvSumms do Selected := FindPieceNode(AParentID, 1, U, Items.GetFirstNode);
454end;
455
456procedure TfrmDCSumm.ClearPtData;
457{ clear all controls that contain patient specific information }
458begin
459 inherited ClearPtData;
460 ClearEditControls;
461 uChanging := True;
462 tvSumms.Items.BeginUpdate;
463 KillDocTreeObjects(tvSumms);
464 tvSumms.Items.Clear;
465 tvSumms.Items.EndUpdate;
466 uChanging := False;
467 lstSumms.Clear;
468 memSumm.Clear;
469 memPCEShow.Clear;
470 uPCEShow.Clear;
471 uPCEEdit.Clear;
472 frmDrawers.ResetTemplates;
473end;
474
475procedure TfrmDCSumm.DisplayPage;
476{ causes page to be visible and conditionally executes initialization code }
477begin
478 inherited DisplayPage;
479 frmFrame.ShowHideChartTabMenus(mnuViewChart);
480 frmFrame.mnuFilePrint.Tag := CT_DCSUMM;
481 frmFrame.mnuFilePrint.Enabled := True;
482 frmFrame.mnuFilePrintSetup.Enabled := True;
483 frmFrame.mnuFilePrintSelectedItems.Enabled := True;
484 if InitPage then
485 begin
486 EnableDisableIDNotes;
487 FDefaultContext := GetCurrentDCSummContext;
488 FCurrentContext := FDefaultContext;
489 popSummMemoSpell.Visible := SpellCheckAvailable;
490 popSummMemoGrammar.Visible := popSummMemoSpell.Visible;
491 Z11.Visible := popSummMemoSpell.Visible;
492 timAutoSave.Interval := User.AutoSave * 1000; // convert seconds to milliseconds
493 SetEqualTabStops(memNewSumm);
494 end;
495 // to indent the right margin need to set Paragraph.RightIndent for each paragraph?
496 if InitPatient and not (CallingContext = CC_NOTIFICATION) then
497 begin
498 SetViewContext(FDefaultContext);
499 end;
500 case CallingContext of
501 CC_INIT_PATIENT: if not InitPatient then
502 begin
503 SetViewContext(FDefaultContext);
504 end;
505 CC_NOTIFICATION: ProcessNotifications;
506 end;
507end;
508
509procedure TfrmDCSumm.RequestPrint;
510var
511 Saved: Boolean;
512begin
513 with lstSumms do
514 begin
515 if ItemIndex = EditingIndex then
516 //if ItemIEN < 0 then
517 begin
518 SaveCurrentSumm(Saved);
519 if not Saved then Exit;
520 end;
521 if ItemIEN > 0 then PrintNote(ItemIEN, MakeDCSummDisplayText(Items[ItemIndex])) else
522 begin
523 if ItemIEN = 0 then InfoBox(TX_NO_NOTE, TX_NOSUMM_CAP, MB_OK);
524 if ItemIEN < 0 then InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK);
525 end;
526 end;
527end;
528
529procedure TfrmDCSumm.RequestMultiplePrint(AForm: TfrmPrintList);
530var
531 NoteIEN: int64;
532 i: integer;
533begin
534 with AForm.lbIDParents do
535 begin
536 for i := 0 to Items.Count - 1 do
537 begin
538 if Selected[i] then
539 begin
540 NoteIEN := StrToInt64def(Piece(TStringList(Items.Objects[i])[0],U,1),0);
541 if NoteIEN > 0 then PrintNote(NoteIEN, MakeDCSummDisplayText(TStringList(Items.Objects[i])[0]), TRUE) else
542 begin
543 if ItemIEN = 0 then InfoBox(TX_NO_NOTE, TX_NOSUMM_CAP, MB_OK);
544 if ItemIEN < 0 then InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK);
545 end;
546 end; {if selected}
547 end; {for}
548 end {with}
549end;
550
551procedure TfrmDCSumm.SetFontSize(NewFontSize: Integer);
552{ adjusts the font size of any controls that don't have ParentFont = True }
553begin
554 inherited SetFontSize(NewFontSize);
555 memSumm.Font.Size := NewFontSize;
556 memNewSumm.Font.Size := NewFontSize;
557 lblTitle.Font.Size := NewFontSize;
558 frmDrawers.Font.Size := NewFontSize;
559 SetEqualTabStops(memNewSumm);
560 // adjust heights of pnlAction, pnlFields, and lstEncntShow
561end;
562
563procedure TfrmDCSumm.mnuChartTabClick(Sender: TObject);
564{ reroute to Chart Tab menu of the parent form: frmFrame }
565begin
566 inherited;
567 frmFrame.mnuChartTabClick(Sender);
568end;
569
570{ General procedures ----------------------------------------------------------------------- }
571
572procedure TfrmDCSumm.ClearEditControls;
573{ resets controls used for entering a new Discharge Summary }
574begin
575 // clear FEditDCSumm (should FEditDCSumm be an object with a clear method?)
576 with FEditDCSumm do
577 begin
578 DocType := 0;
579 EditIEN := 0;
580 Title := 0;
581 TitleName := '';
582 AdmitDateTime := 0;
583 DischargeDateTime := 0;
584 DictDateTime := 0;
585 Dictator := 0;
586 DictatorName := '';
587 Cosigner := 0;
588 CosignerName := '';
589 Transcriptionist := 0;
590 TranscriptionistName := '';
591 Attending := 0;
592 AttendingName := '';
593 Urgency := '';
594 UrgencyName := '';
595 Location := 0;
596 LocationName := '';
597 Addend := 0;
598 VisitStr := '';
599 {LastCosigner & LastCosignerName aren't cleared because they're used as default for next note.}
600 Lines := nil;
601 end;
602 // clear the editing controls (also clear the new labels?)
603 memNewSumm.Clear;
604 timAutoSave.Enabled := False;
605 // clear the PCE object for editing
606 uPCEEdit.Clear;
607 // set the tracking variables to initial state
608 EditingIndex := -1;
609 FChanged := False;
610end;
611
612procedure TfrmDCSumm.ShowPCEControls(ShouldShow: Boolean);
613begin
614 sptVert.Visible := ShouldShow;
615 memPCEShow.Visible := ShouldShow;
616 if(ShouldShow) then
617 sptVert.Top := memPCEShow.Top - sptVert.Height;
618 memSumm.Invalidate;
619end;
620
621procedure TfrmDCSumm.DisplayPCE;
622{ displays PCE information if appropriate & enables/disabled editing of PCE data }
623var
624 VitalStr: TStringlist;
625 NoPCE: boolean;
626 ActionSts: TActionRec;
627
628begin
629 memPCEShow.Clear;
630 with lstSumms do if ItemIndex = EditingIndex then
631 begin
632 with uPCEEdit do
633 begin
634 AddStrData(memPCEShow.Lines);
635 NoPCE := (memPCEShow.Lines.Count = 0);
636 VitalStr := TStringList.create;
637 try
638 GetVitalsFromDate(VitalStr, uPCEEdit);
639 AddVitalData(VitalStr, memPCEShow.Lines);
640 finally
641 VitalStr.free;
642 end;
643 cmdPCE.Enabled := CanEditPCE(uPCEEdit);
644 ShowPCEControls(cmdPCE.Enabled or (memPCEShow.Lines.Count > 0));
645 if(NoPCE and memPCEShow.Visible) then
646 memPCEShow.Lines.Insert(0, TX_NOPCE);
647
648 frmDrawers.DisplayDrawers(TRUE, [odTemplates],[odTemplates]);
649 cmdNewSumm.Visible := FALSE;
650 lblSpace1.Top := cmdPCE.Top - lblSpace1.Height;
651 end;
652 end else
653 begin
654 cmdPCE.Enabled := False;
655
656 frmDrawers.DisplayDrawers(FALSE);
657 cmdNewSumm.Visible := TRUE;
658 lblSpace1.Top := cmdNewSumm.Top - lblSpace1.Height;
659
660 ActOnDocument(ActionSts, lstSumms.ItemIEN, 'VIEW');
661 if ActionSts.Success then
662 begin
663 StatusText('Retrieving encounter information...');
664 with uPCEShow do
665 begin
666 NoteDateTime := MakeFMDateTime(Piece(lstSumms.Items[lstSumms.ItemIndex], U, 3));
667 PCEForNote(lstSumms.ItemIEN, uPCEEdit);
668 AddStrData(memPCEShow.Lines);
669 NoPCE := (memPCEShow.Lines.Count = 0);
670 VitalStr := TStringList.create;
671 try
672 GetVitalsFromNote(VitalStr, uPCEShow, lstSumms.ItemIEN);
673 AddVitalData(VitalStr, memPCEShow.Lines);
674 finally
675 VitalStr.free;
676 end;
677 ShowPCEControls(memPCEShow.Lines.Count > 0);
678 if(NoPCE and memPCEShow.Visible) then
679 memPCEShow.Lines.Insert(0, TX_NOPCE);
680 end;
681 StatusText('');
682 end
683 else
684 ShowPCEControls(FALSE);
685 end; {if ItemIndex}
686 memPCEShow.SelStart := 0;
687 popSummMemoEncounter.Enabled := cmdPCE.Enabled;
688end;
689
690procedure TfrmDCSumm.InsertNewSumm(IsIDChild: boolean; AnIDParent: integer);
691{ creates the editing context for a new Discharge Summary & inserts stub into top of view list}
692const
693 USE_CURRENT_VISITSTR = -2;
694var
695 EnableAutosave, HaveRequired, Saved: Boolean;
696 CreatedSumm: TCreatedDoc;
697 ListItemForEdit: string;
698 TmpBoilerPlate: TStringList;
699 tmpNode: TTreeNode;
700 x, WhyNot: string;
701 DocInfo: string;
702begin
703 EnableAutosave := FALSE;
704 TmpBoilerPlate := nil;
705 try
706 ClearEditControls;
707 FShowAdmissions := True;
708 FillChar(FEditDCSumm, SizeOf(FEditDCSumm), 0); //v15.7
709 with FEditDCSumm do
710 begin
711 EditIEN := 0;
712 DocType := TYP_DC_SUMM;
713 Title := DfltDCSummTitle;
714 TitleName := DfltDCSummTitleName;
715 if IsIDChild and (not CanTitleBeIDChild(Title, WhyNot)) then
716 begin
717 Title := 0;
718 TitleName := '';
719 end;
720 DictDateTime := FMNow;
721 Dictator := User.DUZ;
722 DictatorName := User.Name;
723 if IsIDChild then
724 IDParent := AnIDParent
725 else
726 IDParent := 0;
727 end;
728 // check to see if interaction necessary to get required fields
729 if LacksRequiredForCreate or VerifySummTitle
730 then HaveRequired := ExecuteDCSummProperties(FEditDCSumm, ListItemForEdit, FShowAdmissions, IsIDChild)
731 else HaveRequired := True;
732 if HaveRequired then
733 begin
734 if ListItemForEdit <> '' then
735 begin
736 lstSumms.ItemIndex := -1;
737 lstSumms.SelectByID(Piece(ListItemForEdit, U, 1));
738 if lstSumms.ItemIndex < 0 then
739 begin
740 lstSumms.Items.Insert(0, ListItemForEdit);
741 lstSumms.ItemIndex := 0;
742 end;
743 if lstSumms.ItemIndex = EditingIndex then Exit;
744 if EditingIndex > -1 then
745 begin
746 if InfoBox(TX_NEW_SAVE1 + MakeDCSummDisplayText(lstSumms.Items[EditingIndex]) + TX_NEW_SAVE2,
747 TC_NEW_SAVE2, MB_YESNO) = IDNO then exit
748 else
749 begin
750 SaveCurrentSumm(Saved);
751 if not Saved then exit;
752 end;
753 end;
754 //if not StartNewEdit then Exit;
755 lstSummsClick(Self);
756 LoadForEdit(True);
757 Exit;
758 end
759 else
760 begin
761 // set up uPCEEdit for entry of new note
762 uPCEEdit.UseEncounter := True;
763 uPCEEdit.NoteDateTime := FEditDCSumm.DischargeDateTime;
764 uPCEEdit.PCEForNote(USE_CURRENT_VISITSTR, uPCEShow);
765 FEditDCSumm.NeedCPT := uPCEEdit.CPTRequired;
766 // create the note
767 PutNewDCSumm(CreatedSumm, FEditDCSumm);
768 uPCEEdit.NoteIEN := CreatedSumm.IEN;
769 if CreatedSumm.IEN > 0 then LockDocument(CreatedSumm.IEN, CreatedSumm.ErrorText);
770 if CreatedSumm.ErrorText = '' then
771 begin
772 //x := $$RESOLVE^TIUSRVLO formatted string
773 //7348^Discharge Summary^3000913^NERD, YOURA (N0165)^1329;Rich Vertigan;VERTIGAN,RICH^8E REHAB MED^unverified^Adm: 11/05/98;2981105.095547^ ;^^0^^^2
774 with FEditDCSumm do
775 begin
776 x := IntToStr(CreatedSumm.IEN) + U + TitleName + U + FloatToStr(DischargeDateTime) + U +
777 Patient.Name + U + IntToStr(Dictator) + ';' + DictatorName + U + LocationName + U + 'new' + U +
778 'Adm: ' + FormatFMDateTime('mmm dd,yyyy', AdmitDateTime) + ';' + FloatToStr(AdmitDateTime) + U +
779 'Dis: ' + FormatFMDateTime('mmm dd,yyyy', DischargeDateTime) + ';' + FloatToStr(DischargeDateTime) +
780 U + U + U + U + U + U;
781 end;
782 lstSumms.Items.Insert(0, x);
783 uChanging := True;
784 tvSumms.Items.BeginUpdate;
785 if IsIDChild then
786 begin
787 tmpNode := tvSumms.FindPieceNode(IntToStr(AnIDParent), 1, U, tvSumms.Items.GetFirstNode);
788 tmpNode.ImageIndex := IMG_IDNOTE_OPEN;
789 tmpNode.SelectedIndex := IMG_IDNOTE_OPEN;
790 tmpNode := tvSumms.Items.AddChildObjectFirst(tmpNode, MakeDCSummDisplayText(x), MakeDCSummTreeObject(x));
791 tmpNode.ImageIndex := IMG_ID_CHILD;
792 tmpNode.SelectedIndex := IMG_ID_CHILD;
793 end
794 else
795 begin
796 tmpNode := tvSumms.Items.AddObjectFirst(tvSumms.Items.GetFirstNode, 'New Summary in Progress',
797 MakeDCSummTreeObject('NEW^New Summary in Progress^^^^^^^^^^^%^0'));
798 TORTreeNode(tmpNode).StringData := 'NEW^New Summary in Progress^^^^^^^^^^^%^0';
799 tmpNode.ImageIndex := IMG_TOP_LEVEL;
800 tmpNode := tvSumms.Items.AddChildObjectFirst(tmpNode, MakeDCSummDisplayText(x), MakeDCSummTreeObject(x));
801 tmpNode.ImageIndex := IMG_SINGLE;
802 tmpNode.SelectedIndex := IMG_SINGLE;
803 end;
804 TORTreeNode(tmpNode).StringData := x;
805 tvSumms.Selected := tmpNode;
806 tvSumms.Items.EndUpdate;
807 uChanging := False;
808 Changes.Add(CH_SUM, IntToStr(CreatedSumm.IEN), GetTitleText(0), '', CH_SIGN_YES);
809 lstSumms.ItemIndex := 0;
810 EditingIndex := 0;
811 if not assigned(TmpBoilerPlate) then
812 TmpBoilerPlate := TStringList.Create;
813 LoadBoilerPlate(TmpBoilerPlate, FEditDCSumm.Title);
814 FChanged := False;
815 cmdChangeClick(Self); // will set captions, sign state for Changes
816 lstSummsClick(Self); // will make pnlWrite visible
817 if timAutoSave.Interval <> 0 then EnableAutosave := TRUE;
818 memNewSumm.SetFocus;
819 end else
820 begin
821 InfoBox(CreatedSumm.ErrorText, TX_CREATE_ERR, MB_OK);
822 HaveRequired := False;
823 end; {if CreatedSumm.IEN}
824 end; {loaded for edit}
825 end; {if HaveRequired}
826 if not HaveRequired then ClearEditControls;
827 finally
828 if assigned(TmpBoilerPlate) then
829 begin
830 DocInfo := MakeXMLParamTIU(IntToStr(CreatedSumm.IEN), FEditDCSumm);
831 ExecuteTemplateOrBoilerPlate(TmpBoilerPlate, FEditDCSumm.Title, ltTitle, Self, 'Title: ' + FEditDCSumm.TitleName, DocInfo);
832 memNewSumm.Lines.Assign(TmpBoilerPlate);
833 TmpBoilerPlate.Free;
834 end;
835 if EnableAutosave then // Don't enable autosave until after dialog fields have been resolved
836 timAutoSave.Enabled := True;
837 end;
838end;
839
840procedure TfrmDCSumm.InsertAddendum;
841{ sets up fields of pnlWrite to write an addendum for the selected Summary}
842const
843 AS_ADDENDUM = True;
844 IS_ID_CHILD = False;
845var
846 HaveRequired: Boolean;
847 CreatedSumm: TCreatedDoc;
848 ListItemForEdit: string;
849 tmpNode: TTreeNode;
850 x: string;
851begin
852 ClearEditControls;
853 FShowAdmissions := False;
854 with FEditDCSumm do
855 begin
856 DocType := TYP_ADDENDUM;
857 Title := TitleForNote(lstSumms.ItemIEN);
858 TitleName := Piece(lstSumms.Items[lstSumms.ItemIndex], U, 2);
859 if Copy(TitleName,1,1) = '+' then TitleName := Copy(TitleName, 3, 199);
860 DictDateTime := FMNow;
861 Dictator := User.DUZ;
862 DictatorName := User.Name;
863 Addend := lstSumms.ItemIEN;
864 end;
865 // check to see if interaction necessary to get required fields
866 if LacksRequiredForCreate
867 then HaveRequired := ExecuteDCSummProperties(FEditDCSumm, ListItemForEdit, FShowAdmissions, IS_ID_CHILD)
868 else HaveRequired := True;
869 if HaveRequired then
870 begin
871 with FEditDCSumm do
872 begin
873 uPCEEdit.NoteDateTime := DischargeDateTime;
874 uPCEEdit.PCEForNote(Addend, uPCEShow);
875 Location := uPCEEdit.Location;
876 LocationName := ExternalName(uPCEEdit.Location, 44);
877 AdmitDateTime := uPCEEdit.DateTime;
878 DischargeDateTime := StrToFMDateTime(GetDischargeDate(Patient.DFN, FloatToStr(AdmitDateTime)));
879 if DischargeDateTime <= 0 then DischargeDateTime := FMNow;
880 end;
881 PutDCAddendum(CreatedSumm, FEditDCSumm, FEditDCSumm.Addend);
882 uPCEEdit.NoteIEN := CreatedSumm.IEN;
883 if CreatedSumm.IEN > 0 then LockDocument(CreatedSumm.IEN, CreatedSumm.ErrorText);
884 if CreatedSumm.ErrorText = '' then
885 begin
886 with FEditDCSumm do
887 begin
888 x := IntToStr(CreatedSumm.IEN) + U + 'Addendum to ' + TitleName + U + FloatToStr(DischargeDateTime) + U +
889 Patient.Name + U + IntToStr(Dictator) + ';' + DictatorName + U + LocationName + U + 'new' + U +
890 'Adm: ' + FormatFMDateTime('mmm dd,yyyy', AdmitDateTime) + ';' + FloatToStr(AdmitDateTime) + U +
891 'Dis: ' + FormatFMDateTime('mmm dd,yyyy', DischargeDateTime) + ';' + FloatToStr(DischargeDateTime) +
892 U + U + U + U + U + U;
893 end;
894 lstSumms.Items.Insert(0, x);
895 uChanging := True;
896 tvSumms.Items.BeginUpdate;
897 tmpNode := tvSumms.Items.AddObjectFirst(tvSumms.Items.GetFirstNode, 'New Addendum in Progress',
898 MakeDCSummTreeObject('ADDENDUM^New Addendum in Progress^^^^^^^^^^^%^0'));
899 TORTreeNode(tmpNode).StringData := 'ADDENDUM^New Addendum in Progress^^^^^^^^^^^%^0';
900 tmpNode.ImageIndex := IMG_TOP_LEVEL;
901 tmpNode := tvSumms.Items.AddChildObjectFirst(tmpNode, MakeDCSummDisplayText(x), MakeDCSummTreeObject(x));
902 TORTreeNode(tmpNode).StringData := x;
903 tmpNode.ImageIndex := IMG_ADDENDUM;
904 tmpNode.SelectedIndex := IMG_ADDENDUM;
905 tvSumms.Selected := tmpNode;
906 tvSumms.Items.EndUpdate;
907 uChanging := False;
908 Changes.Add(CH_SUM, IntToStr(CreatedSumm.IEN), GetTitleText(0), '', CH_SIGN_YES);
909 lstSumms.ItemIndex := 0;
910 EditingIndex := 0;
911 cmdChangeClick(Self); // will set captions, sign state for Changes
912 lstSummsClick(Self); // will make pnlWrite visible
913 if timAutoSave.Interval <> 0 then timAutoSave.Enabled := True;
914 memNewSumm.SetFocus;
915 end else
916 begin
917 InfoBox(CreatedSumm.ErrorText, TX_CREATE_ERR, MB_OK);
918 HaveRequired := False;
919 end; {if CreatedNote.IEN}
920 end; {if HaveRequired}
921 if not HaveRequired then ClearEditControls;
922end;
923
924procedure TfrmDCSumm.LoadForEdit(PreserveValues: Boolean);
925{ retrieves an existing Summ and places the data in the fields of pnlWrite }
926var
927 tmpNode: TTreeNode;
928 x: string;
929begin
930 if not PreserveValues then ClearEditControls;
931 if not LockSumm(lstSumms.ItemIEN) then Exit;
932 EditingIndex := lstSumms.ItemIndex;
933 Changes.Add(CH_SUM, lstSumms.ItemID, GetTitleText(EditingIndex), '', CH_SIGN_YES);
934 if not PreserveValues then GetDCSummForEdit(FEditDCSumm, lstSumms.ItemIEN);
935 if FEditDCSumm.Lines <> nil then memNewSumm.Lines.Assign(FEditDCSumm.Lines);
936 FChanged := False;
937 if FEditDCSumm.Title = TYP_ADDENDUM then
938 begin
939 FEditDCSumm.DocType := TYP_ADDENDUM;
940 FEditDCSumm.TitleName := Piece(lstSumms.Items[lstSumms.ItemIndex], U, 2);
941 if Copy(FEditDCSumm.TitleName,1,1) = '+' then FEditDCSumm.TitleName := Copy(FEditDCSumm.TitleName, 3, 199);
942 if CompareText(Copy(FEditDCSumm.TitleName, 1, 8), 'Addendum') <> 0
943 then FEditDCSumm.TitleName := FEditDCSumm.TitleName + 'Addendum to ';
944 end;
945
946 uChanging := True;
947 tvSumms.Items.BeginUpdate;
948 tmpNode := tvSumms.FindPieceNode('EDIT', 1, U, nil);
949 if tmpNode = nil then
950 begin
951 tmpNode := tvSumms.Items.AddObjectFirst(tvSumms.Items.GetFirstNode, 'Summary being edited',
952 MakeDCSummTreeObject('EDIT^Summary being edited^^^^^^^^^^^%^0'));
953 TORTreeNode(tmpNode).StringData := 'EDIT^Summary being edited^^^^^^^^^^^%^0';
954 end
955 else
956 tmpNode.DeleteChildren;
957 x := lstSumms.Items[lstSumms.ItemIndex];
958 tmpNode.ImageIndex := IMG_TOP_LEVEL;
959 tmpNode := tvSumms.Items.AddChildObjectFirst(tmpNode, MakeDCSummDisplayText(x), MakeDCSummTreeObject(x));
960 TORTreeNode(tmpNode).StringData := x;
961 if CompareText(Copy(FEditDCSumm.TitleName, 1, 8), 'Addendum') <> 0 then
962 tmpNode.ImageIndex := IMG_SINGLE
963 else
964 tmpNode.ImageIndex := IMG_ADDENDUM;
965 tmpNode.SelectedIndex := tmpNode.ImageIndex;
966 tvSumms.Selected := tmpNode;
967 tvSumms.Items.EndUpdate;
968 uChanging := False;
969
970 uPCEEdit.NoteDateTime := MakeFMDateTime(Piece(lstSumms.Items[lstSumms.ItemIndex], U, 3));
971 uPCEEdit.PCEForNote(lstSumms.ItemIEN, uPCEShow);
972 FEditDCSumm.NeedCPT := uPCEEdit.CPTRequired;
973 cmdChangeClick(Self); // will set captions, sign state for Changes
974 lstSummsClick(Self); // will make pnlWrite visible
975 if timAutoSave.Interval <> 0 then timAutoSave.Enabled := True;
976 memNewSumm.SetFocus;
977end;
978
979function TfrmDCSumm.TitleText(AnIndex: Integer): string;
980{ returns non-tabbed text for the title of a Summ given the ItemIndex in lstSumms }
981begin
982 with lstSumms do
983 Result := FormatFMDateTime('mmm dd,yy', MakeFMDateTime(Piece(Items[AnIndex], U, 3))) +
984 ' ' + Piece(Items[AnIndex], U, 2);
985end;
986
987procedure TfrmDCSumm.SaveEditedSumm(var Saved: Boolean);
988{ validates fields and sends the updated Summ to the server }
989var
990 UpdatedSumm: TCreatedDoc;
991 x: string;
992begin
993 Saved := False;
994 if (memNewSumm.GetTextLen = 0) or (not ContainsVisibleChar(memNewSumm.Text)) then
995 begin
996 lstSumms.ItemIndex := EditingIndex;
997 x := lstSumms.ItemID;
998 uChanging := True;
999 tvSumms.Selected := tvSumms.FindPieceNode(x, 1, U, tvSumms.Items.GetFirstNode);
1000 uChanging := False;
1001 tvSummsChange(Self, tvSumms.Selected);
1002 if FSilent or
1003 ((not FSilent) and
1004 (InfoBox(GetTitleText(EditingIndex) + TX_EMPTY_SUMM, TC_EMPTY_SUMM, MB_YESNO) = IDYES))
1005 then
1006 begin
1007 FConfirmed := True;
1008 mnuActDeleteClick(Self);
1009 Saved := True;
1010 FDeleted := True;
1011 end
1012 else
1013 FConfirmed := False;
1014 Exit;
1015 end;
1016 //ExpandTabsFilter(memNewSumm.Lines, TAB_STOP_CHARS);
1017 with FEditDCSumm do
1018 begin
1019 if (Attending = 0) and (not FSilent) then
1020 begin
1021 InfoBox(TX_MISSING_FIELDS, TC_MISSING_FIELDS,MB_OK);
1022 cmdChangeClick(mnuActSave);
1023 Exit;
1024 end;
1025 NeedCPT := uPCEEdit.CPTRequired; {*RAB*}
1026 Lines := memNewSumm.Lines;
1027 if RequireMASVerification(lstSumms.GetIEN(EditingIndex), TYP_DC_SUMM) then
1028 Status := TIU_ST_UNVER;
1029 (*if (User.DUZ <> Dictator) and (User.DUZ <> Attending) and*) //ALL USERS??
1030 if RequireRelease(lstSumms.GetIEN(EditingIndex), TYP_DC_SUMM) then
1031 begin
1032 if not FSilent then
1033 begin
1034 if InfoBox(TX_RELEASE, TC_RELEASE, MB_YESNO) = IDNO then
1035 Status := TIU_ST_UNREL;
1036 end
1037 else // always save as unreleased on timeout
1038 Status := TIU_ST_UNREL;
1039 end;
1040 end;
1041 timAutoSave.Enabled := False;
1042 try
1043 PutEditedDCSumm(UpdatedSumm, FEditDCSumm, lstSumms.GetIEN(EditingIndex));
1044 finally
1045 timAutoSave.Enabled := True;
1046 end;
1047 if UpdatedSumm.IEN > 0 then
1048 begin
1049 if (FEditDCSumm.Status in [TIU_ST_UNREL, TIU_ST_UNVER]) then
1050 begin
1051 Changes.Remove(CH_SUM, IntToStr(UpdatedSumm.IEN)); // DON'T REPROMPT ON PATIENT CHANGE
1052 UnlockDocument(UpdatedSumm.IEN); // Unlock only if UNRELEASED or UNVERIFIED
1053 end;
1054 // otherwise, there's no unlocking here since the note is still in Changes after a save
1055 if lstSumms.ItemIndex = EditingIndex then
1056 begin
1057 EditingIndex := -1;
1058 lstSummsClick(Self);
1059 end;
1060 EditingIndex := -1; // make sure EditingIndex reset even if not viewing edited note
1061 Saved := True;
1062 FChanged := False;
1063 end else
1064 begin
1065 if not FSilent then
1066 InfoBox(TX_SAVE_ERROR1 + UpdatedSumm.ErrorText + TX_SAVE_ERROR2, TC_SAVE_ERROR, MB_OK or MB_ICONWARNING);
1067 end;
1068end;
1069
1070procedure TfrmDCSumm.SaveCurrentSumm(var Saved: Boolean);
1071{ called whenever a Summ should be saved - uses IEN to call appropriate save logic }
1072begin
1073 if EditingIndex < 0 then Exit;
1074 SaveEditedSumm(Saved);
1075end;
1076
1077{ Form events ------------------------------------------------------------------------------ }
1078
1079procedure TfrmDCSumm.pnlRightResize(Sender: TObject);
1080{ memSumm (TRichEdit) doesn't repaint appropriately unless its parent panel is refreshed }
1081begin
1082 inherited;
1083 pnlRight.Refresh;
1084 memSumm.Repaint;
1085end;
1086
1087procedure TfrmDCSumm.pnlWriteResize(Sender: TObject);
1088const
1089 LEFT_MARGIN = 4;
1090begin
1091 inherited;
1092 LimitEditWidth(memNewSumm, MAX_ENTRY_WIDTH - 1);
1093 memNewSumm.Constraints.MinWidth := TextWidthByFont(memNewSumm.Font.Handle, StringOfChar('X', MAX_ENTRY_WIDTH)) + (LEFT_MARGIN * 2) + ScrollBarWidth;
1094 pnlLeft.Width := self.ClientWidth - pnlWrite.Width - sptHorz.Width;
1095end;
1096
1097{ Left panel (selector) events ------------------------------------------------------------- }
1098
1099procedure TfrmDCSumm.lstSummsClick(Sender: TObject);
1100{ loads the text for the selected Summ or displays the editing panel for the selected Summ }
1101begin
1102 inherited;
1103 with lstSumms do if ItemIndex = -1 then Exit
1104 else if ItemIndex = EditingIndex then
1105 begin
1106 pnlWrite.Visible := True;
1107 pnlRead.Visible := False;
1108 mnuViewDetail.Enabled := False;
1109 mnuActChange.Enabled := True;
1110 mnuActLoadBoiler.Enabled := True;
1111 end else
1112 begin
1113 StatusText('Retrieving selected Discharge Summary...');
1114 Screen.Cursor := crHourGlass;
1115 pnlRead.Visible := True;
1116 pnlWrite.Visible := False;
1117 lblTitle.Caption := MakeDCSummDisplayText(Items[ItemIndex]);
1118 lvSumms.Caption := lblTitle.Caption;
1119 lblTitle.Hint := lblTitle.Caption;
1120 //lblTitle.Caption := Piece(DisplayText[ItemIndex], #9, 1) + ' ' + Piece(DisplayText[ItemIndex], #9, 2);
1121 LoadDocumentText(memSumm.Lines, ItemIEN);
1122 memSumm.SelStart := 0;
1123 mnuViewDetail.Enabled := True;
1124 mnuViewDetail.Checked := False;
1125 mnuActChange.Enabled := False;
1126 mnuActLoadBoiler.Enabled := False;
1127 Screen.Cursor := crDefault;
1128 StatusText('');
1129 end;
1130 DisplayPCE;
1131 pnlRight.Refresh;
1132 memNewSumm.Repaint;
1133 memSumm.Repaint;
1134 NotifyOtherApps(NAE_REPORT, 'TIU^' + lstSumms.ItemID);
1135end;
1136
1137procedure TfrmDCSumm.cmdNewSummClick(Sender: TObject);
1138{ maps 'New Summ' button to the New Discharge Summary menu item }
1139begin
1140 inherited;
1141 mnuActNewClick(Self);
1142end;
1143
1144procedure TfrmDCSumm.cmdPCEClick(Sender: TObject);
1145begin
1146 inherited;
1147 cmdPCE.Enabled := False;
1148 UpdatePCE(uPCEEdit);
1149 cmdPCE.Enabled := True;
1150 if frmFrame.Closing then exit;
1151 DisplayPCE;
1152end;
1153
1154procedure TfrmDCSumm.cmdOrdersClick(Sender: TObject);
1155begin
1156 inherited;
1157 { call add orders here }
1158end;
1159
1160{ Right panel (editor) events -------------------------------------------------------------- }
1161
1162procedure TfrmDCSumm.memNewSummChange(Sender: TObject);
1163{ sets FChanged to record that the Summ has really been edited }
1164begin
1165 inherited;
1166 FChanged := True;
1167end;
1168
1169{ View menu events ------------------------------------------------------------------------- }
1170
1171procedure TfrmDCSumm.mnuViewClick(Sender: TObject);
1172{ changes the list of Summs available for viewing }
1173var
1174 AuthCtxt: TAuthorContext;
1175 DateRange: TNoteDateRange;
1176 Saved: Boolean;
1177begin
1178 inherited;
1179 if EditingIndex <> -1 then
1180 begin
1181 SaveCurrentSumm(Saved);
1182 if not Saved then Exit;
1183 end;
1184 FLastSummID := lstSumms.ItemID;
1185 StatusText('Retrieving Discharge Summary list...');
1186 mnuViewDetail.Checked := False;
1187 if Sender is TMenuItem then ViewContext := TMenuItem(Sender).Tag
1188 else if FCurrentContext.Status <> '' then ViewContext := NC_CUSTOM
1189 else ViewContext := NC_RECENT;
1190 case ViewContext of
1191 NC_RECENT: begin
1192 FillChar(FCurrentContext, SizeOf(FCurrentContext), 0);
1193 lblSumms.Caption := 'Last ' + IntToStr(ReturnMaxDCSumms) + ' Summaries';
1194 FCurrentContext.Status := IntToStr(ViewContext);
1195 FCurrentContext.MaxDocs := ReturnMaxDCSumms;
1196 LoadSumms;
1197 end;
1198 NC_ALL: begin
1199 FillChar(FCurrentContext, SizeOf(FCurrentContext), 0);
1200 lblSumms.Caption := 'All Signed Summaries';
1201 FCurrentContext.Status := IntToStr(ViewContext);
1202 LoadSumms;
1203 end;
1204 NC_UNSIGNED: begin
1205 FillChar(FCurrentContext, SizeOf(FCurrentContext), 0);
1206 lblSumms.Caption := 'Unsigned Summaries';
1207 FCurrentContext.Status := IntToStr(ViewContext);
1208 LoadSumms;
1209 end;
1210 NC_UNCOSIGNED: begin
1211 FillChar(FCurrentContext, SizeOf(FCurrentContext), 0);
1212 lblSumms.Caption := 'Uncosigned Summaries';
1213 FCurrentContext.Status := IntToStr(ViewContext);
1214 LoadSumms;
1215 end;
1216 NC_BY_AUTHOR: begin
1217 SelectAuthor(Font.Size, FCurrentContext, AuthCtxt);
1218 with AuthCtxt do if Changed then
1219 begin
1220 FillChar(FCurrentContext, SizeOf(FCurrentContext), 0);
1221 lblSumms.Caption := AuthorName + ': Signed Summaries';
1222 FCurrentContext.Status := IntToStr(NC_BY_AUTHOR);
1223 FCurrentContext.Author := Author;
1224 FCurrentContext.TreeAscending := Ascending;
1225 LoadSumms;
1226 end;
1227 end;
1228 NC_BY_DATE: begin
1229 SelectNoteDateRange(Font.Size, FCurrentContext, DateRange);
1230 with DateRange do if Changed then
1231 begin
1232 FillChar(FCurrentContext, SizeOf(FCurrentContext), 0);
1233 lblSumms.Caption := FormatFMDateTime('mmm dd,yy', FMBeginDate) + ' to ' +
1234 FormatFMDateTime('mmm dd,yy', FMEndDate) + ': Signed Summaries';
1235 FCurrentContext.BeginDate := BeginDate;
1236 FCurrentContext.EndDate := EndDate;
1237 FCurrentContext.FMBeginDate := FMBeginDate;
1238 FCurrentContext.FMEndDate := FMEndDate;
1239 FCurrentContext.TreeAscending := Ascending;
1240 FCurrentContext.Status := IntToStr(NC_BY_DATE);
1241 LoadSumms;
1242 end;
1243 end;
1244 NC_CUSTOM: begin
1245 if Sender is TMenuItem then
1246 begin
1247 SelectTIUView(Font.Size, True, FCurrentContext, uDCSummContext);
1248 //lblSumms.Caption := 'Custom List';
1249 end;
1250 with uDCSummContext do if Changed then
1251 begin
1252 //if not (Sender is TMenuItem) then lblSumms.Caption := 'Default List';
1253 //if MaxDocs = 0 then MaxDocs := ReturnMaxNotes;
1254 FCurrentContext.BeginDate := BeginDate;
1255 FCurrentContext.EndDate := EndDate;
1256 FCurrentContext.FMBeginDate := FMBeginDate;
1257 FCurrentContext.FMEndDate := FMEndDate;
1258 FCurrentContext.Status := Status;
1259 FCurrentContext.Author := Author;
1260 FCurrentContext.MaxDocs := MaxDocs;
1261 FCurrentContext.ShowSubject := ShowSubject;
1262 // NEW PREFERENCES:
1263 FCurrentContext.SortBy := SortBy;
1264 FCurrentContext.ListAscending := ListAscending;
1265 FCurrentContext.GroupBy := GroupBy;
1266 FCurrentContext.TreeAscending := TreeAscending;
1267 FCurrentContext.SearchField := SearchField;
1268 FCurrentContext.Keyword := Keyword;
1269 FCurrentContext.Filtered := Filtered;
1270 LoadSumms;
1271 end;
1272 end;
1273 end; {case}
1274 lblSumms.Caption := SetSummTreeLabel(FCurrentContext);
1275 lblSumms.hint := lblSumms.Caption;
1276 tvSumms.Caption := lblSumms.Caption;
1277 StatusText('');
1278end;
1279
1280{ Action menu events ----------------------------------------------------------------------- }
1281
1282function TfrmDCSumm.StartNewEdit(NewNoteType: integer): Boolean;
1283{ if currently editing a note, returns TRUE if the user wants to start a new one }
1284var
1285 Saved: Boolean;
1286 Msg, CapMsg: string;
1287begin
1288 Result := True;
1289 if EditingIndex > -1 then
1290 begin
1291 case NewNoteType of
1292 DC_ACT_ADDENDUM: begin
1293 Msg := TX_NEW_SAVE1 + MakeDCSummDisplayText(lstSumms.Items[EditingIndex]) + TX_NEW_SAVE3;
1294 CapMsg := TC_NEW_SAVE3;
1295 end;
1296 DC_ACT_EDIT_SUMM: begin
1297 Msg := TX_NEW_SAVE1 + MakeDCSummDisplayText(lstSumms.Items[EditingIndex]) + TX_NEW_SAVE4;
1298 CapMsg := TC_NEW_SAVE4;
1299 end;
1300 DC_ACT_ID_ENTRY: begin
1301 Msg := TX_NEW_SAVE1 + MakeDCSummDisplayText(lstSumms.Items[EditingIndex]) + TX_NEW_SAVE5;
1302 CapMsg := TC_NEW_SAVE5;
1303 end;
1304 else
1305 begin
1306 Msg := TX_NEW_SAVE1 + MakeDCSummDisplayText(lstSumms.Items[EditingIndex]) + TX_NEW_SAVE2;
1307 CapMsg := TC_NEW_SAVE2;
1308 end;
1309 end;
1310
1311 if InfoBox(Msg, CapMsg, MB_YESNO) = IDNO then Result := False
1312 else
1313 begin
1314 SaveCurrentSumm(Saved);
1315 if not Saved then Result := False else LoadSumms;
1316 end;
1317 end;
1318end;
1319
1320procedure TfrmDCSumm.mnuActNewClick(Sender: TObject);
1321const
1322 IS_ID_CHILD = False;
1323{ switches to current new Summ or creates a new Summ if none is being edited already }
1324begin
1325 inherited;
1326 if not StartNewEdit(DC_ACT_NEW_SUMM) then Exit;
1327 //LoadSumms;
1328 // a visit (time & location) need not be available before creating the summary,
1329 // since an admission will be prompted for to link the summary to. (REV - v14d)
1330(* if Encounter.NeedVisit then
1331 begin
1332 UpdateVisit(Font.Size);
1333 frmFrame.DisplayEncounterText;
1334 end;
1335 if Encounter.NeedVisit then
1336 begin
1337 InfoBox(TX_NEED_VISIT, TX_NO_VISIT, MB_OK or MB_ICONWARNING);
1338 Exit;
1339 end;*)
1340
1341 InsertNewSumm(IS_ID_CHILD, 0);
1342end;
1343
1344procedure TfrmDCSumm.mnuActAddIDEntryClick(Sender: TObject);
1345const
1346 IS_ID_CHILD = True;
1347var
1348 AnIDParent: integer;
1349{ switches to current new note or creates a new note if none is being edited already }
1350begin
1351 inherited;
1352 AnIDParent := lstSumms.ItemIEN;
1353 if not StartNewEdit(DC_ACT_ID_ENTRY) then Exit;
1354 //LoadSumms;
1355 with tvSumms do Selected := FindPieceNode(IntToStr(AnIDParent), U, Items.GetFirstNode);
1356 // make sure a visit (time & location) is available before creating the note
1357 if Encounter.NeedVisit then
1358 begin
1359 UpdateVisit(Font.Size, DfltTIULocation);
1360 frmFrame.DisplayEncounterText;
1361 end;
1362 if Encounter.NeedVisit then
1363 begin
1364 InfoBox(TX_NEED_VISIT, TX_NO_VISIT, MB_OK or MB_ICONWARNING);
1365 Exit;
1366 end;
1367 InsertNewSumm(IS_ID_CHILD, AnIDParent);
1368end;
1369
1370procedure TfrmDCSumm.mnuActAddendClick(Sender: TObject);
1371{ make an addendum to an existing Summ }
1372var
1373 ActionSts: TActionRec;
1374 ASummID: string;
1375begin
1376 inherited;
1377 if NoSummSelected() then Exit;
1378 ASummID := lstSumms.ItemID;
1379 if not StartNewEdit(DC_ACT_ADDENDUM) then Exit;
1380 //LoadSumms;
1381 with tvSumms do Selected := FindPieceNode(ASummID, 1, U, Items.GetFirstNode);
1382 if lstSumms.ItemIndex = EditingIndex then
1383 begin
1384 InfoBox(TX_ADDEND_NO, TX_ADDEND_MK, MB_OK);
1385 Exit;
1386 end;
1387 ActOnDCDocument(ActionSts, lstSumms.ItemIEN, 'MAKE ADDENDUM');
1388 if not ActionSts.Success then
1389 begin
1390 InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
1391 Exit;
1392 end;
1393 with lstSumms do if TitleForNote(ItemIEN) = TYP_ADDENDUM then //v17.5 RV
1394 //with lstSumms do if Copy(Piece(Items[ItemIndex], U, 2), 1, 8) = 'Addendum' then
1395 begin
1396 InfoBox(TX_ADDEND_AD, TX_ADDEND_MK, MB_OK);
1397 Exit;
1398 end;
1399 FEditDCSumm.DischargeDateTime := FMNow;
1400 InsertAddendum;
1401end;
1402
1403procedure TfrmDCSumm.mnuActDetachFromIDParentClick(Sender: TObject);
1404var
1405 DocID, WhyNot: string;
1406 Saved: boolean;
1407 SavedDocID: string;
1408begin
1409 if lstSumms.ItemIEN = 0 then exit;
1410 SavedDocID := lstSumms.ItemID;
1411 if EditingIndex <> -1 then
1412 begin
1413 SaveCurrentSumm(Saved);
1414 if not Saved then Exit;
1415 LoadSumms;
1416 with tvSumms do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1417 end;
1418 if not CanBeAttached(PDocTreeObject(tvSumms.Selected.Data)^.DocID, WhyNot) then
1419 begin
1420 WhyNot := StringReplace(WhyNot, 'ATTACH', 'DETACH', [rfIgnoreCase]);
1421 WhyNot := StringReplace(WhyNot, 'to an ID', 'from an ID', [rfIgnoreCase]);
1422 InfoBox(WhyNot, TX_DETACH_FAILURE, MB_OK);
1423 Exit;
1424 end;
1425 if (InfoBox('DETACH: ' + tvSumms.Selected.Text + CRLF + CRLF +
1426 ' FROM: ' + tvSumms.Selected.Parent.Text + CRLF + CRLF +
1427 'Are you sure?', TX_DETACH_CNF, MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) <> IDYES)
1428 then Exit;
1429 DocID := PDocTreeObject(tvSumms.Selected.Data)^.DocID;
1430 SavedDocID := PDocTreeObject(tvSumms.Selected.Parent.Data)^.DocID;
1431 if DetachEntryFromParent(DocID, WhyNot) then
1432 begin
1433 LoadSumms;
1434 with tvSumms do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1435 if tvSumms.Selected <> nil then tvSumms.Selected.Expand(False);
1436 end
1437 else
1438 begin
1439 WhyNot := StringReplace(WhyNot, 'ATTACH', 'DETACH', [rfIgnoreCase]);
1440 WhyNot := StringReplace(WhyNot, 'to an ID', 'from an ID', [rfIgnoreCase]);
1441 InfoBox(WhyNot, TX_DETACH_FAILURE, MB_OK);
1442 end;
1443end;
1444
1445
1446procedure TfrmDCSumm.mnuActSignListClick(Sender: TObject);
1447{ add the Summ to the Encounter object, see mnuActSignClick - copied}
1448const
1449 SIG_COSIGN = 'COSIGNATURE';
1450 SIG_SIGN = 'SIGNATURE';
1451var
1452 ActionType, SignTitle: string;
1453 ActionSts: TActionRec;
1454begin
1455 inherited;
1456 if NoSummSelected() then Exit;
1457 if lstSumms.ItemIndex = EditingIndex then Exit; // already in signature list
1458 if not NoteHasText(lstSumms.ItemIEN) then
1459 begin
1460 InfoBox(TX_EMPTY_SUMM1, TC_EMPTY_SUMM, MB_OK or MB_ICONERROR);
1461 Exit;
1462 end;
1463 if not LastSaveClean(lstSumms.ItemIEN) and
1464 (InfoBox(TX_ABSAVE, TC_ABSAVE, MB_YESNO or MB_DEFBUTTON2 or MB_ICONWARNING) <> IDYES) then Exit;
1465 if CosignDocument(lstSumms.ItemIEN) then
1466 begin
1467 SignTitle := TX_COSIGN;
1468 ActionType := SIG_COSIGN;
1469 end else
1470 begin
1471 SignTitle := TX_SIGN;
1472 ActionType := SIG_SIGN;
1473 end;
1474 ActOnDCDocument(ActionSts, lstSumms.ItemIEN, ActionType);
1475 if not ActionSts.Success then
1476 begin
1477 InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
1478 Exit;
1479 end;
1480 LockSumm(lstSumms.ItemIEN);
1481 with lstSumms do Changes.Add(CH_SUM, ItemID, TitleText(ItemIndex), '', CH_SIGN_YES);
1482end;
1483
1484procedure TfrmDCSumm.RemovePCEFromChanges(IEN: Int64; AVisitStr: string = '');
1485begin
1486 if IEN = DC_ADDENDUM then Exit; // no PCE information entered for an addendum
1487 // do we need to call DeletePCE(AVisitStr), as was done with NT_NEW_NOTE (ien=-10)???
1488 if AVisitStr = '' then AVisitStr := VisitStrForNote(IEN);
1489 Changes.Remove(CH_PCE, 'V' + AVisitStr);
1490 Changes.Remove(CH_PCE, 'P' + AVisitStr);
1491 Changes.Remove(CH_PCE, 'D' + AVisitStr);
1492 Changes.Remove(CH_PCE, 'I' + AVisitStr);
1493 Changes.Remove(CH_PCE, 'S' + AVisitStr);
1494 Changes.Remove(CH_PCE, 'A' + AVisitStr);
1495 Changes.Remove(CH_PCE, 'H' + AVisitStr);
1496 Changes.Remove(CH_PCE, 'E' + AVisitStr);
1497 Changes.Remove(CH_PCE, 'T' + AVisitStr);
1498end;
1499
1500
1501procedure TfrmDCSumm.mnuActDeleteClick(Sender: TObject);
1502{ delete the selected progress note & remove from the Encounter object if necessary }
1503var
1504 DeleteSts, ActionSts: TActionRec;
1505 ReasonForDelete, AVisitStr, SavedDocID: string;
1506 Saved: boolean;
1507 SavedDocIEN: integer;
1508begin
1509 inherited;
1510 if NoSummSelected() then Exit;
1511 ActOnDocument(ActionSts, lstSumms.ItemIEN, 'DELETE RECORD');
1512 if ShowMsgOn(not ActionSts.Success, ActionSts.Reason, TX_IN_AUTH) then Exit;
1513 ReasonForDelete := SelectDeleteReason(lstSumms.ItemIEN);
1514 if ReasonForDelete = DR_CANCEL then Exit;
1515 // suppress prompt for deletion when called from SaveEditedNote (Sender = Self)
1516 if (Sender <> Self) and (InfoBox(MakeDCSummDisplayText(lstSumms.Items[lstSumms.ItemIndex]) + TX_DEL_OK,
1517 TX_DEL_CNF, MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) <> IDYES) then Exit;
1518 // do the appropriate locking
1519 if not LockSumm(lstSumms.ItemIEN) then Exit;
1520 // retraction notification message
1521 if JustifyDocumentDelete(lstSumms.ItemIEN) then
1522 InfoBox(TX_RETRACT, TX_RETRACT_CAP, MB_OK);
1523 SavedDocID := lstSumms.ItemID;
1524 SavedDocIEN := lstSumms.ItemIEN;
1525 if (EditingIndex > -1) and (not FConfirmed) and (lstSumms.ItemIndex <> EditingIndex) and (memNewSumm.GetTextLen > 0) then
1526 begin
1527 SaveCurrentSumm(Saved);
1528 if not Saved then Exit;
1529 end;
1530 EditingIndex := -1;
1531 FConfirmed := False;
1532(* if Saved then
1533 begin
1534 EditingIndex := -1;
1535 mnuViewClick(Self);
1536 with tvSumms do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1537 end;*)
1538 // remove the note
1539 DeleteSts.Success := True;
1540 AVisitStr := VisitStrForNote(SavedDocIEN);
1541 RemovePCEFromChanges(SavedDocIEN, AVisitStr);
1542 if (SavedDocIEN > 0) and (lstSumms.ItemIEN = SavedDocIEN) then DeleteDocument(DeleteSts, SavedDocIEN, ReasonForDelete);
1543 if not Changes.Exist(CH_SUM, SavedDocID) then UnlockDocument(SavedDocIEN);
1544 Changes.Remove(CH_SUM, SavedDocID); // this will unlock the document if in Changes
1545 // reset the display now that the note is gone
1546 if DeleteSts.Success then
1547 begin
1548 DeletePCE(AVisitStr); // removes PCE data if this was the only note pointing to it
1549 ClearEditControls;
1550 //ClearPtData; WRONG - fixed in v15.10 - RV
1551 LoadSumms;
1552(* with tvSumms do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1553 if tvSumms.Selected <> nil then tvSummsChange(Self, tvSumms.Selected) else
1554 begin*)
1555 pnlWrite.Visible := False;
1556 pnlRead.Visible := True;
1557 UpdateReminderFinish;
1558 ShowPCEControls(False);
1559 frmDrawers.DisplayDrawers(FALSE);
1560 cmdNewSumm.Visible := TRUE;
1561 cmdPCE.Visible := FALSE;
1562 popSummMemoEncounter.Visible := cmdPCE.Visible;
1563 lblSpace1.Top := cmdNewSumm.Top - lblSpace1.Height;
1564// end; {if ItemIndex}
1565 end {if DeleteSts}
1566 else InfoBox(DeleteSts.Reason, TX_DEL_ERR, MB_OK or MB_ICONWARNING);
1567end;
1568
1569procedure TfrmDCSumm.mnuActEditClick(Sender: TObject);
1570{ load the selected Discharge Summary for editing }
1571var
1572 ActionSts: TActionRec;
1573 ASummID: string;
1574begin
1575 inherited;
1576 if NoSummSelected() then Exit;
1577 if lstSumms.ItemIndex = EditingIndex then Exit;
1578 ASummID := lstSumms.ItemID;
1579 if not StartNewEdit(DC_ACT_EDIT_SUMM) then Exit;
1580 //LoadSumms;
1581 with tvSumms do Selected := FindPieceNode(ASummID, 1, U, Items.GetFirstNode);
1582 ActOnDCDocument(ActionSts, lstSumms.ItemIEN, 'EDIT RECORD');
1583 if not ActionSts.Success then
1584 begin
1585 InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
1586 Exit;
1587 end;
1588 LoadForEdit(False);
1589end;
1590
1591procedure TfrmDCSumm.mnuActSaveClick(Sender: TObject);
1592{ saves the Summ that is currently being edited }
1593var
1594 Saved: Boolean;
1595 SavedDocID: string;
1596begin
1597 inherited;
1598 if EditingIndex > -1 then
1599 begin
1600 SavedDocID := Piece(lstSumms.Items[EditingIndex], U, 1);
1601 FLastSummID := SavedDocID;
1602 SaveCurrentSumm(Saved);
1603 if Saved and (EditingIndex < 0) and (not FDeleted) then
1604 //if Saved then
1605 begin
1606 LoadSumms;
1607 with tvSumms do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1608 end;
1609 end
1610 else InfoBox(TX_NO_NOTE, TX_SAVE_NOTE, MB_OK or MB_ICONWARNING);
1611end;
1612
1613procedure TfrmDCSumm.mnuActSignClick(Sender: TObject);
1614{ sign the currently selected Summ, save first if necessary }
1615const
1616 SIG_COSIGN = 'COSIGNATURE';
1617 SIG_SIGN = 'SIGNATURE';
1618var
1619 Saved, SummUnlocked: Boolean;
1620 ActionType, ESCode, SignTitle: string;
1621 ActionSts, SignSts: TActionRec;
1622 OK: boolean;
1623 SavedDocID, tmpItem: string;
1624 EditingID: string; //v22.12 - RV
1625 tmpNode: TTreeNode;
1626begin
1627 inherited;
1628 if NoSummSelected() then Exit;
1629(* if lstSumms.ItemIndex = EditingIndex then //v22.12 - RV
1630 begin //v22.12 - RV
1631 SaveCurrentSumm(Saved); //v22.12 - RV
1632 if (not Saved) or FDeleted then Exit; //v22.12 - RV
1633 end //v22.12 - RV
1634 else if EditingIndex > -1 then //v22.12 - RV
1635 tmpItem := lstSumms.Items[EditingIndex]; //v22.12 - RV
1636 SavedDocID := lstSumms.ItemID;*) //v22.12 - RV
1637 SavedDocID := lstSumms.ItemID; //v22.12 - RV
1638 FLastSummID := SavedDocID; //v22.12 - RV
1639 if lstSumms.ItemIndex = EditingIndex then //v22.12 - RV
1640 begin //v22.12 - RV
1641 SaveCurrentSumm(Saved); //v22.12 - RV
1642 if (not Saved) or FDeleted then Exit; //v22.12 - RV
1643 end //v22.12 - RV
1644 else if EditingIndex > -1 then //v22.12 - RV
1645 begin //v22.12 - RV
1646 tmpItem := lstSumms.Items[EditingIndex]; //v22.12 - RV
1647 EditingID := Piece(tmpItem, U, 1); //v22.12 - RV
1648 end; //v22.12 - RV
1649 if not NoteHasText(lstSumms.ItemIEN) then
1650 begin
1651 InfoBox(TX_EMPTY_SUMM1, TC_EMPTY_SUMM, MB_OK or MB_ICONERROR);
1652 Exit;
1653 end;
1654 if not LastSaveClean(lstSumms.ItemIEN) and
1655 (InfoBox(TX_ABSAVE, TC_ABSAVE, MB_YESNO or MB_DEFBUTTON2 or MB_ICONWARNING) <> IDYES) then Exit;
1656 if CosignDocument(lstSumms.ItemIEN) then
1657 begin
1658 SignTitle := TX_COSIGN;
1659 ActionType := SIG_COSIGN;
1660 end else
1661 begin
1662 SignTitle := TX_SIGN;
1663 ActionType := SIG_SIGN;
1664 end;
1665 if not LockSumm(lstSumms.ItemIEN) then Exit;
1666 // no exits after things are locked
1667 SummUnlocked := False;
1668 ActOnDCDocument(ActionSts, lstSumms.ItemIEN, ActionType);
1669 if ActionSts.Success then
1670 begin
1671 OK := IsOK2Sign(uPCEShow, lstSumms.ItemIEN);
1672 if frmFrame.Closing then exit;
1673 if(uPCEShow.Updated) then
1674 begin
1675 uPCEShow.CopyPCEData(uPCEEdit);
1676 uPCEShow.Updated := FALSE;
1677 lstSummsClick(Self);
1678 end;
1679 if not AuthorSignedDocument(lstSumms.ItemIEN) then
1680 begin
1681 if (InfoBox(TX_AUTH_SIGNED +
1682 GetTitleText(lstSumms.ItemIndex),TX_SIGN ,MB_YESNO)= ID_NO) then exit;
1683 end;
1684 if(OK) then
1685 begin
1686 with lstSumms do SignatureForItem(Font.Size, MakeDCSummDisplayText(Items[ItemIndex]), SignTitle, ESCode);
1687 if Length(ESCode) > 0 then
1688 begin
1689 SignDCDocument(SignSts, lstSumms.ItemIEN, ESCode);
1690 RemovePCEFromChanges(lstSumms.ItemIEN);
1691 SummUnlocked := Changes.Exist(CH_SUM, lstSumms.ItemID);
1692 Changes.Remove(CH_SUM, lstSumms.ItemID);
1693 if SignSts.Success
1694 then lstSummsClick(Self)
1695 else InfoBox(SignSts.Reason, TX_SIGN_ERR, MB_OK);
1696 end {if Length(ESCode)}
1697 else
1698 SummUnlocked := Changes.Exist(CH_SUM, lstSumms.ItemID);
1699 end;
1700 end
1701 else InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
1702 if not SummUnlocked then UnlockDocument(lstSumms.ItemIEN);
1703 //SetViewContext(FCurrentContext); //v22.12 - RV
1704 LoadSumms; //v22.12 - RV
1705 //if EditingIndex > -1 then //v22.12 - RV
1706 if (EditingID <> '') then //v22.12 - RV
1707 begin
1708 lstSumms.Items.Insert(0, tmpItem);
1709 tmpNode := tvSumms.Items.AddObjectFirst(tvSumms.Items.GetFirstNode, 'Summary being edited',
1710 MakeDCSummTreeObject('EDIT^Summary being edited^^^^^^^^^^^%^0'));
1711 TORTreeNode(tmpNode).StringData := 'EDIT^Summary being edited^^^^^^^^^^^%^0';
1712 tmpNode.ImageIndex := IMG_TOP_LEVEL;
1713 tmpNode := tvSumms.Items.AddChildObjectFirst(tmpNode, MakeDCSummDisplayText(tmpItem), MakeDCSummTreeObject(tmpItem));
1714 TORTreeNode(tmpNode).StringData := tmpItem;
1715 SetTreeNodeImagesAndFormatting(TORTreeNode(tmpNode), FCurrentContext, CT_DCSUMM);
1716 EditingIndex := lstSumms.SelectByID(EditingID); //v22.12 - RV
1717 end;
1718 //with tvSumms do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode); //v22.12 - RV
1719 with tvSumms do //v22.12 - RV
1720 begin //v22.12 - RV
1721 Selected := FindPieceNode(FLastSummID, U, Items.GetFirstNode); //v22.12 - RV
1722 if Selected <> nil then tvSummsChange(Self, Selected); //v22.12 - RV
1723 end; //v22.12 - RV
1724end;
1725
1726procedure TfrmDCSumm.SaveSignItem(const ItemID, ESCode: string);
1727{ saves and optionally signs a Discharge Summary or addendum }
1728var
1729 AnIndex, IEN, i: Integer;
1730 Saved, ContinueSign: Boolean; {*RAB* 8/26/99}
1731 SignSts: TActionRec;
1732 APCEObject: TPCEData;
1733 OK: boolean;
1734
1735begin
1736 AnIndex := -1;
1737 IEN := StrToIntDef(ItemID, 0);
1738 if IEN = 0 then Exit;
1739 if frmFrame.TimedOut and (EditingIndex <> -1) then FSilent := True;
1740 with lstSumms do for i := 0 to Items.Count - 1 do if lstSumms.GetIEN(i) = IEN then
1741 begin
1742 AnIndex := i;
1743 break;
1744 end;
1745 if (AnIndex > -1) and (AnIndex = EditingIndex) then
1746 begin
1747 SaveCurrentSumm(Saved);
1748 if not Saved then Exit;
1749 if FDeleted then
1750 begin
1751 FDeleted := False;
1752 Exit;
1753 end;
1754 AnIndex := lstSumms.SelectByIEN(IEN);
1755 //IEN := lstNotes.GetIEN(AnIndex); // saving will change IEN
1756 end;
1757 if Length(ESCode) > 0 then
1758 begin
1759 if not NoteHasText(IEN) then
1760 begin
1761 InfoBox(TX_EMPTY_SUMM1, TC_EMPTY_SUMM, MB_OK or MB_ICONERROR);
1762 ContinueSign := False;
1763 end
1764 else if not LastSaveClean(IEN) and
1765 (InfoBox(TX_ABSAVE, TC_ABSAVE, MB_YESNO or MB_DEFBUTTON2 or MB_ICONWARNING) <> IDYES)
1766 then ContinueSign := False
1767 else ContinueSign := True;
1768 if ContinueSign then
1769 begin
1770 if (AnIndex >= 0) and (AnIndex = lstSumms.ItemIndex) then
1771 APCEObject := uPCEShow
1772 else
1773 APCEObject := nil;
1774 OK := IsOK2Sign(APCEObject, IEN);
1775 if frmFrame.Closing then exit;
1776 if(assigned(APCEObject)) and (uPCEShow.Updated) then
1777 begin
1778 uPCEShow.CopyPCEData(uPCEEdit);
1779 uPCEShow.Updated := FALSE;
1780 lstSummsClick(Self);
1781 end
1782 else
1783 uPCEEdit.Clear;
1784 if(OK) then
1785 begin
1786 SignDocument(SignSts, IEN, ESCode);
1787 if not SignSts.Success then InfoBox(SignSts.Reason, TX_SIGN_ERR, MB_OK);
1788 end; {if OK}
1789 end; {if ContinueSign}
1790 end; {if Length(ESCode)}
1791
1792 if (AnIndex = lstSumms.ItemIndex) and (not frmFrame.ContextChanging) then
1793 begin
1794 LoadSumms;
1795 with tvSumms do Selected := FindPieceNode(IntToStr(IEN), U, Items.GetFirstNode);
1796 end;
1797end;
1798
1799procedure TfrmDCSumm.popSummMemoPopup(Sender: TObject);
1800begin
1801 inherited;
1802 if PopupComponent(Sender, popSummMemo) is TCustomEdit
1803 then FEditCtrl := TCustomEdit(PopupComponent(Sender, popSummMemo))
1804 else FEditCtrl := nil;
1805 if FEditCtrl <> nil then
1806 begin
1807 popSummMemoCut.Enabled := FEditCtrl.SelLength > 0;
1808 popSummMemoCopy.Enabled := popSummMemoCut.Enabled;
1809 popSummMemoPaste.Enabled := (not TORExposedCustomEdit(FEditCtrl).ReadOnly) and
1810 Clipboard.HasFormat(CF_TEXT);
1811 popSummMemoTemplate.Enabled := frmDrawers.CanEditTemplates and popSummMemoCut.Enabled;
1812 popSummMemoFind.Enabled := FEditCtrl.GetTextLen > 0;
1813 end else
1814 begin
1815 popSummMemoCut.Enabled := False;
1816 popSummMemoCopy.Enabled := False;
1817 popSummMemoPaste.Enabled := False;
1818 popSummMemoTemplate.Enabled := False;
1819 end;
1820 if pnlWrite.Visible then
1821 begin
1822 popSummMemoSpell.Enabled := True;
1823 popSummMemoGrammar.Enabled := True;
1824 popSummMemoReformat.Enabled := True;
1825 popSummMemoReplace.Enabled := (FEditCtrl.GetTextLen > 0);
1826 popSummMemoPreview.Enabled := (frmDrawers.TheOpenDrawer = odTemplates) and Assigned(frmDrawers.tvTemplates.Selected);
1827 popSummMemoInsTemplate.Enabled := (frmDrawers.TheOpenDrawer = odTemplates) and Assigned(frmDrawers.tvTemplates.Selected);
1828 end else
1829 begin
1830 popSummMemoSpell.Enabled := False;
1831 popSummMemoGrammar.Enabled := False;
1832 popSummMemoReformat.Enabled := False;
1833 popSummMemoReplace.Enabled := False;
1834 popSummMemoPreview.Enabled := False;
1835 popSummMemoInsTemplate.Enabled := False;
1836 end;
1837end;
1838
1839procedure TfrmDCSumm.popSummMemoCutClick(Sender: TObject);
1840begin
1841 inherited;
1842 FEditCtrl.CutToClipboard;
1843end;
1844
1845procedure TfrmDCSumm.popSummMemoCopyClick(Sender: TObject);
1846begin
1847 inherited;
1848 FEditCtrl.CopyToClipboard;
1849end;
1850
1851procedure TfrmDCSumm.popSummMemoPasteClick(Sender: TObject);
1852begin
1853 inherited;
1854 FEditCtrl.SelText := Clipboard.AsText; {*KCM*}
1855 //FEditCtrl.PasteFromClipboard; // use AsText to prevent formatting
1856end;
1857
1858procedure TfrmDCSumm.popSummMemoReformatClick(Sender: TObject);
1859begin
1860 inherited;
1861 if Screen.ActiveControl <> memNewSumm then Exit;
1862 ReformatMemoParagraph(memNewSumm);
1863end;
1864
1865procedure TfrmDCSumm.popSummMemoFindClick(Sender: TObject);
1866begin
1867 inherited;
1868 SendMessage(TRichEdit(popSummMemo.PopupComponent).Handle, WM_VSCROLL, SB_TOP, 0);
1869 with dlgFindText do
1870 begin
1871 Position := Point(Application.MainForm.Left + pnlLeft.Width, Application.MainForm.Top);
1872 FindText := '';
1873 Options := [frDown, frHideUpDown];
1874 Execute;
1875 end;
1876end;
1877
1878procedure TfrmDCSumm.dlgFindTextFind(Sender: TObject);
1879begin
1880 dmodShared.FindRichEditText(dlgFindText, TRichEdit(popSummMemo.PopupComponent));
1881end;
1882
1883procedure TfrmDCSumm.popSummMemoReplaceClick(Sender: TObject);
1884begin
1885 inherited;
1886 SendMessage(TRichEdit(popSummMemo.PopupComponent).Handle, WM_VSCROLL, SB_TOP, 0);
1887 with dlgReplaceText do
1888 begin
1889 Position := Point(Application.MainForm.Left + pnlLeft.Width, Application.MainForm.Top);
1890 FindText := '';
1891 ReplaceText := '';
1892 Options := [frDown, frHideUpDown];
1893 Execute;
1894 end;
1895end;
1896
1897procedure TfrmDCSumm.dlgReplaceTextReplace(Sender: TObject);
1898begin
1899 inherited;
1900 dmodShared.ReplaceRichEditText(dlgReplaceText, TRichEdit(popSummMemo.PopupComponent));
1901end;
1902
1903procedure TfrmDCSumm.dlgReplaceTextFind(Sender: TObject);
1904begin
1905 inherited;
1906 dmodShared.FindRichEditText(dlgFindText, TRichEdit(popSummMemo.PopupComponent));
1907end;
1908
1909procedure TfrmDCSumm.popSummMemoSpellClick(Sender: TObject);
1910begin
1911 inherited;
1912 DoAutoSave;
1913 timAutoSave.Enabled := False;
1914 try
1915 SpellCheckForControl(memNewSumm);
1916 finally
1917 timAutoSave.Enabled := True;
1918 end;
1919end;
1920
1921procedure TfrmDCSumm.popSummMemoGrammarClick(Sender: TObject);
1922begin
1923 inherited;
1924 DoAutoSave;
1925 timAutoSave.Enabled := False;
1926 try
1927 GrammarCheckForControl(memNewSumm);
1928 finally
1929 timAutoSave.Enabled := True;
1930 end;
1931end;
1932
1933procedure TfrmDCSumm.FormCreate(Sender: TObject);
1934begin
1935 inherited;
1936 PageID := CT_DCSUMM;
1937 memSumm.Color := ReadOnlyColor;
1938 memPCEShow.Color := ReadOnlyColor;
1939 lblNewTitle.Color := ReadOnlyColor;
1940 FDischargeDate := FMNow;
1941 EditingIndex := -1;
1942 FEditDCSumm.LastCosigner := 0;
1943 FEditDCSumm.LastCosignerName := '';
1944 FLastSummID := '';
1945 frmDrawers := TfrmDrawers.CreateDrawers(Self, pnlDrawers, [],[]);
1946 frmDrawers.Align := alBottom;
1947 frmDrawers.RichEditControl := memNewSumm;
1948 frmDrawers.Splitter := splDrawers;
1949 frmDrawers.DefTempPiece := 3;
1950 tvSumms.Images := dmodShared.imgNotes;
1951 tvSumms.StateImages := dmodShared.imgImages;
1952 lvSumms.StateImages := dmodShared.imgImages;
1953 lvSumms.SmallImages := dmodShared.imgNotes;
1954 FImageFlag := TBitmap.Create;
1955 FDocList := TStringList.Create;
1956 TAccessibleTreeView.WrapControl(tvSumms);
1957end;
1958
1959procedure TfrmDCSumm.mnuViewDetailClick(Sender: TObject);
1960begin
1961 inherited;
1962 if lstSumms.ItemIEN <= 0 then Exit;
1963 mnuViewDetail.Checked := not mnuViewDetail.Checked;
1964 if mnuViewDetail.Checked then
1965 begin
1966 StatusText('Retrieving discharge summary details...');
1967 Screen.Cursor := crHourGlass;
1968 LoadDetailText(memSumm.Lines, lstSumms.ItemIEN);
1969 Screen.Cursor := crDefault;
1970 StatusText('');
1971 memSumm.SelStart := 0;
1972 memSumm.Repaint;
1973 end
1974 else
1975 lstSummsClick(Self);
1976 SendMessage(memSumm.Handle, WM_VSCROLL, SB_TOP, 0);
1977end;
1978
1979procedure TfrmDCSumm.FormClose(Sender: TObject; var Action: TCloseAction);
1980var
1981 Saved: Boolean;
1982 IEN: Int64;
1983 ErrMsg: string;
1984 DeleteSts: TActionRec;
1985begin
1986 inherited;
1987 if frmFrame.TimedOut and (EditingIndex <> -1) then
1988 begin
1989 FSilent := True;
1990 if memNewSumm.GetTextLen > 0 then SaveCurrentSumm(Saved)
1991 else
1992 begin
1993 IEN := lstSumms.GetIEN(EditingIndex);
1994 if not LastSaveClean(IEN) then // means note hasn't been committed yet
1995 begin
1996 LockDocument(IEN, ErrMsg);
1997 if ErrMsg = '' then
1998 begin
1999 DeleteDocument(DeleteSts, IEN, '');
2000 UnlockDocument(IEN);
2001 end; {if ErrMsg}
2002 end; {if not LastSaveClean}
2003 end; {else}
2004 end; {if frmFrame}
2005end;
2006
2007procedure TfrmDCSumm.mnuActIdentifyAddlSignersClick(Sender: TObject);
2008var
2009 Exclusions: TStrings;
2010 Saved, x, y: boolean;
2011 SignerList: TSignerList;
2012 ActionSts: TActionRec;
2013 SigAction: integer;
2014 SavedDocID: string;
2015begin
2016 inherited;
2017 if NoSummSelected() then Exit;
2018 if lstSumms.ItemIndex = EditingIndex then
2019 begin
2020 SaveCurrentSumm(Saved);
2021 if not Saved then Exit;
2022 LoadSumms;
2023 with tvSumms do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
2024 end;
2025 x := CanChangeCosigner(lstSumms.ItemIEN);
2026 ActOnDocument(ActionSts, lstSumms.ItemIEN, 'IDENTIFY SIGNERS');
2027 y := ActionSts.Success;
2028 if x and not y then
2029 begin
2030 if InfoBox(ActionSts.Reason + CRLF + CRLF +
2031 'Would you like to change the cosigner?',
2032 TX_IN_AUTH, MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) = ID_YES then
2033 SigAction := SG_COSIGNER
2034 else
2035 Exit;
2036 end
2037 else if y and not x then SigAction := SG_ADDITIONAL
2038 else if x and y then SigAction := SG_BOTH
2039 else
2040 begin
2041 InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
2042 Exit;
2043 end;
2044
2045// NEED TO PREVENT CHANGE OF COSIGNER ON DC SUMMARIES?
2046{ if y then SigAction := SG_ADDITIONAL
2047 else
2048 begin
2049 InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
2050 Exit;
2051 end; }
2052
2053 Exclusions := GetCurrentSigners(lstSumms.ItemIEN);
2054 SelectAdditionalSigners(Font.Size, lstSumms.ItemIEN, SigAction, Exclusions, SignerList, CT_DCSUMM);
2055 with SignerList do
2056 begin
2057 case SigAction of
2058 SG_ADDITIONAL: if Changed and (Signers <> nil) and (Signers.Count > 0) then
2059 UpdateAdditionalSigners(lstSumms.ItemIEN, Signers);
2060 SG_COSIGNER: if Changed then ChangeAttending(lstSumms.ItemIEN, Cosigner);
2061 SG_BOTH: if Changed then
2062 begin
2063 if (Signers <> nil) and (Signers.Count > 0) then
2064 UpdateAdditionalSigners(lstSumms.ItemIEN, Signers);
2065 ChangeAttending(lstSumms.ItemIEN, Cosigner);
2066 end;
2067 end;
2068 lstSummsClick(Self);
2069 end;
2070end;
2071
2072procedure TfrmDCSumm.popSummMemoAddlSignClick(Sender: TObject);
2073begin
2074 inherited;
2075 mnuActIdentifyAddlSignersClick(Self);
2076end;
2077
2078procedure TfrmDCSumm.ProcessNotifications;
2079var
2080 x: string;
2081 Saved: boolean;
2082 tmpNode: TTreeNode;
2083 AnObject: PDocTreeObject;
2084begin
2085 if EditingIndex <> -1 then
2086 begin
2087 SaveCurrentSumm(Saved);
2088 if not Saved then Exit;
2089 end;
2090 lblSumms.Caption := Notifications.Text;
2091 tvSumms.Caption := Notifications.Text;
2092 EditingIndex := -1;
2093 lstSumms.Enabled := True ;
2094 pnlRead.BringToFront ;
2095 x := Notifications.AlertData;
2096 //x := MakeDCSummListItem(Notifications.AlertData);
2097 if StrToIntDef(Piece(x, U, 1), 0) = 0 then
2098 begin
2099 InfoBox(TX_NO_ALERT, TX_CAP_NO_ALERT, MB_OK);
2100 Exit;
2101 end;
2102 uChanging := True;
2103 tvSumms.Items.BeginUpdate;
2104 lstSumms.Clear;
2105 KillDocTreeObjects(tvSumms);
2106 tvSumms.Items.Clear;
2107 lstSumms.Items.Add(x);
2108 AnObject := MakeDCSummTreeObject('ALERT^Alerted Note^^^^^^^^^^^%^0');
2109 tmpNode := tvSumms.Items.AddObjectFirst(tvSumms.Items.GetFirstNode, AnObject.NodeText, AnObject);
2110 TORTreeNode(tmpNode).StringData := 'ALERT^Alerted Note^^^^^^^^^^^%^0';
2111 tmpNode.ImageIndex := IMG_TOP_LEVEL;
2112 AnObject := MakeDCSummTreeObject(x);
2113 tmpNode := tvSumms.Items.AddChildObjectFirst(tmpNode, AnObject.NodeText, AnObject);
2114 TORTreeNode(tmpNode).StringData := x;
2115 SetTreeNodeImagesAndFormatting(TORTreeNode(tmpNode), FCurrentContext, CT_DCSUMM);
2116 tvSumms.Selected := tmpNode;
2117 tvSumms.Items.EndUpdate;
2118 uChanging := False;
2119 tvSummsChange(Self, tvSumms.Selected);
2120 case Notifications.Followup of
2121 NF_DCSUMM_UNSIGNED_NOTE: ; //Automatically deleted by sig action!!!
2122 end;
2123 if Copy(Piece(Notifications.RecordID, U, 2), 1, 6) = 'TIUADD' then Notifications.Delete;
2124 if Copy(Piece(Notifications.RecordID, U, 2), 1, 5) = 'TIUID' then Notifications.Delete;
2125end;
2126
2127procedure TfrmDCSumm.SetViewContext(AContext: TTIUContext);
2128var
2129 Saved: boolean;
2130begin
2131 if EditingIndex <> -1 then
2132 begin
2133 SaveCurrentSumm(Saved);
2134 if not Saved then Exit;
2135 end;
2136 EditingIndex := -1;
2137 tvSumms.Enabled := True ;
2138 pnlRead.BringToFront ;
2139 if FCurrentContext.Status <> '' then with uDCSummContext do
2140 begin
2141 BeginDate := FCurrentContext.BeginDate;
2142 EndDate := FCurrentContext.EndDate;
2143 FMBeginDate := FCurrentContext.FMBeginDate;
2144 FMEndDate := FCurrentContext.FMEndDate;
2145 Status := FCurrentContext.Status;
2146 Author := FCurrentContext.Author;
2147 MaxDocs := FCurrentContext.MaxDocs;
2148 ShowSubject := FCurrentContext.ShowSubject;
2149 GroupBy := FCurrentContext.GroupBy;
2150 SortBy := FCurrentContext.SortBy;
2151 ListAscending := FCurrentContext.ListAscending;
2152 TreeAscending := FCurrentContext.TreeAscending;
2153 Keyword := FCurrentContext.Keyword;
2154 SearchField := FCurrentContext.SearchField;
2155 Filtered := FCurrentContext.Filtered;
2156 Changed := True;
2157 mnuViewClick(Self);
2158 end
2159 else
2160 begin
2161 ViewContext := NC_RECENT ;
2162 mnuViewClick(Self);
2163 end;
2164end;
2165
2166procedure TfrmDCSumm.mnuViewSaveAsDefaultClick(Sender: TObject);
2167const
2168 TX_NO_MAX = 'You have not specified a maximum number of summaries to be returned.' + CRLF +
2169 'If you save this preference, the result will be that ALL summaries for every' + CRLF +
2170 'patient will be saved as your default view.' + CRLF + CRLF +
2171 'For patients with large numbers of summaries, this could result in some lengthy' + CRLF +
2172 'delays in loading the list of summaries.' + CRLF + CRLF +
2173 'Are you sure you mean to do this?';
2174 TX_REPLACE = 'Replace current defaults?';
2175begin
2176 inherited;
2177 if FCurrentContext.MaxDocs = 0 then
2178 if InfoBox(TX_NO_MAX,'Warning', MB_YESNO or MB_ICONWARNING) = IDNO then
2179 begin
2180 mnuViewClick(mnuViewCustom);
2181 Exit;
2182 end;
2183 if InfoBox(TX_REPLACE,'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then
2184 begin
2185 SaveCurrentDCSummContext(FCurrentContext);
2186 FDefaultContext := FCurrentContext;
2187 //lblSumms.Caption := 'Default List';
2188 end;
2189end;
2190
2191procedure TfrmDCSumm.mnuViewReturntoDefaultClick(Sender: TObject);
2192begin
2193 inherited;
2194 SetViewContext(FDefaultContext);
2195end;
2196
2197procedure TfrmDCSumm.popSummMemoTemplateClick(Sender: TObject);
2198begin
2199 inherited;
2200 EditTemplates(Self, True, FEditCtrl.SelText);
2201end;
2202
2203procedure TfrmDCSumm.popSummListPopup(Sender: TObject);
2204begin
2205 inherited;
2206 N5.Visible := (popSummList.PopupComponent is TORTreeView);
2207 popSummListExpandAll.Visible := N5.Visible;
2208 popSummListExpandSelected.Visible := N5.Visible;
2209 popSummListCollapseAll.Visible := N5.Visible;
2210 popSummListCollapseSelected.Visible := N5.Visible;
2211end;
2212
2213procedure TfrmDCSumm.popSummListExpandAllClick(Sender: TObject);
2214begin
2215 inherited;
2216 tvSumms.FullExpand;
2217end;
2218
2219procedure TfrmDCSumm.popSummListCollapseAllClick(Sender: TObject);
2220begin
2221 inherited;
2222 tvSumms.Selected := nil;
2223 lvSumms.Items.Clear;
2224 memSumm.Clear;
2225 tvSumms.FullCollapse;
2226 tvSumms.Selected := tvSumms.TopItem;
2227end;
2228
2229procedure TfrmDCSumm.popSummListExpandSelectedClick(Sender: TObject);
2230begin
2231 inherited;
2232 if tvSumms.Selected = nil then exit;
2233 with tvSumms.Selected do if HasChildren then Expand(True);
2234end;
2235
2236procedure TfrmDCSumm.popSummListCollapseSelectedClick(Sender: TObject);
2237begin
2238 inherited;
2239 if tvSumms.Selected = nil then exit;
2240 with tvSumms.Selected do if HasChildren then Collapse(True);
2241end;
2242
2243procedure TfrmDCSumm.mnuNewTemplateClick(Sender: TObject);
2244begin
2245 inherited;
2246 EditTemplates(Self, True);
2247end;
2248
2249procedure TfrmDCSumm.mnuEditTemplatesClick(Sender: TObject);
2250begin
2251 inherited;
2252 EditTemplates(Self);
2253end;
2254
2255procedure TfrmDCSumm.mnuOptionsClick(Sender: TObject);
2256begin
2257 inherited;
2258 mnuEditTemplates.Enabled := frmDrawers.CanEditTemplates;
2259 mnuNewTemplate.Enabled := frmDrawers.CanEditTemplates;
2260 mnuEditSharedTemplates.Enabled := frmDrawers.CanEditShared;
2261 mnuNewSharedTemplate.Enabled := frmDrawers.CanEditShared;
2262 mnuEditDialgFields.Enabled := CanEditTemplateFields;
2263end;
2264
2265procedure TfrmDCSumm.mnuEditSharedTemplatesClick(Sender: TObject);
2266begin
2267 inherited;
2268 EditTemplates(Self, FALSE, '', TRUE);
2269end;
2270
2271procedure TfrmDCSumm.mnuNewSharedTemplateClick(Sender: TObject);
2272begin
2273 inherited;
2274 EditTemplates(Self, TRUE, '', TRUE);
2275end;
2276
2277procedure TfrmDCSumm.FormDestroy(Sender: TObject);
2278begin
2279 TAccessibleTreeView.UnwrapControl(tvSumms);
2280 FImageFlag.Free;
2281 FDocList.Free;
2282 KillDocTreeObjects(tvSumms);
2283 inherited;
2284end;
2285
2286function TfrmDCSumm.GetDrawers: TFrmDrawers;
2287begin
2288 Result := frmDrawers;
2289end;
2290
2291procedure TfrmDCSumm.SetEditingIndex(const Value: Integer);
2292begin
2293 FEditingIndex := Value;
2294end;
2295
2296(*function TfrmDCSumm.MakeTitleText(IsAddendum: Boolean = False): string;
2297{ returns display text for list box based on FEditNote }
2298begin
2299 Result := FormatFMDateTime('mmm dd,yy', FEditDCSumm.DischargeDateTime) + U;
2300 if IsAddendum and (CompareText(Copy(FEditDCSumm.TitleName, 1, 8), 'Addendum') <> 0)
2301 then Result := Result + 'Addendum to ';
2302 Result := Result + FEditDCSumm.TitleName + ', ' + FEditDCSumm.LocationName + ', ' +
2303 FEditDCSumm.DictatorName;
2304end;*)
2305
2306function TfrmDCSumm.LacksRequiredForCreate: Boolean;
2307{ determines if the fields required to create the note are present }
2308var
2309 CurTitle: Integer;
2310begin
2311 Result := False;
2312 with FEditDCSumm do
2313 begin
2314 if Title <= 0 then Result := True;
2315 if Dictator <= 0 then Result := True;
2316 if AdmitDateTime <= 0 then Result := True;
2317 if (DocType = TYP_ADDENDUM) then
2318 begin
2319 if AskCosignerForDocument(Addend, Dictator) and (Cosigner <= 0) then Result := True;
2320 end else
2321 begin
2322 if Title > 0 then CurTitle := Title else CurTitle := DocType;
2323 if AskCosignerForTitle(CurTitle, Dictator) and (Cosigner <= 0) then Result := True;
2324 end;
2325 end;
2326end;
2327
2328function TfrmDCSumm.VerifySummTitle: Boolean;
2329const
2330 VNT_UNKNOWN = 0;
2331 VNT_NO = 1;
2332 VNT_YES = 2;
2333var
2334 AParam: string;
2335begin
2336 if FVerifySummTitle = VNT_UNKNOWN then
2337 begin
2338 AParam := GetUserParam('ORWOR VERIFY NOTE TITLE');
2339 if AParam = '1' then FVerifySummTitle := VNT_YES else FVerifySummTitle := VNT_NO;
2340 end;
2341 Result := FVerifySummTitle = VNT_YES;
2342end;
2343
2344function TfrmDCSumm.LockSumm(AnIEN: Int64): Boolean;
2345{ returns true if summ successfully locked }
2346var
2347 LockMsg: string;
2348begin
2349 Result := True;
2350 if Changes.Exist(CH_SUM, IntToStr(AnIEN)) then Exit; // already locked
2351 LockDocument(AnIEN, LockMsg);
2352 if LockMsg <> '' then
2353 begin
2354 Result := False;
2355 InfoBox(LockMsg, TC_NO_LOCK, MB_OK);
2356 end;
2357end;
2358
2359procedure TfrmDCSumm.DoAutoSave;
2360var
2361 ErrMsg: string;
2362begin
2363 if (EditingIndex > -1) and FChanged then
2364 begin
2365 StatusText('Autosaving note...');
2366 //PutTextOnly(ErrMsg, memNewNote.Lines, lstNotes.GetIEN(EditingIndex));
2367 timAutoSave.Enabled := False;
2368 try
2369 SetText(ErrMsg, memNewSumm.Lines, lstSumms.GetIEN(EditingIndex),1);
2370 finally
2371 timAutoSave.Enabled := True;
2372 end;
2373 FChanged := False;
2374 StatusText('');
2375 end;
2376 if ErrMsg <> '' then
2377 InfoBox(TX_SAVE_ERROR1 + ErrMsg + TX_SAVE_ERROR2, TC_SAVE_ERROR, MB_OK or MB_ICONWARNING);
2378 //Assert(ErrMsg = '', 'AutoSave: ' + ErrMsg);
2379end;
2380
2381procedure TfrmDCSumm.timAutoSaveTimer(Sender: TObject);
2382begin
2383 inherited;
2384 DoAutoSave;
2385end;
2386
2387function TfrmDCSumm.GetTitleText(AnIndex: Integer): string;
2388{ returns non-tabbed text for the title of a note given the ItemIndex in lstSumms }
2389begin
2390 with lstSumms do
2391 Result := FormatFMDateTime('mmm dd,yy', MakeFMDateTime(Piece(Items[AnIndex], U, 3))) +
2392 ' ' + Piece(Items[AnIndex], U, 2) + ', ' + Piece(Items[AnIndex], U, 6) + ', ' +
2393 Piece(Piece(Items[AnIndex], U, 5), ';', 2)
2394end;
2395
2396procedure TfrmDCSumm.cmdChangeClick(Sender: TObject);
2397var
2398 LastTitle: Integer;
2399 OKPressed, IsIDChild: Boolean;
2400 x: string;
2401 ListItemForEdit: string;
2402begin
2403 inherited;
2404 IsIDChild := uIDNotesActive and (FEditDCSumm.IDParent > 0);
2405 LastTitle := FEditDCSumm.Title;
2406 if Sender <> Self then
2407 begin
2408 FShowAdmissions := False;
2409 OKPressed := ExecuteDCSummProperties(FEditDCSumm, ListItemForEdit, FShowAdmissions, IsIDChild);
2410 end
2411 else
2412 OKPressed := True;
2413 if not OKPressed then Exit;
2414 // update display fields & uPCEEdit
2415 lblNewTitle.Caption := ' ' + FEditDCSumm.TitleName + ' ';
2416 if (FEditDCSumm.Addend > 0) and (CompareText(Copy(lblNewTitle.Caption, 2, 8), 'Addendum') <> 0) then
2417 lblNewTitle.Caption := 'Addendum to: ' + lblNewTitle.Caption;
2418 with lblNewTitle do bvlNewTitle.SetBounds(Left - 1, Top - 1, Width + 2, Height + 2);
2419 lblRefDate.Caption := FormatFMDateTime('mmm dd,yyyy@hh:nn', FEditDCSumm.DischargeDateTime);
2420 lblDictator.Caption := FEditDCSumm.DictatorName;
2421 x := 'Adm: ' + FormatFMDateTime('mm/dd/yy', FEditDCSumm.AdmitDateTime) + ' ' + FEditDCSumm.LocationName;
2422 lblVisit.Caption := x;
2423 x := ' Dis: ' + FormatFMDateTime('mm/dd/yy', FEditDCSumm.DischargeDateTime);
2424 lblDischarge.Caption := x;
2425 if Length(FEditDCSumm.AttendingName) > 0
2426 then lblCosigner.Caption := 'Attending: ' + FEditDCSumm.AttendingName
2427 else lblCosigner.Caption := '';
2428 uPCEEdit.NoteTitle := FEditDCSumm.Title;
2429 // modify signature requirements if author or cosigner changed
2430 if (User.DUZ <> FEditDCSumm.Dictator) and (User.DUZ <> FEditDCSumm.Attending)
2431 then Changes.ReplaceSignState(CH_SUM, lstSumms.ItemID, CH_SIGN_NA)
2432 else Changes.ReplaceSignState(CH_SUM, lstSumms.ItemID, CH_SIGN_YES);
2433 x := lstSumms.Items[EditingIndex];
2434 SetPiece(x, U, 2, lblNewTitle.Caption);
2435 SetPiece(x, U, 3, FloatToStr(FEditDCSumm.DischargeDateTime));
2436 tvSumms.Selected.Text := MakeDCSummDisplayText(x);
2437 TORTreeNode(tvSumms.Selected).StringData := x;
2438 lstSumms.Items[EditingIndex] := x;
2439 Changes.ReplaceText(CH_SUM, lstSumms.ItemID, GetTitleText(EditingIndex));
2440 if LastTitle <> FEditDCSumm.Title then mnuActLoadBoilerClick(Self);
2441end;
2442
2443procedure TfrmDCSumm.mnuActChangeClick(Sender: TObject);
2444begin
2445 inherited;
2446 if NoSummSelected() then Exit;
2447 if (FEditingIndex < 0) or (lstSumms.ItemIndex <> FEditingIndex) then Exit;
2448 cmdChangeClick(Sender);
2449end;
2450
2451procedure TfrmDCSumm.mnuActLoadBoilerClick(Sender: TObject);
2452var
2453 NoteEmpty: Boolean;
2454 BoilerText: TStringList;
2455 DocInfo: string;
2456
2457 procedure AssignBoilerText;
2458 begin
2459 ExecuteTemplateOrBoilerPlate(BoilerText, FEditDCSumm.Title, ltTitle, Self, 'Title: ' + FEditDCSumm.TitleName, DocInfo);
2460 memNewSumm.Lines.Assign(BoilerText);
2461 FChanged := False;
2462 end;
2463
2464begin
2465 inherited;
2466 if NoSummSelected() then Exit;
2467 if (FEditingIndex < 0) or (lstSumms.ItemIndex <> FEditingIndex) then Exit;
2468 BoilerText := TStringList.Create;
2469 try
2470 NoteEmpty := memNewSumm.Text = '';
2471 LoadBoilerPlate(BoilerText, FEditDCSumm.Title);
2472 if (BoilerText.Text <> '') or
2473 assigned(GetLinkedTemplate(IntToStr(FEditDCSumm.Title), ltTitle)) then
2474 begin
2475 DocInfo := MakeXMLParamTIU(IntToStr(lstSumms.ItemIEN), FEditDCSumm);
2476 if NoteEmpty then AssignBoilerText else
2477 begin
2478 case QueryBoilerPlate(BoilerText) of
2479 0: { do nothing } ; // ignore
2480 1: begin
2481 ExecuteTemplateOrBoilerPlate(BoilerText, FEditDCSumm.Title, ltTitle, Self, 'Title: ' + FEditDCSumm.TitleName, DocInfo);
2482 memNewSumm.Lines.AddStrings(BoilerText); // append
2483 end;
2484 2: AssignBoilerText // replace
2485 end;
2486 end;
2487 end else
2488 begin
2489 if Sender = mnuActLoadBoiler
2490 then InfoBox(TX_NO_BOIL, TC_NO_BOIL, MB_OK)
2491 else
2492 begin
2493 if not NoteEmpty then
2494 if not FChanged and (InfoBox(TX_BLR_CLEAR, TC_BLR_CLEAR, MB_YESNO) = ID_YES)
2495 then memNewSumm.Lines.Clear;
2496 end;
2497 end; {if BoilerText.Text <> ''}
2498 finally
2499 BoilerText.Free;
2500 end;
2501end;
2502
2503procedure TfrmDCSumm.popSummMemoSaveContinueClick(Sender: TObject);
2504begin
2505 inherited;
2506 FChanged := True;
2507 DoAutoSave;
2508end;
2509
2510procedure TfrmDCSumm.mnuEditDialgFieldsClick(Sender: TObject);
2511begin
2512 inherited;
2513 EditDialogFields;
2514end;
2515
2516//=================== Added for sort/search enhancements ======================
2517procedure TfrmDCSumm.LoadSumms;
2518var
2519 tmpList: TStringList;
2520 ANode: TORTreeNode;
2521
2522begin
2523 tmpList := TStringList.Create;
2524 try
2525 FDocList.Clear;
2526 uChanging := True;
2527 RedrawSuspend(memSumm.Handle);
2528 RedrawSuspend(lvSumms.Handle);
2529 tvSumms.Items.BeginUpdate;
2530 lstSumms.Items.Clear;
2531 KillDocTreeObjects(tvSumms);
2532 tvSumms.Items.Clear;
2533 tvSumms.Items.EndUpdate;
2534 lvSumms.Items.Clear;
2535 memSumm.Clear;
2536 memSumm.Invalidate;
2537 lblTitle.Caption := '';
2538 lvSumms.Caption := lblTitle.Caption;
2539 lblTitle.Hint := lblTitle.Caption;
2540 with FCurrentContext do
2541 begin
2542 if Status <> IntToStr(NC_UNSIGNED) then
2543 begin
2544 ListSummsForTree(tmpList, NC_UNSIGNED, 0, 0, 0, 0, TreeAscending);
2545 if tmpList.Count > 0 then
2546 begin
2547 CreateListItemsForDocumentTree(FDocList, tmpList, NC_UNSIGNED, GroupBy, TreeAscending, CT_DCSUMM);
2548 UpdateTreeView(FDocList, tvSumms);
2549 end;
2550 tmpList.Clear;
2551 FDocList.Clear;
2552 end;
2553 if Status <> IntToStr(NC_UNCOSIGNED) then
2554 begin
2555 ListSummsForTree(tmpList, NC_UNCOSIGNED, 0, 0, 0, 0, TreeAscending);
2556 if tmpList.Count > 0 then
2557 begin
2558 CreateListItemsForDocumentTree(FDocList, tmpList, NC_UNCOSIGNED, GroupBy, TreeAscending, CT_DCSUMM);
2559 UpdateTreeView(FDocList, tvSumms);
2560 end;
2561 tmpList.Clear;
2562 FDocList.Clear;
2563 end;
2564 ListSummsForTree(tmpList, StrToIntDef(Status, 0), FMBeginDate, FMEndDate, Author, MaxDocs, TreeAscending);
2565 CreateListItemsForDocumentTree(FDocList, tmpList, StrToIntDef(Status, 0), GroupBy, TreeAscending, CT_DCSUMM);
2566 UpdateTreeView(FDocList, tvSumms);
2567 end;
2568 with tvSumms do
2569 begin
2570 uChanging := True;
2571 tvSumms.Items.BeginUpdate;
2572 RemoveParentsWithNoChildren(tvSumms, FCurrentContext); // moved TO here in v15.9 (RV)
2573 if FLastSummID <> '' then
2574 Selected := FindPieceNode(FLastSummID, 1, U, nil);
2575 if Selected = nil then
2576 begin
2577 if (FCurrentContext.GroupBy <> '') or (FCurrentContext.Filtered) then
2578 begin
2579 ANode := TORTreeNode(Items.GetFirstNode);
2580 while ANode <> nil do
2581 begin
2582 ANode.Expand(False);
2583 Selected := ANode;
2584 ANode := TORTreeNode(ANode.GetNextSibling);
2585 end;
2586 end
2587 else
2588 begin
2589 ANode := tvSumms.FindPieceNode(FCurrentContext.Status, 1, U, nil);
2590 if ANode <> nil then ANode.Expand(False);
2591 ANode := tvSumms.FindPieceNode(IntToStr(NC_UNSIGNED), 1, U, nil);
2592 if ANode = nil then
2593 ANode := tvSumms.FindPieceNode(IntToStr(NC_UNCOSIGNED), 1, U, nil);
2594 if ANode = nil then
2595 ANode := tvSumms.FindPieceNode(FCurrentContext.Status, 1, U, nil);
2596 if ANode <> nil then
2597 begin
2598 if ANode.getFirstChild <> nil then
2599 Selected := ANode.getFirstChild
2600 else
2601 Selected := ANode;
2602 end;
2603 end;
2604 end;
2605 memSumm.Clear;
2606 with lvSumms do
2607 begin
2608 Selected := nil;
2609 if FCurrentContext.SortBy <> '' then
2610 ColumnToSort := Pos(FCurrentContext.SortBy, 'RDSAL') - 1;
2611 if not FCurrentContext.ShowSubject then
2612 begin
2613 Columns[1].Width := 2 * (Width div 5);
2614 Columns[2].Width := 0;
2615 end
2616 else
2617 begin
2618 Columns[1].Width := Width div 5;
2619 Columns[2].Width := Columns[1].Width;
2620 end;
2621 end;
2622 //RemoveParentsWithNoChildren(tvSumms, FCurrentContext); //moved FROM here in v15.9 (RV)
2623 tvSumms.Items.EndUpdate;
2624 uChanging := False;
2625 SendMessage(tvSumms.Handle, WM_VSCROLL, SB_TOP, 0);
2626 if Selected <> nil then tvSummsChange(Self, Selected);
2627 end;
2628 finally
2629 RedrawActivate(memSumm.Handle);
2630 RedrawActivate(lvSumms.Handle);
2631 tmpList.Free;
2632 end;
2633end;
2634
2635procedure TfrmDCSumm.UpdateTreeView(DocList: TStringList; Tree: TORTreeView);
2636begin
2637 with Tree do
2638 begin
2639 uChanging := True;
2640 Items.BeginUpdate;
2641 lstSumms.Items.AddStrings(DocList);
2642 BuildDocumentTree(DocList, '0', Tree, nil, FCurrentContext, CT_DCSUMM);
2643 Items.EndUpdate;
2644 uChanging := False;
2645 end;
2646end;
2647
2648procedure TfrmDCSumm.tvSummsChange(Sender: TObject; Node: TTreeNode);
2649var
2650 x, MySearch, MyNodeID: string;
2651 i: integer;
2652 WhyNot: string;
2653begin
2654 if uChanging then Exit;
2655 //This gives the change a chance to occur when keyboarding, so that WindowEyes
2656 //doesn't use the old value.
2657 Application.ProcessMessages;
2658 with tvSumms do
2659 begin
2660 memSumm.Clear;
2661 if Selected = nil then Exit;
2662 if uIDNotesActive then
2663 begin
2664 mnuActDetachFromIDParent.Enabled := (Selected.ImageIndex in [IMG_ID_CHILD, IMG_ID_CHILD_ADD]);
2665 popSummListDetachFromIDParent.Enabled := (Selected.ImageIndex in [IMG_ID_CHILD, IMG_ID_CHILD_ADD]);
2666 if (Selected.ImageIndex in [IMG_SINGLE, IMG_PARENT, IMG_ID_CHILD, IMG_ID_CHILD_ADD]) then
2667 mnuActAttachtoIDParent.Enabled := CanBeAttached(PDocTreeObject(Selected.Data)^.DocID, WhyNot)
2668 else
2669 mnuActAttachtoIDParent.Enabled := False;
2670 popSummListAttachtoIDParent.Enabled := mnuActAttachtoIDParent.Enabled;
2671 if (Selected.ImageIndex in [IMG_SINGLE, IMG_PARENT,
2672 IMG_IDNOTE_OPEN, IMG_IDNOTE_SHUT,
2673 IMG_IDPAR_ADDENDA_OPEN, IMG_IDPAR_ADDENDA_SHUT]) then
2674 mnuActAddIDEntry.Enabled := CanReceiveAttachment(PDocTreeObject(Selected.Data)^.DocID, WhyNot)
2675 else
2676 mnuActAddIDEntry.Enabled := False;
2677 popSummListAddIDEntry.Enabled := mnuActAddIDEntry.Enabled
2678 end;
2679 RedrawSuspend(lvSumms.Handle);
2680 RedrawSuspend(memSumm.Handle);
2681 popSummListExpandSelected.Enabled := Selected.HasChildren;
2682 popSummListCollapseSelected.Enabled := Selected.HasChildren;
2683 x := TORTreeNode(Selected).StringData;
2684 if (Selected.ImageIndex in [IMG_TOP_LEVEL, IMG_GROUP_OPEN, IMG_GROUP_SHUT]) then
2685 begin
2686 lvSumms.Visible := True;
2687 lvSumms.Items.Clear;
2688 lvSumms.Height := (2 * lvSumms.Parent.Height) div 5;
2689 with lblTitle do
2690 begin
2691 Caption := Trim(Selected.Text);
2692 if (FCurrentContext.SearchField <> '') and (FCurrentContext.Filtered) then
2693 begin
2694 case FCurrentContext.SearchField[1] of
2695 'T': MySearch := 'TITLE';
2696 'S': MySearch := 'SUBJECT';
2697 'B': MySearch := 'TITLE or SUBJECT';
2698 end;
2699 Caption := Caption + ' where ' + MySearch + ' contains "' + UpperCase(FCurrentContext.Keyword) + '"';
2700 end;
2701 Hint := Caption;
2702 lvSumms.Caption := Caption;
2703 end;
2704
2705 if Selected.ImageIndex = IMG_TOP_LEVEL then
2706 MyNodeID := Piece(TORTreeNode(Selected).StringData, U, 1)
2707 else if Selected.Parent.ImageIndex = IMG_TOP_LEVEL then
2708 MyNodeID := Piece(TORTreeNode(Selected.Parent).StringData, U, 1)
2709 else if Selected.Parent.Parent.ImageIndex = IMG_TOP_LEVEL then
2710 MyNodeID := Piece(TORTreeNode(Selected.Parent.Parent).StringData, U, 1);
2711
2712 uChanging := True;
2713 TraverseTree(tvSumms, lvSumms, Selected.GetFirstChild, MyNodeID, FCurrentContext);
2714 with lvSumms do
2715 begin
2716 for i := 0 to Columns.Count - 1 do
2717 Columns[i].ImageIndex := IMG_NONE;
2718 ColumnSortForward := FCurrentContext.ListAscending;
2719 if ColumnToSort = 5 then ColumnToSort := 0;
2720 if ColumnSortForward then
2721 Columns[ColumnToSort].ImageIndex := IMG_ASCENDING
2722 else
2723 Columns[ColumnToSort].ImageIndex := IMG_DESCENDING;
2724 if ColumnToSort = 0 then ColumnToSort := 5;
2725 AlphaSort;
2726 Columns[5].Width := 0;
2727 Columns[6].Width := 0;
2728 end;
2729 uChanging := False;
2730 with lvSumms do
2731 if Items.Count > 0 then
2732 begin
2733 Selected := Items[0];
2734 lvSummsSelectItem(Self, Selected, True);
2735 end
2736 else
2737 begin
2738 Selected := nil;
2739 lstSumms.ItemIndex := -1;
2740 memPCEShow.Clear;
2741 ShowPCEControls(False);
2742 end;
2743 pnlWrite.Visible := False;
2744 pnlRead.Visible := True;
2745(* UpdateReminderFinish;
2746 ShowPCEControls(False);
2747 frmDrawers.DisplayDrawers(FALSE);
2748 cmdNewSumm.Visible := TRUE;
2749 cmdPCE.Visible := FALSE;
2750 lblSpace1.Top := cmdNewSumm.Top - lblSpace1.Height;*)
2751 //memSumm.Clear;
2752 end
2753 else if StrToIntDef(Piece(x, U, 1), 0) > 0 then
2754 begin
2755 memSumm.Clear;
2756 lvSumms.Visible := False;
2757 lstSumms.SelectByID(Piece(x, U, 1));
2758 lstSummsClick(Self);
2759 SendMessage(memSumm.Handle, WM_VSCROLL, SB_TOP, 0);
2760 end;
2761 SendMessage(tvSumms.Handle, WM_HSCROLL, SB_THUMBTRACK, 0);
2762 RedrawActivate(lvSumms.Handle);
2763 RedrawActivate(memSumm.Handle);
2764 end;
2765end;
2766
2767procedure TfrmDCSumm.tvSummsCollapsed(Sender: TObject; Node: TTreeNode);
2768begin
2769 with Node do
2770 begin
2771 if (ImageIndex in [IMG_GROUP_OPEN, IMG_IDNOTE_OPEN, IMG_IDPAR_ADDENDA_OPEN]) then
2772 ImageIndex := ImageIndex - 1;
2773 if (SelectedIndex in [IMG_GROUP_OPEN, IMG_IDNOTE_OPEN, IMG_IDPAR_ADDENDA_OPEN]) then
2774 SelectedIndex := SelectedIndex - 1;
2775 end;
2776end;
2777
2778procedure TfrmDCSumm.tvSummsExpanded(Sender: TObject; Node: TTreeNode);
2779
2780 function SortByTitle(Node1, Node2: TTreeNode; Data: Longint): Integer; stdcall;
2781 begin
2782 { Within an ID parent node, sorts in ascending order by title
2783 BUT - addenda to parent document are always at the top of the sort, in date order}
2784 if (Copy(PDocTreeObject(Node1.Data)^.DocTitle, 1, 8) = 'Addendum') and
2785 (Copy(PDocTreeObject(Node2.Data)^.DocTitle, 1, 8) = 'Addendum') then
2786 begin
2787 Result := AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocFMDate),
2788 PChar(PDocTreeObject(Node2.Data)^.DocFMDate));
2789 end
2790 else if Copy(PDocTreeObject(Node1.Data)^.DocTitle, 1, 8) = 'Addendum' then Result := -1
2791 else if Copy(PDocTreeObject(Node2.Data)^.DocTitle, 1, 8) = 'Addendum' then Result := 1
2792 else
2793 begin
2794 if Data = 0 then
2795 Result := AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocTitle),
2796 PChar(PDocTreeObject(Node2.Data)^.DocTitle))
2797 else
2798 Result := -AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocTitle),
2799 PChar(PDocTreeObject(Node2.Data)^.DocTitle));
2800 end
2801 end;
2802
2803 function SortByDate(Node1, Node2: TTreeNode; Data: Longint): Integer; stdcall;
2804 begin
2805 { Within an ID parent node, sorts in ascending order by document date
2806 BUT - addenda to parent document are always at the top of the sort, in date order}
2807 if (Copy(PDocTreeObject(Node1.Data)^.DocTitle, 1, 8) = 'Addendum') and
2808 (Copy(PDocTreeObject(Node2.Data)^.DocTitle, 1, 8) = 'Addendum') then
2809 begin
2810 Result := AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocFMDate),
2811 PChar(PDocTreeObject(Node2.Data)^.DocFMDate));
2812 end
2813 else if Copy(PDocTreeObject(Node1.Data)^.DocTitle, 1, 8) = 'Addendum' then Result := -1
2814 else if Copy(PDocTreeObject(Node2.Data)^.DocTitle, 1, 8) = 'Addendum' then Result := 1
2815 else
2816 begin
2817 if Data = 0 then
2818 Result := AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocFMDate),
2819 PChar(PDocTreeObject(Node2.Data)^.DocFMDate))
2820 else
2821 Result := -AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocFMDate),
2822 PChar(PDocTreeObject(Node2.Data)^.DocFMDate));
2823 end;
2824 end;
2825
2826begin
2827 with Node do
2828 begin
2829 if Assigned(Data) then
2830 if (Pos('<', PDocTreeObject(Data)^.DocHasChildren) > 0) then
2831 begin
2832 if (PDocTreeObject(Node.Data)^.OrderByTitle) then
2833 CustomSort(@SortByTitle, 0)
2834 else
2835 CustomSort(@SortByDate, 0);
2836 end;
2837 if (ImageIndex in [IMG_GROUP_SHUT, IMG_IDNOTE_SHUT, IMG_IDPAR_ADDENDA_SHUT]) then
2838 ImageIndex := ImageIndex + 1;
2839 if (SelectedIndex in [IMG_GROUP_SHUT, IMG_IDNOTE_SHUT, IMG_IDPAR_ADDENDA_SHUT]) then
2840 SelectedIndex := SelectedIndex + 1;
2841 end;
2842end;
2843
2844procedure TfrmDCSumm.tvSummsClick(Sender: TObject);
2845begin
2846(* if tvSumms.Selected = nil then exit;
2847 if (tvSumms.Selected.ImageIndex in [IMG_TOP_LEVEL, IMG_GROUP_OPEN, IMG_GROUP_SHUT]) then
2848 begin
2849 uChanging := True;
2850 lvSumms.Selected := nil;
2851 uChanging := False;
2852 memSumm.Clear;
2853 end;*)
2854end;
2855
2856procedure TfrmDCSumm.tvSummsDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
2857var
2858 AnItem: TORTreeNode;
2859begin
2860 Accept := False;
2861 if not uIDNotesActive then exit;
2862 AnItem := TORTreeNode(tvSumms.GetNodeAt(X, Y));
2863 if (AnItem = nil) or (AnItem.ImageIndex in [IMG_GROUP_OPEN, IMG_GROUP_SHUT, IMG_TOP_LEVEL]) then Exit;
2864 with tvSumms.Selected do
2865 if (ImageIndex in [IMG_SINGLE, IMG_PARENT, IMG_ID_CHILD, IMG_ID_CHILD_ADD]) then
2866 Accept := (AnItem.ImageIndex in [IMG_SINGLE, IMG_PARENT,
2867 IMG_IDNOTE_OPEN, IMG_IDNOTE_SHUT,
2868 IMG_IDPAR_ADDENDA_OPEN, IMG_IDPAR_ADDENDA_SHUT])
2869 else if (ImageIndex in [IMG_IDNOTE_OPEN, IMG_IDNOTE_SHUT, IMG_IDPAR_ADDENDA_OPEN, IMG_IDPAR_ADDENDA_SHUT]) then
2870 Accept := (AnItem.ImageIndex in [IMG_GROUP_OPEN, IMG_GROUP_SHUT, IMG_TOP_LEVEL])
2871 else if (ImageIndex in [IMG_ADDENDUM, IMG_GROUP_OPEN, IMG_GROUP_SHUT, IMG_TOP_LEVEL]) then
2872 Accept := False;
2873end;
2874
2875procedure TfrmDCSumm.tvSummsDragDrop(Sender, Source: TObject; X, Y: Integer);
2876var
2877 HT: THitTests;
2878 Saved: boolean;
2879 ADestNode: TORTreeNode;
2880begin
2881 if not uIDNotesActive then
2882 begin
2883 CancelDrag;
2884 exit;
2885 end;
2886 if tvSumms.Selected = nil then exit;
2887 if EditingIndex <> -1 then
2888 begin
2889 SaveCurrentSumm(Saved);
2890 if not Saved then Exit;
2891 end;
2892 HT := tvSumms.GetHitTestInfoAt(X, Y);
2893 ADestNode := TORTreeNode(tvSumms.GetNodeAt(X, Y));
2894 DoAttachIDChild(TORTreeNode(tvSumms.Selected), ADestNode);
2895end;
2896
2897procedure TfrmDCSumm.tvSummsStartDrag(Sender: TObject;
2898 var DragObject: TDragObject);
2899const
2900 TX_CAP_NO_DRAG = 'Item cannot be moved';
2901 var
2902 WhyNot: string;
2903 Saved: boolean;
2904begin
2905 if (tvSumms.Selected.ImageIndex in [IMG_ADDENDUM, IMG_GROUP_OPEN, IMG_GROUP_SHUT, IMG_TOP_LEVEL]) or
2906 (not uIDNotesActive) or
2907 (lstSumms.ItemIEN = 0) then
2908 begin
2909 CancelDrag;
2910 Exit;
2911 end;
2912 if EditingIndex <> -1 then
2913 begin
2914 SaveCurrentSumm(Saved);
2915 if not Saved then Exit;
2916 end;
2917 if not CanBeAttached(PDocTreeObject(tvSumms.Selected.Data)^.DocID, WhyNot) then
2918 begin
2919 InfoBox(WhyNot, TX_CAP_NO_DRAG, MB_OK);
2920 CancelDrag;
2921 end;
2922end;
2923
2924procedure TfrmDCSumm.lvSummsColumnClick(Sender: TObject; Column: TListColumn);
2925var
2926 i, ClickedColumn: Integer;
2927begin
2928 if Column.Index = 0 then ClickedColumn := 5 else ClickedColumn := Column.Index;
2929 if ClickedColumn = ColumnToSort then
2930 ColumnSortForward := not ColumnSortForward
2931 else
2932 ColumnSortForward := True;
2933 for i := 0 to lvSumms.Columns.Count - 1 do
2934 lvSumms.Columns[i].ImageIndex := IMG_NONE;
2935 if ColumnSortForward then lvSumms.Columns[Column.Index].ImageIndex := IMG_ASCENDING
2936 else lvSumms.Columns[Column.Index].ImageIndex := IMG_DESCENDING;
2937 ColumnToSort := ClickedColumn;
2938 case ColumnToSort of
2939 5: FCurrentContext.SortBy := 'R';
2940 1: FCurrentContext.SortBy := 'D';
2941 2: FCurrentContext.SortBy := 'S';
2942 3: FCurrentContext.SortBy := 'A';
2943 4: FCurrentContext.SortBy := 'L';
2944 else
2945 FCurrentContext.SortBy := 'R';
2946 end;
2947 FCurrentContext.ListAscending := ColumnSortForward;
2948 (Sender as TCustomListView).AlphaSort;
2949 //with lvSumms do if Selected <> nil then Scroll(0, Selected.Top - TopItem.Top);
2950end;
2951
2952procedure TfrmDCSumm.lvSummsCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
2953var
2954 ix: Integer;
2955begin
2956 if ColumnToSort = 0 then
2957 Compare := CompareText(Item1.Caption,Item2.Caption)
2958 else begin
2959 ix := ColumnToSort - 1;
2960 Compare := CompareText(Item1.SubItems[ix],Item2.SubItems[ix]);
2961 end;
2962 if not ColumnSortForward then Compare := -Compare;
2963end;
2964
2965procedure TfrmDCSumm.lvSummsSelectItem(Sender: TObject; Item: TListItem;
2966 Selected: Boolean);
2967begin
2968 if uChanging or (not Selected) then Exit;
2969 with lvSumms do
2970 begin
2971 StatusText('Retrieving selected discharge summary...');
2972 lstSumms.SelectByID(Item.SubItems[5]);
2973 lstSummsClick(Self);
2974 SendMessage(memSumm.Handle, WM_VSCROLL, SB_TOP, 0);
2975 end;
2976end;
2977
2978procedure TfrmDCSumm.lvSummsResize(Sender: TObject);
2979begin
2980 inherited;
2981 with lvSumms do
2982 begin
2983 if not FCurrentContext.ShowSubject then
2984 begin
2985 Columns[1].Width := 2 * (Width div 5);
2986 Columns[2].Width := 0;
2987 end
2988 else
2989 begin
2990 Columns[1].Width := Width div 5;
2991 Columns[2].Width := Columns[1].Width;
2992 end;
2993 end;
2994end;
2995
2996procedure TfrmDCSumm.EnableDisableIDNotes;
2997begin
2998 uIDNotesActive := False; // := IDNotesInstalled; Not yet on this tab
2999 mnuActDetachFromIDParent.Visible := uIDNotesActive;
3000 popSummListDetachFromIDParent.Visible := uIDNotesActive;
3001 mnuActAddIDEntry.Visible := uIDNotesActive;
3002 popSummListAddIDEntry.Visible := uIDNotesActive;
3003 mnuActAttachtoIDParent.Visible := uIDNotesActive;
3004 popSummListAttachtoIDParent.Visible := uIDNotesActive;
3005 if uIDNotesActive then
3006 tvSumms.DragMode := dmAutomatic
3007 else
3008 tvSumms.DragMode := dmManual;
3009end;
3010
3011procedure TfrmDCSumm.mnuIconLegendClick(Sender: TObject);
3012begin
3013 inherited;
3014 ShowIconLegend(ilNotes);
3015end;
3016
3017procedure TfrmDCSumm.mnuActAttachtoIDParentClick(Sender: TObject);
3018var
3019 AChildNode: TORTreeNode;
3020 AParentID: string;
3021 SavedDocID: string;
3022 Saved: boolean;
3023begin
3024 inherited;
3025 if not uIDNotesActive then exit;
3026 if lstSumms.ItemIEN = 0 then exit;
3027 SavedDocID := lstSumms.ItemID;
3028 if EditingIndex <> -1 then
3029 begin
3030 SaveCurrentSumm(Saved);
3031 if not Saved then Exit;
3032 LoadSumms;
3033 with tvSumms do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
3034 end;
3035 if tvSumms.Selected = nil then exit;
3036 AChildNode := TORTreeNode(tvSumms.Selected);
3037 AParentID := SelectParentNodeFromList(tvSumms);
3038 if AParentID = '' then exit;
3039 with tvSumms do Selected := FindPieceNode(AParentID, 1, U, Items.GetFirstNode);
3040 DoAttachIDChild(AChildNode, TORTreeNode(tvSumms.Selected));
3041end;
3042
3043procedure TfrmDCSumm.DoAttachIDChild(AChild, AParent: TORTreeNode);
3044const
3045 TX_ATTACH_CNF = 'Confirm Attachment';
3046 TX_ATTACH_FAILURE = 'Attachment failed';
3047var
3048 ErrMsg, WhyNot: string;
3049 SavedDocID: string;
3050begin
3051 if (AChild = nil) or (AParent = nil) then exit;
3052 ErrMsg := '';
3053 if not CanBeAttached(PDocTreeObject(AChild.Data)^.DocID, WhyNot) then
3054 ErrMsg := ErrMsg + WhyNot + CRLF + CRLF;
3055 if not CanReceiveAttachment(PDocTreeObject(AParent.Data)^.DocID, WhyNot) then
3056 ErrMsg := ErrMsg + WhyNot;
3057 if ErrMsg <> '' then
3058 begin
3059 InfoBox(ErrMsg, TX_ATTACH_FAILURE, MB_OK);
3060 Exit;
3061 end
3062 else
3063 begin
3064 WhyNot := '';
3065 if (InfoBox('ATTACH: ' + AChild.Text + CRLF + CRLF +
3066 ' TO: ' + AParent.Text + CRLF + CRLF +
3067 'Are you sure?', TX_ATTACH_CNF, MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) <> IDYES)
3068 then Exit;
3069 SavedDocID := PDocTreeObject(AParent.Data)^.DocID;
3070 end;
3071 if AChild.ImageIndex in [IMG_ID_CHILD, IMG_ID_CHILD_ADD] then
3072 begin
3073 if DetachEntryFromParent(PDocTreeObject(AChild.Data)^.DocID, WhyNot) then
3074 begin
3075 if AttachEntryToParent(PDocTreeObject(AChild.Data)^.DocID, PDocTreeObject(AParent.Data)^.DocID, WhyNot) then
3076 begin
3077 LoadSumms;
3078 with tvSumms do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
3079 if tvSumms.Selected <> nil then tvSumms.Selected.Expand(False);
3080 end
3081 else
3082 InfoBox(WhyNot, TX_ATTACH_FAILURE, MB_OK);
3083 end
3084 else
3085 begin
3086 WhyNot := StringReplace(WhyNot, 'ATTACH', 'DETACH', [rfIgnoreCase]);
3087 WhyNot := StringReplace(WhyNot, 'to an ID', 'from an ID', [rfIgnoreCase]);
3088 InfoBox(WhyNot, TX_DETACH_FAILURE, MB_OK);
3089 Exit;
3090 end;
3091 end
3092 else
3093 begin
3094 if AttachEntryToParent(PDocTreeObject(AChild.Data)^.DocID, PDocTreeObject(AParent.Data)^.DocID, WhyNot) then
3095 begin
3096 LoadSumms;
3097 with tvSumms do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
3098 if tvSumms.Selected <> nil then tvSumms.Selected.Expand(False);
3099 end
3100 else
3101 InfoBox(WhyNot, TX_ATTACH_FAILURE, MB_OK);
3102 end;
3103end;
3104
3105function TfrmDCSumm.SetSummTreeLabel(AContext: TTIUContext): string;
3106var
3107 x: string;
3108
3109 function SetDateRangeText(AContext: TTIUContext): string;
3110 var
3111 x1: string;
3112 begin
3113 with AContext do
3114 if BeginDate <> '' then
3115 begin
3116 x1 := ' from ' + UpperCase(BeginDate);
3117 if EndDate <> '' then x1 := x1 + ' to ' + UpperCase(EndDate)
3118 else x1 := x1 + ' to TODAY';
3119 end;
3120 Result := x1;
3121 end;
3122
3123begin
3124 with AContext do
3125 begin
3126 if MaxDocs > 0 then x := 'Last ' + IntToStr(MaxDocs) + ' ' else x := 'All ';
3127 case StrToIntDef(Status, 0) of
3128 NC_ALL : x := x + 'Signed Summaries';
3129 NC_UNSIGNED : begin
3130 x := x + 'Unsigned Summaries for ';
3131 if Author > 0 then x := x + ExternalName(Author, 200)
3132 else x := x + User.Name;
3133 x := x + SetDateRangeText(AContext);
3134 end;
3135 NC_UNCOSIGNED : begin
3136 x := x + 'Uncosigned Summaries for ';
3137 if Author > 0 then x := x + ExternalName(Author, 200)
3138 else x := x + User.Name;
3139 x := x + SetDateRangeText(AContext);
3140 end;
3141 NC_BY_AUTHOR : x := x + 'Signed Summaries for ' + ExternalName(Author, 200) + SetDateRangeText(AContext);
3142 NC_BY_DATE : x := x + 'Signed Summaries ' + SetDateRangeText(AContext);
3143 else
3144 x := 'Custom List';
3145 end;
3146 end;
3147 Result := x;
3148end;
3149
3150procedure TfrmDCSumm.memNewSummKeyUp(Sender: TObject; var Key: Word;
3151 Shift: TShiftState);
3152begin
3153 inherited;
3154 if (Key = VK_TAB) then
3155 begin
3156 if ssShift in Shift then
3157 begin
3158 FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
3159 Key := 0;
3160 end
3161 else if ssCtrl in Shift then
3162 begin
3163 FindNextControl(Sender as TWinControl, True, True, False).SetFocus; //next control
3164 Key := 0;
3165 end;
3166 end;
3167 if (key = VK_ESCAPE) then begin
3168 FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
3169 key := 0;
3170 end;
3171end;
3172
3173procedure TfrmDCSumm.sptHorzCanResize(Sender: TObject; var NewSize: Integer;
3174 var Accept: Boolean);
3175begin
3176 inherited;
3177 if pnlWrite.Visible then
3178 if NewSize > frmDCSumm.ClientWidth - memNewSumm.Constraints.MinWidth - sptHorz.Width then
3179 NewSize := frmDCSumm.ClientWidth - memNewSumm.Constraints.MinWidth - sptHorz.Width;
3180end;
3181
3182procedure TfrmDCSumm.popSummMemoPreviewClick(Sender: TObject);
3183begin
3184 frmDrawers.mnuPreviewTemplateClick(Sender);
3185end;
3186
3187procedure TfrmDCSumm.popSummMemoInsTemplateClick(Sender: TObject);
3188begin
3189 frmDrawers.mnuInsertTemplateClick(Sender);
3190end;
3191
3192procedure TfrmDCSumm.tvSummsAddition(Sender: TObject; Node: TTreeNode);
3193begin
3194 inherited;
3195 TAccessibleTreeNode.WrapControl(Node as TORTreeNode);
3196end;
3197
3198procedure TfrmDCSumm.tvSummsDeletion(Sender: TObject; Node: TTreeNode);
3199begin
3200 TAccessibleTreeNode.UnwrapControl(Node as TORTreeNode);
3201 inherited;
3202end;
3203
3204
3205{Returns True & Displays a Message if Currently No D/C Summary is Selected,
3206 Otherwise returns false and does not display a message.}
3207function TfrmDCSumm.NoSummSelected: Boolean;
3208begin
3209 if lstSumms.ItemIEN <= 0 then
3210 begin
3211 InfoBox(TX_NOSUMM,TX_NOSUMM_CAP,MB_OK or MB_ICONWARNING);
3212 Result := true;
3213 end
3214 else
3215 Result := false;
3216end;
3217
3218initialization
3219 uPCEEdit := TPCEData.Create;
3220 uPCEShow := TPCEData.Create;
3221
3222finalization
3223 uPCEEdit.Free;
3224 uPCEShow.Free;
3225
3226end.
Note: See TracBrowser for help on using the repository browser.