|
Tom: I have attached
two text files to this email since our IS department strips BWS files. Here is
the deal with these. I am always
hesitant to “share” on talk because I find that most of the people
out there know more then I do already! However here is what I can tell you
about the above. I parse the data from the 835 into Access FIRST then I run
query’s to extract the fields I want and use my existing batch posting
routines, which work nicely. The
managers here use the data from the Access data base for denial management and
f/u activity, creating a very useful tool. Why get all the data and not use it?
I have found
with each additional payer I bring into this routine that they all have their
own unique interpretation of the 835, which makes for fun each time, but is of
course par for the course with all of the “conditional” fields of
the 835 allowing them to do this! So the first thing I do with any 835 is open
a new project and open it through data station as well as print out about 5
pages of raw data and compare where things fall and how they have “Interpreted”
items, this allows me to (with MUCH HELP from BWS staff) modify my scripts to
gather all the data I want. We are
a children’s hospital so our Medicare population is limited to ESRD so
small compared to everyone else.
However the basics should still apply! I imagine all this will do is give you a
starting place but hopefully prevent you from re-inventing the wheel. For those of you
who may look at this and have some “streamline” ideas I would be
interested in your input. Thank you Mary Mary Thompson Special Project Manager Children's Mercy Hospital (816) 234-3940 Electronic mail from Mary
Thompson, The Children's Mercy
Hospital. This communication is intended only for the use of the
addressee. It may contain
information which is privileged or confidential under applicable law. If you are not the intended recipient or
the agent of the recipient, you are hereby notified that any dissemination,
copy or disclosure of this communication is strictly prohibited. If you have received this communication
in error, please immediately notify The Children's Mercy Hospital at
816-234-3940 or via return Internet electronic mail at [EMAIL PROTECTED]
and expunge this communication without making any copies. Thank you for your cooperation. -----Original Message----- Hi, Does anyone have an example to parse a Medicare
Part A 835 remittance file and post the payments into Meditech. Thanks Tom Dobbs |
Public CurrentDB As Database Public rs As DAO.Recordset Public rsClaimTable As DAO.Recordset Public rsSvsTable As DAO.Recordset Const DataDir As String = "C:\Bss65\" Const InputFile As String = "040727mo.txt"
Dim numrecs As Long
' these are the records for ClaimTable
Dim StrField As String 'fField
Dim StrActNo As String 'fAccount
Dim StrProvNo As String 'fProviderNo
Dim StrProvNo1 As String 'fProviderNo1
Dim StrPayer As String 'fPayerName
Dim StrFileDate As String 'fFileDate
Dim StrCkDate As String 'fCheckDate
Dim StrCkNo As String 'fCheckNo
Dim StrCkAmt As String 'fCheckAmt
Dim StrFirstName As String 'fPtFName
Dim StrLastName As String 'fPtLName
Dim StrMidInt As String 'fPtMName
Dim StrDCN As String 'fPtHIC
Dim StrClmBill As String 'fAcctBilled
Dim StrClmPaid As String 'fAcctPaid
Dim StrPtResp As String 'fPtResp
Dim StrICN As String 'fActICN
Dim StrClmStatus As String 'fAcctStatus
Dim StrN1Fld As String
Dim StrOARACode As String 'fOARACode
Dim StrCORACode As String 'fCORACode
Dim StrCRRACode As String 'fCRRACode
Dim StrPRRACode As String 'fPRRACode
Dim StrOAAmt As String 'fOAAmt
Dim StrCOAmt As String 'fCOAmt
Dim StrCRAmt As String 'fCRAmt
Dim StrPRAmt As String 'fPRAmt
Dim StrFSvsDA As String 'fFromDOS
Dim StrTSvsDA As String 'fThruDOS
Dim StrLField As String 'fLField
Dim StrProc As String 'fSvcCode
Dim StrChgAmt As String 'fLineCharge
Dim StrChgAdj As String 'fLineAdj
Dim StrChgPd As String 'fLinePaid
Dim StrUnits As String 'fLineUnits
Dim StrMSGCode As String 'fMSGCode
Dim Str2MSGCode As String 'f2MSGCode
Dim Str3MSGCode As String 'f3MSGCode
Dim Str4MSGCode As String 'f4MSGCode
Dim StrAllowed As String 'fAllowed
Dim StrAllowCode As String 'fAllowCode
Dim StrCAllow As String 'fCAllow
Dim StrCAllowCode As String 'CAllowCode
Dim StrLAllowed As String 'fLAllowed
Dim StrLAllowCode As String 'fLAllowCode
Dim StrProviderAdjNo As String 'fProvAdjNo
Dim StrProvYEDate As String 'fProvYEDate
Dim StrProvCntrlNo As String 'fProvCntrlNo
Dim StrProvAdjAmt As String 'fProvAdjAmt
Dim Str1PayerName As String 'f1PayerName
Dim Str2PayerName As String 'f2PayerName
Dim LQCounter As Integer
'these are the detail records for SvsTable
'Pull from above act #, Names, ICN,
Dim mydate As String
Dim mymonth As String
Dim myyear As String
Dim myday As String
Dim blnFirstLX As Boolean
Dim blnFirstSVS As Boolean
Dim BlnCLPSwitch As Boolean
Dim SVCSegment As Boolean
Sub ParseToAccess()
Set D = New DataStation
M$ = DataDir & InputFile
blnFirstLX = True
D.Open_ "C:\Bss65\040727mo.txt", ftX12
Dim G As Integer, z As Long
Set CurrentDB = DAO.OpenDatabase("W:\IS&PFS\835 Access\RemittanceDB.mdb")
Set rsClaimTable = CurrentDB.OpenRecordset("MCDMClaimTable", dbOpenDynaset)
Set rsSvsTable = CurrentDB.OpenRecordset("MCDMLineItemTable", dbOpenDynaset)
Dim blnNM1Switch, blnN1Switch As Boolean
blnN1Switch = True
blnFirstCLP = True
BlnFirstCAS = True
BlnFirstSvc = True
SVCSegment = False
Do
Select Case D("Segment_")
'**********Header**************
Case "ISA":
StrProvNo = D("ISA.9") 'fProviderNo
Case "GS":
StrFileDate = D("GS.5") 'fFileDate
StrCkNo = D("GS.6") 'fCheckNo
Case "BPR":
StrCkAmt = D("BPR.3") 'fCheckAmt
StrCkDate = D("BPR.17") 'fCheckDate
Case "N1":
StrN1Fld = D("N1.2")
If blnN1Switch = True Then
blnN1Switch = False
If StrN1Fld = "PR" Then
StrPayer = D("N1.3") 'fPayerName
Else
End If
End If
Case "CLP":
WriteLineDetail (False)
If blnFirstCLP = True Then
blnFirstCLP = False
Else
blnFirstCLP = True
End If
If D("CLP.1") = "CLP" Then
StrField = D("CLP.1") ' fField
End If
StrActNo = D("CLP.2") 'fAccount
StrClmStatus = D("CLP.3") 'fAcctStatus
StrClmBill = D("CLP.4") 'fAcctBilled
StrClmPaid = D("CLP.5") 'fAcctPaid
StrPtResp = D("CLP.6") 'fPtResp
StrICN = D("CLP.8") 'fActICN
BlnFirstNM = True
Case "NM1":
If D("NM1.2") = "QC" Then
StrFirstName = D("NM1.5") 'fPtFName
StrLastName = D("NM1.4") 'fPtLName
StrMidInt = D("NM1.6") 'fPtMName
StrDCN = D("NM1.10") 'fPtHIC
Else
End If
Case "CAS":
' If BlnFirstCAS = True Then
If D("CAS.2") = "OA" Then StrOARACode = D("CAS.3") 'fOARACode
If D("CAS.2") = "OA" Then StrOAAmt = D("CAS.4") 'fOAAmt
If D("CAS.2") = "CO" Then StrCORACode = D("CAS.3") 'fCORACode
If D("CAS.2") = "CO" Then StrCOAmt = D("CAS.4") 'fOAAmt
If D("CAS.2") = "PR" Then StrPRRACode = D("CAS.3") 'fPRRACode
If D("CAS.2") = "PR" Then StrPRAmt = D("CAS.4") 'fOAAmt
If D("CAS.2") = "CR" Then StrCRRACode = D("CAS.3") 'fCRRACode
If D("CAS.2") = "CR" Then StrCRAmt = D("CAS.4") 'fOAAmt
StrCAllow = D("CAS.7") 'fCAllow
StrCAllowCode = D("CAS.6") 'fCAllowCode
' End If
Case "DTM":
If D("DTM.2") = 232 Then
StrFSvsDA = D("DTM.3") 'fCFromDate
End If
If D("DTM.2") = 233 Then
StrTSvsDA = D("DTM.3") 'fCThruDate
wa_ClaimTable
BlnFirstCAS = False
ClaimClear
End If
If D("DTM.2") = 150 Then
StrFSvsDA = D("DTM.3") 'fFromDOS
End If
If D("DTM.2") = 151 Then
StrTSvsDA = D("DTM.3") 'fThruDOS
End If
If D("DTM.2") = 472 Then
StrFSvsDA = D("DTM.3") 'fFromDOS
StrTSvsDA = D("DTM.3") 'fThruDOS
End If
Case "SVC":
LQCounter = 0
WriteLineDetail (True)
StrLField = D("SVC.1") 'fLField
StrProc = D("SVC.2") 'fSvcCode
StrChgAmt = D("SVC.3") 'fLineCharge
StrChgPd = D("SVC.4") 'fLinePaid
StrUnits = D("SVC.6") 'fLineUnits
BlnFirstSvc = False
Case "CAS":
If BlnFirstCAS = False Then
If D("CAS.2") = "OA" Then StrOARACode = D("CAS.3") 'fOARACode
If D("CAS.2") = "OA" Then StrOAAmt = D("CAS.4") 'fOAAmt
If D("CAS.2") = "CO" Then StrCORACode = D("CAS.3") 'fCORACode
If D("CAS.2") = "CO" Then StrCOAmt = D("CAS.4") 'fOAAmt
If D("CAS.2") = "PR" Then StrPRRACode = D("CAS.3") 'fPRRACode
If D("CAS.2") = "PR" Then StrPRAmt = D("CAS.4") 'fOAAmt
If D("CAS.2") = "CR" Then StrCRRACode = D("CAS.3") 'fCRRACode
If D("CAS.2") = "CR" Then StrCRAmt = D("CAS.4") 'fOAAmt
End If
Case "LQ":
LQCounter = LQCounter + 1
If LQCounter = 1 Then
StrMSGCode = D("LQ.3") 'fMSGCode
End If
If LQCounter = 2 Then
Str2MSGCode = D("LQ.3") 'f2MSGCode
End If
If LQCounter = 3 Then
Str3MSGCode = D("LQ.3") 'f3MSGCode
End If
If LQCounter = 4 Then
Str4MSGCode = D("LQ.3") 'f4MSGCode
End If
Case "AMT":
StrAllowed = D("AMT.3") 'fAllowed
StrAllowCode = D("AMT.2") 'fAllowCode
Case "PLB":
StrProviderAdjNo = D("PLB.2") 'fProvAdjNo
StrProvYEDate = D("PLB.3") 'fProvYEDate
StrProvCntrlNo = D("PLB.4") 'fProvCntrlNo
StrProvAdjAmt = D("PLB.4") 'fProvAdjAmt
blnFirstSVS = False
'End If
End Select
D.Next_
DoEvents
Loop Until D.EOF
End Sub
Sub WriteLineDetail(SetFlag As Boolean)
If SVCSegment = True Then
wa_SvsTable
Clear_Fields
SVCSegment = False
End If
If SetFlag = True Then SVCSegment = True
End Sub
Sub ClaimClear()
StrField = ""
StrClmStatus = ""
StrClmBill = ""
StrClmPaid = ""
StrPtResp = ""
StrOARACode = ""
StrCORACode = ""
StrCRRACode = ""
StrPRRACode = ""
StrOAAmt = ""
StrCOAmt = ""
StrCRAmt = ""
StrPRAmt = ""
StrFSvsDA = ""
StrTSvsDA = ""
End Sub
Sub Clear_Fields()
StrOARACode = ""
StrCORACode = ""
StrCRRACode = ""
StrPRRACode = ""
StrOAAmt = ""
StrCOAmt = ""
StrCRAmt = ""
StrPRAmt = ""
StrFSvsDA = ""
StrTSvsDA = ""
StrMSGCode = ""
Str2MSGCode = ""
Str3MSGCode = ""
Str4MSGCode = ""
StrLineUnits = ""
StrLAllowed = ""
StrLAllowCode = ""
StrAllowed = ""
StrAllowCode = ""
End Sub
Sub wa_ClaimTable()
With rsClaimTable
.AddNew
!fProviderNo = StrProvNo
!fFileDate = StrFileDate
!fCheckAmt = StrCkAmt
!fCheckDate = StrCkDate
!fCheckNo = StrCkNo
!fPayerName = StrPayer
!fAccount = StrActNo
!fAcctStatus = StrClmStatus
If StrClmBill = "" Then
StrClmBill = "0"
End If
!fAcctBilled = StrClmBill
If StrClmPaid = "" Then
StrClmPaid = "0"
End If
!fAcctPaid = StrClmPaid
If StrPtResp = "" Then
StrPtResp = "0"
End If
!fPtResp = StrPtResp
!fActICN = StrICN
If StrOAAmt = "" Then
StrOAAmt = "0"
End If
!fOAAmt = StrOAAmt
!fOARACode = StrOARACode
If StrCOAmt = "" Then
StrCOAmt = "0"
End If
!fCOAmt = StrCOAmt
!fCORACode = StrCORACode
!fCRRACode = StrCRRACode
If StrCRAmt = "" Then
StrCRAmt = "0"
End If
!fCRAmt = StrCRAmt
!fPRRACode = StrPRRACode
If StrPRAmt = "" Then
StrPRAmt = "0"
End If
!fPRAmt = StrPRAmt
!fCAllowCode = StrCAllowCode
If StrCAllow = "" Then
StrCAllow = "0"
End If
!fCAllow = StrCAllow
!fCFromDate = StrFSvsDA
!fCThruDate = StrTSvsDA
!fPtLName = StrLastName
!fPtFName = StrFirstName
!fPtMName = StrMidInt
!fPtHIC = StrDCN
.Update
DoEvents
End With
End Sub
Sub wa_SvsTable() 'fix this
With rsSvsTable
.AddNew
!fLField = StrLField
!fAccount = StrActNo
!fActICN = StrICN
!fSvcCode = StrProc
!fLineCharge = StrChgAmt
If StrChgPaid = "" Then
StrChgPaid = "0"
End If
!fLinePaid = StrChgPd
If StrChgAdj = "" Then
StrChgAdj = "0"
End If
!fLineAdj = StrChgAdj
If StrUnits = "" Then
StrUnits = "0"
End If
!fLineUnits = StrUnits
!fPtFName = StrFirstName
!fPtLName = StrLastName
!fPtMName = StrMidInt
!fPtHIC = StrDCN
If StrFSvsDA = "" Then
StrFSvsDA = "0"
End If
!fFromDOS = StrFSvsDA
If StrTSvsDA = "" Then
StrTSvsDA = "0"
End If
!fThruDOS = StrTSvsDA
!fOARACode = StrOARACode
If StrOAAmt = "" Then
StrOAAmt = "0"
End If
!fOAAmt = StrOAAmt
!fCORACode = StrCORACode
If StrCOAmt = "" Then
StrCOAmt = "0"
End If
!fCOAmt = StrCOAmt
!fCRRACode = StrCRRACode
If StrCRAmt = "" Then
StrCRAmt = "0"
End If
!fCRAmt = StrCRAmt
!fPRRACode = StrPRRACode
If StrPRAmt = "" Then
StrPRAmt = "0"
End If
!fPRAmt = StrPRAmt
!fMSGCode = StrMSGCode
!f2MSGCode = Str2MSGCode
!f3MSGCode = Str3MSGCode
!f4MSGCode = Str4MSGCode
If StrAllowed = "" Then
StrAllowed = "0"
End If
!fAllowed = StrAllowed
!fAllowCode = StrAllowCode
If StrProvAdj = "" Then
If StrLAllowed = "" Then
StrLAllowed = "0"
End If
If StrCAllow = "" Then
StrCAllow = "0"
End If
!fLAllowed = StrAllowed
!fLAllowCode = StrAllowCode
.Update
DoEvents
Else
!fProvAdjNo = StrProviderAdjNo
!fProvYEDate = StrProvYEDate
!fProvCntrlNo = StrProvControlNo
!fProvAdjAmt = StrProvAdjAmt
!f1Payer1Name = Str1PayerName
!f2PayerName = Str2PayerName
.Update
DoEvents
End If
End With
End Sub
Dim Account As String
Dim Name As String
Dim Part As String
Dim Quantity As String
Dim Zip As String
Dim ExcelApp As Object
Dim ExcelWasNotRunning As Boolean
Dim MyExcel As Boolean
Dim i As Integer
Const DataDir As String = "c:\bss65\"
Const strFileName As String = "KSTEST.xls"
Const strSheet As String = "Sheet2"
' define spreadsheet columns
Const ptPayer As Integer = 1
Const ptProvNo As Integer = 2
Const ptCheckNo As Integer = 3
Const ptCheckDate As Integer = 4
Const ptAccount As Integer = 5
Const ptClmBilled As Currency = 6
Const ptPayment As Currency = 7
Const ptResp As Integer = 8
Const ptICN As Integer = 11
Const ptClmStatus As Integer = 12
Const ptDCN As Integer = 17
Const ptAdjCode As Integer = 13
Const ptRACode As Integer = 14
Const ptMsgCode As Integer = 15
Const ptRecStatus As Integer = 16
Dim strAdj As Currency
'define data variables
Dim strInsurance As String
Sub HaltScript()
Halt_
End Sub
Sub BatchPosting()
MeditechLogon
LoadExcel
MeditechLogout
End Sub
Sub LoadExcel()
On Error Resume Next
Err.Clear
Set ExcelApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
ExcelWasNotRunning = True
Err.Clear
Set ExcelApp = CreateObject("Excel.Application")
If Err.Number <> 0 Then
MsgBox "Error: " & Err.Description
Else
MyExcel = True
End If
MyExcel = False
End If
ExcelApp.Workbooks.Open (DataDir & strFileName) 'This opens the workbook
ExcelApp.Worksheets(strSheet).Select 'This selects the worksheet you want to
work with
ExcelApp.Visible = True
ExcelApp.Workbooks.Visible = True
ExcelApp.DisplayAlerts = False
Activate ("Meditech") 'changed from Medi mt
i = 2 'change as needed
If Not ExcelApp.Application.Cells(i, ptAccount) = "" Then
strInsurance = "MCDK"
ProcessHeader
Else
Exit Sub
End If
Do While Not ExcelApp.Application.Cells(i, ptAccount) = "" 'looking at account
number
ProcessDetail
ExcelApp.Save 'save after processing each record
i = i + 1
Loop
'
Pause "Entry #"
Key "{f11}"
Pause "Number"
Key "{f11}"
Pause "B/AR Batch Menu "
If ExcelWasNotRunning = True Then
ExcelApp.Save
ExcelApp.Application.Quit 'if not already running
End If
Set ExcelApp = Nothing
End Sub
Sub ExtractXLData()
Field1 = ExcelApp.Application.Cells(1, 18)
Field2 = ExcelApp.Application.Cells(2, 18)
ExcelApp.Application.Cells(2, 31) = "done"
i = i + 1
End Sub
Sub MainMeditech()
MeditechLogon
MeditechLogout
End Sub
Sub MeditechLogon()
If Not Active("Medi") Then
Connect "C:\Program Files\Meditech\Workstation3.x\t.exe", stMeditech, "Medi"
End If
Do
Stable 0.4
PauseLoop "<Return> to continue", "~"
PauseLoop "MIS Directories ", "1~"
'PauseLoop "User ID ",
'PauseLoop "Password ", "~"
PauseLoop "Application Databases ", "4~"
PauseLoop "MEDITECH BILLING/ACCOUNTS RECEIVABLE MAIN MENU ", "20~"
PauseLoop "B/AR Batch Menu ", "8~"
Loop Until At("Date")
At ""
End Sub
Sub MeditechLogout()
Do
Stable 0.4
PauseLoop "Date", "{f11}"
PauseLoop "B/AR Batch Menu ", "{f11}"
PauseLoop "MEDITECH BILLING/ACCOUNTS RECEIVABLE MAIN MENU ", "0~"
PauseLoop "Application Databases ", "{f11}"
PauseLoop "User ID ", "~"
Loop Until At("MIS Directories ")
Enter ""
End Sub
Sub ProcessHeader()
'process batch header begin
If Not At("Date") Then
MeditechLogon
End If
'Enter "T" ' add input box for Batch Date
Pause "Journal "
'Enter "RCPFHPRA" 'add input box for journal
Pause "Number "
Enter "N"
Pause "Comment "
Key Trim(ExcelApp.Application.Cells(i, ptPayer) & " #" &
Trim(ExcelApp.Application.Cells(i, ptProvNo) & "Ck# " &
Trim(ExcelApp.Application.Cells(i, ptCheckNo)))) '& "CkDte" &
Trim(ExcelApp.Application.Cells(i, ptCheckDate)))))
Enter ""
Pause "Dflt Serv Date "
'Enter "070203" 'add input box for deposit date
Pause "Amount"
Enter "0"
Pause "Quantity "
Enter ""
Pause "Txn Count "
Enter ""
Pause "@23,1"
Enter "MCDK" 'input box for strins
Pause "@23,14"
Enter "HPMCDK"
Pause "@23,26"
Enter "HAMCDK"
Pause "@24,1"
Enter ""
Pause "Short Form? N"
Enter ""
Pause "Edit Reimb? N"
Enter ""
Pause "Default Ins? Y"
Enter ""
Pause "Remit Codes? N"
Key "{f10}"
Enter "Y"
Pause "Print $0 Bal? N"
Enter ""
Pause "OK? "
Enter "Y"
Pause "Entry #"
' end of batch header
End Sub
Sub ProcessDetail()
Connect "Medi", stStream
'strInsurance = MCDK
strAdj = ExcelApp.Application.Cells(i, ptClmBilled) -
ExcelApp.Application.Cells(i, ptPayment)
Pause "Entry #"
Enter ""
Pause "Account "
Enter Left(ExcelApp.Application.Cells(i, ptAccount), 9)
If At("This is a required field!") Then
Enter ""
Key "{f10}"
Key "{f11}"
Pause "Exit?"
Enter "Y"
ExcelApp.Application.Cells(i, ptRecStatus) = "No act no"
Exit Sub
End If
Stable 0.3
If At("Account @1,~") Then
Enter ""
Enter ""
Key "{f10}"
Key "{f11}"
Pause "Exit?"
Enter "Y"
ExcelApp.Application.Cells(i, ptRecStatus) = "Act not found"
Exit Sub
End If
Pause "Ser Date"
Enter ""
Pause "Insurance "
If "Insurance" = strInsurance Then
Enter ""
Else
Key "{f10}"
Enter strInsurance
Dim INSflag As Boolean
INSflag = False
End If
Stable 0.4
Do
If At("Account does not have this insurance.") Then
Enter ""
Key "{f10}"
Enter "MCDKMD"
INSflag = True
Else
If At("Account does not have this insurance.") Then
Enter ""
Key "{f10}"
Key "{f11}"
Pause "Exit?"
Enter "Y"
INSflag = False
ExcelApp.Application.Cells(i, ptRecStatus) = "INS not in bill
order"
Exit Sub
End If
End If
Stable 0.4
If At("[EMAIL PROTECTED],7") Then
At ""
Key "{pgdn}"
Stable 0.4
End If
If At("Bill # ") Then
Stable 0.3
At ""
strAccount = Trim(ExcelApp.Application.Cells(i, ptAccount))
If Mid(strAccount, 10, Len(strAccount)) = "" Then
Key "{f9}"
Enter "1" 'test this
'Enter "N"
Else
Enter Trim(Mid(strAccount, 10, Len(strAccount)))
Stable 0.4
End If
End If
If At("Non-existent bill!") Then
Enter ""
Key "{f10}"
Key "{f9}"
Enter "1"
End If
Stable 0.3
If At("This entry is unavailable.") Then
Enter ""
Key "{f10}"
Key "{f11}"
Pause "Exit?"
Enter "Y"
ExcelApp.Application.Cells(i, ptRecStatus) = "INS not in bill order"
Exit Sub
End If
Loop Until At("Remittance Code: ")
Stable 0.3
Do
If Trim(ExcelApp.Application.Cells(i, ptRACode)) = "" Then
Enter ""
Else
Enter Trim(ExcelApp.Application.Cells(i, ptRACode))
Pause "Remittance Amt: "
Enter ""
End If
Stable 0.5
Loop Until At("[EMAIL PROTECTED],6")
Pause "[EMAIL PROTECTED],6"
Do
Stable 0.4
If INSflag = True Then
Enter "HPMCDKMD"
Pause "@26,18"
Enter Trim(ExcelApp.Application.Cells(i, ptPayment))
Pause "@26,31"
INSflag = True
'Pause "@26,31"
Key "ICN "
Key Trim(ExcelApp.Application.Cells(i, ptICN))
Key " MsgCde "
Enter Trim(ExcelApp.Application.Cells(i, ptMsgCode))
Stable 0.4
Else
Enter ""
Pause "@26,18"
Enter Trim(ExcelApp.Application.Cells(i, ptPayment))
Stable 0.2
Pause "@26,31"
Key "ICN "
Key Trim(ExcelApp.Application.Cells(i, ptICN))
Key " MsgCde "
Enter Trim(ExcelApp.Application.Cells(i, ptMsgCode))
Stable 0.4
End If
Loop Until At("[EMAIL PROTECTED],6")
Stable 0.3
If INSflag = True Then
Enter "HAMCDKMD"
Pause "@27,18"
Enter strAdj
Pause "@27,31"
If Trim(ExcelApp.Application.Cells(i, ptPayment)) = 0 Then
Key "{F6}"
Stable 0.2
Key "{f10}"
Key "{F6}"
Key "{F10}"
Key "{f12}"
Pause " File?"
Enter "Y"
Pause "Entry #"
ExcelApp.Application.Cells(i, ptRecStatus) = "done"
Exit Sub
End If
Key "AdjCode "
Key Trim(ExcelApp.Application.Cells(i, ptAdjCode))
Key " MsgCode: "
Enter Trim(ExcelApp.Application.Cells(i, ptMsgCode))
Enter ""
Pause "File?"
Enter "Y"
Pause "Entry #"
ExcelApp.Application.Cells(i, ptRecStatus) = "done"
Exit Sub
End If
If Trim(ExcelApp.Application.Cells(i, ptPayment)) = 0 Then
Key "{f10}"
Key "{f12}"
Pause " File?"
Enter "Y"
Pause "Entry #"
ExcelApp.Application.Cells(i, ptRecStatus) = "done"
Exit Sub
End If
If Trim(ExcelApp.Application.Cells(i, ptPayment)) <> 0 Then
Enter ""
Enter strAdj
Pause "@27,31"
Key "AdjCode "
Key Trim(ExcelApp.Application.Cells(i, ptAdjCode))
Key " MsgCode: "
Enter Trim(ExcelApp.Application.Cells(i, ptMsgCode))
End If
Pause "@28,6"
Enter ""
Pause " File? "
Enter "Y"
ExcelApp.Application.Cells(i, ptRecStatus) = "done"
Pause "Entry #"
End Sub
