pacs.dpr

a program written by delphi about middle layer

library pacs;

{ Important note about DLL memory management: ShareMem must be the
  first unit in your library's USES clause AND your project's (select
  Project-View Source) USES clause if your DLL exports any procedures or
  functions that pass strings as parameters or function results. This
  applies to all strings passed to and from your DLL--even those that
  are nested in records and classes. ShareMem is the interface unit to
  the BORLNDMM.DLL shared memory manager, which must be deployed along
  with your DLL. To avoid using BORLNDMM.DLL, pass string information
  using PChar or ShortString parameters. }

uses
  SysUtils,
  Forms,
  Classes,
  Unit_Pacs_Invoke_Query in 'Unit_Pacs_Invoke_Query.pas' {dmPacsQuery: TDataModule},
  Unit_Pacs_Invoke_Conclusion in 'Unit_Pacs_Invoke_Conclusion.pas' {dmPacsConclusion: TDataModule},
  Unit_Pacs_Invoke_Register in 'Unit_Pacs_Invoke_Register.pas' {dmPacsRegister: TDataModule};

{$R *.res}
var
    gv_ip: string;
    gv_port: integer;
    gv_checktype: string;
    gb_socket_opened: boolean;

    gv_socket_register_ip: string;
    gv_socket_register_port: integer;
    gb_socket_register_opened: boolean;

function pacs_open_socket(node: string): boolean;
begin
    //Application.MessageBox(PChar(node),'1');
    //Application.MessageBox(PChar(chkid),'2');
    //Application.MessageBox(PChar(part),'3');
    dmPacsQuery := TdmPacsQuery.Create(nil);
    dmPacsQuery.dmc_query.Connected := true;
    with dmPacsQuery.cds_query do
    begin
        Close;
        FetchParams;
        Params.ParamByName('node').AsString := node;
        Open;
        gv_ip := FieldByName('pacs_ip').AsString;
        gv_checktype := FieldByName('checktype_code').AsString;
        Close;
    end;
    with dmPacsQuery.cds_port do
    begin
        Close;
        Open;
        gv_port := FieldByName('param_value').AsInteger;
        Close;
    end;
    with dmPacsQuery.csmit do
    begin
        try
            if not Active then Open;
            gb_socket_opened := true;
        except
            gb_socket_opened := false;
            raise;
        end;

        //if Socket.Connected then
        //    Application.MessageBox('ok','ok')
        //else
        //    Application.MessageBox('fail','fail');

        //Socket.SendText(strIP);
        //Socket.SendText('测试');
        //Close;
        //Active := false;
    end;
    //dmPacsQuery.csmit.Socket.Connect();
end;

function pacs_open_register_socket(): boolean;
label wait1 ;
begin
    //Application.MessageBox(PChar(node),'1');
    //Application.MessageBox(PChar(chkid),'2');
    //Application.MessageBox(PChar(part),'3');
    dmPacsRegister := TdmPacsRegister.Create(nil);
    dmPacsRegister.dmc_register.Connected := true;
    with dmPacsRegister.cds_ip do
    begin
        Close;
        Open;
        Filter := 'param_name=''pacs_register_port''';
        Filtered := true;
        gv_socket_register_port := FieldByName('param_value').AsInteger;

        Filter := 'param_name=''pacs_register_ip''';
        Filtered := true;
        gv_socket_register_ip := FieldByName('param_value').AsString;

        Close;
    end;
    with dmPacsRegister.cs_register do
    begin
        //Application.HandleMessage;
        //Open;
        //.Socket.Connect(0);
        Host := gv_socket_register_ip;
        Port := gv_socket_register_port;
            if not Active then Open;
                //Active := true;

        //if Socket.Connected then
        //    Application.MessageBox('ok','ok')
        //else
        //    Application.MessageBox('fail','fail');
        //try
//wait1:      if not Socket.Connected then
        //    begin
                //gb_socket_register_opened := true;
                //asm
                //    noop;
                //end;
        //        sleep(100);
                //goto wait1;
        //    end;
            //if Socket.Connected then
            //    Application.MessageBox('ok','ok')
            //else
            //    Application.MessageBox('fail','fail');
        //except
        //    gb_socket_register_opened := false;
        //    raise;
        //end;
    end;
