Module

fOrdersEvntRelease

Path

C:\CPRS\CPRS30\Orders\fOrdersEvntRelease.pas

Last Modified

7/15/2014 3:26:42 PM

Units Used in Interface

Name Comments
fAutoSz -
fOrders -
rOrders -
uCore -

Units Used in Implementation

Name Comments
rMisc -

Classes

Name Comments
TfrmOrdersEvntRelease -

Procedures

Name Owner Declaration Scope Comments
btnApplyClick TfrmOrdersEvntRelease procedure btnApplyClick(Sender: TObject); Public/Published -
btnApplyKeyDown TfrmOrdersEvntRelease procedure btnApplyKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
btnCancelClick TfrmOrdersEvntRelease procedure btnCancelClick(Sender: TObject); Public/Published -
btnOKClick TfrmOrdersEvntRelease procedure btnOKClick(Sender: TObject); Public/Published -
edtNumberChange TfrmOrdersEvntRelease procedure edtNumberChange(Sender: TObject); Public/Published -
edtNumberClick TfrmOrdersEvntRelease procedure edtNumberClick(Sender: TObject); Public/Published -
edtNumberKeyDown TfrmOrdersEvntRelease procedure edtNumberKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
FormClose TfrmOrdersEvntRelease procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormCreate TfrmOrdersEvntRelease procedure FormCreate(Sender: TObject); Public/Published -
FormShow TfrmOrdersEvntRelease procedure FormShow(Sender: TObject); Public/Published -
grdEvtListDblClick TfrmOrdersEvntRelease procedure grdEvtListDblClick(Sender: TObject); Public/Published -
grdEvtListDrawCell TfrmOrdersEvntRelease procedure grdEvtListDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); Public/Published -
grdEvtListKeyPress TfrmOrdersEvntRelease procedure grdEvtListKeyPress(Sender: TObject; var Key: Char); Public/Published -
grdEvtListMouseDown TfrmOrdersEvntRelease procedure grdEvtListMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
pnlBottomResize TfrmOrdersEvntRelease procedure pnlBottomResize(Sender: TObject); Public/Published -
SelectEvtReleasedOrders - procedure SelectEvtReleasedOrders(var OrderView: TOrderView); Interfaced -
ShowEvents TfrmOrdersEvntRelease procedure ShowEvents(NumOfEvts: integer); Private -
updown1Click TfrmOrdersEvntRelease procedure updown1Click(Sender: TObject; Button: TUDBtnType); Public/Published -

Constants

Name Declaration Scope Comments
TAB #9 Global -


Module Source

