| 1 | unit fODReleaseEvent;
|
|---|
| 2 |
|
|---|
| 3 | interface
|
|---|
| 4 |
|
|---|
| 5 | uses
|
|---|
| 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
|---|
| 7 | StdCtrls, ExtCtrls, ORFn, CheckLst, ORCtrls, fAutoSz, fBase508Form,
|
|---|
| 8 | VA508AccessibilityManager;
|
|---|
| 9 |
|
|---|
| 10 | type
|
|---|
| 11 | TfrmOrdersReleaseEvent = class(TfrmBase508Form)
|
|---|
| 12 | pnlMiddle: TPanel;
|
|---|
| 13 | pnlBottom: TPanel;
|
|---|
| 14 | btnOK: TButton;
|
|---|
| 15 | btnCancel: TButton;
|
|---|
| 16 | cklstOrders: TCaptionCheckListBox;
|
|---|
| 17 | lblRelease: TLabel;
|
|---|
| 18 | procedure btnCancelClick(Sender: TObject);
|
|---|
| 19 | procedure FormCreate(Sender: TObject);
|
|---|
| 20 | procedure btnOKClick(Sender: TObject);
|
|---|
| 21 | procedure FormDestroy(Sender: TObject);
|
|---|
| 22 | procedure cklstOrdersMeasureItem(Control: TWinControl; Index: Integer;
|
|---|
| 23 | var AHeight: Integer);
|
|---|
| 24 | procedure cklstOrdersDrawItem(Control: TWinControl; Index: Integer;
|
|---|
| 25 | Rect: TRect; State: TOwnerDrawState);
|
|---|
| 26 | procedure cklstOrdersMouseMove(Sender: TObject; Shift: TShiftState; X,
|
|---|
| 27 | Y: Integer);
|
|---|
| 28 | private
|
|---|
| 29 | { Private declarations }
|
|---|
| 30 | OKPressed: boolean;
|
|---|
| 31 | FLastHintItem: integer;
|
|---|
| 32 | FOldHintPause: integer;
|
|---|
| 33 | FOldHintHidePause: integer;
|
|---|
| 34 | FComplete: boolean;
|
|---|
| 35 | FCurrTS: string;
|
|---|
| 36 | public
|
|---|
| 37 | { Public declarations }
|
|---|
| 38 | property CurrTS: string read FCurrTS write FCurrTS;
|
|---|
| 39 | end;
|
|---|
| 40 |
|
|---|
| 41 | //procedure ExecuteReleaseEventOrders(AnOrderList: TList);
|
|---|
| 42 | function ExecuteReleaseEventOrders(AnOrderList: TList): boolean;
|
|---|
| 43 |
|
|---|
| 44 | implementation
|
|---|
| 45 | {$R *.DFM}
|
|---|
| 46 |
|
|---|
| 47 | uses rCore, rOrders, uConst, fOrdersPrint, uCore, uOrders, fOrders, rODLab, fRptBox,
|
|---|
| 48 | VAUtils;
|
|---|
| 49 |
|
|---|
| 50 | const
|
|---|
| 51 | TX_SAVERR1 = 'The error, ';
|
|---|
| 52 | TX_SAVERR2 = ', occurred while trying to release:' + CRLF + CRLF;
|
|---|
| 53 | TC_SAVERR = 'Error Saving Order';
|
|---|
| 54 |
|
|---|
| 55 | //procedure ExecuteReleaseEventOrders(AnOrderList: TList);
|
|---|
| 56 | function ExecuteReleaseEventOrders(AnOrderList: TList): boolean;
|
|---|
| 57 | const
|
|---|
| 58 | TXT_RELEASE = #13 + #13 + ' The following orders will be released to service:';
|
|---|
| 59 | var
|
|---|
| 60 | i,j,idx: integer;
|
|---|
| 61 | AOrder: TOrder;
|
|---|
| 62 | OrdersLst: TStringlist;
|
|---|
| 63 | OrderText, LastCheckedPtEvt, SpeCap: string;
|
|---|
| 64 | frmOrdersReleaseEvent: TfrmOrdersReleaseEvent;
|
|---|
| 65 | AList: TStringList;
|
|---|
| 66 |
|
|---|
| 67 | function FindOrderText(const AnID: string): string;
|
|---|
| 68 | var
|
|---|
| 69 | i: Integer;
|
|---|
| 70 | begin
|
|---|
| 71 | Result := '';
|
|---|
| 72 | with AnOrderList do for i := 0 to Count - 1 do
|
|---|
| 73 | with TOrder(Items[i]) do if ID = AnID then
|
|---|
| 74 | begin
|
|---|
| 75 | Result := Text;
|
|---|
| 76 | Break;
|
|---|
| 77 | end;
|
|---|
| 78 | end;
|
|---|
| 79 |
|
|---|
| 80 | begin
|
|---|
| 81 | frmOrdersReleaseEvent := TfrmOrdersReleaseEvent.Create(Application);
|
|---|
| 82 | try
|
|---|
| 83 | frmOrdersReleaseEvent.CurrTS := Piece(GetCurrentSpec(Patient.DFN),'^',1);
|
|---|
| 84 | if Length(frmOrdersReleaseEvent.CurrTS)>0 then
|
|---|
| 85 | SpeCap := #13 + ' The current treating specialty is ' + frmOrdersReleaseEvent.CurrTS
|
|---|
| 86 | else
|
|---|
| 87 | SpeCap := #13 + ' No treating specialty is available.';
|
|---|
| 88 | ResizeFormToFont(TForm(frmOrdersReleaseEvent));
|
|---|
| 89 | if Patient.Inpatient then
|
|---|
| 90 | frmOrdersReleaseEvent.lblRelease.Caption := ' ' + Patient.Name + ' is currently admitted to '
|
|---|
| 91 | + Encounter.LocationName + SpeCap + TXT_RELEASE
|
|---|
| 92 | else
|
|---|
| 93 | begin
|
|---|
| 94 | if Encounter.Location > 0 then
|
|---|
| 95 | frmOrdersReleaseEvent.lblRelease.Caption := ' ' + Patient.Name + ' is currently at '
|
|---|
| 96 | + Encounter.LocationName + SpeCap + TXT_RELEASE
|
|---|
| 97 | else
|
|---|
| 98 | frmOrdersReleaseEvent.lblRelease.Caption := ' ' + Patient.Name + ' is currently an outpatient.' + SpeCap + TXT_RELEASE;
|
|---|
| 99 | end;
|
|---|
| 100 | with frmOrdersReleaseEvent do
|
|---|
| 101 | cklstOrders.Caption := lblRelease.Caption;
|
|---|
| 102 | with AnOrderList do for i := 0 to Count - 1 do
|
|---|
| 103 | begin
|
|---|
| 104 | AOrder := TOrder(Items[i]);
|
|---|
| 105 | idx := frmOrdersReleaseEvent.cklstOrders.Items.AddObject(AOrder.Text,AOrder);
|
|---|
| 106 | frmOrdersReleaseEvent.cklstOrders.Checked[idx] := True;
|
|---|
| 107 | end;
|
|---|
| 108 | frmOrdersReleaseEvent.ShowModal;
|
|---|
| 109 | if frmOrdersReleaseEvent.OKPressed then
|
|---|
| 110 | begin
|
|---|
| 111 | OrdersLst := TStringList.Create;
|
|---|
| 112 | for j := 0 to frmOrdersReleaseEvent.cklstOrders.Items.Count - 1 do
|
|---|
| 113 | begin
|
|---|
| 114 | if frmOrdersReleaseEvent.cklstOrders.Checked[j] then
|
|---|
| 115 | OrdersLst.Add(TOrder(frmOrdersReleaseEvent.cklstOrders.Items.Objects[j]).ID);
|
|---|
| 116 | end;
|
|---|
| 117 | StatusText('Releasing Orders to Service...');
|
|---|
| 118 | SendReleaseOrders(OrdersLst);
|
|---|
| 119 | LastCheckedPtEvt := '';
|
|---|
| 120 |
|
|---|
| 121 | //CQ #15813 Modired code to look for error string mentioned in CQ and change strings to conts - JCS
|
|---|
| 122 | with OrdersLst do if Count > 0 then for i := 0 to Count - 1 do
|
|---|
| 123 | begin
|
|---|
| 124 | if Pos('E', Piece(OrdersLst[i], U, 2)) > 0 then
|
|---|
| 125 | begin
|
|---|
| 126 | OrderText := FindOrderText(Piece(OrdersLst[i], U, 1));
|
|---|
| 127 | if Piece(OrdersLst[i],U,4) = TX_SAVERR_PHARM_ORD_NUM_SEARCH_STRING then
|
|---|
| 128 | InfoBox(TX_SAVERR1 + Piece(OrdersLst[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
|
|---|
| 129 | TX_SAVERR_PHARM_ORD_NUM, TC_SAVERR, MB_OK)
|
|---|
| 130 | else if Piece(OrdersLst[i],U,4) = TX_SAVERR_IMAGING_PROC_SEARCH_STRING then
|
|---|
| 131 | InfoBox(TX_SAVERR1 + Piece(OrdersLst[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
|
|---|
| 132 | TX_SAVERR_IMAGING_PROC, TC_SAVERR, MB_OK)
|
|---|
| 133 | else
|
|---|
| 134 | InfoBox(TX_SAVERR1 + Piece(OrdersLst[i], U, 4) + TX_SAVERR2 + OrderText,
|
|---|
| 135 | TC_SAVERR, MB_OK);
|
|---|
| 136 | end;
|
|---|
| 137 | end;
|
|---|
| 138 | // CQ 10226, PSI-05-048 - advise of auto-change from LC to WC on lab orders
|
|---|
| 139 | AList := TStringList.Create;
|
|---|
| 140 | try
|
|---|
| 141 | CheckForChangeFromLCtoWCOnRelease(AList, Encounter.Location, OrdersLst);
|
|---|
| 142 | if AList.Text <> '' then
|
|---|
| 143 | ReportBox(AList, 'Changed Orders', TRUE);
|
|---|
| 144 | finally
|
|---|
| 145 | AList.Free;
|
|---|
| 146 | end;
|
|---|
| 147 | PrintOrdersOnSignRelease(OrdersLst, NO_PROVIDER);
|
|---|
| 148 |
|
|---|
| 149 | with AnOrderList do for i := 0 to Count - 1 do with TOrder(Items[i]) do
|
|---|
| 150 | begin
|
|---|
| 151 | if EventPtr <> LastCheckedPtEvt then
|
|---|
| 152 | begin
|
|---|
| 153 | LastCheckedPtEvt := EventPtr;
|
|---|
| 154 | if CompleteEvt(EventPtr,EventName,False) then
|
|---|
| 155 | frmOrdersReleaseEvent.FComplete := True;
|
|---|
| 156 | end;
|
|---|
| 157 | end;
|
|---|
| 158 | StatusText('');
|
|---|
| 159 | ordersLst.Free;
|
|---|
| 160 | with AnOrderList do for i := 0 to Count - 1 do UnlockOrder(TOrder(Items[i]).ID);
|
|---|
| 161 | if frmOrdersReleaseEvent.FComplete then
|
|---|
| 162 | begin
|
|---|
| 163 | frmOrders.InitOrderSheetsForEvtDelay;
|
|---|
| 164 | frmOrders.ClickLstSheet;
|
|---|
| 165 | end;
|
|---|
| 166 | frmOrdersReleaseEvent.FComplete := False;
|
|---|
| 167 | Result := True;
|
|---|
| 168 | end else
|
|---|
| 169 | Result := False;
|
|---|
| 170 | Except
|
|---|
| 171 | on E: exception do
|
|---|
| 172 | Result := false;
|
|---|
| 173 | end;
|
|---|
| 174 | {finally
|
|---|
| 175 | with AnOrderList do for i := 0 to Count - 1 do UnlockOrder(TOrder(Items[i]).ID);
|
|---|
| 176 | if frmOrdersReleaseEvent.FComplete then
|
|---|
| 177 | begin
|
|---|
| 178 | frmOrders.InitOrderSheetsForEvtDelay;
|
|---|
| 179 | frmOrders.ClickLstSheet;
|
|---|
| 180 | end;
|
|---|
| 181 | frmOrdersReleaseEvent.FComplete := False;
|
|---|
| 182 | end;}
|
|---|
| 183 | end;
|
|---|
| 184 |
|
|---|
| 185 | procedure TfrmOrdersReleaseEvent.btnCancelClick(Sender: TObject);
|
|---|
| 186 | begin
|
|---|
| 187 | Close;
|
|---|
| 188 | end;
|
|---|
| 189 |
|
|---|
| 190 | procedure TfrmOrdersReleaseEvent.FormCreate(Sender: TObject);
|
|---|
| 191 | begin
|
|---|
| 192 | inherited;
|
|---|
| 193 | OKPressed := False;
|
|---|
| 194 | FLastHintItem := -1;
|
|---|
| 195 | FComplete := False;
|
|---|
| 196 | FOldHintPause := Application.HintPause;
|
|---|
| 197 | FCurrTS := '';
|
|---|
| 198 | Application.HintPause := 250;
|
|---|
| 199 | FOldHintHidePause := Application.HintHidePause;
|
|---|
| 200 | Application.HintHidePause := 30000;
|
|---|
| 201 | end;
|
|---|
| 202 |
|
|---|
| 203 | procedure TfrmOrdersReleaseEvent.btnOKClick(Sender: TObject);
|
|---|
| 204 | var
|
|---|
| 205 | i: integer;
|
|---|
| 206 | beSelected: boolean;
|
|---|
| 207 | begin
|
|---|
| 208 | beSelected := False;
|
|---|
| 209 | for i := 0 to cklstOrders.Items.Count - 1 do
|
|---|
| 210 | begin
|
|---|
| 211 | if cklstOrders.Checked[i] then
|
|---|
| 212 | begin
|
|---|
| 213 | beSelected := True;
|
|---|
| 214 | Break;
|
|---|
| 215 | end;
|
|---|
| 216 | end;
|
|---|
| 217 | if not beSelected then
|
|---|
| 218 | begin
|
|---|
| 219 | ShowMsg('You have to select at least one order!');
|
|---|
| 220 | Exit;
|
|---|
| 221 | end;
|
|---|
| 222 | OKPressed := True;
|
|---|
| 223 | Close;
|
|---|
| 224 | end;
|
|---|
| 225 |
|
|---|
| 226 | procedure TfrmOrdersReleaseEvent.FormDestroy(Sender: TObject);
|
|---|
| 227 | begin
|
|---|
| 228 | inherited;
|
|---|
| 229 | Application.HintPause := FOldHintPause;
|
|---|
| 230 | Application.HintHidePause := FOldHintHidePause;
|
|---|
| 231 | end;
|
|---|
| 232 |
|
|---|
| 233 | procedure TfrmOrdersReleaseEvent.cklstOrdersMeasureItem(
|
|---|
| 234 | Control: TWinControl; Index: Integer; var AHeight: Integer);
|
|---|
| 235 | var
|
|---|
| 236 | x:string;
|
|---|
| 237 | ARect: TRect;
|
|---|
| 238 | begin
|
|---|
| 239 | inherited;
|
|---|
| 240 | AHeight := MainFontHeight + 2;
|
|---|
| 241 | with cklstOrders do if Index < Items.Count then
|
|---|
| 242 | begin
|
|---|
| 243 | x := FilteredString(Items[Index]);
|
|---|
| 244 | ARect := ItemRect(Index);
|
|---|
| 245 | AHeight := WrappedTextHeightByFont( cklstOrders.Canvas, Font, x, ARect);
|
|---|
| 246 | if AHeight > 255 then AHeight := 255;
|
|---|
| 247 | if AHeight < 13 then AHeight := 13;
|
|---|
| 248 | end;
|
|---|
| 249 | end;
|
|---|
| 250 |
|
|---|
| 251 | procedure TfrmOrdersReleaseEvent.cklstOrdersDrawItem(Control: TWinControl;
|
|---|
| 252 | Index: Integer; Rect: TRect; State: TOwnerDrawState);
|
|---|
| 253 | var
|
|---|
| 254 | x: string;
|
|---|
| 255 | ARect: TRect;
|
|---|
| 256 | begin
|
|---|
| 257 | inherited;
|
|---|
| 258 | x := '';
|
|---|
| 259 | ARect := Rect;
|
|---|
| 260 | with cklstOrders do
|
|---|
| 261 | begin
|
|---|
| 262 | Canvas.FillRect(ARect);
|
|---|
| 263 | Canvas.Pen.Color := Get508CompliantColor(clSilver);
|
|---|
| 264 | Canvas.MoveTo(0, ARect.Bottom - 1);
|
|---|
| 265 | Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
|
|---|
| 266 | if Index < Items.Count then
|
|---|
| 267 | begin
|
|---|
| 268 | X := FilteredString(Items[Index]);
|
|---|
| 269 | DrawText(Canvas.handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
|
|---|
| 270 | end;
|
|---|
| 271 | end;
|
|---|
| 272 | end;
|
|---|
| 273 |
|
|---|
| 274 | procedure TfrmOrdersReleaseEvent.cklstOrdersMouseMove(Sender: TObject;
|
|---|
| 275 | Shift: TShiftState; X, Y: Integer);
|
|---|
| 276 | var
|
|---|
| 277 | Itm: integer;
|
|---|
| 278 | begin
|
|---|
| 279 | inherited;
|
|---|
| 280 | Itm := cklstOrders.ItemAtPos(Point(X, Y), TRUE);
|
|---|
| 281 | if (Itm >= 0) then
|
|---|
| 282 | begin
|
|---|
| 283 | if (Itm <> FLastHintItem) then
|
|---|
| 284 | begin
|
|---|
| 285 | Application.CancelHint;
|
|---|
| 286 | cklstOrders.Hint := TrimRight(cklstOrders.Items[Itm]);
|
|---|
| 287 | FLastHintItem := Itm;
|
|---|
| 288 | Application.ActivateHint(Point(X, Y));
|
|---|
| 289 | end;
|
|---|
| 290 | end else
|
|---|
| 291 | begin
|
|---|
| 292 | cklstOrders.Hint := '';
|
|---|
| 293 | FLastHintItem := -1;
|
|---|
| 294 | Application.CancelHint;
|
|---|
| 295 | end;
|
|---|
| 296 | end;
|
|---|
| 297 |
|
|---|
| 298 | end.
|
|---|
