********************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. ORCHC501.
*****************************************************************
|
PROGRAM-ID. AKHC501.
|
MOVE "HC501.red" TO MKPRT-DIA
から
MOVE "AKHC501.red" TO MKPRT-DIA
に
|
CALL "ORCSMKPRT1" USING
から
CALL "ORCSMKPRTSITE1" USING
に
|
********************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. ORCHC502.
*****************************************************************
|
PROGRAM-ID. AKHC502.
|
MOVE "HC502.red" TO MKPRT-DIA
から
MOVE "AKHC502.red" TO MKPRT-DIA
に
|
CALL "ORCSMKPRT1" USING
から
CALL "ORCSMKPRTSITE1" USING
に
|
52行 "HC502.INC" → "AKHC502.INC" 208行 PIC X(106) → PIC X(96) 210行 PIC X(70) → PIC X(60) 215行 PIC X(100) → PIC X(90) 827行 IF WRK-TNS-NAME(71:) → IF WRK-TNS-NAME(61:) 831行 AND ( WRK-TNS-NAME(101:) → AND ( WRK-TNS-NAME(91:) 835行 IF WRK-TNS-NAME(101:) → IF WRK-TNS-NAME(91:) 837行 MOVE WRK-TNS-NAME(101:) → MOVE WRK-TNS-NAME(91:) |
辞書の NAIYO のバイト数を90に変更 |
20行 PIC X(106) → PIC X(96) |
MOVE LNK-ORDERPRT-DAY (1 IDX2) TO WRK-KAISU
↓
MOVE 1 TO WRK-KAISU
|
ADD 1 TO IDX-LINE ←---で最後に空行を入れている
PERFORM 2202-DAY-HENSYU-SEC ←-------次行に自作の日数表示の処理を入れる
|
IF (IDX-S + IDX-LINE) > WRK-IDX-MAX
↓
IF (IDX-S + IDX-LINE) >= WRK-IDX-MAX
|
*****************************************************************
* 日・回数編集処理
*****************************************************************
2202-DAY-HENSYU-SEC SECTION.
*
MOVE ZERO TO WRK-KAISU
MOVE ORCHC502-SRYYMD TO WRK-SRYYMD
PERFORM VARYING IDX2 FROM 1 BY 1
UNTIL IDX2 > 31
IF LNK-ORDERPRT-DAY (1 IDX2) > ZERO
MOVE IDX2 TO WRK-DAY
MOVE LNK-ORDERPRT-DAY (1 IDX2) TO WRK-KAISU
END-IF
END-PERFORM
*
MOVE SPACE TO WRK-NAIYOU
(IDX-PAGE IDX-LINE)
MOVE WRK-DAY TO WRK-KAISU-Z9
MOVE WRK-KAISU-X TO WRK-MOJI
PERFORM 500-HENKAN-SEC
MOVE WRK-ZENKAKU-G(1:6) TO WRK-NAIYOU
(IDX-PAGE IDX-LINE)(39:)
MOVE "日から"
TO WRK-NAIYOU
(IDX-PAGE IDX-LINE)(45:)
MOVE WRK-KAISU TO WRK-KAISU-Z9
MOVE WRK-KAISU-X TO WRK-MOJI
PERFORM 500-HENKAN-SEC
MOVE WRK-ZENKAKU-G(1:6) TO WRK-NAIYOU
(IDX-PAGE IDX-LINE)(55:)
MOVE "日分"
TO WRK-NAIYOU
(IDX-PAGE IDX-LINE)(61:)
.
2202-DAY-HENSYU-EXT.
EXIT.
|
********************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. ORCHCN62.
*****************************************************************
のPROGRAM-IDを変更
********************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. AKHCN62.
*****************************************************************
|
MOVE "HCM62.red" TO MKPRT-DIA
を
MOVE "AKHCM62.red" TO MKPRT-DIA
に
|
* 帳票領域
COPY "HCM62.INC".
を
COPY "AKHCN62.INC".
に
|
*****************************************************************
* 帳票出力処理
*****************************************************************
CALL "ORCSMKPRT1" USING
を
CALL "ORCSMKPRTSITE1" USING
（カスタマイズ用再印刷プログラム）に変更
|
*****************************************************************
* 帳票文字編集処理
*****************************************************************
COMPUTE IDX-KET1 = 54 - WRK-M-KETA
↓
COMPUTE IDX-KET1 = 44 - WRK-M-KETA
|
*****************************************************************
* 帳票文字編集処理
*****************************************************************
MOVE 50 TO MAX-GYO
↓
MOVE 40 TO MAX-GYO
|
*****************************************************************
* 頁チェック 処理
*****************************************************************
250-PAGE-CHK-SEC SECTION.
*
EVALUATE TRUE
* ページ件数を超えていたら印刷
WHEN CNT-LINE = MAX-LINE
PERFORM 400-PRT-WRITE-SEC
INITIALIZE HCM62
MOVE ZERO TO CNT-LINE
PERFORM 410-HEAD-SET-SEC
* WHEN CNT-LINE = MAX-LINE2←――――――――――コメントアウト
* 半ページ件数を超えていたら改ページ
* PERFORM 410-HEAD-SET-SEC←――――――――――――――――コメントアウト
END-EVALUATE
*
COMPUTE CNT-LINE = CNT-LINE + 1
*
.
250-PAGE-CHK-EXT.
EXIT.
*
|
01 MAX-LINE PIC 9(03) VALUE 68.
↓
01 MAX-LINE PIC 9(03) VALUE 58.
|
'sex 1:男2:女 cls=01/02
Private Function OrcaApi12(ByVal cls As String, ByVal ID As String, ByVal Name As String, ByVal KanaName As String, _
ByVal BirthDay As String, ByVal sex As String, ByRef restr As String) As Boolean
Dim HOST As String = TextBox3.Text
Dim PORT As String = TextBox4.Text
Dim USER As String = TextBox5.Text
Dim PASSWD As String = TextBox6.Text
Dim CONTENT_TYPE As String = "application/xml"
Dim URL As String = "http://" & HOST & ":" & PORT & "/orca12/patientmod?class=" + cls
Dim rt As Boolean
Dim CR As String = vbCr & vbLf
Dim record_in As String = CR
record_in = record_in & " <record>" & CR
record_in = record_in & " <record name=""patientmodreq"">" & CR
record_in = record_in & " <string name=""Patient_ID"">" & ID & "</string>" & CR
record_in = record_in & " <string name=""WholeName"">" & Name & "</string>" & CR
record_in = record_in & " <string name=""WholeName_inKana"">" & KanaName & "</string>" & CR
record_in = record_in & " <string name=""BirthDate"">" & BirthDay & "</string>" & CR
record_in = record_in & " <string name=""Sex"">" & sex & "</string>" & CR
record_in = record_in & " </record>" & CR
record_in = record_in & " </record>" & CR
record_in = record_in & " "
Dim BODY As String = "<data>" & record_in & "</data>"
Dim record_in_byte As Byte() = System.Text.Encoding.UTF8.GetBytes(BODY)
Dim req As HttpWebRequest = DirectCast(HttpWebRequest.Create(URL), HttpWebRequest)
req.Method = "POST"
req.ContentType = CONTENT_TYPE
req.ContentLength = record_in_byte.Length
req.Credentials = New NetworkCredential(USER, PASSWD)
Console.WriteLine(BODY)
Dim res As HttpWebResponse = Nothing
restr = ""
Try
Dim reqstream As Stream = req.GetRequestStream()
reqstream.Write(record_in_byte, 0, record_in_byte.Length)
reqstream.Close()
System.Threading.Thread.Sleep(Wait)
'連続で登録すると
'[基礎になる接続が閉じられました: 維持される必要があった接続が、サーバーによって切断されました]
'というエラーが出て登録できない （1個目は登録できるが2つ目以降でエラーになる）
'解決策不明だが ここにウエイトを入れると良さそう
'一応100msに設定 短くすると飛び飛びで登録されたりする
res = DirectCast(req.GetResponse(), HttpWebResponse)
restr = restr + res.ResponseUri.ToString + vbCrLf + res.StatusDescription
rt = True
Catch exc As WebException
If exc.Status = WebExceptionStatus.ProtocolError Then
Dim err As HttpWebResponse = DirectCast(exc.Response, HttpWebResponse)
Dim errcode As Integer = CInt(err.StatusCode)
Console.WriteLine(err.ResponseUri)
Console.WriteLine("{0}:{1}", errcode, err.StatusDescription)
restr = restr + err.ResponseUri.ToString + vbCrLf + errcode.ToString + vbCrLf + err.StatusDescription
err.Close()
rt = False
Else
Console.WriteLine(exc.Message)
restr = restr + exc.Message
rt = False
End If
End Try
If res IsNot Nothing Then
Try
Dim str As Stream = res.GetResponseStream()
Dim strread As New StreamReader(str)
restr = restr + strread.ReadToEnd()
Dim FOO As String = strread.ReadToEnd()
strread.Close()
str.Close()
res.Close()
Catch ex As Exception
rt = False
End Try
End If
Return rt
End Function
|