source: cprs/branches/tmg-cprs/CPRS-Chart/fLabPrint.pas@ 1099

//kt -- Modified with SourceScanner on 7/19/2007
unit fLabPrint;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ORCtrls, ORNet, Mask, ComCtrls, DKLang;

type
  TfrmLabPrint = class(TForm)
    lblLabTitle: TMemo;
    lblPrintTo: TLabel;
    grpDevice: TGroupBox;
    lblMargin: TLabel;
    lblLength: TLabel;
    txtRightMargin: TMaskEdit;
    txtPageLength: TMaskEdit;
    cboDevice: TORComboBox;
    cmdOK: TButton;
    cmdCancel: TButton;
    dlgWinPrinter: TPrintDialog;
    chkDefault: TCheckBox;
    DKLanguageController1: TDKLanguageController;
    procedure FormCreate(Sender: TObject);
    procedure cboDeviceChange(Sender: TObject);
    procedure cboDeviceNeedData(Sender: TObject; const StartFrom: String;
      Direction, InsertAt: Integer);
    procedure cmdOKClick(Sender: TObject);
    procedure cmdCancelClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    //kt Begin Mod (change Consts to Vars) 7/19/2007
    TX_NODEVICE      : string;  //kt
    TX_NODEVICE_CAP  : string;  //kt
    TX_ERR_CAP       : string;  //kt
    PAGE_BREAK       : string;  //kt
    //kt End Mod -------------------
    { Private declarations }
    FReports: Integer;
    FDaysBack: Integer;
    FReportText: TRichEdit;
    procedure DisplaySelectDevice;
    procedure SetupVars;  //kt
  public
    { Public declarations }
  end;

var
  frmLabPrint: TfrmLabPrint;

procedure PrintLabs(AReports: Longint; const ALabTitle: string; ADaysBack: Integer);

implementation

{$R *.DFM}

uses ORFn, rCore, uCore, fLabs, rLabs, Printers, rReports;

//const
//TX_NODEVICE = 'A device must be selected to print, or press ''Cancel'' to not print.';  <-- original line.  //kt 7/19/2007
//TX_NODEVICE_CAP = 'Device Not Selected';  <-- original line.  //kt 7/19/2007
//TX_ERR_CAP = 'Print Error';  <-- original line.  //kt 7/19/2007
//PAGE_BREAK = '**PAGE BREAK**';  <-- original line.  //kt 7/19/2007


procedure TfrmLabPrint.SetupVars;
//kt Added entire function to replace constant declarations 7/19/2007
begin
  TX_NODEVICE := DKLangConstW('fLabPrint_A_device_must_be_selected_to_printx_or_press_xxCancelxx_to_not_printx');
  TX_NODEVICE_CAP := DKLangConstW('fLabPrint_Device_Not_Selected');
  TX_ERR_CAP := DKLangConstW('fLabPrint_Print_Error');
  PAGE_BREAK := DKLangConstW('fLabPrint_xxPAGE_BREAKxx');
end;
 
procedure PrintLabs(AReports: Integer; const ALabTitle: string; ADaysBack: Integer);
{ displays a form that prompts for a device and then prints the report }
var
  frmLabPrint: TfrmLabPrint;
  DefPrt: string;
begin
  frmLabPrint := TfrmLabPrint.Create(Application);
  try
    ResizeAnchoredFormToFont(frmLabPrint);
    with frmLabPrint do
    begin
      lblLabTitle.Text := ALabTitle;
      FReports := AReports;
      FDaysBack := ADaysBack;
      DefPrt := GetDefaultPrinter(User.Duz, Encounter.Location);
      if User.CurrentPrinter = '' then User.CurrentPrinter := DefPrt;
      with cboDevice do
        begin
          if Printer.Printers.Count > 0 then
            begin
//            Items.Add('WIN;Windows Printer^Windows Printer');  <-- original line.  //kt 7/19/2007
              Items.Add('WIN;'+DKLangConstW('fLabPrint_Windows_Printer')+'^'+DKLangConstW('fLabPrint_Windows_Printer')); //kt added 7/19/2007
//            Items.Add('^--------------------VistA Printers----------------------');  <-- original line.  //kt 7/19/2007
              Items.Add('^'+DKLangConstW('fLabPrint_xxxxxxxxxxxxxxxxxxxxxVistA_Printersxxxxxxxxxxxxxxxxxxxxxx')); //kt added 7/19/2007
            end;
          if User.CurrentPrinter <> '' then
            begin
              InitLongList(Piece(User.CurrentPrinter, ';', 2));
              SelectByID(User.CurrentPrinter);
            end
          else
            InitLongList('');
        end;
