//kt -- Modified with SourceScanner on 8/25/2007, also 8/09 unit fNotePrt; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fAutoSz, ORCtrls, StdCtrls, Mask, ORNet, ORFn, ComCtrls, DKLang; type TfrmNotePrint = class(TfrmAutoSz) grpChooseCopy: TGroupBox; radChartCopy: TRadioButton; radWorkCopy: TRadioButton; grpDevice: TGroupBox; lblMargin: TLabel; lblLength: TLabel; txtRightMargin: TMaskEdit; txtPageLength: TMaskEdit; cmdOK: TButton; cmdCancel: TButton; lblNoteTitle: TMemo; cboDevice: TORComboBox; lblPrintTo: TLabel; dlgWinPrinter: TPrintDialog; chkDefault: TCheckBox; procedure cboDeviceNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); procedure FormCreate(Sender: TObject); procedure cboDeviceChange(Sender: TObject); procedure radChartCopyClick(Sender: TObject); procedure radWorkCopyClick(Sender: TObject); procedure cmdOKClick(Sender: TObject); procedure cmdCancelClick(Sender: TObject); private //kt Begin Mod (change Consts to Vars) 8/25/2007 TX_NODEVICE : string; //kt TX_NODEVICE_CAP : string; //kt TX_ERR_CAP : string; //kt //kt End Mod ------------------- { Private declarations } FNote: Integer; FReportText: TRichEdit; procedure DisplaySelectDevice; procedure SetupVars; //kt public { Public declarations } end; procedure PrintNote(ANote: Longint; const ANoteTitle: string; MultiNotes: boolean = False); implementation {$R *.DFM} uses rCore, rTIU, rReports, uCore, Printers, rHTMLTools; //kt 8/09 const //TX_NODEVICE = 'A device must be selected to print, or press ''Cancel'' to not print.'; <-- original line. //kt 8/25/2007 //TX_NODEVICE_CAP = 'Device Not Selected'; <-- original line. //kt 8/25/2007 //TX_ERR_CAP = 'Print Error'; <-- original line. //kt 8/25/2007 PAGE_BREAK = '**PAGE BREAK**'; procedure TfrmNotePrint.SetupVars; //kt Added entire function to replace constant declarations 8/25/2007 begin TX_NODEVICE := DKLangConstW('fNotePrt_A_device_must_be_selected_to_printx_or_press_xxCancelxx_to_not_printx'); TX_NODEVICE_CAP := DKLangConstW('fNotePrt_Device_Not_Selected'); TX_ERR_CAP := DKLangConstW('fNotePrt_Print_Error'); end; procedure PrintNote(ANote: Longint; const ANoteTitle: string; MultiNotes: boolean = False); { displays a form that prompts for a device and then prints the progress note } var frmNotePrint: TfrmNotePrint; DefPrt: string; begin frmNotePrint := TfrmNotePrint.Create(Application); try ResizeFormToFont(TForm(frmNotePrint)); with frmNotePrint do begin { check to see of Chart Print allowed outside of MAS } if AllowChartPrintForNote(ANote) then begin {This next code begs the question: Why are we even bothering to check radWorkCopy if we immediately check the other button? Short answer: it seems to wokr better Long answer: The checkboxes have to in some way register with the group they are in. If this doesn't happen, both will be initially included the tab order. This means that the first time tabbing through the controls, the work copy button would be tabbed to and selected after the chart copy. Tabbing through controls should not change the group selection. } radWorkCopy.Checked := True; radChartCopy.Checked := True; end else begin radChartCopy.Enabled := False; radWorkCopy.Checked := True; end; lblNoteTitle.Text := ANoteTitle; // frmNotePrint.Caption := 'Print ' + Piece(Piece(ANoteTitle, #9, 2), ',', 1); <-- original line. //kt 8/25/2007 frmNotePrint.Caption := DKLangConstW('fNotePrt_Print') + Piece(Piece(ANoteTitle, #9, 2), ',', 1); //kt added 8/25/2007 FNote := ANote; 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 8/25/2007 Items.Add('WIN;'+DKLangConstW('fNotePrt_Windows_Printer')+'^'+DKLangConstW('fNotePrt_Windows_Printer')); //kt added 8/25/2007 // Items.Add('^--------------------VistA Printers----------------------'); <-- original line. //kt 8/25/2007 Items.Add('^'+DKLangConstW('fNotePrt_xxxxxxxxxxxxxxxxxxxxxVistA_Printersxxxxxxxxxxxxxxxxxxxxxx')); //kt added 8/25/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 (User.CurrentPrinter = DefPrt)) then cmdOKClick(frmNotePrint) //CQ6660 //Commented out for CQ6660 //or //((User.CurrentPrinter <> '') and //(MultiNotes = True)) then //frmNotePrint.cmdOKClick(frmNotePrint) //end CQ6660 else frmNotePrint.ShowModal; end; finally frmNotePrint.Release; end; end; procedure TfrmNotePrint.FormCreate(Sender: TObject); begin inherited; FReportText := TRichEdit.Create(Self); with FReportText do begin Parent := Self; Visible := False; Width := 600; end; end; procedure TfrmNotePrint.DisplaySelectDevice; begin with cboDevice, lblPrintTo do begin // if radChartCopy.Checked then Caption := 'Print Chart Copy on: ' + Piece(ItemID, ';', 2); <-- original line. //kt 8/25/2007 if radChartCopy.Checked then Caption := DKLangConstW('fNotePrt_Print_Chart_Copy_onx') + Piece(ItemID, ';', 2); //kt added 8/25/2007 // if radWorkCopy.Checked then Caption := 'Print Work Copy on: ' + Piece(ItemID, ';', 2); <-- original line. //kt 8/25/2007 if radWorkCopy.Checked then Caption := DKLangConstW('fNotePrt_Print_Work_Copy_onx') + Piece(ItemID, ';', 2); //kt added 8/25/2007 end; end; procedure TfrmNotePrint.cboDeviceNeedData(Sender: TObject; const StartFrom: string; Direction, InsertAt: Integer); begin inherited; cboDevice.ForDataUse(SubsetOfDevices(StartFrom, Direction)); end; procedure TfrmNotePrint.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 TfrmNotePrint.radChartCopyClick(Sender: TObject); begin inherited; DisplaySelectDevice; end; procedure TfrmNotePrint.radWorkCopyClick(Sender: TObject); begin inherited; DisplaySelectDevice; end; procedure TfrmNotePrint.cmdOKClick(Sender: TObject); var ADevice, ErrMsg: string; ChartCopy: Boolean; RemoteSiteID: string; //for Remote site printing RemoteQuery: string; //for Remote site printing TempLines: TStringList; //kt added 5-31-05 begin SetupVars; //kt added 8/25/2007 to replace constants with vars. inherited; RemoteSiteID := ''; RemoteQuery := ''; if cboDevice.ItemID = '' then begin InfoBox(TX_NODEVICE, TX_NODEVICE_CAP, MB_OK); Exit; end; if radChartCopy.Checked then ChartCopy := True else ChartCopy := False; if Piece(cboDevice.ItemID, ';', 1) = 'WIN' then (* //begin original block of code from before 5-24-05 //---------------------------------------------- begin if dlgWinPrinter.Execute then with FReportText do begin Lines.Assign(GetFormattedNote(FNote, ChartCopy)); PrintWindowsReport(FReportText, PAGE_BREAK, Self.Caption, ErrMsg); if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK); end; end //end original unmodified block of code //kt 5-24-05 //-------------------------------------------------- *) //begin modified block of code //kt 5-31-05 //---------------------------------------------- begin TempLines := TStringList.Create; TempLines.Assign(GetFormattedNote(FNote, ChartCopy)); if rHTMLTools.IsHTML(TempLines) = false then begin //NOTE: If HTML, then bypass this printer dialog, because it will be // replaced by a printer dialog that internet explorer uses. if dlgWinPrinter.Execute then begin FReportText.Lines.Assign(TempLines); PrintWindowsReport(FReportText, PAGE_BREAK, Self.Caption, ErrMsg,Application); end; end else begin LoadDocumentText(TempLines, FNote); //Get document without headers/footers PrintHTMLReport(TempLines, ErrMsg, Patient.Name, FormatFMDateTime('mm/dd/yyyy', Patient.DOB), rHTMLtools.ExtractDateOfNote(TempLines), // date for report. Patient.WardService, Application); end; TempLines.Free; if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK); end //end modified block of code //kt 5-31-05 //---------------------------------------------- else begin ADevice := Piece(cboDevice.ItemID, ';', 2); PrintNoteToDevice(FNote, ADevice, ChartCopy, ErrMsg); if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK); {* Original Block of Code //elh 1/19/10 begin InfoBox(TX_NODEVICE, TX_NODEVICE_CAP, MB_OK); Exit; end; if radChartCopy.Checked then ChartCopy := True else ChartCopy := False; if Piece(cboDevice.ItemID, ';', 1) = 'WIN' then begin if dlgWinPrinter.Execute then begin //kt ----- Begin original code ------------- 8/09 //kt FReportText.Lines.Assign(GetFormattedNote(FNote, ChartCopy)); //kt PrintWindowsReport(FReportText, PAGE_BREAK, Self.Caption, ErrMsg); //kt if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK); //kt ----- End original code ------------- TempLines := TStringList.Create; //kt 8/09 TempLines.Assign(GetFormattedNote(FNote, ChartCopy)); //kt 8/09 if not rHTMLTools.IsHTML(TempLines) then begin //kt 8/09 //NOTE: If HTML, then bypass this printer dialog, because it will be //kt 8/09 // replaced by a printer dialog that internet explorer uses. //kt 8/09 if dlgWinPrinter.Execute then begin //kt 8/09 FReportText.Lines.Assign(TempLines); //kt 8/09 PrintWindowsReport(FReportText, PAGE_BREAK, Self.Caption, ErrMsg,Application); //kt 8/09 end; //kt 8/09 end else begin //kt 8/09 LoadDocumentText(TempLines, FNote); //Get document without headers/footers //kt 8/09 PrintHTMLReport(TempLines, ErrMsg, Patient.Name, //kt 8/09 FormatFMDateTime('mm/dd/yyyy', Patient.DOB),' ', //kt 8/09 Patient.WardService, Application); //kt 8/09 end; //kt 8/09 TempLines.Free; //kt 8/09 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK); //kt 8/09 end; //kt 8/09 end else begin ADevice := Piece(cboDevice.ItemID, ';', 2); PrintNoteToDevice(FNote, ADevice, ChartCopy, ErrMsg); if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK); *} // End of original block of code //elh 1/19/10 end; if chkDefault.Checked then SaveDefaultPrinter(Piece(cboDevice.ItemID, ';', 1)); User.CurrentPrinter := cboDevice.ItemID; Close; end; procedure TfrmNotePrint.cmdCancelClick(Sender: TObject); begin inherited; Close; end; end.