source: cprs/branches/tmg-cprs/CPRS-Chart/Consults/fConsults.pas@ 1035

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

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