===========================================================
■データ移行用プログラムaccess VBA (07/4/4-4/25,5/9)
(1)Microsoft Accessで以下のモジュールを実行し、Windows上で主な処理を行う
・モジュールconvknj7
アクセプトのKANJMS.DBFから患者情報(PTINF.TXT)、保険情報(PTHKNINF.TXT)、公費情報(PTKOHINF.TXT)、診療情報（最終受診日情報のみ）(SRYKARRK.TXT)を取り出す。
・モジュールconvbyo5
アクセプトのBBYM.DBFから病名情報(PTBYOMEI.TXT）を取り出す
(2)できた5つの*.TXTファイルをUSBメモリでWindowsからDebianへデータを移動し、以下の処理（shift-JISをEUCに、また改行をCR+LFからLFのみにする）を行う
・henkan1.sh
nkf -e ptinf.txt >ptinf.euc
nkf -e pthkninf.txt >pthkninf.euc
nkf -e ptkohinf.txt >ptkohinf.euc
nkf -e srykarrk.txt >srykarrk.euc
nkf -e ptbyomei.txt >ptbyomei.euc
tr -d '\r' <ptinf.euc >PTINF.CSV
tr -d '\r' <pthkninf.euc >PTHKNINF.CSV
tr -d '\r' <ptkohinf.euc >PTKOHINF.CSV
tr -d '\r' <srykarrk.euc >SRYKARRK.CSV
tr -d '\r' <ptbyomei.euc >PTBYOMEI.CSV

(3)あとはデータ移行手順書に従ってコンバートする
（できた*.CSVを/var/tmp/にコピーし、./orcvt_go_woody.sh ORCVTPTINFなどを実行）

==========================================================================
Option Compare Database

Public Sub convknj7()      'v7国保負担割合を補助区分に書き込む'v6有効期限のきれた保険・公費は移行しない

  Dim cn As ADODB.Connection  'ADOを使ってデータベースを操作
  Dim rs As ADODB.Recordset
  
  Set cn = CurrentProject.Connection  'カレントデータベースに接続
  
  Set rs = New ADODB.Recordset
  rs.Open "KANJMS", cn, adOpenKeyset, adLockOptimistic
  
  Dim Counter As Integer   'デバッグ用
  Counter = 1000
  
  
  Dim dfuriorca As String, dziporca As String, dadd_borca As String, dtelorca As String
  Dim dbirthorca As String, didateorca As String, ddateorca As String, dzenorca As String
  Dim dh_shuorca As String, dh_yukorca As String, d2_shuorca As String, d2_yukorca As String
  Dim dh_kigorca As String, dh_bangorca As String
  
  Dim didnoorca As String, dnameorca As String, dsexorca As String, dh_nomorca As String, drituorca As String, dzokuorca As String
  Dim dk_nomorca As String, dk_jukorca As String, dadd_aorca As String, d2_nomorca As String, d2_jukorca As String
  Dim hobetsuorca As String, hobetsuorcak1 As String, hobetsuorcak2 As String
  Dim kohhokenorca As String
  Dim hojyoorca  '保険情報補助区分用
  
  

  Dim l As Long, m As Long, n As Long, o As Long  'テキストファイルに出力するための準備
  
  l = FreeFile()
  Open "c:\temp\PTINF.TXT" For Output As #l
  m = FreeFile()
  Open "c:\temp\PTHKNINF.TXT" For Output As #m
  n = FreeFile()
  Open "c:\temp\PTKOHINF.TXT" For Output As #n
  o = FreeFile()
  Open "c:\temp\SRYKARRK.TXT" For Output As #o
  
  Dim knj As String, hkn As String, koh As String, koh2 As String, rir As String

 
   
  'レコードを参照-----------------------
  Do Until rs.EOF  'Counter = 0   'Until rs.EOFだとすべてのレコード counter=0
        
  If IsNull(rs!dfuri) = True Then
     dfuriorca = ""
  Else
     If IsNull(rs!dfuri) = True Then
        dfuriorca = ""
     Else
        dfuriorca = StrConv(rs!dfuri, 4)   '半角を全角に変換
        dfuriorca = Replace(dfuriorca, "　　", "　")  '余分な空白を取る
        dfuriorca = Replace(dfuriorca, "　　", "　")
     End If
  End If
  
  If IsNull(rs!dzip_a) = True Then
     dziporca = ""
  Else
     If IsNull(rs!dzip_b) = True Then
        dziporca = rs!dzip_a
     Else
        dziporca = rs!dzip_a & rs!dzip_b
     End If
  End If
  
  If IsNull(rs!dadd_b) = True Then  '未入力、空欄のために引数なしとなるエラーをIsNullで防ぐ必要あり
     dadd_borca = ""
  Else
     dadd_borca = StrConv(rs!dadd_b, 4)
  End If
  
  dbirthorca = Mid(rs!dbirth, 1, 4) & Mid(rs!dbirth, 6, 2) & Mid(rs!dbirth, 9, 2)
  didateorca = Mid(rs!didate, 1, 4) & Mid(rs!didate, 6, 2) & Mid(rs!didate, 9, 2)
  ddateorca = Mid(rs!ddate, 1, 4) & Mid(rs!ddate, 6, 2) & Mid(rs!ddate, 9, 2)
  
  If IsNull(rs!dzen) = True Then
       dzenorca = ""
  Else
    dzenorca = Mid(rs!dzen, 1, 4) & Mid(rs!dzen, 6, 2) & Mid(rs!dzen, 9, 2)
  End If
  
  If IsNull(rs!dh_kig) = True Then
     dh_kigorca = ""
     dh_bangorca = ""
  Else
    If InStr(rs!dh_kig, "・") = nul Then
      dh_kigorca = ""
      dh_bangorca = rs!dh_kig
    Else
      dh_kigorca = Left(rs!dh_kig, InStr(rs!dh_kig, "・") - 1)
      dh_bangorca = Mid(rs!dh_kig, InStr(rs!dh_kig, "・") + 1)
    End If
  End If
  
  didnoorca = rs!didno
  
  dnameorca = StrConv(rs!dname, 4)
  dnameorca = Replace(dnameorca, "　　", "　") '姓名間の余分な空白を取る
  dnameorca = Replace(dnameorca, "　　", "　")
    
  dsexorca = rs!dsex
  
  If IsNull(rs!dh_nom) = True Then
    dh_nomorca = ""
  Else
    dh_nomorca = rs!dh_nom
  End If
  
  
  If IsNull(rs!dhoken) = True Then     ''補助区分について一般的に国保は３割、一部で本人２割家族３割
                                       ''063032,063024,063016,133298,133033
     hojyoorca = ""
  Else
     If Left(rs!dhoken, 1) = "3" Or Left(rs!dhoken, 1) = "4" Then  '当院の該当は133033だけだったのでこれだけ処理
     
        If rs!dh_nom = "133033" And rs!dzoku = "1" Then
           hojyoorca = "2"
        Else
           hojyoorca = "3"
        End If
     Else
        hojyoorca = "0"
     End If
     
  End If
  
  drituorca = ""    'rs!dritu 意味が違いそうなので空欄にした
  dzokuorca = rs!dzoku
  
  If IsNull(rs!dk_nom) = True Then
     dk_nomorca = ""
  Else
    dk_nomorca = rs!dk_nom
  End If
  
  If IsNull(rs!dk_juk) = True Then
     dk_jukorca = ""
  Else
    dk_jukorca = rs!dk_juk
  End If
  
  If IsNull(rs!dadd_a) = True Then
     dadd_aorca = ""
  Else
    dadd_aorca = StrConv(rs!dadd_a, 4)
  End If
  
  If IsNull(rs!d2_nom) = True Then
     d2_nomorca = ""
  Else
    d2_nomorca = rs!d2_nom
  End If
 
  
  If IsNull(rs!d2_juk) = True Then
      d2_jukorca = ""
  Else
      d2_jukorca = rs!d2_juk
  End If
  
  If IsNull(rs!dtel) = True Then
     dtelorca = ""
  ElseIf Mid(rs!dtel, 4, 1) = "-" Then
     dtelorca = Mid(rs!dtel, 1, 3) & Mid(rs!dtel, 5, 3) & Mid(rs!dtel, 9, 4)
  ElseIf Mid(rs!dtel, 5, 1) = "-" Then
     dtelorca = Mid(rs!dtel, 1, 4) & Mid(rs!dtel, 6, 2) & Mid(rs!dtel, 9, 4)
  ElseIf Mid(rs!dtel, 3, 1) = "-" Then
     dtelorca = Mid(rs!dtel, 1, 2) & Mid(rs!dtel, 4, 4) & Mid(rs!dtel, 9, 4)
  Else
     dtelorca = rs!dtel
  End If
  
     
  dh_shuorca = hidukeorca(rs!dh_shu)
  dh_yukorca = hidukeorca(rs!dh_yuk)
  dk_shuorca = hidukeorca(rs!dk_shu)
  dk_yukorca = hidukeorca(rs!dk_yuk)
  d2_shuorca = hidukeorca(rs!d2_shu)
  d2_yukorca = hidukeorca(rs!d2_yuk)
  
  
  If IsNull(rs!dh_nom) = True Then
     hobetsuorca = "99"
  Else
     hobetsuorca = hobetsu(rs!dh_nom, rs!dhoken, rs!dkansho)
  End If

  If IsNull(rs!dk_nom) = True Then
     hobetsuorcak1 = ""
     hobetsuorcak2 = ""
  Else
     If Left(rs!dk_nom, 2) = "41" Or Left(rs!dk_nom, 2) = "90" Or Left(rs!dk_nom, 2) = "91" Or Left(rs!dk_nom, 2) = "92" Then
        hobetsuorcak1 = ""
        hobetsuorcak2 = Left(rs!dk_nom, 2)
     Else
        hobetsuorcak1 = Left(rs!dk_nom, 2)
        hobetsuorcak2 = ""
     End If
  End If
  
  ''公費保険番号
  
  If IsNull(rs!dk_nom) = True Then
     kohhokenorca = ""
    
  Else
     If IsNull(rs!dadd_a) = True Then
       kohhokenorca = ""
     Else
       kohhokenorca = kohhoken(rs!dhoken, rs!dadd_a, rs!dritu)
     End If
  End If
  
 
  
  'MsgBox rs!DIDNO & rs!DNAME 'テスト用
   
  ' MsgBox dfuriorca & dtelorca & dadd_borca & d2_jukorca
   
     
  '患者情報出力前処理
    knj = didnoorca & "," & dfuriorca & "," & dnameorca & ",," & dsexorca & "," & dbirthorca & ",," & dziporca & "," & dadd_aorca & "," & dadd_borca & "," & dtelorca & ",,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,0," & didateorca & "," & ddateorca
         
     
  '患者保険情報出力前処理
    hkn = didnoorca & ",1," & hobetsuorca & ",," & dh_nomorca & "," & dzokuorca & "," & hojyoorca & ",," & dh_kigorca & "," & dh_bangorca & ",," & drituorca & ",," & dh_shuorca & "," & dh_yukorca & ",,,"
   
     
  '患者公費情報出力前処理
   koh = didnoorca & ",1," & hobetsuorcak1 & "," & hobetsuorcak2 & ",," & kohhokenorca & "," & dk_nomorca & "," & dk_jukorca & ",," & dk_shuorca & "," & dk_yukorca & ",,,"
   
   koh2 = didnoorca & ",2," & hobetsuorcak1 & "," & hobetsuorcak2 & ",," & kohhokenorca & "," & d2_nomorca & "," & d2_jukorca & ",," & d2_shuorca & "," & d2_yukorca & ",,,"
   
       
  '患者診療科履歴情報出力前処理'09は小児科
    rir = didnoorca & ",09," & dzenorca & ",,,,,,,"
    
      
    ''''（かなり前に）有効期限の切れた保険・公費は移行しない
  
  '''If dh_yukorca > "20060130" Then
    '患者保険情報出力
     Print #m, addkugiri(hkn)
  '''End If
  
  
  ''If dk_yukorca > "20070430" Then
    '患者公費情報出力
     If d2_nomorca <> "" Then
        Print #n, addkugiri(koh)
        Print #n, addkugiri(koh2)
     Else
        If dk_nomorca <> "" Then
           Print #n, addkugiri(koh)
        End If
     End If
  ''End If
         
         
         
         
      
  '患者情報出力
   Print #l, addkugiri(knj)
   
    
  '患者診療科履歴情報出力
   Print #o, addkugiri(rir)
      
     rs.MoveNext
     ''Counter = Counter - 1
     
     Loop
  
    
  Close #l
  Close #m
  Close #n
  Close #o
  
  'オブジェクトを閉じる
  rs.Close
  Set rs = Nothing
  
  cn.Close
  Set cn = Nothing

End Sub

  
  
  '''元号を西暦にし、０を加えたり、仕切りをとったりする関数を定義--------------------
  Function hidukeorca(hidukeacc As String)
   
   Dim nen As String, tuki As String, hi As String, nengen As String, tukigen As String, higen As String, nenacc As String, tukiacc As String, hiacc As String
   Dim kugiri1 As Integer, kugiri2 As Integer
    
     nengen = Mid(hidukeacc, 1, 2)
     tukigen = Mid(hidukeacc, 4, 2)
     higen = Mid(hidukeacc, 7, 2)
    
    If Val(nengen) < 20 Then
       nen = LTrim(Str(Val(nengen) + 1988))
      Else
       nen = LTrim(Str(Val(nengen) + 1925))
    End If
    
    If Val(tukigen) < 10 Then
       tuki = "0" & LTrim(tukigen)
    Else
       tuki = tukigen
    End If
    
    If Val(higen) < 10 Then
       hi = "0" & LTrim(higen)
    Else
       hi = higen
    End If
    
    If hidukeacc = "  /  /" Or hidukeacc = " 0/ 0/ 0" Then
       hidukeorea = ""
    Else
        hidukeorca = nen & tuki & hi
    End If
   
  End Function
  
  '''カンマの区切りに""を加える関数を定義-----------------------
  Function addkugiri(onlycomma As String)
   Dim mae As String, ato As String
   mae = Chr(44)
   ato = Chr(34) & Chr(44) & Chr(34)
   
   addkugiri = Chr(34) & Replace(onlycomma, mae, ato) & Chr(34)
     
   End Function
   
   
  



  '''法別番号をDH_NOMとDHOKENとDKANSHOから判定する関数を定義
  Function hobetsu(h_nom As String, hoken As String, kansho As String)
  
  If Left(hoken, 1) = "3" Then
     hobetsu = "60"
  Else
   
     If Len(h_nom) = 8 Then
        If Left(h_nom, 2) = "36" Then  ''''36130011は以前のNTT
           hobetsu = "06"
        Else
           If Left(h_nom, 2) = "37" Then  '''37270402は以前のJR
              hobetsu = "06"
           Else
               hobetsu = Left(h_nom, 2)
           End If
        End If
       
     
     Else
       
         If Left(hoken, 1) = "3" Then
              hobetsu = "60"
         Else
              If kansho = "1" Then
                 hobetsu = "01"
              Else
                   If kansho = "2" Then
                      hobetsu = "02"
                   Else
                        If kansyo = "3" Then
                           hobetsu = "03"
                        Else
                             If kansho = "4" Then
                                hobetsu = "04"
                             Else
                                  If kansho = "5" Then
                                     hobetsu = "05"
                                  Else
                                      If kansyo = "6" Then
                                         hobetsu = "06"
                                      Else
                                           If kansyo = "7" Then
                                              hobetsu = "07"
                                           Else
                                               If kansyo = "8" Then   '''''
                                                  hobetsu = "??"
                                               Else
                                               
                                                       hobetsu = "99"
                                               End If
                                               
                                           End If
                                       End If
                                   End If
                              End If
                          End If
                  End If
               End If
           End If
       End If
   End If
   
     
  End Function
  
  
'''''公費の保険番号を決める関数を定義

Function kohhoken(hoken As String, jyusho As String, ritu As String)
   ''hokenの下一桁が0:乳児, 2:老人, 3:身障, 4:ひとり親
   ''
   
   If Right(hoken, 1) = "0" Then
      If InStr(jyusho, "広島市") <> 0 Then
         kohhoken = "390"
      Else
         If InStr(jyusho, "福山市") <> 0 Then
           kohhoken = "190"
         Else
             If InStr(jyusho, "庄原市") <> 0 Then
                kohhoken = "490"
             Else
                kohhoken = "290"
             End If
         End If
      End If
   End If
   
   If Right(hoken, 1) = "3" Then
      If InStr(jyusho, "広島市") <> 0 Then
         kohhoken = "391"
      Else
         If InStr(jyusho, "福山市") <> 0 Then
           kohhoken = "291"
         Else
           kohhoken = "191"
             
         End If
      End If
   End If
   
   
   If Right(hoken, 1) = "4" Then
      If InStr(jyusho, "広島市") <> 0 Then
         kohhoken = "392"
      Else
         If InStr(jyusho, "福山市") <> 0 Then
           kohhoken = "292"
         Else
           kohhoken = "192"
         End If
      End If
   End If
   
   If Right(jyusho, 1) = "2" Then
      If ritu = 1 Then
         kohhoken = "141"
      Else
         If ritu = 2 Then
           kohhoken = "241"
         End If
      End If
   End If
   
   
   
   
   
   
End Function
  
Function hobetsuk1(k_nom As String, hoken As String)

End Function
  




 ==============================================
Option Compare Database

Public Sub convbyo5() 'ダブルクオーテーションで囲む処理を追加

  Dim cn As ADODB.Connection  'ADOを使ってデータベースを操作
  Dim rs As ADODB.Recordset
  
  Set cn = CurrentProject.Connection  'カレントデータベースに接続
  
  Set rs = New ADODB.Recordset
  rs.Open "BBYM", cn, adOpenKeyset, adLockOptimistic
  
  Dim Counter As Integer   'デバッグ用
  Counter = 1000
  
  
  Dim didnobyorca As String, dbymeiorca As String, dmkuorca As String, dskuorca As String
  Dim dkaisborca As String, dshuborca As String, dtku As String, dmanb As String

  Dim l As Long  'テキストファイルに出力するための準備
  
  l = FreeFile()
  Open "c:\temp\PTBYOMEI.TXT" For Output As #l
  
  Dim byo As String
  
   
  'レコードを参照-----------------------
  Do Until rs.EOF 'Counter = 0   'Until rs.EOFだとすべてのレコード counter=0
        
          
  didnobyorca = LTrim(Right(rs!didno, 5))
  
  
  dbymeiorca = StrConv(rs!dbymei, 4)
  
  
  If IsNull(rs!dkaisb) = True Then  '未入力、空欄のために引数なしとなるエラーをIsNullで防ぐ必要あり
     dkaisborca = ""
  Else
     dkaisborca = Mid(rs!dkaisb, 1, 4) & Mid(rs!dkaisb, 6, 2) & Mid(rs!dkaisb, 9, 2)
  End If
  
  If IsNull(rs!dshub) = True Then
       dshuborca = ""
  Else
    dshuborca = Mid(rs!dshub, 1, 4) & Mid(rs!dshub, 6, 2) & Mid(rs!dshub, 9, 2)
  End If
  
  
  If IsNull(rs!dsku) = True Then
     dskuorca = ""
  Else
     dskuorca = rs!dsku
  End If
  
    
  
  If IsNull(rs!dtku) = True Then
     dtkuorca = ""
  Else
     If rs!dtku = " 0" Then
        dtkuorca = ""
     Else
        dtkuorca = LTrim(rs!dtku)
     End If
  End If
  
  
  
  
  
  'MsgBox rs!DIDNO & rs!DNAME 'テスト用
   
  ' MsgBox dfuriorca & dtelorca & dadd_borca & d2_jukorca
   
  '患者病名情報出力前処理'２項目目09は小児科
   byo = didnobyorca & ",09," & dkaisborca & "," & dbymeiorca & ",,,,,,,,,," & dskuorca & "," & dmkuorca & ",,,,,,," & dtkuorca & ",," & dshuborca & ",,,,,,,,,"
          
   '患者病名情報出力
   Print #l, addkugiri(byo)


   rs.MoveNext
   ''Counter = Counter - 1
   Loop
 
    
  Close #l

  
  'オブジェクトを閉じる
  rs.Close
  Set rs = Nothing
  
  cn.Close
  Set cn = Nothing

End Sub

 '''カンマの区切りに""を加える関数を定義-----------------------
  Function addkugiri(onlycomma As String)

   Dim mae, ato As String
   mae = Chr(44)
   ato = Chr(34) & Chr(44) & Chr(34)
  
  
    addkugiri = Chr(34) & Replace(onlycomma, mae, ato) & Chr(34)
     
   End Function