Ignore:
Timestamp:
Mar 31, 2010, 5:06:56 PM (14 years ago)
Author:
Kevin Toppenberg
Message:

Added functions to Templates, and Images tab

File:
1 edited

Legend:

Unmodified
Added
Removed
  • cprs/branches/tmg-cprs/CPRS-Chart/UploadImages.pas

    r453 r729  
    77  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    88  Dialogs, StdCtrls, Buttons, ExtCtrls, pngimage, ExtDlgs, OleCtrls,
     9  uCore,
    910  SHDocVw, DKLang;
    1011
    1112type
    12   TUploadImageInfo = class
     13
     14  TImageInfo = class
    1315    private
    1416    public
    15       TIUIEN :             int64;    //IEN in file# 8925
    16       DFN :                AnsiString;    //IEN in Patient File (#2)
    17       UploadDUZ :          int64;
     17      TIUIEN :             int64;      //IEN in file# 8925
     18      DFN :                AnsiString; //IEN in Patient File (#2)
     19      UploadDUZ :          int64;      //IEN in NEW PERSON file
    1820      ThumbFPathName :     AnsiString; // local file path name
    19       ImageFPathName :     AnsiString;
     21      ImageFPathName :     AnsiString; // local file path name
    2022      ServerPath :         AnsiString;
    2123      ServerFName :        AnsiString;
     
    2527      ImageDateTime :      AnsiString;
    2628      UploadDateTime:      AnsiString;
    27       ObjectType :         Integer;  //pointer to file 2005.02
    28       ProcName :           String[10];  //server limit is 10 chars.
    29       //AcquisitionSite
    30       pLongDesc :          TStrings;
    31     published
    32   end;
     29      ObjectType :         int64;      //pointer to file 2005.02
     30      ProcName :           String[10]; //server limit is 10 chars.
     31      pLongDesc :          TStrings;  //Won't be owned by this list
     32      procedure Assign(Source : TImageInfo);
     33      procedure Clear;
     34  end;
     35
     36  TAutoUploadNote = class
     37    private
     38    public
     39      TIUIEN :       int64;      //IEN in file# 8925
     40      ErrMsg :       AnsiString;
     41      NoteTitle :    AnsiString; //Title of note to be associated with image
     42      Patient :      TPatient;
     43      ImageInfo :    TImageInfo;
     44      Location :     AnsiString; //Location that image if from
     45      DOS :          AnsiString; //Date of service
     46      Provider :     AnsiString;
     47      CurNoteImages: TStringList;
     48      UploadError :  Boolean;
     49      procedure SetDFN(var ChartNum,Location,FName,LName,MName,DOB,Sex : string);
     50      Procedure SetInfo(var DOS,Provider,Location,Title : string);
     51      function SameAs(OtherNote: TAutoUploadNote): boolean;
     52      procedure MakeNewBlankNote(DFN,DOS,Provider,Location,Title : string);
     53      procedure InitFrom(OtherNote: TAutoUploadNote);
     54      function IsValid : boolean;
     55      procedure Clear;
     56      constructor Create();
     57      destructor Destroy;  override;
     58  end;
     59
     60
    3361
    3462
     
    5482    NoteEdit: TEdit;
    5583    PickOtherButton: TBitBtn;
    56     Panel1: TPanel;
     84    pnlIEHolder: TPanel;
    5785    WebBrowser: TWebBrowser;
    5886    Label6: TLabel;
    5987    MoveCheckBox: TCheckBox;
     88    PolTimer: TTimer;
    6089    DKLanguageController1: TDKLanguageController;
    6190    procedure UploadButtonClick(Sender: TObject);
     
    6998    procedure PickOtherButtonClick(Sender: TObject);
    7099    procedure FormRefresh(Sender: TObject);
    71 
     100    procedure PolTimerTimer(Sender: TObject);
    72101  private
    73102    { Private declarations }
    74103    Bitmap : TBitmap;
    75104    Picture : TPicture;
    76     function MakeThumbNail(Info: TUploadImageInfo): boolean;
     105    FScanDir : String;
     106    function MakeThumbNail(Info: TImageInfo): boolean;
    77107
    78108    procedure LoadNotesEdit();
    79109    //procedure LoadNotesList();
    80     function UploadFile(Info: TUploadImageInfo): boolean;
     110    function UploadFile(Info: TImageInfo; DelOrig : boolean): boolean;
    81111    procedure UploadChosenFiles();
    82 
     112    function ProcessOneLine(Line : string) : string;
     113    function ProcessOneFile(FileName : string) : boolean;
     114    procedure ScanAndHandleImgTxt;
     115    procedure ScanAndHandleImages;
     116    procedure DecodeImgTxt(Line : string; out ChartNum, Location,
     117                           FName, LName, MName, Sex, DOB, DOS, Provider,
     118                           Title : string; FilePaths : TStrings);
     119    function EncodeImgTxt(ChartNum, Location, FName, LName, MName, Sex, DOB,
     120                           DOS, Provider, Title : string; FilePaths : TStrings) : AnsiString;
     121    procedure FinishDocument(UploadNote : TAutoUploadNote);
    83122  public
    84123    { Public declarations }
     124    procedure SetScanDir(NewDir : string);
     125  published
     126    property ScanDir : String read FScanDir write SetScanDir;
    85127  end;
    86128
     
    95137        StrUtils, //for MidStr etc.
    96138        ORFn,  //for PIECE etc.
    97         uCore, // for User.DUZ etc
    98139        Trpcb, //for .PType enum
    99140        fImages, //for upload/download files etc.
    100141        //Targa,  //for TGA graphic save
    101         ORNet //for RPCBrokerV
     142        ORNet, //for RPCBrokerV
     143        rTIU,
     144        uTMGOptions
    102145        ;
    103146
     
    105148//  DefShortDesc = '(Short Image Description)';  <-- original line.  //kt 8/7/2007
    106149
     150  type
     151    TFileInfo = class
     152    private
     153    public
     154      SrcRec : TSearchRec;
     155      STimeStamp : String;
     156      SBarCode : String;
     157      FPath : String;
     158      MetaFileName : String;
     159      MetaFileExists : boolean;
     160      BatchCount : integer;
     161      procedure Assign(Source: TFileInfo);
     162      procedure Clear;
     163    end;
     164
    107165  var
    108166    DefShortDesc : string; //kt
     167    PolInterval : integer;
     168    AutoUploadNote : TAutoUploadNote;
     169
    109170
    110171  procedure SetupVars;
     
    115176  //-------------------------------------------------------------------------
    116177  //-------------------------------------------------------------------------
    117   function TUploadForm.MakeThumbNail(Info: TUploadImageInfo) : boolean;
     178
     179  function NumPieces(const s: string; ADelim : Char) : integer;
     180  var List : TStringList;
     181  begin
     182    List := TStringList.Create;
     183    PiecesToList(S, ADelim, List);
     184    Result := List.Count;
     185  end;
     186
     187  //-------------------------------------------------------------------------
     188  //-------------------------------------------------------------------------
     189  procedure TFileInfo.Assign(Source: TFileInfo);
     190  begin
     191    SrcRec := Source.SrcRec;
     192    STimeStamp := Source.STimeStamp;
     193    SBarCode := Source.SBarCode;
     194    FPath := Source.FPath;
     195    BatchCount := Source.BatchCount;
     196    MetaFileName := Source.MetaFileName;
     197    MetaFileExists := Source.MetaFileExists;
     198  end;
     199
     200  procedure TFileInfo.Clear;
     201  begin
     202    //SrcRec := ...   //Note sure how to clear this.  Will leave as is...
     203    STimeStamp := '';
     204    SBarCode := '';
     205    FPath := '';
     206    BatchCount := 0;
     207    MetaFileName := '';
     208    MetaFileExists := false;
     209  end;
     210
     211  //-------------------------------------------------------------------------
     212  //-------------------------------------------------------------------------
     213  procedure TImageInfo.Assign(Source : TImageInfo);
     214  begin
     215    TIUIEN := Source.TIUIEN;
     216    DFN := Source.DFN;
     217    UploadDUZ := Source.UploadDUZ;
     218    ThumbFPathName := Source.ThumbFPathName;
     219    ImageFPathName := Source.ImageFPathName;
     220    ServerPath := Source.ServerPath;
     221    ServerFName := Source.ServerFName;
     222    ServerThumbFName := Source.ServerThumbFName;
     223    ShortDesc := Source.ShortDesc;
     224    Extension := Source.Extension;
     225    ImageDateTime := Source.ImageDateTime;
     226    UploadDateTime := Source.UploadDateTime;
     227    ObjectType := Source.ObjectType;
     228    ProcName := Source.ProcName;
     229    pLongDesc := Source.pLongDesc;  //this is only a pointer to object owned elsewhere
     230  end;
     231
     232  procedure TImageInfo.Clear;
     233  begin
     234    TIUIEN := 0;
     235    DFN := '';
     236    UploadDUZ := 0;
     237    ThumbFPathName := '';
     238    ImageFPathName := '';
     239    ServerPath := '';
     240    ServerFName := '';
     241    ServerThumbFName := '';
     242    ShortDesc := '';
     243    Extension := '';
     244    ImageDateTime := '';
     245    UploadDateTime:= '';
     246    ObjectType :=0;
     247    ProcName := '';
     248    pLongDesc := nil
     249  end;
     250
     251  //-------------------------------------------------------------------------
     252  //-------------------------------------------------------------------------
     253  procedure TAutoUploadNote.SetDFN(var ChartNum,Location,FName,LName,MName,DOB,Sex : string);
     254  var RPCResult : AnsiString;
     255      PMS : AnsiString;
     256  begin
     257    //Notice: ChartNum, and PMS are optional.  If PMS is 1,2,or 3, then ChartNum
     258    //        is used to look up patient.  Otherwise a lookup is based on just
     259    //        Name, DOB, Sex.
     260    //        To NOT use ChartNum, just set the values to ''
     261    //
     262    //Note: If LName is in form: `12345, then LName is used for DFN, and call
     263    //      to server for lookup is bypassed, and the values for FName,DOB etc
     264    //      are ignored
     265
     266    if MidStr(LName,1,1)='`' then begin
     267      Self.Patient.DFN := MidStr(LName,2,999);
     268    end else begin
     269      //**NOTE**: site-specific code
     270      if Location ='Laughlin_Office' then PMS :='2'
     271      else if Location ='Peds_Office' then PMS :='3'
     272      else PMS := ''; //default
     273
     274      RPCBrokerV.ClearParameters := true;
     275      RPCBrokerV.remoteprocedure := 'TMG GET DFN';
     276      RPCBrokerV.param[0].value := ChartNum;  RPCBrokerV.param[0].ptype := literal;
     277      RPCBrokerV.param[1].value := PMS;       RPCBrokerV.Param[1].ptype := literal;
     278      RPCBrokerV.param[2].value := FName;     RPCBrokerV.Param[2].ptype := literal;
     279      RPCBrokerV.param[3].value := LName;     RPCBrokerV.Param[3].ptype := literal;
     280      RPCBrokerV.param[4].value := MName;     RPCBrokerV.Param[4].ptype := literal;
     281      RPCBrokerV.param[5].value := DOB;       RPCBrokerV.Param[5].ptype := literal;
     282      RPCBrokerV.param[6].value := Sex;       RPCBrokerV.Param[6].ptype := literal;
     283      RPCBrokerV.Call;
     284      RPCResult := RPCBrokerV.Results[0]; //returns: success: DFN;  or  error: -1^ErrMsg
     285      if piece(RPCResult,'^',1) <> '-1' then begin
     286        self.Patient.DFN := RPCResult;
     287      end else begin
     288        self.Patient.DFN := '';
     289      end;
     290    end;
     291  end;
     292
     293  Procedure TAutoUploadNote.SetInfo(var DOS,Provider,Location,Title : string);
     294  //Just loads values into structure.  No validation done.
     295  begin
     296    Self.DOS := DOS;
     297    Self.Provider := Provider;
     298    Self.Location := Location;
     299    Self.NoteTitle := Title;
     300  end;
     301
     302  procedure TAutoUploadNote.InitFrom(OtherNote: TAutoUploadNote);
     303  //Will create a blank note for itself.
     304  begin
     305    Patient.Assign(OtherNote.Patient);
     306    ImageInfo.Assign(OtherNote.ImageInfo);
     307    Location := OtherNote.Location;
     308    DOS := OtherNote.DOS;
     309    Provider := OtherNote.Provider;
     310    NoteTitle := OtherNote.NoteTitle;
     311    CurNoteImages.Assign(OtherNote.CurNoteImages);
     312    MakeNewBlankNote(Patient.DFN,DOS,Provider,Location,NoteTitle);
     313  end;
     314 
     315  procedure TAutoUploadNote.MakeNewBlankNote(DFN,DOS,Provider,Location,Title : string);
     316  var RPCResult : string;
     317  begin
     318    RPCResult := '';
     319    Self.ErrMsg := '';    //default to no error messages
     320   
     321    RPCBrokerV.ClearParameters := true;
     322    RPCBrokerV.remoteprocedure := 'TMG GET BLANK TIU DOCUMENT';
     323    RPCBrokerV.param[0].value := DFN;       RPCBrokerV.param[0].ptype := literal;
     324    RPCBrokerV.param[1].value := Provider;  RPCBrokerV.Param[1].ptype := literal;
     325    RPCBrokerV.param[2].value := Location;  RPCBrokerV.Param[2].ptype := literal;
     326    RPCBrokerV.param[3].value := DOS;       RPCBrokerV.Param[3].ptype := literal;
     327    RPCBrokerV.param[4].value := Title;     RPCBrokerV.Param[4].ptype := literal;
     328    RPCBrokerV.Call;
     329    RPCResult := RPCBrokerV.Results[0];
     330    try
     331      TIUIEN := StrToInt64(Piece(RPCResult,'^',1));    //returns:  success: TIU IEN;  or  error: -1
     332    except
     333      on E: EConvertError do begin
     334        Self.ErrMsg := 'WHILE CREATING BLANK NOTE FOR UPLOAD, ' +
     335                       'ERROR CONVERTING: ' + RPCBrokerV.Results[0] + ' to document record #.';
     336        TIUIEN := -1;
     337      end 
     338    end; 
     339    If TIUIEN <> -1 then begin
     340      Self.Patient.DFN := DFN;
     341      Self.Provider := Provider;
     342      Self.Location := Location;
     343      Self.DOS := DOS;
     344    end else begin
     345      Self.ErrMsg := 'FAILED TO CREATE A BLANK NOTE FOR UPLOAD' +
     346                     '  ' + Piece(RPCResult,'^',2);
     347      Self.UploadError := true;     
     348    end;
     349  end;
     350
     351  function TAutoUploadNote.IsValid : boolean;     
     352  begin
     353    Result := true;  //default to success.
     354    if (Patient.DFN='') {or (TIUIEN < 1)} or (ErrMsg <> '') or (NoteTitle = '')
     355    or (Location = '') or (DOS = '') or (Provider = '') then begin
     356      Result := false
     357    end;
     358  end;
     359
     360  procedure TAutoUploadNote.Clear;
     361  begin
     362    TIUIEN := 0;
     363    if Patient <> nil then Patient.Clear;
     364    if ImageInfo <> nil then ImageInfo.Clear;
     365    Location := '';
     366    DOS := '';
     367    Provider := '';
     368    NoteTitle := '';
     369    UploadError := False;
     370    if CurNoteImages <> nil then CurNoteImages.Clear;
     371  end; 
     372
     373  function TAutoUploadNote.SameAs(OtherNote: TAutoUploadNote): boolean;
     374  begin
     375    Result := true;
     376    if (OtherNote = nil) or (OtherNote.Patient = nil)
     377    or (Patient.DFN <> OtherNote.Patient.DFN)
     378    or (DOS <> OtherNote.DOS)
     379    or (Provider <> OtherNote.Provider)
     380    or (Location <> OtherNote.Location)
     381    or (NoteTitle <> OtherNote.NoteTitle) then begin
     382      Result := false;
     383    end;     
     384  end;
     385 
     386  constructor TAutoUploadNote.Create;
     387  begin
     388    Self.TIUIEN := 0;
     389    Self.Patient := TPatient.Create;
     390    Self.CurNoteImages := TStringList.Create;
     391    Self.ImageInfo := TImageInfo.Create;
     392    Self.Clear;
     393  end;
     394
     395  destructor TAutoUploadNote.Destroy;
     396  begin
     397    self.patient.free;
     398    Self.CurNoteImages.Free;
     399    Self.ImageInfo.Free;
     400  end;
     401
     402  //-------------------------------------------------------------------------
     403  //-------------------------------------------------------------------------
     404  function TUploadForm.MakeThumbNail(Info: TImageInfo) : boolean;
    118405  //This takes Info.ImageFPathName and creates a 64x64 .bmp file with
    119406  //this same name, and saves in cache directory.
     
    141428
    142429
    143   function TUploadForm.UploadFile(Info: TUploadImageInfo): boolean;
     430  function TUploadForm.UploadFile(Info: TImageInfo; DelOrig : boolean): boolean;
    144431  //result: true if success, false if failure
    145432  var
     
    196483      Info.ServerPath := Piece(RPCResult,'^',2);
    197484      Info.ServerFName := Piece(RPCResult,'^',3);
    198       result := frmImages.UploadFile(Info.ImageFPathName,Info.ServerPath,Info.ServerFName);
     485      result := frmImages.UploadFile(Info.ImageFPathName,Info.ServerPath,Info.ServerFName,1,1);
    199486      if result=false then begin
    200487//      ErrorMsg :='Error uploading image to server';  <-- original line.  //kt 8/7/2007
     
    227514      if result then begin
    228515        if MakeThumbNail(Info) then begin;
    229           result := frmImages.UploadFile(Info.ThumbFPathName,Info.ServerPath,Info.ServerThumbFName);
     516          result := frmImages.UploadFile(Info.ThumbFPathName,Info.ServerPath,Info.ServerThumbFName,1,1);
    230517          if result=false then begin
    231518//          ErrorMsg :='Error sending thumbnail image to server.';  <-- original line.  //kt 8/7/2007
     
    234521          end;
    235522        end;
     523        if DelOrig=true then begin
     524          DeleteFile(Info.ImageFPathName);
     525        end;
    236526      end;
    237527    end;
     
    243533  procedure TUploadForm.UploadChosenFiles();
    244534  var i : integer;
    245       Info: TUploadImageInfo;
    246 
    247   begin
    248     SetupVars; 
    249     Info := TUploadImageInfo.Create();
     535      Info: TImageInfo;
     536
     537  begin
     538    SetupVars;
     539    Info := TImageInfo.Create();
    250540    Info.pLongDesc := nil;
    251541
     
    269559      Info.Extension := MidStr(Info.Extension,2,17); //remove '.'
    270560
    271       if not UploadFile(Info) then begin   //Upload function passes back filename info in Info class
     561      if not UploadFile(Info,MoveCheckBox.Checked) then begin   //Upload function passes back filename info in Info class
    272562        //Application.MessageBox('Error uploading image file!','Error');
    273563      end;
     
    376666    Bitmap.Width := 64;
    377667    Picture := TPicture.Create;
     668
     669    AutoUploadNote := TAutoUploadNote.Create;
     670    FScanDir := uTMGOptions.ReadString('Pol Directory','??');
     671    if FScanDir='??' then begin
     672      FScanDir := ExtractFileDir(Application.ExeName);
     673      uTMGOptions.WriteString('Pol Directory',FScanDir);
     674    end;
     675    PolInterval := uTMGOptions.ReadInteger('Pol Interval (milliseconds)',0);
     676    if PolInterval=0 then begin
     677      PolInterval := 60000;
     678      uTMGOptions.WriteInteger('Pol Interval (milliseconds)',PolInterval);
     679    end;
     680  end;
     681
     682  procedure TUploadForm.SetScanDir(NewDir : string);
     683  begin
     684    if DirectoryExists(NewDir) then begin
     685      FScanDir := NewDir;
     686      uTMGOptions.WriteString('Pol Directory',FScanDir);
     687    end;
    378688  end;
    379689
     
    412722  end;
    413723
     724  procedure TUploadForm.DecodeImgTxt(Line : string; out ChartNum, Location,
     725                           FName, LName, MName, Sex, DOB, DOS, Provider,
     726                           Title : string; FilePaths : TStrings);
     727  //format of line is as follows:
     728  //ChartNum^Location^FName^LName^MName^Sex^DOB^DOS^Provider^Title^FilePath(s)
     729  //NOTE: To provide patient IEN instead of FName etc, use this format:
     730  //      ^Location^^`1234567^^^^DOS^Provider^Title^FilePath(s)
     731  //      i.e. `IEN  (note ` is not an appostrophy ('))
     732  //      `IEN in place of LName, and leave blank: ChartNum,FName,FName,Sex,DOB
     733                           
     734  var Files: String;                           
     735      FileName : String;
     736      num,i : integer;
     737  begin
     738    if Pos('}',Line)>0 then begin
     739      Line := Piece(Line,'}',2);  //If error message is present, still allow parse.
     740    end;
     741    ChartNum := Piece(Line,'^',1);
     742    Location := Piece(Line,'^',2);
     743    FName := Piece(Line,'^',3);
     744    LName := Piece(Line,'^',4);
     745    MName := Piece(Line,'^',5);
     746    Sex := Piece(Line,'^',6);
     747    DOB := Piece(Line,'^',7);
     748    DOS := Piece(Line,'^',8);
     749    Provider := Piece(Line,'^',9);
     750    Title := Piece(Line,'^',10);
     751    Files := Piece(Line,'^',11); //may be list of multiple files separated by ;
     752    if Pos(';',Files)>0  then begin
     753      num := NumPieces(Files,';');
     754      for i := 1 to num do begin
     755        FileName := piece(files,';',i);
     756        if FileName <> '' then FilePaths.Add(FileName);
     757      end; 
     758    end else begin
     759      FilePaths.Add(Files);
     760    end;
     761     
     762  end; 
     763
     764  function TUploadForm.EncodeImgTxt(ChartNum, Location, FName, LName, MName, Sex, DOB,
     765                           DOS, Provider, Title : string; FilePaths : TStrings) : AnsiString;
     766  //format of line is as follows:
     767  //ChartNum^Location^FName^LName^MName^Sex^DOB^DOS^Provider^Title^FilePath(s)
     768  //NOTE: To provide patient IEN instead of FName etc, use this format:
     769  //      ^Location^^`1234567^^^^DOS^Provider^Title^FilePath(s)
     770  //      i.e. `IEN  (note ` is not an appostrophy ('))
     771  //      `IEN in place of LName, and leave blank: ChartNum,FName,FName,Sex,DOB
     772  var i : integer;
     773  begin
     774    Result := ChartNum + '^' + Location + '^' + FName + '^' + LName + '^' +
     775              MName + '^' + Sex + '^' + DOB + '^' + DOS + '@01:00' + '^' + Provider + '^' +
     776              Title + '^';    //added time of 1:00    elh   7/8/08
     777    for i:= 0 to FilePaths.Count-1 do begin
     778      Result := Result + FilePaths.Strings[i];
     779      if i <> FilePaths.Count-1 then Result := Result + ';';
     780    end;
     781  end;                           
     782
     783 
     784  procedure TUploadForm.FinishDocument(UploadNote : TAutoUploadNote);
     785  var Text : TStringList;
     786      ErrMsg : String;
     787      RPCResult : String;
     788      i : integer;
     789      oneImage: string;
     790      //TIUIEN : int64;
     791       
     792  begin
     793    if (UploadNote.TIUIEN>0) and (UploadNote.CurNoteImages.Count>0)
     794    and (UploadNote.UploadError = False) then begin
     795      //Add text for note: "See scanned image" --
     796      //   or later, some HTML code to show note in CPRS directly....
     797      Text := TStringList.Create;
     798      Text.Add('<!DOCTYPE HTML PUBLIC>');
     799      Text.Add('<html>');
     800      Text.Add('<head>');
     801      Text.Add('<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">');
     802      Text.Add('<title>VistA HTML Note</title>');
     803      Text.Add('</head>');
     804      Text.Add('<body>');
     805      Text.Add('<p>');
     806      Text.Add('Note created automatically from imported media.');
     807      Text.Add('<p>');
     808      for i := 0 to UploadNote.CurNoteImages.Count-1 do begin
     809        // note: $CPRSDIR$ will be replaced at runtime with directory of CPRS
     810        // This will be done as page is passed to TWebBrowser (in rHTMLTools)
     811        oneImage := '$CPRSDIR$\Cache\' + UploadNote.CurNoteImages.Strings[i]; 
     812        //oneImage := CacheDir + '\' + CurNoteImages.Strings[i];
     813        Text.Add('<img WIDTH=640 src="'+oneImage+'">');
     814        Text.Add('<p>');
     815      end;
     816      //Text.Add('<small>');
     817      //Text.Add('If images don''t display, first view them in IMAGES tab.<br>');
     818      //Text.Add('Then return here, click on note and press [F5] key to refresh.');
     819      //Text.Add('</small>');
     820      //Text.Add('<p>');
     821      Text.Add('</body>');
     822      Text.Add('</html>');
     823      Text.Add(' ');
     824      rTIU.SetText(ErrMsg,Text,UploadNote.TIUIEN,1);  //1=commit data, do actual save.
     825      Text.Free;
     826      //Here I autosign  -- later make this optional?
     827      RPCBrokerV.ClearParameters := true;
     828      RPCBrokerV.remoteprocedure := 'TMG AUTOSIGN TIU DOCUMENT';
     829      RPCBrokerV.param[0].value := IntToStr(UploadNote.TIUIEN); 
     830      RPCBrokerV.param[0].ptype := literal;
     831      RPCBrokerV.Call;
     832      RPCResult := RPCBrokerV.Results[0];    //returns:  error: -1;  success=1
     833      if RPCResult='-1' then begin
     834        MessageDlg('Unable to set status for scanned document to SIGNED',mtError,[mbOK],0);
     835      end;     
     836      UploadNote.TIUIEN := 0;
     837    end; 
     838    UploadNote.Clear;
     839  end;
     840
     841
     842  function TUploadForm.ProcessOneLine(Line : string) : string;
     843  //Returns: if success, '';  if failure, returns reason
     844
     845  //format of line is as follows:
     846  //ChartNum^Location^FName^LName^MName^Sex^DOB^DOS^Provider^Title^FilePath(s)
     847  //NOTE: To provide patient IEN instead of FName etc, use this format:
     848  //      ^Location^^`1234567^^^^DOS^Provider^Title^FilePath(s)
     849  //      i.e. `IEN  (note ` is not an appostrophy ('))
     850  //      `IEN in place of LName, and leave blank: ChartNum,FName,FName,Sex,DOB
     851   
     852  var
     853    ChartNum,FName,LName,MName,Sex,DOB  : String;
     854    DOS,Provider,Title : String;
     855    ThisNote : TAutoUploadNote;
     856    FilePaths : TStringList;
     857    i : integer;
     858    Location : string;
     859   
     860  begin
     861    Result := '';  //default to success for function
     862    ThisNote := TAutoUploadNote.Create;
     863    FilePaths := TStringList.Create();
     864    DecodeImgTxt(Line, ChartNum, Location, FName, LName, MName, Sex, DOB, DOS, Provider, Title, FilePaths);
     865     
     866    ThisNote.SetDFN(ChartNum,Location,FName,LName,MName,DOB,Sex);
     867    ThisNote.SetInfo(DOS,Provider,Location,Title);
     868    if Pos('//Failed',Line)>0 then ThisNote.UploadError := true;
     869    if ThisNote.IsValid then begin  //A note can be 'Valid' and still have an 'UploadError'
     870      if ThisNote.SameAs(AutoUploadNote)= false then begin
     871        ThisNote.TIUIEN := AutoUploadNote.TIUIEN;
     872        FinishDocument(AutoUploadNote);  // Close and clear any existing note
     873        AutoUploadNote.InitFrom(ThisNote);
     874        Result := AutoUploadNote.ErrMsg; //'' if no error
     875      end; 
     876      if ThisNote.UploadError then AutoUploadNote.UploadError := true;
     877      if (AutoUploadNote.UploadError=false) then for i := 0 to FilePaths.Count-1 do begin
     878        AutoUploadNote.ImageInfo.pLongDesc := nil;
     879        //Load up info record with data for upload
     880        AutoUploadNote.ImageInfo.ShortDesc := 'Scanned document';
     881        AutoUploadNote.ImageInfo.UploadDUZ := User.DUZ;
     882        AutoUploadNote.ImageInfo.ObjectType := 1; //type 1 is Still Image (jpg).  OK to use with .bmp??
     883        AutoUploadNote.ImageInfo.ProcName := 'Scanned'; //max length is 10 characters
     884        AutoUploadNote.ImageInfo.ImageDateTime := DOS;
     885        AutoUploadNote.ImageInfo.TIUIEN := AutoUploadNote.TIUIEN;
     886        AutoUploadNote.ImageInfo.UploadDateTime := 'NOW';
     887        AutoUploadNote.ImageInfo.DFN := AutoUploadNote.Patient.DFN;
     888        AutoUploadNote.ImageInfo.ImageFPathName := FilePaths.Strings[i];
     889        AutoUploadNote.ImageInfo.Extension := ExtractFileExt(AutoUploadNote.ImageInfo.ImageFPathName); //includes '.'
     890        AutoUploadNote.ImageInfo.Extension := MidStr(AutoUploadNote.ImageInfo.Extension,2,17); //remove '.'
     891        if not UploadFile(AutoUploadNote.ImageInfo,true) then begin   //Upload function passes back filename info in Info class
     892          Result := 'ERROR UPLOADING IMAGE FILE';
     893        end;   
     894        AutoUploadNote.CurNoteImages.Add(AutoUploadNote.ImageInfo.ServerFName);
     895      end else begin
     896        If Result='' then Result := '(Error found in earlier file entry in batch)';
     897      end;
     898    end else begin
     899      Result := 'NOTE INFO INVALID (Probably: PATIENT NOT FOUND)';
     900    end;
     901    FilePaths.Free;
     902    ThisNote.Free;
     903  end;
     904
     905 
     906  function TUploadForm.ProcessOneFile(FileName : string) : boolean;
     907  //This will process image(s) indicated in textfile FileName
     908  //After uploading image to server, textfile and specified images are deleted
     909  //Returns Success
     910  //Note: To upload multiple images into one document, one may add multiple
     911  //      lines to the ImgTxt text file.  As long as the info is the same
     912  //      (i.e. same provider, patient, note type, DOS etc) then they
     913  //      will be appended to current note.
     914  //      OR, add multiple image file names to one line.
     915  //        -- the problem with multiple images on one line is that errors
     916  //        can not be reported for just one image.  It will be ONE for any/all
     917  //      OR, if the next file in process-order is still has the same info as
     918  //        the prior file, then it will be appended.
     919  var
     920    Lines : TStringList;
     921    i : integer;
     922    ResultStr : string;
     923    OneLine : string;
     924  begin
     925    Result := true;  //default is Success=true
     926    Lines := TStringList.Create;
     927    Lines.LoadFromFile(FileName);
     928    //FinishDocument(AutoUploadNote);  //will save and clear any old data.
     929    for i := 0 to Lines.Count-1 do begin
     930      OneLine := Lines.Strings[i];
     931      ResultStr := ProcessOneLine(OneLine);  //Even process with //failed markeers (to preserve batches)
     932      if Pos('//Failed',OneLine)> 0 then begin  //If we already have //Failed, don't duplicate another Error Msg
     933        Result := false;  //prevent deletion of file containing //Failed//     
     934      end else begin
     935        if ResultStr <> '' then begin
     936          Lines.Strings[i] := '//Failed: '+ResultStr+'}'+Lines.Strings[i];
     937          Lines.SaveToFile(FileName);
     938          Result := false;
     939        end; 
     940      end;
     941    end;
     942    //Temp, for debugging
     943    //Lines.SaveToFile(ChangeFileExt(FileName,'.imgtxt-bak'));
     944    //end temp   
     945    Lines.free;
     946  end;
     947
     948 
     949  procedure TUploadForm.ScanAndHandleImgTxt;
     950  var
     951    FoundFile : string;
     952    Found : TSearchRec;
     953    FilesList : TStringList;
     954    i         : integer;
     955    result : boolean;
     956  begin
     957    //NOTE: Later I may make this spawn a separate thread, so that
     958    //  user doesn't encounter sudden unresponsiveness of CPRS
     959    //I can use BeginThread, then EndTread
     960    //Issues: ProcessOneFile would probably have to be a function
     961    //  not in a class/object...
     962     
     963    FilesList := TStringList.Create;
     964
     965    //scan for new *.ImgTxt file
     966    //FindFirst may not have correct order, so collect all names and then sort.
     967    if FindFirst(FScanDir+'*.imgtxt',faAnyFile,Found)=0 then repeat
     968      FilesList.Add(FScanDir+Found.Name);
     969    until FindNext(Found) <> 0;   
     970    FindClose(Found); 
     971    FilesList.Sort;  //puts filenames in alphanumeric order
     972
     973    //Now process images in correct order.
     974    for i := 0 to FilesList.Count-1 do begin
     975      FoundFile := FilesList.Strings[i];
     976      if ProcessOneFile(FoundFile) = true then begin  {process *.imgtxt file}
     977        DeleteFile(FoundFile);
     978        FoundFile := ChangeFileExt(FoundFile,'.barcode.txt');
     979        DeleteFile(FoundFile);
     980      end; //Note: it is OK to continue, to get other non-error notes afterwards.
     981    end;
     982    FinishDocument(AutoUploadNote);  // Close and clear any existing note
     983    FilesList.Free
     984  end;
     985
     986 
     987  procedure TUploadForm.ScanAndHandleImages;
     988  (*  Overview of mechanism of action of automatically uploading images.
     989      =================================================================
     990    -- For an image to be uploaded, it must first be positively identified. 
     991       This can occur 1 of two ways:
     992         -- the image contains a datamatrix barcode.
     993         -- the image is part of a batch, and the first image of the batch
     994            contains a barcode for the entire batch.
     995    -- At our site, the scanner program automatically names the files numerically
     996       so that sorting on the name will put them in proper order when working
     997       with batches.
     998    -- The decoding of the barcode requires a special program.  I was not
     999       able to find a way to run this on the Windows client.  I found the
     1000       libdmtx that does this automatically.  It currently is on unix only.
     1001       It was too complicated for me to compile it for windows.  I initially
     1002       wanted everything to run through the RPC broker.  This involved
     1003       uploading the image to the linux server, running the decoder on the
     1004       server, then passing the result back.  The code for this is still avail
     1005       in this CPRS code.  However, the process was too slow and I had to
     1006       come up with something faster.  So the following arrangement was setup
     1007        -- scanned images are stored in a folder that was shared by both the
     1008           windows network (and thus is available to CPRS), and the linux server.
     1009        -- At our site, we used a copier/scanner unit that created only TIFF
     1010           files.  These are not the needed format for the barcode decoder, so...
     1011        -- a cron job runs on the linux server that converts the .tif files
     1012           to .png.  Here is that script:
     1013             <removed due to frequent changes...>
     1014           ---------------------------------
     1015        -- Next the .png files must be checked for a barcode.  Another cron
     1016           task scans a directory for .png files and creates a metafile for
     1017           the file giving its barcode reading, or a marker that there is
     1018           no barcode available for that image.  The file name format is:
     1019           *.barcode.txt, with the * coorelating to filename of the image.
     1020           -- The decoding process can take some time (up to several minutes
     1021              per image.
     1022           -- A flag file named barcodeRead.working.txt is created when the
     1023              script is run, and deleted when done.  So if this file is present
     1024              then the decoding process is not complete.
     1025           -- if a *.barcode.txt file is present, then no attempts will be made
     1026              to decode the image a second time.
     1027           -- CPRS still contains code to upload an image to look for a barcode.
     1028              At this site, only png's will contain barcodes, so I have commented
     1029              out support for automatically uploading other file formats.
     1030           -- Here is the unix bash script that decodes the barcodes.  It is
     1031              launched by cron:
     1032           ---------------------------------
     1033             <removed due to frequent changes...>
     1034           ---------------------------------
     1035    -- After the *.png images are available, and no flag files are present
     1036       to indicate that the server is working with the files, then the images
     1037       are processed, using the barcode metafiles.  This is triggered by a
     1038       timer in CPRS.  It essentially converts imagename + barcode data -->
     1039       --> *.imgtxt.
     1040    -- For each *.png image, there will be a *.imgtxt metafile created.  This
     1041       will contain information needed by the server, in a special format for
     1042       the RPC calls.  When an *.imgtxt file is present, this is a flag that
     1043       the image is ready to be uploaded.
     1044    -- A timer in CPRS scans for *.imgtxt files.  When found, it uploads the
     1045       image to the server and creates a container progress note for displaying
     1046       it in CPRS.
     1047 *)
     1048 
     1049    procedure ScanOneImageType(ImageType : string);
     1050    //Scan directory for all instances of images of type ImageType
     1051    //For each one, create a metadata file (if not already present)
     1052
     1053    //Note: Batch mode only works for a batch of file ALL OF THE SAME TYPE.
     1054    //I.e. There can't be a batch of .jpg, then .gif, then .bmp.  This is
     1055    //because a scanner, if it is scanning a stack of documents for a given
     1056    //patient will produce all files in the same ImageType
     1057
     1058      function DeltaMins(CurrentTime,PriorTime : TDateTime) : integer;
     1059        //Return ABSOLUTE difference in minutes between Current <--> Prior.
     1060        //NOTE: if value is > 1440, then 1440 is returned
     1061      var DeltaDays,FracDays : double; 
     1062      begin
     1063        DeltaDays := abs(CurrentTime-PriorTime);
     1064        FracDays := DeltaDays - Round(DeltaDays);
     1065        if DeltaDays>1 then FracDays := 1;
     1066        Result := Round((60*24)*FracDays);
     1067      end;
     1068
     1069    var
     1070      FoundFile : string;
     1071      MetaFilename : string;
     1072      Found : TSearchRec;
     1073      BarCodeData : AnsiString;
     1074      DFN,DOS,AuthIEN,LocIEN,NoteTypeIEN : string;
     1075      OneLine : string;
     1076      FilePaths : TStringList;
     1077      AllFiles : TStringList;
     1078      OutFileLines : TStringList;
     1079      BatchS : string;
     1080      tempCount : integer;
     1081      BatchFInfo : TFileInfo;
     1082      LastFileTimeStamp,CurFileTimeStamp : TDateTime;
     1083      DeltaMinutes : integer;
     1084      pFInfo : TFileInfo;
     1085      i : integer;
     1086    Label AbortPoint;     
     1087
     1088    const
     1089      ALLOWED_TIME_GAP = 2;  //time in minutes
     1090
     1091    begin   
     1092      FilePaths := TStringList.Create;
     1093      OutFileLines := TStringList.Create;
     1094      AllFiles := TStringList.Create;
     1095      BatchFInfo := TFileInfo.Create;
     1096     
     1097      //NOTE: Later I may make this spawn a separate thread, so that
     1098      //  user doesn't encounter sudden unresponsiveness of CPRS
     1099      //I can use BeginThread, then EndTread
     1100      //Issues: ProcessOneFile would probably have to be a function
     1101      //  not in a class/object...
     1102
     1103      //scan for all instances *.ImageType Image file
     1104      //Store info for processesing after loop
     1105      //Do this as a separate step, so files can be processed in proper order
     1106      if FindFirst(FScanDir+'*.'+ImageType,faAnyFile,Found)=0 then repeat
     1107        FoundFile := FScanDir+Found.Name;
     1108        if FileExists(ChangeFileExt(FoundFile,'.imgtxt')) then continue;
     1109        MetaFilename := ChangeFileExt(FoundFile,'.barcode.txt');
     1110        pFInfo := TFileInfo.Create;  //will be owned by AllFiles
     1111        pFInfo.MetaFileName := MetaFilename;
     1112        pFInfo.FPath := FoundFile;
     1113        pFInfo.SrcRec := Found;
     1114        pFInfo.STimeStamp := FloatToStr(FileDateToDateTime(Found.Time));
     1115        pFInfo.MetaFileExists := FileExists(MetaFilename);
     1116        pFInfo.SBarCode := '';  //default to empty.
     1117        pFInfo.BatchCount := 0;       
     1118        if pFInfo.MetaFileExists = false then begin
     1119          //Call server via RPC to decode Barcode
     1120          //This is too slow and buggy.  Will remove for now...
     1121          //BarCodeData := frmImages.DecodeBarcode(FoundFile,ImageType);
     1122          //pFInfo.SBarCode := BarCodeData;
     1123          pFInfo.SBarCode := '';
     1124          //Here I could optionally create a Metafile for processing below.
     1125        end;
     1126        if pFInfo.MetaFileExists then begin  //Retest in case RPC changed status.
     1127          if FileExists(FScanDir+'barcodeRead.working.txt') then goto AbortPoint;
     1128          OutFileLines.LoadFromFile(pFInfo.MetaFileName);
     1129          if OutFileLines.Count>0 then begin
     1130            pFInfo.SBarCode := OutFileLines.Strings[0];
     1131            //convert 'No Barcode message into an empty string, to match existing code.           
     1132            if Pos('//',pFInfo.SBarCode)=1 then pFInfo.SBarCode := ''; 
     1133            if NumPieces(pFInfo.SBarCode,'-') <> 8 then pFInfo.SBarCode := ''; 
     1134          end else begin
     1135            pFInfo.MetaFileExists := false;  //set empty file to Non-existence status
     1136          end;
     1137        end;
     1138        AllFiles.AddObject(pFInfo.FPath,pFInfo);  //Store filename, to allow sorting on this.
     1139      until FindNext(Found) <> 0;   
     1140      AllFiles.Sort; // Sort on timestamp --> put in ascending alpha filename order
     1141
     1142      //-------- Now, process files in name order ------------
     1143      LastFileTimeStamp := 0;
     1144      BatchFInfo.BatchCount := 0;
     1145      for i := 0 to AllFiles.Count-1 do begin
     1146        pFInfo := TFileInfo(AllFiles.Objects[i]);
     1147        if pFInfo.MetaFileExists = false then continue;
     1148        CurFileTimeStamp := FileDateToDateTime(pFInfo.SrcRec.Time);
     1149        DeltaMinutes := DeltaMins(CurFileTimeStamp,LastFileTimeStamp);
     1150        // *.barcode.txt file exists at this point
     1151        if pFInfo.SBarCode <> '' then begin  //Found a new barcode
     1152          LastFileTimeStamp := CurFileTimeStamp;
     1153          //Note: The expected format of barcode must be same as that
     1154          //      created by TfrmPtLabelPrint.PrintButtonClick:
     1155          //      70685-12-31-2008-73-6-1302-0
     1156          //      PtIEN-DateOfService-AuthorIEN-LocIEN-NoteTypeIEN-BatchFlag
     1157          //      THUS there should be 8 pieces in the string.       
     1158          DFN := piece(pFInfo.SBarCode,'-',1);
     1159          DOS := pieces(pFInfo.SBarCode,'-',2,4);
     1160          AuthIEN := piece(pFInfo.SBarCode,'-',5);
     1161          LocIEN := piece(pFInfo.SBarCode,'-',6);
     1162          NoteTypeIEN := piece(pFInfo.SBarCode,'-',7);
     1163          BatchS := piece(pFInfo.SBarCode,'-',8);
     1164          if BatchS = '*' then begin
     1165            pFInfo.BatchCount := 9999
     1166          end else begin
     1167            try
     1168              pFInfo.BatchCount := StrToInt(BatchS);
     1169            except
     1170              on E:EConvertError do begin
     1171                pFInfo.BatchCount := 1;
     1172              end;
     1173            end;
     1174          end;
     1175          //BatchFInfo.SBarCode := pFInfo.SBarCode;
     1176        end else if (BatchFInfo.BatchCount > 0) then begin
     1177          if (DeltaMinutes > ALLOWED_TIME_GAP) then begin
     1178            pFInfo.Clear;
     1179            BatchFInfo.Clear;
     1180          end else begin
     1181            //Apply barcode from last image onto this one (from same batch)
     1182            pFInfo.SBarCode := BatchFInfo.SBarCode; 
     1183          end;
     1184        end;
     1185        if pFInfo.SBarCode <> '' then begin
     1186          //Success --> write out ImgTxt file...
     1187          FilePaths.Add(pFInfo.FPath);
     1188          OneLine := EncodeImgTxt('', '`'+LocIEN,'', '`'+DFN, '', '', '',
     1189                                  DOS,'`'+AuthIEN, '`'+NoteTypeIEN, FilePaths);
     1190          if pFInfo.BatchCount>0 then begin
     1191            //A BATCH marker has been found on current barcode.  This means that
     1192            //Batchmode should be turned on.  This will apply current barcode
     1193            //data to any subsequent images, providing there is not a gap in
     1194            //time > ALLOWED_TIME_GAP
     1195            BatchFInfo.Assign(pFInfo);  //reset Batch info to current
     1196          end; 
     1197          //Decrease use count of Batch Info
     1198          Dec(BatchFInfo.BatchCount);
     1199        end else begin
     1200          OneLine := '';
     1201        end;
     1202        OutFileLines.Clear;
     1203        if OneLine <> '' then begin
     1204          OutFileLines.Add(OneLine);                                       
     1205          OutFileLines.SaveToFile(ChangeFileExt(pFInfo.FPath,'.imgtxt'));
     1206        end; 
     1207        FilePaths.Clear;
     1208        OutFileLines.Clear;
     1209        LastFileTimeStamp := CurFileTimeStamp;
     1210      end;
     1211AbortPoint:
     1212      FindClose(Found); 
     1213      BatchFInfo.Free;
     1214      FilePaths.Free;
     1215      for i := 0 to AllFiles.Count-1 do begin  //free owned objects
     1216        pFInfo := TFileInfo(AllFiles.Objects[i]);
     1217        pFInfo.Free;
     1218      end;
     1219      AllFiles.Free;
     1220      OutFileLines.Free;
     1221    end;
     1222
     1223  var flag1Filename,flag2Filename : string;
     1224  begin
     1225    flag1Filename := FScanDir+'barcodeRead.working.txt';
     1226    flag2Filename := FScanDir+'convertTif2Png.working.txt';
     1227    //if linux server is in middle of a conversion or barcode decode, then skip.
     1228    if (FileExists(flag1Filename)=false) and (FileExists(flag2Filename)=false) then begin
     1229      (* Remove {}'s to be able to have jpg's etc that contain barcodes
     1230        In our site, only png's will have barcodes, and thus these are the
     1231        only images that can be uploaded automatically.  Uploading jpg's, bmp's
     1232        etc to look for (nonexistent) barcodes will just waste time and bandwidth. *)
     1233      {
     1234      ScanOneImageType('jpg');
     1235      ScanOneImageType('jpeg');
     1236      ScanOneImageType('gif');
     1237      ScanOneImageType('bmp');
     1238      }
     1239      //ScanOneImageType('tif');   {Tiff was not showing up in IE for some reason}
     1240      //ScanOneImageType('tiff');  {Tiff was not showing up in IE for some reason}
     1241      ScanOneImageType('png');
     1242    end;
     1243  end;
     1244
     1245  procedure TUploadForm.PolTimerTimer(Sender: TObject);
     1246  begin
     1247    PolTimer.Enabled := false;
     1248    try
     1249      if Assigned(frmImages) and frmImages.AutoScanUpload.Checked then begin
     1250        ScanAndHandleImages;  //create metadata for images (if not done already)
     1251        ScanAndHandleImgTxt;  //process upload file, based on metadata
     1252      end;
     1253    finally
     1254      PolTimer.Enabled := true;
     1255      PolTimer.Interval := PolInterval;
     1256    end;
     1257  end;
     1258
     1259
     1260
    4141261end.
Note: See TracChangeset for help on using the changeset viewer.