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

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

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