« หน้าที่แล้ว ต่อไป »
หน้า: [1]   ลงล่าง

ผู้เขียน หัวข้อ: HI Exchange 0.01  (อ่าน 6317 ครั้ง)

0 สมาชิก และ 1 บุคคลทั่วไป กำลังดูหัวข้อนี้

doramon

  • บุคคลทั่วไป
HI Exchange 0.01
« เมื่อ: พฤศจิกายน 23, 2006, 10:00:18 AM »
0
โค๊ด: Delphi
  1. unit StatExchange;// version 0.1// 2006-09-05// Chaiyaporn Suratemekul var StatPath: string;   MainForm: TForm;  StartButton: TButton;  AbortButton: TButton;  StatusMemo: TMemo;  FAbort: Boolean;  StatusLabel : TLabel;  ErrMemo:TMemo;   LastErr: string; implementation Procedure AddLog(s:string);begin  StatusMemo.Lines.Add(formatdatetime('hh:nn:ss',now)+'>'+s); end; Procedure CheckErr;begin   if LastErr<>'' then  if Pos('CommandText', LastErr) = 0 then ErrMemo.Lines.Add(formatdatetime('hh:nn:ss',now)+' '+LastErr); end;  procedure StartExport;var  sconnection: string; // variable for hold connection string  st: string; // variable for hold any string  tc, StatCDS: Tclientdataset;  QueueCDS: TClientDataset; begin   if StatPath = '' then  begin    StatPath := VarToStr(GetSQLData('select statroot from opdconfig'));    StatusMemo.Lines.Add('Stat Path = ' + statPath);  end;   if StatPath = '' then  begin    AddLog('Error : no unit StatExchange;
  2. // version 0.1
  3. // 2006-09-05
  4. // Chaiyaporn Suratemekul
  5.  
  6. var StatPath: string;
  7.  
  8.   MainForm: TForm;
  9.   StartButton: TButton;
  10.   AbortButton: TButton;
  11.   StatusMemo: TMemo;
  12.   FAbort: Boolean;
  13.   StatusLabel : TLabel;
  14.   ErrMemo:TMemo;
  15.  
  16.   LastErr: string;
  17.  
  18. implementation
  19.  
  20. Procedure AddLog(s:string);
  21. begin
  22.   StatusMemo.Lines.Add(formatdatetime('hh:nn:ss',now)+'>'+s);
  23.  
  24. end;
  25.  
  26. Procedure CheckErr;
  27. begin
  28.  
  29.   if LastErr<>'' then
  30.   if Pos('CommandText', LastErr) = 0 then ErrMemo.Lines.Add(formatdatetime('hh:nn:ss',now)+' '+LastErr);
  31.  
  32. end;
  33.  
  34.  
  35. procedure StartExport;
  36. var
  37.   sconnection: string; // variable for hold connection string
  38.   st: string; // variable for hold any string
  39.   tc, StatCDS: Tclientdataset;
  40.   QueueCDS: TClientDataset;
  41.  
  42. begin
  43.  
  44.   if StatPath = '' then
  45.   begin
  46.     StatPath := VarToStr(GetSQLData('select statroot from opdconfig'));
  47.     StatusMemo.Lines.Add('Stat Path = ' + statPath);
  48.   end;
  49.  
  50.   if StatPath = '' then
  51.   begin
  52.     AddLog('Error : no information in opdconfig.statroot');
  53.     exit;
  54.   end;
  55.  
  56.  
  57.  
  58.  
  59.   sconnection := 'Provider=VFPOLEDB.1;Data Source=' + StatPath + '\hi\tbl;Mode=Share Deny None;Extended Properties="";User ID="";Password="";Mask Password=False;Cache Authentication=False;Encrypt Password=False;Collating Sequence=THAI;DSN=""';
  60.  
  61.   ado_connection.connected := false;
  62.  
  63.   ado_connection.connectionstring := sconnection;
  64.  
  65.   ado_connection.connected := true;
  66.  
  67.   tc := tclientdataset.create(nil);
  68.   statcds := tclientdataset.create(nil);
  69.  // tc.data:=HOSxP_GetADODataset('select count(*) as cc from patient1');
  70.  // StatusMemo.lines.add('Start Import Patient');
  71.  
  72.   QueueCDS := TClientDataset.create(nil);
  73.  
  74.  
  75.   repeat
  76.  
  77.     QueueCDS.data := HOSxP_GetDataset('select * from stat_queue where process_count = 0 and queue_type = "OPDCARD" order by queue_date_time');
  78.  
  79.     while not QueueCDS.eof do
  80.     begin
  81.       LastErr := '';
  82.       tc.data := HOSxP_GetDataset('select * from patient where hn = "' + queuecds.fieldbyname('id').asstring + '"');
  83.  
  84.  
  85.       statcds.data := HOSxP_GetADODataset('select count(*) as cc from pt where hn = ' + inttostr(tc.fieldbyname('hn').asinteger) + '');
  86.       if statcds.fieldbyname('cc').asinteger = 0 then
  87.       begin
  88.         LastErr := '';
  89.         StatusMemo.Lines.Add('======= New Patient ====== [' + tc.fieldbyname('hn').asstring+']');
  90.         AddLog('Insert pt 1 '+tc.fieldbyname('hn').asstring);
  91.         try
  92.           HOSxP_GetADODataset('insert into pt (hn,sex,name,birthday,derive,mother,father,lastdate,time,person_id,class,clinic) values ("' + tc['hn'] + '","' + tc['sex'] + '","' +
  93.             vartostr(tc['fname']) + ' ' + vartostr(tc['lname']) + ',' +
  94.             vartostr(tc['pname']) + '",Date(' + formatdatetime('yyyy', tc.fieldbyname('birthday').asdatetime) + ',' +
  95.             formatdatetime('m', tc.fieldbyname('birthday').asdatetime) + ',' +
  96.             formatdatetime('d', tc.fieldbyname('birthday').asdatetime) + '),"1","' +
  97.             vartostr(tc['mathername']) + '","' +
  98.             vartostr(tc['fathername']) + '", ' +
  99.             ' Date(' + formatdatetime('yyyy', date) + ',' +
  100.             formatdatetime('m', date) + ',' +
  101.             formatdatetime('d', date) + '), ' +
  102.             '"' + formatdatetime('hhnn', now) + '", "' +
  103.             tc.fieldbyname('cid').asstring + '" ,"' +
  104.             tc.fieldbyname('pttype').asstring + '" ,"' +
  105.             '01"' +
  106.  
  107.             ' )');
  108.         except
  109.           on e: exception do
  110.           begin
  111.             LastErr := E.message;
  112.           end;
  113.         end;
  114.  
  115.         CheckErr;
  116.  
  117.  
  118.         statcds.data := HOSxP_GetADODataset('select count(*) as cc from patient1 where hn = "' + tc.fieldbyname('hn').asstring + '"');
  119.         if statcds.fieldbyname('cc').asinteger = 0 then StatusMemo.lines.add('Stat Insert Fail !!!');
  120.  
  121.       end else
  122.       begin
  123.         LastErr := '';
  124.         AddLog('Edit pt 1 ' + tc.fieldbyname('hn').asstring);
  125.         try
  126.           HOSxP_GetADODataset('update pt set sex = "' + vartostr(tc['sex']) + '" , ' +
  127.             'name = "' + vartostr(tc['fname']) + ' ' + vartostr(tc['lname']) + ',' + vartostr(tc['pname']) + '" ,' +
  128.             'birthday = Date(' + formatdatetime('yyyy', tc.fieldbyname('birthday').asdatetime) + ',' +
  129.             formatdatetime('m', tc.fieldbyname('birthday').asdatetime) + ',' +
  130.             formatdatetime('d', tc.fieldbyname('birthday').asdatetime) + ') , ' +
  131.             'mother = "' + vartostr(tc['mathername']) + '" , ' +
  132.             'father = "' + vartostr(tc['fathername']) + '"  ' +
  133.  
  134.             ' where hn = "' + vartostr(tc['hn']) + '" ');
  135.         except
  136.           on e: exception do
  137.           begin
  138.             LastErr := E.message;
  139.           end;
  140.         end;
  141.  
  142.       end;
  143.  
  144.       CheckErr;
  145.       statcds.data := HOSxP_GetADODataset('select count(*) as cc from patient2 where hn = "' + tc.fieldbyname('hn').asstring + '"');
  146.       if statcds.fieldbyname('cc').asinteger = 0 then
  147.       begin
  148.         AddLog('Insert patient2 ' + tc.fieldbyname('hn').asstring);
  149.         try
  150.           HOSxP_GetADODataset('insert into patient2 (hn,occupa,nation,race,marriage,phone,contact) values ("' + tc['hn'] + '","' +
  151.  
  152.             vartostr(tc['occupation']) + '", "' +
  153.             tc.fieldbyname('nationality').asstring + '" ,"' +
  154.             tc.fieldbyname('citizenship').asstring + '" ,"' +
  155.             tc.fieldbyname('marrystatus').asstring + '" ,"' +
  156.             tc.fieldbyname('hometel').asstring + '" ,"' +
  157.             tc.fieldbyname('informname').asstring + '" ' +
  158.  
  159.             ' )');
  160.         except
  161.           on e: exception do
  162.           begin
  163.             LastErr := E.message;
  164.           end;
  165.         end;
  166.  
  167.         CheckErr;
  168.         statcds.data := HOSxP_GetADODataset('select count(*) as cc from patient2 where hn = "' + tc.fieldbyname('hn').asstring + '"');
  169.         if statcds.fieldbyname('cc').asinteger = 0 then StatusMemo.lines.add('Stat patient2 Insert Fail !!!');
  170.  
  171.       end else
  172.       begin
  173.         AddLog('Edit patient2 ' + tc.fieldbyname('hn').asstring);
  174.         try
  175.           HOSxP_GetADODataset('update patient2 set occupa = "' + vartostr(tc['occupation']) + '" ,' +
  176.  
  177.             'nation = "' + vartostr(tc['nationality']) + '" , ' +
  178.             'race = "' + vartostr(tc['citizenship']) + '",  ' +
  179.             'marriage = "' + vartostr(tc['marrystatus']) + '",  ' +
  180.             'phone = "' + vartostr(tc['hometel']) + '"  ,' +
  181.             'contact = "' + vartostr(tc['informname']) + '" ' +
  182.  
  183.             ' where hn = "' + vartostr(tc['hn']) + '" ');
  184.         except
  185.           on e: exception do
  186.           begin
  187.             LastErr := E.message;
  188.           end;
  189.         end;
  190.  
  191.       end;
  192.  
  193.       CheckErr;
  194.       statcds.data := HOSxP_GetADODataset('select count(*) as cc from contact where hn = "' + tc.fieldbyname('hn').asstring + '"');
  195.       if statcds.fieldbyname('cc').asinteger = 0 then
  196.       begin
  197.         AddLog('Insert contact ' + tc.fieldbyname('hn').asstring);
  198.         try
  199.           HOSxP_GetADODataset('insert into contact (hn,address,village,tambon,ampur,changwat,owner) values ("' + tc['hn'] + '","' +
  200.  
  201.             vartostr(tc['addrpart']) + '", "' +
  202.             tc.fieldbyname('moopart').asstring + '" ,"' +
  203.             tc.fieldbyname('tmbpart').asstring + '" ,"' +
  204.             tc.fieldbyname('amppart').asstring + '" ,"' +
  205.             tc.fieldbyname('chwpart').asstring + '" ,"' +
  206.             '1' + '" ' +
  207.  
  208.             ' )');
  209.         except
  210.           on e: exception do
  211.           begin
  212.             LastErr := E.message;
  213.           end;
  214.         end;
  215.  
  216.         CheckErr;
  217.         statcds.data := HOSxP_GetADODataset('select count(*) as cc from contact where hn = "' + tc.fieldbyname('hn').asstring + '"');
  218.         if statcds.fieldbyname('cc').asinteger = 0 then StatusMemo.lines.add('Stat contact Insert Fail !!!');
  219.  
  220.       end else
  221.       begin
  222.         LastErr := '';
  223.         AddLog('Edit contact ' + tc.fieldbyname('hn').asstring);
  224.         try
  225.           HOSxP_GetADODataset('update contact set address = "' + vartostr(tc['addrpart']) + '" ,' +
  226.  
  227.             'village = "' + vartostr(tc['moopart']) + '" , ' +
  228.             'tambon = "' + vartostr(tc['tmbpart']) + '",  ' +
  229.             'ampur = "' + vartostr(tc['amppart']) + '",  ' +
  230.             'changwat = "' + vartostr(tc['chwpart']) + '"  ,' +
  231.             'owner = "1" ' +
  232.  
  233.             ' where hn = "' + vartostr(tc['hn']) + '" and owner="1" ');
  234.         except
  235.           on e: exception do
  236.           begin
  237.             LastErr := E.message;
  238.           end;
  239.         end;
  240.  
  241.       end;
  242.  
  243.       CheckErr;
  244.  
  245.       QueueCDS.edit;
  246.       QueueCDS.fieldbyname('process_count').asinteger := QueueCDS.fieldbyname('process_count').asinteger + 1;
  247.       if Pos('CommandText', LastErr) > 0 then QueueCDS.fieldbyname('error').asinteger:= QueueCDS.fieldbyname('error').asinteger+1;
  248.       QueueCDs.post;
  249.  
  250.       QueueCDS.next;
  251.     end;
  252.  
  253.     if QueueCDs.ChangeCount > 0 then
  254.       HOSxP_updateDelta(Queuecds.Delta, 'select * from stat_queue where process_count = 0 and queue_type = "OPDCARD" order by queue_date_time');
  255.  
  256.   until ((QueueCDS.RecordCount = 0) or FAbort);
  257.  
  258.  
  259.   repeat
  260.     QueueCDS.data := HOSxP_GetDataset('select * from stat_queue where process_count = 0 and queue_type = "VISIT" order by queue_date_time');
  261.  
  262.     while not QueueCDS.Eof do
  263.     begin
  264.       LastErr := '';
  265.       sconnection := 'Provider=VFPOLEDB.1;Data Source=' + StatPath + '\PUB;Mode=Share Deny None;Extended Properties="";User ID="";Password="";Mask Password=False;Cache Authentication=False;Encrypt Password=False;Collating Sequence=THAI;DSN=""';
  266.  
  267.       ado_connection.connected := false;
  268.  
  269.       ado_connection.connectionstring := sconnection;
  270.  
  271.       ado_connection.connected := true;
  272.  
  273.       tc.data := HOSxP_GetDataset('select * from vn_stat where vn = "' + QueueCDS.fieldbyname('id').asstring + '"');
  274.       if tc.recordcount > 0 then
  275.       begin
  276.         LastErr := '';
  277.         StatusMemo.Lines.add('===== New Visit =====');
  278.         AddLog('Edit patient1 class ' + tc.fieldbyname('hn').asstring);
  279.         try
  280.           HOSxP_GetADODataset('update patient1 set class = "' + vartostr(tc['pttype']) + '"  ' +
  281.  
  282.             ' where hn = "' + vartostr(tc['hn']) + '" ');
  283.         except
  284.           on e: exception do
  285.           begin
  286.             LastErr := E.message;
  287.           end;
  288.         end;
  289.  
  290.         CheckErr;
  291.  
  292.  
  293.         //check insurelog
  294.         sconnection := 'Provider=VFPOLEDB.1;Data Source=' + StatPath + '\CREDIT\DATA;Mode=Share Deny None;Extended Properties="";User ID="";Password="";Mask Password=False;Cache Authentication=False;Encrypt Password=False;Collating Sequence=THAI;DSN=""';
  295.  
  296.  
  297.  
  298.         ado_connection.connected := false;
  299.  
  300.         ado_connection.connectionstring := sconnection;
  301.  
  302.         ado_connection.connected := true;
  303.  
  304.  
  305.         statcds.data := HOSxP_GetADODataset('select count(*) as cc from insurlog where hn = "' + tc.fieldbyname('hn').asstring + '"');
  306.  
  307.  
  308.         if statcds.fieldbyname('cc').asinteger = 0 then
  309.       begin
  310.         LastErr := '';
  311.         AddLog('Insert insurlog ' + tc.fieldbyname('hn').asstring);
  312.  
  313.         try
  314.           HOSxP_GetADODataset('insert into insurlog (hn,subtype,inscl,cid,hospmain,hospsub,name,datein,dateexp,notedate,note,recordby,verifyby) values ("' +
  315.             tc['hn'] + '","' +
  316.             vartostr(tc['pcode']) + '", "' +
  317.             tc.fieldbyname('pttype').asstring + '" ,"' +
  318.             tc.fieldbyname('pttypeno').asstring + '" ,"' +
  319.             tc.fieldbyname('hospmain').asstring + '" ,"' +
  320.             tc.fieldbyname('hospsub').asstring + '" ,"' +
  321.             vartostr(getsqldata('select concat(fname," ",lname,",",pname) as name from patient where hn="'+tc.fieldbyname('hn').asstring+'"')) + '", ' +
  322.             ' Date(' + formatdatetime('yyyy', date) + ',' +
  323.             formatdatetime('m', date) + ',' +
  324.             formatdatetime('d', date) + ') , '+
  325.  
  326.             ' Date(' + formatdatetime('yyyy', date) + ',' +
  327.             formatdatetime('m', date) + ',' +
  328.             formatdatetime('d', date) + ') , '+
  329.  
  330.             ' Date(' + formatdatetime('yyyy', date) + ',' +
  331.             formatdatetime('m', date) + ',' +
  332.             formatdatetime('d', date) + ')  ,'+
  333.  
  334.             ' " " ,'+ // note
  335.             ' "HOSxP" , '+ //   recordby
  336.             ' "HOSxP" '+ // verifyby
  337.  
  338.             ' )');
  339.         except
  340.           on e: exception do
  341.           begin
  342.             LastErr := E.message;
  343.           end;
  344.         end;
  345.  
  346.         CheckErr;
  347.  
  348.         statcds.data := HOSxP_GetADODataset('select count(*) as cc from insurlog where hn = "' + tc.fieldbyname('hn').asstring + '"');
  349.         if statcds.fieldbyname('cc').asinteger = 0 then ErrMemo.lines.add('Stat insurlog Insert Fail !!!');
  350.  
  351.       end else
  352.       begin
  353.         LastErr := '';
  354.         AddLog('Edit insurlog ' + tc.fieldbyname('hn').asstring);
  355.         try
  356.           HOSxP_GetADODataset('update insurlog set subtype = "' + vartostr(tc['pcode']) + '" ,' +
  357.  
  358.             'inscl = "' + vartostr(tc['pttype']) + '" , ' +
  359.             'cid = "' + vartostr(tc['pttypeno']) + '",  ' +
  360.             'hospmain = "' + vartostr(tc['hospmain']) + '",  ' +
  361.             'hospsub = "' + vartostr(tc['hospsub']) + '"  ,' +
  362.             'name = "' + vartostr(getsqldata('select concat(fname," ",lname,",",pname) as name from patient where hn="'+tc.fieldbyname('hn').asstring+'"')) + '" ' +
  363.  
  364.             ' where hn = "' + vartostr(tc['hn']) + '" ');
  365.         except
  366.           on e: exception do
  367.           begin
  368.             LastErr := E.message;
  369.           end;
  370.         end;
  371.  
  372.         CheckErr;
  373.  
  374.       end;
  375.  
  376.  
  377.  
  378.  
  379.  
  380.  
  381.       end;
  382.  
  383.  
  384.      // if Pos('CommandText', LastErr) > 0 then
  385.      // begin
  386.  
  387.       QueueCDS.edit;
  388.       QueueCDS.fieldbyname('process_count').asinteger := QueueCDS.fieldbyname('process_count').asinteger + 1;
  389.       if Pos('CommandText', LastErr) > 0 then QueueCDS.fieldbyname('error').asinteger:= QueueCDS.fieldbyname('error').asinteger+1;
  390.  
  391.       QueueCDs.post;
  392.       QueueCDS.next;
  393.  
  394.       //end;
  395.     end;
  396.  
  397.  
  398.     if QueueCDs.ChangeCount > 0 then
  399.       HOSxP_updateDelta(Queuecds.Delta, 'select * from stat_queue where process_count = 0 and queue_type = "VISIT" order by queue_date_time');
  400.  
  401.  
  402.  
  403.   until ((QueueCDS.RecordCount = 0) or FAbort);
  404.  
  405.   ado_connection.connected := false;
  406.  
  407.   tc.free;
  408.   queuecds.free;
  409.   statcds.free;
  410.  // StatusMemo.lines.add('Patient Export Done.');
  411.  
  412.   if StatusMemo.lines.count > 1000 then Statusmemo.lines.clear;
  413.  
  414. end;
  415.  
  416. procedure StartButtonClick(Sender: TObject);
  417. var Tk: LongInt;
  418. begin
  419.   StartButton.enabled := false;
  420.   AbortButton.enabled:=true;
  421.   FAbort := false;
  422.   while not FAbort do
  423.   begin
  424.     StatusLabel.caption:=formatdatetime('dd/mm/ee hh:nn:ss',now);
  425.     StartExport;
  426.     tk := GetTickCount;
  427.  
  428.     repeat
  429.       application.processmessages;
  430.     until ((GetTickCount - Tk) > 3000);
  431.   end;
  432.   startButton.enabled := true;
  433.  
  434. end;
  435.  
  436. procedure AbortButtonClick(Sender: TObject);
  437. begin
  438.  
  439.   FAbort := true;
  440.   AbortButton.enabled:=false;
  441.  
  442. end;
  443.  
  444.  
  445. procedure Main;
  446.  
  447.  
  448. begin
  449.  
  450.   MainForm := TForm.Create(nil);
  451.   MainForm.top := 200;
  452.   MainForm.left := 200;
  453.   MainForm.Width := 750;
  454.   MainForm.Height := 400;
  455.  
  456.   StartButton := TButton.Create(MainForm);
  457.   StartButton.parent := mainForm;
  458.   startButton.left := 30;
  459.   StartButton.top := 20;
  460.   StartButton.Width := 100;
  461.   StartButton.caption := 'Start';
  462.   StartButton.OnClick := StartButtonClick;
  463.  
  464.   AbortButton := TButton.Create(MainForm);
  465.   AbortButton.parent := mainForm;
  466.   AbortButton.left := 140;
  467.   AbortButton.top := 20;
  468.   AbortButton.Width := 100;
  469.   AbortButton.caption := 'Abort';
  470.   AbortButton.OnClick := AbortButtonClick;
  471.   AbortButton.enabled:=false;
  472.  
  473.   StatusMemo := TMemo.create(MainForm);
  474.   StatusMemo.parent := MainForm;
  475.   StatusMemo.left := 30;
  476.   Statusmemo.top := 50;
  477.   Statusmemo.width := 300;
  478.   StatusMemo.height := 300;
  479.  
  480.   ErrMemo := TMemo.create(MainForm);
  481.   ErrMemo.parent := MainForm;
  482.   ErrMemo.left:=350;
  483.   ErrMemo.top:=50;
  484.   ErrMemo.width := 300;
  485.   ErrMemo.Height := 300;
  486.  
  487.   StatusLabel := TLabel.create(Mainform);
  488.   STatusLabel.parent:=Mainform;
  489.   StatusLabel.left:=280;
  490.   StatusLabel.top := 20;
  491.   StatusLabel.caption:='Status';
  492.  
  493.   MainForm.Caption := 'HI Exchange version 0.1';
  494.  
  495.   MainForm.Showmodal;
  496.   MainForm.free;
  497.  
  498.  
  499.  
  500.  
  501.  
  502.  
  503. end;
  504.  
  505.  
  506. end.
  507.  
  508.  
บันทึกการเข้า
หน้า: [1]   ขึ้นบน
« หน้าที่แล้ว ต่อไป »