end;

function pacs_hex(): string;
begin
    result := 'A';
end;

function pacs_frmae_pack(s: string): string;
begin
    s := #02 + s + #03;
    result := s;
end;

function pacs_frmae_checksum(s: string): string;
var
    i, j, k: integer;
    sbit: string;
begin
    j := 0;
    k := 256;
    for i := 1 to length(s) do
    begin
        sbit := copy(s, j, 1);
        //j := j + ord(setlength(sbit[0],1));
        j := 20000;
    end;
    j := j div k;

    result := IntToHex(j, 2);
end;

procedure pacs_disp_capt(pchkid: integer; pnode: string; ppart: string; pt: integer);
var
    strFrame: string;
begin
    if not gb_socket_opened then
    begin
        gb_socket_opened := pacs_open_socket(pnode);
        ppart := gv_checktype;
    end;
    strFrame := '|F|' + IntToStr(pt) + '|A|' + IntToStr(pchkid) + '|D|' + ppart;

    strFrame := pacs_frmae_pack(strFrame) + pacs_frmae_checksum(strFrame);
    with dmPacsQuery.csmit do
    begin
        try
            Socket.SendText(strFrame);
        except
            raise;
        end;
    end;
end;

procedure pacs_capture(pchkid: integer; pnode: string);
begin
    pacs_disp_capt(pchkid, pnode, gv_checktype, 2);
end;

procedure pacs_display(pchkid: integer; pnode: string; ppart: string);
begin
    pacs_disp_capt(pchkid, pnode, ppart, 3);
end;

procedure pacs_register(pchkid: integer);
var
    strFrame: string;
    strBasInfo: string;
begin
    //if not gb_socket_register_opened then
    //    gb_socket_register_opened := pacs_open_register_socket;
    with dmPacsRegister.cds_register do
    begin
        Close;
        FetchParams;
        Params.ParamByName('chkid').AsInteger := pchkid;
        Open;
        strBasInfo := '|F|1';
        strBasInfo := strBasInfo + '|P|' + trim(FieldByName('occupy_date').AsString);
        strBasInfo := strBasInfo + '|Q|' + trim(FieldByName('check_card_no').AsString);
        strBasInfo := strBasInfo + '|B|' + FieldByName('member_id').AsString;
        strBasInfo := strBasInfo + '|A|' + FieldByName('check_id').AsString;
        strBasInfo := strBasInfo + '|E|' + FieldByName('name').AsString;
        strBasInfo := strBasInfo + '|G|' + FieldByName('sex').AsString;
        strBasInfo := strBasInfo + '|H|' + FieldByName('english_name').AsString;
        strBasInfo := strBasInfo + '|I|' + FieldByName('birthday').AsString;
        strBasInfo := strBasInfo + '|J|' + FieldByName('idcard').AsString;
        strBasInfo := strBasInfo + '|C|' + FieldByName('part').AsString;
    end;

    strFrame := pacs_frmae_pack(strBasInfo) + pacs_frmae_checksum(strBasInfo);
    with dmPacsRegister.cs_register do
    begin
        try
            Socket.SendText(strFrame);
        except
            gb_socket_register_opened := false;
            raise;
        end;
        //Socket.Close;

    end;
end;

procedure pacs_conclusion(pchkid: integer; pitem: string; pcon: string; padv: string);
begin

end;

procedure init;
begin
    gb_socket_register_opened := false;
    gb_socket_opened := false;
    //pacs_open_register_socket;
end;

function socket_connection_check(handle: integer): boolean;
begin

end;

exports
    pacs_open_socket,
    pacs_open_register_socket,
    pacs_capture,
    pacs_display,
    pacs_register,
    pacs_conclusion;

begin
    Application.Initialize;
    Application.CreateForm(TdmPacsQuery, dmPacsQuery);
    Application.CreateForm(TdmPacsRegister, dmPacsRegister);
    Application.CreateForm(TdmPacsConclusion, dmPacsConclusion);
    Init;
    //pacs_open_socket;
    //pacs_open_register_socket;
end.