1     unit fOrdersEvntRelease;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs
7       ,ORFn, uCore, rOrders, fOrders, StdCtrls, ORCtrls, ExtCtrls, Grids,fAutoSz,
8       Spin, ComCtrls, VA508AccessibilityManager;
9     
10    type
11      TfrmOrdersEvntRelease = class(TfrmAutoSz)
12        pnlTop: TPanel;
13        lblPtInfo: TStaticText;
14        pnlBottom: TPanel;
15        Label1: TLabel;
16        btnOK: TButton;
17        btnCancel: TButton;
18        grdEvtList: TCaptionStringGrid;
19        Panel1: TPanel;
20        Panel2: TPanel;
21        btnApply: TButton;
22        updown1: TUpDown;
23        edtNumber: TEdit;
24        Panel3: TPanel;
25        Label2: TLabel;
26        Label3: TLabel;
27        procedure FormCreate(Sender: TObject);
28        procedure btnCancelClick(Sender: TObject);
29        procedure FormShow(Sender: TObject);
30        procedure grdEvtListDrawCell(Sender: TObject; ACol, ARow: Integer;
31          Rect: TRect; State: TGridDrawState);
32        procedure grdEvtListMouseDown(Sender: TObject; Button: TMouseButton;
33          Shift: TShiftState; X, Y: Integer);
34        procedure btnOKClick(Sender: TObject);
35        procedure grdEvtListKeyPress(Sender: TObject; var Key: Char);
36        procedure grdEvtListDblClick(Sender: TObject);
37        procedure pnlBottomResize(Sender: TObject);
38        procedure edtNumberChange(Sender: TObject);
39        procedure edtNumberKeyDown(Sender: TObject; var Key: Word;
40          Shift: TShiftState);
41        procedure btnApplyClick(Sender: TObject);
42        procedure btnApplyKeyDown(Sender: TObject; var Key: Word;
43          Shift: TShiftState);
44        procedure edtNumberClick(Sender: TObject);
45        procedure updown1Click(Sender: TObject; Button: TUDBtnType);
46        procedure FormClose(Sender: TObject; var Action: TCloseAction);
47      private
48        { Private declarations }
49        FEvtList: TStringList;
50        FTotal: Integer;
51        FDGroup: Integer;
52        FViewName: string;
53        FPtEvt:      string;
54        FEvent:  TOrderDelayEvent;
55        fPreTxt: string;
56        FOkPressed:  Boolean;
57        procedure ShowEvents(NumOfEvts: integer);
58      public
59        { Public declarations }
60      end;
61    
62      procedure SelectEvtReleasedOrders(var OrderView: TOrderView);
63    
64    implementation
65    
66    uses rMisc, VAUtils;
67    
68    {$R *.DFM}
69    
70    const
71       TAB = #9;
72    
73    procedure SelectEvtReleasedOrders(var OrderView: TOrderView);
74    const
75      FROM_SERVER = TRUE;
76    var
77      frmOrdersEvntRelease: TfrmOrdersEvntRelease;
78    begin
79      frmOrdersEvntRelease := TfrmOrdersEvntRelease.Create(Application);
80      SetFormPosition(frmOrdersEvntRelease);
81      try
82        with frmOrdersEvntRelease do
83        begin
84          FDGroup    := OrderView.DGroup;
85          ShowModal;
86          if FOkPressed then
87          begin
88            frmOrders.FromDCRelease := True;
89            OrderView.Changed   := FOkPressed;
90            OrderView.DGroup    := FDGroup;
91            OrderView.CtxtTime  := 0;
92            OrderView.TextView  := 0;
93            OrderView.ViewName  := FViewName;
94            OrderView.EventDelay.PtEventIFN := StrToIntDef(FPtEvt,0);
95            if FEvent.PtEventIFN > 0 then OrderView.EventDelay := FEvent
96            else
97            begin
98              OrderView.EventDelay.EventType := 'C';
99              OrderView.EventDelay.Specialty := 0;
100             OrderView.EventDelay.Effective := 0;
101             OrderView.EventDelay.PtEventIFN := 0;
102           end;
103         end else
104           OrderView.Changed := False;
105       end;
106     finally
107       frmOrdersEvntRelease.FEvtList.Clear;
108       frmOrdersEvntRelease.Release;
109       frmOrdersEvntRelease.FOkPressed := False;
110     end;
111   end;
112   
113   procedure TfrmOrdersEvntRelease.FormCreate(Sender: TObject);
114   var
115     CurrTS: string;
116     SpeCap: string;
117     ATotal: integer;
118   begin
119     CurrTS := Piece(GetCurrentSpec(Patient.DFN),'^',1);
120     if Length(CurrTS)>0 then
121       SpeCap := #13 + '  The current treating specialty is ' + CurrTS
122     else
123       SpeCap := #13 + '  No treating specialty is available.';
124     FPtEvt     := '';
125     FEvent.EventType := #0;
126     FEvent.EventIFN  := 0;
127     FEvent.EventName := '';
128     FEvent.PtEventIFN := 0;
129     FEvent.Specialty  := 0;
130     FEvent.Effective := 0;
131     FOkPressed := False;
132     FEvtList := TStringList.Create;
133     FTotal := 5;
134     edtNumber.Text := '5';
135     fPreTxt := edtNumber.Text;
136     if Patient.Inpatient then
137       lblPtInfo.Caption := '  ' + Patient.Name + ' is currently admitted to ' + Encounter.LocationName +  SpeCap
138     else
139     begin
140       if Encounter.Location > 0 then
141         lblPtInfo.Caption := '  ' + Patient.Name + ' is currently at ' + Encounter.LocationName +  SpeCap
142       else
143         lblPtInfo.Caption := '  ' + Patient.Name + ' currently is an outpatient. ' +  SpeCap;
144     end;
145     lblPtInfo.Top := (pnlTop.Height - lblPtInfo.Height) div 2;
146     grdEvtList.Cells[0,0] := 'Event Name';
147     grdEvtList.Cells[1,0] := 'Date/Time Occured';
148     SetPtEvtList(TStrings(fevtList),Patient.DFN, ATotal);
149   end;
150   
151   procedure TfrmOrdersEvntRelease.btnCancelClick(Sender: TObject);
152   begin
153     Close;
154   end;
155   
156   procedure TfrmOrdersEvntRelease.FormShow(Sender: TObject);
157   begin
158     ShowEvents(fTotal);
159   end;
160   
161   procedure TfrmOrdersEvntRelease.grdEvtListDrawCell(Sender: TObject; ACol,
162     ARow: Integer; Rect: TRect; State: TGridDrawState);
163   begin
164    inherited;
165    grdEvtList.Canvas.TextRect(Rect, Rect.Left+2, Rect.Top+2,
166       Piece(grdEvtList.Cells[ACol, ARow], TAB, 1));
167   end;
168   
169   procedure TfrmOrdersEvntRelease.grdEvtListMouseDown(Sender: TObject;
170     Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
171   var
172     ACol, ARow: integer;
173     EvtInfo: string;
174   begin
175     grdEvtList.MouseToCell(X,Y,ACol,ARow);
176     if ARow>0 then
177     begin
178       FPtEvt := Piece(grdEvtList.Cells[0,grdEvtList.Row],TAB,2);
179       if StrToIntDef(FPtEvt,0)>0 then
180         FEvent.PtEventIFN := StrToInt(FPtEvt);
181       EvtInfo := EventInfo(FPtEvt);
182       FEvent.EventIFN  := StrToIntDef( Piece(EvtInfo,'^',2),0);
183       if FEvent.EventIFN > 0 then
184       begin
185         FEvent.EventType := CharAt(Piece(EvtInfo,'^',1),1);
186         FEvent.EventName := Piece(EvtInfo,'^',3);
187       end;
188       FDGroup := DGroupAll;
189       FViewName := 'Patient event -- ' + Piece(grdEvtList.Cells[0,grdEvtList.Row],TAB,1)
190          + ' on ' + grdEvtList.Cells[1,grdEvtList.Row];
191     end;
192   end;
193   
194   procedure TfrmOrdersEvntRelease.btnOKClick(Sender: TObject);
195   var
196     EvtInfo: string;
197   begin
198     if grdEvtList.Row < 1 then
199     begin
200       ShowMsg('You need to select an event first.');
201       FOkPressed := False;
202       Exit;
203     end
204     else
205     begin
206       if AnsiCompareText(grdEvtList.Cells[0,1],'No event order found') = 0 then
207       begin
208         FOKPressed := False;
209         Exit;
210       end;
211       if FPtEvt = '' then
212       begin
213        FPtEvt := Piece(grdEvtList.Cells[0,grdEvtList.Row],TAB,2);
214        if StrToIntDef(FPtEvt,0)>0 then
215          FEvent.PtEventIFN := StrToInt(FPtEvt);
216        EvtInfo := EventInfo(FPtEvt);
217        FEvent.EventIFN  := StrToIntDef( Piece(EvtInfo,'^',2),0);
218        if FEvent.EventIFN > 0 then
219        begin
220          FEvent.EventType := CharAt(Piece(EvtInfo,'^',1),1);
221          FEvent.EventName := Piece(EvtInfo,'^',3);
222        end;
223        FDGroup := DGroupAll;
224        FViewName := 'Patient event -- ' + Piece(grdEvtList.Cells[0,grdEvtList.Row],TAB,1)
225           + ' on ' + grdEvtList.Cells[1,grdEvtList.Row];
226        FOkPressed := True;
227        Close;
228       end else
229       begin
230        FOkPressed := True;
231        Close;
232       end;
233     end;
234   end;
235   
236   procedure TfrmOrdersEvntRelease.grdEvtListKeyPress(Sender: TObject;
237     var Key: Char);
238   var
239     EvtInfo: string;
240   begin
241     if grdEvtList.Row > 0 then
242     begin
243       FPtEvt := Piece(grdEvtList.Cells[0,grdEvtList.Row],TAB,2);
244       if StrToIntDef(FPtEvt,0)>0 then
245         FEvent.PtEventIFN := StrToInt(FPtEvt);
246       EvtInfo := EventInfo(FPtEvt);
247       FEvent.EventIFN  := StrToIntDef( Piece(EvtInfo,'^',2),0);
248       if FEvent.EventIFN > 0 then
249       begin
250         FEvent.EventType := CharAt(Piece(EvtInfo,'^',1),1);
251         FEvent.EventName := Piece(EvtInfo,'^',3);
252       end;
253       FDGroup := DGroupAll;
254       FViewName := 'Released orders for event--Delayed ' + Piece(grdEvtList.Cells[0,grdEvtList.Row],TAB,1)
255         + ' on ' + grdEvtList.Cells[1,grdEvtList.Row];
256       if Key = #13 then btnOKClick(Self);
257     end;
258   end;
259   
260   procedure TfrmOrdersEvntRelease.grdEvtListDblClick(Sender: TObject);
261   begin
262     if grdEvtList.Row > 0 then
263       btnOKClick(Self);
264   end;
265   
266   procedure TfrmOrdersEvntRelease.pnlBottomResize(Sender: TObject);
267   begin
268     grdEvtList.ColWidths[0] := ( grdEvtList.Width div 3 ) * 2;
269     grdEvtList.ColWidths[1] := grdEvtList.Width - grdEvtList.ColWidths[0] - 4;
270   end;
271   
272   procedure TfrmOrdersEvntRelease.ShowEvents(NumOfEvts: integer);
273   var
274     temptot,idx,jdx: integer;
275   begin
276     with grdEvtList do
277       for idx := 0 to ColCount - 1 do
278         for jdx:= 1 to RowCount - 1 do
279           begin
280             Cells[idx,jdx] := '';
281           end;
282     if NumOfEvts = 0 then  temptot := fevtList.Count
283     else temptot := NumOfEvts;
284     if temptot > fevtList.Count then
285        temptot := fevtList.Count;
286     grdEvtList.RowCount := temptot + 1;
287     if temptot = 0 then
288     begin
289       grdEvtList.RowCount := 2;
290       grdEvtList.Cells[0,1] := 'No event order found';
291       btnOK.Enabled := False;
292     end else
293     begin
294       for idx := 1 to grdEvtList.RowCount-1 do
295       begin
296         grdEvtList.Cells[0,idx] := Piece(fevtList[idx-1],'^',2)+ TAB + Piece(fevtList[idx-1],'^',1);
297         grdEvtList.Cells[1,idx] := FormatFMDateTime('mm/dd/yy hh:nn',StrToFloat(Piece(fevtList[idx-1],'^',3)));
298       end;
299     end;
300   end;
301   
302   procedure TfrmOrdersEvntRelease.edtNumberChange(Sender: TObject);
303   begin
304     inherited;
305     if (CharAt(edtNumber.Text,1)='A') or (CharAt(edtNumber.Text,1)='a') then
306     begin
307       edtNumber.Text := 'ALL';
308       edtNumber.SelectAll;
309       fTotal := 0;
310     end
311     else if (StrToIntDef(edtNumber.Text,0)=0) and (AnsiCompareText(edtNumber.Text,'all')<>0) then
312       edtNumber.Text := fPreTxt
313     else if StrToIntDef(edtNumber.Text,0)>0 then
314       fTotal := StrtoInt(edtNumber.Text);
315   end;
316   
317   procedure TfrmOrdersEvntRelease.edtNumberKeyDown(Sender: TObject;
318     var Key: Word; Shift: TShiftState);
319   begin
320     inherited;
321     if Key=VK_RETURN then
322       btnApplyClick(Self);
323   end;
324   
325   procedure TfrmOrdersEvntRelease.btnApplyClick(Sender: TObject);
326   begin
327     inherited;
328     fPreTxt := edtNumber.Text;
329     ShowEvents(fTotal);
330   end;
331   
332   procedure TfrmOrdersEvntRelease.btnApplyKeyDown(Sender: TObject;
333     var Key: Word; Shift: TShiftState);
334   begin
335     inherited;
336     if Key = VK_RETURN then
337       btnApplyClick(Self);
338   end;
339   
340   procedure TfrmOrdersEvntRelease.edtNumberClick(Sender: TObject);
341   begin
342     inherited;
343     edtNumber.SelectAll;
344   end;
345   
346   procedure TfrmOrdersEvntRelease.updown1Click(Sender: TObject;
347     Button: TUDBtnType);
348   begin
349     inherited;
350     fTotal := updown1.Position;
351     edtNumber.Text := IntToStr(updown1.Position);
352     btnApplyClick(Self);
353   end;
354   
355   procedure TfrmOrdersEvntRelease.FormClose(Sender: TObject;
356     var Action: TCloseAction);
357   begin
358     inherited;
359     SaveUserBounds(Self);
360     Action := caFree;
361   end;
362   
363   end.

Module Calls (2 levels)


fOrdersEvntRelease
 ├uCore
 │ ├rCore
 │ ├uConst
 │ ├uCombatVet
 │ ├rTIU
 │ ├rOrders
 │ ├rConsults
 │ └uOrders
 ├rOrders...
 ├fOrders
 │ ├fHSplit
 │ ├rOrders...
 │ ├fODBase
 │ ├uConst
 │ ├uCore...
 │ ├uOrders...
 │ ├UBACore
 │ ├UBAGlobals
 │ ├fFrame
 │ ├fOrderVw
 │ ├fRptBox
 │ ├fLkUpLocation
 │ ├fOrdersDC
 │ ├fOrdersCV
 │ ├fOrdersHold
 │ ├fOrdersUnhold
 │ ├fOrdersAlert
 │ ├fOrderFlag
 │ ├fOrderUnflag
 │ ├fOrdersSign
 │ ├fOrdersRelease
 │ ├fOrdersOnChart
 │ ├fOrdersEvntRelease...
 │ ├fOrdersComplete
 │ ├fOrdersVerify
 │ ├fOrderComment
 │ ├fOrdersRenew
 │ ├fODReleaseEvent
 │ ├rCore...
 │ ├fOCSession
 │ ├fOrdersPrint
 │ ├fOrdersTS
 │ ├fEffectDate
 │ ├fODActive
 │ ├fOrdersCopy
 │ ├uODBase
 │ ├rMeds
 │ ├fODValidateAction
 │ ├fMeds
 │ ├uInit
 │ ├fODConsult
 │ ├fClinicWardMeds
 │ ├fActivateDeactivate
 │ └rODMeds
 ├fAutoSz
 │ └fBase508Form
 └rMisc
   └fOrders...

Module Called-By (2 levels)


       fOrdersEvntRelease
                fOrders┘ 
              uOrders┤   
              fODBase┤   
               fFrame┤   
                rMisc┤   
              uODBase┤   
                fMeds┤   
            fOrdersDC┤   
            fOrdersCV┤   
              fOMNavA┤   
               fOMSet┤   
fOrdersEvntRelease...┤   
      fODReleaseEvent┤   
           mEvntDelay┤   
            fODActive┤   
          fOrdersCopy┤   
             fMedCopy┤   
  fActivateDeactivate┘