โปรแกรมบัญชีเกณพ์คงค้าง รพ.สต. สสจ.สุรินทร์ รายงานผู้บริหารด้านการเงิน รพ.สต.

Scriptนำข้อมูลสิทธิจ่ายตรง 21 เข้า hosxp


DateTime : 2010-08-19 09:53:06
Post By : chinaga
IP Address :

นำไปวางที่สายฟ้าครับ 

 แก้ไขชื่อไฟล์และที่อยู่ที่นำเข้าตรงบรรทัดนีเครับ dbf.tablename:='c:\CSCDMEM.DBF';

แก้ไขสิทธิที่นำเข้าตรงบรรทัดนีเครับ  tc.fieldbyname('pttype').asstring:= '21';

 

#################################

Unit Script;


function addzero(s:string;i:integer):string;
begin
  //result:=s;
  while length(s)<i do
  begin
    s:='0'+s;
  end;
  result:=s;
end;

function CheckPID(pid: string): boolean;
var
  i: integer;
  nMod, nValue, cv: integer;
  snmod: string;
begin
  pid := replacestr(pid, '-', '');
  result := false;
  if length(replacestr(pid, ' ', '')) <> 13 then
    exit;

  try

    cv := strtoint(copy(pid, 1, 1));
    nValue := cv * 13;

    for i := 2 to 12 do
    begin
      cv := strtoint(copy(pid, i, 1));
      nValue := nValue + (cv * (14 - i));

    end;

    nMod := 11 - (nValue mod 11);
    snmod := inttostr(nmod);
    snmod := copy(snmod, length(snmod), 1);
    result := copy(pid, 13, 1) = snmod;

  except
    result := false;

  end;

end;

function MakeFullCID(cid: string): string;
begin
  result := cid;
  if length(cid) = 17 then
    exit;
  result := '';
  if length(cid) <> 13 then
    exit;
  result := copy(cid, 1, 1) + '-' +
    copy(cid, 2, 4) + '-' +
    copy(cid, 6, 5) + '-' +
    copy(cid, 11, 2) + '-' +
    copy(cid, 13, 1);
end;

 

Procedure Main;
var
  i:integer;
  dbf:TDBF;
  tc:tclientdataset;
  tcid:tclientdataset;
begin

  dbf:=tdbf.create(nil);
  dbf.tablename:='c:\CSCDMEM.DBF';
  dbf.open;
  dbf.first;
  tc:=tclientdataset.create(nil);
  tcid:=tclientdataset.create(nil);
  while not dbf.eof do
  begin
    tc.data:=HoSxP_GetDataset('select * from patient where hn = "'+ dbf.fieldbyname('hn').asstring +'"');
    if tc.recordcount>0 then
    begin
      showdebugtext('Update patient : '+tc.fieldbyname('hn').asstring+'pttype='+tc.fieldbyname('pttype').asstring+'CID='+tc.fieldbyname('cid').asstring);
      tc.edit;
      tc.fieldbyname('gov_chronic_id').asstring:=dbf.fieldbyname('memberno').asstring;
      tc.fieldbyname('pttype').asstring:= '21';
      if checkpid(dbf.fieldbyname('pid').asstring) then
      begin
        tc.fieldbyname('cid').asstring:=dbf.fieldbyname('pid').asstring;
        tcid.data:=HOSxP_GetDataset('select * from ptcardno where hn="'+ dbf.fieldbyname('hn').asstring +'" and cardtype="01"');
        if tcid.recordcount>0 then
        begin
          tcid.edit;

        end else
        begin
          tcid.insert;
        end;

        tcid.fieldbyname('hn').asstring:=dbf.fieldbyname('hn').asstring ;
        tcid.fieldbyname('cardno').asstring:=makefullcid(dbf.fieldbyname('pid').asstring);
        tcid.fieldbyname('cardtype').asstring:='01';
        tcid.post;
        if tcid.changecount>0 then
         HOSxP_UpdateDelta(tcid.delta, 'select * from ptcardno where hn="'+dbf.fieldbyname('hn').asstring+'" and cardtype="01"');
      end;
      tc.post;

      if tc.changecount>0 then
      HOSxP_UpdateDelta(tc.delta,'select * from patient where hn = "'+dbf.fieldbyname('hn').asstring+'"');

    end;
    dbf.next;
  end;


  dbf.free;
  tc.free;
  showmessage('done.');
end;

 

 

end.


Message !!

หากต้องการตอบกระทู้ Webboard กรุณาเข้าใช้ระบบก่อนนะค่ะ..


กระทู้ตอบกลับ

โอ้เทพมาปล่อยของดีอีกแล้ว ขอบคุณมากครับ


Post โดย :  dogmike Date: 2010-08-19 11:20:06 ip:

ไม่มีหน้ากากหรอครับ ....


Post โดย :  dogmike Date: 2010-08-19 11:27:47 ip:

ขอบคุณมากๆๆๆเลยค่ะ


Post โดย :  nong1ka Date: 2010-08-19 18:42:24 ip:

ไม่มีครับ Script อย่างเดียวรบกวนออกแบบให้ด้วยครับ

 


Post โดย :  chinaga Date: 2010-08-19 22:43:45 ip:

เปลี่ยนแล้วมี error เกิดขึ้นครับ  ตามนี้ครับ

 

 


Post โดย :  pongsa Date: 2010-10-23 10:28:13 ip: 124.157.147.210

Post โดย :  pongsa Date: 2010-10-23 10:28:29 ip: 124.157.147.210

ต้อง save ก่อนแล้วค่อย run ครับ

ทดสอบแล้วได่ไหมครับ


Post โดย :  chinaga Date: 2010-10-23 21:07:21 ip: 113.53.239.85