Open Office macro 程式徵求 (小弟會付費)

[Pofeng Lee ( 李柏鋒 ) <pofeng gmail com>]

Hi 大家好,

小弟有個小程式需要幫忙 ( Open Office macro )
小弟願意付費
不知道大家可不可以介紹適當的人選, 並且報個價, 非常感謝

有找到可能相關的範例檔, 請見附檔 code.txt

資料
c:\01\10002d.dbf 藥品簡碼對照表
c:\01\10002s.dbf 疾病簡碼 / ICD9 對照表
c:\s\XP10003.DBF 當月看病紀錄
c:\s\PATDB.DBF 病人基本資料
  (  PATDB.DBF 沒有病例號欄位, 第一筆 病歷號碼號碼就是 1, 第 323 筆, 病歷號碼就是 323 )

需求:
找出某月就診病人中 PATDB.DBF 中有 BAE 記號
且
最近 90天(會變動,不要寫死) 都 沒有以 BA BA2 BA3 BAE 的診斷就診過
的病患
列印出 病歷號


範例:
輸入 100-04 ( 100 年 四月 )

掃描所有 100-04 所有就診病人的病歷號碼

範例 (假設)

病人 1119
         於 100-01-02 就診，病名簡碼為 BA2
         於 100-04-12 就診，不論病名
         符合 ( > 90 天 )  輸出 病歷號碼 1119

病人 3315
         99-12-26  病名簡碼 BA3
        100-03-01 就診，不論病名
        不符合 (< 90 天 ) 不輸出資料

-- 
Pofeng "informer" Lee, 李柏鋒, pofeng at gmail dot com

    REM  *****  BASIC  *****

    Sub csvtoods   REM put all csv files into a database first

    Const cSource = "Allpressurefiles"   REM replace with your actual data source name (press F4 to check) *case sensitive

    oDatabaseContext = createUnoService("com.sun.star.sdb.DatabaseContext")
    oDataSource = oDatabaseContext.getByName(cSource) REM defines the name of the database
    oConnection = oDataSource.GetConnection("","") REM connects to the database

    oTables = oConnection.getTables() REM connects to the tables in the database
    oElementNames() = oTables.getElementNames() REM gets a sequence of all names in the Database


    for i = 0 to uBound(oElementNames()) REM for 1st iteration to last(count of number of tables in database) iteration
       doc = StarDesktop.loadComponentFromURL("private:factory/scalc","_default",0,Array()) REM loads a new calc document

       
       shx=doc.getSheets()   REM returns the collection of sheets in the document.
       dbx=doc.DatabaseRanges REM provides access to the settings and options of a database range.
       sn = oElementNames(i) REM name of each table
       sdb = "Import_"& i REM Import number
       
       shx.getByIndex(0).setName(sn) REM gets the first sheet and gives it the same name as the table
       addr = createUnoStruct("com.sun.star.table.CellRangeAddress") REM contains a cell range address within a spreadsheet document
       addr.Sheet = 0 REM Sheet number 0
       if not dbx.hasByName(sdb) then dbx.addNewByName(sdb, addr) REM if dbx doesn't have sdb as a name then a new one is added using sdb and addr
       dbr = dbx.getByName(sdb) REM the database table as named by sdb
       a() = getNewImportDescriptor(cSource, sn, com.sun.star.sheet.DataImportMode.TABLE) REM import details (database name, table name, dataimportmode)
       rg = dbr.getReferredCells() REM returns the cell range object that is represented by the database table
       rg.doImport(a()) REM import using the import details provided by 'a' and the range set by rg
       
       saveasURL = "file:///C:/Users/DMRC/Documents/AndyR/OpenOffice/Runonmultiplefiles/Converted Docs/" & sn & ".ods" REM URL of new .ods file with filename same as table
       Dim Dummy()   REM Empty Sequence
       doc.storeAsURL(saveasURL, Dummy())   REM Saves as
       doc.Close(True) REM closes the document
       REM unlink the database range if you like:
       ' dbx.removeByName(sdb)
    next

    oConnection.close()
    End Sub

    Function getNewImportDescriptor(src,stbl,ntype)
    Dim a(2) as new com.sun.star.beans.PropertyValue
       a(0).Name = "SourceType"
       a(0).Value = ntype
       a(1).Name ="DatabaseName"
       a(1).Value = src
       a(2).Name ="SourceObject"
       a(2).Value= stbl
    getNewImportDescriptor = a()
    End Function