source: cprs/trunk/CPRS-Chart/Encounter/fEncounterFrame.pas@ 1800

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

Updating the working copy to CPRS version 28
File size: 26.9 KB
Line 
1unit fEncounterFrame;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 Tabs, ComCtrls, ExtCtrls, Menus, StdCtrls, Buttons, fPCEBase,
8 fVisitType, fDiagnoses, fProcedure, fImmunization, fSkinTest, fPatientEd,
9 fHealthFactor, fExam, uPCE, rPCE, rTIU, ORCtrls, ORFn, fEncVitals, rvitals, fBase508Form,
10 VA508AccessibilityManager;
11
12const
13 //tab names
14 CT_VisitNm = 'Visit Type';
15 CT_DiagNm = 'Diagnoses';
16 CT_ProcNm = 'Procedures';
17 CT_ImmNm = 'Immunizations';
18 CT_SkinNm = 'Skin Tests';
19 CT_PedNm = 'Patient Ed';
20 CT_HlthNm = 'Health Factors';
21 CT_XamNm = 'Exams';
22 CT_VitNm = 'Vitals';
23 CT_GAFNm = 'GAF';
24
25 //numbers assigned to tabs to make changes easier
26 //they must be sequential
27 CT_NOPAGE = -1;
28 CT_UNKNOWN = 0;
29 CT_VISITTYPE = 1; CT_FIRST = 1;
30 CT_DIAGNOSES = 2;
31 CT_PROCEDURES = 3;
32 CT_IMMUNIZATIONS = 4;
33 CT_SKINTESTS = 5;
34 CT_PATIENTED = 6;
35 CT_HEALTHFACTORS = 7;
36 CT_EXAMS = 8;
37 CT_VITALS = 9;
38 CT_GAF = 10; CT_LAST = 10;
39
40 NUM_TABS = 3;
41 TAG_VTYPE = 10;
42 TAG_DIAG = 20;
43 TAG_PROC = 30;
44 TAG_IMMUNIZ = 40;
45 TAG_SKIN = 50;
46 TAG_PED = 60;
47 TAG_HF = 70;
48 TAG_XAM = 80;
49 TAG_TRT = 90;
50
51 TX_NOSECTION = '-1^No sections found';
52 TX_PROV_REQ = 'A primary encounter provider must be selected before encounter data can' + CRLF +
53 'be saved. Select the Primary Encounter Provider on the VISIT TYPE tab.' + CRLF +
54 'Otherwise, press <Cancel> to quit without saving data.';
55
56 TC_PROV_REQ = 'Missing Primary Provider for Encounter';
57
58type
59 TfrmEncounterFrame = class(TfrmBase508Form)
60 StatusBar1: TStatusBar;
61 pnlPage: TPanel;
62 Bevel1: TBevel;
63 TabControl: TTabControl;
64
65 procedure tabPageChange(Sender: TObject; NewTab: Integer;
66 var AllowChange: Boolean);
67 procedure FormResize(Sender: TObject);
68 procedure SectionClick(Sender: TObject);
69 procedure FormDestroy(Sender: TObject);
70 procedure FormCreate(Sender: TObject);
71 procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
72 procedure TabControlChange(Sender: TObject);
73 procedure TabControlChanging(Sender: TObject;
74 var AllowChange: Boolean);
75 procedure FormKeyDown(Sender: TObject; var Key: Word;
76 Shift: TShiftState);
77 procedure FormClose(Sender: TObject; var Action: TCloseAction);
78 procedure FormCanResize(Sender: TObject; var NewWidth,
79 NewHeight: Integer; var Resize: Boolean);
80 procedure FormShow(Sender: TObject);
81 procedure TabControlEnter(Sender: TObject);
82
83 private
84 FAutoSave: boolean;
85 FSaveNeeded: boolean;
86 FChangeSource: Integer;
87 FCancel: Boolean; //Indicates the cancel button has been pressed;
88 FAbort: boolean; // indicates that neither OK or Cancel has been pressed
89 FormList: TStringList; //Holds the types of any forms that will be used
90 //in the frame. They must be available at compile time
91 FLastPage: TfrmPCEBase;
92 FGiveMultiTabMessage: boolean;
93 procedure CreateChildForms(Sender: TObject; Location: integer);
94 procedure SynchPCEData;
95 procedure SwitchToPage(NewForm: TfrmPCEBase); //was tfrmPage
96 function PageIDToForm(PageID: Integer): TfrmPCEBase;
97 function PageIDToTab(PageID: Integer): string;
98 procedure LoadFormList(Location: integer);
99 procedure CreateForms;
100 procedure AddTabs;
101 function FormListContains(item: string): Boolean;
102 procedure SendData;
103 procedure UpdateEncounter(PCE: TPCEData);
104 procedure SetFormFonts;
105
106 public
107 procedure SelectTab(NewTabName: string);
108 property ChangeSource: Integer read FChangeSource;
109 property Forms: tstringlist read FormList;
110 property Cancel: Boolean read FCancel write FCancel;
111 property Abort: Boolean read FAbort write FAbort;
112 end;
113
114var
115 frmEncounterFrame: TfrmEncounterFrame;
116 uSCCond: TSCConditions;
117 uVisitType: TPCEProc; // contains info for visit type page
118 uEncPCEData: TPCEData;
119 uProviders: TPCEProviderList;
120
121// Returns true if PCE data still needs to be saved - vitals/gaf are always saved
122function UpdatePCE(PCEData: TPCEData; SaveOnExit: boolean = TRUE): boolean;
123
124implementation
125
126uses
127 uCore,
128 fGAF, uConst,
129 rCore, fPCEProvider, rMisc, VA508AccessibilityRouter, VAUtils;
130
131{$R *.DFM}
132
133{///////////////////////////////////////////////////////////////////////////////
134//Name: function TfrmEncounterFrame.PageIDToTab(PageID: Integer): String;
135//Created: Jan 1999
136//By: Robert Bott
137//Location: ISL
138//Description: returns the tab index that corresponds to a given PageID .
139///////////////////////////////////////////////////////////////////////////////}
140function TfrmEncounterFrame.PageIDToTab(PageID: Integer): String;
141begin
142 result := '';
143 case PageID of
144 CT_NOPAGE: Result := '';
145 CT_UNKNOWN: Result := '';
146 CT_VISITTYPE: Result := CT_VisitNm;
147 CT_DIAGNOSES: Result := CT_DiagNm;
148 CT_PROCEDURES: Result := CT_ProcNm;
149 CT_IMMUNIZATIONS: Result := CT_ImmNm;
150 CT_SKINTESTS: Result := CT_SkinNm;
151 CT_PATIENTED: Result := CT_PedNm;
152 CT_HEALTHFACTORS: Result := CT_HlthNm;
153 CT_EXAMS: Result := CT_XamNm;
154 CT_VITALS: Result := CT_VitNm;
155 CT_GAF: Result := CT_GAFNm;
156
157 end;
158end;
159
160
161{///////////////////////////////////////////////////////////////////////////////
162//Name: function TfrmEncounterFrame.PageIDToForm(PageID: Integer): TfrmPCEBase;
163//Created: Jan 1999
164//By: Robert Bott
165//Location: ISL
166//Description: return the form name based on the PageID}
167///////////////////////////////////////////////////////////////////////////////}
168function TfrmEncounterFrame.PageIDToForm(PageID: Integer): TfrmPCEBase;
169begin
170 case PageID of
171 CT_VISITTYPE: Result := frmVisitType;
172 CT_DIAGNOSES: Result := frmDiagnoses;
173 CT_PROCEDURES: Result := frmProcedures;
174 CT_IMMUNIZATIONS: Result := frmImmunizations;
175 CT_SKINTESTS: Result := frmSkinTests;
176 CT_PATIENTED: Result := frmPatientEd;
177 CT_HEALTHFACTORS: Result := frmHealthFactors;
178 CT_EXAMS: Result := frmExams;
179 CT_VITALS: Result := frmEncVitals;
180 CT_GAF: Result := frmGAF;
181 else //not a valid form
182 result := frmPCEBase;
183 end;
184end;
185
186
187{///////////////////////////////////////////////////////////////////////////////
188//Name: procedure TfrmEncounterFrame.CreatChildForms(Sender: TObject);
189//Created: Jan 1999
190//By: Robert Bott
191//Location: ISL
192//Description: Finds out what pages to display, has the pages and tabs created.
193///////////////////////////////////////////////////////////////////////////////}
194procedure TfrmEncounterFrame.CreateChildForms(Sender: TObject; Location: integer);
195begin
196 //load FormList with a list of all forms to display.
197 inherited;
198 LoadFormList(Location);
199 AddTabs;
200 CreateForms;
201end;
202
203
204
205{///////////////////////////////////////////////////////////////////////////////
206//Name: TfrmEncounterFrame.LoadFormList;
207//Created: Jan 1999
208//By: Robert Bott
209//Location: ISL
210//Description: Loads Formlist with the forms to create, will be replaced by RPC call.
211///////////////////////////////////////////////////////////////////////////////}
212procedure TfrmEncounterFrame.LoadFormList(Location: integer);
213begin
214 //change this to an RPC in RPCE.pas
215 FormList.clear;
216 FormList.add(CT_VisitNm);
217 FormList.add(CT_DiagNm);
218 FormList.add(CT_ProcNm);
219 formList.add(CT_VitNm);
220 formList.add(CT_ImmNm);
221 formList.add(CT_SkinNm);
222 formList.add(CT_PedNm);
223 formList.add(CT_HlthNm);
224 formList.add(CT_XamNm);
225 if MHClinic(Location) then
226 formList.add(CT_GAFNm);
227 end;
228
229
230{///////////////////////////////////////////////////////////////////////////////
231//Name: function TfrmEncounterFrame.FormListContains(item: string): Boolean;
232//Created: 12/06/98
233//By: Robert Bott
234//Location: ISL
235//Description: Returns a boolean value indicating if a given string exists in
236// the formlist.
237///////////////////////////////////////////////////////////////////////////////}
238function TfrmEncounterFrame.FormListContains(item: string): Boolean;
239begin
240 result := false;
241 if (FormList.IndexOf(item) <> -1 ) then
242 result := true;
243end;
244
245{///////////////////////////////////////////////////////////////////////////////
246//Name: procedure TfrmEncounterFrame.CreateForms;
247//Created: Jan 1999
248//By: Robert Bott
249//Location: ISL
250//Description: Creates all of the forms in the list.
251///////////////////////////////////////////////////////////////////////////////}
252procedure TfrmEncounterFrame.CreateForms;
253var
254 i: integer;
255begin
256 //could this be placed in a loop using PagedIdToTab & PageIDToFOrm & ?
257
258 if FormListContains(CT_VisitNm) then
259 frmVisitType := TfrmVisitType.CreateLinked(pnlPage);
260 if FormListContains(CT_DiagNm) then
261 frmDiagnoses := TfrmDiagnoses.CreateLinked(pnlPage);
262 if FormListContains(CT_ProcNm) then
263 frmProcedures := TfrmProcedures.CreateLinked(pnlPage);
264 if FormListContains(CT_VitNm) then
265 frmEncVitals := TfrmEncVitals.CreateLinked(pnlPage);
266 if FormListContains(CT_ImmNm) then
267 frmImmunizations := TfrmImmunizations.CreateLinked(pnlPage);
268 if FormListContains(CT_SkinNm) then
269 frmSkinTests := TfrmSkinTests.CreateLinked(pnlPage);
270 if FormListContains(CT_PedNm) then
271 frmPatientEd := TfrmPatientEd.CreateLinked(pnlPage);
272 if FormListContains(CT_HlthNm) then
273 frmHealthFactors := TfrmHEalthFactors.CreateLinked(pnlPage);
274 if FormListContains(CT_XamNm) then
275 frmExams := TfrmExams.CreateLinked(pnlPage);
276 if FormListContains(CT_GAFNm) then
277 frmGAF := TfrmGAF.CreateLinked(pnlPage);
278 //must switch based on caption, as all tabs may not be present.
279 for i := CT_FIRST to CT_LAST do
280 begin
281 if Formlist.IndexOf(PageIdToTab(i)) <> -1 then
282 PageIDToForm(i).Visible := (Formlist.IndexOf(PageIdToTab(i)) = 0);
283 end;
284end;
285
286
287{///////////////////////////////////////////////////////////////////////////////
288//Name: TfrmEncounterFrame.SwitchToPage(NewForm: tfrmPCEBase);
289//Created: Jan 1999
290//By: Robert Bott
291//Location: ISL
292//Description: Brings the selected page to the front for display.
293///////////////////////////////////////////////////////////////////////////////}
294procedure TfrmEncounterFrame.SwitchToPage(NewForm: tfrmPCEBase);// was TfrmPage);
295{ unmerge/merge menus, bring page to top of z-order, call form-specific OnDisplay code }
296begin
297 if (NewForm = nil) or (FLastPage = NewForm) then Exit;
298 if Assigned(FLastPage) then
299 FLastPage.Hide;
300 FLastPage := NewForm;
301// KeyPreview := (NewForm = frmEncVitals);
302 NewForm.DisplayPage; // this calls BringToFront for the form
303end;
304
305
306
307{///////////////////////////////////////////////////////////////////////////////
308//Name: procedure TfrmEncounterFrame.tabPageChange(Sender: TObject; NewTab: Integer; var AllowChange: Boolean);
309//Created: Jan 1999
310//By: Robert Bott
311//Location: ISL
312//Description: Finds the page, and calls SwithToPage to display it.
313///////////////////////////////////////////////////////////////////////////////}
314procedure TfrmEncounterFrame.tabPageChange(Sender: TObject; NewTab: Integer; var AllowChange: Boolean);
315{ switches to form linked to NewTab }
316var
317 i: integer;
318begin
319//must switch based on caption, as all tabs may not be present.
320for i := CT_FIRST to CT_LAST do
321 begin
322 With Formlist do
323 if NewTab = IndexOf(PageIdToTab(i)) then
324 begin
325 PageIDToForm(i).show;
326 SwitchToPage(PageIDToForm(i));
327 end;
328 end;
329end;
330
331{ Resize and Font-Change procedures --------------------------------------------------------- }
332
333{///////////////////////////////////////////////////////////////////////////////
334//Name: procedure TfrmEncounterFrame.FormResize(Sender: TObject);
335//Created: Jan 1999
336//By: Robert Bott
337//Location: ISL
338//Description: Resizes all windows when parent changes.
339///////////////////////////////////////////////////////////////////////////////}
340procedure TfrmEncounterFrame.FormResize(Sender: TObject);
341var
342 i: integer;
343begin
344 for i := CT_FIRST to CT_LAST do
345 if (FormList.IndexOf(PageIdToTab(i)) <> -1) then
346 MoveWindow(PageIdToForm(i).Handle, 0, 0, pnlPage.ClientWidth, pnlpage.ClientHeight, true);
347 self.repaint;
348end;
349
350{///////////////////////////////////////////////////////////////////////////////
351//Name: procedure TfrmEncounterFrame.AddTabs;
352//Created: Jan 1999
353//By: Robert Bott
354//Location: ISL
355//Description: adds a tab for each page that will be displayed
356///////////////////////////////////////////////////////////////////////////////}
357procedure TfrmEncounterFrame.AddTabs;
358
359var
360 i: integer;
361begin
362 TabControl.Tabs.Clear;
363 for I := 0 to (Formlist.count - 1) do
364 TabControl.Tabs.Add(Formlist.Strings[i]);
365end;
366
367
368{///////////////////////////////////////////////////////////////////////////////
369//Name: procedure UpdatePCE(PCEData: TPCEData);
370//Created: Jan 1999
371//By: Robert Bott
372//Location: ISL
373//Description: The main call to open the encounter frame and capture encounter
374// information.
375///////////////////////////////////////////////////////////////////////////////}
376function UpdatePCE(PCEData: TPCEData; SaveOnExit: boolean = TRUE): boolean;
377var
378// FontHeight,
379// FontWidth: Integer;
380 AUser: string;
381
382begin
383 frmEncounterFrame := TfrmEncounterFrame.Create(Application);
384 try
385 frmEncounterFrame.FAutoSave := SaveOnExit;
386
387 uEncPCEData := PCEData;
388 if(uEncPCEData.Empty and ((uEncPCEData.Location = 0) or (uEncPCEData.VisitDateTime = 0)) and
389 (not Encounter.NeedVisit)) then
390 uEncPCEData.UseEncounter := TRUE;
391 frmEncounterFrame.Caption := 'Encounter Form for ' + ExternalName(uEncPCEData.Location, 44) +
392 ' (' + FormatFMDateTime('mmm dd,yyyy@hh:nn', uEncPCEData.VisitDateTime) + ')';
393
394 uProviders.Assign(uEncPCEData.Providers);
395 SetDefaultProvider(uProviders, uEncPCEData);
396 AUser := IntToStr(uProviders.PendingIEN(FALSE));
397 if(AUser <> '0') and (uProviders.IndexOfProvider(AUser) < 0) and
398 AutoCheckout(uEncPCEData.Location) then
399 uProviders.AddProvider(AUser, uProviders.PendingName(FALSE), FALSE);
400
401 frmEncounterFrame.CreateChildForms(frmEncounterFrame, PCEData.Location);
402 SetFormPosition(frmEncounterFrame);
403 ResizeAnchoredFormToFont(frmEncounterFrame);
404 //SetFormPosition(frmEncounterFrame);
405
406 with frmEncounterFrame do
407 begin
408 SetRPCEncLocation(PCEData.Location);
409 SynchPCEData;
410 TabControl.Tabindex := 0;
411 TabControlChange(TabControl);
412
413 ShowModal;
414 Result := FSaveNeeded;
415 end;
416 finally
417 // frmEncounterFrame.Free; v22.11 (JD and SM)
418 frmEncounterFrame.Release;
419 //frmEncounterFrame := nil; access violation source? removed 7/28/03 RV
420 end;
421end;
422
423{///////////////////////////////////////////////////////////////////////////////
424//Name: TfrmEncounterFrame.SectionClick(Sender: TObject);
425//Created: Jan 1999
426//By: Robert Bott
427//Location: ISL
428//Description: Call the procedure apropriate for the selected tab
429///////////////////////////////////////////////////////////////////////////////}
430procedure TfrmEncounterFrame.SectionClick(Sender: TObject);
431begin
432 with Sender as TListBox do case Tag of
433 TAG_VTYPE: if FormListContains(CT_VisitNm) then
434 begin
435 with frmVisitType do
436 lstVTypeSectionClick(Sender);
437 end;
438 end;
439end;
440
441{///////////////////////////////////////////////////////////////////////////////
442//Name: procedure TfrmEncounterFrame.SynchPCEData;
443//Created: Jan 1999
444//By: Robert Bott
445//Location: ISL
446//Description: Synchronize any existing PCE data with what is displayed in the form.
447///////////////////////////////////////////////////////////////////////////////}
448procedure TfrmEncounterFrame.SynchPCEData;
449
450 procedure InitList(AListBox: TORListBox);
451 var
452 DoClick: boolean;
453
454 begin
455 with AListBox do
456 begin
457 DoClick := TRUE;
458 case Tag of
459 TAG_VTYPE: begin
460 if FormListContains(CT_VisitNm) then
461 ListVisitTypeSections(Items);
462 DoClick := AutoSelectVisit(PCERPCEncLocation);
463 end;
464 end;
465 if Items.Count > 0 then
466 begin
467 if DoClick then
468 begin
469 ItemIndex := 0;
470 SectionClick(AListBox);
471 end;
472 end
473 else Items.Add(TX_NOSECTION);
474 end;
475 end;
476
477begin
478 if FormListContains(CT_VisitNm) then
479 with frmVisitType do
480 begin
481 InitList(frmVisitType.lstVTypeSection); // set up Visit Type page
482 ListSCDisabilities(memSCDisplay.Lines);
483 uSCCond := EligbleConditions;
484 frmVisitType.fraVisitRelated.InitAllow(uSCCond);
485 end;
486 with uEncPCEData do // load any existing data from PCEData
487 begin
488 if FormListContains(CT_VisitNm) then
489 frmVisitType.fraVisitRelated.InitRelated(uEncPCEData);
490 if FormListContains(CT_DiagNm) then
491 frmDiagnoses.InitTab(CopyDiagnoses, ListDiagnosisSections);
492 if FormListContains(CT_ProcNm) then
493 frmProcedures.InitTab(CopyProcedures, ListProcedureSections);
494 if FormListContains(CT_ImmNm) then
495 frmImmunizations.InitTab(CopyImmunizations,ListImmunizSections);
496 if FormListContains(CT_SkinNm) then
497 frmSkinTests.InitTab(CopySkinTests, ListSkinSections);
498 if FormListContains(CT_PedNm) then
499 frmPatientEd.InitTab(CopyPatientEds, ListPatientSections);
500 if FormListContains(CT_HlthNm) then
501 frmHealthFactors.InitTab(CopyHealthFactors, ListHealthSections);
502 if FormListContains(CT_XamNm) then
503 frmExams.InitTab(CopyExams, ListExamsSections);
504 uVisitType.Assign(VisitType);
505 if FormListContains(CT_VisitNm) then
506 with frmVisitType do
507 begin
508 MatchVType;
509 end;
510 end;
511end;
512
513
514{///////////////////////////////////////////////////////////////////////////////
515//Name: procedure TfrmEncounterFrame.FormDestroy(Sender: TObject);
516//Created: Jan 1999
517//By: Robert Bott
518//Location: ISL
519//Description: Free up objects in memory when destroying form.
520///////////////////////////////////////////////////////////////////////////////}
521procedure TfrmEncounterFrame.FormDestroy(Sender: TObject);
522var
523 i: integer;
524
525begin
526 inherited;
527 for i := ComponentCount-1 downto 0 do
528 if(Components[i] is TForm) then
529 TForm(Components[i]).Free;
530
531 formlist.clear;
532 KillObj(@uProviders);
533 uVisitType.Free;
534 Formlist.free;
535end;
536
537
538{///////////////////////////////////////////////////////////////////////////////
539//Name: procedure TfrmEncounterFrame.FormCreate(Sender: TObject);
540//Created: Jan 1999
541//By: Robert Bott
542//Location: ISL
543//Description: Create instances of the objects needed.
544///////////////////////////////////////////////////////////////////////////////}
545procedure TfrmEncounterFrame.FormCreate(Sender: TObject);
546begin
547 uProviders := TPCEProviderList.Create;
548 uVisitType := TPCEProc.create;
549 //uVitalOld := TStringList.create;
550 //uVitalNew := TStringList.create;
551 FormList := TStringList.create;
552 fCancel := False;
553 FAbort := TRUE;
554 SetFormFonts;
555 FGiveMultiTabMessage := ScreenReaderSystemActive;
556end;
557
558
559{///////////////////////////////////////////////////////////////////////////////
560//Name: procedure TfrmEncounterFrame.SendData;
561//Created: Jan 1999
562//By: Robert Bott
563//Location: ISL
564//Description: Send Data back to the M side sor storing.
565///////////////////////////////////////////////////////////////////////////////}
566procedure TfrmEncounterFrame.SendData;
567//send PCE data to the RPC
568var
569 StoreMessage: string;
570 GAFScore: integer;
571 GAFDate: TFMDateTime;
572 GAFStaff: Int64;
573
574begin
575 inherited;
576 // do validation for vitals & anything else here
577
578 //process vitals
579 if FormListContains(CT_VitNm) then
580 begin
581 with frmEncVitals do
582 if HasData then
583 begin
584 if AssignVitals then
585 begin
586 StoreMessage := ValAndStoreVitals(frmEncVitals.VitalNew);
587 if (Storemessage <> 'True') then
588 begin
589 ShowMsg(storemessage);
590// exit;
591 end;
592 end;
593 end;
594 end;
595
596 if(FormListContains(CT_GAFNm)) then
597 begin
598 frmGAF.GetGAFScore(GAFScore, GAFDate, GAFStaff);
599 if(GAFScore > 0) then
600 SaveGAFScore(GAFScore, GAFDate, GAFStaff);
601 end;
602
603 //PCE
604
605 UpdateEncounter(uEncPCEData);
606 with uEncPCEData do
607 begin
608 if FAutoSave then
609 Save
610 else
611 FSaveNeeded := TRUE;
612 end;
613 Close;
614end;
615
616{///////////////////////////////////////////////////////////////////////////////
617//Name: procedure TfrmEncounterFrame.FormCloseQuery(Sender: TObject;
618//Created: Jan 1999
619//By: Robert Bott
620//Location: ISL
621//Description: Check to see if the Cancel button was pressed, if not, call
622// procedure to send the data to the server.
623///////////////////////////////////////////////////////////////////////////////}
624procedure TfrmEncounterFrame.FormCloseQuery(Sender: TObject;
625 var CanClose: Boolean);
626
627const
628 TXT_SAVECHANGES = 'Save Changes?';
629
630var
631 TmpPCEData: TPCEData;
632 ask, ChangeOK: boolean;
633
634begin
635 CanClose := True;
636 if(FAbort) then
637 FCancel := (InfoBox(TXT_SAVECHANGES, TXT_SAVECHANGES, MB_YESNO) = ID_NO);
638 if FCancel then Exit; //*KCM*
639
640 if(uProviders.PrimaryIdx >= 0) then
641 ask := TRUE
642 else
643 begin
644 TmpPCEData := TPCEData.Create;
645 try
646 uEncPCEData.CopyPCEData(TmpPCEData);
647 UpdateEncounter(TmpPCEData);
648 ask := TmpPCEData.NeedProviderInfo;
649 finally
650 TmpPCEData.Free;
651 end;
652 end;
653 if ask and (NoPrimaryPCEProvider(uProviders, uEncPCEData)) then
654 begin
655 InfoBox(TX_PROV_REQ, TC_PROV_REQ, MB_OK or MB_ICONWARNING);
656 CanClose := False;
657 Exit;
658 end;
659
660 uVisitType.Provider := uProviders.PrimaryIEN; {RV - v20.1}
661
662 if FormListContains(CT_VitNm) then
663 CanClose := frmEncVitals.OK2SaveVitals;
664
665 if CanClose and FormListContains(CT_ProcNm) then
666 begin
667 CanClose := frmProcedures.OK2SaveProcedures;
668 if not CanClose then
669 begin
670 tabPageChange(Self, FormList.IndexOf(CT_ProcNm), ChangeOK);
671 SwitchToPage(PageIDToForm(CT_PROCEDURES));
672 TabControl.TabIndex := FormList.IndexOf(CT_ProcNm);
673 end;
674 end;
675
676 if CanClose then SendData; //*KCM*
677
678end;
679
680procedure TfrmEncounterFrame.TabControlChange(Sender: TObject);
681var
682 i: integer;
683begin
684//must switch based on caption, as all tabs may not be present.
685 if (sender as tTabControl).tabindex = -1 then exit;
686
687 if TabControl.CanFocus and Assigned(FLastPage) and not TabControl.Focused then
688 TabControl.SetFocus; //CQ: 14845
689
690 for i := CT_FIRST to CT_LAST do
691 begin
692 with Formlist do
693 with sender as tTabControl do
694 if Tabindex = IndexOf(PageIdToTab(i)) then
695 begin
696 PageIDToForm(i).show;
697 SwitchToPage(PageIDToForm(i));
698 Exit;
699 end;
700 end;
701end;
702
703procedure TfrmEncounterFrame.TabControlChanging(Sender: TObject;
704 var AllowChange: Boolean);
705begin
706 if(assigned(FLastPage)) then
707 FLastPage.AllowTabChange(AllowChange);
708end;
709
710procedure TfrmEncounterFrame.UpdateEncounter(PCE: TPCEData);
711begin
712 with PCE do
713 begin
714 if FormListContains(CT_VisitNm) then
715 begin
716 VisitType := uVisitType;
717 frmVisitType.fraVisitRelated.GetRelated(uEncPCEData);
718 Providers.Merge(uProviders);
719 end;
720
721 if FormListContains(CT_DiagNm) then
722 SetDiagnoses(frmDiagnoses.lbGrid.Items);
723 if FormListContains(CT_ProcNm) then
724 SetProcedures(frmProcedures.lbGrid.Items);
725 if FormListContains(CT_ImmNm) then
726 SetImmunizations(frmImmunizations.lbGrid.Items);
727 if FormListContains(CT_SkinNm) then
728 SetSkinTests(frmSkinTests.lbGrid.Items);
729 if FormListContains(CT_PedNm) then
730 SetPatientEds(frmPatientEd.lbGrid.Items);
731 if FormListContains(CT_HlthNm) then
732 SetHealthFactors(frmHealthFactors.lbGrid.Items);
733 if FormListContains(CT_XamNm) then
734 SetExams(frmExams.lbGrid.Items);
735 end;
736end;
737
738procedure TfrmEncounterFrame.SelectTab(NewTabName: string);
739var
740 AllowChange: boolean;
741begin
742 AllowChange := True;
743 tabControl.TabIndex := FormList.IndexOf(NewTabName);
744 tabPageChange(Self, tabControl.TabIndex, AllowChange);
745end;
746
747procedure TfrmEncounterFrame.TabControlEnter(Sender: TObject);
748begin
749 if FGiveMultiTabMessage then // CQ#15483
750 begin
751 FGiveMultiTabMessage := FALSE;
752 GetScreenReader.Speak('Multi tab form');
753 end;
754end;
755
756procedure TfrmEncounterFrame.FormKeyDown(Sender: TObject; var Key: Word;
757 Shift: TShiftState);
758var
759 CanChange: boolean;
760begin
761 inherited;
762 if (Key = VK_ESCAPE) then
763 begin
764 Key := 0;
765 FLastPage.btnCancel.Click;
766 end
767 else if Key = VK_TAB then
768 begin
769 if ssCtrl in Shift then
770 begin
771 CanChange := True;
772 if Assigned(TabControl.OnChanging) then
773 TabControl.OnChanging(TabControl, CanChange);
774 if CanChange then
775 begin
776 if ssShift in Shift then
777 begin
778 if TabControl.TabIndex < 1 then
779 TabControl.TabIndex := TabControl.Tabs.Count -1
780 else
781 TabControl.TabIndex := TabControl.TabIndex - 1;
782 end
783 else
784 TabControl.TabIndex := (TabControl.TabIndex + 1) mod TabControl.Tabs.Count;
785 if Assigned(TabControl.OnChange) then
786 TabControl.OnChange(TabControl);
787 end;
788 Key := 0;
789 end;
790 end;
791end;
792
793procedure TfrmEncounterFrame.SetFormFonts;
794var
795 NewFontSize: integer;
796begin
797 NewFontSize := MainFontsize;
798 if FormListContains(CT_VisitNm) then
799 frmVisitType.Font.Size := NewFontSize;
800 if FormListContains(CT_DiagNm) then
801 frmDiagnoses.Font.Size := NewFontSize;
802 if FormListContains(CT_ProcNm) then
803 frmProcedures.Font.Size := NewFontSize;
804 if FormListContains(CT_ImmNm) then
805 frmImmunizations.Font.Size := NewFontSize;
806 if FormListContains(CT_SkinNm) then
807 frmSkinTests.Font.Size := NewFontSize;
808 if FormListContains(CT_PedNm) then
809 frmPatientEd.Font.Size := NewFontSize;
810 if FormListContains(CT_HlthNm) then
811 frmHealthFactors.Font.Size := NewFontSize;
812 if FormListContains(CT_XamNm) then
813 frmExams.Font.Size := NewFontSize;
814 if FormListContains(CT_VitNm) then
815 frmEncVitals.Font.Size := NewFontSize;
816 if FormListContains(CT_GAFNm) then
817 frmGAF.SetFontSize(NewFontSize);
818end;
819
820procedure TfrmEncounterFrame.FormClose(Sender: TObject;
821 var Action: TCloseAction);
822begin
823 SaveUserBounds(Self);
824end;
825
826procedure TfrmEncounterFrame.FormCanResize(Sender: TObject; var NewWidth,
827 NewHeight: Integer; var Resize: Boolean);
828begin
829 //CQ4740
830 if NewWidth < 200 then
831 begin
832 NewWidth := 200;
833 Resize := false;
834 end;
835end;
836
837procedure TfrmEncounterFrame.FormShow(Sender: TObject);
838begin
839 inherited;
840 if TabControl.CanFocus then
841 TabControl.SetFocus;
842end;
843
844end.
Note: See TracBrowser for help on using the repository browser.