source: cprs/branches/tmg-cprs/CPRS-Chart/fDCSumm.pas@ 1245

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

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