Module

fOrderSaveQuick

Path

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

Last Modified

7/15/2014 3:26:42 PM

Units Used in Interface

Name Comments
fAutoSz -
fODBase -
uOrders -

Units Used in Implementation

Name Comments
fRename -
rODBase -
rOrders -

Classes

Name Comments
TfrmSaveQuickOrder -

Procedures

Name Owner Declaration Scope Comments
cmdCancelClick TfrmSaveQuickOrder procedure cmdCancelClick(Sender: TObject); Public/Published -
cmdDeleteClick TfrmSaveQuickOrder procedure cmdDeleteClick(Sender: TObject); Public/Published -
cmdDownClick TfrmSaveQuickOrder procedure cmdDownClick(Sender: TObject); Public/Published -
cmdOKClick TfrmSaveQuickOrder procedure cmdOKClick(Sender: TObject); Public/Published -
cmdRenameClick TfrmSaveQuickOrder procedure cmdRenameClick(Sender: TObject); Public/Published -
cmdUpClick TfrmSaveQuickOrder procedure cmdUpClick(Sender: TObject); Public/Published -
FormCreate TfrmSaveQuickOrder procedure FormCreate(Sender: TObject); Public/Published -
pnlUpButtonEnter TfrmSaveQuickOrder procedure pnlUpButtonEnter(Sender: TObject); Public/Published -
pnlUpButtonExit TfrmSaveQuickOrder procedure pnlUpButtonExit(Sender: TObject); Public/Published -
txtDisplayNameChange TfrmSaveQuickOrder procedure txtDisplayNameChange(Sender: TObject); Public/Published -

Functions

Name Owner Declaration Scope Comments
EditCommonList - function EditCommonList(ADisplayGroup: Integer): Boolean; Interfaced -
SaveAsQuickOrder - function SaveAsQuickOrder(ResponseSet: TResponses): Boolean; Interfaced -

Constants

Name Declaration Scope Comments
TC_DEL_CONFIRM 'Remove Quick Order' Global -
TC_DNAME_REQ 'Display Name Missing' Global -
TC_DUP_NAME 'Unable to save quick order' Global -
TC_DUP_RENAME 'Unable to rename quick order' Global -
TC_NO_DEL_NEW 'Remove Quick Order' Global -
TC_NO_TEXT 'Save as Quick Order' Global -
TX_DEL_CONFIRM 'Remove the following quick order from your list?' + CRLF + CRLF Global -
TX_DNAME_REQ 'A name for the quick order must be entered in order to save it.' Global -
TX_DUP_NAME 'There is already a quick order with that name.' + CRLF + Global -
TX_NO_DEL_NEW 'A new quick order cannot be deleted. Press <Cancel> instead.' Global -
TX_NO_TEXT 'No fields have been entered - cannot save as quick order.' Global -
TX_QO_RENAME 'Rename Quick Order' Global -


Module Source

