//kt -- Modified with SourceScanner on 8/7/2007
unit UploadImages;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, pngimage, ExtDlgs, OleCtrls,
  SHDocVw, DKLang;

type
  TUploadImageInfo = class
    private
    public
      TIUIEN :             int64;    //IEN in file# 8925
      DFN :                AnsiString;    //IEN in Patient File (#2)
      UploadDUZ :          int64;
      ThumbFPathName :     AnsiString; // local file path name
      ImageFPathName :     AnsiString;
      ServerPath :         AnsiString;
      ServerFName :        AnsiString;
      ServerThumbFName:    AnsiString;
      ShortDesc :          String[60];
      Extension :          String[16];
      ImageDateTime :      AnsiString;
      UploadDateTime:      AnsiString;
      ObjectType :         Integer;  //pointer to file 2005.02
      ProcName :           String[10];  //server limit is 10 chars.
      //AcquisitionSite
      pLongDesc :          TStrings;
    published
  end;



type
  TUploadForm = class(TForm)
    OpenFileDialog: TOpenDialog;
    Image1: TImage;
    PickImagesButton: TBitBtn;
    Label1: TLabel;
    CancelButton: TBitBtn;
    UploadButton: TBitBtn;
    Label2: TLabel;
    Label4: TLabel;
    ShortDescEdit: TEdit;
    LongDescMemo: TMemo;
    Label3: TLabel;
    Label5: TLabel;
    DateTimeEdit: TEdit;
    ClearImagesButton: TBitBtn;
    OpenDialog: TOpenPictureDialog;
    FilesToUploadList: TListBox;
    NoteEdit: TEdit;
    PickOtherButton: TBitBtn;
    Panel1: TPanel;
    WebBrowser: TWebBrowser;
    Label6: TLabel;
    MoveCheckBox: TCheckBox;
    DKLanguageController1: TDKLanguageController;
    procedure UploadButtonClick(Sender: TObject);
    procedure PickImagesButtonClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ShortDescEditChange(Sender: TObject);
    procedure ClearImagesButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FilesToUploadListClick(Sender: TObject);
    procedure PickOtherButtonClick(Sender: TObject);
    procedure FormRefresh(Sender: TObject);

  private
    { Private declarations }
    Bitmap : TBitmap;
    Picture : TPicture;
    function MakeThumbNail(Info: TUploadImageInfo): boolean;

    procedure LoadNotesEdit();
    //procedure LoadNotesList();
    function UploadFile(Info: TUploadImageInfo): boolean;
    procedure UploadChosenFiles();

  public
    { Public declarations }
  end;

var
  UploadForm: TUploadForm;

implementation

{$R *.dfm}

  uses  fNotes,
        StrUtils, //for MidStr etc.
        ORFn,  //for PIECE etc.
        uCore, // for User.DUZ etc
        Trpcb, //for .PType enum
        fImages, //for upload/download files etc.
        //Targa,  //for TGA graphic save
        ORNet //for RPCBrokerV
        ;

