source: cprs/branches/tmg-cprs/CPRS-Chart/Encounter/fEncounterFrame.pas@ 453

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

Initial upload of TMG-CPRS 1.0.26.69

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