1     unit fOrderSaveQuick;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       fAutoSz, Buttons, ExtCtrls, StdCtrls, ORCtrls, ORFn, fODBase, uOrders,
8       VA508AccessibilityManager;
9     
10    type
11      TfrmSaveQuickOrder = class(TfrmAutoSz)
12        Panel1: TPanel;
13        memOrder: TMemo;
14        lblDisplayName: TLabel;
15        txtDisplayName: TCaptionEdit;
16        Panel2: TPanel;
17        lblQuickList: TLabel;
18        lstQuickList: TORListBox;
19        pnlUpButton: TKeyClickPanel;
20        cmdUp: TSpeedButton;
21        pnlDownButton: TKeyClickPanel;
22        cmdRename: TButton;
23        cmdDelete: TButton;
24        cmdDown: TSpeedButton;
25        Panel3: TPanel;
26        cmdOK: TButton;
27        cmdCancel: TButton;
28        procedure FormCreate(Sender: TObject);
29        procedure cmdOKClick(Sender: TObject);
30        procedure cmdCancelClick(Sender: TObject);
31        procedure txtDisplayNameChange(Sender: TObject);
32        procedure cmdUpClick(Sender: TObject);
33        procedure cmdDownClick(Sender: TObject);
34        procedure cmdRenameClick(Sender: TObject);
35        procedure cmdDeleteClick(Sender: TObject);
36        procedure pnlUpButtonEnter(Sender: TObject);
37        procedure pnlUpButtonExit(Sender: TObject);
38      private
39        OKPressed: Boolean;
40      end;
41    
42    function EditCommonList(ADisplayGroup: Integer): Boolean;
43    function SaveAsQuickOrder(ResponseSet: TResponses): Boolean;
44    
45    implementation
46    
47    {$R *.DFM}
48    
49    uses rODBase, rOrders, fRename;
50    
51    const
52      TX_DNAME_REQ = 'A name for the quick order must be entered in order to save it.';
53      TC_DNAME_REQ = 'Display Name Missing';
54      TX_DEL_CONFIRM = 'Remove the following quick order from your list?' + CRLF + CRLF;
55      TC_DEL_CONFIRM = 'Remove Quick Order';
56      TX_QO_RENAME   = 'Rename Quick Order';
57      TX_NO_DEL_NEW  = 'A new quick order cannot be deleted.  Press <Cancel> instead.';
58      TC_NO_DEL_NEW  = 'Remove Quick Order';
59      TX_NO_TEXT     = 'No fields have been entered - cannot save as quick order.';
60      TC_NO_TEXT     = 'Save as Quick Order';
61      TX_DUP_NAME = 'There is already a quick order with that name.' + CRLF +
62                    'Please either delete the original or enter a different name.';
63      TC_DUP_NAME = 'Unable to save quick order';
64      TC_DUP_RENAME = 'Unable to rename quick order';
65    
66    function EditCommonList(ADisplayGroup: Integer): Boolean;
67    var
68      frmSaveQuickOrder: TfrmSaveQuickOrder;
69      DGroupName: string;
70    begin
71      Result := False;
72      frmSaveQuickOrder := TfrmSaveQuickOrder.Create(Application);
73      try
74        ResizeFormToFont(TForm(frmSaveQuickOrder));
75        with frmSaveQuickOrder do
76        begin
77          if ADisplayGroup = ClinDisp then
78            ADisplayGroup := InptDisp;
79          DGroupName := NameOfDGroup(ADisplayGroup);
80          Caption := 'Edit Common Order List (' + DGroupName + ')';
81          lblQuickList.Caption := 'Common List for ' + DGroupName;
82          lstQuickList.Caption := lblQuickList.Caption;
83          lblDisplayName.Font.Color := clGrayText;
84          txtDisplayName.Enabled := False;
85          txtDisplayName.Color := clBtnFace;
86          with lstQuickList do
87          begin
88            LoadQuickListForOD(Items, ADisplayGroup);
89            ItemIndex := 0;
90          end;
91          ActiveControl := lstQuickList;
92          ShowModal;
93          if OKPressed then
94          begin
95            Result := True;
96            // replace the user's quick list with this new quick list
97            SaveQuickListForOD(lstQuickList.Items, ADisplayGroup);
98          end; {if OKPressed}
99        end; {with frmSaveQuickOrder}
100     finally
101       frmSaveQuickOrder.Release;
102     end;
103   end;
104   
105   function SaveAsQuickOrder(ResponseSet: TResponses): Boolean;
106   const
107     EMPTY_CRC = 'FFFFFFFF';
108   var
109     frmSaveQuickOrder: TfrmSaveQuickOrder;
110     DGroupName, QuickName, CRC: string;
111     NewIEN, AnIndex, i: Integer;
112     IsClinicOrder: boolean;
113   begin
114     Result := False;
115     CRC := ResponseSet.OrderCRC;
116     IsClinicOrder := False;
117     if CRC = EMPTY_CRC then
118     begin
119       InfoBox(TX_NO_TEXT, TC_NO_TEXT, MB_OK);
120       Exit;
121     end;
122     frmSaveQuickOrder := TfrmSaveQuickOrder.Create(Application);
123     try
124       ResizeFormToFont(TForm(frmSaveQuickOrder));
125       with frmSaveQuickOrder do
126       begin
127         if (ResponseSet.DisplayGroup = ClinDisp) and (ResponseSet.Dialog = 'PSJI OR PAT FLUID OE') then
128           begin
129             ResponseSet.DisplayGroup := IVDisp;
130             IsClinicOrder := True;
131           end;
132         if ResponseSet.DisplayGroup = ClinDisp then
133           DGroupName := NameOfDGroup(InptDisp)
134         else
135           DGroupName := NameOfDGroup(ResponseSet.DisplayGroup);
136         if DGroupName = 'Inpt. Meds' then
137           begin
138             ResponseSet.DisplayGroup := InptDisp;
139             DGroupName := NameOfDGroup(InptDisp);
140           end;
141         Caption := 'Add Quick Order (' + DGroupName + ')';
142         lblQuickList.Caption := 'Common List for ' + DGroupName;
143         lstQuickList.Caption := lblQuickList.Caption;
144         QuickName := GetQuickName(CRC);
145         memOrder.Text := ResponseSet.OrderText;
146         txtDisplayName.Text := QuickName;
147         with lstQuickList do
148         begin
149           if ResponseSet.DisplayGroup = ClinDisp then
150             LoadQuickListForOD(Items, InptDisp)
151           else
152             LoadQuickListForOD(Items, ResponseSet.DisplayGroup);
153           if Length(QuickName) > 0
154             then Items.Insert(0, '-1^' + QuickName)
155             else Items.Insert(0, '-1^<New Quick Order>');
156           ItemIndex := 0;
157         end;
158         ActiveControl := txtDisplayName;
159         ShowModal;
160         if OKPressed then
161         begin
162           Result := True;
163           // save reponses as quick order
164           ResponseSet.SaveQuickOrder(NewIEN, txtDisplayName.Text);
165           // find the new quick order and set the new IEN
166           AnIndex := -1;
167           with lstQuickList do for i := 0 to Items.Count - 1 do
168             if GetIEN(i) = -1 then AnIndex := i;
169           if AnIndex > -1 then lstQuickList.Items[AnIndex] := IntToStr(NewIEN) + U +
170                                                               txtDisplayName.Text;
171           // replace the user's quick list with this new quick list
172           if ResponseSet.DisplayGroup = ClinDisp then
173             SaveQuickListForOD(lstQuickList.Items, InptDisp)
174           else
175             SaveQuickListForOD(lstQuickList.Items, ResponseSet.DisplayGroup);
176         end; {if OKPressed}
177         if IsClinicOrder = True then ResponseSet.DisplayGroup := ClinDisp;
178       end; {with frmSaveQuickOrder}
179     finally
180       frmSaveQuickOrder.Release;
181     end;
182   end;
183   
184   procedure TfrmSaveQuickOrder.txtDisplayNameChange(Sender: TObject);
185   var
186     AnIndex, i: Integer;
187   begin
188     inherited;
189     if txtDisplayName.Text = '' then Exit;
190     AnIndex := -1;
191     with lstQuickList do for i := 0 to Items.Count - 1 do
192       if GetIEN(i) = -1 then AnIndex := i;
193     if AnIndex > -1 then lstQuickList.Items[AnIndex] := '-1^' + txtDisplayName.Text;
194   end;
195   
196   procedure TfrmSaveQuickOrder.cmdUpClick(Sender: TObject);
197   var
198     NewIndex: Integer;
199   begin
200     inherited;
201     with lstQuickList do
202     begin
203       if ItemIndex < 1 then Exit;
204       NewIndex := ItemIndex - 1;
205       Items.Move(ItemIndex, NewIndex);
206       ItemIndex := NewIndex;
207     end;
208   end;
209   
210   procedure TfrmSaveQuickOrder.cmdDownClick(Sender: TObject);
211   var
212     NewIndex: Integer;
213   begin
214     inherited;
215     with lstQuickList do
216     begin
217       if ItemIndex > Items.Count - 2 then Exit;
218       NewIndex := ItemIndex + 1;
219       Items.Move(ItemIndex, NewIndex);
220       ItemIndex := NewIndex;
221     end;
222   end;
223   
224   procedure TfrmSaveQuickOrder.cmdRenameClick(Sender: TObject);
225   var
226     AName: string;
227     i: integer;
228   begin
229     inherited;
230     with lstQuickList do
231     begin
232       if ItemIndex < 0 then Exit;
233       AName := Piece(Items[ItemIndex], U, 2);
234       if ExecuteRename(AName, TX_QO_RENAME) then
235       begin
236         i := Items.IndexOf(AName);
237         if (i > -1) and (i <> ItemIndex) then
238           InfoBox(TX_DUP_NAME, TC_DUP_RENAME, MB_ICONERROR or MB_OK)
239         else
240           Items[ItemIndex] := Piece(Items[ItemIndex], U, 1) + U + AName;
241       end;
242     end;
243   
244   end;
245   
246   procedure TfrmSaveQuickOrder.cmdDeleteClick(Sender: TObject);
247   begin
248     inherited;
249     with lstQuickList do
250     begin
251       if ItemIndex < 0 then Exit;
252       if ItemIEN = -1 then
253       begin
254         InfoBox(TX_NO_DEL_NEW, TC_NO_DEL_NEW, MB_OK);
255         Exit;
256       end;
257       if InfoBox(TX_DEL_CONFIRM + DisplayText[ItemIndex], TC_DEL_CONFIRM,
258         MB_YESNO or MB_ICONQUESTION) = IDYES then Items.Delete(ItemIndex);
259     end;
260   end;
261   
262   procedure TfrmSaveQuickOrder.FormCreate(Sender: TObject);
263   begin
264     inherited;
265     OKPressed := False;
266   end;
267   
268   procedure TfrmSaveQuickOrder.cmdOKClick(Sender: TObject);
269   var
270     i: integer;
271   begin
272     inherited;
273     if txtDisplayName.Enabled then
274     begin
275       if (txtDisplayName.Text = '') then
276       begin
277         InfoBox(TX_DNAME_REQ, TC_DNAME_REQ, MB_OK);
278         Exit;
279       end;
280       for i := 0 to lstQuickList.Count - 1 do
281         if (UpperCase(lstQuickList.DisplayText[i]) = UpperCase(txtDisplayName.Text)) and (i > 0) then
282         begin
283           InfoBox(TX_DUP_NAME, TC_DUP_NAME, MB_ICONERROR or MB_OK);
284           lstQuickList.ItemIndex := i;
285           Exit;
286         end;
287     end;
288     OKPressed := True;
289     Close;
290   end;
291   
292   procedure TfrmSaveQuickOrder.cmdCancelClick(Sender: TObject);
293   begin
294     inherited;
295     Close;
296   end;
297   
298   procedure TfrmSaveQuickOrder.pnlUpButtonEnter(Sender: TObject);
299   begin
300     inherited;
301     TPanel(Sender).BevelOuter := bvRaised;
302   end;
303   
304   procedure TfrmSaveQuickOrder.pnlUpButtonExit(Sender: TObject);
305   begin
306     inherited;
307     TPanel(Sender).BevelOuter := bvNone;
308   end;
309   
310   end.

