unit fOrdersEvntRelease; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs ,ORFn, uCore, rOrders, fOrders, StdCtrls, ORCtrls, ExtCtrls, Grids,fAutoSz, Spin, ComCtrls; type TfrmOrdersEvntRelease = class(TfrmAutoSz) pnlTop: TPanel; lblPtInfo: TStaticText; pnlBottom: TPanel; Label1: TLabel; btnOK: TButton; btnCancel: TButton; grdEvtList: TCaptionStringGrid; Panel1: TPanel; Panel2: TPanel; btnApply: TButton; updown1: TUpDown; edtNumber: TEdit; Panel3: TPanel; Label2: TLabel; Label3: TLabel; procedure FormCreate(Sender: TObject); procedure btnCancelClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure grdEvtListDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); procedure grdEvtListMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure btnOKClick(Sender: TObject); procedure grdEvtListKeyPress(Sender: TObject; var Key: Char); procedure grdEvtListDblClick(Sender: TObject); procedure pnlBottomResize(Sender: TObject); procedure edtNumberChange(Sender: TObject); procedure edtNumberKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure btnApplyClick(Sender: TObject); procedure btnApplyKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure edtNumberClick(Sender: TObject); procedure updown1Click(Sender: TObject; Button: TUDBtnType); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormDestroy(Sender: TObject); private { Private declarations } FEvtList: TStringList; FTotal: Integer; FDGroup: Integer; FViewName: string; FPtEvt: string; FEvent: TOrderDelayEvent; fPreTxt: string; FOkPressed: Boolean; procedure ShowEvents(NumOfEvts: integer); public { Public declarations } end; procedure SelectEvtReleasedOrders(var OrderView: TOrderView); implementation uses rMisc, Accessibility_TLB, uAccessibleStringGrid; {$R *.DFM} const TAB = #9; procedure SelectEvtReleasedOrders(var OrderView: TOrderView); const FROM_SERVER = TRUE; var frmOrdersEvntRelease: TfrmOrdersEvntRelease; begin frmOrdersEvntRelease := TfrmOrdersEvntRelease.Create(Application); SetFormPosition(frmOrdersEvntRelease); try with frmOrdersEvntRelease do begin FDGroup := OrderView.DGroup; ShowModal; if FOkPressed then begin frmOrders.FromDCRelease := True; OrderView.Changed := FOkPressed; OrderView.DGroup := FDGroup; OrderView.CtxtTime := 0; OrderView.TextView := 0; OrderView.ViewName := FViewName; OrderView.EventDelay.PtEventIFN := StrToIntDef(FPtEvt,0); if FEvent.PtEventIFN > 0 then OrderView.EventDelay := FEvent else begin OrderView.EventDelay.EventType := 'C'; OrderView.EventDelay.Specialty := 0; OrderView.EventDelay.Effective := 0; OrderView.EventDelay.PtEventIFN := 0; end; end else OrderView.Changed := False; end; finally frmOrdersEvntRelease.FEvtList.Clear; frmOrdersEvntRelease.Release; frmOrdersEvntRelease.FOkPressed := False; end; end; procedure TfrmOrdersEvntRelease.FormCreate(Sender: TObject); var CurrTS: string; SpeCap: string; ATotal: integer; begin CurrTS := Piece(GetCurrentSpec(Patient.DFN),'^',1); if Length(CurrTS)>0 then SpeCap := #13 + ' The current treating specialty is ' + CurrTS else SpeCap := #13 + ' No treating specialty is available.'; FPtEvt := ''; FEvent.EventType := #0; FEvent.EventIFN := 0; FEvent.EventName := ''; FEvent.PtEventIFN := 0; FEvent.Specialty := 0; FEvent.Effective := 0; FOkPressed := False; FEvtList := TStringList.Create; FTotal := 5; edtNumber.Text := '5'; fPreTxt := edtNumber.Text; if Patient.Inpatient then lblPtInfo.Caption := ' ' + Patient.Name + ' is currently admitted to ' + Encounter.LocationName + SpeCap else begin if Encounter.Location > 0 then lblPtInfo.Caption := ' ' + Patient.Name + ' is currently at ' + Encounter.LocationName + SpeCap else lblPtInfo.Caption := ' ' + Patient.Name + ' currently is an outpatient. ' + SpeCap; end; lblPtInfo.Top := (pnlTop.Height - lblPtInfo.Height) div 2; grdEvtList.Cells[0,0] := 'Event Name'; grdEvtList.Cells[1,0] := 'Date/Time Occured'; SetPtEvtList(TStrings(fevtList),Patient.DFN, ATotal); TAccessibleStringGrid.WrapControl(grdEvtList); end; procedure TfrmOrdersEvntRelease.btnCancelClick(Sender: TObject); begin Close; end; procedure TfrmOrdersEvntRelease.FormShow(Sender: TObject); begin ShowEvents(fTotal); end; procedure TfrmOrdersEvntRelease.grdEvtListDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); begin inherited; grdEvtList.Canvas.TextRect(Rect, Rect.Left+2, Rect.Top+2, Piece(grdEvtList.Cells[ACol, ARow], TAB, 1)); end; procedure TfrmOrdersEvntRelease.grdEvtListMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var ACol, ARow: integer; EvtInfo: string; begin grdEvtList.MouseToCell(X,Y,ACol,ARow); if ARow>0 then begin FPtEvt := Piece(grdEvtList.Cells[0,grdEvtList.Row],TAB,2); if StrToIntDef(FPtEvt,0)>0 then FEvent.PtEventIFN := StrToInt(FPtEvt); EvtInfo := EventInfo(FPtEvt); FEvent.EventIFN := StrToIntDef( Piece(EvtInfo,'^',2),0); if FEvent.EventIFN > 0 then begin FEvent.EventType := CharAt(Piece(EvtInfo,'^',1),1); FEvent.EventName := Piece(EvtInfo,'^',3); end; FDGroup := DGroupAll; FViewName := 'Patient event -- ' + Piece(grdEvtList.Cells[0,grdEvtList.Row],TAB,1) + ' on ' + grdEvtList.Cells[1,grdEvtList.Row]; end; end; procedure TfrmOrdersEvntRelease.btnOKClick(Sender: TObject); var EvtInfo: string; begin if grdEvtList.Row < 1 then begin ShowMessage('You need to select an event first.'); FOkPressed := False; Exit; end else begin if AnsiCompareText(grdEvtList.Cells[0,1],'No event order found') = 0 then begin FOKPressed := False; Exit; end; if FPtEvt = '' then begin FPtEvt := Piece(grdEvtList.Cells[0,grdEvtList.Row],TAB,2); if StrToIntDef(FPtEvt,0)>0 then FEvent.PtEventIFN := StrToInt(FPtEvt); EvtInfo := EventInfo(FPtEvt); FEvent.EventIFN := StrToIntDef( Piece(EvtInfo,'^',2),0); if FEvent.EventIFN > 0 then begin FEvent.EventType := CharAt(Piece(EvtInfo,'^',1),1); FEvent.EventName := Piece(EvtInfo,'^',3); end; FDGroup := DGroupAll; FViewName := 'Patient event -- ' + Piece(grdEvtList.Cells[0,grdEvtList.Row],TAB,1) + ' on ' + grdEvtList.Cells[1,grdEvtList.Row]; FOkPressed := True; Close; end else begin FOkPressed := True; Close; end; end; end; procedure TfrmOrdersEvntRelease.grdEvtListKeyPress(Sender: TObject; var Key: Char); var EvtInfo: string; begin if grdEvtList.Row > 0 then begin FPtEvt := Piece(grdEvtList.Cells[0,grdEvtList.Row],TAB,2); if StrToIntDef(FPtEvt,0)>0 then FEvent.PtEventIFN := StrToInt(FPtEvt); EvtInfo := EventInfo(FPtEvt); FEvent.EventIFN := StrToIntDef( Piece(EvtInfo,'^',2),0); if FEvent.EventIFN > 0 then begin FEvent.EventType := CharAt(Piece(EvtInfo,'^',1),1); FEvent.EventName := Piece(EvtInfo,'^',3); end; FDGroup := DGroupAll; FViewName := 'Released orders for event--Delayed ' + Piece(grdEvtList.Cells[0,grdEvtList.Row],TAB,1) + ' on ' + grdEvtList.Cells[1,grdEvtList.Row]; if Key = #13 then btnOKClick(Self); end; end; procedure TfrmOrdersEvntRelease.grdEvtListDblClick(Sender: TObject); begin if grdEvtList.Row > 0 then btnOKClick(Self); end; procedure TfrmOrdersEvntRelease.pnlBottomResize(Sender: TObject); begin grdEvtList.ColWidths[0] := ( grdEvtList.Width div 3 ) * 2; grdEvtList.ColWidths[1] := grdEvtList.Width - grdEvtList.ColWidths[0] - 4; end; procedure TfrmOrdersEvntRelease.ShowEvents(NumOfEvts: integer); var temptot,idx,jdx: integer; begin with grdEvtList do for idx := 0 to ColCount - 1 do for jdx:= 1 to RowCount - 1 do begin Cells[idx,jdx] := ''; end; if NumOfEvts = 0 then temptot := fevtList.Count else temptot := NumOfEvts; if temptot > fevtList.Count then temptot := fevtList.Count; grdEvtList.RowCount := temptot + 1; if temptot = 0 then begin grdEvtList.RowCount := 2; grdEvtList.Cells[0,1] := 'No event order found'; btnOK.Enabled := False; end else begin for idx := 1 to grdEvtList.RowCount-1 do begin grdEvtList.Cells[0,idx] := Piece(fevtList[idx-1],'^',2)+ TAB + Piece(fevtList[idx-1],'^',1); grdEvtList.Cells[1,idx] := FormatFMDateTime('mm/dd/yy hh:nn',StrToFloat(Piece(fevtList[idx-1],'^',3))); end; end; end; procedure TfrmOrdersEvntRelease.edtNumberChange(Sender: TObject); begin inherited; if (CharAt(edtNumber.Text,1)='A') or (CharAt(edtNumber.Text,1)='a') then begin edtNumber.Text := 'ALL'; edtNumber.SelectAll; fTotal := 0; end else if (StrToIntDef(edtNumber.Text,0)=0) and (AnsiCompareText(edtNumber.Text,'all')<>0) then edtNumber.Text := fPreTxt else if StrToIntDef(edtNumber.Text,0)>0 then fTotal := StrtoInt(edtNumber.Text); end; procedure TfrmOrdersEvntRelease.edtNumberKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin inherited; if Key=VK_RETURN then btnApplyClick(Self); end; procedure TfrmOrdersEvntRelease.btnApplyClick(Sender: TObject); begin inherited; fPreTxt := edtNumber.Text; ShowEvents(fTotal); end; procedure TfrmOrdersEvntRelease.btnApplyKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin inherited; if Key = VK_RETURN then btnApplyClick(Self); end; procedure TfrmOrdersEvntRelease.edtNumberClick(Sender: TObject); begin inherited; edtNumber.SelectAll; end; procedure TfrmOrdersEvntRelease.updown1Click(Sender: TObject; Button: TUDBtnType); begin inherited; fTotal := updown1.Position; edtNumber.Text := IntToStr(updown1.Position); btnApplyClick(Self); end; procedure TfrmOrdersEvntRelease.FormClose(Sender: TObject; var Action: TCloseAction); begin inherited; SaveUserBounds(Self); Action := caFree; end; procedure TfrmOrdersEvntRelease.FormDestroy(Sender: TObject); begin TAccessibleStringGrid.UnwrapControl(grdEvtList); inherited; end; end.