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

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

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