Module

fGAF

Path

C:\CPRS\CPRS30\Encounter\fGAF.pas

Last Modified

7/15/2014 3:26:36 PM

Initialization Code

initialization
  SpecifyFormIsNotADialog(TfrmGAF);

end.

Units Used in Interface

Name Comments
fPCEBase -
fPCEBaseGrid -

Units Used in Implementation

Name Comments
fEncounterFrame -
rCore -
rPCE -
uCore -
uPCE -

Classes

Name Comments
TfrmGAF -

Procedures

Name Owner Declaration Scope Comments
AllowTabChange TfrmGAF procedure AllowTabChange(var AllowChange: boolean); override; Public -
btnURLClick TfrmGAF procedure btnURLClick(Sender: TObject); Public/Published -
cboGAFProviderExit TfrmGAF procedure cboGAFProviderExit(Sender: TObject); Public/Published -
cboGAFProviderNeedData TfrmGAF procedure cboGAFProviderNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
dteGAFExit TfrmGAF procedure dteGAFExit(Sender: TObject); Public/Published -
edtScoreChange TfrmGAF procedure edtScoreChange(Sender: TObject); Public/Published -
FormActivate TfrmGAF procedure FormActivate(Sender: TObject); Public/Published -
FormCreate TfrmGAF procedure FormCreate(Sender: TObject); Public/Published -
FormShow TfrmGAF procedure FormShow(Sender: TObject); Public/Published -
GetGAFScore TfrmGAF procedure GetGAFScore(var Score: integer; var Date: TFMDateTime; var Staff: Int64); Public -
LoadScores TfrmGAF procedure LoadScores; Private -

Functions

Name Owner Declaration Scope Comments
BADData TfrmGAF function BADData(ShowMessage: boolean): boolean; Private -
ValidGAFData - function ValidGAFData(Score: integer; Date: TFMDateTime; Staff: Int64): boolean; Interfaced -

Global Variables

Name Type Declaration Comments
frmGAF TfrmGAF frmGAF: TfrmGAF; -


Module Source