Module Calls (2 levels)


fOrderSaveQuick
 ├fAutoSz
 │ └fBase508Form
 ├fODBase
 │ ├fAutoSz...
 │ ├uConst
 │ ├rOrders
 │ ├rODBase
 │ ├uCore
 │ ├UBAGlobals
 │ ├UBACore
 │ ├fOCAccept
 │ ├uODBase
 │ ├rCore
 │ ├rMisc
 │ ├fTemplateDialog
 │ ├uEventHooks
 │ ├uTemplates
 │ ├rConsults
 │ ├fOrders
 │ ├uOrders
 │ ├fFrame
 │ ├fODDietLT
 │ └rODDiet
 ├uOrders...
 ├rODBase...
 ├rOrders...
 └fRename
   └fAutoSz...

Module Called-By (2 levels)


             fOrderSaveQuick
                   uOrders┘ 
                   uCore┤   
                 fODBase┤   
                 rODBase┤   
                  fFrame┤   
                 fOrders┤   
             fOrdersSign┤   
                   fMeds┤   
               fARTAllgy┤   
                  fNotes┤   
               fConsults┤   
         fReminderDialog┤   
                 fReview┤   
            fOrdersRenew┤   
               fOrdersCV┤   
                 fODMeds┤   
                 fOMNavA┤   
      fOrderSaveQuick...┤   
                  fOMSet┤   
          fOrdersRelease┤   
                 fOMHTML┤   
               fODMedNVA┤   
fODChangeUnreleasedRenew┤   
          fOrdersOnChart┤   
         fODReleaseEvent┤   
               fODActive┘