//    if (DefPrt = 'WIN;Windows Printer') and  <-- original line.  //kt 7/19/2007
      if (DefPrt = DKLangConstW('fLabPrint_WINxWindows_Printer')) and //kt added 7/19/2007
         (User.CurrentPrinter = DefPrt) then
         cmdOKClick(frmLabPrint)
      else
         ShowModal;
    end;
  finally
    frmLabPrint.Release;
  end;
end;

procedure TfrmLabPrint.DisplaySelectDevice;
begin
  with cboDevice, lblPrintTo do
  begin
// Caption := 'Print Report on:  ' + Piece(ItemID, ';', 2);  <-- original line.  //kt 7/19/2007
   Caption := DKLangConstW('fLabPrint_Print_Report_onx') + Piece(ItemID, ';', 2); //kt added 7/19/2007
  end;
end;

procedure TfrmLabPrint.FormCreate(Sender: TObject);
begin
  inherited;
  FReportText := TRichEdit.Create(Self);
  with FReportText do
    begin
      Parent := Self;
      Visible := False;
      Width := 600;
    end;
end;

procedure TfrmLabPrint.cboDeviceChange(Sender: TObject);
begin
  inherited;
  with cboDevice do if ItemIndex > -1 then
    begin
      txtRightMargin.Text := Piece(Items[ItemIndex], '^', 4);
      txtPageLength.Text := Piece(Items[ItemIndex], '^', 5);
      DisplaySelectDevice;
    end;
end;

procedure TfrmLabPrint.cboDeviceNeedData(Sender: TObject;
  const StartFrom: String; Direction, InsertAt: Integer);
begin
inherited;
  cboDevice.ForDataUse(SubsetOfDevices(StartFrom, Direction));
end;

procedure TfrmLabPrint.cmdOKClick(Sender: TObject);
var
  ADevice, ErrMsg: string;
  daysback: integer;
  date1, date2: TFMDateTime;
  today: TDateTime;
  RemoteSiteID: string;    //for Remote site printing
  RemoteQuery: string;    //for Remote site printing
begin
  SetupVars;  //kt added 7/19/2007 to replace constants with vars.
  inherited;
  RemoteSiteID := '';
  RemoteQuery := '';
  with frmLabs.TabControl1 do
    if TabIndex > 0 then
      begin
        RemoteSiteID := TRemoteSite(Tabs.Objects[TabIndex]).SiteID;
        RemoteQuery := TRemoteSite(Tabs.Objects[TabIndex]).CurrentLabQuery;
      end;
  if cboDevice.ItemID = '' then
  begin
    InfoBox(TX_NODEVICE, TX_NODEVICE_CAP, MB_OK);
    Exit;
  end;
  today := frmLabs.FMToDateTime(floattostr(FMToday));
  if frmLabs.lstDates.ItemIEN > 0 then
    begin
      daysback := frmLabs.lstDates.ItemIEN;
      date1 := FMToday;
      If daysback = 1 then
        date2 := DateTimeToFMDateTime(today)
      Else
        date2 := DateTimeToFMDateTime(today - daysback);
    end
  else
    frmLabs.BeginEndDates(date1,date2,daysback);
  date1 := date1 + 0.2359;
//if Piece(cboDevice.ItemID, ';', 1) = 'WIN' then  <-- original line.  //kt 7/19/2007
  if Piece(cboDevice.ItemID, ';', 1) = DKLangConstW('fLabPrint_WIN') then //kt added 7/19/2007
    begin
      if dlgWinPrinter.Execute then with FReportText do
        begin
          Lines.Assign(GetFormattedLabReport(FReports, FDaysBack, Patient.DFN,
            frmLabs.lstTests.Items, date1, date2, RemoteSiteID, RemoteQuery));
          PrintWindowsReport(FReportText, PAGE_BREAK, Self.Caption, ErrMsg, Application); //kt 8/09 added 'Application'
          if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
        end;
    end
  else
    begin
      ADevice := Piece(cboDevice.ItemID, ';', 2);
      PrintLabsToDevice(FReports, FDaysBack, Patient.DFN, ADevice,
        frmLabs.lstTests.Items, ErrMsg, date1, date2, RemoteSiteID, RemoteQuery);
      ErrMsg := Piece(FReportText.Lines[0], U, 2);
      if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
    end;
  if chkDefault.Checked then SaveDefaultPrinter(Piece(cboDevice.ItemID, ';', 1));
  User.CurrentPrinter := cboDevice.ItemID;
  Close;
end;

procedure TfrmLabPrint.cmdCancelClick(Sender: TObject);
begin
inherited;
  Close;
end;

procedure TfrmLabPrint.FormDestroy(Sender: TObject);
begin
  FReportText.Free;
  inherited;
end;

end.