1     unit fGAF;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       fPCEBase, StdCtrls, Buttons, ExtCtrls, Grids, ORFn, ORNet, ORCtrls,
8       ORDtTm, ComCtrls, fPCEBaseGrid, Menus, VA508AccessibilityManager;
9     
10    type
11      TfrmGAF = class(TfrmPCEBaseGrid)
12        lblGAF: TStaticText;
13        edtScore: TCaptionEdit;
14        udScore: TUpDown;
15        dteGAF: TORDateBox;
16        lblEntry: TStaticText;
17        lblScore: TLabel;
18        lblDate: TLabel;
19        lblDeterminedBy: TLabel;
20        cboGAFProvider: TORComboBox;
21        btnURL: TButton;
22        Spacer1: TLabel;
23        Spacer2: TLabel;
24        procedure cboGAFProviderNeedData(Sender: TObject; const StartFrom: String;
25          Direction, InsertAt: Integer);
26        procedure edtScoreChange(Sender: TObject);
27        procedure dteGAFExit(Sender: TObject);
28        procedure cboGAFProviderExit(Sender: TObject);
29        procedure FormActivate(Sender: TObject);
30        procedure FormShow(Sender: TObject);
31        procedure btnURLClick(Sender: TObject);
32        procedure FormCreate(Sender: TObject);
33      private
34        FDataLoaded: boolean;
35        procedure LoadScores;
36        function BADData(ShowMessage: boolean): boolean;
37      public
38        procedure AllowTabChange(var AllowChange: boolean); override;
39        procedure GetGAFScore(var Score: integer; var Date: TFMDateTime; var Staff: Int64);
40      end;
41    
42    function ValidGAFData(Score: integer; Date: TFMDateTime; Staff: Int64): boolean;
43    
44    var
45      frmGAF: TfrmGAF;
46    
47    implementation
48    
49    uses rPCE, rCore, uCore, uPCE, fEncounterFrame, VA508AccessibilityRouter;
50    
51    {$R *.DFM}
52    
53    function ValidGAFData(Score: integer; Date: TFMDateTime; Staff: Int64): boolean;
54    begin
55      if(Score < 1) or (Score > 100) or (Date <= 0) or (Staff = 0) then
56        Result := FALSE
57      else
58        Result := ((Patient.DateDied <= 0) or (Date <= Patient.DateDied));
59    end;
60    
61    procedure TfrmGAF.LoadScores;
62    var
63      i: integer;
64      tmp: string;
65    
66    begin
67      RecentGAFScores(3);
68      if(RPCBrokerV.Results.Count > 0) and (RPCBrokerV.Results[0] = '[DATA]') then
69      begin
70        for i := 1 to RPCBrokerV.Results.Count-1 do
71        begin
72          tmp := RPCBrokerV.Results[i];
73          lbGrid.Items.Add(Piece(tmp,U,5) + U + Piece(Piece(tmp,U,2),NoPCEValue,1) + U +
74                                    Piece(tmp,U,7) + U + Piece(tmp,U,8));
75        end;
76      end;
77      if(lbGrid.Items.Count > 0) then
78        SyncGridData
79      else
80        lbGrid.Items.Add('No GAF scores found.');
81    end;
82    
83    procedure TfrmGAF.cboGAFProviderNeedData(Sender: TObject;
84      const StartFrom: String; Direction, InsertAt: Integer);
85    begin
86      inherited;
87      cboGAFProvider.ForDataUse(SubSetOfPersons(StartFrom, Direction));
88    end;
89    
90    function TfrmGAF.BADData(ShowMessage: boolean): boolean;
91    var
92      PName, msg: string;
93      GAFDate: TFMDateTime;
94      UIEN: Int64;
95    
96    begin
97      GAFDate := dteGAF.FMDateTime;
98      msg := ValidateGAFDate(GAFDate);
99      if(dteGAF.FMDateTime <> GAFDate) then
100       dteGAF.FMDateTime := GAFDate;
101   
102     if(cboGAFProvider.ItemID = '') then
103     begin
104       if(msg <> '') then
105         msg := msg + CRLF;
106       msg := msg + 'A determining party is required to enter a GAF score.';
107       UIEN := uProviders.PCEProvider;
108       if(UIEN <> 0) then
109       begin
110         PName := uProviders.PCEProviderName;
111         msg := msg + '  Determined By changed to ' + PName + '.';
112         cboGAFProvider.SelectByIEN(UIEN);
113         if(cboGAFProvider.ItemID = '') then
114         begin
115           cboGAFProvider.InitLongList(PName);
116           cboGAFProvider.SelectByIEN(UIEN);
117         end;
118       end;
119     end;
120   
121     if(ShowMessage and (msg <> '')) then
122       InfoBox(msg, 'Invalid GAF Data', MB_OK);
123   
124     if(udScore.Position > udScore.Min) then
125       Result := (msg <> '')
126     else
127       Result := FALSE;
128   end;
129   
130   procedure TfrmGAF.edtScoreChange(Sender: TObject);
131   var
132     i: integer;
133   
134   begin
135     inherited;
136     i := StrToIntDef(edtScore.Text,udScore.Min);
137     if(i < udScore.Min) or (i > udScore.Max) then
138       i := udScore.Min;
139     udScore.Position := i;
140     edtScore.Text := IntToStr(i);
141     edtScore.SelStart := length(edtScore.Text);
142   end;
143   
144   procedure TfrmGAF.dteGAFExit(Sender: TObject);
145   begin
146     inherited;
147   //  BadData(TRUE);
148   end;
149   
150   procedure TfrmGAF.cboGAFProviderExit(Sender: TObject);
151   begin
152     inherited;
153     BADData(TRUE);
154   end;
155   
156   procedure TfrmGAF.AllowTabChange(var AllowChange: boolean);
157   begin
158     AllowChange := (not BADData(TRUE));
159   end;
160   
161   procedure TfrmGAF.GetGAFScore(var Score: integer; var Date: TFMDateTime; var Staff: Int64);
162   begin
163     Score := udScore.Position;
164     if(Score > 0) then BADData(TRUE);
165     Date := dteGAF.FMDateTime;
166     Staff := cboGAFProvider.ItemIEN;
167     if(not ValidGAFData(Score, Date, Staff)) then
168     begin
169       Score := 0;
170       Date := 0;
171       Staff := 0
172     end;
173   end;
174   
175   procedure TfrmGAF.FormActivate(Sender: TObject);
176   begin
177     inherited;
178     if(not FDataLoaded) then
179     begin
180       FDataLoaded := TRUE;
181       LoadScores;
182       cboGAFProvider.InitLongList(Encounter.ProviderName);
183       BADData(FALSE);
184     end;
185   end;
186   
187   procedure TfrmGAF.FormShow(Sender: TObject);
188   begin
189     inherited;
190     FormActivate(Sender);
191   end;
192   
193   procedure TfrmGAF.btnURLClick(Sender: TObject);
194   begin
195     inherited;
196     GotoWebPage(GAFURL);
197   end;
198   
199   procedure TfrmGAF.FormCreate(Sender: TObject);
200   begin
201     inherited;
202     FTabName := CT_GAFNm;
203     btnURL.Visible := (User.WebAccess and (GAFURL <> ''));
204     FormActivate(Sender);
205   end;
206   
207   initialization
208     SpecifyFormIsNotADialog(TfrmGAF);
209   
210   end.

Module Calls (2 levels)


fGAF
 ├fPCEBase
 │ ├uConst
 │ ├fAutoSz
 │ ├fBase508Form
 │ └fEncounterFrame
 ├fPCEBaseGrid
 │ └fPCEBase...
 ├rPCE
 │ ├uPCE
 │ ├UBACore
 │ ├rCore
 │ ├uCore
 │ ├uConst
 │ ├fEncounterFrame...
 │ ├UBAGlobals
 │ └UBAConst
 ├rCore...
 ├uCore...
 ├uPCE...
 └fEncounterFrame...

Module Called-By (2 levels)


             fGAF
fEncounterFrame┘ 
         uPCE┤   
         rPCE┤   
     fPCEBase┤   
   fVisitType┤   
   fDiagnoses┤   
 fPCEBaseMain┤   
   fProcedure┤   
    fPCEOther┤   
fImmunization┤   
    fSkinTest┤   
   fPatientEd┤   
fHealthFactor┤   
        fExam┤   
   fEncVitals┤   
       fNotes┤   
    fConsults┤   
      fDCSumm┤   
     fSurgery┤   
      fGAF...┤   
     fPCEEdit┤   
    fHFSearch┘