| 1 | //kt -- Modified with SourceScanner on 8/8/2007
|
|---|
| 2 | unit fOrdersDC;
|
|---|
| 3 |
|
|---|
| 4 | interface
|
|---|
| 5 |
|
|---|
| 6 | uses
|
|---|
| 7 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
|---|
| 8 | fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, DKLang;
|
|---|
| 9 |
|
|---|
| 10 | type
|
|---|
| 11 | TfrmDCOrders = class(TfrmAutoSz)
|
|---|
| 12 | Label1: TLabel;
|
|---|
| 13 | Panel1: TPanel;
|
|---|
| 14 | lstOrders: TCaptionListBox;
|
|---|
| 15 | Panel2: TPanel;
|
|---|
| 16 | lblReason: TLabel;
|
|---|
| 17 | lstReason: TORListBox;
|
|---|
| 18 | cmdOK: TButton;
|
|---|
| 19 | cmdCancel: TButton;
|
|---|
| 20 | procedure FormCreate(Sender: TObject);
|
|---|
| 21 | procedure cmdOKClick(Sender: TObject);
|
|---|
| 22 | procedure cmdCancelClick(Sender: TObject);
|
|---|
| 23 | procedure lstOrdersDrawItem(Control: TWinControl; Index: Integer;
|
|---|
| 24 | Rect: TRect; State: TOwnerDrawState);
|
|---|
| 25 | procedure lstOrdersMeasureItem(Control: TWinControl; Index: Integer;
|
|---|
| 26 | var AHeight: Integer);
|
|---|
| 27 | private
|
|---|
| 28 | OKPressed: Boolean;
|
|---|
| 29 | DCReason: Integer;
|
|---|
| 30 | function MeasureColumnHeight(TheOrderText: string; Index: Integer):integer;
|
|---|
| 31 | end;
|
|---|
| 32 |
|
|---|
| 33 | function ExecuteDCOrders(SelectedList: TList; var DelEvt: boolean): Boolean;
|
|---|
| 34 |
|
|---|
| 35 | implementation
|
|---|
| 36 |
|
|---|
| 37 | {$R *.DFM}
|
|---|
| 38 |
|
|---|
| 39 | uses rOrders, uCore, uConst, fOrders;
|
|---|
| 40 |
|
|---|
| 41 | function ExecuteDCOrders(SelectedList: TList; var DelEvt: boolean): Boolean;
|
|---|
| 42 | const
|
|---|
| 43 | DCT_NEWORDER = 1;
|
|---|
| 44 | DCT_DELETION = 2;
|
|---|
| 45 | DCT_NEWSTATUS = 3;
|
|---|
| 46 |
|
|---|
| 47 | var
|
|---|
| 48 | frmDCOrders: TfrmDCOrders;
|
|---|
| 49 | AnOrder: TOrder;
|
|---|
| 50 | i,CanSign, DCType: Integer;
|
|---|
| 51 | NeedReason,NeedRefresh,OnCurrent: Boolean;
|
|---|
| 52 | OriginalID,APtEvtID,APtEvtName,AnEvtInfo,tmpPtEvt: string;
|
|---|
| 53 | PtEvtList: TStringList;
|
|---|
| 54 | begin
|
|---|
| 55 | Result := False;
|
|---|
| 56 | DelEvt := False;
|
|---|
| 57 | OnCurrent := False;
|
|---|
| 58 | NeedRefresh := False;
|
|---|
| 59 | PtEvtList := TStringList.Create;
|
|---|
| 60 | if SelectedList.Count = 0 then Exit;
|
|---|
| 61 | frmDCOrders := TfrmDCOrders.Create(Application);
|
|---|
| 62 | try
|
|---|
| 63 | ResizeFormToFont(TForm(frmDCOrders));
|
|---|
| 64 | NeedReason := False;
|
|---|
| 65 | with SelectedList do for i := 0 to Count - 1 do
|
|---|
| 66 | begin
|
|---|
| 67 | AnOrder := TOrder(Items[i]);
|
|---|
| 68 | frmDCOrders.lstOrders.Items.Add(AnOrder.Text);
|
|---|
| 69 | if not ((AnOrder.Status = 11) and (AnOrder.Signature = 2)) then NeedReason := True;
|
|---|
| 70 | end;
|
|---|
| 71 | if NeedReason then
|
|---|
| 72 | begin
|
|---|
| 73 | frmDCOrders.lblReason.Visible := True;
|
|---|
| 74 | frmDCOrders.lstReason.Visible := True;
|
|---|
| 75 | end else
|
|---|
| 76 | begin
|
|---|
| 77 | frmDCOrders.lblReason.Visible := False;
|
|---|
| 78 | frmDCOrders.lstReason.Visible := False;
|
|---|
| 79 | end;
|
|---|
| 80 | frmDCOrders.ShowModal;
|
|---|
| 81 | if frmDCOrders.OKPressed then
|
|---|
| 82 | begin
|
|---|
| 83 | if (Encounter.Provider = User.DUZ) and User.CanSignOrders
|
|---|
| 84 | then CanSign := CH_SIGN_YES
|
|---|
| 85 | else CanSign := CH_SIGN_NA;
|
|---|
| 86 | with SelectedList do for i := 0 to Count - 1 do
|
|---|
| 87 | begin
|
|---|
| 88 | AnOrder := TOrder(Items[i]);
|
|---|
| 89 | OriginalID := AnOrder.ID;
|
|---|
| 90 | PtEvtList.Add(AnOrder.EventPtr + '^' + AnOrder.EventName);
|
|---|
| 91 | DCOrder(AnOrder, frmDCOrders.DCReason, DCType);
|
|---|
| 92 | case DCType of
|
|---|
| 93 | DCT_NEWORDER: begin
|
|---|
| 94 | Changes.Add(CH_ORD, AnOrder.ID, AnOrder.Text, '', CanSign, AnOrder.ParentID);
|
|---|
| 95 | AnOrder.ActionOn := OriginalID + '=DC';
|
|---|
| 96 | end;
|
|---|
| 97 | DCT_DELETION: begin
|
|---|
| 98 | Changes.Remove(CH_ORD, OriginalID);
|
|---|
| 99 | if (AnOrder.ID = '0') or (AnOrder.ID = '')
|
|---|
| 100 | then AnOrder.ActionOn := OriginalID + '=DL' // delete order
|
|---|
| 101 | else AnOrder.ActionOn := OriginalID + '=CA'; // cancel action
|
|---|
| 102 | {else AnOrder.ActionOn := AnOrder.ID + '=CA'; - caused cancel from meds to not update orders}
|
|---|
| 103 | UnlockOrder(OriginalID); // for deletion of unsigned DC
|
|---|
| 104 | end;
|
|---|
| 105 | DCT_NEWSTATUS: begin
|
|---|
| 106 | AnOrder.ActionOn := OriginalID + '=DC';
|
|---|
| 107 | UnlockOrder(OriginalID);
|
|---|
| 108 | end;
|
|---|
| 109 | else UnlockOrder(OriginalID);
|
|---|
| 110 | end;
|
|---|
| 111 | SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_ACT, Integer(AnOrder));
|
|---|
| 112 | end;
|
|---|
| 113 | if frmOrders.lstSheets.ItemIndex > -1 then
|
|---|
| 114 | if CharAt(frmOrders.lstSheets.Items[frmOrders.lstSheets.ItemIndex],1)='C' then
|
|---|
| 115 | OnCurrent := True;
|
|---|
| 116 | if not OnCurrent then
|
|---|
| 117 | begin
|
|---|
| 118 | for i := 0 to PtEvtList.Count - 1 do
|
|---|
| 119 | begin
|
|---|
| 120 | if Length(PtEvtList[i])>1 then
|
|---|
| 121 | begin
|
|---|
| 122 | APtEvtID := Piece(PtEvtList[i],'^',1);
|
|---|
| 123 | APtEvtName := Piece(PtEvtList[i],'^',2);
|
|---|
| 124 | AnEvtInfo := EventInfo(APtEvtID);
|
|---|
| 125 | if isExistedEvent(Patient.DFN,Piece(AnEvtInfo,'^',2),tmpPtEvt) and (DeleteEmptyEvt(APtEvtID,APtEvtName,False)) then
|
|---|
| 126 | begin
|
|---|
| 127 | NeedRefresh := True;
|
|---|
| 128 | frmOrders.ChangesUpdate(APtEvtID);
|
|---|
| 129 | end;
|
|---|
| 130 | end;
|
|---|
| 131 | end;
|
|---|
| 132 | if NeedRefresh then
|
|---|
| 133 | begin
|
|---|
| 134 | frmOrders.InitOrderSheetsForEvtDelay;
|
|---|
| 135 | frmOrders.lstSheets.ItemIndex := 0;
|
|---|
| 136 | frmOrders.lstSheetsClick(nil);
|
|---|
| 137 | DelEvt := True;
|
|---|
| 138 | end;
|
|---|
| 139 | end;
|
|---|
| 140 | Result := True;
|
|---|
| 141 | end
|
|---|
| 142 | else with SelectedList do for i := 0 to Count - 1 do UnlockOrder(TOrder(Items[i]).ID);
|
|---|
| 143 | finally
|
|---|
| 144 | frmDCOrders.Release;
|
|---|
| 145 | end;
|
|---|
| 146 | end;
|
|---|
| 147 |
|
|---|
| 148 | procedure TfrmDCOrders.FormCreate(Sender: TObject);
|
|---|
| 149 | var
|
|---|
| 150 | DefaultIEN: Integer;
|
|---|
| 151 | begin
|
|---|
| 152 | inherited;
|
|---|
| 153 | OKPressed := False;
|
|---|
| 154 | ListDCReasons(lstReason.Items, DefaultIEN);
|
|---|
| 155 | lstReason.SelectByIEN(DefaultIEN);
|
|---|
| 156 | { the following commented out so that providers can enter DC reasons }
|
|---|
| 157 | // if Encounter.Provider = User.DUZ then
|
|---|
| 158 | // begin
|
|---|
| 159 | // lblReason.Visible := False;
|
|---|
| 160 | // lstReason.Visible := False;
|
|---|
| 161 | // end;
|
|---|
| 162 | end;
|
|---|
| 163 |
|
|---|
| 164 | procedure TfrmDCOrders.cmdOKClick(Sender: TObject);
|
|---|
| 165 | //const
|
|---|
| 166 | //TX_REASON_REQ = 'A reason for discontinue must be selected.'; <-- original line. //kt 8/8/2007
|
|---|
| 167 | //TC_REASON_REQ = 'Missing Discontinue Reason'; <-- original line. //kt 8/8/2007
|
|---|
| 168 | var
|
|---|
| 169 | TX_REASON_REQ : string; //kt
|
|---|
| 170 | TC_REASON_REQ : string; //kt
|
|---|
| 171 | begin
|
|---|
| 172 | TX_REASON_REQ := DKLangConstW('fOrdersDC_A_reason_for_discontinue_must_be_selectedx'); //kt added 8/8/2007
|
|---|
| 173 | TC_REASON_REQ := DKLangConstW('fOrdersDC_Missing_Discontinue_Reason'); //kt added 8/8/2007
|
|---|
| 174 | inherited;
|
|---|
| 175 | if (lstReason.Visible) and (not (lstReason.ItemIEN > 0)) then
|
|---|
| 176 | begin
|
|---|
| 177 | InfoBox(TX_REASON_REQ, TC_REASON_REQ, MB_OK);
|
|---|
| 178 | Exit;
|
|---|
| 179 | end;
|
|---|
| 180 | OKPressed := True;
|
|---|
| 181 | DCReason := lstReason.ItemIEN;
|
|---|
| 182 | Close;
|
|---|
| 183 | end;
|
|---|
| 184 |
|
|---|
| 185 | procedure TfrmDCOrders.cmdCancelClick(Sender: TObject);
|
|---|
| 186 | begin
|
|---|
| 187 | inherited;
|
|---|
| 188 | Close;
|
|---|
| 189 | end;
|
|---|
| 190 |
|
|---|
| 191 | procedure TfrmDCOrders.lstOrdersDrawItem(Control: TWinControl;
|
|---|
| 192 | Index: Integer; Rect: TRect; State: TOwnerDrawState);
|
|---|
| 193 | var
|
|---|
| 194 | x: string;
|
|---|
| 195 | ARect: TRect;
|
|---|
| 196 | begin
|
|---|
| 197 | inherited;
|
|---|
| 198 | x := '';
|
|---|
| 199 | ARect := Rect;
|
|---|
| 200 | with lstOrders do
|
|---|
| 201 | begin
|
|---|
| 202 | Canvas.FillRect(ARect);
|
|---|
| 203 | Canvas.Pen.Color := clSilver;
|
|---|
| 204 | Canvas.MoveTo(0, ARect.Bottom - 1);
|
|---|
| 205 | Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
|
|---|
| 206 | if Index < Items.Count then
|
|---|
| 207 | begin
|
|---|
| 208 | x := Items[Index];
|
|---|
| 209 | DrawText(Canvas.handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
|
|---|
| 210 | end;
|
|---|
| 211 | end;
|
|---|
| 212 | end;
|
|---|
| 213 |
|
|---|
| 214 | procedure TfrmDCOrders.lstOrdersMeasureItem(Control: TWinControl;
|
|---|
| 215 | Index: Integer; var AHeight: Integer);
|
|---|
| 216 | var
|
|---|
| 217 | x:string;
|
|---|
| 218 | begin
|
|---|
| 219 | inherited;
|
|---|
| 220 | with lstOrders do if Index < Items.Count then
|
|---|
| 221 | begin
|
|---|
| 222 | x := Items[index];
|
|---|
| 223 | AHeight := MeasureColumnHeight(x, Index);
|
|---|
| 224 | end;
|
|---|
| 225 | end;
|
|---|
| 226 |
|
|---|
| 227 | function TfrmDCOrders.MeasureColumnHeight(TheOrderText: string;
|
|---|
| 228 | Index: Integer): integer;
|
|---|
| 229 | var
|
|---|
| 230 | ARect: TRect;
|
|---|
| 231 | begin
|
|---|
| 232 | ARect.Left := 0;
|
|---|
| 233 | ARect.Top := 0;
|
|---|
| 234 | ARect.Bottom := 0;
|
|---|
| 235 | ARect.Right := lstOrders.Width - 6;
|
|---|
| 236 | Result := WrappedTextHeightByFont(lstOrders.Canvas,lstOrders.Font,TheOrderText,ARect);
|
|---|
| 237 | end;
|
|---|
| 238 |
|
|---|
| 239 | end.
|
|---|
