| 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.
|
---|