//  const
//  DefShortDesc = '(Short Image Description)';  <-- original line.  //kt 8/7/2007

  var
    DefShortDesc : string; //kt

  procedure SetupVars;
  begin
    DefShortDesc := DKLangConstW('UploadImages_xShort_Image_Descriptionx'); //kt added 8/7/2007
  end;

  //-------------------------------------------------------------------------
  //-------------------------------------------------------------------------
  function TUploadForm.MakeThumbNail(Info: TUploadImageInfo) : boolean;
  //This takes Info.ImageFPathName and creates a 64x64 .bmp file with
  //this same name, and saves in cache directory.
  //saves name of this thumbnail in info.ThumbFPathName

  var
    Rect : TRect;
    ThumbFName : AnsiString;
  begin
    Rect.Top := 0; Rect.Left:=0; Rect.Right:=63; Rect.Bottom:=63;
    result := false; //default of failure
    try
      Picture.LoadFromFile(Info.ImageFPathName);
      Bitmap.Canvas.StretchDraw(Rect,Picture.Graphic);
      ThumbFName := frmImages.CacheDir + '\Thumb-' + ExtractFileName(Info.ImageFPathName);
      ThumbFName := ChangeFileExt(ThumbFName,'.bmp');
      Bitmap.SaveToFile(ThumbFName);  //save to local cache (for upload)
      Info.ThumbFPathName := ThumbFName;  //pass info back out.
      Info.ServerThumbFName := ChangeFileExt(Info.ServerFName,'.ABS'); //format is .bmp
      result := true
    except
      on E: Exception do exit;
   end;
  end;


  function TUploadForm.UploadFile(Info: TUploadImageInfo): boolean;
  //result: true if success, false if failure
  var
    RPCResult,index              : AnsiString;
    ImageIEN                     : AnsiString;
    MsgNum                       : AnsiString;
    ErrorMsg                     : AnsiString;
    i                            : integer;

  begin
    RPCBrokerV.remoteprocedure := 'MAGGADDIMAGE';
    RPCBrokerV.Param[0].Value := '.X';
    RPCBrokerV.Param[0].PType := list;
    RPCBrokerV.Param[0].Mult['"NETLOCABS"'] := 'ABS^STUFFONLY';
    RPCBrokerV.Param[0].Mult['"magDFN"'] := '5^' + Info.DFN; {patient dfn}
    RPCBrokerV.Param[0].Mult['"DATETIME"'] := '7^NOW'; {date/time image collected}
    RPCBrokerV.Param[0].Mult['"DATETIMEPROC"'] := '15^' +  Info.ImageDateTime; {Date/Time of Procedure}
    if Info.ProcName <> '' then
      RPCBrokerV.Param[0].Mult['"PROC"'] := '6^' + Info.ProcName; {procedure}
    RPCBrokerV.Param[0].Mult['"DESC"'] := '10^(Hard coded Short Description)'; {image description}
    if Info.ShortDesc <> '' then
      RPCBrokerV.Param[0].Mult['"DESC"'] := '10^' + Info.ShortDesc; {image description}
    RPCBrokerV.Param[0].Mult['"DUZ"'] := '8^' + IntToStr(Info.UploadDUZ); {Duz}

    //The field (#14) below is used for images that are part of a group,
    //for example a CT exam might contain 30 images.  This field
    //contains a pointer back to the Image file (2005), to the
    //object whose type is "GROUP" that points to this object as
    //a member of its group.  A pointer to this object will be
    //found in the Object Group multiple of the parent GROUP
    //object.
    //RPCBrokerV.Param[0].Mult['"GROUP"'] := '14^' + group;

    RPCBrokerV.Param[0].Mult['"OBJTYPE"'] := '3^' + IntToStr(Info.ObjectType);
    RPCBrokerV.Param[0].Mult['"FileExt"'] := 'EXT^' + Info.Extension;

    for i := 0 to Info.pLongDesc.Count - 1 do begin
      index := IntToStr(i);
      while length(index) < 3 do index := '0' + index;
      index :='"LongDescr' + index + '"';
      RPCBrokerV.Param[0].Mult[index] := '11^' + Info.pLongDesc.Strings[i];
    end;

    RPCResult := RPCBrokerV.STRcall;   { returns ImageIEN^directory/filename }

    ImageIEN := Piece(RPCResult,'^',1);
    result := ((ImageIEN <> '0') and (ImageIEN <> ''));  // function result.
    if result=false then begin
//    ErrorMsg :='Server Error -- Couldn''t store image information';  <-- original line.  //kt 8/7/2007
      ErrorMsg :=DKLangConstW('UploadImages_Server_Error_xx_Couldnxxt_store_image_information'); //kt added 8/7/2007
      MessageDlg(ErrorMsg,mtWarning,[mbOK],0);
    end;
    if result then begin
      Info.ServerPath := Piece(RPCResult,'^',2);
      Info.ServerFName := Piece(RPCResult,'^',3);
      result := frmImages.UploadFile(Info.ImageFPathName,Info.ServerPath,Info.ServerFName);
      if result=false then begin
