source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/fDCSumm.pas@ 1702

Last change on this file since 1702 was 1702, checked in by healthsevak, 9 years ago

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