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

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

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