//      ErrorMsg :='Error uploading image to server';  <-- original line.  //kt 8/7/2007
        ErrorMsg :=DKLangConstW('UploadImages_Error_uploading_image_to_server'); //kt added 8/7/2007
        //Application.MessageBox(@ErrorMsg,'Error Uploading Image');
        MessageDlg(ErrorMsg,mtWarning,[mbCancel],0);
      end;
      //Later, put code that also copies the file into the cache directory,
      //so that we don't have to turn around and download it again.
      if result then begin
        RPCBrokerV.remoteprocedure := 'MAG3 TIU IMAGE';
        RPCBrokerV.param[0].ptype := literal;
        RPCBrokerV.param[0].value := ImageIEN;
        RPCBrokerV.Param[1].ptype := literal;
        RPCBrokerV.param[1].value := IntToStr(Info.TIUIEN);
        RPCBrokerV.Call;
        RPCResult := RPCBrokerV.Results[0];
        //returns:  success:  1^message;  or  error:  0^error message
        MsgNum := Piece(RPCResult,'^',1);
        result := (MsgNum = '1');
        if result=false then begin
//        ErrorMsg :='Error associating image with note:' + #13 + Piece(RPCResult,'^',2);  <-- original line.  //kt 8/7/2007
          ErrorMsg :=DKLangConstW('UploadImages_Error_associating_image_with_notex') + #13 + Piece(RPCResult,'^',2); //kt added 8/7/2007
          MessageDlg(ErrorMsg,mtWarning,[mbCancel],0);
        end;
      end;
      if (result=true) and (MoveCheckBox.Checked) then begin
        DeleteFile(Info.ImageFPathName);
      end;
      if result then begin
        if MakeThumbNail(Info) then begin;
          result := frmImages.UploadFile(Info.ThumbFPathName,Info.ServerPath,Info.ServerThumbFName);
          if result=false then begin
