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

Last change on this file since 1713 was 1679, checked in by healthsevak, 10 years ago

Updating the working copy to CPRS version 28

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