source: cprs/trunk/CPRS-Chart/Consults/fConsults.pas@ 1085

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

Upgrade to version 27
File size: 176.8 KB
RevLine 
[456]1unit fConsults;
[829]2{Notes of Intent:
3 Tab Order:
4 The tab order has been custom coded to place the pnlRight in the Tab order
5 right after the tvConsults.
6}
[456]7
8interface
9
10uses
11 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORDtTm,
12 fHSplit, stdCtrls, ExtCtrls, Menus, ComCtrls, ORCtrls, ORFn, uConsults, rOrders, uPCE,
[829]13 ORClasses, uConst, fDrawers, rTIU, uTIU, uDocTree, RichEdit, fPrintList,
14 VA508AccessibilityManager, fBase508Form, VA508ImageListLabeler;
[456]15
16type
17 TfrmConsults = class(TfrmHSplit)
18 mnuConsults: TMainMenu;
19 mnuView: TMenuItem;
20 mnuViewChart: TMenuItem;
21 mnuChartReports: TMenuItem;
22 mnuChartLabs: TMenuItem;
23 mnuChartDCSumm: TMenuItem;
24 mnuChartCslts: TMenuItem;
25 mnuChartNotes: TMenuItem;
26 mnuChartOrders: TMenuItem;
27 mnuChartMeds: TMenuItem;
28 mnuChartProbs: TMenuItem;
29 mnuChartCover: TMenuItem;
30 mnuAct: TMenuItem;
31 Z2: TMenuItem;
32 pnlRead: TPanel;
33 lblTitle: TOROffsetLabel;
34 memConsult: TRichEdit;
35 pnlAction: TPanel;
36 cmdNewConsult: TORAlignButton;
37 Z3: TMenuItem;
38 mnuViewAll: TMenuItem;
39 mnuViewByService: TMenuItem;
40 mnuViewByDate: TMenuItem;
41 mnuViewByStatus: TMenuItem;
42 cmdNewProc: TORAlignButton;
43 N1: TMenuItem;
44 mnuActConsultRequest: TMenuItem;
45 mnuActReceive: TMenuItem;
46 mnuActDeny: TMenuItem;
47 mnuActForward: TMenuItem;
48 mnuActDiscontinue: TMenuItem;
49 mnuActAddComment: TMenuItem;
50 mnuActComplete: TMenuItem;
51 mnuActNew: TMenuItem;
52 mnuActNewConsultRequest: TMenuItem;
53 mnuActNewProcedure: TMenuItem;
54 mnuActSignatureList: TMenuItem;
55 mnuActSignatureSave: TMenuItem;
56 mnuActSignatureSign: TMenuItem;
57 mnuActMakeAddendum: TMenuItem;
58 mnuViewCustom: TMenuItem;
59 pnlResults: TPanel;
60 memResults: TRichEdit;
61 mnuActNoteEdit: TMenuItem;
62 mnuActNoteDelete: TMenuItem;
63 sptVert: TSplitter;
64 memPCEShow: TRichEdit;
65 cmdEditResubmit: TORAlignButton;
66 cmdPCE: TORAlignButton;
67 mnuActConsultResults: TMenuItem;
68 N2: TMenuItem;
69 lstNotes: TORListBox;
70 popNoteMemo: TPopupMenu;
71 popNoteMemoCut: TMenuItem;
72 popNoteMemoCopy: TMenuItem;
73 popNoteMemoPaste: TMenuItem;
74 Z10: TMenuItem;
75 popNoteMemoSignList: TMenuItem;
76 popNoteMemoDelete: TMenuItem;
77 popNoteMemoEdit: TMenuItem;
78 popNoteMemoSave: TMenuItem;
79 popNoteMemoSign: TMenuItem;
80 popConsultList: TPopupMenu;
81 popConsultAll: TMenuItem;
82 popConsultStatus: TMenuItem;
83 popConsultService: TMenuItem;
84 popConsultDates: TMenuItem;
85 popConsultCustom: TMenuItem;
86 mnuActPrintSF513: TMenuItem;
87 N3: TMenuItem;
88 mnuActDisplayDetails: TMenuItem;
89 mnuActDisplayResults: TMenuItem;
90 mnuActDisplaySF513: TMenuItem;
91 mnuActSigFindings: TMenuItem;
92 mnuActAdminComplete: TMenuItem;
93 mnuActIdentifyAddlSigners: TMenuItem;
94 popNoteMemoAddlSign: TMenuItem;
95 Z11: TMenuItem;
96 popNoteMemoSpell: TMenuItem;
97 popNoteMemoGrammar: TMenuItem;
98 mnuActEditResubmit: TMenuItem;
99 N4: TMenuItem;
100 mnuViewSaveAsDefault: TMenuItem;
101 mnuViewReturntoDefault: TMenuItem;
102 splDrawers: TSplitter;
103 N5: TMenuItem;
104 popNoteMemoTemplate: TMenuItem;
105 mnuOptions: TMenuItem;
106 mnuEditTemplates: TMenuItem;
107 mnuNewTemplate: TMenuItem;
108 splConsults: TSplitter;
109 pnlConsultList: TPanel;
110 lblConsults: TOROffsetLabel;
111 lstConsults: TORListBox;
112 N6: TMenuItem;
113 mnuEditSharedTemplates: TMenuItem;
114 mnuNewSharedTemplate: TMenuItem;
115 popNoteMemoPrint: TMenuItem;
116 N7: TMenuItem;
117 N8: TMenuItem;
118 mnuActNotePrint: TMenuItem;
119 timAutoSave: TTimer;
120 pnlFields: TPanel;
121 lblNewTitle: TStaticText;
122 lblRefDate: TStaticText;
123 lblAuthor: TStaticText;
124 lblVisit: TStaticText;
125 lblCosigner: TStaticText;
126 lblSubject: TStaticText;
127 cmdChange: TButton;
128 txtSubject: TCaptionEdit;
129 mnuActSchedule: TMenuItem;
130 popNoteMemoPaste2: TMenuItem;
131 popNoteMemoReformat: TMenuItem;
132 N9: TMenuItem;
133 mnuActChange: TMenuItem;
134 mnuActLoadBoiler: TMenuItem;
135 bvlNewTitle: TBevel;
136 popNoteMemoSaveContinue: TMenuItem;
137 mnuActAttachMed: TMenuItem;
138 mnuActRemoveMed: TMenuItem;
139 N10: TMenuItem;
140 mnuEditDialgFields: TMenuItem;
141 tvCsltNotes: TORTreeView;
142 popNoteList: TPopupMenu;
143 popNoteListExpandSelected: TMenuItem;
144 popNoteListExpandAll: TMenuItem;
145 popNoteListCollapseSelected: TMenuItem;
146 popNoteListCollapseAll: TMenuItem;
147 N11: TMenuItem;
148 popNoteListDetachFromIDParent: TMenuItem;
149 N12: TMenuItem;
150 mnuActDetachFromIDParent: TMenuItem;
151 mnuActAddIDEntry: TMenuItem;
152 tvConsults: TORTreeView;
153 popNoteListAddIDEntry: TMenuItem;
154 N13: TMenuItem;
155 mnuIconLegend: TMenuItem;
156 dlgFindText: TFindDialog;
157 popNoteMemoFind: TMenuItem;
158 dlgReplaceText: TReplaceDialog;
159 N14: TMenuItem;
160 popNoteMemoReplace: TMenuItem;
161 mnuChartSurgery: TMenuItem;
162 mnuActAttachtoIDParent: TMenuItem;
163 popNoteListAttachtoIDParent: TMenuItem;
164 popNoteMemoAddend: TMenuItem;
165 N15: TMenuItem;
166 popNoteMemoPreview: TMenuItem;
167 popNoteMemoInsTemplate: TMenuItem;
168 popNoteMemoEncounter: TMenuItem;
169 mnuViewInformation: TMenuItem;
170 mnuViewDemo: TMenuItem;
171 mnuViewVisits: TMenuItem;
172 mnuViewPrimaryCare: TMenuItem;
173 mnuViewMyHealtheVet: TMenuItem;
174 mnuInsurance: TMenuItem;
175 mnuViewFlags: TMenuItem;
176 mnuViewReminders: TMenuItem;
177 mnuViewRemoteData: TMenuItem;
178 mnuViewPostings: TMenuItem;
[829]179 imgLblNotes: TVA508ImageListLabeler;
180 imgLblImages: TVA508ImageListLabeler;
181 imgLblConsults: TVA508ImageListLabeler;
[456]182 procedure mnuChartTabClick(Sender: TObject);
183 procedure lstConsultsClick(Sender: TObject);
184 procedure pnlRightResize(Sender: TObject);
185 procedure cmdNewConsultClick(Sender: TObject);
186 procedure memResultChange(Sender: TObject);
187 procedure mnuActCompleteClick(Sender: TObject);
188 procedure mnuActAddIDEntryClick(Sender: TObject);
189 procedure mnuActSignatureSaveClick(Sender: TObject);
190 procedure mnuViewClick(Sender: TObject);
191 procedure mnuActSignatureListClick(Sender: TObject);
192 procedure mnuActSignatureSignClick(Sender: TObject);
193 procedure mnuActMakeAddendumClick(Sender: TObject);
194 procedure mnuActDetachFromIDParentClick(Sender: TObject);
195 procedure mnuActAttachtoIDParentClick(Sender: TObject);
196 procedure cmdPCEClick(Sender: TObject);
197 procedure mnuActConsultClick(Sender: TObject);
198 procedure mnuActNewConsultRequestClick(Sender: TObject);
199 procedure mnuActNoteEditClick(Sender: TObject);
200 procedure mnuActNoteDeleteClick(Sender: TObject);
201 procedure lstNotesClick(Sender: TObject);
202 procedure popNoteMemoCutClick(Sender: TObject);
203 procedure popNoteMemoCopyClick(Sender: TObject);
204 procedure popNoteMemoPasteClick(Sender: TObject);
205 procedure popNoteMemoPopup(Sender: TObject);
206 procedure NewPersonNeedData(Sender: TObject; const StartFrom: string;
207 Direction, InsertAt: Integer);
208 procedure cmdNewProcClick(Sender: TObject);
209 procedure mnuActNewProcedureClick(Sender: TObject);
210 procedure mnuActDisplayResultsClick(Sender: TObject);
211 procedure mnuActDisplaySF513Click(Sender: TObject);
212 procedure pnlResultsResize(Sender: TObject);
213 procedure mnuActPrintSF513Click(Sender: TObject);
214 procedure FormCreate(Sender: TObject);
215 procedure mnuActDisplayDetailsClick(Sender: TObject);
216 procedure FormClose(Sender: TObject; var Action: TCloseAction);
217 procedure mnuActIdentifyAddlSignersClick(Sender: TObject);
218 procedure popNoteMemoAddlSignClick(Sender: TObject);
219 procedure mnuActEditResubmitClick(Sender: TObject);
220 procedure EnableDisableOrdering;
221 procedure cmdEditResubmitClick(Sender: TObject);
222 procedure popNoteMemoSpellClick(Sender: TObject);
223 procedure popNoteMemoGrammarClick(Sender: TObject);
224 procedure mnuViewSaveAsDefaultClick(Sender: TObject);
225 procedure mnuViewReturntoDefaultClick(Sender: TObject);
226 procedure popNoteMemoTemplateClick(Sender: TObject);
227 procedure mnuEditTemplatesClick(Sender: TObject);
228 procedure mnuNewTemplateClick(Sender: TObject);
229 procedure pnlLeftResize(Sender: TObject);
230 procedure mnuOptionsClick(Sender: TObject);
231 procedure mnuEditSharedTemplatesClick(Sender: TObject);
232 procedure mnuNewSharedTemplateClick(Sender: TObject);
233 procedure popNoteMemoPrintClick(Sender: TObject);
234 procedure mnuActNotePrintClick(Sender: TObject);
235 procedure FormDestroy(Sender: TObject);
236 procedure timAutoSaveTimer(Sender: TObject);
237 procedure cmdChangeClick(Sender: TObject);
238 procedure pnlFieldsResize(Sender: TObject);
239 procedure popNoteMemoReformatClick(Sender: TObject);
240 procedure mnuActChangeClick(Sender: TObject);
241 procedure mnuActLoadBoilerClick(Sender: TObject);
242 procedure popNoteMemoSaveContinueClick(Sender: TObject);
243 procedure ProcessMedResults(ActionType: string);
244 procedure mnuActAttachMedClick(Sender: TObject);
245 procedure mnuActRemoveMedClick(Sender: TObject);
246 procedure mnuEditDialgFieldsClick(Sender: TObject);
247 procedure tvCsltNotesChange(Sender: TObject; Node: TTreeNode);
248 procedure tvCsltNotesCollapsed(Sender: TObject; Node: TTreeNode);
249 procedure tvCsltNotesExpanded(Sender: TObject; Node: TTreeNode);
250 procedure tvCsltNotesStartDrag(Sender: TObject;
251 var DragObject: TDragObject);
252 procedure tvCsltNotesDragDrop(Sender, Source: TObject; X, Y: Integer);
253 procedure tvCsltNotesDragOver(Sender, Source: TObject; X, Y: Integer;
254 State: TDragState; var Accept: Boolean);
255 procedure popNoteListExpandSelectedClick(Sender: TObject);
256 procedure popNoteListExpandAllClick(Sender: TObject);
257 procedure popNoteListCollapseSelectedClick(Sender: TObject);
258 procedure popNoteListCollapseAllClick(Sender: TObject);
259 procedure tvCsltNotesClick(Sender: TObject);
260 procedure tvConsultsExpanded(Sender: TObject; Node: TTreeNode);
261 procedure tvConsultsCollapsed(Sender: TObject; Node: TTreeNode);
262 procedure tvConsultsClick(Sender: TObject);
263 procedure tvConsultsChange(Sender: TObject; Node: TTreeNode);
264 procedure popNoteListPopup(Sender: TObject);
265 procedure mnuIconLegendClick(Sender: TObject);
266 procedure popNoteMemoFindClick(Sender: TObject);
267 procedure dlgFindTextFind(Sender: TObject);
268 procedure dlgReplaceTextFind(Sender: TObject);
269 procedure dlgReplaceTextReplace(Sender: TObject);
270 procedure popNoteMemoReplaceClick(Sender: TObject);
271 procedure tvConsultsKeyUp(Sender: TObject; var Key: Word;
272 Shift: TShiftState);
273 procedure memResultsKeyDown(Sender: TObject; var Key: Word;
274 Shift: TShiftState);
275 procedure sptHorzCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean);
276 procedure popNoteMemoPreviewClick(Sender: TObject);
277 procedure popNoteMemoInsTemplateClick(Sender: TObject);
278 procedure tvConsultsExit(Sender: TObject);
279 procedure FormHide(Sender: TObject);
280 procedure FormShow(Sender: TObject);
281 procedure ViewInfo(Sender: TObject);
282 procedure mnuViewInformationClick(Sender: TObject);
[829]283 procedure pnlLeftExit(Sender: TObject);
284 procedure pnlRightExit(Sender: TObject);
285 procedure cmdEditResubmitExit(Sender: TObject);
286 procedure cmdNewConsultExit(Sender: TObject);
[456]287 private
[829]288 FocusToRightPanel : Boolean;
[456]289 FEditingIndex: Integer; // TIU index of document being currently edited
290 FChanged: Boolean;
291 FActionType: integer ;
292 FEditCtrl: TCustomEdit;
293 FSilent: Boolean;
294 FCurrentContext: TSelectContext;
295 FDefaultContext: TSelectContext;
296 FCurrentNoteContext: TTIUContext;
297 FOrderID: string;
298 FImageFlag: TBitmap;
299 FEditNote: TEditNoteRec;
300 FVerifyNoteTitle: Integer;
301 FDocList: TStringList;
302 FConfirmed: boolean;
303 FCsltList: TStringList;
304 FDeleted: boolean;
305 FLastNoteID: string;
306 FcmdChangeOKPressed: boolean;
307 FNotifPending: boolean;
308 FOldFramePnlPatientExit: TNotifyEvent;
[829]309 //FMousing: TDateTime;
310 procedure DoLeftPanelCustomShiftTab;
[456]311 procedure frmFramePnlPatientExit(Sender: TObject);
312 procedure DoAutoSave(Suppress: integer = 1);
313 function GetTitleText(AnIndex: Integer): string;
314 //function MakeTitleText(IsAddendum: Boolean = False): string;
315 procedure ClearEditControls;
316 procedure LoadForEdit ;
317 function LacksRequiredForCreate: Boolean;
318 function LacksClinProcFields(AnEditRec: TEditNoteRec; AMenuAccessRec: TMenuAccessRec; var ErrMsg: string): boolean;
319 function LacksClinProcFieldsForSignature(NoteIEN: int64; var ErrMsg: string): boolean;
320 procedure UpdateList;
321 procedure DisplayPCE;
322 procedure CompleteConsult(IsIDChild: boolean; AnIDParent: integer; UseClinProcTitles: boolean);
323 procedure InsertAddendum;
324 procedure SetSubjectVisible(ShouldShow: Boolean);
325 procedure SaveCurrentNote(var Saved: Boolean);
326 procedure SaveEditedConsult(var Saved: Boolean);
327 procedure SetEditingIndex(const Value: Integer);
328 procedure ShowPCEControls(ShouldShow: Boolean);
329 procedure SetActionMenus ;
330 procedure SetResultMenus ;
331 procedure RemovePCEFromChanges(IEN: Integer; AVisitStr: string = '');
332 procedure ProcessNotifications;
333 procedure UMNewOrder(var Message: TMessage); message UM_NEWORDER;
334 procedure SetViewContext(AContext: TSelectContext);
335 function GetDrawers: TFrmDrawers;
336 function LockConsultRequest(AConsult: Integer): Boolean;
337 function LockConsultRequestAndNote(AnIEN: Int64): Boolean;
338 function StartNewEdit(NewNoteType: integer): Boolean;
339 procedure UnlockConsultRequest(ANote: Int64; AConsult: Integer = 0);
340 function CanFinishReminder: boolean;
341 property EditingIndex: Integer read FEditingIndex write SetEditingIndex;
342 function VerifyNoteTitle: Boolean;
343 procedure UpdateNoteTreeView(DocList: TStringList; Tree: TORTreeView; AContext: integer);
344 procedure EnableDisableIDNotes;
345 procedure LoadConsults;
346 procedure UpdateConsultsTreeView(DocList: TStringList; Tree: TORTreeView);
347 procedure DoAttachIDChild(AChild, AParent: TORTreeNode);
348 function UserIsSigner(NoteIEN: integer): boolean;
349 public
350 function ActiveEditOf(AnIEN: Int64): Boolean;
351 function AllowContextChange(var WhyNot: string): Boolean; override;
352 procedure ClearPtData; override;
353 procedure DisplayPage; override;
354 procedure SetFontSize(NewFontSize: Integer); override;
355 procedure SaveSignItem(const ItemID, ESCode: string);
356 procedure RequestPrint; override;
357 procedure RequestMultiplePrint(AForm: TfrmPrintList);
358 procedure NotifyOrder(OrderAction: Integer; AnOrder: TOrder); override;
359 function AuthorizedUser: Boolean;
360 procedure AssignRemForm;
361 property OrderID: string read FOrderID;
362 procedure LstConsultsToPrint;
363 published
364 property Drawers: TFrmDrawers read GetDrawers; // Keep Drawers published
365 end;
366
367var
368 frmConsults: TfrmConsults;
369
370const
371 CN_ACT_RECEIVE = 1 ;
372 CN_ACT_DENY = 2 ;
373 CN_ACT_DISCONTINUE = 3 ;
374 CN_ACT_FORWARD = 4 ;
375 CN_ACT_ADD_CMT = 5 ;
376 CN_ACT_COMPLETE = 6 ;
377 CN_ACT_ADDENDUM = 7 ;
378 CN_ACT_SIGFIND = 8 ;
379 CN_ACT_ADMIN_COMPLETE = 9 ;
380 CN_ACT_SCHEDULE = 10;
381 CN_ACT_CP_COMPLETE = 11;
382
383 ActionType: array[1..11] of string = ('Receive Consult','Cancel (Deny) Consult',
384 'Discontinue Consult','Forward Consult','Add Comment to Consult',
385 'Complete Consult', 'Make Addendum to Consult', 'Update Significant Findings',
386 'Administratively Complete', 'Schedule Consult', 'Complete Clinical Procedure') ;
387
388implementation
389
390{$R *.DFM}
391
392uses fVisit, rCore, uCore, rConsults, fConsultBS, fConsultBD, fSignItem,
393 fConsultBSt, fConsultsView, fConsultAct, fEncnt, rPCE, fEncounterFrame,
394 Clipbrd, rReports, fRptBox, fConsult513Prt, fODConsult, fODProc, fCsltNote, fAddlSigners,
395 fOrders, rVitals, fFrame, fNoteDR, fEditProc, fEditConsult, uOrders, rODBase, uSpell, {*KCM*}
396 fTemplateEditor, fNotePrt, fNotes, fNoteProps, fNotesBP, fReminderTree,
397 fReminderDialog, uReminders, fConsMedRslt, fTemplateFieldEditor,
398 dShared, rTemplates, fIconLegend, fNoteIDParents, fNoteCPFields,
[829]399 uTemplates, fTemplateDialog, DateUtils, uVA508CPRSCompatibility, VA508AccessibilityRouter;
[456]400
401const
402 CT_ORDERS = 4; // ID for orders tab used by frmFrame
403 EF_VISIT_TYPE = 10;
404 EF_VITALS = 200;
405 EF_DIAGNOSES = 20;
406 EF_PROCEDURES = 30;
407 EF_ORDERS = 100;
408
409 CA_CREATE = 0; // create new consult result
410 CA_SHOW = 1; // show current note
411 CA_SAVECREATE = 2; // save current then create
412 CA_EDIT = 3; // save current note, then edit an existing note
413 CA_SAVEEDIT = 4;
414
415 CN_NEW_RESULT = -30; // Holder IEN for a new Consult Result
416 CN_ADDENDUM = -40; // Holder IEN for a new addendum
417
418 NT_ACT_NEW_NOTE = 2;
419 NT_ACT_ADDENDUM = 3;
420 NT_ACT_EDIT_NOTE = 4;
421 NT_ACT_ID_ENTRY = 5;
422
423 ST_DISCONTINUED = 1 ;
424 ST_COMPLETE = 2 ;
425 ST_HOLD = 3 ;
426 ST_FLAGGED = 4 ;
427 ST_PENDING = 5 ;
428 ST_ACTIVE = 6 ;
429 ST_EXPIRED = 7 ;
430 ST_SCHEDULED = 8 ;
431 ST_PARTIAL_RESULTS = 9 ;
432 ST_DELAYED = 10 ;
433 ST_UNRELEASED = 11 ;
434 ST_CHANGED = 12 ;
435 ST_CANCELLED = 13 ;
436 ST_LAPSED = 14 ;
437 ST_RENEWED = 15 ;
438 ST_NO_STATUS = 99 ;
439
440 TYP_PROGRESS_NOTE = 3;
441 TYP_ADDENDUM = 81;
442 TX_PROV_LOC = 'A provider and location must be selected before entering orders.';
443 TC_PROV_LOC = 'Incomplete Information';
444
445 TX_NEED_VISIT = 'A visit is required before creating a new consult result.';
446 TX_NO_VISIT = 'Insufficient Visit Information';
447 TX_BOILERPLT = 'You have modified the text of this note. Changing the title will' +
448 ' discard the note text.' + CRLF + 'Do you wish to continue?';
449 TX_NEWTITLE = 'Change Consult Title';
450 TX_REQD_CONSULT = 'The following information is required to save a Consult Result - ' + CRLF;
451 TX_REQD_ADDM = 'The following information is required to save an addendum - ' + CRLF;
452 TX_REQ2 = CRLF + CRLF +
453 'It is recommended that these fields be entered before continuing' + CRLF +
454 'to prevent losing the note should the application time out.';
455 TX_CREATE_ERR = 'Error Creating Note';
456 TX_UPDATE_ERR = 'Error Updating Note';
457 TX_NO_CONSULT = 'No note is currently being edited';
458 TX_SAVE_CONSULT = 'Save Note';
459 TX_ADDEND_NO = 'Cannot make an addendum to a note that is being edited';
460 TX_DEL_OK = CRLF + CRLF + 'Delete this note?';
461 TX_DEL_ERR = 'Unable to Delete note';
462 TX_SIGN = 'Sign Note';
463 TX_COSIGN = 'Cosign Note';
464 TX_REQD_COSIG = CRLF + 'Expected Cosigner';
465 TX_REQ_COSIGNER = 'A cosigner must be identified.';
466 TX_SIGN_ERR = 'Unable to Sign Note';
467 TX_INVALID_CONSULT_CAP = 'Invalid consult record' ;
468 TX_INVALID_CONSULT_TEXT = 'Unable to retrieve the information for this consult.' ;
469 TX_SCREQD = 'This progress note title requires the service connected questions to be '+
470 'answered. The Encounter form will now be opened. Please answer all '+
471 'service connected questions.';
472 TX_SCREQD_T = 'Response required for SC questions.';
473 TX_NOPRT_NEW = 'This consult may not be printed until the current note is saved';
474 TX_NOPRT_NEW_CAP = 'Save Consult Result';
475 TX_NOCONSULT = 'No consult is currently selected.';
476 TX_NOCSLT_CAP = 'No Consult Selected';
477 TX_NONOTE = 'No note is currently selected.';
478 TX_NONOTE_CAP = 'No Note Selected';
479 TX_NO_ORDER = 'Ordering has been disabled.';
480 TX_NO_ORDER_CAP = 'Unable to place order';
481 TX_PROV_KEY = 'The provider selected for this encounter must' + CRLF +
482 'hold the PROVIDER key to enter orders.';
483 TC_PROV_KEY = 'PROVIDER Key Required';
484 TX_NOKEY = 'You do not have the keys required to take this action.';
485 TC_NOKEY = 'Insufficient Authority';
486 TX_BADKEYS = 'You have mutually exclusive order entry keys (ORES, ORELSE, or OREMAS).' +
487 CRLF + 'This must be resolved before you can enter orders.';
488 TC_BADKEYS = 'Multiple Keys';
489 TX_NO_FUTURE_DT = 'A Reference Date/Time in the future is not allowed.';
490 TX_ORDER_LOCKED = 'This record is locked by an action underway on the Notes tab';
491 TC_ORDER_LOCKED = 'Unable to access record';
492 TC_NO_RESUBMIT = 'Unable to resubmit';
493 TX_NO_ORD_CHG = 'The note is still associated with the previously selected request.' + CRLF +
494 'Finish the pending action, then try again.';
495 TC_NO_ORD_CHG = 'Locked Consult Request';
496 TX_NEW_SAVE1 = 'You are currently editing:' + CRLF + CRLF;
497 TX_NEW_SAVE2 = CRLF + CRLF + 'Do you wish to save this note and begin a new one?';
498 TX_NEW_SAVE3 = CRLF + CRLF + 'Do you wish to save this note and begin a new addendum?';
499 TX_NEW_SAVE4 = CRLF + CRLF + 'Do you wish to save this note and edit the one selected?';
500 TX_NEW_SAVE5 = CRLF + CRLF + 'Do you wish to save this note and begin a new Interdisciplinary entry?';
501 TC_NEW_SAVE2 = 'Create New Note';
502 TC_NEW_SAVE3 = 'Create New Addendum';
503 TC_NEW_SAVE4 = 'Edit Different Note';
504 TC_NEW_SAVE5 = 'Create New Interdisciplinary Entry';
505 TX_EMPTY_NOTE = CRLF + CRLF + 'This note contains no text and will not be saved.' + CRLF +
506 'Do you wish to delete this note?';
507 TC_EMPTY_NOTE = 'Empty Note';
508 TX_EMPTY_NOTE1 = 'This note contains no text and can not be signed.';
509 TC_NO_LOCK = 'Unable to Lock Note';
510 TX_ABSAVE = 'It appears the session terminated abnormally when this' + CRLF +
511 'note was last edited. Some text may not have been saved.' + CRLF + CRLF +
512 'Do you wish to continue and sign the note?';
513 TC_ABSAVE = 'Possible Missing Text';
514 TX_NO_BOIL = 'There is no boilerplate text associated with this title.';
515 TC_NO_BOIL = 'Load Boilerplate Text';
516 TX_BLR_CLEAR = 'Do you want to clear the previously loaded boilerplate text?';
517 TC_BLR_CLEAR = 'Clear Previous Boilerplate Text';
518 TX_CP_NO_RESULTS = 'This Clinical Procedure cannot be completed yet.' + CRLF +
519 'No results are available for interpretation.';
520 TC_CP_NO_RESULTS = 'No Results Available';
521 TX_CLIN_PROC = 'A procedure summary code and valid date/time for the procedure must be entered.';
522 TX_NO_AUTHOR = 'An author must be entered for the note.';
523 TC_CLIN_PROC = 'Missing Information for Clinical Procedures Document';
524 TX_DETACH_CNF = 'Confirm Detachment';
525 TX_DETACH_FAILURE = 'Detach failed';
526
527 DLG_CONSULT = 'C';
528 DLG_PROC = 'P';
529 TX_RETRACT_CAP = 'Retraction Notice';
530 TX_RETRACT = 'This document will now be RETRACTED. As Such, it has been removed' +CRLF +
531 ' from public view, and from typical Releases of Information,' +CRLF +
532 ' but will remain indefinitely discoverable to HIMS.' +CRLF +CRLF;
533 TX_AUTH_SIGNED = 'Author has not signed, are you SURE you want to sign.' +CRLF;
534
535var
536 ViewContext, CurrNotifIEN: integer ;
537 SvcCtxt: TServiceContext;
538 StsCtxt: TStatusContext ;
539 DateRange: TConsultDateRange;
540 uSelectContext: TSelectContext ;
541 uPCEShow, uPCEEdit: TPCEData;
542 frmDrawers: TfrmDrawers;
543 MenuAccessRec: TMenuAccessRec;
544 MedResult: TMedResultRec;
545 uChanging: Boolean;
546 uIDNotesActive: boolean;
547
548{ TPage common methods --------------------------------------------------------------------- }
549
550function TfrmConsults.AllowContextChange(var WhyNot: string): Boolean;
551begin
552 dlgFindText.CloseDialog;
553 Result := inherited AllowContextChange(WhyNot); // sets result = true
554 if Assigned(frmTemplateDialog) then
555 if Screen.ActiveForm = frmTemplateDialog then
556 //if (fsModal in frmTemplateDialog.FormState) then
557 case BOOLCHAR[frmFrame.CCOWContextChanging] of
558 '1': begin
559 WhyNot := 'A template in progress will be aborted. ';
560 Result := False;
561 end;
562 '0': begin
563 if WhyNot = 'COMMIT' then
564 begin
565 FSilent := True;
566 frmTemplateDialog.Silent := True;
567 frmTemplateDialog.ModalResult := mrCancel;
568 end;
569 end;
570 end;
571 if EditingIndex <> -1 then
572 case BOOLCHAR[frmFrame.CCOWContextChanging] of
573 '1': begin
574 if memResults.GetTextLen > 0 then
575 WhyNot := WhyNot + 'A note in progress will be saved as unsigned. '
576 else
577 WhyNot := WhyNot + 'An empty note in progress will be deleted. ';
578 Result := False;
579 end;
580 '0': begin
581 if WhyNot = 'COMMIT' then FSilent := True;
582 SaveCurrentNote(Result);
583 end;
584 end;
585 if Assigned(frmEncounterFrame) then
586 if Screen.ActiveForm = frmEncounterFrame then
587 //if (fsModal in frmEncounterFrame.FormState) then
588 case BOOLCHAR[frmFrame.CCOWContextChanging] of
589 '1': begin
590 WhyNot := WhyNot + 'Encounter information being edited will not be saved';
591 Result := False;
592 end;
593 '0': begin
594 if WhyNot = 'COMMIT' then
595 begin
596 FSilent := True;
597 frmEncounterFrame.Abort := False;
598 frmEncounterFrame.Cancel := True;
599 end;
600 end;
601 end;
602end;
603
604procedure TfrmConsults.ClearPtData;
605{ clear all controls that contain patient specific information }
606begin
607 inherited ClearPtData;
608 ClearEditControls;
609 lstConsults.Clear;
610 memConsult.Clear;
611 memResults.Clear;
612 uChanging := True;
613 tvCsltNotes.Items.BeginUpdate;
614 KillDocTreeObjects(tvCsltNotes);
615 tvCsltNotes.Items.Clear;
616 tvCsltNotes.Items.EndUpdate;
617 tvConsults.Items.BeginUpdate;
618 tvConsults.Items.Clear;
619 tvConsults.Items.EndUpdate;
620 uChanging := False;
621 lstNotes.Clear ;
622 memPCEShow.Clear;
623 uPCEShow.Clear;
624 frmDrawers.ResetTemplates;
625 FOrderID := '';
626end;
627
628procedure TfrmConsults.SetViewContext(AContext: TSelectContext);
629var
630 Saved: boolean;
631begin
632 if EditingIndex <> -1 then
633 begin
634 SaveCurrentNote(Saved);
635 if not Saved then Exit;
636 end;
637 FCurrentContext := AContext;
638 CurrNotifIEN := 0;
639 EditingIndex := -1;
640 tvConsults.Enabled := True;
641 lstConsults.Enabled := True ;
642 lstNotes.Enabled := True ;
643 pnlRead.BringToFront ;
644 memConsult.TabStop := True;
645 with uSelectContext do
646 begin
647 BeginDate := FCurrentContext.BeginDate;
648 EndDate := FCurrentContext.EndDate;
649 Status := FCurrentContext.Status;
650 Service := FCurrentContext.Service;
651 Ascending := FCurrentContext.Ascending;
652 GroupBy := FCurrentContext.GroupBy;
653 Changed := True;
654 mnuViewClick(Self);
655 end;
656end;
657
658procedure TfrmConsults.DisplayPage;
659{ causes page to be visible and conditionally executes initialization code }
660begin
661 inherited DisplayPage;
662 frmFrame.ShowHideChartTabMenus(mnuViewChart);
663 frmFrame.mnuFilePrint.Tag := CT_CONSULTS;
664 frmFrame.mnuFilePrint.Enabled := True;
665 frmFrame.mnuFilePrintSetup.Enabled := True;
666 frmFrame.mnuFilePrintSelectedItems.Enabled := True;
667 FNotifPending := False;
668 if InitPage then
669 begin
670 FDefaultContext := GetCurrentContext;
671 FCurrentContext := FDefaultContext;
672 popNoteMemoSpell.Visible := SpellCheckAvailable;
673 popNoteMemoGrammar.Visible := popNoteMemoSpell.Visible;
674 Z11.Visible := popNoteMemoSpell.Visible;
675 timAutoSave.Interval := User.AutoSave * 1000; // convert seconds to milliseconds
676 SetEqualTabStops(memResults);
677 end;
678 cmdEditResubmit.Visible := False;
679 EnableDisableIDNotes;
680 EnableDisableOrdering;
681 if InitPage then SendMessage(memConsult.Handle, EM_SETMARGINS, EC_LEFTMARGIN, 4);
682 if InitPatient and not (CallingContext = CC_NOTIFICATION) then
683 begin
684 SetViewContext(FDefaultContext);
685 end;
686 case CallingContext of
687 CC_INIT_PATIENT: if not InitPatient then
688 begin
689 SetViewContext(FDefaultContext);
690 end;
691 CC_NOTIFICATION: ProcessNotifications;
692 end;
693 //with tvConsults do if Selected <> nil then tvConsultsChange(Self, Selected);
694end;
695
696procedure TfrmConsults.SetFontSize(NewFontSize: Integer);
697{ adjusts the font size of any controls that don't have ParentFont = True }
698begin
699 inherited SetFontSize(NewFontSize);
700 memConsult.Font.Size := NewFontSize;
701 memResults.Font.Size := NewFontSize;
702 lblTitle.Font.Size := NewFontSize;
703 frmDrawers.Font.Size := NewFontSize;
704 SetEqualTabStops(memResults);
705 // adjust heights of pnlAction, pnlFields, and memPCEShow
706end;
707
708procedure TfrmConsults.mnuChartTabClick(Sender: TObject);
709{ reroute to Chart Tab menu of the parent form: frmFrame }
710begin
711 inherited;
712 frmFrame.mnuChartTabClick(Sender);
713end;
714
715{ General procedures ----------------------------------------------------------------------- }
716
717procedure TfrmConsults.ClearEditControls;
718begin
719 // clear FEditNote (should FEditNote be an object with a clear method?)
720 with FEditNote do
721 begin
722 DocType := 0;
723 Title := 0;
724 TitleName := '';
725 DateTime := 0;
726 Author := 0;
727 AuthorName := '';
728 Cosigner := 0;
729 CosignerName := '';
730 Subject := '';
731 Location := 0;
732 LocationName := '';
733 //Consult := 0;
734 PkgRef := '';
735 PkgIEN := 0;
736 PkgPtr := '';
737 NeedCPT := False;
738 Addend := 0;
739 Lines := nil;
740 end;
741 // clear the editing controls (also clear the new labels?)
742 txtSubject.Text := '';
743 memResults.Clear;
744 timAutoSave.Enabled := False;
745 // clear the PCE object for editing
746 uPCEEdit.Clear;
747 // set the tracking variables to initial state
748 EditingIndex := -1;
749 frmConsults.ActiveControl := nil;
750 ShowPCEControls(FALSE);
751 FChanged := False;
752end;
753
754procedure TfrmConsults.CompleteConsult(IsIDChild: boolean; AnIDParent: integer; UseClinProcTitles: boolean);
755{ creates the editing context for a new progress note & inserts stub into top of view list }
756const
757 USE_CURRENT_VISITSTR = -2;
758var
759 EnableAutosave, HaveRequired: Boolean;
760 CreatedNote: TCreatedDoc;
761 TmpBoilerPlate: TStringList;
762 x, WhyNot: string;
763 tmpNode: TTreeNode;
764 AClassName: string;
765 DocInfo: string;
766begin
767 EnableAutosave := FALSE;
768 TmpBoilerPlate := nil;
769 try
770 ClearEditControls;
771 tvConsults.Enabled := False;
772 lstConsults.Enabled := False ;
773 FillChar(FEditNote, SizeOf(FEditNote), 0); //v15.7
774 with FEditNote do
775 begin
776 if UseClinProcTitles then
777 begin
778 DocType := IdentifyClinProcClass;
779 Title := DfltClinProcTitle;
780 TitleName := DfltClinProcTitleName;
781 AClassName := DCL_CLINPROC;
782 end
783 else
784 begin
785 DocType := TYP_PROGRESS_NOTE;
786 Title := DfltConsultTitle;
787 TitleName := DfltConsultTitleName;
788 AClassName := DCL_CONSULTS
789 end;
790 if IsIDChild and (not CanTitleBeIDChild(Title, WhyNot)) then
791 begin
792 Title := 0;
793 TitleName := '';
794 end;
795 DateTime := FMNow;
796 Author := User.DUZ;
797 AuthorName := User.Name;
798 Location := Encounter.Location;
799 LocationName := Encounter.LocationName;
800 VisitDate := Encounter.DateTime;
801 if IsIDChild then
802 IDParent := AnIDParent
803 else
804 IDParent := 0;
805 PkgRef := lstConsults.ItemID + ';' + PKG_CONSULTS;
806 PkgIEN := lstConsults.ItemIEN;
807 PkgPtr := PKG_CONSULTS;
808 // Cosigner, if needed, will be set by fNoteProps
809 end;
810 // check to see if interaction necessary to get required fields
811 if LacksRequiredForCreate or VerifyNoteTitle
812 then HaveRequired := ExecuteNoteProperties(FEditNote, CT_CONSULTS, IsIDChild, False, AClassName,
813 MenuAccessRec.ClinProcFlag)
814 else HaveRequired := True;
815 // lock the consult request if there is a consult
816 if FEditNote.PkgIEN > 0 then HaveRequired := HaveRequired and LockConsultRequest(FEditNote.PkgIEN);
817 if HaveRequired then
818 begin
819 // set up uPCEEdit for entry of new note
820 uPCEEdit.UseEncounter := True;
821 uPCEEdit.NoteDateTime := FEditNote.DateTime;
822 uPCEEdit.PCEForNote(USE_CURRENT_VISITSTR, uPCEShow);
823 FEditNote.NeedCPT := uPCEEdit.CPTRequired;
824 // create the note
825 PutNewNote(CreatedNote, FEditNote);
826 uPCEEdit.NoteIEN := CreatedNote.IEN;
827 if CreatedNote.IEN > 0 then LockDocument(CreatedNote.IEN, CreatedNote.ErrorText);
828 if CreatedNote.ErrorText = '' then
829 begin
830 if lstNotes.DisplayText[0] = 'None' then
831 begin
832 uChanging := True;
833 tvCsltNotes.Items.BeginUpdate;
834 lstNotes.Items.Clear;
835 KillDocTreeObjects(tvCsltNotes);
836 tvCsltNotes.Items.Clear;
837 tvCsltNotes.Items.EndUpdate;
838 uChanging := False;
839 end;
840 with FEditNote do
841 begin
842 x := IntToStr(CreatedNote.IEN) + U + TitleName + U + FloatToStr(DateTime) + U +
843 Patient.Name + U + IntToStr(Author) + ';' + AuthorName + U + LocationName + U + 'new' + U +
844 'Adm: ' + FormatFMDateTime('mmm dd,yyyy', VisitDate) + ';' + FloatToStr(VisitDate) + U + U +
845 U + U + U + U + U + U;
846 end;
847 lstNotes.Items.Insert(0, x);
848 uChanging := True;
849 tvCsltNotes.Items.BeginUpdate;
850 if IsIDChild then
851 begin
852 tmpNode := tvCsltNotes.FindPieceNode(IntToStr(AnIDParent), 1, U, tvCsltNotes.Items.GetFirstNode);
853 tmpNode.ImageIndex := IMG_IDNOTE_OPEN;
854 tmpNode.SelectedIndex := IMG_IDNOTE_OPEN;
855 tmpNode := tvCsltNotes.Items.AddChildObjectFirst(tmpNode, MakeConsultNoteDisplayText(x), MakeNoteTreeObject(x));
856 tmpNode.ImageIndex := IMG_ID_CHILD;
857 tmpNode.SelectedIndex := IMG_ID_CHILD;
858 end
859 else
860 begin
861 tmpNode := tvCsltNotes.Items.AddObjectFirst(tvCsltNotes.Items.GetFirstNode, 'New Note in Progress',
862 MakeNoteTreeObject('NEW^New Note in Progress^^^^^^^^^^^%^0'));
863 TORTreeNode(tmpNode).StringData := 'NEW^New Note in Progress^^^^^^^^^^^%^0';
864 tmpNode.ImageIndex := IMG_TOP_LEVEL;
865 tmpNode := tvCsltNotes.Items.AddChildObjectFirst(tmpNode, MakeConsultNoteDisplayText(x), MakeNoteTreeObject(x));
866 tmpNode.ImageIndex := IMG_SINGLE;
867 tmpNode.SelectedIndex := IMG_SINGLE;
868 end;
869 tmpNode.StateIndex := IMG_NO_IMAGES;
870 TORTreeNode(tmpNode).StringData := x;
871 tvCsltNotes.Selected := tmpNode;
872 tvCsltNotes.Items.EndUpdate;
873 uChanging := False;
874
875 Changes.Add(CH_CON, IntToStr(CreatedNote.IEN), GetTitleText(0), '', CH_SIGN_YES);
876 lstNotes.ItemIndex := 0;
877 EditingIndex := 0;
878 SetSubjectVisible(AskSubjectForNotes);
879 if not assigned(TmpBoilerPlate) then
880 TmpBoilerPlate := TStringList.Create;
881 LoadBoilerPlate(TmpBoilerPlate, FEditNote.Title);
882 FChanged := False;
883 cmdChangeClick(Self); // will set captions, sign state for Changes
884 lstNotesClick(Self); // will make pnlWrite visible
885 if timAutoSave.Interval <> 0 then EnableAutosave := TRUE;
886 if txtSubject.Visible then txtSubject.SetFocus else memResults.SetFocus;
887 end
888 else // CreatedNote.ErrorText <> ''
889 begin
890 // if note creation failed or failed to get note lock (both unlikely), unlock consult
891 if FEditNote.PkgIEN > 0 then UnlockConsultRequest(0, FEditNote.PkgIEN);
892 //if FEditNote.Consult > 0 then UnlockConsultRequest(0, FEditNote.Consult);
893 if CreatedNote.ErrorText <> '' then
894 InfoBox(CreatedNote.ErrorText, TX_CREATE_ERR, MB_OK);
895 HaveRequired := False;
896 end; {if CreatedNote.IEN}
897 end; {if HaveRequired}
898 if not HaveRequired then
899 begin
900 ClearEditControls;
901 lstConsults.Enabled := True;
902 tvConsults.Enabled := True;
903 end;
904 SetResultMenus ;
905 finally
906 if assigned(TmpBoilerPlate) then
907 begin
908 DocInfo := MakeXMLParamTIU(IntToStr(CreatedNote.IEN), FEditNote);
909 ExecuteTemplateOrBoilerPlate(TmpBoilerPlate, FEditNote.Title, ltTitle, Self, 'Title: ' + FEditNote.TitleName, DocInfo);
[829]910 QuickCopyWith508Msg(TmpBoilerPlate, memResults);
[456]911 TmpBoilerPlate.Free;
912 end;
913 if EnableAutosave then // Don't enable autosave until after dialog fields have been resolved
914 timAutoSave.Enabled := True;
915 end;
916end;
917
918procedure TfrmConsults.InsertAddendum;
919{ sets up fields of pnlWrite to write an addendum for the selected note }
920const
921 AS_ADDENDUM = True;
922 IS_ID_CHILD = False;
923var
924 HaveRequired: Boolean;
925 CreatedNote: TCreatedDoc;
926 x: string;
927 tmpNode: TTreeNode;
928 AClassName: string;
929begin
930 AClassName := DCL_CONSULTS;
931 ClearEditControls;
932 lstConsults.Enabled := False ;
933 tvConsults.Enabled := False;
934 with FEditNote do
935 begin
936 DocType := TYP_ADDENDUM;
937 Title := TitleForNote(lstNotes.ItemIEN);
938 TitleName := Piece(lstNotes.Items[lstNotes.ItemIndex], U, 2);
939 DateTime := FMNow;
940 Author := User.DUZ;
941 AuthorName := User.Name;
942 x := GetPackageRefForNote(lstNotes.ItemIEN);
943 if Piece(x, U, 1) <> '-1' then
944 begin
945 PkgRef := GetPackageRefForNote(lstNotes.ItemIEN);
946 PkgIEN := StrToIntDef(Piece(PkgRef, ';', 1), 0);
947 PkgPtr := Piece(PkgRef, ';', 2);
948 end;
949 Addend := lstNotes.ItemIEN;
950 // Cosigner, if needed, will be set by fNoteProps
951 // Location info will be set after the encounter is loaded
952 end;
953 // check to see if interaction necessary to get required fields
954 if LacksRequiredForCreate
955 then HaveRequired := ExecuteNoteProperties(FEditNote, CT_CONSULTS, IS_ID_CHILD,
956 False, AClassName, MenuAccessRec.ClinProcFlag)
957 else HaveRequired := True;
958 // lock the consult request if there is a consult
959 if HaveRequired and (FEditNote.PkgIEN > 0) then
960 HaveRequired := LockConsultRequest(FEditNote.PkgIEN);
961 if HaveRequired then
962 begin
963 uPCEEdit.NoteDateTime := FEditNote.DateTime;
964 uPCEEdit.PCEForNote(FEditNote.Addend, uPCEShow);
965 FEditNote.Location := uPCEEdit.Location;
966 FEditNote.LocationName := ExternalName(uPCEEdit.Location, 44);
967 FEditNote.VisitDate := uPCEEdit.DateTime;
968 PutAddendum(CreatedNote, FEditNote, FEditNote.Addend);
969 uPCEEdit.NoteIEN := CreatedNote.IEN;
970 if CreatedNote.IEN > 0 then LockDocument(CreatedNote.IEN, CreatedNote.ErrorText);
971 if CreatedNote.ErrorText = '' then
972 begin
973 with FEditNote do
974 begin
975 x := IntToStr(CreatedNote.IEN) + U + 'Addendum to ' + TitleName + U + FloatToStr(DateTime) + U +
976 Patient.Name + U + IntToStr(Author) + ';' + AuthorName + U + LocationName + U + 'new' + U +
977 U + U + U + U + U + U + U + U;
978 end;
979 lstNotes.Items.Insert(0, x);
980
981 uChanging := True;
982 tvCsltNotes.Items.BeginUpdate;
983 tmpNode := tvCsltNotes.Items.AddObjectFirst(tvCsltNotes.Items.GetFirstNode, 'New Addendum in Progress',
984 MakeConsultsNoteTreeObject('ADDENDUM^New Addendum in Progress^^^^^^^^^^^%^0'));
985 TORTreeNode(tmpNode).StringData := 'ADDENDUM^New Addendum in Progress^^^^^^^^^^^%^0';
986 tmpNode.ImageIndex := IMG_TOP_LEVEL;
987 tmpNode := tvCsltNotes.Items.AddChildObjectFirst(tmpNode, MakeConsultNoteDisplayText(x), MakeConsultsNoteTreeObject(x));
988 TORTreeNode(tmpNode).StringData := x;
989 tmpNode.ImageIndex := IMG_ADDENDUM;
990 tmpNode.SelectedIndex := IMG_ADDENDUM;
991 tvCsltNotes.Selected := tmpNode;
992 tvCsltNotes.Items.EndUpdate;
993 uChanging := False;
994
995 Changes.Add(CH_CON, IntToStr(CreatedNote.IEN), GetTitleText(0), '', CH_SIGN_YES);
996 lstNotes.ItemIndex := 0;
997 EditingIndex := 0;
998 SetSubjectVisible(AskSubjectForNotes);
999 cmdChangeClick(Self); // will set captions, sign state for Changes
1000 lstNotesClick(Self); // will make pnlWrite visible
1001 if timAutoSave.Interval <> 0 then timAutoSave.Enabled := True;
1002 memResults.SetFocus;
1003 end else
1004 begin
1005 // if note creation failed or failed to get note lock (both unlikely), unlock consult
1006 if FEditNote.PkgIEN > 0 then UnlockConsultRequest(0, FEditNote.PkgIEN);
1007 //if FEditNote.Consult > 0 then UnlockConsultRequest(0, FEditNote.Consult);
1008 InfoBox(CreatedNote.ErrorText, TX_CREATE_ERR, MB_OK);
1009 HaveRequired := False;
1010 lstConsults.Enabled := True;
1011 tvConsults.Enabled := True;
1012 end; {if CreatedNote.IEN}
1013 end; {if HaveRequired}
1014 if not HaveRequired then ClearEditControls;
1015 SetResultMenus ;
1016end;
1017
1018procedure TfrmConsults.LoadForEdit;
1019{ retrieves an existing note and places the data in the fields of pnlWrite }
1020var
1021 tmpNode: TTreeNode;
1022 x: string;
1023 ErrMsg: string;
1024 AnAuthor: int64;
1025 AProcSummCode: integer;
1026 AProcDate: TFMDateTime;
1027 tmpBoilerplate: TStringList;
1028 EnableAutoSave: boolean;
1029 DocInfo: string;
1030begin
1031 ClearEditControls;
1032 if not LockConsultRequestAndNote(lstNotes.ItemIEN) then Exit;
1033 EnableAutosave := FALSE;
1034 tmpBoilerplate := nil;
1035 try
1036 EditingIndex := lstNotes.ItemIndex;
1037 Changes.Add(CH_CON, lstNotes.ItemID, GetTitleText(EditingIndex), '', CH_SIGN_YES);
1038 GetNoteForEdit(FEditNote, lstNotes.ItemIEN);
1039 memResults.Lines.Assign(FEditNote.Lines);
1040 FChanged := False;
1041 if FEditNote.Title = TYP_ADDENDUM then
1042 begin
1043 FEditNote.DocType := TYP_ADDENDUM;
1044 FEditNote.TitleName := Piece(lstNotes.Items[lstNotes.ItemIndex], U, 2);
1045 if Copy(FEditNote.TitleName,1,1) = '+' then FEditNote.TitleName := Copy(FEditNote.TitleName, 3, 199);
1046 if CompareText(Copy(FEditNote.TitleName, 1, 8), 'Addendum') <> 0
1047 then FEditNote.TitleName := FEditNote.TitleName + 'Addendum to ';
1048 end;
1049 uChanging := True;
1050 tvCsltNotes.Items.BeginUpdate;
1051 tmpNode := tvCsltNotes.FindPieceNode('EDIT', 1, U, nil);
1052 if tmpNode = nil then
1053 begin
1054 tmpNode := tvCsltNotes.Items.AddObjectFirst(tvCsltNotes.Items.GetFirstNode, 'Note being edited',
1055 MakeConsultsNoteTreeObject('EDIT^Note being edited^^^^^^^^^^^%^0'));
1056 TORTreeNode(tmpNode).StringData := 'EDIT^Note being edited^^^^^^^^^^^%^0';
1057 end
1058 else
1059 tmpNode.DeleteChildren;
1060 x := lstNotes.Items[lstNotes.ItemIndex];
1061 tmpNode.ImageIndex := IMG_TOP_LEVEL;
1062 tmpNode := tvCsltNotes.Items.AddChildObjectFirst(tmpNode, MakeConsultNoteDisplayText(x), MakeConsultsNoteTreeObject(x));
1063 TORTreeNode(tmpNode).StringData := x;
1064 if CompareText(Copy(FEditNote.TitleName, 1, 8), 'Addendum') <> 0 then
1065 tmpNode.ImageIndex := IMG_SINGLE
1066 else
1067 tmpNode.ImageIndex := IMG_ADDENDUM;
1068 tmpNode.SelectedIndex := tmpNode.ImageIndex;
1069 tvCsltNotes.Selected := tmpNode;
1070 tvCsltNotes.Items.EndUpdate;
1071 uChanging := False;
1072
1073 uPCEEdit.NoteDateTime := MakeFMDateTime(Piece(lstNotes.Items[lstNotes.ItemIndex], U, 3));
1074 uPCEEdit.PCEForNote(lstNotes.ItemIEN, uPCEShow);
1075 FEditNote.NeedCPT := uPCEEdit.CPTRequired;
1076 txtSubject.Text := FEditNote.Subject;
1077 SetSubjectVisible(AskSubjectForNotes);
1078 if MenuAccessRec.IsClinicalProcedure and LacksClinProcFields(FEditNote, MenuAccessRec, ErrMsg) then
1079 begin
1080 // **** Collect Author, ClinProcSummCode, and ClinProcDate ****
1081 AnAuthor := FEditNote.Author;
1082 AProcSummCode := FEditNote.ClinProcSummCode;
1083 AProcDate := FEditNote.ClinProcDateTime;
1084 EnterClinProcFields(MenuAccessRec.ClinProcFlag, ErrMsg, AProcSummCode, AProcDate, AnAuthor);
1085 // **** set values into FEditNote ****
1086 FEditNote.Author := AnAuthor;
1087 FEditNote.ClinProcSummCode := AProcSummCode;
1088 FEditNote.ClinProcDateTime := AProcDate;
1089 end;
1090 (* if LacksClinProcFields(ErrMsg) then
1091 begin
1092 // **** Collect Author, Cosigner (if required), ClinProcSummCode, and ClinProcDate ****
1093 EnterClinProcFields(MenuAccessRec.ClinProcFlag, ErrMsg, FEditNote);
1094 end;*)
1095 if MenuAccessRec.IsClinicalProcedure and (memResults.Lines.Text = '') then
1096 begin
1097 if not assigned(TmpBoilerPlate) then
1098 TmpBoilerPlate := TStringList.Create;
1099 LoadBoilerPlate(TmpBoilerPlate, FEditNote.Title);
1100 end;
1101 if frmFrame.Closing then exit;
1102 cmdChangeClick(Self); // will set captions, sign state for Changes
1103 lstNotesClick(Self); // will make pnlWrite visible
1104 if timAutoSave.Interval <> 0 then EnableAutosave := TRUE;
1105 memResults.SetFocus;
1106 finally
1107 if assigned(TmpBoilerPlate) then
1108 begin
1109 DocInfo := MakeXMLParamTIU(IntToStr(lstNotes.ItemIEN), FEditNote);
1110 ExecuteTemplateOrBoilerPlate(TmpBoilerPlate, FEditNote.Title, ltTitle, Self, 'Title: ' + FEditNote.TitleName, DocInfo);
[829]1111 QuickCopyWith508Msg(TmpBoilerPlate, memResults);
[456]1112 TmpBoilerPlate.Free;
1113 end;
1114 if EnableAutosave then // Don't enable autosave until after dialog fields have been resolved
1115 timAutoSave.Enabled := True;
1116 end;
1117end;
1118
1119procedure TfrmConsults.SaveEditedConsult(var Saved: Boolean);
1120{ validates fields and sends the updated consult result to the server }
1121var
1122 UpdatedNote: TCreatedDoc;
1123 x, ErrMsg: string;
1124 ContinueSave: boolean;
1125
1126 // this block executes for Clinical Procedures documents ONLY!!
1127 procedure SaveOrAbort(var AllowSave: boolean);
1128 begin
1129 // if no text, leave as undictated, saving nothing
1130 if (memResults.GetTextLen = 0) or (not ContainsVisibleChar(memResults.Text)) then
1131 begin
1132 if lstNotes.ItemIndex = EditingIndex then
1133 begin
1134 EditingIndex := -1;
1135 lstNotesClick(Self);
1136 end;
1137 EditingIndex := -1;
1138 Saved := True; // (yes, though not actually saving, this is correct and necessary (RV))
1139 AllowSave := False;
1140 end
1141 // if text, stuff user as author, and allow save as unsigned
1142 else
1143 begin
1144 if FEditNote.Author <= 0 then FEditNote.Author := User.DUZ;
1145 AllowSave := True;
1146 end;
1147 end;
1148
1149begin
1150 Saved := False;
1151 ContinueSave := True;
1152 if MenuAccessRec.IsClinicalProcedure and LacksClinProcFields(FEditNote, MenuAccessRec, ErrMsg) then
1153 // this block will execute for Clinical Procedures documents ONLY!!
1154 begin
1155 if not FSilent then // if not timing out, then prompt for required fields
1156 begin
1157 InfoBox(ErrMsg, TC_CLIN_PROC, MB_OK);
1158 cmdChangeClick(mnuActConsultResults);
1159 if frmFrame.TimedOut then exit;
1160 if MenuAccessRec.IsClinicalProcedure and LacksClinProcFields(FEditNote, MenuAccessRec, ErrMsg) then // if still not entered, action depends on presence of text
1161 SaveOrAbort(ContinueSave);
1162 end
1163 else SaveOrAbort(ContinueSave); // if timing out, action depends on presence of text
1164 if not ContinueSave then exit;
1165 end
1166 else if (memResults.GetTextLen = 0) or (not ContainsVisibleChar(memResults.Text)) then
1167 // this block will NOT execute for Clinical Procedures documents!!
1168 begin
1169 lstNotes.ItemIndex := EditingIndex;
1170 x := lstNotes.ItemID;
1171 uChanging := True;
1172 tvCsltNotes.Selected := tvCsltNotes.FindPieceNode(x, 1, U, tvCsltNotes.Items.GetFirstNode);
1173 uChanging := False;
1174 tvCsltNotesChange(Self, tvCsltNotes.Selected);
1175 if FSilent or
1176 ((not FSilent) and
1177 (InfoBox(GetTitleText(EditingIndex) + TX_EMPTY_NOTE, TC_EMPTY_NOTE, MB_YESNO) = IDYES))
1178 then
1179 begin
1180 FConfirmed := True;
1181 mnuActNoteDeleteClick(Self);
1182 Saved := True;
1183 FDeleted := True;
1184 end
1185 else
1186 FConfirmed := False;
1187 Exit;
1188 end;
1189 //ExpandTabsFilter(memResults.Lines, TAB_STOP_CHARS);
1190 FEditNote.Lines := memResults.Lines;
1191 FEditNote.Subject := txtSubject.Text;
1192 FEditNote.NeedCPT := uPCEEdit.CPTRequired;
1193 timAutoSave.Enabled := False;
1194 try
1195 PutEditedNote(UpdatedNote, FEditNote, lstNotes.GetIEN(EditingIndex));
1196 finally
1197 timAutoSave.Enabled := True;
1198 end;
1199 // there's no unlocking here since the note is still in Changes after a save
1200 if UpdatedNote.IEN > 0 then
1201 begin
1202 if lstNotes.ItemIndex = EditingIndex then
1203 begin
1204 EditingIndex := -1;
1205 lstNotesClick(Self);
1206 end;
1207 EditingIndex := -1;
1208 Saved := True;
1209 FChanged := False;
1210 end else
1211 begin
1212 if not FSilent then
1213 InfoBox(TX_SAVE_ERROR1 + UpdatedNote.ErrorText + TX_SAVE_ERROR2, TC_SAVE_ERROR, MB_OK or MB_ICONWARNING);
1214 end;
1215end;
1216
1217procedure TfrmConsults.SaveCurrentNote(var Saved: Boolean);
1218begin
1219 if EditingIndex < 0 then Exit;
1220 SaveEditedConsult(Saved);
1221end;
1222
1223
1224{ Form events -----------------------------------------------------------------}
1225
[829]1226procedure TfrmConsults.pnlRightExit(Sender: TObject);
1227begin
1228 inherited;
1229 if TabIsPressed then
1230 FindNextControl(tvConsults, True, True, False).SetFocus
1231 else if ShiftTabIsPressed then
1232 FindNextControl(pnlLeft, True, True, False).SetFocus;
1233end;
1234
[456]1235procedure TfrmConsults.pnlRightResize(Sender: TObject);
1236{ TRichEdit doesn't repaint appropriately unless its parent panel is refreshed }
1237begin
1238 inherited;
1239 pnlRight.Refresh;
1240 pnlAction.Invalidate;
1241 memConsult.Repaint;
1242 pnlResults.Invalidate;
1243 memResults.Repaint;
1244end;
1245
1246{ Left panel (selector) events ------------------------------------------------------------- }
1247
1248procedure TfrmConsults.lstConsultsClick(Sender: TObject);
1249{ loads the text for the selected Consult}
1250const
1251 RSLT_TIU_DOC = 1;
1252 RSLT_MED_RPT = 2;
1253var
1254 ANode: TTreeNode;
1255begin
1256 inherited;
1257 lstNotes.Items.Clear ;
1258 memConsult.Clear ;
1259 ClearEditControls ;
1260 if lstConsults.ItemIEN <= 0 then
1261 begin
1262 memConsult.Lines.Add('No consults were found which met the criteria specified: '
1263 + #13#10#13#10 + lblConsults.Caption) ;
1264 memConsult.SelStart := 0;
1265 mnuAct.Enabled := False ;
1266 exit ;
1267 end
1268 else mnuAct.Enabled := True;
1269 pnlResults.Visible := False;
1270 pnlResults.SendToBack;
1271 Screen.Cursor := crHourglass ;
1272 StatusText('Retrieving selected consult...');
1273 cmdPCE.Enabled := False;
1274 popNoteMemoEncounter.Enabled := False;
1275 GetConsultRec(lstConsults.ItemIEN) ;
1276 FOrderID := '';
1277 //FOrderID := Piece(lstConsults.Items[lstConsults.ItemIndex], U, 6);
1278 if ConsultRec.EntryDate = -1 then
1279 begin
1280 memConsult.Lines.Add(TX_INVALID_CONSULT_TEXT) ;
1281 lblTitle.Caption := TX_INVALID_CONSULT_CAP ;
1282 lblTitle.Hint := lblTitle.Caption;
1283 end
1284 else
1285 begin
1286 lblTitle.Caption := lstConsults.DisplayText[lstConsults.ItemIndex] ;
1287 lblTitle.Hint := lblTitle.Caption;
1288 LoadConsultDetail(memConsult.Lines, lstConsults.ItemIEN) ;
1289 FDocList.Clear;
1290 lstNotes.Items.Clear;
1291 uChanging := True;
1292 tvCsltNotes.Items.BeginUpdate;
1293 KillDocTreeObjects(tvCsltNotes);
1294 tvCsltNotes.Items.Clear;
1295 if (ConsultRec.TIUDocuments.Count + ConsultRec.MedResults.Count) > 0 then
1296 begin
1297 with FCurrentNoteContext do
1298 begin
1299 if ConsultRec.TIUDocuments.Count > 0 then
1300 begin
1301 CreateListItemsForDocumentTree(FDocList, ConsultRec.TIUDocuments, RSLT_TIU_DOC, GroupBy, TreeAscending, CT_CONSULTS);
1302 UpdateNoteTreeView(FDocList, tvCsltNotes, RSLT_TIU_DOC);
1303 end;
1304 FDocList.Clear;
1305 if ConsultRec.MedResults.Count > 0 then
1306 begin
1307 CreateListItemsForDocumentTree(FDocList, ConsultRec.MedResults, RSLT_MED_RPT, GroupBy, TreeAscending, CT_CONSULTS);
1308 UpdateNoteTreeView(FDocList, tvCsltNotes, RSLT_MED_RPT);
1309 end;
1310 end;
1311 with tvCsltNotes do
1312 begin
1313 FullExpand;
1314 if Notifications.Active and FNotifPending then
1315 Selected := FindPieceNode(Piece(Notifications.AlertData, U, 1), 1, U, nil)
1316 else if FLastNoteID <> '' then
1317 Selected := FindPieceNode(FLastNoteID, 1, U, nil);
1318 if Selected <> nil then
1319 if Piece(PDocTreeObject(Selected)^.DocID, ';', 1) <> 'MCAR' then DisplayPCE ;
1320 end;
1321 end
1322 else
1323 begin
1324 ANode := tvCsltNotes.Items.AddFirst(tvCsltNotes.Items.GetFirstNode, 'No related documents found');
1325 TORTreeNode(ANode).StringData := '-1^No related documents found';
1326 lstNotes.Items.Add('-1^None') ;
1327 ShowPCEControls(False) ;
1328 end ;
1329 tvCsltNotes.Items.EndUpdate;
1330 uChanging := False;
1331 FLastNoteID := '';
1332 //FLastNoteID := lstNotes.ItemID;
1333 end ;
1334 SetActionMenus ;
1335 SetResultMenus ;
1336 StatusText('');
1337 pnlRight.Repaint ;
1338 memConsult.SelStart := 0;
1339 memConsult.Repaint;
1340 Screen.Cursor := crDefault ;
1341end;
1342
1343procedure TfrmConsults.mnuActNewConsultRequestClick(Sender: TObject);
1344var
1345 DialogInfo: string;
1346 DelayEvent: TOrderDelayEvent;
1347begin
1348 inherited;
1349 DelayEvent.EventType := 'C'; // temporary, so can pass to CopyOrders
1350 DelayEvent.Specialty := 0;
1351 DelayEvent.Effective := 0;
1352 DelayEvent.EventIFN := 0;
1353 DelayEvent.PtEventIFN := 0;
1354 if not ReadyForNewOrder(DelayEvent) then Exit;
1355 { get appropriate form, create the dialog form and show it }
1356 DialogInfo := GetNewDialog(DLG_CONSULT); // DialogInfo = DlgIEN;FormID;DGroup
1357 case CharAt(Piece(DialogInfo, ';', 4), 1) of
1358 'A': ActivateAction( Piece(DialogInfo, ';', 1), Self, 0);
1359 'D', 'Q': ActivateOrderDialog(Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1360 'M': ActivateOrderMenu( Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1361 'O': ActivateOrderSet( Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1362 else InfoBox('Unsupported dialog type', 'Error', MB_OK);
1363 end; {case}
1364end;
1365
1366procedure TfrmConsults.mnuActNewProcedureClick(Sender: TObject);
1367var
1368 DialogInfo: string;
1369 DelayEvent: TOrderDelayEvent;
1370begin
1371 inherited;
1372 DelayEvent.EventType := 'C'; // temporary, so can pass to CopyOrders
1373 DelayEvent.Specialty := 0;
1374 DelayEvent.Effective := 0;
1375 DelayEvent.EventIFN := 0;
1376 DelayEvent.PtEventIFN := 0;
1377
1378 if not ReadyForNewOrder(DelayEvent) then Exit;
1379 { get appropriate form, create the dialog form and show it }
1380 DialogInfo := GetNewDialog(DLG_PROC); // DialogInfo = DlgIEN;FormID;DGroup
1381 case CharAt(Piece(DialogInfo, ';', 4), 1) of
1382 'D', 'Q': ActivateOrderDialog(Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1383 'M': ActivateOrderMenu( Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1384 'O': ActivateOrderSet( Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1385 else InfoBox('Unsupported dialog type', 'Error', MB_OK);
1386 end; {case}
1387end;
1388
1389procedure TfrmConsults.cmdNewConsultClick(Sender: TObject);
1390{ maps 'New Consult' button to the New Consult menu item }
1391begin
1392 inherited;
1393 mnuActNewConsultRequestClick(Self);
1394end;
1395
[829]1396procedure TfrmConsults.cmdNewConsultExit(Sender: TObject);
1397begin
1398 inherited;
1399 if Not cmdEditResubmit.Visible then
1400 DoLeftPanelCustomShiftTab;
1401end;
1402
[456]1403procedure TfrmConsults.cmdNewProcClick(Sender: TObject);
1404begin
1405 inherited;
1406 mnuActNewProcedureClick(Self);
1407end;
1408
1409{ Right panel (editor) events -------------------------------------------------------------- }
1410
1411procedure TfrmConsults.NewPersonNeedData(Sender: TObject; const StartFrom: string;
1412 Direction, InsertAt: Integer);
1413begin
1414 inherited;
1415 (Sender as TORComboBox).ForDataUse(SubSetOfPersons(StartFrom, Direction));
1416end;
1417
1418procedure TfrmConsults.memResultChange(Sender: TObject);
1419{ sets FChanged to record that the note has really been edited }
1420begin
1421 inherited;
1422 FChanged := True;
1423end;
1424
1425{ View menu events ------------------------------------------------------------------------- }
1426
1427procedure TfrmConsults.mnuViewClick(Sender: TObject);
1428{ changes the list of Consults available for viewing }
1429var
1430 NewView: boolean;
1431 Saved: Boolean;
1432 //tmpNode: TTreeNode;
1433begin
1434 inherited;
1435 // save note at FEditingIndex?
1436 if EditingIndex <> -1 then
1437 begin
1438 SaveCurrentNote(Saved);
1439 if not Saved then Exit;
1440 end;
1441 NewView := False ;
1442 if Sender is TMenuItem then
1443 begin
1444 ViewContext := TMenuItem(Sender).Tag ;
1445 case ViewContext of
1446 CC_BY_STATUS : NewView := SelectStatus(Font.Size, FCurrentContext, StsCtxt);
1447 CC_BY_SERVICE : NewView := SelectService(Font.Size, FCurrentContext, SvcCtxt);
1448 CC_BY_DATE : NewView := SelectConsultDateRange(Font.Size, FCurrentContext, DateRange);
1449 CC_CUSTOM : begin
1450 NewView := SelectConsultsView(Font.Size, FCurrentContext, uSelectContext) ;
1451 if NewView then lblConsults.Caption := 'Custom List';
1452 end;
1453 CC_ALL : NewView := True ;
1454 end;
1455 end
1456 else with FCurrentContext do
1457 begin
1458 if ((BeginDate + EndDate + Status + Service + GroupBy) <> '') then
1459 begin
1460 ViewContext := CC_CUSTOM;
1461 NewView := True;
1462 lblConsults.Caption := 'Default List';
1463 end
1464 else
1465 begin
1466 ViewContext := CC_ALL;
1467 NewView := True;
1468 lblConsults.Caption := 'All Consults';
1469 end;
1470 end;
1471 tvConsults.Caption := lblConsults.Caption;
1472 if NewView then
1473 begin
1474 StatusText('Retrieving Consult list...');
1475 lblTitle.Caption := '';
1476 lblTitle.Hint := lblTitle.Caption;
1477 UpdateList ;
1478 StatusText('');
1479 end;
1480 tvConsultsClick(Self);
1481end;
1482
1483{ Action menu events ----------------------------------------------------------------------- }
1484
1485procedure TfrmConsults.mnuActCompleteClick(Sender: TObject);
1486const
1487 IS_ID_CHILD = False;
1488var
1489 NoteIEN: integer;
1490 ActionSts: TActionRec;
1491 UseClinProcTitles: boolean;
1492begin
1493 inherited;
1494 if lstConsults.ItemIEN = 0 then exit;
1495 if MenuAccessRec.IsClinicalProcedure then
1496 begin
1497 case MenuAccessRec.ClinProcFlag of
1498 {1} CP_NO_INSTRUMENT : FActionType := CN_ACT_CP_COMPLETE;
1499 {2} CP_INSTR_NO_STUB : begin
1500 InfoBox(TX_CP_NO_RESULTS, TC_CP_NO_RESULTS, MB_OK or MB_ICONERROR);
1501 Exit;
1502 end;
1503 {3} CP_INSTR_INCOMPLETE : FActionType := CN_ACT_CP_COMPLETE;
1504 {4} CP_INSTR_COMPLETE : FActionType := CN_ACT_CP_COMPLETE;
1505 end;
1506 end
1507 else // {0} not a clinical procedure
1508 FActionType := TMenuItem(Sender).Tag ;
1509 if not StartNewEdit(NT_ACT_NEW_NOTE) then Exit;
1510
1511 SelectNoteForProcessing(Font.Size, FActionType, lstNotes.Items, NoteIEN, MenuAccessRec.ClinProcFlag);
1512 if NoteIEN > 0 then
1513 begin
1514 with tvCsltNotes do Selected := FindPieceNode(IntToStr(NoteIEN), 1, U, Items.GetFirstNode);
1515 if tvCsltNotes.Selected = nil then exit;
1516 ActOnDocument(ActionSts, lstNotes.ItemIEN, 'EDIT RECORD');
1517 if not ActionSts.Success then
1518 begin
1519 InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
1520 Exit;
1521 end ;
1522 mnuActNoteEditClick(Self);
1523 end
1524 else if NoteIEN = StrToInt(CN_NEW_CP_NOTE) then
1525 begin
1526 // make sure a visit (time & location) is available before creating the note
1527 if Encounter.NeedVisit then
1528 begin
1529 UpdateVisit(Font.Size, DfltTIULocation);
1530 frmFrame.DisplayEncounterText;
1531 end;
1532 if Encounter.NeedVisit then
1533 begin
1534 InfoBox(TX_NEED_VISIT, TX_NO_VISIT, MB_OK or MB_ICONWARNING);
1535 Exit;
1536 end;
1537 SetResultMenus ;
1538 UseClinProcTitles := True;
1539 CompleteConsult(IS_ID_CHILD, 0, UseClinProcTitles);
1540 end
1541 else if NoteIEN = StrToInt(CN_NEW_CSLT_NOTE) then
1542 begin
1543 // make sure a visit (time & location) is available before creating the note
1544 if Encounter.NeedVisit then
1545 begin
1546 UpdateVisit(Font.Size, DfltTIULocation);
1547 frmFrame.DisplayEncounterText;
1548 end;
1549 if Encounter.NeedVisit then
1550 begin
1551 InfoBox(TX_NEED_VISIT, TX_NO_VISIT, MB_OK or MB_ICONWARNING);
1552 Exit;
1553 end;
1554 SetResultMenus ;
1555 UseClinProcTitles := False;
1556 CompleteConsult(IS_ID_CHILD, 0, UseClinProcTitles);
1557 end
1558 else if NoteIEN = -1 then Exit
1559end;
1560
1561procedure TfrmConsults.mnuActAddIDEntryClick(Sender: TObject);
1562const
1563 IS_ID_CHILD = True;
1564 IS_CLIN_PROC = False;
1565var
1566 AnIDParent: integer;
1567 //AConsultID: string;
1568{ switches to current new note or creates a new note if none is being edited already }
1569begin
1570 inherited;
1571(* AConsultID := lstConsults.ItemID;*)
1572 AnIDParent := lstNotes.ItemIEN;
1573 if not StartNewEdit(NT_ACT_ID_ENTRY) then Exit;
1574(* with tvConsults do Selected := FindPieceNode(AConsultID, 1, U, Items.GetFirstNode);
1575 with tvCsltNotes do Selected := FindPieceNode(IntToStr(AnIDParent), 1, U, Items.GetFirstNode);*)
1576
1577 // make sure a visit (time & location) is available before creating the note
1578 if Encounter.NeedVisit then
1579 begin
1580 UpdateVisit(Font.Size, DfltTIULocation);
1581 frmFrame.DisplayEncounterText;
1582 end;
1583 if Encounter.NeedVisit then
1584 begin
1585 InfoBox(TX_NEED_VISIT, TX_NO_VISIT, MB_OK or MB_ICONWARNING);
1586 Exit;
1587 end;
1588 CompleteConsult(IS_ID_CHILD, AnIDParent, IS_CLIN_PROC);
1589end;
1590
1591procedure TfrmConsults.mnuActMakeAddendumClick(Sender: TObject);
1592var
1593 ActionSts: TActionRec;
1594 //ANoteID, AConsultID: string;
1595begin
1596 inherited;
1597 if lstConsults.ItemIEN = 0 then exit;
1598(* // ====== REMOVED IN V14 - superfluous with treeview in v15 ===========
1599 FActionType := TMenuItem(Sender).Tag ;
1600 SelectNoteForProcessing(Font.Size, FActionType, lstNotes.Items, NoteIEN);
1601 if NoteIEN = -1 then exit;
1602 //lstNotes.SelectByIEN(NoteIEN);
1603 with tvCsltNotes do Selected := FindPieceNode(IntToStr(NoteIEN), 1, U, Items.GetFirstNode);
1604 if tvCsltNotes.Selected = nil then exit;
1605 // ========================================*)
1606 if lstNotes.ItemIEN <= 0 then Exit;
1607(* AConsultID := lstConsults.ItemID;
1608 ANoteID := lstNotes.ItemID;*)
1609 if lstNotes.ItemIndex = EditingIndex then
1610 begin
1611 InfoBox(TX_ADDEND_NO, TX_ADDEND_MK, MB_OK);
1612 Exit;
1613 end;
1614 if not StartNewEdit(NT_ACT_ADDENDUM) then Exit;
1615(* with tvConsults do Selected := FindPieceNode(AConsultID, 1, U, Items.GetFirstNode);
1616 with tvCsltNotes do Selected := FindPieceNode(ANoteID, 1, U, Items.GetFirstNode);*)
1617 ActOnDocument(ActionSts, lstNotes.ItemIEN, 'MAKE ADDENDUM');
1618 if not ActionSts.Success then
1619 begin
1620 InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
1621 Exit;
1622 end;
1623 with lstNotes do if TitleForNote(ItemIEN) = TYP_ADDENDUM then //v17.5 RV
1624 //with lstNotes do if Copy(Piece(Items[ItemIndex], U, 2), 1, 8) = 'Addendum' then
1625 begin
1626 InfoBox(TX_ADDEND_AD, TX_ADDEND_MK, MB_OK);
1627 Exit;
1628 end;
1629 SetResultMenus ;
1630 InsertAddendum;
1631end;
1632
1633procedure TfrmConsults.mnuActDetachFromIDParentClick(Sender: TObject);
1634var
1635 DocID, WhyNot: string;
1636 Saved: boolean;
1637 SavedDocID, SavedConsultID: string;
1638begin
1639 if lstNotes.ItemIEN = 0 then exit;
1640 SavedDocID := lstNotes.ItemID;
1641 if EditingIndex <> -1 then
1642 begin
1643 SaveCurrentNote(Saved);
1644 if not Saved then Exit;
1645 with tvConsults do Selected := FindPieceNode(SavedConsultID, 1, U, Items.GetFirstNode);
1646 tvConsultsClick(Self);
1647 with tvCsltNotes do Selected := FindPieceNode(SavedDocID, 1, U, Items.GetFirstNode);
1648 end;
1649 if not CanBeAttached(PDocTreeObject(tvCsltNotes.Selected.Data)^.DocID, WhyNot) then
1650 begin
1651 WhyNot := StringReplace(WhyNot, 'ATTACH', 'DETACH', [rfIgnoreCase]);
1652 WhyNot := StringReplace(WhyNot, 'to an ID', 'from an ID', [rfIgnoreCase]);
1653 InfoBox(WhyNot, TX_DETACH_FAILURE, MB_OK);
1654 Exit;
1655 end;
1656 if (InfoBox('DETACH: ' + tvCsltNotes.Selected.Text + CRLF + CRLF +
1657 ' FROM: ' + tvCsltNotes.Selected.Parent.Text + CRLF + CRLF +
1658 'Are you sure?', TX_DETACH_CNF, MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) <> IDYES)
1659 then Exit;
1660 DocID := PDocTreeObject(tvCsltNotes.Selected.Data)^.DocID;
1661 SavedDocID := PDocTreeObject(tvCsltNotes.Selected.Parent.Data)^.DocID;
1662 if DetachEntryFromParent(DocID, WhyNot) then
1663 begin
1664 tvConsultsChange(Self, tvConsults.Selected);
1665 with tvCsltNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1666 if tvCsltNotes.Selected <> nil then tvCsltNotes.Selected.Expand(False);
1667 end
1668 else
1669 begin
1670 WhyNot := StringReplace(WhyNot, 'ATTACH', 'DETACH', [rfIgnoreCase]);
1671 WhyNot := StringReplace(WhyNot, 'to an ID', 'from an ID', [rfIgnoreCase]);
1672 InfoBox(WhyNot, TX_DETACH_FAILURE, MB_OK);
1673 end;
1674end;
1675
1676procedure TfrmConsults.mnuActSignatureListClick(Sender: TObject);
1677{ add the note to the Encounter object, see mnuActSignatureSignClick - copied}
1678const
1679 SIG_COSIGN = 'COSIGNATURE';
1680 SIG_SIGN = 'SIGNATURE';
1681var
1682 ActionType, SignTitle: string;
1683 ActionSts: TActionRec;
1684 ErrMsg: string;
1685begin
1686 inherited;
1687 if lstNotes.ItemIEN = 0 then Exit;
1688 if lstNotes.ItemIndex = EditingIndex then Exit; // already in signature list
1689 if LacksClinProcFieldsForSignature(lstNotes.ItemIEN, ErrMsg) then
1690 begin
1691 InfoBox(ErrMsg, TC_CLIN_PROC, MB_OK);
1692 Exit;
1693 end;
1694 if not NoteHasText(lstNotes.ItemIEN) then
1695 begin
1696 InfoBox(TX_EMPTY_NOTE1, TC_EMPTY_NOTE, MB_OK or MB_ICONERROR);
1697 Exit;
1698 end;
1699 if not LastSaveClean(lstNotes.ItemIEN) and
1700 (InfoBox(TX_ABSAVE, TC_ABSAVE, MB_YESNO or MB_DEFBUTTON2 or MB_ICONWARNING) <> IDYES) then Exit;
1701 if CosignDocument(lstNotes.ItemIEN) then
1702 begin
1703 SignTitle := TX_COSIGN;
1704 ActionType := SIG_COSIGN;
1705 end else
1706 begin
1707 SignTitle := TX_SIGN;
1708 ActionType := SIG_SIGN;
1709 end;
1710 ActOnDocument(ActionSts, lstNotes.ItemIEN, ActionType);
1711 if not ActionSts.Success then
1712 begin
1713 InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
1714 Exit;
1715 end;
1716 LockConsultRequestAndNote(lstNotes.ItemIEN);
1717 with lstNotes do Changes.Add(CH_CON, ItemID, GetTitleText(ItemIndex), '', CH_SIGN_YES);
1718end;
1719
1720
1721procedure TfrmConsults.mnuActNoteDeleteClick(Sender: TObject);
1722{ delete the selected progress note & remove from the Encounter object if necessary }
1723var
1724 DeleteSts, ActionSts: TActionRec;
1725 SaveConsult, SavedDocIEN: Integer;
1726 ReasonForDelete, AVisitStr, SavedDocID, x: string;
1727 Saved: boolean;
1728begin
1729 inherited;
1730 if lstNotes.ItemIEN = 0 then Exit;
1731 ActOnDocument(ActionSts, lstNotes.ItemIEN, 'DELETE RECORD');
1732 if ShowMsgOn(not ActionSts.Success, ActionSts.Reason, TX_IN_AUTH) then Exit;
1733 ReasonForDelete := SelectDeleteReason(lstNotes.ItemIEN);
1734 if ReasonForDelete = DR_CANCEL then Exit;
1735 // suppress prompt for deletion when called from SaveEditedNote (Sender = Self)
1736 if (Sender <> Self) and (InfoBox(MakeNoteDisplayText(lstNotes.Items[lstNotes.ItemIndex]) + TX_DEL_OK,
1737 TX_DEL_CNF, MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) <> IDYES) then Exit;
1738 // do the appropriate locking
1739 if not LockConsultRequestAndNote(lstNotes.ItemIEN) then Exit;
1740 if JustifyDocumentDelete(lstNotes.ItemIEN) then
1741 InfoBox(TX_RETRACT, TX_RETRACT_CAP, MB_OK);
1742 SavedDocID := lstNotes.ItemID;
1743 SavedDocIEN := lstNotes.ItemIEN;
1744 if (EditingIndex > -1) and (not FConfirmed) and (lstNotes.ItemIndex <> EditingIndex) and (memResults.GetTextLen > 0) then
1745 begin
1746 SaveCurrentNote(Saved);
1747 if not Saved then Exit;
1748 end;
1749 EditingIndex := -1;
1750 FConfirmed := False;
1751 (* if Saved then
1752 begin
1753 EditingIndex := -1;
1754 mnuViewClick(Self);
1755 with tvCsltNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1756 end;*)
1757 // remove the note
1758 DeleteSts.Success := True;
1759 x := GetPackageRefForNote(SavedDocIEN);
1760 SaveConsult := StrToIntDef(Piece(x, ';', 1), 0);
1761 //SaveConsult := GetConsultIENforNote(SavedDocIEN);
1762 AVisitStr := VisitStrForNote(SavedDocIEN);
1763 RemovePCEFromChanges(SavedDocIEN, AVisitStr);
1764 if (SavedDocIEN > 0) and (lstNotes.ItemIEN = SavedDocIEN)then DeleteDocument(DeleteSts, SavedDocIEN, ReasonForDelete);
1765 if not Changes.Exist(CH_CON, SavedDocID) then UnlockDocument(SavedDocIEN);
1766 Changes.Remove(CH_CON, SavedDocID); // this will unlock the document if in Changes
1767 UnlockConsultRequest(0, SaveConsult); // note has been deleted, so 1st param = 0
1768 // reset the display now that the note is gone
1769 if DeleteSts.Success then
1770 begin
1771 DeletePCE(AVisitStr); // removes PCE data if this was the only note pointing to it
1772 ClearEditControls;
1773 //ClearPtData; WRONG - fixed in v15.10 - RV
1774 cmdNewConsult.Visible := True;
1775 cmdNewProc.Top := cmdNewConsult.Top + cmdNewConsult.Height;
1776 cmdNewProc.Visible := True;
1777 pnlConsultList.Height := (pnlLeft.Height div 2);
1778(* uChanging := True;
1779 with tvNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1780 uChanging := False;
1781 if tvCsltNotes.Selected <> nil then tvCsltNotesChange(Self, tvCsltNotes.Selected) else
1782 begin*)
1783 pnlResults.Visible := False;
1784 pnlResults.SendToBack;
1785 pnlRead.Visible := True;
1786 pnlRead.BringToFront ;
1787 memConsult.TabStop := True;
1788 UpdateReminderFinish;
1789 ShowPCEControls(False);
1790 frmDrawers.DisplayDrawers(FALSE);
1791 cmdPCE.Visible := FALSE;
1792 popNoteMemoEncounter.Visible := FALSE;
1793 UpdateList;
1794 lstConsults.Enabled := True ;
1795 tvConsults.Enabled := True;
1796 with tvConsults do Selected := FindPieceNode(IntToStr(SaveConsult), 1, U, Items.GetFirstNode);
1797 tvConsultsClick(Self);
1798(* lstConsults.SelectByIEN(ConsultRec.IEN);
1799 if lstConsults.ItemIEN > 0 then
1800 lstConsultsClick(Self) ;*)
1801 lstNotes.Enabled := True;
1802(* uChanging := True;
1803 with tvNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1804 uChanging := False;
1805 if tvCsltNotes.Selected <> nil then tvCsltNotesChange(Self, tvCsltNotes.Selected);
1806 end; {if ItemIndex}*)
1807 end {if DeleteSts}
1808 else InfoBox(DeleteSts.Reason, TX_DEL_ERR, MB_OK or MB_ICONWARNING);
1809end;
1810
1811procedure TfrmConsults.mnuActNoteEditClick(Sender: TObject);
1812{ load the selected progress note for editing }
1813var
1814 ActionSts: TActionRec;
1815 //AConsultID, ANoteID: string;
1816begin
1817 inherited;
1818 if lstNotes.ItemIndex = EditingIndex then Exit;
1819(* AConsultID := lstConsults.ItemID;
1820 ANoteID := lstNotes.ItemID;*)
1821 if not StartNewEdit(NT_ACT_EDIT_NOTE) then Exit;
1822(* with tvConsults do Selected := FindPieceNode(AConsultID, 1, U, Items.GetFirstNode);
1823 with tvCsltNotes do Selected := FindPieceNode(ANoteID, 1, U, Items.GetFirstNode);*)
1824 ActOnDocument(ActionSts, lstNotes.ItemIEN, 'EDIT RECORD');
1825 if not ActionSts.Success then
1826 begin
1827 InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
1828 Exit;
1829 end;
1830 LoadForEdit;
1831end;
1832
1833procedure TfrmConsults.mnuActSignatureSaveClick(Sender: TObject);
1834{ saves the Consult that is currently being edited }
1835var
1836 Saved: Boolean;
1837// i: integer;
1838 SavedDocID, SavedCsltID, x: string;
1839 tmpNode: TORTreeNode;
1840begin
1841 inherited;
1842 if EditingIndex > -1 then
1843 begin
1844 SavedDocID := Piece(lstNotes.Items[EditingIndex], U, 1);
1845 FLastNoteID := SavedDocID;
1846 SavedCsltID := lstConsults.ItemID;
1847 SaveCurrentNote(Saved) ;
1848 if Saved and (EditingIndex < 0) and (not FDeleted) then
1849 //if Saved then
1850 begin
1851 pnlResults.Visible := False;
1852 pnlResults.SendToBack;
1853 lstConsults.Enabled := True;
1854 tvConsults.Enabled := True;
1855 if Notifications.Active then
1856 with tvConsults do
1857 begin
1858 uChanging := True;
1859 Selected := FindPieceNode(SavedCsltID, 1, U, Items.GetFirstNode);
1860 if Selected <> nil then Selected.Delete;
1861 x := FindConsult(StrToIntDef(SavedCsltID, 0));
1862 tmpNode := TORTreeNode(Items.AddChildFirst(Items.GetFirstNode, MakeConsultListDisplayText(x)));
1863 tmpNode.StringData := x;
1864 SetNodeImage(tmpNode, FCurrentContext);
1865 uChanging := False;
1866 Selected := tmpNode;
1867 tvConsultsClick(Self);
1868 end
1869 else
1870 begin
1871 UpdateList ; {update consult list after success}
1872 with tvConsults do Selected := FindPieceNode(SavedCsltID, U, Items.GetFirstNode);
1873 tvConsultsClick(Self);
1874 with tvCsltNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1875 end;
1876 pnlLeft.Refresh ;
1877 end;
1878 end
1879 else InfoBox(TX_NO_CONSULT, TX_SAVE_CONSULT, MB_OK or MB_ICONWARNING);
1880 if frmFrame.TimedOut then Exit;
1881 with tvCsltNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1882end;
1883
1884procedure TfrmConsults.mnuActSignatureSignClick(Sender: TObject);
1885{ sign the currently selected note, save first if necessary }
1886const
1887 SIG_COSIGN = 'COSIGNATURE';
1888 SIG_SIGN = 'SIGNATURE';
1889var
1890 Saved, NoteUnlocked: Boolean;
1891 ActionType, ESCode, SignTitle, x: string;
1892 ActionSts, SignSts: TActionRec;
1893 OK: boolean;
1894 tmpNode: TORTreeNode;
1895 SavedDocID, SavedCsltID, tmpItem, ErrMsg: string;
1896 EditingID: string; //v22.12 - RV
1897begin
1898 inherited;
1899(* if lstNotes.ItemIndex = EditingIndex then
1900 begin
1901 SaveCurrentNote(Saved);
1902 if (not Saved) or FDeleted then Exit;
1903 end
1904 else if EditingIndex > -1 then
1905 tmpItem := lstNotes.Items[EditingIndex];
1906 SavedDocID := lstNotes.ItemID;*)
1907 SavedCsltID := lstConsults.ItemID;
1908 SavedDocID := lstNotes.ItemID; //v22.12 - RV
1909 FLastNoteID := SavedDocID; //v22.12 - RV
1910 if lstNotes.ItemIndex = EditingIndex then //v22.12 - RV
1911 begin //v22.12 - RV
1912 SaveCurrentNote(Saved); //v22.12 - RV
1913 if (not Saved) or FDeleted then Exit; //v22.12 - RV
1914 end //v22.12 - RV
1915 else if EditingIndex > -1 then //v22.12 - RV
1916 begin //v22.12 - RV
1917 tmpItem := lstNotes.Items[EditingIndex]; //v22.12 - RV
1918 EditingID := Piece(tmpItem, U, 1); //v22.12 - RV
1919 end; //v22.12 - RV
1920 if LacksClinProcFieldsForSignature(lstNotes.ItemIEN, ErrMsg) then
1921 begin
1922 InfoBox(ErrMsg, TC_CLIN_PROC, MB_OK);
1923 Exit;
1924 end;
1925 if not NoteHasText(lstNotes.ItemIEN) then
1926 begin
1927 InfoBox(TX_EMPTY_NOTE1, TC_EMPTY_NOTE, MB_OK or MB_ICONERROR);
1928 Exit;
1929 end;
1930 if not LastSaveClean(lstNotes.ItemIEN) and
1931 (InfoBox(TX_ABSAVE, TC_ABSAVE, MB_YESNO or MB_DEFBUTTON2 or MB_ICONWARNING) <> IDYES) then Exit;
1932 if CosignDocument(lstNotes.ItemIEN) then
1933 begin
1934 SignTitle := TX_COSIGN;
1935 ActionType := SIG_COSIGN;
1936 end else
1937 begin
1938 SignTitle := TX_SIGN;
1939 ActionType := SIG_SIGN;
1940 end;
1941 if not LockConsultRequestAndNote(lstNotes.ItemIEN) then Exit;
1942 // no exits after things are locked
1943 NoteUnlocked := False;
1944 ActOnDocument(ActionSts, lstNotes.ItemIEN, ActionType);
1945 if ActionSts.Success then
1946 begin
1947 OK := IsOK2Sign(uPCEShow, lstNotes.ItemIEN);
1948 if frmFrame.Closing then exit;
1949 if(uPCEShow.Updated) then
1950 begin
1951 uPCEShow.CopyPCEData(uPCEEdit);
1952 uPCEShow.Updated := FALSE;
1953 lstNotesClick(Self);
1954 end;
1955 if not AuthorSignedDocument(lstNotes.ItemIEN) then
1956 begin
1957 if (InfoBox(TX_AUTH_SIGNED +
1958 GetTitleText(lstNotes.ItemIndex),TX_SIGN ,MB_YESNO)= ID_NO) then exit;
1959 end;
1960 if(OK) then
1961 begin
1962 with lstNotes do SignatureForItem(Font.Size, MakeConsultNoteDisplayText(Items[ItemIndex]), SignTitle, ESCode);
1963 if Length(ESCode) > 0 then
1964 begin
1965 SignDocument(SignSts, lstNotes.ItemIEN, ESCode);
1966 RemovePCEFromChanges(lstNotes.ItemIEN);
1967 NoteUnlocked := Changes.Exist(CH_CON, lstNotes.ItemID);
1968 Changes.Remove(CH_CON, lstNotes.ItemID); // this will unlock if in Changes
1969 if SignSts.Success then
1970 begin
1971 pnlResults.Visible := False;
1972 pnlResults.SendToBack;
1973 lstConsults.Enabled := True;
1974 tvConsults.Enabled := True;
1975 if Notifications.Active then
1976 with tvConsults do
1977 begin
1978 uChanging := True;
1979 Selected := FindPieceNode(SavedCsltID, 1, U, Items.GetFirstNode);
1980 if Selected <> nil then Selected.Delete;
1981 x := FindConsult(StrToIntDef(SavedCsltID, 0));
1982 tmpNode := TORTreeNode(Items.AddChildFirst(Items.GetFirstNode, MakeConsultListDisplayText(x)));
1983 tmpNode.StringData := x;
1984 SetNodeImage(tmpNode, FCurrentContext);
1985 uChanging := False;
1986 Selected := tmpNode;
1987 //tvConsultsClick(Self);
1988 end
1989 else
1990 begin
1991 UpdateList ; {update consult list after success}
1992 with tvConsults do Selected := FindPieceNode(SavedCsltID, U, Items.GetFirstNode);
1993 //tvConsultsClick(Self);
1994 //with tvCsltNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1995 end;
1996 end
1997 else InfoBox(SignSts.Reason, TX_SIGN_ERR, MB_OK);
1998 end {if Length(ESCode)}
1999 else
2000 NoteUnlocked := Changes.Exist(CH_CON, lstNotes.ItemID);
2001 end;
2002 end
2003 else InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
2004 if not NoteUnlocked then UnlockDocument(lstNotes.ItemIEN);
2005 UnlockConsultRequest(lstNotes.ItemIEN, StrToIntDef(SavedCsltID, 0)); // v20.4 RV (unlocking problem)
2006 //UnlockConsultRequest(lstNotes.ItemIEN, ConsultRec.IEN);
2007 tvConsultsClick(Self);
2008 //if EditingIndex > -1 then //v22.12 - RV
2009 if (EditingID <> '') then //v22.12 - RV
2010 begin
2011 lstNotes.Items.Insert(0, tmpItem);
2012 tmpNode := TORTreeNode(tvCsltNotes.Items.AddObjectFirst(tvCsltNotes.Items.GetFirstNode, 'Note being edited',
2013 MakeNoteTreeObject('EDIT^Note being edited^^^^^^^^^^^%^0')));
2014 tmpNode.StringData := 'EDIT^Note being edited^^^^^^^^^^^%^0';
2015 tmpNode.ImageIndex := IMG_TOP_LEVEL;
2016 tmpNode := TORTreeNode(tvCsltNotes.Items.AddChildObjectFirst(tmpNode, MakeConsultNoteDisplayText(tmpItem),
2017 MakeConsultsNoteTreeObject(tmpItem)));
2018 tmpNode.StringData := tmpItem;
2019 SetTreeNodeImagesAndFormatting(TORTreeNode(tmpNode), FCurrentNoteContext, CT_CONSULTS);
2020 EditingIndex := lstNotes.SelectByID(EditingID); //v22.12 - RV
2021 end;
2022 //with tvCsltNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode); //v22.12 - RV
2023 with tvCsltNotes do //v22.12 - RV
2024 begin //v22.12 - RV
2025 Selected := FindPieceNode(FLastNoteID, U, Items.GetFirstNode); //v22.12 - RV
2026 if Selected <> nil then tvCsltNotesChange(Self, Selected); //v22.12 - RV
2027 end;
2028end;
2029
2030procedure TfrmConsults.SaveSignItem(const ItemID, ESCode: string);
2031{ saves and optionally signs a progress note or addendum }
2032const
2033 SIG_COSIGN = 'COSIGNATURE';
2034 SIG_SIGN = 'SIGNATURE';
2035var
2036 AnIndex, IEN, i: Integer;
2037 Saved, ContinueSign: Boolean; {*RAB* 8/26/99}
2038 ActionSts, SignSts: TActionRec;
2039 APCEObject: TPCEData;
2040 OK: boolean;
2041 SavedCsltID, x: string;
2042 tmpNode: TORTreeNode;
2043 ErrMsg: string;
2044 ActionType, SignTitle: string;
2045begin
2046 AnIndex := -1;
2047 IEN := StrToIntDef(ItemID, 0);
2048 if IEN = 0 then Exit;
2049 x := GetPackageRefForNote(IEN);
2050 SavedCsltID := Piece(x, ';', 1);
2051 //SavedCsltID := IntToStr(GetConsultIENForNote(IEN));
2052 if frmFrame.TimedOut and (EditingIndex <> -1) then FSilent := True;
2053 with lstNotes do for i := 0 to Items.Count - 1 do if lstNotes.GetIEN(i) = IEN then
2054 begin
2055 AnIndex := i;
2056 break;
2057 end;
2058 if (AnIndex > -1) and (AnIndex = EditingIndex) then
2059 begin
2060 SaveCurrentNote(Saved);
2061 if not Saved then Exit;
2062 if FDeleted then
2063 begin
2064 FDeleted := False;
2065 Exit;
2066 end;
2067 AnIndex := lstNotes.SelectByIEN(IEN);
2068 //IEN := lstNotes.GetIEN(AnIndex); // saving will change IEN
2069 end;
2070 if Length(ESCode) > 0 then
2071 begin
2072 if CosignDocument(IEN) then
2073 begin
2074 SignTitle := TX_COSIGN;
2075 ActionType := SIG_COSIGN;
2076 end else
2077 begin
2078 SignTitle := TX_SIGN;
2079 ActionType := SIG_SIGN;
2080 end;
2081 ActOnDocument(ActionSts, IEN, ActionType);
2082 if not ActionSts.Success then
2083 begin
2084 InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
2085 ContinueSign := False;
2086 end
2087 else if LacksClinProcFieldsForSignature(IEN, ErrMsg) then
2088 begin
2089 InfoBox(ErrMsg, TC_CLIN_PROC, MB_OK);
2090 ContinueSign := False;
2091 end
2092 else if not NoteHasText(IEN) then
2093 begin
2094 InfoBox(TX_EMPTY_NOTE1, TC_EMPTY_NOTE, MB_OK or MB_ICONERROR);
2095 ContinueSign := False;
2096 end
2097 else if not LastSaveClean(IEN) and
2098 (InfoBox(TX_ABSAVE, TC_ABSAVE, MB_YESNO or MB_DEFBUTTON2 or MB_ICONWARNING) <> IDYES)
2099 then ContinueSign := False
2100 else ContinueSign := True;
2101 if ContinueSign then
2102 begin
2103 if (AnIndex >= 0) and (AnIndex = lstNotes.ItemIndex) then
2104 APCEObject := uPCEShow
2105 else
2106 APCEObject := nil;
2107 OK := IsOK2Sign(APCEObject, IEN);
2108 if frmFrame.Closing then exit;
2109 if(assigned(APCEObject)) and (uPCEShow.Updated) then
2110 begin
2111 uPCEShow.CopyPCEData(uPCEEdit);
2112 uPCEShow.Updated := FALSE;
2113 lstNotesClick(Self);
2114 end
2115 else
2116 uPCEEdit.Clear;
2117 if(OK) then
2118 begin
2119 SignDocument(SignSts, IEN, ESCode);
2120 if not SignSts.Success then InfoBox(SignSts.Reason, TX_SIGN_ERR, MB_OK);
2121 end; {if OK}
2122 end; {if ContinueSign}
2123 end; {if Length(ESCode)}
2124
2125 UnlockConsultRequest(IEN);
2126 UnlockDocument(IEN);
2127 if (AnIndex = lstNotes.ItemIndex) and (not frmFrame.ContextChanging) then lstNotesClick(Self);
2128 if Notifications.Active then
2129 with tvConsults do
2130 begin
2131 if (AnIndex = lstNotes.ItemIndex) and (not frmFrame.ContextChanging) then lstNotesClick(Self);
2132 uChanging := True;
2133 Selected := FindPieceNode(SavedCsltID, 1, U, Items.GetFirstNode);
2134 if Selected <> nil then Selected.Delete;
2135 x := FindConsult(StrToIntDef(SavedCsltID, 0));
2136 tmpNode := TORTreeNode(Items.AddChildFirst(Items.GetFirstNode, MakeConsultListDisplayText(x)));
2137 tmpNode.StringData := x;
2138 SetNodeImage(tmpNode, FCurrentContext);
2139 uChanging := False;
2140 Selected := tmpNode;
2141 tvConsultsClick(Self);
2142 end
2143 else
2144 begin
2145 UpdateList ; {update consult list after success}
2146 if (AnIndex = lstNotes.ItemIndex) and (not frmFrame.ContextChanging) then lstNotesClick(Self);
2147 with tvConsults do Selected := FindPieceNode(SavedCsltID, U, Items.GetFirstNode);
2148 tvConsultsClick(Self);
2149 with tvCsltNotes do Selected := FindPieceNode(IntToStr(IEN), U, Items.GetFirstNode);
2150 end;
2151 pnlLeft.Refresh ;
2152end ;
2153
2154procedure TfrmConsults.cmdPCEClick(Sender: TObject);
2155begin
2156 inherited;
2157 cmdPCE.Enabled := False;
2158 UpdatePCE(uPCEEdit);
2159 cmdPCE.Enabled := True;
2160 if frmFrame.Closing then exit;
2161 DisplayPCE;
2162end;
2163
2164procedure TfrmConsults.mnuActConsultClick(Sender: TObject);
2165var
2166// i:integer ;
2167 Saved, IsProcedure: boolean;
2168 SavedCsltID, x: string;
2169 tmpNode: TORTreeNode;
2170begin
2171 inherited;
2172 if lstConsults.ItemIEN = 0 then exit;
2173 SavedCsltID := lstConsults.ItemID;
2174 if EditingIndex <> -1 then
2175 begin
2176 SaveCurrentNote(Saved);
2177 if not Saved then Exit;
2178 end;
2179 FOrderID := Piece(lstConsults.Items[lstConsults.ItemIndex], U, 6);
2180 if not LockConsultRequest(lstConsults.ItemIEN) then Exit;
2181 FActionType := TMenuItem(Sender).Tag ;
2182 ClearEditControls ;
2183 lstNotes.Enabled := False ;
2184 lstConsults.Enabled := False ;
2185 tvConsults.Enabled := False;
2186 x := Piece(lstConsults.Items[lstConsults.ItemIndex], U, 12);
2187 if x <> '' then
2188 IsProcedure := (x[1] in ['P', 'M'])
2189 else
2190 IsProcedure := (Piece(lstConsults.Items[lstConsults.ItemIndex], U, 9) = 'Procedure');
2191 //if SetActionContext(Font.Size,FActionType, IsProcedure, ConsultRec.ConsultProcedure) then
2192 if SetActionContext(Font.Size,FActionType, IsProcedure, ConsultRec.ConsultProcedure, MenuAccessRec.UserLevel) then
2193 begin
2194 if Notifications.Active then
2195 with tvConsults do
2196 begin
2197 uChanging := True;
2198 Selected := FindPieceNode(SavedCsltID, 1, U, Items.GetFirstNode);
2199 if Selected <> nil then Selected.Delete;
2200 x := FindConsult(StrToIntDef(SavedCsltID, 0));
2201 tmpNode := TORTreeNode(Items.AddChildFirst(Items.GetFirstNode, MakeConsultListDisplayText(x)));
2202 tmpNode.StringData := x;
2203 SetNodeImage(tmpNode, FCurrentContext);
2204 uChanging := False;
2205 Selected := tmpNode;
2206 tvConsultsClick(Self);
2207 end
2208(* with tvConsults do
2209 begin
2210 Selected := FindPieceNode(IntToStr(ConsultRec.IEN), 1, U, Items.GetFirstNode);
2211 if Selected <> nil then Selected.Delete;
2212 Items.AddFirst(nil, FindConsult(ConsultRec.IEN));
2213 Selected := FindPieceNode(IntToStr(ConsultRec.IEN), 1, U, Items.GetFirstNode);
2214 end*)
2215 else
2216 begin
2217 UpdateList ; {update consult list after success}
2218 with tvConsults do Selected := FindPieceNode(SavedCsltID, U, Items.GetFirstNode);
2219 tvConsultsClick(Self);
2220 end;
2221 end;
2222 UnlockConsultRequest(lstNotes.ItemIEN, StrToIntDef(SavedCsltID, 0)); // v20.4 RV (unlocking problem)
2223 //UnlockConsultRequest(lstNotes.ItemIEN, lstConsults.ItemIEN);
2224 lstNotes.Enabled := True ;
2225 lstConsults.Enabled := True ;
2226 tvConsults.Enabled := True;
2227end;
2228
2229procedure TfrmConsults.UpdateList;
2230begin
2231 { call this after performing some action on a consult that changes its status
2232 or its service }
2233 case ViewContext of
2234 CC_ALL : begin
2235 FillChar(FCurrentContext, SizeOf(FCurrentContext), 0);
2236 lblConsults.Caption := 'All Consults' ;
2237 FCurrentContext.Ascending := False;
2238 end;
2239 CC_BY_STATUS : begin
2240 with StsCtxt do if Changed then
2241 begin
2242 FillChar(FCurrentContext, SizeOf(FCurrentContext), 0);
2243 lblConsults.Caption := 'All ' + StatusName + ' Consults';
2244 FCurrentContext.Status := Status;
2245 FCurrentContext.Ascending := Ascending;
2246 end;
2247 end;
2248 CC_BY_SERVICE : begin
2249 with SvcCtxt do if Changed then
2250 begin
2251 FillChar(FCurrentContext, SizeOf(FCurrentContext), 0);
2252 lblConsults.Caption := 'Consults to ' + ServiceName;
2253 FCurrentContext.Service := Service;
2254 FCurrentContext.Ascending := Ascending;
2255 end;
2256 end;
2257 CC_BY_DATE : begin
2258 with DateRange do if Changed then
2259 begin
2260 FillChar(FCurrentContext, SizeOf(FCurrentContext), 0);
2261 lblConsults.Caption := FormatFMDateTime('mmm dd,yy', StrToFMDateTime(BeginDate)) + ' to ' +
2262 FormatFMDateTime('mmm dd,yy', StrToFMDateTime(EndDate));
2263 FCurrentContext.BeginDate := BeginDate;
2264 FCurrentContext.EndDate := EndDate;
2265 FCurrentContext.Ascending := Ascending;
2266 end;
2267 end;
2268 CC_CUSTOM : begin
2269 with uSelectContext do if Changed then
2270 begin
2271 FillChar(FCurrentContext, SizeOf(FCurrentContext), 0);
2272 with lblConsults do if Caption <> 'Default List' then Caption := 'Custom List' ;
2273 FCurrentContext.BeginDate := BeginDate;
2274 FCurrentContext.EndDate := EndDate;
2275 FCurrentContext.Status := Status;
2276 FCurrentContext.Service := Service;
2277 FCurrentContext.GroupBy := GroupBy;
2278 FCurrentContext.Ascending := Ascending;
2279 end ;
2280 end ;
2281 end; {case}
2282 tvConsults.Caption := lblConsults.Caption;
2283 if not frmFrame.ContextChanging then LoadConsults;
2284end ;
2285
2286procedure TfrmConsults.SetActionMenus ;
2287{Set available menu actions based on consult status and user access to consult's service}
2288var
2289 status: integer ;
2290begin
2291
2292 FillChar(MenuAccessRec, SizeOf(MenuAccessRec), 0);
2293 if (lstConsults.ItemIndex < 0) then
2294 begin
2295 mnuAct.Enabled := False ;
2296 exit ;
2297 end
2298 else
2299 begin
2300 MenuAccessRec := GetActionMenuLevel(ConsultRec.IEN) ;
2301 status := ConsultRec.ORStatus ;
2302 end ;
2303
2304
2305 with MenuAccessRec do
2306 begin
2307 // mnuAct.Enabled := (UserLevel > 1) ; {'User Review' menu level = 1 }
2308 {'Service Action' menu level = 2 }
2309
2310 mnuActConsultRequest.Enabled := (lstConsults.ItemIEN > 0);
2311 mnuActReceive.Enabled := (UserLevel > UL_REVIEW)
2312 and (status=ST_PENDING);
2313 mnuActSchedule.Enabled := (UserLevel > UL_REVIEW)
2314 and ((status=ST_PENDING)
2315 or (status=ST_ACTIVE));
2316 mnuActDeny.Enabled := (UserLevel > UL_REVIEW)
2317 and ((status<>ST_DISCONTINUED)
2318 and (status<>ST_COMPLETE)
2319 and (status<>ST_CANCELLED)
2320 and (status<>ST_PARTIAL_RESULTS)) ;
2321(* mnuActEditResubmit.Enabled := {(UserLevel > 1) and }(Notifications.Active)
2322 {if the user received the alert,} and (lstConsults.ItemIEN = CurrNotifIEN)
2323 { this menu should be available } and (status = ST_CANCELLED)
2324 and (not User.NoOrdering);*)
2325 {if processing an alert - NO CHANGE HERE}
2326 if Notifications.Active and (lstConsults.ItemIEN = CurrNotifIEN) then
2327 mnuActEditResubmit.Enabled := (*(lstConsults.ItemIEN = CurrNotifIEN) and*)
2328 (status = ST_CANCELLED) and
2329 (not User.NoOrdering)
2330 {if not processing an alert, check other stuff}
2331 else
2332 mnuActEditResubmit.Enabled := AllowResubmit and
2333 (status = ST_CANCELLED) and
2334 (not User.NoOrdering);
2335 mnuActForward.Enabled := (UserLevel > UL_REVIEW)
2336 and ((status<>ST_DISCONTINUED)
2337 and (status<>ST_COMPLETE)
2338 and (status<>ST_CANCELLED)) ;
2339 mnuActDiscontinue.Enabled := (UserLevel > UL_REVIEW)
2340 and ((status<>ST_DISCONTINUED)
2341 and (status<>ST_COMPLETE)
2342 and (status<>ST_CANCELLED)
2343 and (status<>ST_PARTIAL_RESULTS)) ;
2344 mnuActSigFindings.Enabled := (UserLevel > UL_REVIEW)
2345 and ((status<>ST_DISCONTINUED)
2346 and (status<>ST_CANCELLED));
2347 mnuActAdminComplete.Enabled := ((UserLevel = UL_ADMIN) or (UserLevel = UL_UPDATE_AND_ADMIN))
2348 and ((status<>ST_DISCONTINUED)
2349 and (status<>ST_COMPLETE)
2350 and (status<>ST_CANCELLED));
2351
2352 mnuActAddComment.Enabled := True;
2353 mnuActDisplayDetails.Enabled := True;
2354 mnuActDisplayResults.Enabled := True;
2355 mnuActDisplaySF513.Enabled := True;
2356 mnuActPrintSF513.Enabled := True;
2357 mnuActConsultResults.Enabled := (lstConsults.ItemIEN > 0) and
[829]2358 (((UserLevel = UL_UPDATE) or (UserLevel = UL_UPDATE_AND_ADMIN) or (UserLevel = UL_UNRESTRICTED)) and
[456]2359 ((status<>ST_DISCONTINUED) and
2360 (status<>ST_CANCELLED)))
2361 or
2362 (lstConsults.ItemIEN > 0) and
2363 ((AllowMedResulting) and
2364 ((status<>ST_DISCONTINUED) and
2365 (status<>ST_CANCELLED)))
2366 or
2367 (lstConsults.ItemIEN > 0) and
2368 ((AllowMedDissociate) and
2369 ((status = ST_COMPLETE)))
2370 or
2371 ((Notifications.Active) and
2372 (lstConsults.ItemIEN = CurrNotifIEN) and
2373 (Notifications.FollowUp = NF_CONSULT_UNSIGNED_NOTE) and
2374 (lstNotes.ItemIndex > -1));
2375 cmdEditResubmit.Visible := mnuActEditResubmit.Enabled;
2376 end;
2377end ;
2378
2379procedure TfrmConsults.SetResultMenus ;
2380var
2381 WhyNot: string;
2382begin
2383 mnuActComplete.Enabled := mnuActConsultResults.Enabled and
2384 ((MenuAccessRec.UserLevel = UL_UPDATE) or
[829]2385 (MenuAccessRec.UserLevel = UL_UPDATE_AND_ADMIN) or
2386 (MenuAccessRec.UserLevel = UL_UNRESTRICTED))
[456]2387 and
2388 ((ConsultRec.ORStatus=ST_PENDING) or
2389 (ConsultRec.ORStatus=ST_ACTIVE) or
2390 (ConsultRec.ORStatus=ST_SCHEDULED) or
2391 (ConsultRec.ORStatus=ST_PARTIAL_RESULTS) or
2392 (ConsultRec.ORStatus=ST_COMPLETE)) ;
2393 mnuActMakeAddendum.Enabled := mnuActConsultResults.Enabled and
2394 ((MenuAccessRec.UserLevel = UL_UPDATE) or
[829]2395 (MenuAccessRec.UserLevel = UL_UPDATE_AND_ADMIN) or
2396 (MenuAccessRec.UserLevel = UL_UNRESTRICTED))
[456]2397 and
2398 (ConsultRec.ORStatus=ST_COMPLETE) and
2399 ((lstNotes.ItemIndex > -1) and
2400 ((ConsultRec.TIUResultNarrative>0) or
2401 (lstNotes.ItemIEN > 0)));
2402 mnuActAddIDEntry.Enabled := mnuActConsultResults.Enabled and
2403 uIDNotesActive and
2404 (tvCsltNotes.Selected <> nil) and
2405 (tvCsltNotes.Selected.ImageIndex in [IMG_SINGLE, IMG_PARENT,
2406 IMG_IDNOTE_OPEN, IMG_IDNOTE_SHUT, IMG_IDPAR_ADDENDA_OPEN,
2407 IMG_IDPAR_ADDENDA_SHUT]) and
2408 CanReceiveAttachment(PDocTreeObject(tvCsltNotes.Selected.Data)^.DocID, WhyNot);
2409 mnuActDetachFromIDParent.Enabled := mnuActConsultResults.Enabled and
2410 uIDNotesActive and
2411 (tvCsltNotes.Selected <> nil) and
2412 (tvCsltNotes.Selected.ImageIndex in [IMG_ID_CHILD, IMG_ID_CHILD_ADD]);
2413 mnuActAttachMed.Enabled := mnuActConsultResults.Enabled and
2414 (((mnuActComplete.Enabled) or
2415 (MenuAccessRec.UserLevel = UL_ADMIN) or
2416 (MenuAccessRec.UserLevel = UL_UPDATE_AND_ADMIN)))
2417 and (MenuAccessRec.AllowMedResulting);
2418 mnuActRemoveMed.Enabled := mnuActConsultResults.Enabled and
2419 ((ConsultRec.ORStatus=ST_COMPLETE) and (MenuAccessRec.AllowMedDissociate));
2420 mnuActNoteEdit.Enabled := mnuActConsultResults.Enabled and
2421 ((lstNotes.ItemIndex > -1) and
2422 ((ConsultRec.TIUResultNarrative>0) or
2423 (lstNotes.ItemIEN > 0) or
2424 (FActionType = CN_ACT_COMPLETE) or
2425 (FActionType = CN_ACT_ADDENDUM)));
2426 mnuActNoteDelete.Enabled := mnuActConsultResults.Enabled and
2427 ((lstNotes.ItemIndex > -1) and
2428 ((ConsultRec.TIUResultNarrative>0) or
2429 (lstNotes.ItemIEN > 0) or
2430 (FActionType = CN_ACT_COMPLETE) or
2431 (FActionType = CN_ACT_ADDENDUM)));
2432 mnuActSignatureSign.Enabled := mnuActConsultResults.Enabled and
2433 ((lstNotes.ItemIndex > -1) and
2434 ((ConsultRec.TIUResultNarrative>0) or
2435 (lstNotes.ItemIEN > 0) or
2436 (FActionType = CN_ACT_COMPLETE) or
2437 (FActionType = CN_ACT_ADDENDUM)))
2438 or
2439 ((Notifications.Active) and
2440 (lstConsults.ItemIEN = CurrNotifIEN) and
2441 (Notifications.FollowUp = NF_CONSULT_UNSIGNED_NOTE) and
2442 (lstNotes.ItemIndex > -1));
2443 mnuActSignatureList.Enabled := mnuActConsultResults.Enabled and
2444 ((lstNotes.ItemIndex > -1) and
2445 ((ConsultRec.TIUResultNarrative>0) or
2446 (lstNotes.ItemIEN > 0) or
2447 (FActionType = CN_ACT_COMPLETE) or
2448 (FActionType = CN_ACT_ADDENDUM)))
2449 or
2450 ((Notifications.Active) and
2451 (lstConsults.ItemIEN = CurrNotifIEN) and
2452 (Notifications.FollowUp = NF_CONSULT_UNSIGNED_NOTE) and
2453 (lstNotes.ItemIndex > -1));
2454 mnuActSignatureSave.Enabled := mnuActConsultResults.Enabled and
2455 ((lstNotes.ItemIndex > -1) and
2456 ((ConsultRec.TIUResultNarrative>0) or
2457 (lstNotes.ItemIEN > 0) or
2458 (FActionType = CN_ACT_COMPLETE) or
2459 (FActionType = CN_ACT_ADDENDUM)));
2460 mnuActIdentifyAddlSigners.Enabled := mnuActConsultResults.Enabled and
2461 ((lstNotes.ItemIndex > -1) and
2462 ((ConsultRec.TIUResultNarrative>0) or
2463 (lstNotes.ItemIEN > 0)));
2464 mnuActNotePrint.Enabled := mnuActConsultResults.Enabled and
2465 ((lstNotes.ItemIndex > -1) and
2466 ((ConsultRec.TIUResultNarrative>0) or
2467 (lstNotes.ItemIEN > 0)));
2468 mnuActChange.Enabled := mnuActConsultResults.Enabled and
2469 ((lstNotes.ItemIndex > -1) and (lstNotes.ItemIndex = EditingIndex));
2470 mnuActLoadBoiler.Enabled := mnuActConsultResults.Enabled and
2471 ((lstNotes.ItemIndex > -1) and (lstNotes.ItemIndex = EditingIndex));
2472
2473 if ((lstNotes.ItemIndex > -1) and UserIsSigner(lstNotes.ItemIEN)) then
2474 begin
2475 mnuActSignatureList.Enabled := True;
2476 mnuActSignatureSign.Enabled := True;
2477 mnuActConsultResults.Enabled := True;
2478 end;
2479
2480 popNoteMemoSignList.Enabled := //(mnuActConsultResults.Enabled) and
2481 (mnuActSignatureList.Enabled) ;
2482 popNoteMemoSign.Enabled := //(mnuActConsultResults.Enabled) and
2483 mnuActSignatureSign.Enabled ;
2484 popNoteMemoSave.Enabled := //(mnuActConsultResults.Enabled) and
2485 mnuActSignatureSave.Enabled ;
2486 popNoteMemoEdit.Enabled := //(mnuActConsultResults.Enabled) and
2487 mnuActNoteEdit.Enabled;
2488 popNoteMemoAddend.Enabled := //(mnuActConsultResults.Enabled) and
2489 mnuActMakeAddendum.Enabled;
2490 popNoteMemoDelete.Enabled := //(mnuActConsultResults.Enabled) and
2491 mnuActNoteDelete.Enabled;
2492 popNoteMemoAddlSign.Enabled := //(mnuActConsultResults.Enabled) and
2493 mnuActIdentifyAddlSigners.Enabled;
2494 popNoteMemoPrint.Enabled := (mnuActNotePrint.Enabled);
2495end;
2496
2497procedure TfrmConsults.DisplayPCE;
2498{ displays PCE information if appropriate & enables/disables editing of PCE data }
2499var
2500 EnableList, ShowList: TDrawers;
2501 VitalStr: TStringlist;
2502 NoPCE: boolean;
2503 ActionSts: TActionRec;
2504
2505begin
2506 if (lstNotes.ItemIndex=-1) or (lstNotes.Items.Count=0) then exit ;
2507 memPCEShow.Clear;
2508 with lstNotes do if ItemIndex = EditingIndex then
2509 begin
2510 with uPCEEdit do
2511 begin
2512 AddStrData(memPCEShow.Lines);
2513 NoPCE := (memPCEShow.Lines.Count = 0);
2514 VitalStr := TStringList.create;
2515 try
2516 GetVitalsFromDate(VitalStr, uPCEEdit);
2517 AddVitalData(VitalStr, memPCEShow.Lines);
2518 finally
2519 VitalStr.free;
2520 end;
2521 cmdPCE.Enabled := CanEditPCE(uPCEEdit);
2522 ShowPCEControls(cmdPCE.Enabled or (memPCEShow.Lines.Count > 0));
2523 if(NoPCE and memPCEShow.Visible) then
2524 memPCEShow.Lines.Insert(0, TX_NOPCE);
2525
2526 if(InteractiveRemindersActive) then
2527 begin
2528 if(GetReminderStatus = rsNone) then
2529 EnableList := [odTemplates]
2530 else
2531 EnableList := [odTemplates, odReminders];
2532 ShowList := [odTemplates, odReminders];
2533 end
2534 else
2535 begin
2536 EnableList := [odTemplates];
2537 ShowList := [odTemplates];
2538 end;
2539 frmDrawers.Visible := True;
2540 frmDrawers.DisplayDrawers(TRUE, EnableList, ShowList);
2541 cmdNewConsult.Visible := False;
2542 cmdNewProc.Visible := False;
2543 pnlConsultList.Height := (pnlLeft.Height div 5);
2544
2545 cmdPCE.Visible := TRUE;
2546 end;
2547 end else
2548 begin
2549 //VitalStr := TStringList.create;
2550 //VitalStr.clear;
2551 cmdPCE.Enabled := False;
2552
2553 frmDrawers.Visible := False;
2554 frmDrawers.DisplayDrawers(FALSE);
2555 cmdPCE.Visible := FALSE;
2556 cmdNewConsult.Visible := True;
2557 cmdNewProc.Top := cmdNewConsult.Top + cmdNewConsult.Height;
2558 cmdNewProc.Visible := True;
2559 pnlConsultList.Height := (pnlLeft.Height div 2);
2560 //pnlConsultList.Height := 3 * (pnlLeft.Height div 5);
2561
2562 ActOnDocument(ActionSts, lstNotes.ItemIEN, 'VIEW');
2563 if ActionSts.Success then
2564 begin
2565 StatusText('Retrieving encounter information...');
2566 with uPCEShow do
2567 begin
2568 NoteDateTime := MakeFMDateTime(Piece(lstNotes.Items[lstNotes.ItemIndex], U, 3));
2569 PCEForNote(lstNotes.ItemIEN, uPCEEdit);
2570 AddStrData(memPCEShow.Lines);
2571 NoPCE := (memPCEShow.Lines.Count = 0);
2572 VitalStr := TStringList.create;
2573 try
2574 GetVitalsFromNote(VitalStr, uPCEShow, lstNotes.ItemIEN);
2575 AddVitalData(VitalStr, memPCEShow.Lines);
2576 finally
2577 VitalStr.free;
2578 end;
2579 ShowPCEControls(memPCEShow.Lines.Count > 0);
2580 if(NoPCE and memPCEShow.Visible) then
2581 memPCEShow.Lines.Insert(0, TX_NOPCE);
2582 end;
2583 StatusText('');
2584 end
2585 else
2586 ShowPCEControls(FALSE);
2587 end; {if ItemIndex}
2588 memPCEShow.SelStart := 0;
2589 popNoteMemoEncounter.Enabled := cmdPCE.Enabled;
2590 popNoteMemoEncounter.Visible := cmdPCE.Visible;
2591end;
2592
2593procedure TfrmConsults.ShowPCEControls(ShouldShow: Boolean);
2594begin
2595 sptVert.Visible := ShouldShow;
2596 memPCEShow.Visible := ShouldShow;
2597 if(ShouldShow) then
2598 sptVert.Top := memPCEShow.Top - sptVert.Height;
2599 memResults.Invalidate;
2600end;
2601
2602procedure TfrmConsults.RemovePCEFromChanges(IEN: Integer; AVisitStr: string = '');
2603begin
2604 if IEN = CN_ADDENDUM then Exit; // no PCE information entered for an addendum
2605 if AVisitStr = '' then AVisitStr := VisitStrForNote(IEN);
2606 Changes.Remove(CH_PCE, 'V' + AVisitStr);
2607 Changes.Remove(CH_PCE, 'P' + AVisitStr);
2608 Changes.Remove(CH_PCE, 'D' + AVisitStr);
2609 Changes.Remove(CH_PCE, 'I' + AVisitStr);
2610 Changes.Remove(CH_PCE, 'S' + AVisitStr);
2611 Changes.Remove(CH_PCE, 'A' + AVisitStr);
2612 Changes.Remove(CH_PCE, 'H' + AVisitStr);
2613 Changes.Remove(CH_PCE, 'E' + AVisitStr);
2614 Changes.Remove(CH_PCE, 'T' + AVisitStr);
2615end;
2616
2617procedure TfrmConsults.lstNotesClick(Sender: TObject);
2618{ loads the text for the selected note or displays the editing panel for the selected note }
2619var
2620 x: string;
2621begin
2622 inherited;
2623 if (lstNotes.ItemIEN = -1) then exit ;
2624 with lstNotes do
2625 if ItemIndex = EditingIndex then
2626 begin
2627 lstConsults.Enabled := False ;
2628 tvConsults.Enabled := False;
2629 pnlResults.Visible := True;
2630 pnlResults.BringToFront;
2631 memConsult.TabStop := False;
2632 mnuActChange.Enabled := True;
2633 mnuActLoadBoiler.Enabled := True;
2634 UpdateReminderFinish;
2635 end
2636 else
2637 begin
2638 StatusText('Retrieving selected item...');
2639 if EditingIndex = -1 then
2640 begin
2641 lstConsults.Enabled := True ;
2642 tvConsults.Enabled := True;
2643 end;
2644 lblTitle.Caption := MakeConsultNoteDisplayText(lstNotes.Items[lstNotes.ItemIndex]);
2645 lblTitle.Hint := lblTitle.Caption;
2646 lstNotes.Enabled := True ;
2647 pnlResults.Visible := False;
2648 UpdateReminderFinish;
2649 pnlRead.BringToFront;
2650 memConsult.TabStop := True;
2651 if Copy(Piece(lstNotes.ItemID, ';', 2), 1, 4)= 'MCAR' then
2652 begin
[829]2653 QuickCopy(GetDetailedMedicineResults(lstNotes.ItemID), memConsult);
[456]2654 x := Piece(Piece(Piece(lstNotes.ItemID, ';', 2), '(', 2), ',', 1) + ';' + Piece(lstNotes.ItemID, ';', 1);
[829]2655 x := 'MED^' + x;
2656 SetPiece(x, U, 10, Piece(lstNotes.Items[lstNotes.ItemIndex], U, 11));
2657 NotifyOtherApps(NAE_REPORT, x);
[456]2658 end
2659 else
2660 begin
2661 LoadDocumentText(memConsult.Lines,ItemIEN) ;
2662 mnuActChange.Enabled := False;
2663 mnuActLoadBoiler.Enabled := False;
[829]2664 x := 'TIU^' + lstNotes.ItemID;
2665 SetPiece(x, U, 10, Piece(lstNotes.Items[lstNotes.ItemIndex], U, 11));
2666 NotifyOtherApps(NAE_REPORT, x);
[456]2667 end;
2668 memConsult.SelStart := 0;
2669 end;
2670 if Copy(Piece(lstNotes.ItemID, ';', 2), 1, 4) <> 'MCAR' then
2671 begin
2672 if(assigned(frmReminderTree)) then frmReminderTree.EnableActions;
2673 DisplayPCE;
2674 end;
2675 pnlRight.Refresh;
2676 memConsult.Repaint;
2677 memResults.Repaint;
2678 SetResultMenus;
2679 StatusText('');
2680end;
2681
2682procedure TfrmConsults.popNoteMemoPopup(Sender: TObject);
2683begin
2684 inherited;
2685 if PopupComponent(Sender, popNoteMemo) is TCustomEdit
2686 then FEditCtrl := TCustomEdit(PopupComponent(Sender, popNoteMemo))
2687 else FEditCtrl := nil;
2688 if FEditCtrl <> nil then
2689 begin
2690 popNoteMemoCut.Enabled := FEditCtrl.SelLength > 0;
2691 popNoteMemoCopy.Enabled := popNoteMemoCut.Enabled;
2692 popNoteMemoPaste.Enabled := (not TORExposedCustomEdit(FEditCtrl).ReadOnly) and
2693 Clipboard.HasFormat(CF_TEXT);
2694 popNoteMemoTemplate.Enabled := frmDrawers.CanEditTemplates and popNoteMemoCut.Enabled;
2695 popNoteMemoFind.Enabled := FEditCtrl.GetTextLen > 0;
2696 end
2697 else
2698 begin
2699 popNoteMemoCut.Enabled := False;
2700 popNoteMemoCopy.Enabled := False;
2701 popNoteMemoPaste.Enabled := False;
2702 popNoteMemoTemplate.Enabled := False;
2703 end;
2704 if pnlResults.Visible then
2705 begin
2706 popNoteMemoSpell.Enabled := True;
2707 popNoteMemoGrammar.Enabled := True;
2708 popNoteMemoReformat.Enabled := True;
2709 popNoteMemoReplace.Enabled := (FEditCtrl.GetTextLen > 0);
2710 popNoteMemoPreview.Enabled := (frmDrawers.TheOpenDrawer = odTemplates) and Assigned(frmDrawers.tvTemplates.Selected);
2711 popNoteMemoInsTemplate.Enabled := (frmDrawers.TheOpenDrawer = odTemplates) and Assigned(frmDrawers.tvTemplates.Selected);
2712 end else
2713 begin
2714 popNoteMemoSpell.Enabled := False;
2715 popNoteMemoGrammar.Enabled := False;
2716 popNoteMemoReformat.Enabled := False;
2717 popNoteMemoReplace.Enabled := False;
2718 popNoteMemoPreview.Enabled := False;
2719 popNoteMemoInsTemplate.Enabled := False;
2720 end;
2721end;
2722
2723procedure TfrmConsults.popNoteMemoCutClick(Sender: TObject);
2724begin
2725 inherited;
2726 FEditCtrl.CutToClipboard;
2727end;
2728
2729procedure TfrmConsults.popNoteMemoCopyClick(Sender: TObject);
2730begin
2731 inherited;
2732 FEditCtrl.CopyToClipboard;
2733end;
2734
2735procedure TfrmConsults.popNoteMemoPasteClick(Sender: TObject);
2736begin
2737 inherited;
2738 FEditCtrl.SelText := Clipboard.AsText; {*KCM*}
2739 //FEditCtrl.PasteFromClipboard; // use AsText to prevent formatting
2740end;
2741
2742procedure TfrmConsults.popNoteMemoReformatClick(Sender: TObject);
2743begin
2744 inherited;
2745 if Screen.ActiveControl <> memResults then Exit;
2746 ReformatMemoParagraph(memResults);
2747end;
2748
2749procedure TfrmConsults.popNoteMemoFindClick(Sender: TObject);
2750begin
2751 inherited;
2752 SendMessage(TRichEdit(popNoteMemo.PopupComponent).Handle, WM_VSCROLL, SB_TOP, 0);
2753 with dlgFindText do
2754 begin
2755 Position := Point(Application.MainForm.Left + pnlLeft.Width, Application.MainForm.Top);
2756 FindText := '';
2757 Options := [frDown, frHideUpDown];
2758 Execute;
2759 end;
2760end;
2761
2762procedure TfrmConsults.dlgFindTextFind(Sender: TObject);
2763begin
2764 dmodShared.FindRichEditText(dlgFindText, TRichEdit(popNoteMemo.PopupComponent));
2765end;
2766
2767procedure TfrmConsults.dlgReplaceTextFind(Sender: TObject);
2768begin
2769 inherited;
2770 dmodShared.FindRichEditText(dlgFindText, TRichEdit(popNoteMemo.PopupComponent));
2771end;
2772
2773procedure TfrmConsults.dlgReplaceTextReplace(Sender: TObject);
2774begin
2775 inherited;
2776 dmodShared.ReplaceRichEditText(dlgReplaceText, TRichEdit(popNoteMemo.PopupComponent));
2777end;
2778
2779procedure TfrmConsults.popNoteMemoReplaceClick(Sender: TObject);
2780begin
2781 inherited;
2782 SendMessage(TRichEdit(popNoteMemo.PopupComponent).Handle, WM_VSCROLL, SB_TOP, 0);
2783 with dlgReplaceText do
2784 begin
2785 Position := Point(Application.MainForm.Left + pnlLeft.Width, Application.MainForm.Top);
2786 FindText := '';
2787 ReplaceText := '';
2788 Options := [frDown, frHideUpDown];
2789 Execute;
2790 end;
2791end;
2792
2793procedure TfrmConsults.popNoteMemoSpellClick(Sender: TObject);
2794begin
2795 inherited;
2796 DoAutoSave(0);
2797 timAutoSave.Enabled := False;
2798 try
2799 SpellCheckForControl(memResults);
2800 finally
2801 FChanged := True;
2802 DoAutoSave(0);
2803 timAutoSave.Enabled := True;
2804 end;
2805end;
2806
2807procedure TfrmConsults.popNoteMemoGrammarClick(Sender: TObject);
2808begin
2809 inherited;
2810 DoAutoSave(0);
2811 timAutoSave.Enabled := False;
2812 try
2813 GrammarCheckForControl(memResults);
2814 finally
2815 FChanged := True;
2816 DoAutoSave(0);
2817 timAutoSave.Enabled := True;
2818 end;
2819end;
2820
2821procedure TfrmConsults.RequestPrint;
2822var
2823 Saved: boolean;
2824begin
2825 inherited;
2826 if lstNotes.ItemIEN = EditingIndex then // !KCM! in response to WPB-0898-31166
2827 //if ItemIEN < 0 then
2828 begin
2829 SaveCurrentNote(Saved);
2830 if not Saved then Exit;
2831 end;
2832 with lstConsults do
2833 if ItemIEN > 0 then PrintSF513(ItemIEN, DisplayText[ItemIndex]) else
2834 begin
2835 if ItemIEN = 0 then InfoBox(TX_NOCONSULT, TX_NOCSLT_CAP, MB_OK);
2836 if lstNotes.ItemIEN < 0 then InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK);
2837 end;
2838end;
2839
[829]2840{for printing multiple notes}
[456]2841procedure TfrmConsults.RequestMultiplePrint(AForm: TfrmPrintList);
2842var
2843 NoteIEN: int64;
2844 i: integer;
2845begin
2846 with AForm.lbIDParents do
[829]2847 for i := 0 to Items.Count - 1 do
2848 if Selected[i] then
[456]2849 begin
[829]2850 NoteIEN := StrToInt64def(Piece(Items[i], U, 1), 0);
2851 if NoteIEN > 0 then PrintSF513(NoteIEN, DisplayText[i])
2852 else if NoteIEN = 0 then InfoBox(TX_NOCONSULT, TX_NOCSLT_CAP, MB_OK)
2853 else InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK);
2854 end;
[456]2855end;
2856
2857procedure TfrmConsults.mnuActDisplayResultsClick(Sender: TObject);
2858var
2859 Saved: boolean;
2860begin
2861 inherited;
2862 if lstConsults.ItemIEN = 0 then exit;
2863 if EditingIndex <> -1 then
2864 begin
2865 SaveCurrentNote(Saved);
2866 if not Saved then Exit;
2867 end;
2868 lstNotes.ItemIndex := -1 ;
2869 DisplayResults(memConsult.Lines, lstConsults.ItemIEN) ;
2870 memConsult.SelStart := 0;
2871 SetResultMenus;
[829]2872 if memConsult.CanFocus then
2873 memConsult.SetFocus;
[456]2874end;
2875
2876procedure TfrmConsults.mnuActDisplaySF513Click(Sender: TObject);
2877var
2878 Saved: boolean;
2879begin
2880 inherited;
2881 if lstConsults.ItemIEN = 0 then exit;
2882 if EditingIndex <> -1 then
2883 begin
2884 SaveCurrentNote(Saved);
2885 if not Saved then Exit;
2886 end;
2887 lstNotes.ItemIndex := -1 ;
2888 with lstConsults do
2889 if ItemIEN > 0 then ReportBox(ShowSF513(ItemIEN),DisplayText[ItemIndex], False)
2890 else
2891 begin
2892 if ItemIEN = 0 then InfoBox(TX_NOCONSULT, TX_NOCSLT_CAP, MB_OK);
2893 if lstNotes.ItemIEN < 0 then InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK);
2894 end;
2895 SetResultMenus;
2896end;
2897
2898procedure TfrmConsults.pnlResultsResize(Sender: TObject);
2899const
2900 LEFT_MARGIN = 4;
2901begin
2902 inherited;
2903 LimitEditWidth(memResults, MAX_ENTRY_WIDTH - 1);
2904 memResults.Constraints.MinWidth := TextWidthByFont(memResults.Font.Handle, StringOfChar('X', MAX_ENTRY_WIDTH)) + (LEFT_MARGIN * 2) + ScrollBarWidth;
[829]2905 //CQ13181 508 Consults--Splitter bar doesn't retain size
2906 //CQ13181 pnlLeft.Width := self.ClientWidth - pnlResults.Width - sptHorz.Width;
[456]2907end;
2908
2909procedure TfrmConsults.NotifyOrder(OrderAction: Integer; AnOrder: TOrder);
[829]2910var
2911 SavedCsltID: string;
[456]2912begin
2913 if ViewContext = 0 then exit; // form has not yet been displayed, so nothing to update
2914 if EditingIndex <> -1 then exit; // do not rebuild list until after save
[829]2915 with tvConsults do if Selected <> nil then SavedCsltID := lstConsults.ItemID;
[456]2916 case OrderAction of
2917 ORDER_NEW: UpdateList ;
2918 ORDER_SIGN: UpdateList{ sent by fReview, fOrderSign when orders signed, AnOrder=nil}
2919 end;
[829]2920 if SavedCsltID <> '' then with tvConsults do
2921 begin
2922 Selected := FindPieceNode(SavedCsltID, U, Items.GetFirstNode);
2923 tvConsultsChange(Self, Selected);
2924 end;
[456]2925end;
2926
2927procedure TfrmConsults.mnuActPrintSF513Click(Sender: TObject);
2928var
2929 Saved: boolean;
2930begin
2931 inherited;
2932 if lstConsults.ItemIEN = 0 then exit;
2933 if EditingIndex <> -1 then
2934 begin
2935 SaveCurrentNote(Saved);
2936 if not Saved then Exit;
2937 end;
2938 RequestPrint;
2939end;
2940
2941
2942function TfrmConsults.AuthorizedUser: Boolean;
2943begin
2944 Result := True;
2945 if User.NoOrdering then Result := False;
2946 if User.OrderRole = OR_BADKEYS then
2947 begin
2948 InfoBox(TX_BADKEYS, TC_BADKEYS, MB_OK);
2949 Result := False;
2950 end;
2951end;
2952
2953procedure TfrmConsults.FormCreate(Sender: TObject);
2954begin
2955 inherited;
[829]2956 FocusToRightPanel := False;
[456]2957 PageID := CT_CONSULTS;
2958 EditingIndex := -1;
2959 FLastNoteID := '';
2960 FEditNote.LastCosigner := 0;
2961 FEditNote.LastCosignerName := '';
2962 //pnlConsultList.Height := (pnlLeft.Height div 2);
2963 pnlConsultList.Height := 3 * (pnlLeft.Height div 5);
2964 frmDrawers := TfrmDrawers.CreateDrawers(Self, pnlAction, [],[]);
2965 frmDrawers.Align := alBottom;
2966 frmDrawers.RichEditControl := memResults;
2967 frmDrawers.Splitter := splDrawers;
2968 frmDrawers.DefTempPiece := 2;
2969 FImageFlag := TBitmap.Create;
2970 FDocList := TStringList.Create;
2971 with FCurrentNoteContext do
2972 begin
2973 GroupBy := '';
2974 TreeAscending := False;
2975 Status := IntToStr(NC_ALL);
2976 end;
2977 FCsltList := TStringList.Create;
2978end;
2979
2980procedure TfrmConsults.mnuActDisplayDetailsClick(Sender: TObject);
2981var
2982 Saved: boolean;
2983begin
2984 inherited;
2985 if lstConsults.ItemIEN = 0 then exit;
2986 if EditingIndex <> -1 then
2987 begin
2988 SaveCurrentNote(Saved);
2989 if not Saved then Exit;
2990 end;
2991 tvConsultsChange(Self, tvConsults.Selected);
2992 //lstConsultsClick(Self);
[829]2993 if memConsult.CanFocus then
2994 memConsult.SetFocus;
[456]2995end;
2996
2997procedure TfrmConsults.FormClose(Sender: TObject; var Action: TCloseAction);
2998var
2999 Saved: Boolean;
3000 IEN: Int64;
3001 ErrMsg: string;
3002 DeleteSts: TActionRec;
3003begin
3004 inherited;
3005 if frmFrame.TimedOut and (EditingIndex <> -1) then
3006 begin
3007 FSilent := True;
3008 if memResults.GetTextLen > 0 then SaveCurrentNote(Saved)
3009 else
3010 begin
3011 IEN := lstNotes.GetIEN(EditingIndex);
3012 if not LastSaveClean(IEN) then // means note hasn't been committed yet
3013 begin
3014 LockDocument(IEN, ErrMsg);
3015 if ErrMsg = '' then
3016 begin
3017 DeleteDocument(DeleteSts, IEN, '');
3018 UnlockDocument(IEN);
3019 end; {if ErrMsg}
3020 end; {if not LastSaveClean}
3021 end; {else}
3022 end; {if frmFrame}
3023end;
3024
3025procedure TfrmConsults.mnuActIdentifyAddlSignersClick(Sender: TObject);
3026var
3027 Exclusions: TStrings;
3028 Saved, x, y: boolean;
3029 SignerList: TSignerList;
3030 ActionSts: TActionRec;
3031 SigAction: integer;
3032 SavedDocID, SavedCsltID: string;
3033 ARefDate: TFMDateTime;
3034begin
3035 inherited;
3036 if lstNotes.ItemIEN = 0 then exit;
3037 SavedDocID := lstNotes.ItemID;
3038 SavedCsltID := lstConsults.ItemID;
3039 if lstNotes.ItemIndex = EditingIndex then
3040 begin
3041 SaveCurrentNote(Saved);
3042 if not Saved then Exit;
3043 tvConsultsChange(Self, tvConsults.Selected);
3044 with tvCsltNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
3045 end;
3046 x := CanChangeCosigner(lstNotes.ItemIEN);
3047 ActOnDocument(ActionSts, lstNotes.ItemIEN, 'IDENTIFY SIGNERS');
3048 y := ActionSts.Success;
3049 if x and not y then
3050 begin
3051 if InfoBox(ActionSts.Reason + CRLF + CRLF +
3052 'Would you like to change the cosigner?',
3053 TX_IN_AUTH, MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) = ID_YES then
3054 SigAction := SG_COSIGNER
3055 else
3056 Exit;
3057 end
3058 else if y and not x then SigAction := SG_ADDITIONAL
3059 else if x and y then SigAction := SG_BOTH
3060 else
3061 begin
3062 InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
3063 Exit;
3064 end;
3065
3066 with lstNotes do
3067 begin
3068 if not LockConsultRequestAndNote(ItemIEN) then Exit;
3069 Exclusions := GetCurrentSigners(ItemIEN);
3070 ARefDate := StrToFloat(Piece(Items[ItemIndex], U, 3));
3071 SelectAdditionalSigners(Font.Size, ItemIEN, SigAction, Exclusions, SignerList, CT_CONSULTS, ARefDate);
3072 end;
3073 with SignerList do
3074 begin
3075 case SigAction of
3076 SG_ADDITIONAL: if Changed and (Signers <> nil) and (Signers.Count > 0) then
3077 UpdateAdditionalSigners(lstNotes.ItemIEN, Signers);
3078 SG_COSIGNER: if Changed then ChangeCosigner(lstNotes.ItemIEN, Cosigner);
3079 SG_BOTH: if Changed then
3080 begin
3081 if (Signers <> nil) and (Signers.Count > 0) then
3082 UpdateAdditionalSigners(lstNotes.ItemIEN, Signers);
3083 ChangeCosigner(lstNotes.ItemIEN, Cosigner);
3084 end;
3085 end;
3086 lstNotesClick(Self);
3087 end;
3088 UnlockDocument(lstNotes.ItemIEN);
3089 UnlockConsultRequest(lstNotes.ItemIEN, StrToIntDef(SavedCsltID, 0)); // v20.4 RV (unlocking problem)
3090 //UnlockConsultRequest(lstNotes.ItemIEN, ConsultRec.IEN);
3091end;
3092
3093procedure TfrmConsults.popNoteMemoAddlSignClick(Sender: TObject);
3094begin
3095 inherited;
3096 mnuActIdentifyAddlSignersClick(Self);
3097end;
3098
3099procedure TfrmConsults.ProcessNotifications;
3100var
3101 ConsultIEN, NoteIEN: integer;
3102 x: string;
3103 Saved: boolean;
3104 AnObject: PDocTreeObject;
3105 tmpNode: TORTreeNode;
3106begin
3107 if EditingIndex <> -1 then
3108 begin
3109 SaveCurrentNote(Saved);
3110 if not Saved then Exit;
3111 end;
3112 FNotifPending := True;
3113 NoteIEN := 0;
3114 CurrNotifIEN := 0;
3115 lblConsults.Caption := Notifications.Text;
3116 tvConsults.Caption := Notifications.Text;
3117 EditingIndex := -1;
3118 lstConsults.Enabled := True ;
3119 tvConsults.Enabled := True;
3120 lstNotes.Enabled := True ;
3121 pnlRead.BringToFront ;
3122 memConsult.TabStop := True;
3123 lstConsults.Clear;
3124
3125 if Copy(Piece(Piece(Notifications.RecordID, U, 2),';',1),1,3) = 'TIU' then
3126 begin
3127 ConsultIEN := StrToIntDef(Piece(Piece(Notifications.RecordID, U, 4),';',2),0);
3128 NoteIEN := StrToIntDef(Piece(Notifications.AlertData, U, 1),0);
3129 end
3130 else if Notifications.Followup = NF_STAT_RESULTS then
3131 ConsultIEN := StrToIntDef(Piece(Piece(Piece(Notifications.AlertData, '|', 2), '@', 1), ';', 1), 0)
3132 else if Notifications.Followup = NF_CONSULT_PROC_INTERPRETATION then
3133 ConsultIEN := StrToIntDef(Piece(Notifications.AlertData, '|', 1), 0)
3134 else if ((Notifications.Followup = NF_CONSULT_REQUEST_RESOLUTION) and (Pos('Sig Findings', Notifications.RecordID) = 0)) then
3135 ConsultIEN := StrToIntDef(Piece(Notifications.AlertData, '|', 1), 0)
3136 else
3137 ConsultIEN := StrToIntDef(Notifications.AlertData, 0);
3138 x := FindConsult(ConsultIEN);
3139 CurrNotifIEN := ConsultIEN;
3140 lstConsults.Items.Add(x);
3141 uChanging := True;
3142 tvConsults.Items.BeginUpdate;
3143 tvConsults.Items.Clear;
3144 tmpNode := tvConsults.FindPieceNode('Alerted Consult', 2, U, nil);
3145 if tmpNode = nil then
3146 begin
3147 tmpNode := TORTreeNode(tvConsults.Items.AddFirst(tvConsults.Items.GetFirstNode, 'Alerted Consult'));
3148 tmpNode.StringData := '-1^Alerted Consult^^^^^^0';
3149 end
3150 else
3151 tmpNode.DeleteChildren;
3152 SetNodeImage(tmpNode, FCurrentContext);
3153 tmpNode := TORTreeNode(tvConsults.Items.AddChildFirst(tmpNode, MakeConsultListDisplayText(x)));
3154 tmpNode.StringData := x;
3155 SetNodeImage(tmpNode, FCurrentContext);
3156 with tvConsults do Selected := FindPieceNode(Piece(x, U, 1), U, Items.GetFirstNode);
3157 tvConsults.Items.EndUpdate;
3158 uChanging := False;
3159 tvConsultsChange(Self, tvConsults.Selected);
3160 if ((Notifications.Followup = NF_CONSULT_REQUEST_RESOLUTION) and (Pos('Sig Findings', Notifications.RecordID) = 0)) then
3161 begin
3162 //XQADATA = consult_ien|tiu_ien;TIU(8925,
3163 if Copy(Piece(Piece(Notifications.AlertData, '|', 2), ';', 2), 1, 3) = 'TIU' then
3164 NoteIEN := StrToIntDef(Piece(Piece(Notifications.AlertData, '|', 2), ';', 1), 0);
3165 end
3166 else if (Notifications.Followup = NF_CONSULT_PROC_INTERPRETATION) then
3167 begin
3168 NoteIEN := StrToIntDef(Piece(Piece(Notifications.AlertData, '|', 2), ';', 1), 0);
3169 end
3170 else if (Notifications.Followup = NF_STAT_RESULTS) then
3171 begin
3172 NoteIEN := 0; // Note IEN not available for this alert - fall through to display all results - CURTIS?
3173 end;
3174 tvCsltNotes.FullExpand;
3175 if NoteIEN > 0 then with lstNotes do
3176 begin
3177 if SelectByIEN(NoteIEN) = -1 then
3178 begin
3179 x := Notifications.AlertData;
3180 uChanging := True;
3181 tvCsltNotes.Items.BeginUpdate;
3182 lstNotes.Clear;
3183 KillDocTreeObjects(tvCsltNotes);
3184 tvCsltNotes.Items.Clear;
3185 lstNotes.Items.Add(x);
3186 AnObject := MakeConsultsNoteTreeObject('ALERT^Alerted Note^^^^^^^^^^^%^0');
3187 tmpNode := TORTreeNode(tvCsltNotes.Items.AddObjectFirst(tvCsltNotes.Items.GetFirstNode, AnObject.NodeText, AnObject));
3188 TORTreeNode(tmpNode).StringData := 'ALERT^Alerted Note^^^^^^^^^^^%^0';
3189 tmpNode.ImageIndex := IMG_TOP_LEVEL;
3190 AnObject := MakeConsultsNoteTreeObject(x);
3191 tmpNode := TORTreeNode(tvCsltNotes.Items.AddChildObjectFirst(tmpNode, AnObject.NodeText, AnObject));
3192 tmpNode.StringData := x;
3193 SetTreeNodeImagesAndFormatting(tmpNode, FCurrentNoteContext, CT_CONSULTS);
3194 with tvCsltNotes do Selected := FindPieceNode(Piece(x, U, 1), U, Items.GetFirstNode);
3195 tvCsltNotes.Items.EndUpdate;
3196 uChanging := False;
3197 end
3198 else
3199 begin
3200 uChanging := True;
3201 with tvCsltNotes do Selected := FindPieceNode(IntToStr(NoteIEN), U , nil);
3202 uChanging := False;
3203 end;
3204 tvCsltNotesChange(Self, tvCsltNotes.Selected);
3205 end
3206 else if (ConsultRec.ORStatus = ST_COMPLETE) and ((ConsultRec.TIUDocuments.Count + ConsultRec.MedResults.Count) > 0) then
3207 mnuActDisplayResultsClick(Self);
3208
3209 case Notifications.Followup of
3210 NF_CONSULT_REQUEST_RESOLUTION : Notifications.Delete;
3211 NF_NEW_SERVICE_CONSULT_REQUEST : Notifications.Delete;
3212 NF_STAT_RESULTS : Notifications.Delete;
3213 NF_CONSULT_REQUEST_CANCEL_HOLD : Notifications.Delete;
3214 NF_CONSULT_REQUEST_UPDATED : Notifications.Delete;
3215 NF_CONSULT_UNSIGNED_NOTE : {Will be automatically deleted by TIU sig action!!!} ;
3216 NF_CONSULT_PROC_INTERPRETATION : Notifications.Delete; // not sure we want to do this yet,
3217 // but if not now, then when?
3218 end;
3219 if Copy(Piece(Notifications.RecordID, U, 2), 1, 6) = 'TIUADD' then Notifications.Delete;
3220 if Copy(Piece(Notifications.RecordID, U, 2), 1, 5) = 'TIUID' then Notifications.Delete;
3221 FNotifPending := False;
3222end;
3223
3224procedure TfrmConsults.mnuActEditResubmitClick(Sender: TObject);
3225var
3226 Resubmitted: boolean;
3227 x: string;
3228 SavedConsultID: string;
3229begin
3230 inherited;
3231 if lstConsults.ItemIEN = 0 then exit;
3232 SavedConsultID := lstConsults.ItemID;
3233 x := ConsultCanBeResubmitted(lstConsults.ItemIEN);
3234 if Piece(x, U, 1) = '0' then
3235 begin
3236 InfoBox(Piece(x, U, 2), TC_NO_RESUBMIT, MB_OK);
3237 Exit;
3238 end;
3239 if ConsultRec.ConsultProcedure <> '' then
3240 Resubmitted := EditResubmitProcedure(Font.Size, lstConsults.ItemIEN)
3241 else
3242 Resubmitted := EditResubmitConsult(Font.Size, lstConsults.ItemIEN);
3243 if Resubmitted then
3244 begin
3245 LoadConsults;
3246 with tvConsults do Selected := FindPieceNode(SavedConsultID, 1, U, Items.GetFirstNode);
3247 tvConsultsClick(Self);
3248 (* lstConsults.Clear;
3249 lstConsults.Items.Add(FindConsult(ConsultRec.IEN));
3250 lstConsults.SelectByIEN(ConsultRec.IEN);
3251 lstConsultsClick(Self);*)
3252 end;
3253end;
3254
3255procedure TfrmConsults.EnableDisableOrdering;
3256begin
3257 if User.NoOrdering then
3258 begin
3259 cmdNewConsult.Enabled := False;
3260 cmdNewProc.Enabled := False;
3261 mnuActNew.Enabled := False;
3262 Exit;
3263 end;
3264end;
3265
3266procedure TfrmConsults.UMNewOrder(var Message: TMessage);
3267{ update consults list if progress note completes consult }
3268begin
3269 with Message do
3270 begin
3271 if ViewContext = 0 then exit; // form has not yet been displayed, so nothing to update
3272 UpdateList;
3273 end;
3274end;
3275
3276procedure TfrmConsults.cmdEditResubmitClick(Sender: TObject);
3277begin
3278 inherited;
3279 mnuActEditResubmitClick(Self);
3280end;
3281
[829]3282procedure TfrmConsults.cmdEditResubmitExit(Sender: TObject);
3283begin
3284 inherited;
3285 DoLeftPanelCustomShiftTab;
3286end;
3287
[456]3288procedure TfrmConsults.mnuViewSaveAsDefaultClick(Sender: TObject);
3289begin
3290 inherited;
3291 if InfoBox('Replace current defaults?','Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then
3292 begin
3293 SaveCurrentContext(FCurrentContext);
3294 lblConsults.Caption := 'Default List';
3295 tvConsults.Caption := 'Default List';
3296 FDefaultContext := FCurrentContext;
3297 end;
3298end;
3299
3300procedure TfrmConsults.mnuViewReturntoDefaultClick(Sender: TObject);
3301begin
3302 inherited;
3303 lblConsults.Caption := 'Default List';
3304 tvConsults.Caption := 'Default List';
3305 SetViewContext(FDefaultContext);
3306end;
3307
3308procedure TfrmConsults.popNoteMemoTemplateClick(Sender: TObject);
3309begin
3310 inherited;
3311 EditTemplates(Self, True, FEditCtrl.SelText);
3312end;
3313
3314procedure TfrmConsults.mnuEditTemplatesClick(Sender: TObject);
3315begin
3316 inherited;
3317 EditTemplates(Self);
3318end;
3319
3320procedure TfrmConsults.mnuNewTemplateClick(Sender: TObject);
3321begin
3322 inherited;
3323 EditTemplates(Self, True);
3324end;
3325
[829]3326procedure TfrmConsults.pnlLeftExit(Sender: TObject);
3327begin
3328 inherited;
3329 if (Not FocusToRightPanel) then
3330 if ShiftTabIsPressed then
3331 frmFrame.tabPage.SetFocus
3332 else if TabIsPressed then
3333 frmFrame.pnlPatient.SetFocus;
3334
3335 if FocusToRightPanel then
3336 FocusToRightPanel := False;
3337end;
3338
[456]3339procedure TfrmConsults.pnlLeftResize(Sender: TObject);
3340begin
3341 inherited;
3342 if EditingIndex = -1 then
3343 pnlConsultList.Height := (pnlLeft.Height div 2)
3344 //pnlConsultList.Height := 3 * (pnlLeft.Height div 5)
3345 else
3346 pnlConsultList.Height := (pnlLeft.Height div 5);
3347 Self.Invalidate;
3348end;
3349
3350procedure TfrmConsults.mnuOptionsClick(Sender: TObject);
3351begin
3352 inherited;
3353 mnuEditTemplates.Enabled := frmDrawers.CanEditTemplates;
3354 mnuNewTemplate.Enabled := frmDrawers.CanEditTemplates;
3355 mnuEditSharedTemplates.Enabled := frmDrawers.CanEditShared;
3356 mnuNewSharedTemplate.Enabled := frmDrawers.CanEditShared;
3357 mnuEditDialgFields.Enabled := CanEditTemplateFields;
3358end;
3359
3360procedure TfrmConsults.mnuEditSharedTemplatesClick(Sender: TObject);
3361begin
3362 inherited;
3363 EditTemplates(Self, FALSE, '', TRUE);
3364end;
3365
3366procedure TfrmConsults.mnuNewSharedTemplateClick(Sender: TObject);
3367begin
3368 inherited;
3369 EditTemplates(Self, TRUE, '', TRUE);
3370end;
3371
3372procedure TfrmConsults.mnuActNotePrintClick(Sender: TObject);
3373var
3374 Saved: Boolean;
3375begin
3376 inherited;
3377 with lstNotes do
3378 begin
3379 if ItemIndex = EditingIndex then
3380 begin
3381 SaveCurrentNote(Saved);
3382 if not Saved then Exit;
3383 end;
3384 if ItemIEN > 0 then PrintNote(ItemIEN, MakeConsultNoteDisplayText(Items[ItemIndex])) else
3385 begin
3386 if ItemIEN = 0 then InfoBox(TX_NONOTE, TX_NONOTE_CAP, MB_OK);
3387 if ItemIEN < 0 then InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK);
3388 end;
3389 end;
3390end;
3391
3392procedure TfrmConsults.popNoteMemoPrintClick(Sender: TObject);
3393begin
3394 inherited;
3395 mnuActNotePrintClick(Self);
3396end;
3397
3398
3399//========================== leave these at end of file =============================
3400
3401(*procedure TfrmConsults.lstNotesDrawItem(Control: TWinControl;
3402 Index: Integer; Rect: TRect; State: TOwnerDrawState);
3403var
3404 x: string;
3405const
3406 STD_DATE = 'MMM DD,YY';
3407begin
3408 inherited;
3409 with (Control as TORListBox).Canvas do { draw on control canvas, not on the form }
3410 begin
3411 FImageFlag.LoadFromResourceName(hInstance, 'BMP_IMAGEFLAG_1');
3412 x := (Control as TORListBox).Items[Index];
3413 (Control as TORListBox).ItemHeight := HigherOf(TextHeight(x), FImageFlag.Height);
3414 FillRect(Rect); { clear the rectangle }
3415 if StrToIntDef(Piece(x, U, 7), 0) > 0 then
3416 begin
3417 if StrToIntDef(Piece(x, U, 7), 0) = 1 then
3418 FImageFlag.LoadFromResourceName(hInstance, 'BMP_IMAGEFLAG_1')
3419 else if StrToIntDef(Piece(x, U, 7), 0) = 2 then
3420 FImageFlag.LoadFromResourceName(hInstance, 'BMP_IMAGEFLAG_2')
3421 else if StrToIntDef(Piece(x, U, 7), 0) > 2 then
3422 FImageFlag.LoadFromResourceName(hInstance, 'BMP_IMAGEFLAG_3');
3423 BrushCopy(Bounds(Rect.Left, Rect.Top, FImageFlag.Width, FImageFlag.Height),
3424 FImageFlag, Bounds(0, 0, FImageFlag.Width, FImageFlag.Height), clRed); {render ImageFlag}
3425 end;
3426 TextOut(Rect.Left + FImageFlag.Width, Rect.Top, Piece(x, U, 2));
3427 TextOut(Rect.Left + FImageFlag.Width + TextWidth(STD_DATE), Rect.Top, Piece(x, U, 3));
3428 end;
3429end;
3430*)
3431procedure TfrmConsults.FormDestroy(Sender: TObject);
3432begin
3433 FDocList.Free;
3434 FCsltList.Free;
3435 FImageFlag.Free;
3436 KillDocTreeObjects(tvCsltNotes);
3437 inherited;
3438end;
3439
3440function TfrmConsults.GetDrawers: TFrmDrawers;
3441begin
3442 Result := frmDrawers;
3443end;
3444
3445procedure TfrmConsults.SetEditingIndex(const Value: Integer);
3446begin
3447 FEditingIndex := Value;
3448 if(FEditingIndex < 0) then
3449 KillReminderDialog(Self);
3450 if(assigned(frmReminderTree)) then
3451 frmReminderTree.EnableActions;
3452end;
3453
3454function TfrmConsults.LockConsultRequest(AConsult: Integer): Boolean;
3455{ returns true if consult successfully locked }
3456begin
3457 // *** I'm not sure about the FOrderID field - if the user is editing one note and
3458 // deletes another, FOrderID will be for editing note, then delete note, then null
3459 Result := True;
3460 FOrderID := GetConsultOrderIEN(AConsult);
3461 if frmNotes.ActiveEditOf(0, AConsult) then
3462 begin
3463 InfoBox(TX_ORDER_LOCKED, TC_ORDER_LOCKED, MB_OK);
3464 Result := False;
3465 FOrderID := '';
3466 Exit;
3467 end;
3468(* if (FOrderID <> '') and (FOrderID = frmNotes.OrderID) then
3469 begin
3470 InfoBox(TX_ORDER_LOCKED, TC_ORDER_LOCKED, MB_OK);
3471 Result := False;
3472 FOrderID := '';
3473 Exit;
3474 end;*)
3475 if (FOrderId <> '') then
3476 if not OrderCanBeLocked(FOrderID) then Result := False;
3477 if not Result then FOrderID := '';
3478end;
3479
3480function TfrmConsults.LockConsultRequestAndNote(AnIEN: Int64): Boolean;
3481{ returns true if note and associated request successfully locked }
3482var
3483 AConsult: Integer;
3484 LockMsg, x: string;
3485begin
3486 Result := True;
3487 AConsult := 0;
3488 if frmNotes.ActiveEditOf(AnIEN, lstConsults.ItemIEN) then
3489 begin
3490 InfoBox(TX_ORDER_LOCKED, TC_ORDER_LOCKED, MB_OK);
3491 Result := False;
3492 Exit;
3493 end;
3494 if Changes.Exist(CH_CON, IntToStr(AnIEN)) then Exit; // already locked
3495 // try to lock the consult request first, if there is one
3496 if IsConsultTitle(TitleForNote(AnIEN)) then
3497 begin
3498 x := GetPackageRefForNote(lstNotes.ItemIEN);
3499 AConsult := StrToIntDef(Piece(x, ';', 1), 0);
3500 //AConsult := GetConsultIENforNote(lstNotes.ItemIEN);
3501 Result := LockConsultRequest(AConsult);
3502 end;
3503 // now try to lock the note
3504 if Result then
3505 begin
3506 LockDocument(AnIEN, LockMsg);
3507 if LockMsg <> '' then
3508 begin
3509 Result := False;
3510 // if can't lock the note, unlock the consult request that was just locked
3511 if AConsult > 0 then
3512 begin
3513 UnlockOrderIfAble(FOrderID);
3514 FOrderID := '';
3515 end;
3516 InfoBox(LockMsg, TC_NO_LOCK, MB_OK);
3517 end;
3518 end;
3519 if not Result then FOrderID := '';
3520end;
3521
3522procedure TfrmConsults.UnlockConsultRequest(ANote: Int64; AConsult: Integer = 0);
3523(*var
3524 x: string;*)
3525begin
3526(* if (AConsult = 0) then
3527 begin
3528 x := GetPackageRefForNote(ANote);
3529 AConsult := StrToIntDef(Piece(x, ';', 1), 0);
3530 end;
3531 if AConsult = 0 then Exit;*)
3532 if AConsult = 0 then AConsult := GetConsultIENForNote(ANote);
3533 if AConsult <= 0 then exit;
3534 FOrderID := GetConsultOrderIEN(AConsult);
3535 UnlockOrderIfAble(FOrderID);
3536 FOrderID := '';
3537end;
3538
3539function TfrmConsults.ActiveEditOf(AnIEN: Int64): Boolean;
3540var
3541 ARequest: integer;
3542 x: string;
3543begin
3544 Result := False;
3545 if (lstNotes.ItemIEN = AnIEN) and (lstNotes.ItemIndex = EditingIndex) then
3546 begin
3547 Result := True;
3548 Exit;
3549 end;
3550 x := GetPackageRefForNote(AnIEN);
3551 ARequest := StrToIntDef(Piece(x, ';', 1), 0);
3552 //ARequest := GetConsultIENForNote(AnIEN);
3553 if (lstConsults.ItemIEN = ARequest) and (EditingIndex > -1) then Result := True;
3554end;
3555
3556function TfrmConsults.StartNewEdit(NewNoteType: integer): Boolean;
3557{ if currently editing a note, returns TRUE if the user wants to start a new one }
3558var
3559 Saved: Boolean;
3560 AConsultID, ANoteID: string;
3561 Msg, CapMsg: string;
3562begin
3563 AConsultID := lstConsults.ItemID;
3564 ANoteID := lstNotes.ItemID;
3565 Result := True;
3566 if EditingIndex > -1 then
3567 begin
3568 case NewNoteType of
3569 NT_ACT_ADDENDUM: begin
3570 Msg := TX_NEW_SAVE1 + MakeConsultNoteDisplayText(lstNotes.Items[EditingIndex]) + TX_NEW_SAVE3;
3571 CapMsg := TC_NEW_SAVE3;
3572 end;
3573 NT_ACT_EDIT_NOTE: begin
3574 Msg := TX_NEW_SAVE1 + MakeConsultNoteDisplayText(lstNotes.Items[EditingIndex]) + TX_NEW_SAVE4;
3575 CapMsg := TC_NEW_SAVE4;
3576 end;
3577 NT_ACT_ID_ENTRY: begin
3578 Msg := TX_NEW_SAVE1 + MakeConsultNoteDisplayText(lstNotes.Items[EditingIndex]) + TX_NEW_SAVE5;
3579 CapMsg := TC_NEW_SAVE5;
3580 end;
3581 else
3582 begin
3583 Msg := TX_NEW_SAVE1 + MakeNoteDisplayText(lstNotes.Items[EditingIndex]) + TX_NEW_SAVE2;
3584 CapMsg := TC_NEW_SAVE2;
3585 end;
3586 end;
3587 if InfoBox(Msg, CapMsg, MB_YESNO) = IDNO then Result := False
3588 else
3589 begin
3590 SaveCurrentNote(Saved);
3591 if not Saved then Result := False
3592 else
3593 begin
3594 with tvConsults do Selected := FindPieceNode(AConsultID, 1, U, Items.GetFirstNode);
3595 tvConsultsClick(Self);
3596 with tvCsltNotes do Selected := FindPieceNode(ANoteID, 1, U, Items.GetFirstNode);
3597 end;
3598 end;
3599 end;
3600end;
3601
3602function TfrmConsults.LacksRequiredForCreate: Boolean;
3603{ determines if the fields required to create the note are present }
3604var
3605 CurTitle: Integer;
3606begin
3607 Result := False;
3608 with FEditNote do
3609 begin
3610 if Title <= 0 then Result := True;
3611 if Author <= 0 then Result := True;
3612 if DateTime <= 0 then Result := True;
3613 if MenuAccessRec.IsClinicalProcedure then
3614 begin
3615 if (IsClinProcTitle(Title) and (PkgIEN = 0)) then Result := True;
3616 //if (IsClinProcTitle(Title) and (Consult = 0)) then Result := True;
3617 end
3618 else
3619 if (IsConsultTitle(Title) and (PkgIEN = 0)) then Result := True;
3620 //if (IsConsultTitle(Title) and (Consult = 0)) then Result := True;
3621 if (DocType = TYP_ADDENDUM) then
3622 begin
[829]3623 if AskCosignerForDocument(Addend, Author, DateTime) and (Cosigner <= 0) then Result := True;
[456]3624 end else
3625 begin
3626 if Title > 0 then CurTitle := Title else CurTitle := DocType;
3627 if AskCosignerForTitle(CurTitle, Author, DateTime) and (Cosigner <= 0) then Result := True;
3628 end;
3629 end;
3630end;
3631
3632function TfrmConsults.LacksClinProcFields(AnEditRec: TEditNoteRec; AMenuAccessRec: TMenuAccessRec; var ErrMsg: string): boolean;
3633begin
3634 Result := False;
3635 if not AMenuAccessRec.IsClinicalProcedure then exit;
3636 with AnEditRec do
3637 begin
3638 if Author <= 0 then
3639 begin
3640 Result := True;
3641 ErrMsg := TX_NO_AUTHOR;
3642 end;
3643 if AskCosignerForTitle(Title, Author, DateTime) and (Cosigner = 0) then
3644 begin
3645 Result := True;
3646 ErrMsg := ErrMsg + CRLF + TX_REQ_COSIGNER;
3647 end;
3648 if (DocType <> TYP_ADDENDUM) and (AMenuAccessRec.ClinProcFlag = CP_INSTR_INCOMPLETE) then
3649 begin
3650 if (ClinProcSummCode = 0) or (ClinProcDateTime <= 0) then
3651 begin
3652 Result := True;
3653 ErrMsg := ErrMsg + CRLF + TX_CLIN_PROC;
3654 end;
3655 end;
3656 end;
3657end;
3658
3659function TfrmConsults.LacksClinProcFieldsForSignature(NoteIEN: int64; var ErrMsg: string): boolean;
3660var
3661 CsltIEN: integer;
3662 CsltActionRec: TMenuAccessRec;
3663 SignRec: TEditNoteRec;
3664begin
3665 Result := False;
3666 CsltIEN := GetConsultIENForNote(NoteIEN);
3667 if CsltIEN <= 0 then exit;
3668 CsltActionRec := GetActionMenuLevel(CsltIEN);
3669 if not CsltActionRec.IsClinicalProcedure then exit;
3670 if not IsClinProcTitle(TitleForNote(NoteIEN)) then exit;
3671 SignRec := GetSavedCPFields(NoteIEN);
3672 Result := LacksClinProcFields(SignRec, CsltActionRec, ErrMsg);
3673end;
3674
3675function TfrmConsults.GetTitleText(AnIndex: Integer): string;
3676{ returns non-tabbed text for the title of a note given the ItemIndex in lstNotes }
3677var
3678 x: string;
3679begin
3680 with lstNotes do
3681 x := MakeConsultNoteDisplayText(Items[AnIndex]);
3682(* x := FormatFMDateTime('mmm dd,yy', MakeFMDateTime(Piece(Items[AnIndex], U, 3))) +
3683 ' ' + Piece(Items[AnIndex], U, 2);*)
3684 Result := x;
3685end;
3686
3687(*function TfrmConsults.MakeTitleText(IsAddendum: Boolean = False): string;
3688{ returns display text for list box based on FEditNote }
3689begin
3690 Result := FormatFMDateTime('mmm dd,yy', FEditNote.DateTime) + U;
3691 if IsAddendum and (CompareText(Copy(FEditNote.TitleName, 1, 8), 'Addendum') <> 0)
3692 then Result := Result + 'Addendum to ';
3693 Result := Result + FEditNote.TitleName + ', ' + FEditNote.LocationName + ', ' +
3694 FEditNote.AuthorName;
3695end;*)
3696
3697function TfrmConsults.VerifyNoteTitle: Boolean;
3698const
3699 VNT_UNKNOWN = 0;
3700 VNT_NO = 1;
3701 VNT_YES = 2;
3702var
3703 AParam: string;
3704begin
3705 if FVerifyNoteTitle = VNT_UNKNOWN then
3706 begin
3707 AParam := GetUserParam('ORWOR VERIFY NOTE TITLE');
3708 if AParam = '1' then FVerifyNoteTitle := VNT_YES else FVerifyNoteTitle := VNT_NO;
3709 end;
3710 Result := FVerifyNoteTitle = VNT_YES;
3711end;
3712
3713procedure TfrmConsults.SetSubjectVisible(ShouldShow: Boolean);
3714{ hide/show subject & resize panel accordingly - leave 6 pixel margin above memNewNote }
3715begin
3716 if ShouldShow then
3717 begin
3718 lblSubject.Visible := True;
3719 txtSubject.Visible := True;
3720 pnlFields.Height := txtSubject.Top + txtSubject.Height + 6;
3721 end else
3722 begin
3723 lblSubject.Visible := False;
3724 txtSubject.Visible := False;
3725 pnlFields.Height := lblVisit.Top + lblVisit.Height + 6;
3726 end;
3727end;
3728
3729
3730procedure TfrmConsults.timAutoSaveTimer(Sender: TObject);
3731begin
3732 inherited;
3733 DoAutoSave;
3734end;
3735
3736procedure TfrmConsults.DoAutoSave(Suppress: integer = 1);
3737var
3738 ErrMsg: string;
3739begin
[829]3740 if fFrame.frmFrame.DLLActive = True then Exit;
[456]3741 if (EditingIndex > -1) and FChanged then
3742 begin
3743 StatusText('Autosaving note...');
3744 //PutTextOnly(ErrMsg, memResults.Lines, lstNotes.GetIEN(EditingIndex));
3745 timAutoSave.Enabled := False;
3746 try
3747 SetText(ErrMsg, memResults.Lines, lstNotes.GetIEN(EditingIndex), Suppress);
3748 finally
3749 timAutoSave.Enabled := True;
3750 end;
3751 FChanged := False;
3752 StatusText('');
3753 end;
3754 if ErrMsg <> '' then
3755 InfoBox(TX_SAVE_ERROR1 + ErrMsg + TX_SAVE_ERROR2, TC_SAVE_ERROR, MB_OK or MB_ICONWARNING);
3756 //Assert(ErrMsg = '', 'AutoSave: ' + ErrMsg);
3757end;
3758
[829]3759procedure TfrmConsults.DoLeftPanelCustomShiftTab;
3760begin
3761 if ShiftTabIsPressed then begin
3762 FocusToRightPanel := True;
3763 FindNextControl(frmFrame.pnlPatient, False, True, False).SetFocus;
3764 end;
3765end;
3766
[456]3767procedure TfrmConsults.cmdChangeClick(Sender: TObject);
3768var
3769 LastTitle, LastConsult: Integer;
3770 (*OKPressed, *)IsIDChild, UseClinProcTitles: Boolean;
3771 x, AClassName: string;
3772begin
3773 inherited;
3774 FcmdChangeOKPressed := False;
3775 IsIDChild := uIDNotesActive and (FEditNote.IDParent > 0);
3776 LastTitle := FEditNote.Title;
3777 LastConsult := FEditNote.PkgIEN;
3778 with MenuAccessRec do
3779 UseClinProcTitles := ((IsClinicalProcedure) and
3780 (ClinProcFlag in [CP_NO_INSTRUMENT, CP_INSTR_INCOMPLETE, CP_INSTR_COMPLETE]));
3781 if UseClinProcTitles then AClassName := DCL_CLINPROC else AClassName := DCL_CONSULTS;
3782 if Sender <> Self then
3783 FcmdChangeOKPressed := ExecuteNoteProperties(FEditNote, CT_CONSULTS, IsIDChild, False, AClassName,
3784 MenuAccessRec.ClinProcFlag)
3785 else FcmdChangeOKPressed := True;
3786 if not FcmdChangeOKPressed then Exit;
3787 // update display fields & uPCEEdit
3788 lblNewTitle.Caption := ' ' + FEditNote.TitleName + ' ';
3789 if (FEditNote.Addend > 0) and (CompareText(Copy(lblNewTitle.Caption, 2, 8), 'Addendum') <> 0)
3790 then lblNewTitle.Caption := ' Addendum to:' + lblNewTitle.Caption;
3791 with lblNewTitle do bvlNewTitle.SetBounds(Left - 1, Top - 1, Width + 2, Height + 2);
3792 lblRefDate.Caption := FormatFMDateTime('mmm dd,yyyy@hh:nn', FEditNote.DateTime);
3793 lblAuthor.Caption := FEditNote.AuthorName;
3794 if uPCEEdit.Inpatient then x := 'Adm: ' else x := 'Vst: ';
3795 x := x + FormatFMDateTime('mm/dd/yy', FEditNote.VisitDate) + ' ' + FEditNote.LocationName;
3796 lblVisit.Caption := x;
3797 if Length(FEditNote.CosignerName) > 0
3798 then lblCosigner.Caption := 'Expected Cosigner: ' + FEditNote.CosignerName
3799 else lblCosigner.Caption := '';
3800 uPCEEdit.NoteTitle := FEditNote.Title;
3801 // modify signature requirements if author or cosigner changed
3802 if (User.DUZ <> FEditNote.Author) and (User.DUZ <> FEditNote.Cosigner)
3803 then Changes.ReplaceSignState(CH_CON, lstNotes.ItemID, CH_SIGN_NA)
3804 else Changes.ReplaceSignState(CH_CON, lstNotes.ItemID, CH_SIGN_YES);
3805 x := lstNotes.Items[EditingIndex];
3806 SetPiece(x, U, 2, lblNewTitle.Caption);
3807 SetPiece(x, U, 3, FloatToStr(FEditNote.DateTime));
3808 tvCsltNotes.Selected.Text := MakeConsultNoteDisplayText(x);
3809 TORTreeNode(tvCsltNotes.Selected).StringData := x;
3810 lstNotes.Items[EditingIndex] := x;
3811 Changes.ReplaceText(CH_CON, lstNotes.ItemID, GetTitleText(EditingIndex));
3812 if LastConsult <> FEditNote.PkgIEN then
3813 //if LastConsult <> FEditNote.Consult then
3814 begin
3815 // try to lock the new consult, reset to previous if unable
3816 if (FEditNote.PkgIEN > 0) and not LockConsultRequest(FEditNote.PkgIEN) then
3817 //if (FEditNote.Consult > 0) and not LockConsultRequest(FEditNote.Consult) then
3818 begin
3819 Infobox(TX_NO_ORD_CHG, TC_NO_ORD_CHG, MB_OK);
3820 FEditNote.PkgIEN := LastConsult;
3821 //FEditNote.Consult := LastConsult;
3822 end else
3823 begin
3824 // unlock the previous consult
3825 if LastConsult > 0 then UnlockOrderIfAble(GetConsultOrderIEN(LastConsult));
3826 if FEditNote.PkgIEN = 0 then FOrderID := '';
3827 //if FEditNote.Consult = 0 then FOrderID := '';
3828 end;
3829 end;
3830 if LastTitle <> FEditNote.Title then mnuActLoadBoilerClick(Self);
3831end;
3832
3833procedure TfrmConsults.pnlFieldsResize(Sender: TObject);
3834{ center the reference date on the panel }
3835begin
3836 inherited;
3837 lblRefDate.Left := (pnlFields.Width - lblRefDate.Width) div 2;
3838 if lblRefDate.Left < (lblNewTitle.Left + lblNewTitle.Width + 6)
3839 then lblRefDate.Left := (lblNewTitle.Left + lblNewTitle.Width);
3840end;
3841
3842
3843procedure TfrmConsults.AssignRemForm;
3844begin
3845 with RemForm do
3846 begin
3847 Form := Self;
3848 PCEObj := uPCEEdit;
3849 RightPanel := pnlRight;
3850 CanFinishProc := CanFinishReminder;
3851 DisplayPCEProc := DisplayPCE;
3852 Drawers := frmDrawers;
3853 NewNoteRE := memResults;
3854 NoteList := lstNotes;
3855 end;
3856end;
3857
3858function TfrmConsults.CanFinishReminder: boolean;
3859begin
3860 if(EditingIndex < 0) then
3861 Result := FALSE
3862 else
3863 Result := (lstNotes.ItemIndex = EditingIndex);
3864end;
3865
3866procedure TfrmConsults.mnuActChangeClick(Sender: TObject);
3867begin
3868 inherited;
3869 if (FEditingIndex < 0) or (lstNotes.ItemIndex <> FEditingIndex) then Exit;
3870 cmdChangeClick(Sender);
3871end;
3872
3873procedure TfrmConsults.mnuActLoadBoilerClick(Sender: TObject);
3874var
3875 NoteEmpty: Boolean;
3876 BoilerText: TStringList;
3877 DocInfo: string;
3878
3879 procedure AssignBoilerText;
3880 begin
3881 ExecuteTemplateOrBoilerPlate(BoilerText, FEditNote.Title, ltTitle, Self, 'Title: ' + FEditNote.TitleName, DocInfo);
[829]3882 QuickCopyWith508Msg(BoilerText, memResults);
[456]3883 FChanged := False;
3884 end;
3885
3886begin
3887 inherited;
3888 if (FEditingIndex < 0) or (lstNotes.ItemIndex <> FEditingIndex) then Exit;
3889 BoilerText := TStringList.Create;
3890 try
3891 NoteEmpty := memResults.Text = '';
3892 LoadBoilerPlate(BoilerText, FEditNote.Title);
3893 if (BoilerText.Text <> '') or
3894 assigned(GetLinkedTemplate(IntToStr(FEditNote.Title), ltTitle)) then
3895 begin
3896 DocInfo := MakeXMLParamTIU(IntToStr(lstNotes.ItemIEN), FEditNote);
3897 if NoteEmpty then AssignBoilerText else
3898 begin
3899 case QueryBoilerPlate(BoilerText) of
3900 0: { do nothing } ; // ignore
3901 1: begin
3902 ExecuteTemplateOrBoilerPlate(BoilerText, FEditNote.Title, ltTitle, Self, 'Title: ' + FEditNote.TitleName, DocInfo);
[829]3903 QuickCopyWith508Msg(BoilerText, memResults); // append
[456]3904 end;
3905 2: AssignBoilerText; // replace
3906 end;
3907 end;
3908 end else
3909 begin
3910 if Sender = mnuActLoadBoiler
3911 then InfoBox(TX_NO_BOIL, TC_NO_BOIL, MB_OK)
3912 else
3913 begin
3914 if not NoteEmpty then
3915 if not FChanged and (InfoBox(TX_BLR_CLEAR, TC_BLR_CLEAR, MB_YESNO) = ID_YES)
3916 then memResults.Lines.Clear;
3917 end;
3918 end; {if BoilerText.Text <> ''}
3919 finally
3920 BoilerText.Free;
3921 end;
3922end;
3923
3924procedure TfrmConsults.popNoteMemoSaveContinueClick(Sender: TObject);
3925begin
3926 inherited;
3927 FChanged := True;
3928 DoAutoSave;
3929end;
3930
3931procedure TfrmConsults.ProcessMedResults(ActionType: string);
3932var
3933 FormTitle, ErrMsg: string;
3934 (*i, *)AConsult: integer;
3935const
3936 TX_ATTACH = 'Attach Medicine Result to: ';
3937 TX_REMOVE = 'Remove Medicine Result from: ';
3938 TX_NO_ATTACH_RESULTS = 'There are no results available to associate with this procedure.';
3939 TX_NO_REMOVE_RESULTS = 'There are no medicine results currently associated with this procedure.';
3940 TC_NO_RESULTS = 'No Results';
3941begin
3942 inherited;
3943 with lstConsults, MedResult do
3944 begin
3945 FillChar(MedResult, SizeOf(MedResult), 0);
3946 if ItemIEN = 0 then Exit;
3947 AConsult := ItemIEN;
3948 if not LockConsultRequest(AConsult) then Exit;
3949 lstNotes.Enabled := False ;
3950 lstConsults.Enabled := False ;
3951 tvConsults.Enabled := False;
3952 if ActionType = 'ATTACH' then
3953 begin
3954 FormTitle := TX_ATTACH + Piece(DisplayText[ItemIndex], #9, 3);
3955 ErrMsg := TX_NO_ATTACH_RESULTS;
3956 end
3957 else if ActionType = 'REMOVE' then
3958 begin
3959 FormTitle := TX_REMOVE + Piece(DisplayText[ItemIndex], #9, 3);
3960 ErrMsg := TX_NO_REMOVE_RESULTS;
3961 end;
3962 Action := ActionType;
3963 if SelectMedicineResult(ItemIEN, FormTitle, MedResult) then
3964 begin
3965 if ResultPtr <> '' then
3966 begin
3967 if ActionType = 'ATTACH' then
3968 AttachMedicineResult(ItemIEN, ResultPtr, DateTimeofAction, ResponsiblePerson, AlertsTo.Recipients)
3969 else if ActionType = 'REMOVE' then
3970 RemoveMedicineResult(ItemIEN, ResultPtr, DateTimeofAction, ResponsiblePerson);
3971 UpdateList ; {update consult list after success}
3972 ItemIndex := 0 ;
3973 {ItemIndex may have changed - need to look up by IEN}
3974 with tvConsults do Selected := FindPieceNode(IntToStr(AConsult), 1, U, Items.GetFirstNode);
3975 tvConsultsClick(Self);
3976 end
3977 else
3978 InfoBox(ErrMsg, TC_NO_RESULTS, MB_OK or MB_ICONWARNING);
3979 end;
3980 end;
3981 lstNotes.Enabled := True ;
3982 lstConsults.Enabled := True ;
3983 tvConsults.Enabled := True;
3984 FOrderID := GetConsultOrderIEN(AConsult);
3985 UnlockOrderIfAble(FOrderID);
3986 FOrderID := '';
3987end;
3988
3989procedure TfrmConsults.mnuActAttachMedClick(Sender: TObject);
3990begin
3991 inherited;
3992 ProcessMedResults('ATTACH');
3993end;
3994
3995procedure TfrmConsults.mnuActRemoveMedClick(Sender: TObject);
3996begin
3997 inherited;
3998 ProcessMedResults('REMOVE');
3999end;
4000
4001procedure TfrmConsults.mnuEditDialgFieldsClick(Sender: TObject);
4002begin
4003 inherited;
4004 EditDialogFields;
4005end;
4006
4007procedure TfrmConsults.UpdateNoteTreeView(DocList: TStringList; Tree: TORTreeView; AContext: integer);
4008var
4009 i: integer;
4010begin
4011 with Tree do
4012 begin
4013 uChanging := True;
4014 Items.BeginUpdate;
4015 for i := 0 to DocList.Count - 1 do
4016 begin
4017 if Piece(DocList[i], U, 14) = '0' then continue; // v16.8 fix RV
4018 //if Piece(DocList[i], U, 14) <> IntToStr(AContext) then continue;
4019 lstNotes.Items.Add(DocList[i]);
4020 end;
4021 FCurrentNoteContext.Status := IntToStr(AContext);
4022 BuildDocumentTree(DocList, '0', Tree, nil, FCurrentNoteContext, CT_CONSULTS);
4023 Items.EndUpdate;
4024 uChanging := False;
4025 end;
4026end;
4027
4028procedure TfrmConsults.tvCsltNotesChange(Sender: TObject; Node: TTreeNode);
4029var
4030 x, WhyNot: string;
4031begin
4032 if uChanging then Exit;
4033 //This gives the change a chance to occur when keyboarding, so that WindowEyes
4034 //doesn't use the old value.
4035 Application.ProcessMessages;
4036 with tvCsltNotes do
4037 begin
4038 if (Selected = nil) then Exit;
4039 if uIDNotesActive then
4040 begin
4041 mnuActDetachFromIDParent.Enabled := (Selected.ImageIndex in [IMG_ID_CHILD, IMG_ID_CHILD_ADD]);
4042 popNoteListDetachFromIDParent.Enabled := mnuActDetachFromIDParent.Enabled;
4043 if (Selected.ImageIndex in [IMG_SINGLE, IMG_PARENT, IMG_ID_CHILD, IMG_ID_CHILD_ADD]) then
4044 mnuActAttachtoIDParent.Enabled := CanBeAttached(PDocTreeObject(Selected.Data)^.DocID, WhyNot)
4045 else
4046 mnuActAttachtoIDParent.Enabled := False;
4047 popNoteListAttachtoIDParent.Enabled := mnuActAttachtoIDParent.Enabled;
4048 if (Selected.ImageIndex in [IMG_SINGLE, IMG_PARENT,
4049 IMG_IDNOTE_OPEN, IMG_IDNOTE_SHUT,
4050 IMG_IDPAR_ADDENDA_OPEN, IMG_IDPAR_ADDENDA_SHUT]) then
4051 mnuActAddIDEntry.Enabled := CanReceiveAttachment(PDocTreeObject(Selected.Data)^.DocID, WhyNot)
4052 else
4053 mnuActAddIDEntry.Enabled := False;
4054 popNoteListAddIDEntry.Enabled := mnuActAddIDEntry.Enabled
4055 end;
4056 popNoteListExpandSelected.Enabled := Selected.HasChildren;
4057 popNoteListCollapseSelected.Enabled := Selected.HasChildren;
4058 if (Selected.ImageIndex = IMG_TOP_LEVEL) then
4059 begin
4060 pnlResults.Visible := False;
4061 pnlResults.SendToBack;
4062 pnlRead.Visible := True;
4063 pnlRead.BringToFront ;
4064 memConsult.TabStop := True;
4065 UpdateReminderFinish;
4066 ShowPCEControls(False);
4067 frmDrawers.DisplayDrawers(FALSE);
4068 cmdPCE.Visible := FALSE;
4069 popNoteMemoEncounter.Visible := FALSE;
4070 lstConsults.Enabled := True ;
4071 tvConsults.Enabled := True;
4072 lstNotes.Enabled := True;
4073 lblTitle.Caption := '';
4074 lblTitle.Hint := lblTitle.Caption;
4075 Exit;
4076 end;
4077 x := TORTreeNode(Selected).StringData;
4078 if StrToIntDef(Piece(Piece(x, U, 1), ';', 1), 0) > 0 then
4079 begin
4080 memConsult.Clear;
4081 lstNotes.SelectByID(Piece(x, U, 1));
4082 lstNotesClick(Self);
4083 SendMessage(memConsult.Handle, WM_VSCROLL, SB_TOP, 0);
4084 end;
4085 end;
4086end;
4087
4088procedure TfrmConsults.tvCsltNotesCollapsed(Sender: TObject; Node: TTreeNode);
4089begin
4090 with Node do
4091 begin
4092 if (ImageIndex in [IMG_GROUP_OPEN, IMG_IDNOTE_OPEN, IMG_IDPAR_ADDENDA_OPEN]) then
4093 ImageIndex := ImageIndex - 1;
4094 if (SelectedIndex in [IMG_GROUP_OPEN, IMG_IDNOTE_OPEN, IMG_IDPAR_ADDENDA_OPEN]) then
4095 SelectedIndex := SelectedIndex - 1;
4096 end;
4097end;
4098
4099procedure TfrmConsults.tvCsltNotesExpanded(Sender: TObject; Node: TTreeNode);
4100
4101 function SortByTitle(Node1, Node2: TTreeNode; Data: Longint): Integer; stdcall;
4102 begin
4103 { Within an ID parent node, sorts in ascending order by title
4104 BUT - addenda to parent document are always at the top of the sort, in date order}
4105 if (Copy(PDocTreeObject(Node1.Data)^.DocTitle, 1, 8) = 'Addendum') and
4106 (Copy(PDocTreeObject(Node2.Data)^.DocTitle, 1, 8) = 'Addendum') then
4107 begin
4108 Result := AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocFMDate),
4109 PChar(PDocTreeObject(Node2.Data)^.DocFMDate));
4110 end
4111 else if Copy(PDocTreeObject(Node1.Data)^.DocTitle, 1, 8) = 'Addendum' then Result := -1
4112 else if Copy(PDocTreeObject(Node2.Data)^.DocTitle, 1, 8) = 'Addendum' then Result := 1
4113 else
4114 begin
4115 if Data = 0 then
4116 Result := AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocTitle),
4117 PChar(PDocTreeObject(Node2.Data)^.DocTitle))
4118 else
4119 Result := -AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocTitle),
4120 PChar(PDocTreeObject(Node2.Data)^.DocTitle));
4121 end
4122 end;
4123
4124 function SortByDate(Node1, Node2: TTreeNode; Data: Longint): Integer; stdcall;
4125 begin
4126 { Within an ID parent node, sorts in ascending order by document date
4127 BUT - addenda to parent document are always at the top of the sort, in date order}
4128 if (Copy(PDocTreeObject(Node1.Data)^.DocTitle, 1, 8) = 'Addendum') and
4129 (Copy(PDocTreeObject(Node2.Data)^.DocTitle, 1, 8) = 'Addendum') then
4130 begin
4131 Result := AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocFMDate),
4132 PChar(PDocTreeObject(Node2.Data)^.DocFMDate));
4133 end
4134 else if Copy(PDocTreeObject(Node1.Data)^.DocTitle, 1, 8) = 'Addendum' then Result := -1
4135 else if Copy(PDocTreeObject(Node2.Data)^.DocTitle, 1, 8) = 'Addendum' then Result := 1
4136 else
4137 begin
4138 if Data = 0 then
4139 Result := AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocFMDate),
4140 PChar(PDocTreeObject(Node2.Data)^.DocFMDate))
4141 else
4142 Result := -AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocFMDate),
4143 PChar(PDocTreeObject(Node2.Data)^.DocFMDate));
4144 end;
4145 end;
4146
4147begin
4148 with Node do
4149 begin
4150 if Assigned(Data) then
4151 if (Pos('<', PDocTreeObject(Data)^.DocHasChildren) > 0) then
4152 begin
4153 if (PDocTreeObject(Node.Data)^.OrderByTitle) then
4154 CustomSort(@SortByTitle, 0)
4155 else
4156 CustomSort(@SortByDate, 0);
4157 end;
4158 if (ImageIndex in [IMG_GROUP_SHUT, IMG_IDNOTE_SHUT, IMG_IDPAR_ADDENDA_SHUT]) then
4159 ImageIndex := ImageIndex + 1;
4160 if (SelectedIndex in [IMG_GROUP_SHUT, IMG_IDNOTE_SHUT, IMG_IDPAR_ADDENDA_SHUT]) then
4161 SelectedIndex := SelectedIndex + 1;
4162 end;
4163end;
4164
4165procedure TfrmConsults.tvCsltNotesDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
4166var
4167 AnItem: TORTreeNode;
4168begin
4169 Accept := False;
4170 if not uIDNotesActive then exit;
4171 AnItem := TORTreeNode(tvCsltNotes.GetNodeAt(X, Y));
4172 if (AnItem = nil) or (AnItem.ImageIndex in [IMG_GROUP_OPEN, IMG_GROUP_SHUT, IMG_TOP_LEVEL]) then Exit;
4173 with tvCsltNotes.Selected do
4174 if (ImageIndex in [IMG_SINGLE, IMG_PARENT, IMG_ID_CHILD, IMG_ID_CHILD_ADD]) then
4175 Accept := (AnItem.ImageIndex in [IMG_SINGLE, IMG_PARENT,
4176 IMG_IDNOTE_OPEN, IMG_IDNOTE_SHUT,
4177 IMG_IDPAR_ADDENDA_OPEN, IMG_IDPAR_ADDENDA_SHUT])
4178 else if (ImageIndex in [IMG_IDNOTE_OPEN, IMG_IDNOTE_SHUT, IMG_IDPAR_ADDENDA_OPEN, IMG_IDPAR_ADDENDA_SHUT]) then
4179 Accept := (AnItem.ImageIndex in [IMG_GROUP_OPEN, IMG_GROUP_SHUT, IMG_TOP_LEVEL])
4180 else if (ImageIndex in [IMG_ADDENDUM, IMG_GROUP_OPEN, IMG_GROUP_SHUT, IMG_TOP_LEVEL]) then
4181 Accept := False;
4182end;
4183
4184procedure TfrmConsults.tvCsltNotesDragDrop(Sender, Source: TObject; X, Y: Integer);
4185var
4186 HT: THitTests;
4187 ADestNode: TORTreeNode;
4188 Saved: boolean;
4189begin
4190 if not uIDNotesActive then
4191 begin
4192 CancelDrag;
4193 exit;
4194 end;
4195 if tvCsltNotes.Selected = nil then exit;
4196 if EditingIndex <> -1 then
4197 begin
4198 SaveCurrentNote(Saved);
4199 if not Saved then Exit;
4200 end;
4201 HT := tvCsltNotes.GetHitTestInfoAt(X, Y);
4202 ADestNode := TORTreeNode(tvCsltNotes.GetNodeAt(X, Y));
4203 DoAttachIDChild(TORTreeNode(tvCsltNotes.Selected), ADestNode);
4204end;
4205
4206procedure TfrmConsults.tvCsltNotesStartDrag(Sender: TObject;
4207 var DragObject: TDragObject);
4208const
4209 TX_CAP_NO_DRAG = 'Item cannot be moved';
4210 var
4211 WhyNot: string;
4212 Saved: boolean;
4213begin
4214 if (tvCsltNotes.Selected.ImageIndex in [IMG_ADDENDUM, IMG_GROUP_OPEN, IMG_GROUP_SHUT, IMG_TOP_LEVEL]) or
4215 (not uIDNotesActive) or
4216 (lstNotes.ItemIEN = 0) then
4217 begin
4218 CancelDrag;
4219 Exit;
4220 end;
4221 if EditingIndex <> -1 then
4222 begin
4223 SaveCurrentNote(Saved);
4224 if not Saved then Exit;
4225 end;
4226 if not CanBeAttached(PDocTreeObject(tvCsltNotes.Selected.Data)^.DocID, WhyNot) then
4227 begin
4228 InfoBox(WhyNot, TX_CAP_NO_DRAG, MB_OK);
4229 CancelDrag;
4230 end;
4231end;
4232
4233procedure TfrmConsults.popNoteListExpandAllClick(Sender: TObject);
4234begin
4235 inherited;
4236 if PopupComponent(Sender, popNoteList) is TTreeView then
4237 TTreeView(PopupComponent(Sender, popNoteList)).FullExpand;
4238end;
4239
4240procedure TfrmConsults.popNoteListCollapseAllClick(Sender: TObject);
4241begin
4242 inherited;
4243 if PopupComponent(Sender, popNoteList) is TTreeView then
4244 with TTreeView(PopupComponent(Sender, popNoteList)) do
4245 begin
4246 Selected := nil;
4247 FullCollapse;
4248 Selected := TopItem;
4249 end;
4250 lblTitle.Caption := '';
4251 lblTitle.Hint := lblTitle.Caption;
4252 memConsult.Clear;
4253end;
4254
4255procedure TfrmConsults.popNoteListExpandSelectedClick(Sender: TObject);
4256begin
4257 inherited;
4258 if PopupComponent(Sender, popNoteList) is TTreeView then
4259 with TTreeView(PopupComponent(Sender, popNoteList)) do
4260 begin
4261 if Selected = nil then exit;
4262 with Selected do if HasChildren then Expand(True);
4263 end;
4264end;
4265
4266procedure TfrmConsults.popNoteListCollapseSelectedClick(Sender: TObject);
4267begin
4268 inherited;
4269 if PopupComponent(Sender, popNoteList) is TTreeView then
4270 with TTreeView(PopupComponent(Sender, popNoteList)) do
4271 begin
4272 if Selected = nil then exit;
4273 with Selected do if HasChildren then Collapse(True);
4274 end;
4275end;
4276
4277procedure TfrmConsults.EnableDisableIDNotes;
4278begin
4279 uIDNotesActive := False; //IDNotesInstalled; {not for Consults in v15}
4280 mnuActDetachFromIDParent.Visible := uIDNotesActive;
4281 popNoteListDetachFromIDParent.Visible := uIDNotesActive;
4282 mnuActAddIDEntry.Visible := uIDNotesActive;
4283 popNoteListAddIDEntry.Visible := uIDNotesActive;
4284 mnuActAttachtoIDParent.Visible := uIDNotesActive;
4285 popNoteListAttachtoIDParent.Visible := uIDNotesActive;
4286 if uIDNotesActive then
4287 tvCsltNotes.DragMode := dmAutomatic
4288 else
4289 tvCsltNotes.DragMode := dmManual;
4290end;
4291
4292
4293procedure TfrmConsults.tvCsltNotesClick(Sender: TObject);
4294begin
4295 inherited;
4296 if tvCsltNotes.Selected = nil then exit;
4297 if (tvCsltNotes.Selected.ImageIndex in [IMG_TOP_LEVEL, IMG_GROUP_OPEN, IMG_GROUP_SHUT]) then
4298 begin
4299 lblTitle.Caption := '';
4300 lblTitle.Hint := lblTitle.Caption;
4301 memConsult.Clear;
4302 end;
4303end;
4304
4305// =========================== Consults Treeview Code ==================================
4306
4307procedure TfrmConsults.LoadConsults;
4308var
4309 tmpList: TStringList;
4310 ANode: TTreeNode;
4311begin
4312 tmpList := TStringList.Create;
4313 try
4314
4315 FCsltList.Clear;
4316 uChanging := True;
4317 RedrawSuspend(memConsult.Handle);
4318 tvConsults.Items.BeginUpdate;
4319 lstConsults.Items.Clear;
4320 KillDocTreeObjects(tvConsults);
4321 tvConsults.Items.Clear;
4322 tvConsults.Items.EndUpdate;
4323 tvCsltNotes.Items.BeginUpdate;
4324 KillDocTreeObjects(tvCsltNotes);
4325 tvCsltNotes.Items.Clear;
4326 tvCsltNotes.Items.EndUpdate;
4327 lstNotes.Clear;
4328 memConsult.Clear;
4329 memConsult.Invalidate;
4330 lblTitle.Caption := '';
4331 lblTitle.Hint := lblTitle.Caption;
4332 with FCurrentContext do
4333 begin
4334 GetConsultsList(tmpList, StrToFMDateTime(BeginDate), StrToFMDateTime(EndDate), Service, Status, Ascending);
4335 CreateListItemsforConsultTree(FCsltList, tmpList, ViewContext, GroupBy, Ascending);
4336 UpdateConsultsTreeView(FCsltList, tvConsults);
[829]4337 FastAssign(tmpList, lstConsults.Items);
[456]4338 end;
4339 with tvConsults do
4340 begin
4341 uChanging := True;
4342 Items.BeginUpdate;
4343 ANode := Items.GetFirstNode;
4344 if ANode <> nil then Selected := ANode.getFirstChild;
4345 memConsult.Clear;
4346 //RemoveParentsWithNoChildren(tvConsults, FCurrentContext);
4347 Items.EndUpdate;
4348 uChanging := False;
4349 if (Self.Active) and (Selected <> nil) then tvConsultsChange(Self, Selected);
4350 end;
4351 finally
4352 RedrawActivate(memConsult.Handle);
4353 tmpList.Free;
4354 end;
4355end;
4356
4357procedure TfrmConsults.UpdateConsultsTreeView(DocList: TStringList; Tree: TORTreeView);
4358begin
4359 with Tree do
4360 begin
4361 uChanging := True;
4362 Items.BeginUpdate;
[829]4363 FastAddStrings(DocList, lstConsults.Items);
[456]4364 BuildConsultsTree(Tree, DocList, '0', nil, FCurrentContext);
4365 Items.EndUpdate;
4366 uChanging := False;
4367 end;
4368end;
4369
4370procedure TfrmConsults.tvConsultsExpanded(Sender: TObject; Node: TTreeNode);
4371begin
4372 inherited;
4373 with Node do
4374 begin
4375 if (ImageIndex in [IMG_GMRC_GROUP_SHUT]) then
4376 ImageIndex := ImageIndex + 1;
4377 if (SelectedIndex in [IMG_GMRC_GROUP_SHUT]) then
4378 SelectedIndex := SelectedIndex + 1;
4379 end;
4380end;
4381
4382procedure TfrmConsults.tvConsultsCollapsed(Sender: TObject; Node: TTreeNode);
4383begin
4384 inherited;
4385 with Node do
4386 begin
4387 if (ImageIndex in [IMG_GMRC_GROUP_OPEN]) then
4388 ImageIndex := ImageIndex - 1;
4389 if (SelectedIndex in [IMG_GMRC_GROUP_OPEN]) then
4390 SelectedIndex := SelectedIndex - 1;
4391 end;
4392end;
4393
4394procedure TfrmConsults.tvConsultsClick(Sender: TObject);
4395begin
4396 inherited;
4397 with tvConsults do
4398 begin
4399 if Selected = nil then exit;
4400 if (Selected.ImageIndex in [IMG_GMRC_TOP_LEVEL, IMG_GMRC_GROUP_OPEN, IMG_GMRC_GROUP_SHUT]) then
4401 begin
4402 lblTitle.Caption := '';
4403 lblTitle.Hint := lblTitle.Caption;
4404 memConsult.Clear;
4405 KillDocTreeObjects(tvCsltNotes);
4406 tvCsltNotes.Items.Clear;
4407 lstNotes.Items.Clear;
4408 end
4409 else
4410 tvConsultsChange(Self, Selected);
4411 end;
4412end;
4413
4414procedure TfrmConsults.tvConsultsChange(Sender: TObject; Node: TTreeNode);
4415var
4416 x: string;
4417begin
4418 inherited;
4419 if uChanging then Exit;
4420 with tvConsults do
4421 begin
4422 if (Selected = nil) then Exit;
4423 if (tvConsults.Selected.ImageIndex in [IMG_GMRC_TOP_LEVEL, IMG_GMRC_GROUP_OPEN, IMG_GMRC_GROUP_SHUT]) then
4424 begin
4425 mnuActConsultRequest.Enabled := False;
4426 mnuActConsultResults.Enabled := False;
4427 frmFrame.mnuFilePrint.Enabled := False;
4428 frmFrame.mnuFilePrintSelectedItems.Enabled := False;
4429 end
4430 else
4431 begin
4432 frmFrame.mnuFilePrint.Enabled := True;
4433 frmFrame.mnuFilePrintSelectedItems.Enabled := True;
4434 end;
4435 popNoteListExpandSelected.Enabled := Selected.HasChildren;
4436 popNoteListCollapseSelected.Enabled := Selected.HasChildren;
4437 lstConsults.Enabled := True ;
4438 tvConsults.Enabled := True;
4439 lstNotes.Enabled := True;
4440 if (Selected.ImageIndex in [IMG_GMRC_TOP_LEVEL, IMG_GMRC_GROUP_OPEN, IMG_GMRC_GROUP_SHUT]) then
4441 begin
4442 pnlResults.Visible := False;
4443 pnlResults.SendToBack;
4444 pnlRead.Visible := True;
4445 pnlRead.BringToFront ;
4446 memConsult.TabStop := True;
4447 UpdateReminderFinish;
4448 ShowPCEControls(False);
4449 frmDrawers.DisplayDrawers(FALSE);
4450 cmdPCE.Visible := FALSE;
4451 popNoteMemoEncounter.Visible := FALSE;
4452 lstConsults.Enabled := True ;
4453 tvConsults.Enabled := True;
4454 KillDocTreeObjects(tvCsltNotes);
4455 tvCsltNotes.Items.Clear;
4456 lstNotes.Clear;
4457 lstNotes.Enabled := True;
4458 lblTitle.Caption := '';
4459 lblTitle.Hint := lblTitle.Caption;
4460 Exit;
4461 end;
4462 x := TORTreeNode(Selected).StringData;
4463 if StrToIntDef(Piece(x, U, 1), 0) > 0 then
4464 begin
4465 memConsult.Clear;
4466 lstConsults.SelectByID(Piece(x, U, 1));
4467 lstConsultsClick(Self);
4468 //tvConsults.SetFocus;
4469 SendMessage(memConsult.Handle, WM_VSCROLL, SB_TOP, 0);
4470 end;
4471 end;
4472end;
4473
4474procedure TfrmConsults.popNoteListPopup(Sender: TObject);
4475var
4476 ShowIt: boolean;
4477begin
4478 inherited;
4479 ShowIt := uIDNotesActive and (PopupComponent(Sender, popNoteList) = tvCsltNotes);
4480 popNoteListDetachFromIDParent.Visible := ShowIt;
4481 popNoteListAddIDEntry.Visible := ShowIt;
4482end;
4483
4484procedure TfrmConsults.mnuIconLegendClick(Sender: TObject);
4485begin
4486 inherited;
4487 ShowIconLegend(ilConsults);
4488end;
4489
4490procedure TfrmConsults.mnuActAttachtoIDParentClick(Sender: TObject);
4491var
4492 AChildNode: TORTreeNode;
4493 AParentID: string;
4494 Saved: boolean;
4495 SavedDocID, SavedConsultID: string;
4496begin
4497 if lstNotes.ItemIEN = 0 then exit;
4498 SavedDocID := lstNotes.ItemID;
4499 if EditingIndex <> -1 then
4500 begin
4501 SaveCurrentNote(Saved);
4502 if not Saved then Exit;
4503 with tvConsults do Selected := FindPieceNode(SavedConsultID, 1, U, Items.GetFirstNode);
4504 tvConsultsClick(Self);
4505 with tvCsltNotes do Selected := FindPieceNode(SavedDocID, 1, U, Items.GetFirstNode);
4506 end;
4507 if tvCsltNotes.Selected = nil then exit;
4508 AChildNode := TORTreeNode(tvCsltNotes.Selected);
4509 AParentID := SelectParentNodeFromList(tvCsltNotes);
4510 if AParentID = '' then exit;
4511 with tvCsltNotes do Selected := FindPieceNode(AParentID, 1, U, Items.GetFirstNode);
4512 DoAttachIDChild(AChildNode, TORTreeNode(tvCsltNotes.Selected));
4513end;
4514
4515procedure TfrmConsults.DoAttachIDChild(AChild, AParent: TORTreeNode);
4516const
4517 TX_ATTACH_CNF = 'Confirm Attachment';
4518 TX_ATTACH_FAILURE = 'Attachment failed';
4519var
4520 ErrMsg, WhyNot: string;
4521 SavedDocID: string;
4522begin
4523 if (AChild = nil) or (AParent = nil) then exit;
4524 ErrMsg := '';
4525 if not CanBeAttached(PDocTreeObject(AChild.Data)^.DocID, WhyNot) then
4526 ErrMsg := ErrMsg + WhyNot + CRLF + CRLF;
4527 if not CanReceiveAttachment(PDocTreeObject(AParent.Data)^.DocID, WhyNot) then
4528 ErrMsg := ErrMsg + WhyNot;
4529 if ErrMsg <> '' then
4530 begin
4531 InfoBox(ErrMsg, TX_ATTACH_FAILURE, MB_OK);
4532 Exit;
4533 end
4534 else
4535 begin
4536 WhyNot := '';
4537 if (InfoBox('ATTACH: ' + AChild.Text + CRLF + CRLF +
4538 ' TO: ' + AParent.Text + CRLF + CRLF +
4539 'Are you sure?', TX_ATTACH_CNF, MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) <> IDYES)
4540 then Exit;
4541 SavedDocID := PDocTreeObject(AParent.Data)^.DocID;
4542 end;
4543 if AChild.ImageIndex in [IMG_ID_CHILD, IMG_ID_CHILD_ADD] then
4544 begin
4545 if DetachEntryFromParent(PDocTreeObject(AChild.Data)^.DocID, WhyNot) then
4546 begin
4547 if AttachEntryToParent(PDocTreeObject(AChild.Data)^.DocID, PDocTreeObject(AParent.Data)^.DocID, WhyNot) then
4548 begin
4549 tvConsultsChange(Self, tvConsults.Selected);
4550 with tvCsltNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
4551 if tvCsltNotes.Selected <> nil then tvCsltNotes.Selected.Expand(False);
4552 end
4553 else
4554 InfoBox(WhyNot, TX_ATTACH_FAILURE, MB_OK);
4555 end
4556 else
4557 begin
4558 WhyNot := StringReplace(WhyNot, 'ATTACH', 'DETACH', [rfIgnoreCase]);
4559 WhyNot := StringReplace(WhyNot, 'to an ID', 'from an ID', [rfIgnoreCase]);
4560 InfoBox(WhyNot, TX_DETACH_FAILURE, MB_OK);
4561 Exit;
4562 end;
4563 end
4564 else
4565 begin
4566 if AttachEntryToParent(PDocTreeObject(AChild.Data)^.DocID, PDocTreeObject(AParent.Data)^.DocID, WhyNot) then
4567 begin
4568 tvConsultsChange(Self, tvConsults.Selected);
4569 with tvCsltNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
4570 if tvCsltNotes.Selected <> nil then tvCsltNotes.Selected.Expand(False);
4571 end
4572 else
4573 InfoBox(WhyNot, TX_ATTACH_FAILURE, MB_OK);
4574 end;
4575end;
4576
4577procedure TfrmConsults.tvConsultsKeyUp(Sender: TObject; var Key: Word;
4578 Shift: TShiftState);
4579begin
4580 inherited;
4581 if Key in [VK_UP, VK_DOWN] then tvConsultsChange(Self, tvConsults.Selected);
4582end;
4583
4584function TfrmConsults.UserIsSigner(NoteIEN: integer): boolean;
4585var
4586 Signers: TStringList;
4587 i: integer;
4588begin
4589 Result := False;
4590 if NoteIEN <= 0 then exit;
4591 Signers := TStringList.Create;
4592 try
[829]4593 FastAssign(GetCurrentSigners(NoteIEN), Signers);
[456]4594 for i := 0 to Signers.Count - 1 do
4595 if Piece(Signers[i], U, 1) = IntToStr(User.DUZ) then
4596 begin
4597 Result := True;
4598 break;
4599 end;
4600 finally
4601 Signers.Free;
4602 end;
4603end;
4604
4605procedure TfrmConsults.memResultsKeyDown(Sender: TObject; var Key: Word;
4606 Shift: TShiftState);
4607begin
4608 inherited;
4609 if (Key = VK_TAB) then
4610 begin
4611 if ssShift in Shift then
4612 begin
4613 FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
4614 Key := 0;
4615 end
4616 else if ssCtrl in Shift then
4617 begin
4618 FindNextControl(Sender as TWinControl, True, True, False).SetFocus; //next control
4619 Key := 0;
4620 end;
4621 end;
4622 if (key = VK_ESCAPE) then begin
4623 FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
4624 key := 0;
4625 end;
4626end;
4627
4628procedure TfrmConsults.sptHorzCanResize(Sender: TObject; var NewSize: Integer;
4629 var Accept: Boolean);
4630begin
4631 inherited;
4632 if pnlResults.Visible then
4633 if NewSize > frmConsults.ClientWidth - memResults.Constraints.MinWidth - sptHorz.Width then
4634 NewSize := frmConsults.ClientWidth - memResults.Constraints.MinWidth - sptHorz.Width;
4635end;
4636
4637procedure TfrmConsults.popNoteMemoPreviewClick(Sender: TObject);
4638begin
4639 frmDrawers.mnuPreviewTemplateClick(Sender);
4640end;
4641
4642procedure TfrmConsults.popNoteMemoInsTemplateClick(Sender: TObject);
4643begin
4644 inherited;
4645 frmDrawers.mnuInsertTemplateClick(Sender);
4646end;
4647
4648procedure TfrmConsults.lstConsultsToPrint;
4649var
4650 AParentID: string;
4651 SavedDocID: string;
4652 Saved: boolean;
4653begin
4654 inherited;
4655 if lstConsults.ItemIEN = 0 then exit;
4656 SavedDocID := lstNotes.ItemID;
4657 if EditingIndex <> -1 then
4658 begin
4659 SaveCurrentNote(Saved);
4660 if not Saved then Exit;
4661 LoadConsults;
4662 with tvConsults do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
4663 end;
4664 if tvConsults.Selected = nil then exit;
4665 AParentID := frmPrintList.SelectParentFromList(tvConsults,CT_CONSULTS);
4666 if AParentID = '' then exit;
4667 with tvConsults do Selected := FindPieceNode(AParentID, 1, U, Items.GetFirstNode);
4668end;
4669
4670procedure TfrmConsults.tvConsultsExit(Sender: TObject);
4671begin
4672 inherited;
[829]4673 FocusToRightPanel := True;
4674 if TabIsPressed then
4675 FindNextControl(pnlLeft, False, True, False).SetFocus;
[456]4676end;
4677
4678procedure TfrmConsults.frmFramePnlPatientExit(Sender: TObject);
4679begin
4680 FOldFramePnlPatientExit(Sender);
[829]4681 if ShiftTabIsPressed then
4682 FindNextControl( pnlRight, False, True, False).SetFocus;
[456]4683end;
4684
4685procedure TfrmConsults.FormHide(Sender: TObject);
4686begin
4687 inherited;
4688 frmFrame.pnlPatient.OnExit := FOldFramePnlPatientExit;
4689end;
4690
4691procedure TfrmConsults.FormShow(Sender: TObject);
4692var
4693 i : integer;
4694begin
4695 inherited;
4696 FOldFramePnlPatientExit := frmFrame.pnlPatient.OnExit;
4697 frmFrame.pnlPatient.OnExit := frmFramePnlPatientExit;
4698 {Below is a fix for ClearQuest Defect HDS0000948, Kind of Kloogy I looked
4699 and looked for side effects and a better solution and this was the best!}
4700 if (EditingIndex = -1) or (lstNotes.ItemIndex <> EditingIndex) then
4701 frmDrawers.Hide;
4702 {This TStaticText I am looking for doesn't have a Name! So
4703 I have to loop through the panel's controls and disable the TStaticText.}
4704 with pnlAction do begin
4705 for i := 0 to (ControlCount -1) do
4706 begin
4707 if Controls[i] is TStaticText then
4708 if (Controls[i] as TStaticText).Caption = 'Consult Notes' then
4709 (Controls[i] as TStaticText).Enabled := False;
4710 end;
4711 end
4712 {End of ClearQuest Defect HDS0000948 Fixes}
4713end;
4714
4715procedure TfrmConsults.ViewInfo(Sender: TObject);
4716begin
4717 inherited;
4718 frmFrame.ViewInfo(Sender);
4719end;
4720
4721procedure TfrmConsults.mnuViewInformationClick(Sender: TObject);
4722begin
4723 inherited;
4724 mnuViewDemo.Enabled := frmFrame.pnlPatient.Enabled;
4725 mnuViewVisits.Enabled := frmFrame.pnlVisit.Enabled;
4726 mnuViewPrimaryCare.Enabled := frmFrame.pnlPrimaryCare.Enabled;
4727 mnuViewMyHealtheVet.Enabled := not (Copy(frmFrame.laMHV.Hint, 1, 2) = 'No');
4728 mnuInsurance.Enabled := not (Copy(frmFrame.laVAA2.Hint, 1, 2) = 'No');
4729 mnuViewFlags.Enabled := frmFrame.lblFlag.Enabled;
4730 mnuViewRemoteData.Enabled := frmFrame.lblCirn.Enabled;
4731 mnuViewReminders.Enabled := frmFrame.pnlReminders.Enabled;
4732 mnuViewPostings.Enabled := frmFrame.pnlPostings.Enabled;
4733end;
4734
4735initialization
[829]4736 SpecifyFormIsNotADialog(TfrmConsults);
[456]4737 uPCEEdit := TPCEData.Create;
4738 uPCEShow := TPCEData.Create;
4739
4740finalization
4741 uPCEEdit.Free;
4742 uPCEShow.Free;
4743
4744end.
Note: See TracBrowser for help on using the repository browser.