//          ErrorMsg :='Error sending thumbnail image to server.';  <-- original line.  //kt 8/7/2007
            ErrorMsg :=DKLangConstW('UploadImages_Error_sending_thumbnail_image_to_serverx'); //kt added 8/7/2007
            MessageDlg(ErrorMsg,mtWarning,[mbOK],0);
          end;
        end;
      end;
    end;
    //returns: result
  end;



  procedure TUploadForm.UploadChosenFiles();
  var i : integer;
      Info: TUploadImageInfo;

  begin
    SetupVars; 
    Info := TUploadImageInfo.Create();
    Info.pLongDesc := nil;

    //Load up info class/record
    Info.ShortDesc := MidStr(ShortDescEdit.Text,1,60);
    if Info.ShortDesc = DefShortDesc then Info.ShortDesc := ' ';
    Info.UploadDUZ := User.DUZ;
    if LongDescMemo.Lines.Count>0 then begin
      Info.pLongDesc := LongDescMemo.Lines;
    end;
    Info.ObjectType := 1; //type 1 is Still Image (jpg).  OK to use with .bmp??
    Info.ProcName := 'Picture'; //max length is 10 characters
    Info.ImageDateTime := DateTimeEdit.Text;
    Info.TIUIEN := frmNotes.lstNotes.ItemID;
    Info.UploadDateTime := 'NOW';
    Info.DFN := Patient.DFN;

    for i:= 0 to FilesToUploadList.Items.Count-1 do begin
      Info.ImageFPathName := FilesToUploadList.Items.Strings[i];
      Info.Extension := ExtractFileExt(Info.ImageFPathName); //includes '.'
      Info.Extension := MidStr(Info.Extension,2,17); //remove '.'

      if not UploadFile(Info) then begin   //Upload function passes back filename info in Info class
        //Application.MessageBox('Error uploading image file!','Error');
      end;

    end;
    Info.Free;
  end;

  procedure TUploadForm.LoadNotesEdit();
  begin
    NoteEdit.Text := frmNotes.tvNotes.Selected.Text;
  end;

  {
  procedure TUploadForm.LoadNotesList();
  var
    NoteInfo,s,dateS : AnsiString;
    i : integer;
  const
    U='^';
  begin
    NoteComboBox.Items.Clear;

    for i := 0 to frmNotes.lstNotes.Count-1 do with frmNotes.lstNotes do begin
      NoteInfo := Items[i];
      (* example NoteInfo:
        piece# 1:  14321^                        //TIU IEN
        piece# 2:  PRESCRIPTION CALL IN^         //Document Title
        piece# 3:  3050713.0947^                 //Date/Time
        piece# 4:  TEST, KILLME D (T0101)^       //Patient
        piece# 5:  133;JANE A DOE;DOE,JANE A^    //Author
        piece# 6:  Main_Office^                  //Location of Visit
        piece# 7:  completed^                    //Status of Document
        piece# 8:  Visit: 07/13/05;3050713.094721^ //Date/Time
        piece# 9...:          ;^^1^^^1^'         //?
      *)
      dateS := Piece(Piece(NoteInfo, U, 8), ';', 2);
      s := FormatFMDateTime('mmm dd,yy@hh:nn', MakeFMDateTime(dateS)) + ' -- ';
  //    s := Piece(Piece(NoteInfo, U, 8), ';', 1) + ' -- ';
      s := s + Piece(NoteInfo, U, 2) + '; ';
      s := s + 'Author: ' + Piece(Piece(NoteInfo, U, 5), ';', 2) + ', ';
      s := s + Piece(NoteInfo, U, 6);
      NoteComboBox.Items.Add(s);
    end;
    NoteComboBox.ItemIndex := frmNotes.lstNotes.ItemIndex;
  end;
  }
  //Delphi events etc.------------------------------------------------

  procedure TUploadForm.UploadButtonClick(Sender: TObject);
  begin
    try
      WebBrowser.Navigate(frmImages.NullImageName);
    except
      on E: Exception do exit;
    end;
    UploadChosenFiles();
  end;

  procedure TUploadForm.PickImagesButtonClick(Sender: TObject);
  var i : integer;
  begin
    If OpenDialog.Execute then begin
      for i := 0 to OpenDialog.Files.Count-1 do begin
        FilesToUploadList.Items.Add(OpenDialog.Files.Strings[i]);
      end;
    end;
  end;

  procedure TUploadForm.PickOtherButtonClick(Sender: TObject);
  var i : integer;
  begin
    If OpenFileDialog.Execute then begin
      for i := 0 to OpenFileDialog.Files.Count-1 do begin
        FilesToUploadList.Items.Add(OpenFileDialog.Files.Strings[i]);
      end;
    end;
  end;

  procedure TUploadForm.FormShow(Sender: TObject);
  begin
    FormRefresh(self);
    FilesToUploadList.Items.Clear;
    LoadNotesEdit();
    SetupVars;
    ShortDescEdit.Text := DefShortDesc;
  end;

  procedure TUploadForm.ShortDescEditChange(Sender: TObject);
  begin
    if Length(ShortDescEdit.Text)> 60 then begin
      ShortDescEdit.Text := MidStr(ShortDescEdit.Text,1,60);
    end;
  end;

  procedure TUploadForm.ClearImagesButtonClick(Sender: TObject);
  begin
    FilesToUploadList.Items.Clear;
    FilesToUploadListClick(self);
  end;

  procedure TUploadForm.FormCreate(Sender: TObject);
  begin
    Bitmap := TBitmap.Create;
    Bitmap.Height := 64;
    Bitmap.Width := 64;
    Picture := TPicture.Create;
  end;

  procedure TUploadForm.FormDestroy(Sender: TObject);
  begin
    Bitmap.Free;
    Picture.Free;
  end;

  procedure TUploadForm.FilesToUploadListClick(Sender: TObject);
  var
    FileName:  AnsiString;
    SelectedItem: integer;
  begin
    SelectedItem := FilesToUploadList.ItemIndex;
    if SelectedItem > -1 then begin
      FileName := FilesToUploadList.Items[SelectedItem];
      //Application.MessageBox('Here I would pass to IE','NOte');
    end else begin
      FileName := frmImages.NullImageName;
    end;
    try
      WebBrowser.Navigate(FileName);
    except
      on E: Exception do exit;
    end;
  end;

  procedure TUploadForm.FormRefresh(Sender: TObject);
  begin
    try
      WebBrowser.Navigate(frmImages.NullImageName);
    except
      on E: Exception do exit;
    end;
  end;

end.