source: cprs/trunk/CPRS-Chart/fDCSumm.pas@ 836

Last change on this file since 836 was 830, checked in by Kevin Toppenberg, 14 years ago

Upgrading to version 27

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