How to call a cobol DLL from delphi
Stephen K. Miyasato
How does one call the same functions from Delphi.
The code is I've done from Delphi is:
{functions for edrio.dll}
function PIBSINIT(pc : pcT); stdcall; external 'edrio.dll';
function PIBSEXIT(pc : pcT); stdcall; external 'edrio.dll';
The VB code is
Type pcT 'PIBS comm
ver as String *6
verDate as String * 8
prog As String * 8
...
'File areea
Global pc As pcT 'PIBS common area
....
'eDrIO.DLL declares
Declare sub PIBSINIT Lib "erdio.dll" (pc As pcT)
I have no idea where to go next. I do have the source code for the cobol
dll.
Any help appreciated.
Stephen K. Miyasato
MDsync
Marc Rohloff [TeamB]
> How does one call the same functions from Delphi.
It would help if you could show sample VB code of how it is used as
well as which values are modified by the COBOL functions.
FOr starters these two should be procedures not functions:
> function PIBSINIT(pc : pcT); stdcall; external 'edrio.dll';
> function PIBSEXIT(pc : pcT); stdcall; external 'edrio.dll';
> Type pcT 'PIBS comm
> ver as String *6
> verDate as String * 8
> prog As String * 8
> ...
This is approximately:
type
pcT = packed record
ver : string;
verDate : string;
prog:string;
end;
--
Marc Rohloff [TeamB]
marc rohloff -at- myrealbox -dot- com
Stephen K. Miyasato
I get an accessViolation as noted on he call to the DLL
Any other suggustions?
Stephen K. Miyasato
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
pcT = packed record //PIBS Comm
ver : string;
verDate : String ;
prog : String ;
err : String;
first : String; //first Call
mibsFlg : String; //y MIBS is present N = no
initFlg : String; //y means initialized new files
rand : integer ; //random number
filSt : string ; //
f1 : String ; //
date : string ; //8char
fCmd : string ; //2 File command
fName: string ; //24 file name
nAcct : string ; //10 Next account number
nPat : string ; //10 next pat number
debug : string ; //debug flag
lCls : string ; //8 last closed date
qName : string ; //24 query com are name
qAcct : string ; //12 Account Number (num & type)
qPat : string ; //10 pat Number
qClm : string ; //4 claim number
qcurTyp : string; //1 Current account type index
qCmd : string ; //1 command
qCmdS : string ; //1 sub command
qFunc : String ; //1 function
qMod : string ; //1 mode
qFuncS : string ; //sub function
f2 : string; //8 Flags to be later enumerated
pmtDate : string; //8 payment date
chgDate : string; //8 charge date
msg : string ; //54 msg line
f3 : string ; //60 function key defn
paths : string ; //960 file paths
// file open flags
accctOpen : string;// 1
aTypOpen : string; // 1
claimOpen : string;// 1
open : string; // 77 file open flag
f4 : string ; // 24 filler
apptLogN: string; // 24 appt log file name
f5 : string ; // 34 filler
initMIBS : string ; // send command skm
end;
type
nrT = packed record //Name record
Name : String ; //24 last,first m, tittle
acct : string; //10
pat : string ; //10
bir : string ; //8 birth ccyymmdd
reg : string ; // 6 registration date
sex : string ; // 1
st : string ; //status
loc : string ; //location
end;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
const
Ez : String = '000';
implementation
{$R *.dfm}
{functions for edrio.dll}
Procedure PIBSINIT(pc : pcT); stdcall; external 'edrio.dll';
Procedure PIBSEXIT(pc : pcT); stdcall; external 'edrio.dll';
Procedure NAMEIO(pc : pcT; nr : nrT);stdcall; external 'edrio.dll';
procedure TForm1.Button1Click(Sender: TObject);
var
pc : pcT ;
cNr : nrT ;
begin
pc.mibsFlg := 'Y' ; //initialize whether MIBS present
pc.err := Ez;
// get common directory for all winMIBS applications
// some WinMibs directory information
pc.fName := 'C:\MIBS5\' ;
//call PIBSINIT
PIBSINIT(pc); // initialize MIBS <==== error occurs
here.EAccessViolation in module cblrtss.dll (module is present)
end;
end.
VB code begin here
pc.mibsFlg = "Y" 'initialize whether MIBS present
pc.err = Ez
'Get common directory for all winMIBS applications
currDir = CurDir$ 'Get current directory path
winMibsIni = currDir & "\winmibs.ini"
If Exist%(winMibsIni) Then
winMibsDir = getProfileStr("winMIBS", "winMIBS_Dir")
chkHipDir
Else
MsgBox "Unable to find winmibs.ini " & winMibsIni
End If
pc.fName = winMibsDir & "\"
Call PIBSINIT(pc) 'Initialize MIBS
l = Len(pc)
pc.date = Format$(date, "yyyymmdd")
pc.chgDate = pc.date
pc.pmtDate = pc.date
pc.err = Ez
Call CUSTIO(pc, cu)
pc.err = Ez
'Initialize flags & variables
noteDirty = True
noteInitFlg = False
patInsDispInitFlg = False
accessDir = getProfileStr("winMIBS", "Access_Dir")
reportDir = getProfileStr("winMIBS", "Report_Dir")
Load frmMenuEBill
Stephen K. Miyasato
Stephen K. Miyasato
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
copy customer.cop.
copy setup.cop.
01 various-variables.
03 todays-date.
05 system-date pic x(08).
05 system-hhmm pic x(04).
05 filler pic x(09).
03 version-setup.
05 filler pic x(01) value "V".
05 vs-num pic x(02).
05 filler pic x(01) value ".".
05 vs-subnum pic x(02).
03 current-time.
05 filler pic x(01).
05 ct-time pic 9(07).
03 i pic 9(02).
03 parse-path.
05 pp-drive pic x(01).
05 pp-colon pic x(01).
05 filler pic x(12).
03 current-julian.
05 cd-year pic x(02).
05 cd-julian pic x(03).
LINKAGE SECTION.
copy pibscom.cop.
PROCEDURE DIVISION using pibs-comarea.
main-program.
perform init-program.
if pc-error-code = zero
perform get-customer-rec
if pc-error-code = zero
perform process-pibs-comarea.
main-program-exit.
exit program.
init-program.
move zero to pc-error-code.
move "PIBSINIT" to pc-program-name.
move function CURRENT-DATE to todays-date.
move system-date to pc-cdate.
move pc-cdate to pc-pmt-date, pc-chg-date.
move system-hhmm to pc-start-time.
move all "C" to pc-file-open-flags.
accept current-time from time.
* compute pc-rand = function RANDOM(ct-time)
* perform set-day-log.
set-day-log.
* Set log file & create if necessary - ADD LATTER
accept current-julian from day.
move space to appt-log-name.
string "LOG\", pc-cen, current-julian, ".LOG"
delimited by size
into appt-log-name.
get-customer-rec.
move 30 to pc-file-cmd.
call "CUSTIO" using pibs-comarea, customer-rec.
if pc-error-code not = zero
DISPLAY " "
DISPLAY "ERROR READING CUSTOMER FILE ", pc-file-status
DISPLAY PC-FILE-NAME
move "028" to pc-error-code.
process-pibs-comarea.
perform init-pibs-comarea.
perform check-setup-file.
perform set-temp-files.
init-pibs-comarea.
MOVE "F" TO QC-CLAIM-ORDER, QC-TRANS-ORDER.
MOVE "A" TO QC-CLAIM-FMT.
MOVE "L" TO QC-TRANS-FMT.
MOVE "N" TO QC-CLAIM-ARCHIVE, QC-TRANS-ARCHIVE.
unstring cu-version into
vs-num,
vs-subnum.
move version-setup to pc-version.
move cu-version-date to pc-version-date.
move cu-next-acct-num to pc-next-acct-num.
move cu-next-pat-num to pc-next-pat-num.
move cu-lines-per-page to lines-per-page.
move cu-set-condensed-mode to set-condensed-mode.
move cu-cancel-condensed-mode to cancel-condensed-mode.
perform move-paths
varying i from 1 by 1 until i > 60.
move-paths.
move cu-file-path(i) to parse-path.
if pp-drive not = space
and pp-drive not = low-value
if pp-colon = space
move ":" to pp-colon.
move parse-path to pibs-paths(i).
check-setup-file.
move 11 to pc-file-cmd.
call "SETUPIO" using pibs-comarea, setup-rec.
* if pc-error-code not = zero
* if pc-error-code = "002"
* move zero to pc-error-code
* move 15 to pc-file-cmd
* call "SETUPIO" using pibs-comarea, setup-rec.
* perform close-setup-file.
close-setup-file.
if setup-open-flag not = "C"
move zero to pc-error-code
move 90 to pc-file-cmd
call "SETUPIO" using pibs-comarea, setup-rec.
set-temp-files.
move space to temp1-file-name.
string temp1-path, "TEMP1.DAT"
delimited by space into temp1-file-name.
move space to temp2-file-name.
string temp2-path, "TEMP2.DAT"
delimited by space into temp2-file-name.
move space to temp3-file-name.
string temp3-path, "TEMP3.DAT"
delimited by space into temp3-file-name.
Thomas Mueller
> Here is the cobol code for those that are interested;
> ENVIRONMENT DIVISION.
>
> INPUT-OUTPUT SECTION.
> FILE-CONTROL.
>
> DATA DIVISION.
>
> FILE SECTION.
>
> WORKING-STORAGE SECTION.
>
> copy customer.cop.
>
> copy setup.cop.
AAAAAAAAAAAAAAAAAAAAAAAAAaaaaaaaaaaaaaaaaaaaaaaaaaaaaaahhhhhhhhhhhhhhhhhh
[one time Cobol developer running away and hiding under the next large
rock ....]
;-)
MfG
twm
Iman L Crawford
news:4509...@newsgroups.borland.com:
> ver : string;
> verDate : String ;
> prog : String ;
Nothing outside of Delphi understands delphi strings. Most API's I've
used use arrry of chars. Change all of your strings to something like:
ver: array[0..SIZENEEDED] of char;
SIZENEEDED should be deduced from what documentation you got the record
info from. If you could post what you translated your record definition
from, it would be easier for people to help.
also big records like this are usually passed by reference. So your
function declarations should probably include the var keyword:
procedure PIBSINIT(var pc:pcT); stdcall; external; 'edrio.dll';
Again you need to show the actual code that you translated to pascal.
--
Iman
Peter Below (TeamB)
> This is approximately:
> type
> pcT = packed record
> ver : string;
> verDate : string;
> prog:string;
> end;
Not even remotely <g>. The VB type has *fixed* length string fields,
which would be represented by array [1..len] of Widechar. The picture
is complicated by the fact that VB translates UNICODE strings in
user-defined types to ANSI when they get passed to an external function.
--
Peter Below (TeamB)
Don't be a vampire (http://slash7.com/pages/vampires),
use the newsgroup archives :
http://www.tamaracka.com/search.htm
http://groups.google.com
http://www.prolix.be
Stephen K. Miyasato
Stephen K. Miyasato
MDsync
'**** Define Public Data Structures ****
Type pcT 'PIBS Comm
ver As String * 6
verDate As String * 8
prog As String * 32
err As String * 3
first As String * 1 'first call
mibsFlg As String * 1 'Y MIBS is present, N = no
initFlg As String * 1 'Y means initialize new files
rand As Long 'random number
filSt As String * 5
f1 As String * 1
date As String * 8
time As String * 4
fCmd As String * 2 'File command
fName As String * 24 'file name
nAcct As String * 10 'Next account number
nPat As String * 10 'Next pat number
debug As String * 2 'debug flag
lCls As String * 8 'Last closed date
qName As String * 24 'Query Comarea Name
qAcct As String * 12 'Account number (num & type)
qPat As String * 10 'Pat number
qClm As String * 4 'Claim number
qcurTyp As String * 1 'Current account type index
qCmd As String * 1 'command
qCmdS As String * 1 'sub command
qFunc As String * 1 'function
qMod As String * 1 'mode
qFuncS As String * 1 'sub function
f2 As String * 8 'Flags to be latter enumerated
pmtDate As String * 8 'payment date
chgDate As String * 8 'charge date
msg As String * 54 'Msg line
f3 As String * 60 'Function key definitions
paths As String * 960 'File paths
'File open Flags
acctOpen As String * 1
aTypOpen As String * 1
claimOpen As String * 1
open As String * 77 'File open flags
f4 As String * 72 'Filler
apptLogN As String * 24 'appt log file name
f5 As String * 34 'Filler
End Type
Type nrT 'Name Record
Name As String * 24 'last,first m,title
acct As String * 10
pat As String * 10
bir As String * 8 'birth ccyymmdd
reg As String * 6 'registration date
sex As String * 1
st As String * 1 'status
loc As String * 8 'location
End Type
Peter Below (TeamB)
> I have this DLL that is written in Cobol with VB6 able to call the
> dll.
>
> How does one call the same functions from Delphi.
>
> The code is I've done from Delphi is:
> {functions for edrio.dll}
> function PIBSINIT(pc : pcT); stdcall; external 'edrio.dll';
> function PIBSEXIT(pc : pcT); stdcall; external 'edrio.dll';
> 'eDrIO.DLL declares
> Declare sub PIBSINIT Lib "erdio.dll" (pc As pcT)
Since VB uses call-by-reference as default the proper translation would
be
procedure PIBSINIT(var pc: pcT); stdcall; external...;
The main problem is to get the record declaration correctly.
>
> The VB code is
>
> Type pcT 'PIBS comm
> ver as String *6
> verDate as String * 8
> prog As String * 8
A VB6 string*N is an array of 2*N bytes that holds UNICODE characters.
But when a user-defined type (UDT) like the above is passed to an
external function VB translates the UNICODE fields to ANSI, since it
assumes that the DLL will not handle UNICODE. So the COBOL DLL will
likely expect to get ANSI characters or return them. The record
declaration should thus be like this:
type
pcT = packed record
Ver: array [1..12] of char;
verDate: array [1..16] of char;
prog: array [1..16] of char;
...
end;
VB uses $A4 alignment, that may be relevant if your record contains
other fields that are not of type fixed string. You cannot count on the
strings to be zero-terminated, by the way! Delphi allows you to assign
a one-based array of char to a variable of type String, you get all
characters in the array this way. It is customary to fill the unused
space with blanks.
Thomas Mueller
Stephen K. Miyasato wrote:
> Here is the code from VB
> '**** Define Public Data Structures ****
> Type pcT 'PIBS Comm
> ver As String * 6
> verDate As String * 8
> prog As String * 32
Here's your problem: The strings declared in VB are strings with a fixed
length. Delphi does have them too, but they are different from the VB ones,
so you must declare them as array of char like this:
type pcT = packed record
ver: array[0..5] of char;
verDate: array[0..7] of char
prog: array[0..31] of char;
[...]
You were using normal Delphi strings which contain the string length in the
first character, so all your fields were too long. Now only pray that you
won't get any fun with word / double word or whatever alignments on top of
that.
MfG
twm
Stephen K. Miyasato
the error trap:
The program exits on the call to
PIBSINIT(pc); // initialize MIBS
I also tried changing the arry from array[0..SOMENUMBER] to
array[1..SOMENUMBER]
and got type errors.'Incompatible type array and char
The DLL can be downloaded from
http://www.mdsync.net/download/edrio.zip
Thanks for the help
Stephen K. Miyasato
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
pcT = packed record //PIBS Comm
ver : array[0..5]of char; //6
verDate : array[0..7]of char ;//8
prog : array[0..31]of char ; //32
err : array[0..2]of char; //3
first : array[0..0]of char; //1first Call
mibsFlg : array[0..0]of char; //1 y MIBS is present N = no
initFlg : array[0..0]of char; //1 y means initialized new files
rand : integer ; //random number
filSt : array[0..4]of char ; //5
f1 : array[0..0]of char ; //1
date : array[0..7]of char ; //8 char
time : array[0..3]of char ; //4
fCmd : array[0..1]of char ; //2 File command
fName: array[0..23]of char ; //24 file name
nAcct : array[0..9]of char ; //10 Next account number
nPat : array[0..9]of char ; //10 next pat number
debug : array[0..1]of char ; //2 debug flag
lCls : array[0..7]of char ; //8 last closed date
qName : array[0..23]of char ; //24 query com are name
qAcct : array[0..11]of char ; //12 Account Number (num & type)
qPat : array[0..9]of char ; //10 pat Number
qClm : array[0..3]of char ; //4 claim number
qcurTyp : array[0..0]of char; //1 Current account type index
qCmd : array[0..0]of char ; //1 command
qCmdS : array[0..0]of char ; //1 sub command
qFunc : array[0..0]of char ; //1 function
qMod : array[0..0]of char ; //1 mode
qFuncS : array[0..0]of char ; //1 sub function
f2 : array[0..7]of char; //8 Flags to be later enumerated
pmtDate : array[0..7]of char; //8 payment date
chgDate : array[0..7]of char; //8 charge date
msg : array[0..53]of char ; //54 msg line
f3 : array[0..59]of char ; //60 function key defn
paths : array[0..959]of char ; //960 file paths
// file open flags
accctOpen : array[0..0]of char;// 1
aTypOpen : array[0..0]of char; // 1
claimOpen : array[0..0]of char;// 1
open : array[0..76]of char; // 77 file open flag
f4 : array[0..71]of char ; // 72 filler
apptLogN: array[0..23]of char; // 24 appt log file name
f5 : array[0..33]of char ; // 34 filler
end;
type
nrT = packed record //Name record
Name : array[0..23]of char ; //24 last,first m, tittle
acct : array[0..9]of char; //10
pat : array[0..9]of char ; //10
bir : array[0..7]of char ; //8 birth ccyymmdd
reg : array[0..5]of char ; //6 registration date
sex : array[0..0]of char ; //1
st : array[0..0]of char ; //1 status
loc : array[0..7]of char ; //8 location
end;
type
cuT = packed record //Customer record
Name : array[0..23]of char ;
addr1 : array[0..23]of char ;
addr2 : array[0..23]of char ;
city : array[0..19]of char ;
state : array[0..1]of char ;
zip : array[0..9]of char ;
phone : array[0..9]of char ;
fill : array[0..49]of char ;
acctNumLen : array[0..1]of char ;
patNumLen : array[0..1]of char ;
acctNumNext : array[0..9]of char ;
patNumNext : array[0..9]of char ;
acctNumChk : array[0..0]of char ;
acctNumeric: array[0..0]of char ;
patNumChk : array[0..0]of char ;
patNumeric: array[0..0]of char ;
acctNumAuto: array[0..0]of char ;
patNumAuto : array[0..0]of char ;
fil5 : array[0..1]of char ;
filePaths : array[0..719]of char ;
fil6 : array[0..1]of char ;
datelastDayRpt : array[0..7]of char ; // not used
fil2 : array[0..16]of char ;
dayRptByDr : array[0..0]of char ;
fil3 : array[0..143]of char ;
stmtRefNext : array[0..7]of char ; //Next stmt reference number
acctNumIncre :array[0..1]of char ;
patNumIncre :array[0..1]of char ;
fil4 : array[0..2]of char ;
fiscalYr : array[0..7]of char ; //fiscal year, next
dateLastUsed :array[0..7]of char ; //date system last used
fil7 : array[0..0]of char ; //
end;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
const
Ez : string = '000';
implementation
{$R *.dfm}
{functions for edrio.dll}
Procedure PIBSINIT(var pc : pcT); stdcall; external 'edrio.dll';
Procedure PIBSEXIT(var pc : pcT); stdcall; external 'edrio.dll';
Procedure NAMEIO(var pc : pcT; nr : nrT);stdcall; external 'edrio.dll';
procedure CUSTIO(var pc : pcT; cu : cuT);stdcall; external 'edrio.dll';
procedure TForm1.Button1Click(Sender: TObject);
var
pc : pcT ;
cNr : nrT ;
cu : cuT ;
iLen : integer;
begin
pc.mibsFlg := 'Y' ; //initialize whether MIBS present
pc.err := '000';
// get common directory for all winMIBS applications
// some WinMibs directory information
pc.fName := 'C:\MIBS5\' ;
//call PIBSINIT
try
PIBSINIT(pc); // initialize MIBS <== program exits here
except
on E : Exception do
begin
ShowMessage('Exception class name = '+E.ClassName);
ShowMessage('Exception message = '+E.Message);
end;
end;
//iLen := length(pc); ..get error incompatible type
pc.date := '20060912' ;
pc.chgDate := pc.chgDate ;
pc.pmtDate := pc.pmtDate ;
pc.err := '000' ;
CUSTIO(pc, cu);
// initialize the flags and variables
end;
end.
VB Code
pc.mibsFlg = "Y" 'initialize whether MIBS present
pc.err = Ez
'Get common directory for all winMIBS applications
currDir = CurDir$ 'Get current directory path
winMibsIni = currDir & "\winmibs.ini"
If Exist%(winMibsIni) Then
winMibsDir = getProfileStr("winMIBS", "winMIBS_Dir")
chkHipDir
Else
MsgBox "Unable to find winmibs.ini " & winMibsIni
End If
pc.fName = winMibsDir & "\"
Call PIBSINIT(pc) 'Initialize MIBS
l = Len(pc)
pc.date = Format$(date, "yyyymmdd")
pc.chgDate = pc.date
pc.pmtDate = pc.date
pc.err = Ez
Call CUSTIO(pc, cu)
pc.err = Ez
GLOBALS
Option Explicit
Public NL As String * 2 'New line characters
Public Const MODAL = 1 'Form is Modal
Public Const NONMODAL = 0
Public loginOkFlg As Boolean 'user logged in ok
'Screen Stuff
Global Const tm = 25 'top margin for screen
Global Const lm = 25 'left margin
Global Const hm = 375 'height
Global Const wm = 50 'width
Public formW As Long 'Form Width
Public formH As Long 'Form Height
Public formL As Long 'Form Left
Public formT As Long 'Form top
Public Const keyTab = &H9 'Tab
Public Const keyRtn = &HD 'Return
Public Const keyEsc = &H1B 'Escape
Public Const keyPageUp = &H21 'Page UP
Public Const keyPageDown = &H22 'Page Down
'Define Function Key
Public Const keyF1 = &H70
Public Const keyF2 = &H71
Public Const keyF3 = &H72
Public Const keyF4 = &H73
Public Const keyF5 = &H74
Public Const keyF6 = &H75
Public Const keyF7 = &H76
Public Const keyF8 = &H77
Public Const keyF9 = &H78
Public Const keyF10 = &H79
'Define MIBS I/O commands
Public Const f10 = "10" 'Open Input
Public Const f11 = "11" 'Open Dynamic
Public Const f15 = "15" 'Create
Public Const f20 = "20" 'Start not less than
Public Const f21 = "21" 'Start not less than
Public Const f22 = "22" 'Start not less than
Public Const f23 = "23" 'Start not less than
Public Const f30 = "30" 'Read specified record
Public Const f31 = "31" 'Read next
Public Const f32 = "32" 'Read prev
Public Const f33 = "33" 'Read alt key
Public Const f40 = "40" 'Add
Public Const f50 = "50" 'Update
Public Const f60 = "60" 'Delete
Public Const f90 = "90" 'Close file
'Define common file error values
Public Const Ez = "000" 'Zero or no error
'**** Define Public Data Structures ****
Type pcT 'PIBS Comm
ver As String * 6
Type icT 'Insurance Company
comp As String * 4 'Insurance company ID - key
Name As String * 24 'Insurance name
addr As String * 24
city As String * 20
st As String * 2 'State
Z As String * 10 'ZIP
typ As String * 1 'Claim type
frm As String * 1 'Claim form
provSign As String * 1 'Providers name for signature
provInsNum As String * 1 'Pointer to provider's ins num
assign As String * 1 'Accept assignment default
emc As String * 1 'EMC type
phone As String * 10 'Phone
contact As String * 24 'Contact person
clmDate As String * 1 'Claim date on statement
secSusp As String * 1 'Second suspense
secDays As String * 3 'Suspense days
refInsNum As String * 1 'Pointer to referring provider's ins #
secInsPmt As String * 1 'Ins pmts printed on 2nd ins claim
secInsAdj As String * 1 'Ins adj printer on 2nd ins claim
sedInsPmt As String * 1 'Patient pmts printed on 2nd ins claim
secPrt As String * 1 'Print 2nd claim
insPmt As String * 1 'Insurance payment type
ver As String * 1 'Copylib version
pos As String * 1 'Pointer to POS code in Place File
ext As String * 4 'Phone extension
susp As String * 1 'Suspense flag
f1 As String * 2 'filler
prt As String * 1 'print primary claim
priceList As String * 1 ' price list
acctType As String * 2 'account type
f2 As String * 11 'stop, copay, sec days
medigap As String * 12
dateStart As String * 8
cci As String * 1 'Y for cci edits
dxMax As String * 1 'Y for dx max specifity edits
hmsaCompId As String * 2
f3 As String * 8
insGrp As String * 4 'ins group for submission
insGrpSub As String * 1 'submit w/group Y/N
f4 As String * 28 'Filler
End Type 'Insurance Company Record
Type ixT 'Insurance Extension
comp As String * 4 'Insurance company ID - key
emcType As String * 24 'emc type, "HMSA"
dateLastSub As String * 8 'last emc submission date
ctrlNum As Long 'Uniques number for interchange
daySeq As Long 'Sequence number for day
ver837 As String * 16 '837 version
isaSenderIdQual As String * 2 'sender ID qualifer
isaSenderId As String * 16
isaReceiverIdQual As String * 2 'receiver ID qualifer
isaReceiverID As String * 16
gsSenderCode As String * 16 'GS02
gsReceiverCode As String * 16 'GS03
senderName As String * 36 'actually 35 characters
senderID As String * 36 '2-80 char
senderContact As String * 24 'contact person
receiverName As String * 36 '35 char
receiverID As String * 36 '2-80 char
provIdQual As String * 2 'type of id
refDrIdQual As String * 2 'type of id
provTaxonomy As String * 16 'specialty code
clmFiling As String * 2 'SBR09 claim filing indicator
dD As String * 1 'data element separator
dC As String * 1 'composite element separator
dT As String * 4 'segment terminator
ProdFlg As String * 1 'Production or Test flag
ackReq As String * 1 'TA1 0/1 0=not created
mcPolicyEdits As String * 1 'MC Policy edits in effect Y/N
cciEdits As String * 1 'CCI edits in effect Y/N
maxDxEdits As String * 1 'Max Dx specific edits in effect
hmsaEdits As String * 1
oldType As String * 1 'Old emc type - H, M
f2 As String * 1 'filler
insGrp As String * 4 'insurance group
f1 As String * 64 'filler
End Type 'Insurance Extension
Type prInsT 'Patient Record - ins part of account types
insNum As String * 2 'num or ptr to pat ins record
fm As String * 1 'family member
sign As String * 1 'signature code (code tabel)
prt As String * 1 'print flag
susp As String * 1 'suspense flag
assign As String * 1 'assign ins flag
price As String * 1 'price list
signDate As String * 8 'signature obtained date
End Type
Type prTypT 'Patient Record - up to 3 account types
typ As String * 2 'account type
f1 As String * 2 'filler
ins(1 To 3) As prInsT
End Type
Type prt 'Patient Record
num As String * 10 'Patient number
acct As String * 10 'Account number
typs(1 To 3) As prTypT 'Acct types & ins info for each
Name As String * 24 'Patient name
bir As String * 8 'Patient birth ccyymmdd
ss As String * 10 'social security number
dr As String * 2 'Primary DR
rDr As String * 4 'Referring DR
lClm As String * 4 'Last claim number
op As String * 8 'Date opened
st As String * 1 'pat status
sex As String * 1 'Patient sex
mar As String * 1 'Marital status
emp As String * 1 'Employment status
dUp As String * 8 'Date last updated
tUp As String * 4 'Time last updated
pcp As String * 4 'Primary Care Provider
user1 As String * 8 'User Field 1
user2 As String * 8
f1 As String * 18 'Filler
End Type 'Patient Record
Type piT 'Patient Insurance Record
acct As String * 10
num As String * 2
comp As String * 4
mem As String * 16
grp As String * 16
cond As String * 2
cov As String * 6
dateEff As String * 8
dateExp As String * 8
sub As String * 24 'Subscriber
f1 As String * 2 'filler
dateBirth As String * 8
emp As String * 24 'Employer
f2 As String * 5
sex As String * 1
f3 As String * 24
End Type 'Patient Insurance Record
Type arT 'Account record
num As String * 10 'Account base number
typ As String * 2 'Account type
Name As String * 24 'Account holder's name
a1 As String * 24 '1st line
a2 As String * 24
city As String * 20
st As String * 2
Z As String * 10
hom As String * 10
bus As String * 10
bal(1 To 21) As Long
dOpn As String * 8 'Date opended
dL As String * 8 'Date last activity
dSt As String * 8 'Date last statement
dAg As String * 8 'Date last aged
cy As String * 2 'Statement cycle
tMsg As String * 2 'Temporary statement message
tCy As String * 2 'Number of cycle for temporary statement messages
lDb As String * 4 'Last debit num
lCr As String * 4 'Last credit num
lNot As String * 4 'Last account note num
s As String * 1 'Account status
sChg As String * 1 'Service charge flag
stTax As String * 1 'State tax flag
stF As String * 1 'Statement form
prLst As String * 1 'Price list
dun As String * 1 'Dunning
disTyp As String * 1 'discount type
upTime As String * 4 'time updated
insLast As String * 2 'last ins num
busExt As String * 4 'business phone ext
f1 As String * 21 'Filler Need to finish
End Type 'Account record
Type anT 'Account Note Record
Type As String * 1 '1 = account, 2 = patient, 3 = claim
fil1 As String * 1
key As String * 14 'acct/type or pat/claim
num As String * 4 'account note number
date As String * 8
time As String * 4
UserID As String * 8
tickDate As String * 8
fil2 As String * 8
note As String * 50
fil3 As String * 9
End Type 'Account Note
Type atT 'Account Type Record
typ As String * 2
des As String * 10 'short description
descript As String * 24 'long description
taxDr As String * 2
taxProc As String * 8
servChgDr As String * 2
servChgProc As String * 8
taxRate As Long 'state tax rate
servChg As Long 'service charge rate
minBalDun As Long 'minimum balance for dunning msg
minPayDun As Long 'minimum payment for no dunning
smallBal As Long 'small balance amount
crTerm As Long
crAdjPercent As Long
smallBalDr As String * 2
fil1 As String * 2
crAdjDr As String * 2
stmtMsgCurr As String * 2
stmtMsg31 As String * 2 'statement message 31 to 60 days
stmtMsg61 As String * 2
stmtMsg91 As String * 2
stmtMsg121 As String * 2
stmtMsgOver As String * 2 'over 150 days
servChgPeriod As String * 1
smallBalCrTyp As String * 1
crAdjTyp As String * 1
crTyp As String * 1
crAdjProcAmt As String * 1
delinqPeriod As String * 1
stmtForm As String * 1
suspBill As String * 1
billCr As String * 1
prtCrBal As String * 1
priceLst As String * 1
pmtPostTyp As String * 1
arcTransTyp As String * 1
addrSwitch As String * 1
genStmtMsg As String * 2
servChgTyp As String * 1
dr As String * 2
smallBalTyp As String * 1
fixCycle As String * 1
calcIns As String * 1
refDrStmt As String * 1
fil2 As String * 1
nameSwitch As String * 1
insPmtTyp As String * 1
patPmtTyp As String * 1
fil3 As String * 14
End Type 'Account type
Type cIT 'claim insurance
ins As String * 2 'ins number
insComp As String * 4 'ins company id
dateClm As String * 8 'claim date
dateRSub As String * 8 'resub date
dateInsPmt As String * 8 'insurance payment date
dateEmc As String * 8 'date EMC 1st submitted
susp As String * 1
prt As String * 1
assign As String * 1
status As String * 1
emc As String * 1
suspStatus As String * 1
insPmt As Long
insAdj As Long
End Type
Type clT 'Claim Record
pat As String * 10 'Patient number
num As String * 4 'Claim number
acct As String * 10 'account number
atype As String * 2 'account type
dr As String * 2 'dr number
dx(1 To 6) As String * 8 'dx code array - 6 dx codes
dateFrm As String * 8 'from service date
dateTo As String * 8 'to service date
amt As Long '***claim amt neet to redo with CLAIMIO
adj As Long 'adjustments - non ins
pmt As Long 'payments - non ins
bal As Long 'claim balance
outLab As Long 'outside lab amount
ins1 As cIT
ins2 As cIT
ins3 As cIT
db1 As String * 4 '1st debit number
dbNum As String * 2 'number of claim debits
refDrBy As String * 4 'referring Dr
refTodr As String * 4 'referring TO dr
pos As String * 4 'place of service code
dateSymp As String * 8 'symptom date
date1st As String * 8 'date 1st consult
dateLast As String * 8 'last visit date
dateAdm As String * 8 'hosp admit date
dateDis As String * 8 'hosp dischrage date
author As String * 16 'authorization #
dateEnter As String * 8 'entry date
dateUp As String * 8 'update date
timeUp As String * 4 'update time
ver As String * 1 'version #
complaint As String * 1 'Y = complaint in notes
notes As String * 1 'Y = notes for this claim
pmtSt As String * 1 'payment status
acc As String * 1 'accident indicator
fVisit As String * 1 'first visit indicator
phys As String * 1 'physical indicator
simSymp As String * 1 'similar symptom indicator
sympType As String * 1 'symptom type
emerg As String * 1 'emergency indicator
recall As String * 4
dateRefDrBy As String * 8 'date Dr refer
End Type 'Claim record
Type clmPrcsAreaT 'claim common area for printing, emc...
patInsNum As Long
clmInsPaid As Long
clmAdj As Long
clmPaid As Long
clmNetAmt As Long
prtEmcFlg As String * 1
primSecNum As String * 1
dmdBatFlg As String * 1
callTypeFlg As String * 1
edErrNum As String * 2
f1 As String * 2
edErrs(1 To 5) As String * 4
codeErrs(1 To 5) As String * 12
pi1 As piT
prIns1 As prInsT
ic1 As icT
pi2 As piT
prIns2 As prInsT
ic2 As icT
End Type
Type clmPrtAreaT 'claim print area
clmLine(1 To 59) As String * 80
End Type
Type chT 'Claim Hold Record for Batch Claims
Form As String * 1 'claim form
typ As String * 1 'claim type
patNum As String * 10 'patient number
clmNum As String * 4 'patient number
ins1st As String * 1 'indicates first or second ins
prcs As String * 1 '????
date As String * 8
End Type
Type coT 'code table record
tabl As String * 1 'code table
code As String * 1 'code
descript As String * 24 'description
short As String * 10 'short description
ver As String * 1 'serves also as claim status
pmtFmt As String * 1 'payment format
insPmt As String * 1 'indicates insurance/patient payment
f1 As String * 6 'filler
adjTyp As String * 1 'credit adj code corresponding
f2 As String * 4
End Type
Type crT 'Credit Record
acct As String * 10 'account number
typ As String * 2 'account type
num As String * 4 'credit number
dbKey As String * 16 'debit number
proc As String * 8 'procedure code
descript As String * 24 'description
amt As Long 'credit amount
ver As String * 1
split As String * 1
dr As String * 2
doc As String * 6
dateRef As String * 8 'reference date
dateEntry As String * 8
batch As String * 2
dateStmt As String * 8
pmtCr As String * 1
crTyp As String * 1
pat As String * 10
clm As String * 4
dateUp As String * 8
acctClm As String * 1
insPatPmt As String * 1
insPmtSeq As String * 1
suspStatus As String * 1
End Type
Type crST 'Credit split record
acct As String * 10 'account number
typ As String * 2 'account type
num As String * 4 'credit number
dbNum As String * 4 'debit number
amt As Long 'credit split amount
dr As String * 2 'doctor code
f1 As String * 2 'filler
End Type
Type cuT 'Customer Record
Name As String * 24 'Customer Name
addr1 As String * 24
addr2 As String * 24
city As String * 20
state As String * 2
zip As String * 10
phone As String * 10
fil1 As String * 50
acctNumLen As String * 2
patNumLen As String * 2
acctNumNext As String * 10
patNumNext As String * 10
acctNumChk As String * 1
acctNumeric As String * 1
patNumChk As String * 1
patNumeric As String * 1
acctNumAuto As String * 1
patNumAuto As String * 1
fil5 As String * 2
filePaths As String * 720
fil6 As String * 2
dateLastDayRpt As String * 8 'NOT Used!
fil2 As String * 17
dayRptByDr As String * 1
fil3 As String * 144
stmtRefNext As String * 8 'Next stmt reference number
acctNumIncre As String * 2 'Next acct num increment
patNumIncre As String * 2 'Next pat num increment
fil4 As String * 3
fiscalYr As String * 8 'fiscal year, next
dateLastUsed As String * 8 'date system last used
fil7 As String * 1
End Type
Type dbT 'Debit Record
acct As String * 10 'account number
typ As String * 2 'account type
num As String * 4 'debit num
pat As String * 10 'patient number
fName As String * 10 'patient's first name
proc As String * 8 'procedure
descript As String * 24 'description
amt As Long 'debit amount
amtAdj As Long 'debit amount adjustment
paid As Long 'amount paid - non ins
insPaid As Long 'ins amount paid
insAdj As Long
units As Long
dx(1 To 6) As String * 1 'dx pointers to claim dx
dr As String * 2 'dr number
refDr As String * 4 'referring dr
doc As String * 6 'document number
dateServ As String * 8 'service date
batch As String * 2 'batch number
dateEntry As String * 8 'entry date
clm As String * 4 'claim number
dateClm As String * 8 'claim date
dateStmt As String * 8 'statement date
chgDb As String * 1 'charge/debit
dbTyp As String * 1 'charge/debit type
pmtSt As String * 1 'payment status
pmtISt As String * 1 'insurance payment status
susp As String * 1 'suspense flag
ver As String * 1
dateUp As String * 8 'update date
timeUp As String * 4 'update time
mod2 As String * 2 'second proc modifier
mod3 As String * 2 'third proc modifier
statusCode As String * 1 'status code for Pain, good idea move to code
table
suspStatus As String * 1 'suspense status for debit, Y=suspense
End Type
Type dxT 'Dx record
code As String * 8 'dx code - used internally
icd9 As String * 6 'icd9 dx code
descript As String * 24 'dx description
minAge As String * 2
maxAge As String * 2
clmAccept As String * 1
complaint As String * 1
injury As String * 1
sex As String * 1
onset As String * 1
maxSpec As String * 1 'dx maximum specificity (Y or N)
f1 As String * 12 'filler
End Type
Type dbAFT 'Debit area flag array
coPay As Long 'copay amount
adj As Long 'credit adj amount
copayTyp As String * 1 'copay type
adjTyp As String * 1 'adj type
clmAccept As String * 1 'claim acceptable
refDrR As String * 1 'referring dr required
surgR As String * 1 'surgery date required
injuryR As String * 1 'injury date required
intSubR As String * 1 'first/sub required
onsetR As String * 1 'onset date required
complaint As String * 1 'complaint required
f1 As String * 3 'filler
End Type
Type dbInT 'Debit area ins param
ins As String * 2 'ins number
insComp As String * 4 'insurance company id
susp As String * 1 'suspense bill
prtClm As String * 1 'print claim
assign As String * 1 'accept assign
clmForm As String * 1 'claim form
f1 As String * 2 'filler
End Type
Type dbAT 'Debit area - Charge
dbNum As Long 'Number of debits
dxNum As Long 'Number of dx
dr As String * 2 'dr or provider id
refDr As String * 4 'referring dr id
refDrName As String * 24 'referring dr name
chgDb As String * 1 'charge/debit indicator
dbTyp As String * 1 'debit type
tax As String * 1 'calculate tax flag
crTyp As String * 1 'credit adj type
fName As String * 10 'first name
author As String * 16 'authorization number
recall As String * 4 'reacll num
insNum As String * 1 'number of ins
f1 As String * 3 'filler
ins(1 To 3) As dbInT
db(1 To 10) As dbT 'array of debit recs
dbAFlg(1 To 10) As dbAFT 'debit array flags
dxA(1 To 6) As dxT 'dx array
clmNumPrev As String * 4 'prev claim number
prev As String * 1 'use prev claim flag
injury As String * 1 'injury flag
chkDxNum As String * 1 'number of dx to check
f2 As String * 3
complaint As String * 50 'complaint
End Type
Type ehT 'EMC Hold Record
emcType As String * 1
dr As String * 2
Name As String * 24
pat As String * 10
clmNum As String * 4
prim As String * 1 'P=prim,S=sec,3=third
date As String * 6
End Type
Type emcHoldT 'emcHold array
key As String
emcType As String 'emc type - A,B,C,M,Q
dr As String
insComp As String 'insurance company
Name As String
pat As String
clmNum As String
prim As String 'P=prim,S=sec,3=third
ProdFlg As String
insExtFlg As Boolean 'hipaa extension exists
End Type
Type emcSumT 'emc summary array
emcType As String
emcName As String
numClms As Integer
insComp As String
ProdFlg As String
desc As String 'testing, ready to send
emcStatus As String 'D = delete from emc hold
End Type
Type icAT 'Insurance Company Names used by Registration
ins1 As icT
ins2 As icT
ins3 As icT
End Type
Type nrT 'Name Record
Name As String * 24 'last,first m,title
acct As String * 10
pat As String * 10
bir As String * 8 'birth ccyymmdd
reg As String * 6 'registration date
sex As String * 1
st As String * 1 'status
loc As String * 8 'location
End Type
Type patListT 'patient list
date As String * 8 'scheduled date
num As String * 4 'seq assigned number
dr As String * 2
Name As String * 24
patNum As String * 10
acctNum As String * 10
acctTyp As String * 2
End Type
Type pmtAET 'array of encounters in Payment Area
db1st As String * 4 ' 1st debit number
numDb As Long 'number of debits
bal As Long 'debit bal
charge As Long
pmt As Long 'payment
adj As Long
dr As String * 2
susp As String * 1 'suspense bill
dbClm As String * 1 'flag indicate debit or claim
End Type
Type pmtADbT 'array of claim\encounter pointers
db1st As String * 4 '1st debit number
numDb As Long 'number of debits
ptr As Long 'pointer to pmtSrn
bal As Long 'claim balance
End Type
Type pmtEcntT ' array of debits for an ecounter
db1st As String * 4 '1st debit number
numDb As Long
bal As Long
charge As Long
pmt As Long
adj As Long
dr As String * 2
suspBill As String * 1
dbEcnt As String * 1
End Type
Type pmtAT 'Common area for payment
numPmts As Long
numEcnt As Long
'dbSrn(1 To 200) As pmtADbT 'Pointer for claims on screen
pmtEcnt(1 To 11) As pmtEcntT
pmtSrn(1 To 200) As pmtAET 'Payment info
pmtDate As String * 8
doc As String * 8
stmtRef As String * 8 'statement reference number
stmtDate As String * 8 'statement date
stmtBal As Long 'statement balance
db1st As String * 4 'first db num with balance
pmtFlg As String * 1 'payment flag I = ins, P = Pmt, S = sec ins pmt
acctClmFlg As String * 1 'A=acct, C=claim
stmtFlg As String * 1 'statement reference flag
pmtTyp As String * 1 'payment type
adjTyp As String * 1 'adjustment type
checkTyp As String * 1 'check payment type
cashTyp As String * 1 'cash payment type
depOpt As String * 1 'deposit option
End Type
Type pmtEncountT 'array with payment encounters
dbNum As String * 4 '1st debit number
claimNum As String * 4 'claim number
numDb As Integer 'number of debits
End Type
Type piAT 'Array of patient insurance used in Registration
ins1 As piT
ins2 As piT
ins3 As piT
End Type
Type plT 'Place of Service rec
place As String * 4
f1 As String * 10
Name As String * 24
addr As String * 24
city As String * 20
state As String * 2
zip As String * 10
pos(1 To 5) As String * 2
ver As String * 1
f2 As String * 15
End Type
Type poT 'Provider rec
dr As String * 2
f1 As String * 2
Name As String * 24
nameShort As String * 10
socSec As String * 12
fedId As String * 12
stateId As String * 12
insId(1 To 5) As String * 12
emc1 As String * 12
emc2 As String * 12
descript As String * 40
addr As String * 24
city As String * 20
state As String * 2
zip As String * 10
phone As String * 10
place As String * 4
pos As String * 1
acceptAssign As String * 1
addrFmt As String * 1
ver As String * 1
f2 As String * 2
insId1(1 To 5) As String * 12
champus As String * 18
f3 As String * 10
mcEdiDate As String * 8 'date signed MC EDI contract
group As String * 12
clia As String * 15
f4 As String * 3
End Type
Type prrT 'Proc rec *** Preliminary, needs to be redone!
lst As String * 1 'Price list
proc As String * 8 'Proc code
lType As String * 1 'Proc list type
cpt As String * 8 'Proc ins code - CPT
descript As String * 24 'Proc description
f1 As String * 2
price As Long
f2 As String * 8
dateC As String * 8 'Last date price changed
pricePrev As Long
f3 As String * 8
rvs As Long
clm As String * 1
Type As String * 1
refDr As String * 1
f4 As String * 2
first As String * 1
tos As String * 1
conv As String * 1
f5 As String * 4
comp As String * 1
onset As String * 1
f6 As String * 4
tax As String * 1
dx As String * 8
upin As String * 1
f7 As String * 2
clia As String * 1
pt As String * 1 'physical therapy
epsdt As String * 1 'epsdt
lastVisitReq As String * 1 'last visit required
f8 As String * 18 'filler
End Type
Type prMT 'Proc Macro
list As String * 1 'price list
macro As String * 8 'macro code
proc(1 To 10) As String * 8 'up to 10 macro codes
End Type
Type rdT 'Referring Dr rec
refDr As String * 4 'ref dr id
Name As String * 24 'ref dr's name
f1 As String * 10 'filler
addr As String * 24
addr2 As String * 24
city As String * 20
state As String * 2
zip As String * 10
f2 As String * 4
insNum(1 To 5) As String * 12 'ref provider ins nums
End Type
Type shT 'statement hist
num As String * 8 'stmt ref num
acctNum As String * 10 'account base number, w/o type
dateStmt As String * 8
acctTyp As String * 2
cycle As String * 2
balBeg As Long
balEnd As Long
dateSent As String * 8
noteNum As String * 4
balPrev(1 To 21) As Long 'balance before aging
balCurr(1 To 21) As Long 'after stmt aging
pmtPat As Long 'patient payment - as opposed to insurance
prtDb As String * 4 'first debit print num
prtCr As String * 4 'first credit
ver As String * 1 'version num for this structure
stmtReset As String * 1
lastDb As String * 4
lastCr As String * 4
f1 As String * 4
End Type
Type stmtAreaT 'statement common area
elapMin As Long 'elapsed min
acctsRead As Long 'accounts read
stmtsPrtd As Long 'stmts printed
stmtPrevBal As Long
dbBal As Long
crBal As Long
dbSusp As Long
dbCurr As Long
dbPrev As Long
crSusp As Long
crCurr As Long
crPrev As Long
dbBalCurr As Long
crBalCurr As Long
crBillCurr As Long
crBillPrev As Long
patPmt As Long 'patient payment, non-insurance
stmtRefNum As String * 8 'statement reference number
stmtBegNum As String * 8 'stmt beg for rerun
stmtendNum As String * 8 'stmt end for rerun
callType As String * 1
sBatChkCall As String * 1
resetCall As String * 1
agedDmd As String * 1
prtStmt As String * 1
dmdBat As String * 1
f1 As String * 1 'dmd-aged-stmt - ? not used
cycleCurr As String * 2
cycleNew As String * 2
datePmtDue As String * 6 'mmddyy
acctTypeCurr As String * 2
datePrcs As String * 8
dateTransCut As String * 8
primLastIns As String * 4
secLastIns As String * 4
primCutoffDate As String * 8
secCutoffDate As String * 8
prcsBlanks As String * 1
prtAlphaSort As String * 1
cycleNewRec As String * 1
dbPrtFirst As String * 4 'first print debit
crPrtFirst As String * 4
dbLastNum As String * 4 'last debit num
crLastNum As String * 4
dbRecsMore As String * 1 'Y if more debit recs
crRecsMore As String * 1
suspBill As String * 1
cycleRerun As String * 1
cycleDateLast As String * 8
insPrimComp As String * 24 'name for primary insurance
insPrimCov As String * 6 'primary ins coverage
insSecComp As String * 24
insSecCov As String * 6
End Type
Type stmtPrtAreaT
stmtLine(1 To 61) As String * 80
End Type
Type zipT 'ZIP Code File
code As String * 10
city As String * 20
st As String * 2
End Type
'*** Report Types
Type rft 'Report filter
cmd As String * 1 ' report cmd
st As String * 1 'status
f1 As String * 2 'filler
tBeg As Long 'beginning time
tCur As Long 'current time
recT As Long 'total recs
susp As Long 'suspense interval - number of records
beg As String * 8 'Beginning date
end As String * 8 'End date
recR As Long 'records read
recS As Long 'records selected
End Type 'Report filer
Type abrT 'Aged balance report record
acct As String * 10 'account #
typ As String * 2 'account type
insComp As String * 4 'ins company id
Name As String * 24 'account name
addr1 As String * 24
addr2 As String * 24
city As String * 20
state As String * 2
zip As String * 10
phoneHome As String * 10
phoneBus As String * 10
cy As String * 2 'stmt cycle
f1 As String * 2 'filler
bal(1 To 9) As Long 'Numeric fields
End Type
Type remPmtsClmT 'remittance pmt for claim
sortKey As String 'key to create proper post order
sortKey2 As String '2nd sort key
stNum As Long 'ST group #
segPtr As Long 'pointer to CLP seg with 835
segEndPtr As Long 'pointer to end of CLP group
patSeq As Long 'patient seq within 835
refNum As String 'patient claim reference number
clmStatus835 As String 'claim status code
insSeq As String '1=prim ins, 2=sec, 3 =third
insCrossover As String 'Y = yess,N=no
patName835 As String 'patient name
patNum As String 'patient number
clmNum As String 'claim number
acct As String 'account number
acctTyp As String 'account type
dr As String 'provider number
svcBegDate As Date 'beg service date
svcEndDate As Date 'end service date
clmAmt835 As Currency 'claim charge amt
insPmt835 As Currency 'amount paid
patPmt835 As Currency 'patient responsible
insPmt As Currency 'insurance payment to post
insAdj As Currency 'insurance adjustment to post
insPrev As Currency 'previous ins payment & adjustment
patCopay As Currency 'patient portion
deniedAmt As Currency 'amount denied for claim
dupAmt As Currency 'amount duplicate charges for claim
bal As Currency 'balance before remit post
balPost As Currency 'balance after remit post
db1st As String 'first debit num
dbPtr As Long 'pointer to start of debit detail
dbNum As Long 'number of debits
postFlg As Boolean 'post this claim
foundClmFlg As Boolean 'pat - claim reference not present
svcMatchFlg As Boolean 'service lines match
dupFlg As Boolean 'claim is a duplicate
deductFlg As Boolean 'claim has deductible
deniedFlg As Boolean 'claim denied
warnBalFlg As Boolean 'warning, claim balance is neg
warnAdjFlg As Boolean 'warning, service line adj warning
noPostFlg As Boolean 'do not post adj
checkedFlg As Boolean 'checked to post
taxFlg As Boolean 'claim has tax
taxIncludedFlg As Boolean 'tax included in remit svc lines
taxAmt As Currency 'tax amount
taxPmt As Currency 'tax payment
taxAdj As Currency 'tax adjustment
End Type
Type remDbT 'remittance debits for each claim
db As dbT 'debit rec
cpt As String 'ins cpt code
insPmt As Currency 'insurance payment to post
insAdj As Currency 'insurance adjustment to post
bal As Currency 'db balance before ins
svcPtr As Long 'pointer to SVC in remit
taxFlg As Boolean 'debit is tax
matchFlg As Boolean 'match with a svc line
dupFlg As Boolean 'duplicate claim line
End Type
Type pmtDbT 'rem pmt debit area
dbRec As dbT 'debit rec
dbBal As Long
pmtAmt As Long
adjAmt As Long
ioAdjAmt As Long
End Type
Type remAreaT ' rem area for REMPOST
pmtDate As String * 8 'remit date
pmtTyp As String * 1
adjTyp As String * 1
ioAdjTyp As String * 1
insIO As String * 1
insDeduct As String * 1
insSeq As String * 1
insCrossover As String * 1
susp As String * 1 'Y claim in suspense
dbNum As Long
pmtDb(0 To 10) As pmtDbT 'array of debit recs & stuff
End Type
Type hipAdjCodeT 'HIPAA adj codes
seqNum As String 'seq number- 4 char
adjCode As String 'adj code - 4 chr
cat As String 'adj code category 2 chr
act As String 'action P,N,B,A - P = Post
useNum As Long 'number of uses
descript As String 'description
End Type
Type log837T '837 log record
fileName As String
dateFile As Date 'date file generated
dateSend As Date 'date file actually sent
ctrlNum As Long 'control #
date997 As Date 'date 997 received
accept997 As Boolean '837 accepted, false = rejected
dateRpt As Date 'date report received
date276 As Date 'date 276 generated
date277 As Date 'date 277 received
claims As Long 'number of claims
claimErrs As Long 'number of errors
End Type
Type hip837filesT 'template for array of hipaa upload files
insComp As String 'ins company
emcType As String 'A, B, C, M, Q
emcDate As Date 'date emc generated
claims As Long 'number of claims
amt As Double '$ for this file
fName As String 'file name
End Type
'HIPAA 276/277
Public patClm() As String 'array of pat & claims numbers
Type clm277T 'array with 277 stuffs for each claim
patName As String 'pat name from 277
refNum As String 'pat claim reference number
patNum As String
clmNum As String
clmStatus277 As String 'claim status code
clmAmt As Currency 'charge amount from 277
clmPmt As Currency 'amt paid
pmtDate As Date 'payment or adjudication date
End Type
Global winMibsDir As String 'MIBS directory if present
Global winMibsIni As String 'path for winMIBS.ini
Global accessDir As String 'Access directory
Global accessMDB As String 'Access data base
Public currDir As String 'current directory
Public reportDir As String 'directory with crystal reports RPT files
Public hipDir As String 'hipaa directory
Public hipUpDir As String
Public hipSentDir As String
Public hipDwnDir As String
Public hipEmcDir As String
Public hipRemDir As String
Public dD As String 'data element delimiter
Public dC As String 'composite delimited
Public dT As String 'segment terminator
Public monthDay As String
Public hipBuf As String * 1024 'buffer for reading a hipaa file
Public hStr As String 'hipaa file string
Public hPos As Long 'current position in hStr
Public hipSegNum As Long 'number of segments
Public hipSegBeg As Long 'ptr to start of segment
Public hipRemNum As Integer 'number of 837 files
Public postAmt As Currency
Public postNum As Long
Public warnAmt As Currency
Public warnNum As Long
Public notAmt As Currency
Public notNum As Long
'File areas
Global pc As pcT 'PIBS Common Area
Global ar As arT 'Account
Global an As anT 'Account Note
Public at As atT 'Account Type
Public ch As chT 'claim hold record
Global ci As cIT 'Claim insurance stuff
Global cl As clT 'Claim record
Global co As coT 'Code table rec
Global cr As crT 'Credit record
Global crS As crST 'credit split
Global cu As cuT 'Customer rec
Global db As dbT 'Debit record
Public dx As dxT 'Dx record
Public eh As ehT 'EMC Hold record
Global ic As icT 'Insurance Company
Public ix As ixT 'Ins Comp Extension
Global nr As nrT 'Name
Global pi As piT 'Patient Insurance
Public pl As plT 'place of servcie
Public po As poT 'Provider rec
Global pr As prt 'Patient
Global prr As prrT 'Proc rec
Public sh As shT 'statement history
'common areas
Public dbA As dbAT 'debit common area
Public icA As icAT '3 insurances
Public piA As piAT '3 patient insurances
Global pmtA As pmtAT 'Common area for Payment
Public pmtEncount As pmtEncountT
Public pmtEncountA(100) As pmtEncountT
Public patInsErrFlg(1 To 3) As Boolean 'error in ins comp for pat cov
Public clmPrcsArea As clmPrcsAreaT
Public stmtArea As stmtAreaT 'statement common
'Register flags
Global acctAddFLg As Boolean 'add account flag
Global patAddFlg As Boolean 'add patient flag
Global patInsAddFlg As Boolean 'add patient ins flag
Public patInsCur As Integer 'current pat ins
Public patInsNum As Integer 'number of ins for patient
Public curTyp As Integer 'current account type
'Colors
Public colorReg As Long 'regular color
Public colorHigh As Long 'highlight color
'Note & claim grid flags
Public noteInitFlg As Boolean 'note grid initialized
Public noteDirty As Boolean 'notes have changed
Public noteVisible As Boolean
Public patInsDispInitFlg As Boolean
Public patInsDispVisible As Boolean
Public claimDispDirty As Boolean
'eDrIO.DLL declares
Declare Sub PIBSINIT Lib "edrio.dll" (pc As pcT)
Declare Sub PIBSEXIT Lib "edrio.dll" (pc As pcT)
Declare Sub acctIO Lib "edrio.dll" Alias "ACCTIO" (pc As pcT, ar As arT)
Declare Sub ANOTIO Lib "edrio.dll" (pc As pcT, an As anT)
Declare Sub ATYPIO Lib "edrio.dll" (pc As pcT, at As atT)
Declare Sub CLAIMIO Lib "edrio.dll" (pc As pcT, cl As clT)
Declare Sub CLMHIO Lib "edrio.dll" (pc As pcT, ch As chT)
Declare Sub CODEIO Lib "edrio.dll" (pc As pcT, co As coT)
Declare Sub CREDIO Lib "edrio.dll" (pc As pcT, cr As crT)
Declare Sub CRSPIO Lib "edrio.dll" (pc As pcT, crS As crST)
Declare Sub CUSTIO Lib "edrio.dll" (pc As pcT, cu As cuT)
Declare Sub DEBITIO Lib "edrio.dll" (pc As pcT, db As dbT)
Declare Sub DXIO Lib "edrio.dll" (pc As pcT, dx As dxT)
Declare Sub EMCHIO Lib "edrio.dll" (pc As pcT, eh As ehT)
Declare Sub INSCIO Lib "edrio.dll" (pc As pcT, ic As icT)
Declare Sub INSEXTIO Lib "edrio.dll" (pc As pcT, ix As ixT)
Declare Sub MPROCIO Lib "edrio.dll" (pc As pcT, prM As prMT) 'Proc Macro IO
Declare Sub NAMEIO Lib "edrio.dll" (pc As pcT, nr As nrT)
Declare Sub PATIO Lib "edrio.dll" (pc As pcT, pr As prt)
Declare Sub PATIIO Lib "edrio.dll" (pc As pcT, pi As piT)
Declare Sub PATLSTIO Lib "edrio.dll" (pc As pcT, patList As patListT)
Declare Sub PLACEIO Lib "edrio.dll" (pc As pcT, pl As plT) 'Place of Service
Declare Sub PROCIO Lib "edrio.dll" (pc As pcT, prr As prrT) 'Procedure IO
Declare Sub PROVIO Lib "edrio.dll" (pc As pcT, po As poT) 'Procedure IO
Declare Sub REFDRIO Lib "edrio.dll" (pc As pcT, rd As rdT) 'Referring DR IO
Declare Sub STMTHIO Lib "edrio.dll" (pc As pcT, sh As shT) 'statement hist
IO
Declare Sub ZIPIO Lib "edrio.dll" (pc As pcT, zipCode As zipT)
Declare Sub DEBPOST Lib "edrio.dll" (pc As pcT, dbA As dbAT, ar As arT, at
As atT, pr As prt, cl As clT, db As dbT)
Declare Sub CLMPRTT Lib "edrio.dll" (pc As pcT, clmPrcsArea As clmPrcsAreaT,
clmPrtArea As clmPrtAreaT, ar As arT, pr As prt, at As atT, cl As clT)
Declare Sub PMTPOST Lib "edrio.dll" (pc As pcT, pmtA As pmtAT, ar As arT, at
As atT, pr As prt, cl As clT, db As dbT)
Declare Sub STMTPRCS Lib "edrio.dll" (pc As pcT, ar As arT, stmtArea As
stmtAreaT, at As atT)
Declare Sub STMTPRT Lib "edrio.dll" (pc As pcT, ar As arT, stmtArea As
stmtAreaT, sh As shT, at As atT, stmtPrtArea As stmtPrtAreaT)
Declare Sub REMPOST Lib "edrio.dll" (pc As pcT, remArea As remAreaT, ar As
arT, at As atT, cl As clT, pr As prt)
Declare Function Exist% Lib "QPRO32.DLL" (ByVal fileName$)
Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA"
(ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As
String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
Declare Function GetPrivateProfileString Lib "kernel32" Alias
"GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal
lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As
String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Declare Function WritePrivateProfileString Lib "kernel32" Alias
"WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal
lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
'Setup fnAV helper function
Const G_MAX_ARRAYDIMS = 60 'VB limit on array dimensions
Type tagAV 'Array and Vector in 1 compact unit
PPSA As Long 'Address of pointer to SAFEARRAY
NumDims As Long 'Number of dimensions
SCode As Long 'Error info
Flags As Long 'Reserved
Subscripts(1 To G_MAX_ARRAYDIMS) As Long 'rgIndices Vector
End Type
Declare Function fnAV Lib "QPRO32.DLL" (ByRef A() As Any, ParamArray
SubscriptsVector()) As tagAV
Declare Sub SortStr Lib "QPRO32.DLL" (ByRef AV As tagAV, ByVal NumEls As
Long, ByVal Direction As Long)
Declare Sub ExitProcess Lib "kernel32" (ByVal uExitCode As Long)
Function mdycFmtTo(inDate As String) As String
'ccyymmdd to mm/dd/ccyy
If IsNumeric(Mid$(inDate, 1, 8)) Then
mdycFmtTo = Mid$(inDate, 5, 2) & "/" & Mid$(inDate, 7, 2) & "/" &
Mid$(inDate, 1, 4)
Else
mdycFmtTo = ""
End If
End Function
Function mdyFmtFrom(dateIn As String) As String
'mm/dd - /yy or /ccyy to ccyymmdd
Dim dateHld As String
Dim i As Integer
Dim j As Integer
Dim n As Integer
'Get rid of any "/" in date
If InStr(1, dateIn, "/") Then
i = InStr(1, dateIn, "/") - 1
j = i + 2
n = Len(dateIn) - j + 1
dateHld = Mid$(dateIn, 1, i) & Mid$(dateIn, j, n)
If InStr(1, dateHld, "/") Then
i = InStr(1, dateHld, "/") - 1
j = i + 2
n = Len(dateHld) - j + 1
dateHld = Mid$(dateHld, 1, i) & Mid$(dateHld, j, n)
End If
Else
dateHld = dateIn
End If
If IsNumeric(dateHld) Then
i = Len(dateHld)
If i = 8 Then
mdyFmtFrom = Mid$(dateHld, 7, 2) & Mid$(dateHld, 5, 2) & Mid$(dateHld,
1, 2) & Mid$(dateHld, 3, 2)
ElseIf i = 6 Then
If CInt(Mid$(dateHld, 5, 2)) < 30 Then
mdyFmtFrom = "20"
Else
mdyFmtFrom = "19"
End If
mdyFmtFrom = mdyFmtFrom & Mid$(dateHld, 5, 2) & Mid$(dateHld, 1, 2) &
Mid$(dateHld, 3, 2)
ElseIf i = 4 Then
mdyFmtFrom = Format$(date, "yyyy")
mdyFmtFrom = mdyFmtFrom & Mid$(dateHld, 1, 2) & Mid$(dateHld, 3, 2)
Else
mdyFmtFrom = ""
End If
End If
End Function
Public Function mdyFmtTo(inDate As String) As String
'ccyymmdd to mm/dd/yy
If IsNumeric(Mid$(inDate, 1, 8)) Then
mdyFmtTo = Mid$(inDate, 5, 2) & "/" & Mid$(inDate, 7, 2) & "/" &
Mid$(inDate, 3, 2)
Else
mdyFmtTo = ""
End If
End Function
"Peter Below (TeamB)" <none> wrote in message
news:xn0er7wn...@newsgroups.borland.com...
Iman L Crawford
@newsgroups.borland.com:
> I also tried changing the arry from array[0..SOMENUMBER] to
> array[1..SOMENUMBER]
> and got type errors.'Incompatible type array and char
Peter mentioned they need to bee array of widechar.
Also it would be clearer if the one character strings where just
WideChar without an array.
--
Iman
Stephen K. Miyasato
these getting errors.
pc.mibsFlg := 'Y' ; // <== incompatible type array and string
pc.err := '000'; <== incompatible type array and string
Once again,
Thanks for the help
Stephen K. Miyasato
MDsync
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
pcT = packed record //PIBS Comm
ver : array[1..6]of widechar; //6
verDate : array[1..8]of widechar ;//8
prog : array[1..32]of widechar ; //32
err : array[1..3]of widechar; //3
first : widechar; //1first Call
mibsFlg : widechar; //1 y MIBS is present N = no
initFlg : widechar; //1 y means initialized new files
rand : integer ; //random number
filSt : array[1..5]of widechar ; //5
f1 : widechar ; //1
date : array[1..8]of widechar ; //8 char
time : array[1..4]of widechar ; //4
fCmd : array[1..2]of widechar ; //2 File command
fName: array[1..24]of widechar ; //24 file name
nAcct : array[1..10]of widechar ; //10 Next account number
nPat : array[1..10]of widechar ; //10 next pat number
debug : array[1..2]of widechar ; //2 debug flag
lCls : array[1..8]of widechar ; //8 last closed date
qName : array[1..24]of widechar ; //24 query com are name
qAcct : array[1..12]of widechar ; //12 Account Number (num & type)
qPat : array[1..10]of widechar ; //10 pat Number
qClm : array[1..4]of widechar ; //4 claim number
qcurTyp : widechar; //1 Current account type index
qCmd : widechar ; //1 command
qCmdS : widechar ; //1 sub command
qFunc : widechar ; //1 function
qMod : widechar ; //1 mode
qFuncS : widechar ; //1 sub function
f2 : array[1..8]of widechar; //8 Flags to be later enumerated
pmtDate : array[1..8]of widechar; //8 payment date
chgDate : array[1..8]of widechar; //8 charge date
msg : array[1..54]of widechar ; //54 msg line
f3 : array[1..60]of widechar ; //60 function key defn
paths : array[1..960]of widechar ; //960 file paths
// file open flags
accctOpen : widechar;// 1
aTypOpen : widechar; // 1
claimOpen : widechar;// 1
open : array[1..77]of widechar; // 77 file open flag
f4 : array[1..72]of widechar ; // 72 filler
apptLogN: array[1..24]of widechar; // 24 appt log file name
f5 : array[1..34]of widechar ; // 34 filler
end;
type
nrT = packed record //Name record
Name : array[1..24]of widechar ; //24 last,first m, tittle
acct : array[1..10]of widechar; //10
pat : array[1..10]of widechar ; //10
bir : array[1..8]of widechar ; //8 birth ccyymmdd
reg : array[1..6]of widechar ; //6 registration date
sex : widechar ; //1
st : widechar ; //1 status
loc : array[1..7]of widechar ; //8 location
end;
type
cuT = packed record //Customer record
Name : array[1..24]of widechar ;
addr1 : array[1..24]of widechar ;
addr2 : array[1..24]of widechar ;
city : array[1..20]of widechar ;
state : widechar ;
zip : array[1..10]of widechar ;
phone : array[1..10]of widechar ;
fill : array[1..50]of widechar ;
acctNumLen : widechar ;
patNumLen : widechar ;
acctNumNext : array[1..10]of widechar ;
patNumNext : array[1..10]of widechar ;
acctNumChk : widechar ;
acctNumeric: widechar ;
patNumChk : widechar ;
patNumeric: widechar ;
acctNumAuto: widechar ;
patNumAuto : widechar ;
fil5 : widechar ;
filePaths : array[1..720]of widechar ;
fil6 : widechar ;
datelastDayRpt : array[1..8]of widechar ; // not used
fil2 : array[1..17]of widechar ;
dayRptByDr : widechar ;
fil3 : array[1..144]of widechar ;
stmtRefNext : array[1..8]of widechar ; //Next stmt reference number
acctNumIncre : widechar ;
patNumIncre : widechar ;
fil4 : array[1..3]of widechar ;
fiscalYr : array[1..8]of widechar ; //fiscal year, next
dateLastUsed :array[1..8]of widechar ; //date system last used
fil7 : widechar ; //
implementation
except
on E : Exception do
begin
ShowMessage('Exception class name = '+E.ClassName);
ShowMessage('Exception message = '+E.Message);
end;
end;
//iLen := length(pc); ..get error incompatible type
pc.date := '20060912' ;
pc.chgDate := pc.chgDate ;
pc.pmtDate := pc.pmtDate ;
pc.err := '000' ;
CUSTIO(pc, cu);
// initialize the flags and variables
end;
end.
"Iman L Crawford" <ilcrawford.at.hotmail.dot.com> wrote in message
news:Xns983F6F854...@207.105.83.66...
Iman L Crawford
> be these getting errors.
my apologies. I misread Peter's suggestion. array of char is what you
need, then use move to fill the array;
// You may want to first blank out your record
fillchar(pc, sizeof(pcT), 0);
// the following strange syntax is due to bypassing
// delphi's internal handling of strings
move('000'[1], pc.err, length('000'));
--
Iman
Stephen K. Miyasato
PIBSINIT(pc); // initialize MIBS <== AccessViolation
Don't know if I'm doing this right the the pc.fname variable does not show
the correct values
move('C:\MIBS5\'[9], pc.fName, Length('C:\MIBS5\'));
Stephen K. Miyasato
MDsync
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
pcT = packed record //PIBS Comm
ver : array[1..6]of char; //6
verDate : array[1..8]of char ;//8
prog : array[1..32]of char ; //32
err : array[1..3]of char; //3
first : char; //1first Call
mibsFlg : char; //1 y MIBS is present N = no
initFlg : char; //1 y means initialized new files
rand : integer ; //random number
filSt : array[1..5]of char ; //5
f1 : char ; //1
date : array[1..8]of char ; //8 char
time : array[1..4]of char ; //4
fCmd : array[1..2]of char ; //2 File command
fName: array[1..24]of char ; //24 file name
nAcct : array[1..10]of char ; //10 Next account number
nPat : array[1..10]of char ; //10 next pat number
debug : array[1..2]of char ; //2 debug flag
lCls : array[1..8]of char ; //8 last closed date
qName : array[1..24]of char ; //24 query com are name
qAcct : array[1..12]of char ; //12 Account Number (num & type)
qPat : array[1..10]of char ; //10 pat Number
qClm : array[1..4]of char ; //4 claim number
qcurTyp : char; //1 Current account type index
qCmd : char ; //1 command
qCmdS : char ; //1 sub command
qFunc : char ; //1 function
qMod : char ; //1 mode
qFuncS : char ; //1 sub function
f2 : array[1..8]of char; //8 Flags to be later enumerated
pmtDate : array[1..8]of char; //8 payment date
chgDate : array[1..8]of char; //8 charge date
msg : array[1..54]of char ; //54 msg line
f3 : array[1..60]of char ; //60 function key defn
paths : array[1..960]of char ; //960 file paths
// file open flags
accctOpen : char;// 1
aTypOpen : char; // 1
claimOpen : char;// 1
open : array[1..77]of char; // 77 file open flag
f4 : array[1..72]of char ; // 72 filler
apptLogN: array[1..24]of char; // 24 appt log file name
f5 : array[1..34]of char ; // 34 filler
end;
type
nrT = packed record //Name record
Name : array[1..24]of char ; //24 last,first m, tittle
acct : array[1..10]of char; //10
pat : array[1..10]of char ; //10
bir : array[1..8]of char ; //8 birth ccyymmdd
reg : array[1..6]of char ; //6 registration date
sex : char ; //1
st : char ; //1 status
loc : array[1..8]of char ; //8 location
end;
type
cuT = packed record //Customer record
Name : array[1..24]of char ; //24
addr1 : array[1..24]of char ; //24
addr2 : array[1..24]of char ; //24
city : array[1..20]of char ; //20
state : array[1..2]of char ; //2
zip : array[1..10]of char ; //10
phone : array[1..10]of char ; //10
fill : array[1..50]of char ; //50
acctNumLen : array[1..2]of char ; //2
patNumLen : array[1..2]of char ; //2
acctNumNext : array[1..10]of char ;//10
patNumNext : array[1..10]of char ; //10
acctNumChk : char ; //1
acctNumeric: char ; //1
patNumChk : char ; //1
patNumeric: char ; //1
acctNumAuto: char ; //1
patNumAuto : char ; //1
fil5 : char ; //2
filePaths : array[1..720]of char ;//720
fil6 : array[1..2]of char ; // 2
datelastDayRpt : array[1..8]of char ; //8 not used
fil2 : array[1..17]of char ;//17
dayRptByDr : char ; // 1
fil3 : array[1..144]of char ;//144?15
stmtRefNext : array[1..8]of char ; //8 Next stmt reference number
acctNumIncre :array[1..2]of char ; //2
patNumIncre :array[1..2]of char ; //2
fil4 : array[1..3]of char ; //3
fiscalYr : array[1..8]of char ; //8 fiscal year, next
dateLastUsed :array[1..8]of char ; //8 date system last used
fil7 : char ; //1
end;
type
TForm1 = class(TForm)
Button1: TButton;
implementation
//pc.fName := 'C:\MIBS5\' ;
move('C:\MIBS5\'[9], pc.fName, Length('C:\MIBS5\'));
//call PIBSINIT
try
PIBSINIT(pc); // initialize MIBS <== program exits here
Iain Macmillan
----------
In article <450b...@newsgroups.borland.com>, "Stephen K. Miyasato"
<miy...@flex.com> wrote:
> Latest change does not seem to work. I'm getting AC with the call to
> PIBSINIT(pc); // initialize MIBS <== AccessViolation
It might help to declare an extra, fairly big filler at the end of the
record.
That way, if the AV is because the record is too small because of some
transcription error elsewhere, it will have somewhere legal to put the extra
data. (If the AV continues, I'd suspect I was barking up the wrong tree here
though)
> Don't know if I'm doing this right the the pc.fname variable does not show
> the correct values
Are you saying that some variables that occur before the fname *are* being
retrieved correctly?
If so a study of where things started going wrong and just how far the
retrieved characters are out of position might be revealing..
> //iLen := length(pc); ..get error incompatible type
.. of course you'll need to get the declaration right and remove the 'extra
filler' I suggested above, before this will work, but having done that, the
call you need to find the number of bytes in a record is to sizeof(pc);
Stephen K. Miyasato
"Iain Macmillan" <he...@ariesps.co.uk> wrote in message
news:450b...@newsgroups.borland.com...
>
>
> ----------
> In article <450b...@newsgroups.borland.com>, "Stephen K. Miyasato"
> <miy...@flex.com> wrote:
>
>
>> Latest change does not seem to work. I'm getting AC with the call to
>> PIBSINIT(pc); // initialize MIBS <== AccessViolation
> It might help to declare an extra, fairly big filler at the end of the
> record.
Tried that and it does not work
> That way, if the AV is because the record is too small because of some
> transcription error elsewhere, it will have somewhere legal to put the
> extra
> data. (If the AV continues, I'd suspect I was barking up the wrong tree
> here
> though)
>
>
>> Don't know if I'm doing this right the the pc.fname variable does not
>> show
>> the correct values
>
> Are you saying that some variables that occur before the fname *are* being
> retrieved correctly?
> If so a study of where things started going wrong and just how far the
> retrieved characters are out of position might be revealing..
Sorry, Nothing before the call makes sense
>
>> //iLen := length(pc); ..get error incompatible type
>
> .. of course you'll need to get the declaration right and remove the
> 'extra
> filler' I suggested above, before this will work, but having done that,
> the
> call you need to find the number of bytes in a record is to sizeof(pc);
This is another attemp to call the dll w/o sucess;
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
pPCT= ^pcT;
pcT = packed record //PIBS Comm
ver : array[0..5]of char; //6
verDate : array[0..7]of char ;//8
prog : array[0..31]of char ; //32
err : array[0..2]of char; //3
first : char; //1first Call
mibsFlg : char; //1 y MIBS is present N = no
initFlg : char; //1 y means initialized new files
rand : integer ; //random number
filSt : array[0..4]of char ; //5
f1 : char ; //1
date : array[0..7]of char ; //8 char
time : array[0..3]of char ; //4
fCmd : array[0..1]of char ; //2 File command
fName: array[0..23]of char ; //24 file name
nAcct : array[0..9]of char ; //10 Next account number
nPat : array[0..9]of char ; //10 next pat number
debug : array[0..1]of char ; //2 debug flag
lCls : array[0..7]of char ; //8 last closed date
qName : array[0..23]of char ; //24 query com are name
qAcct : array[0..11]of char ; //12 Account Number (num & type)
qPat : array[0..9]of char ; //10 pat Number
qClm : array[0..3]of char ; //4 claim number
qcurTyp : char; //1 Current account type index
qCmd : char ; //1 command
qCmdS : char ; //1 sub command
qFunc : char ; //1 function
qMod : char ; //1 mode
qFuncS : char ; //1 sub function
f2 : array[0..7]of char; //8 Flags to be later enumerated
pmtDate : array[0..7]of char; //8 payment date
chgDate : array[0..7]of char; //8 charge date
msg : array[0..53]of char ; //54 msg line
f3 : array[0..59]of char ; //60 function key defn
paths : array[0..959]of char ; //960 file paths
// file open flags
accctOpen : char;// 1
aTypOpen : char; // 1
claimOpen : char;// 1
open : array[0..76]of char; // 77 file open flag
f4 : array[0..71]of char ; // 72 filler
apptLogN: array[0..23]of char; // 24 appt log file name
f5 : array[0..33]of char ; // 34 filler
f6 : array[0..7000]of char ; // filler skm filler
end;
type
PnrT = ^nrT;
nrT = packed record //Name record
Name : array[0..24]of char ; //24 last,first m, tittle
acct : array[0..10]of char; //10
pat : array[0..10]of char ; //10
bir : array[0..8]of char ; //8 birth ccyymmdd
reg : array[0..6]of char ; //6 registration date
sex : char ; //1
st : char ; //1 status
loc : array[0..8]of char ; //8 location
end;
type
PcuT = ^cuT;
implementation
pc.fName := 'C:\MIBS5\' ;
//call PIBSINIT
try
PIBSINIT(pc); // initialize MIBS <== program exits here
except
on E : Exception do
begin
ShowMessage('Exception class name = '+E.ClassName);
ShowMessage('Exception message = '+E.Message);
end;
end;
//iLen := length(pc); //..get error incompatible type
Peter Below (TeamB)
> Latest change does not seem to work. I'm getting AC with the call to
> PIBSINIT(pc); // initialize MIBS <== AccessViolation
> Don't know if I'm doing this right the the pc.fname variable does not
> show the correct values
>
> move('C:\MIBS5\'[9], pc.fName, Length('C:\MIBS5\'));
procedure AssignFixedString( Var FixedStr: Array of Char; Const S:
String );
var
maxlen: Integer;
begin
maxlen := Succ( High( FixedStr ) - Low( FixedStr ));
FillChar( FixedStr, maxlen, ' ' ); { blank fixed string }
if Length(S) > maxlen then
Move( S[1], FixedStr, maxlen )
else if S <> '' then
Move( S[1], FixedStr, Length(S));
end;
You can use this routine to copy a string to one of these array of char
fields. Usage would be
AssignFixedString(pc.fName, 'C:\MIBS5\);
> type
> pcT = packed record //PIBS Comm
> ver : array[1..6]of char; //6
This is not correct. If the original VB UDT had ver as a string*6 field
it would consume 12 bytes (6 widechars). To get the same layout your
would need to declare the field as array [1..12] of char.
I was unable to find any definitive information about the details of
how VB passes UDTs containing fixed-length string fields to a DLL. The
only fairly sure fact is that the strings get translated to ANSI. I
assume that to happen "in place", in the space allocated for the
Unicode characters, but that is just a guess. If you have a VB6
installation or know somebody who has, search for a file named
VB6DLL.txt. There used to be such a file on older versions (VB4DLL.txt
with VB4, for example), and it describes how to pass VB stuff to API
DLLs.
> verDate : array[1..8]of char ;//8
> prog : array[1..32]of char ; //32
> err : array[1..3]of char; //3
> first : char; //1first Call
> mibsFlg : char; //1 y MIBS is present N = no
> initFlg : char; //1 y means initialized new files
> rand : integer ; //random number
Keep in mind that a VB integer is a 2 byte integer, aka Delphi SmallInt.
Could you show the Cobol declaration of this data structure?
Stephen K. Miyasato
I'll try the above. Meanwhile here is the cobol code
L-----*!---!---!---!---!------------------!-----------!----------------!
IDENTIFICATION DIVISION.
PROGRAM-ID. PIBSINIT.
AUTHOR. William H. Liggett.
INSTALLATION. Honolulu, Hawaii.
******************************************************************
* *
* PIBSINIT.COB - read Customer file and initialize *
* pibs-comarea. Assumes Customer file is B:CUSTOMER.DAT. *
* *
******************************************************************
******************************************************************
* *
* (C) Copyright 1998 *
* Pacific Professional Management Systems, Inc. *
* All Rights Reserved *
* *
* Version Date Init Description *
* ------- -------- ---- -----------------------------------------*
* V01.00 03/06/84 whl Initial version. *
* V01.01 05/27/84 whl Add new files. *
* V01.02 06/29/84 whl New pibs-comarea. *
* V01.03 08/05/84 whl Add acct-note file. *
* V01.04 09/04/84 whl Add temp2 and temp3 files. *
* V02.8 03/23/85 whl Add emc-hold and encounter files. *
* V03.0 08/12/85 whl Add suspend flag. *
* V03.2 04/20/86 whl Add new files. *
* V03.3 08/15/86 whl General printer parameters in customer. *
* V04.0 02/07/91 whl New Customer, implement file paths. *
* V05.1 11/02/96 whl 4 digit year. *
* V06.2 03/08/98 whl Set random number stuff. *
******************************************************************
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
copy customer.cop.
copy setup.cop.
01 various-variables.
Rudy Velthuis [TeamB]
> Peter,
>
> I'll try the above. Meanwhile here is the cobol code
<snip>
Stephen, next time, it would be a good idea to zip the source up and post
it to the borland.public.attachments group. People who are still on
pay-per-minute dial-up might thank you for that.
--
Rudy Velthuis [TeamB] http://rvelthuis.de/
"A man can't be too careful in the choice of his enemies."
-- Oscar Wilde (1854-1900)
Q Correll
| Usage would be
|
| AssignFixedString(pc.fName, 'C:\MIBS5\);
That shouldn't compile. <giggle> Here's another ' .
(Please don't hit me. ;-)
--
Q
09/16/2006 15:22:04
XanaNews Version 1.17.5.7 [Q's salutation mod]
Kirk Halgren
news:4509...@newsgroups.borland.com...
I had no idea COBOL was capable of DLLs, although I had heard that they have
an OO version these days. I have a couple of years of that, at the
Brookings Institution from 30 something years ago (timeshare terminals
instead of card punches). I had forgotten how verbose the code is.
<SHUDDER>
--
Kirk Halgren
"There's no education in the second kick of a mule."
-- Sam Rayburn
Peter Below (TeamB)
> Peter,
>
> I'll try the above. Meanwhile here is the cobol code
-snip-
But there nothing in there I can see that describes this data structure.
> LINKAGE SECTION.
>
> copy pibscom.cop.
Perhaps it's in this pibscom.cop module. My knowledge of Cobol is near
nonexistent, though...
Dr John Stockton
Sep 2006 14:07:44 remote, seen in news:borland.public.delphi.language.de
lphi.general, Rudy Velthuis [TeamB] <newsg...@rvelthuis.de> posted :
>
>Stephen, next time, it would be a good idea to zip the source up and post
>it to the borland.public.attachments group. People who are still on
>pay-per-minute dial-up might thank you for that.
That was about 7500 bytes. Being COBOL, there's not much in it; it ZIPs
to 2000 bytes. Dial-up sends compressed data, perhaps not as well
compressed; it will have taken about a second to send. Cost thus of the
order of 100 micro-Euros?
And anyone on dial-up wanting to look at it would have had to mark it to
be fetched on the next suitable occasion (only rich dial-up users will
by default collect all of .attachments).
Your principle is excellent; but rather rigorously applied.
--
© John Stockton, Surrey, UK. ?@merlyn.demon.co.uk Delphi 3 Turnpike 4 ©
<URL:http://www.merlyn.demon.co.uk/> TP/BP/Delphi/&c., FAQqy topics & links;
<URL:http://www.bancoems.com/CompLangPascalDelphiMisc-MiniFAQ.htm> clpdmFAQ;
<URL:http://www.borland.com/newsgroups/guide.html> news:borland.* Guidelines
Rudy Velthuis [TeamB]
> JRS: In article <xn0erax2z000...@www.teamb.com>, dated Sat, 16
> Sep 2006 14:07:44 remote, seen in news:borland.public.delphi.language.de
> lphi.general, Rudy Velthuis [TeamB] <newsg...@rvelthuis.de> posted :
> >
> > Stephen, next time, it would be a good idea to zip the source up and
> > post it to the borland.public.attachments group. People who are still
> > on pay-per-minute dial-up might thank you for that.
>
> That was about 7500 bytes.
I only see a message of 180 lines.
--
Rudy Velthuis [TeamB] http://rvelthuis.de/
"Believe those who are seeking the truth. Doubt those who find
it." -- André Gide
Dennis Passmore
How about the 1569 lines when he replied to Peter on the 15th.
Rudy Velthuis [TeamB]
> > I only see a message of 180 lines.
>
> How about the 1569 lines when he replied to Peter on the 15th.
I must have missed that message. But you are right, that is even worse.
--
Rudy Velthuis [TeamB] http://rvelthuis.de/
"The music business is a cruel and shallow money trench, a long
plastic hallway where thieves and pimps run free, and good men
die like dogs. There's also a negative side".
-- Hunter S. Thompson
Iman L Crawford
@newsgroups.borland.com:
> move('C:\MIBS5\'[9], pc.fName, Length('C:\MIBS5\'));
move('c:\MIBS5'[1]
You will always use 1 to get the address of the first character. You
passed the address of the 9th character, which is 5, and you copied 9
bytes past the end of the string.
The biggest problem is you're showing a second level (VB) of indirection
to call the dll. We're all having to guess how the DLL function is
exported and how the records are laid out. Are there any examples of
using the DLL with C/C++?
--
Iman
Stephen K. Miyasato
I'm sorry about passing such a long message in the past. Can you show me
what the maximum message such that I won't do it in the future?
I'll have persons who are interested get the source from a download.
http://www.mdsync.net/download/delphi.zip
Calling a net Express COBOL DLL
http://supportline.microfocus.com/examplesandutilities/nesamp.asp
Examples from Microfocus Cobol.
http://www.mdsync.net/download/cncbl32b.zip
C calling Cobol and Cobol calling C
calling Cobol from VB
http://www.mdsync.net/download/vb-call-cobol.zip
I have already uploaded the edrio.dll.
http://www.mdsync.net/download/edrio.zip
My project, DLL, 1.8 meg. I still get errors on Loading the project. I
suspect the edrio.dll is no loading properly.
http://www.mdsync.net/download/DLL2.zip includes the DLLs
The compiler is Micro Focus Visual Object Cobol v1.0 for Windows 95.
I know nothing on Cobol programming. Any Help is very much appreciated.
Once again, let me know if I break any other rules on this forum as I have
gotten lots of needed help and very much appreciated all the advise.
Stephen K. Miyasato
"Rudy Velthuis [TeamB]" <newsg...@rvelthuis.de> wrote in message
news:xn0erd8w7000...@www.teamb.com...
John Herbster
> that I won't do it in the future?
Stephen, Long message or attachments, preferably in ZIP-files
are welcome in the borland.public.attachments newsgroup.
Regards, JohnH
Rudy Velthuis [TeamB]
> Rudy,
>
> I'm sorry about passing such a long message in the past. Can you show
> me what the maximum message such that I won't do it in the future?
There is no maximum, but just consider that those who are on
pay-per-minute dialup usually download all messages in one burst, and
then disconnect again. If a message is rather long, it will cost them
precious time, and it is not even clear they wanted to read it.
People on dialup usually appreciate messages that are not too long. Long
messages they only expect in .binaries or .attachments groups, where they
usually only download the headers, and only download the attachments they
care for (because someone refers to them in an article in a text
newsgroup).
If you keep that in mind, I'm sure you'll know what is the nicest thing
to do next time.
--
Rudy Velthuis [TeamB] http://rvelthuis.de/
"Raymond's Law of Software: Given a sufficiently large number of
eyeballs, all bugs are shallow." -- Eric S. Raymond
Iain Macmillan
----------
In article <xn0erbr4...@newsgroups.borland.com>, "Peter Below (TeamB)"
<none> wrote:
> Stephen K. Miyasato wrote:
>
>> Peter,
>>
>> I'll try the above. Meanwhile here is the cobol code
>
> -snip-
>
> But there nothing in there I can see that describes this data structure.
Nor anything that actually writes anything into a file.
>
>
>> LINKAGE SECTION.
>>
>> copy pibscom.cop.
Indeed, that may be where it writes the record.
The other .cop files mentioned in Working-storage _might_ be relevant too.
But if its going to write a file, the record definition of a file has to be
made.
That has to be done in the File Section.
The File Section in the quoted code is empty.
We need to find a non-empty File Section.
Also a non-empty File-Control paragraph in Input-Output section which
associates the File definition with the name of a physical file via a Select
clause..
> Perhaps it's in this pibscom.cop module.
Yes, hopefully it defines the pibs-comarea data item which gets passed to
some other subroutines.
Or perhaps pibscom just has a bunch more copy statements..
> My knowledge of Cobol is near
> nonexistent, though...
Oh well, copy = {$INCLUDE} , in case you hadn't guessed.
Call "xxx" using a.
means
invoke the code in source code called xxx.cbl passing it the parameter a
which is defined in the linkage section.
The rest of the the code just sets some data items.
It takes *much* more than 7500 bytes of cobol to do anything remotely
useful. <g>
Stephen K. Miyasato
> exported and how the records are laid out. Are there any examples of
> using the DLL with C/C++?
I found this delphi example
It seem to use C calling parameters?
I have a link on my previous messages.
Stephen K. Miyasato
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Label2: TLabel;
GroupBox1: TGroupBox;
Edit2: TEdit;
Label3: TLabel;
Label5: TLabel;
Edit4: TEdit;
Edit5: TEdit;
Label6: TLabel;
GroupBox2: TGroupBox;
Label4: TLabel;
Label7: TLabel;
Label8: TLabel;
Button2: TButton;
Button3: TButton;
Label1: TLabel;
Label9: TLabel;
Label10: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
procedure callcobol(var a : LongInt ; var b : Double ; var c : pchar ;
var aout :LongInt ; var bout : double ; var cout :
pchar); cdecl ;external 'cobdll.dll' name 'cobdllentry';
var InInteger , OutInteger : LongInt ;
InDouble , OutDouble : double ;
InString , OutString : string[26];
aStrPtr : pstring;
InPChar , OutPchar : pChar ;
begin
// Setup the Inputs to the COBOL Routine
InInteger:=StrToInt(Form1.Edit2.Text);
InDouble:=StrToFloat(Form1.Edit4.Text);
InString:=Form1.Edit5.Text;
InPchar:=@InString[1];
// Reset the Outputs
OutInteger:=0; OutDouble:=0 ; OutString:=InString ;
OutPchar:=@OutString[1];
// Call the COBOL DLL
callcobol(InInteger , InDouble , InPChar , OutInteger , OutDouble ,
OutPChar );
// Set the Return values on the Form
Form1.Label1.Caption:=IntToStr(OutInteger);
Form1.Label9.Caption:=FloatToStr(OutDouble);
Form1.Label10.Caption:=OutString;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Form1.Label1.Caption:='';
Form1.Label9.Caption:='';
Form1.Label10.Caption:='';
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
Application.Terminate
end;
end.
Iman L Crawford
@newsgroups.borland.com:
> I found this delphi example
> It seem to use C calling parameters?
> I have a link on my previous messages.
I saw that. I think that is because the cobol dll describes the calling
convention as C. I don't think I can offer much more help. It appears
you need to do the following.
1. Use array of char and move the chars like Peter showed.
2. Pass the parameters by reference. It may not be by reference, but
the cobol manual should explain when it is and when it is not.
3. Find out the calling convention of the the cobol function. This
appears to be some type of directive at the top of the file. If there
is no directive you need to hunt down the manual and see what the
default is.
4. Read what Ian posted about missing file sections. Not all of the
cobol code that is needed is there.
good luck.
--
Iman
Dr John Stockton
Sep 2006 15:23:35 remote, seen in news:borland.public.delphi.language.de
lphi.general, Rudy Velthuis [TeamB] <newsg...@rvelthuis.de> posted :
>At 12:56:29, 17.09.2006, Dr John Stockton wrote:
>
>> JRS: In article <xn0erax2z000...@www.teamb.com>, dated Sat, 16
>> Sep 2006 14:07:44 remote, seen in news:borland.public.delphi.language.de
>> lphi.general, Rudy Velthuis [TeamB] <newsg...@rvelthuis.de> posted :
>> >
>> > Stephen, next time, it would be a good idea to zip the source up and
>> > post it to the borland.public.attachments group. People who are still
>> > on pay-per-minute dial-up might thank you for that.
>>
>> That was about 7500 bytes.
>
>I only see a message of 180 lines.
That's what the header says (it does not include the header size).
One can easily determine the byte-count by exporting from News to local
disc (if the news-reader is any good), and then the compressed size with
a ZIP tool.
--
© John Stockton, Surrey, UK. ?@merlyn.demon.co.uk Turnpike v4.00 MIME. ©
Web <URL:http://www.merlyn.demon.co.uk/> - FAQish topics, acronyms, & links.
For news:borland.*, use their server newsgroups.borland.com ; but first read
Guidelines <URL:http://www.borland.com/newsgroups/guide.html> ff. with care.
Iain Macmillan
----------
In article <4510275c$1...@newsgroups.borland.com>, "Stephen K. Miyasato"
<miy...@flex.com> wrote:
> I found this delphi example
> It seem to use C calling parameters?
Yes, it looks like you might perhaps get better results with cdecl instead
of stdcall.
It's worth a try anyway.
But it still could be that the data layout is not right, can't be sure of
that without tracking down the proper definition of it.. which should also
resove the issue of whether it is writing multibyte chars or not.
Stephen K. Miyasato
I think I may have found the file defn. it is on my site
www.mdsync.net/download/pibscom.zip
1.2 K
I also found this example
www.mdsync.net/download/mname.zip 457 K.
Thanks for the help again.
Stephen K. Miyasato
"Iain Macmillan" <he...@ariesps.co.uk> wrote in message
news:4510...@newsgroups.borland.com...
Stephen K. Miyasato
do the name have to match?
For instance the declaration is
pcT = packed record //PIBS Comm
ver : array[0..11]of char; //6
verDate : array[0..15]of char ;//8
prog : array[0..63]of char ; //32
err : array[0..5]of char; //3
first : array[0..1]of char; //1first Call
See below for code?
What about the 05,07 region?
There is also a .NET DLL in the mname.zip that I have uploaded.
Thanks for the help.
Stephen K. Miyasato
pibscom.cbl
01 pibs-comarea.
03 pc-version pic x(06).
03 pc-version-date pic x(08).
03 pc-program-name pic x(32).
03 pc-error-code pic x(03).
03 pc-first-call-flag pic x(01).
03 pc-mibs pic x(01).
03 pc-init-flag pic x(01).
03 pc-filst.
05 pc-file-status.
07 pc-fs1 pic x(01).
07 pc-fs2 pic x(01).
05 pc-fsx pic x(03).
03 filler pic x(01).
03 pc-cdate.
05 pc-cen pic x(02).
05 pc-date.
07 pc-year pic x(02).
07 pc-month pic x(02).
07 pc-day pic x(02).
03 pc-start-time pic x(04).
03 pc-file-cmd pic x(02).
03 pc-file-name pic x(24).
03 pc-next-acct-num pic x(10).
03 pc-next-pat-num pic x(10).
03 pc-debug pic x(02).
03 pc-last-closed-date pic x(08).
03 query-comarea.
05 qc-name pic x(24).
05 qc-acct-number.
07 qc-acct-num pic x(10).
07 qc-acct-type pic x(02).
05 qc-pat-num pic x(10).
05 qc-claim-num pic x(04).
05 qc-curr-type pic x(01).
05 qc-cmd pic x(01).
05 qc-sub-cmd pic x(01).
05 qc-function pic x(01).
05 qc-mode pic x(01).
05 qc-sub-function pic x(01).
03 qc-claim-num-arc pic x(01).
03 qc-claim-order pic x(01).
03 qc-claim-fmt pic x(01).
03 qc-trans-order pic x(01).
03 qc-trans-fmt pic x(01).
03 qc-claim-archive pic x(01).
03 qc-trans-archive pic x(01).
03 filler pic x(01).
03 pc-pmt-date pic x(08).
03 pc-chg-date pic x(08).
03 pv-msg-line pic x(54).
03 function-key-definitions.
05 fkey-1 pic x(06).
05 fkey-2 pic x(06).
05 fkey-3 pic x(06).
05 fkey-4 pic x(06).
05 fkey-5 pic x(06).
05 fkey-6 pic x(06).
05 fkey-7 pic x(06).
05 fkey-8 pic x(06).
05 fkey-9 pic x(06).
05 fkey-10 pic x(06).
03 mibs-dir pic x(36).
03 mibs-ws-dir pic x(36).
03 mibs-arc pic x(36).
03 hip-up-dir pic x(36).
03 hip-rem-dir pic x(36).
03 filler pic x(36).
03 pc-file-open-flags.
05 acct-open-flag pic x(01).
05 acct-type-open-flag pic x(01).
05 claim-open-flag pic x(01).
05 codes-open-flag pic x(01).
05 credit-open-flag pic x(01).
05 customer-open-flag pic x(01).
05 debit-open-flag pic x(01).
05 dept-open-flag pic x(01).
05 dx-open-flag pic x(01).
05 error-open-flag pic x(01).
05 ins-company-open-flag pic x(01).
05 names-open-flag pic x(01).
05 pat-open-flag pic x(01).
05 place-open-flag pic x(01).
05 proc-open-flag pic x(01).
05 provider-open-flag pic x(01).
05 refer-dr-open-flag pic x(01).
05 stmt-msg-open-flag pic x(01).
05 zip-code-open-flag pic x(01).
05 temp1-open-flag pic x(01).
05 claim-hold-open-flag pic x(01).
05 day-stat-open-flag pic x(01).
05 day-hist-open-flag pic x(01).
05 cycle-open-flag pic x(01).
05 acct-note-open-flag pic x(01).
05 temp2-open-flag pic x(01).
05 temp3-open-flag pic x(01).
05 emc-hold-open-flag pic x(01).
05 setup-open-flag pic x(01).
05 pat-ins-open-flag pic x(01).
05 recall-open-flag pic x(01).
05 collect-open-flag pic x(01).
05 reason-open-flag pic x(01).
05 dx-edit-open-flag pic x(01).
05 proc-edit-open-flag pic x(01).
05 macro-proc-open-flag pic x(01).
05 prob-temp-open-flag pic x(01).
05 rx-open-flag pic x(01).
05 pat-rx-open-flag pic x(01).
05 arc-open-flag pic x(01).
05 log-open-flag pic x(01).
05 arc-claim-open-flag pic x(01).
05 arc-debit-open-flag pic x(01).
05 arc-credit-open-flag pic x(01).
05 claim-susp-open-flag pic x(01).
05 stmt-hist-open-flag pic x(01).
05 credit-split-open-flag pic x(01).
05 tick-open-flag pic x(01).
05 text-macro-open-flag pic x(01).
05 deposit-open-flag pic x(01).
05 pmt-prof-open-flag pic x(01).
05 prob-open-flag pic x(12).
05 appt-sum-open-flag pic x(01).
05 appt-pat-open-flag pic x(01).
05 visit-open-flag pic x(01).
05 visit-code-open-flag pic x(01).
05 patx-open-flag pic x(01).
05 vital-open-flag pic x(01).
05 author-open-flag pic x(01).
05 cci-open-flag pic x(01).
05 dx-master-open-flag pic x(01).
05 proc-dx-open-flag pic x(01).
05 login-open-flag pic x(01).
05 appt-log-open-flag pic x(01).
05 hosp-pat-open-flag pic x(01).
05 ins-ext-open-flag pic x(01).
05 hip-sub-open-flag pic x(01).
05 filler pic x(13).
03 temp1-file-name pic x(36).
03 temp2-file-name pic x(36).
03 temp3-file-name pic x(36).
03 appt-log-name pic x(36).
03 lines-per-page pic x(02).
03 set-condensed-mode pic x(16).
03 cancel-condensed-mode pic x(16).
Iman L Crawford
@newsgroups.borland.com:
> I think this if the file defn flag.
> do the name have to match?
Only how the record is laid out matters. You can name it whatever you
want.
> What about the 05,07 region?
You can split those out as individual fields or combine them all under
one field as long as they describe same number of bytes in the same
order. If you notice all of the following describe the same number of
bytes.
03 pc-cdate.
05 pc-cen pic x(02).
05 pc-date.
07 pc-year pic x(02).
07 pc-month pic x(02).
07 pc-day pic x(02).
This could be
TMyRecord = packed record
pcDate: array[0..7] of char;
end;
or
TMyRecord = packed record
pcCen: array[0..1] of char;
pcDate: array[0..5] of char;
end;
or
TMyRecord = packed record
pcCen: array[0..1] of char;
pcYear: array[0..1] of char;
pcMonth: array[0..1] of char;
pcDay : array[0..1] of char;
end;
--
Iman
Iain Macmillan
----------
In article <4512241c$1...@newsgroups.borland.com>, "Stephen K. Miyasato"
<miy...@flex.com> wrote:
> I think this if the file defn flag.
> do the name have to match?
No.
They can't anyway, as the '-' is illegal in pascal.
> For instance the declaration is
>
> pcT = packed record //PIBS Comm
> ver : array[0..11]of char; //6
.. no, pic x(6) means 6 chars, don't see why you want to make it 12.
The definition looks as if it is what the VB code represented as far as
>> rand As Long 'random number
.. there's nothing in the cobol that corresponds to this field.
> What about the 05,07 region?
Don't worry about them.
Just check that fields which have a pic clause have the space in your pascal
packed record.
And luckily there's only plain simple pic x's with no qualifiers.
To me your first effort looks OK up to
>> paths : array[1..960]of char ; //960 file paths
.. now I only see 216 bytes here in the cobol (6 x 36).
(though the VB version also used 960 afaics)
After this, the last few fields don't seem to correspond at all well!
Sure this cobol source actually is the source for the DLL you are using? Not
an earlier version?
Stephen K. Miyasato
MicroFocus Cobol is using cdecl convention, i.e. in C++
extern "C" void __declspec(dllexport) MYFUNC(char * parm1, char * parm2,
...)
Hope it helps.
Stephen K. Miyasato
"Iain Macmillan" <he...@ariesps.co.uk> wrote in message
news:4513...@newsgroups.borland.com...
Peter Below (TeamB)
> This is from the Cobol newsgroup.
>
> MicroFocus Cobol is using cdecl convention, i.e. in C++
>
> extern "C" void __declspec(dllexport) MYFUNC(char * parm1, char *
> parm2, ...)
If the functions in question can be called from VB they have to use
stdcall calling convention, VB(6) does not handle any other.
Stephen K. Miyasato
had difficulties trying to access the managed code hense I wish to try using
the this other dll that was made from object cobol. The code below is from
the soure I found in Cobol for .NET.
Below that I have the delphi code that does not load the DLL. It give access
violations on load. I believe no runtime is required.
You can download the DLL from the link below;
http://www.mdsync.net/download/MIBSIO.zip
Thanks
Stephen K. Miyasato
******************************************************************
* *
* PIBSCOM.COP - COMMON AREA FOR PIBS SUBROUTINES. *
* *
* (C) Copyright 2005 *
* netMIBS, LLC *
* All Rights Reserved *
* *
* VERSION DATE INIT DESCRIPTION *
* ------- -------- ---- -----------------------------------------*
* V02.1 02/23/05 WHL netMIBS initial version. *
******************************************************************
01 PIBS-COMAREA.
03 PC-VERSION PIC X(06).
03 PC-VERSION-DATE PIC X(08).
03 PC-PROGRAM-NAME PIC X(32).
03 PC-ERROR-CODE PIC X(03).
03 pc-first-call-flag PIC X(01).
03 pc-mibs PIC X(01).
03 pc-init-flag pic x(01).
03 pc-filSt.
05 PC-FILE-STATUS.
07 pc-fs1 PIC X(01).
07 pc-fs2 PIC X(01).
05 pc-fsx pic x(03).
03 filler pic x(01).
03 pc-cdate.
05 pc-cen pic x(02).
05 pc-date.
07 pc-year pic x(02).
07 pc-month pic x(02).
07 pc-day pic x(02).
03 PC-START-TIME PIC X(04).
03 PC-FILE-CMD PIC 9(02).
03 PC-FILE-NAME PIC X(24).
03 PC-NEXT-ACCT-NUM PIC X(10).
03 PC-NEXT-PAT-NUM PIC X(10).
03 pc-debug PIC X(02).
03 pc-last-closed-date pic x(08).
03 query-comarea.
05 qc-name pic x(24).
05 qc-acct-number.
07 qc-acct-num pic x(10).
07 qc-acct-type pic x(02).
05 qc-pat-num pic x(10).
05 qc-claim-num pic x(04).
05 qc-curr-type pic 9(01).
05 qc-cmd pic x(01).
05 qc-sub-cmd pic x(01).
05 qc-function pic x(01).
05 qc-mode pic x(01).
05 qc-sub-function pic x(01).
03 qc-claim-num-arc pic x(01).
03 qc-claim-order pic x(01).
03 qc-claim-fmt pic x(01).
03 qc-trans-order pic x(01).
03 qc-trans-fmt pic x(01).
03 qc-claim-archive pic x(01).
03 qc-trans-archive pic x(01).
03 filler pic x(01).
03 pc-pmt-date pic x(08).
03 pc-chg-date pic x(08).
03 PV-MSG-LINE PIC X(54).
03 FUNCTION-KEY-DEFINITIONS.
05 FKEY-1 PIC X(06).
05 FKEY-2 PIC X(06).
05 FKEY-3 PIC X(06).
05 FKEY-4 PIC X(06).
05 FKEY-5 PIC X(06).
05 FKEY-6 PIC X(06).
05 FKEY-7 PIC X(06).
05 FKEY-8 PIC X(06).
05 FKEY-9 PIC X(06).
05 FKEY-10 PIC X(06).
03 mibs-dir pic x(36).
03 mibs-ws-dir pic x(36).
03 mibs-arc pic x(36).
03 hip-up-dir pic x(36).
03 hip-rem-dir pic x(36).
03 filler pic x(36).
03 PC-FILE-OPEN-FLAGS.
05 ACCT-OPEN-FLAG PIC X(01).
05 ACCT-TYPE-OPEN-FLAG PIC X(01).
05 CLAIM-OPEN-FLAG PIC X(01).
05 CODES-OPEN-FLAG PIC X(01).
05 CREDIT-OPEN-FLAG PIC X(01).
05 CUSTOMER-OPEN-FLAG PIC X(01).
05 DEBIT-OPEN-FLAG PIC X(01).
05 DEPT-OPEN-FLAG PIC X(01).
05 DX-OPEN-FLAG PIC X(01).
05 ERROR-OPEN-FLAG PIC X(01).
05 INS-COMPANY-OPEN-FLAG PIC X(01).
05 NAMES-OPEN-FLAG PIC X(01).
05 PAT-OPEN-FLAG PIC X(01).
05 PLACE-OPEN-FLAG PIC X(01).
05 PROC-OPEN-FLAG PIC X(01).
05 PROVIDER-OPEN-FLAG PIC X(01).
05 REFER-DR-OPEN-FLAG PIC X(01).
05 STMT-MSG-OPEN-FLAG PIC X(01).
05 ZIP-CODE-OPEN-FLAG PIC X(01).
05 temp1-open-flag PIC X(01).
05 CLAIM-HOLD-OPEN-FLAG PIC X(01).
05 DAY-STAT-OPEN-FLAG PIC X(01).
05 DAY-HIST-OPEN-FLAG PIC X(01).
05 CYCLE-OPEN-FLAG PIC X(01).
03 lines-per-page pic 9(02).
03 set-condensed-mode pic x(16).
03 cancel-condensed-mode pic x(16).
//Delphi code below
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
pPCT= ^pcT;
pcT = packed record //PIBS Comm
ver : array[0..5]of char; //6
verDate : array[0..7]of char ;//8
prog : array[0..31]of char ; //32
err : array[0..2]of char; //3
first : array[0..0]of char; //1first Call
mibsFlg : array[0..0]of char; //1 y MIBS is present N = no
initFlg: array[0..0]of char; //1 y means initialized new files
//rand : smallint ; //random number
filSt : array[0..4]of char ; //5
f1 : array[0..0]of char; //1
date : array[0..7]of char ; //8 char
time : array[0..3]of char ; //4
fCmd : array[0..1]of char ; //2 File command
fName: array[0..23]of char ; //24 file name
//Temp : array [0..1395] of char ;
nAcct : array[0..9]of char ; //10 Next account number
nPat : array[0..9]of char ; //10 next pat number
debug : array[0..1]of char ; //2 debug flag
lCls : array[0..7]of char ; //8 last closed date
qName : array[0..23]of char ; //24 query com are name
qAcct : array[0..11]of char ; //12 Account Number (num & type)
qPat : array[0..9]of char ; //10 pat Number
qClm : array[0..3]of char ; //4 claim number
qcurTyp : array[0..0]of char; //1 Current account type index PIC 9
qCmd : array[0..0]of char; //1 command
qCmdS : array[0..0]of char; //1 sub command
qFunc : array[0..0]of char; //1 function
qMod : array[0..0]of char; //1 mode
qFuncS : array[0..0]of char ; //1 sub function
qClaimNumArc : array[0..0]of char ; // 1 qc-Claim-num-arc
qClaimOrder : array[0..0]of char ; //1 qc-claim-order
qClaimFrm : array[0..0]of char ; // 1 qc-claim-frm
qTransOrder : array[0..0]of char ; //1 qc-trans-order
qTransFrm : array[0..0]of char ; // 1 qc-trans-frm
qClaimArch : array[0..0]of char ; // 1 qc-claim-archive
qTransArch : array[0..0]of char ; // 1 qc-trains-archive
filler : array[0..0]of char ; // 1 filler
pcPmtDate : array[0..7]of char ; // 8 pc-pmt-date
pcChgDate : array[0..8]of char ; // 8 pc-chg-date
pvMsgLine : array[0..53]of char ; // 54 PV-MSG-LINE
fKey1 : array[0..5]of char ; //Function-key-def F1
fKey2 : array[0..5]of char ; //Function-key-def F2
fKey3 : array[0..5]of char ; //Function-key-def F3
fKey4 : array[0..5]of char ; //Function-key-def F4
fKey5 : array[0..5]of char ; //Function-key-def F5
fKey6 : array[0..5]of char ; //Function-key-def F6
fKey7 : array[0..5]of char ; //Function-key-def F7
fKey8 : array[0..5]of char ; //Function-key-def F8
fKey9 : array[0..5]of char ; //Function-key-def F9
fKey10 : array[0..5]of char ; //Function-key-def F10
mibsDir: array[0..35] of char; // 36 mibs-dir
mibsWs: array[0..35] of char; // 36 mibs-ws-dir
mibsArc: array[0..35] of char; // 36 mibs-arc
hipUpDir: array[0..35] of char; //36 hip-up-dir
hipRemDir: array[0..35] of char; //36 hip-rem-dir
filler2: array[0..35] of char; // 36 filler2
AcctOpenFlag: array[0..0] of char; // 1 ACCT-OPEN-FLAG
AcctTypeOpenFlag: array[0..0] of char; // 1 ACCT-TYPE-OPEN-FLAG
ClaimOpenFlag: array[0..0] of char; // 1 CLAIM-OPEN-FLAG
CodesOpenFlag: array[0..0] of char; // 1 CODES-OPEN-FLAG
CreditOpenFlag: array[0..0] of char; // 1 CREDIT-OPEN-FLAG
CustomerOpenFlag: array[0..0] of char; // 1 CUSTOMER-OPEN-FLAG
DebitOpenFlag: array[0..0] of char; // 1 DEBIT-OPEN-FLAG
DeptOpenFlag: array[0..0] of char; // 1 DEPT-OPEN-FLAG
DxOpenFlag: array[0..0] of char; // 1 DX-OPEN-FLAG
ErrorOpenFlag: array[0..0] of char; // 1 Error-OPEN-FLAG
InsCompanyOpenFlag: array[0..0] of char; // 1 INS-COMPANY-OPEN-FLAG
NamesOpenFlag: array[0..0] of char; // 1 NAMES-OPEN-FLAG
PatOpenFlag: array[0..0] of char; // 1 PAT-OPEN-FLAG
PlaceOpenFlag: array[0..0] of char; // 1 PLACE-OPEN-FLAG
ProcOpenFlag: array[0..0] of char; // 1 PROC-OPEN-FLAG
ProviderOpenFlag: array[0..0] of char; // 1 PROVIDER-OPEN-FLAG
ReferDrOpenFlag: array[0..0] of char; // 1 REFER-DR-OPEN-FLAG
StmtOpenFlag: array[0..0] of char; // 1 STMT-OPEN-FLAG
ZipOpenFlag: array[0..0] of char; // 1 ZIP-OPEN-FLAG
Temp1OpenFlag: array[0..0] of char; // 1 temp1-OPEN-FLAG
ClaimHoldOpenFlag: array[0..0] of char; // 1 CLAIM-HOLD-OPEN-FLAG
DayStatOpenFlag: array[0..0] of char; // 1 DAY-STAT-OPEN-FLAG
DayHistOpenFlag: array[0..0] of char; // 1 DAY-HIST-OPEN-FLAG
CycleOpenFlag: array[0..0] of char; // 1 CYCLE-OPEN-FLAG
AcctNoteOpenFlag: array[0..0] of char; // 1 ACCT-NOTE-OPEN-FLAG
temp2OpenFlag: array[0..0] of char; // 1 temp2-OPEN-FLAG
temp3OpenFlag: array[0..0] of char; // 1 temp3-OPEN-FLAG
emcHoldOpenFlag: array[0..0] of char; // 1 EMC-HOLD-OPEN-FLAG
setupOpenFlag: array[0..0] of char; // 1 SETUP-OPEN-FLAG
PatInsOpenFlag: array[0..0] of char; // 1 pat-ins-OPEN-FLAG
recallOpenFlag: array[0..0] of char; // 1 recall-OPEN-FLAG
collectOpenFlag: array[0..0] of char; // 1 COLLECT-OPEN-FLAG
reasonOpenFlag: array[0..0] of char; // 1 REASON-OPEN-FLAG
dxEditOpenFlag: array[0..0] of char; // 1 dx-edit-OPEN-FLAG
procEditOpenFlag: array[0..0] of char; // 1 proc-edit-OPEN-FLAG
macroProcOpenFlag: array[0..0] of char; // 1 macro-Proc-OPEN-FLAG
probTempOpenFlag: array[0..0] of char; // 1 Prob-temp-OPEN-FLAG
rxOpenFlag: array[0..0] of char; // 1 rx-OPEN-FLAG
patRxOpenFlag: array[0..0] of char; // 1 pat-Rx-OPEN-FLAG
arcOpenFlag: array[0..0] of char; // 1 arc-OPEN-FLAG
LogOpenFlag: array[0..0] of char; // 1 log-OPEN-FLAG
arcClaimOpenFlag: array[0..0] of char; // 1 Arc-Claim-OPEN-FLAG
arcDebitOpenFlag: array[0..0] of char; // 1 arc-Debit-OPEN-FLAG
arcCreditOpenFlag: array[0..0] of char; // 1 arc-Credit-OPEN-FLAG
claimSuspOpenFlag: array[0..0] of char; // 1 Claim-susp-OPEN-FLAG
stmtHistOpenFlag: array[0..0] of char; // 1 stmt-hist-OPEN-FLAG
creditSplitOpenFlag: array[0..0] of char; // 1 Credit-split-OPEN-FLAG
tickOpenFlag: array[0..0] of char; // 1 tick-OPEN-FLAG
textMacroOpenFlag: array[0..0] of char; // 1 text-Macro-OPEN-FLAG
DepositOpenFlag: array[0..0] of char; // 1 Deposit-OPEN-FLAG
pmtProfOpenFlag: array[0..0] of char; // 1 pmt-prof-OPEN-FLAG
probOpenFlag: array[0..0] of char; // 1 prob-OPEN-FLAG
apptSumOpenFlag: array[0..0] of char; // 1 appt-sum-OPEN-FLAG
apptPatOpenFlag: array[0..0] of char; // 1 appt-Pat-OPEN-FLAG
visitOpenFlag: array[0..0] of char; // 1 visit-OPEN-FLAG
visitCodeOpenFlag: array[0..0] of char; // 1 visit-Code-OPEN-FLAG
PatxOpenFlag: array[0..0] of char; // 1 Patx-OPEN-FLAG
vitalOpenFlag: array[0..0] of char; // 1 vital-OPEN-FLAG
authorOpenFlag: array[0..0] of char; // 1 author-OPEN-FLAG
cciOpenFlag: array[0..0] of char; // 1 cci-OPEN-FLAG
dxMasterOpenFlag: array[0..0] of char; // 1 dx-master-OPEN-FLAG
procDxOpenFlag: array[0..0] of char; // 1 proc-Dx-OPEN-FLAG
loginOpenFlag: array[0..0] of char; // 1 login-OPEN-FLAG
apptLogOpenFlag: array[0..0] of char; // 1 appt-log-OPEN-FLAG
hospPatOpenFlag: array[0..0] of char; // 1 hosp-pat-OPEN-FLAG
insExtOpenFlag: array[0..0] of char; // 1 ins-ext-OPEN-FLAG
hipSubOpenFlag: array[0..0] of char; // 1 hip-OPEN-FLAG
filler3: array[0..12] of char; // 13 filler
temp1FileName: array[0..35] of char; // 36 temp1-file-name
temp2FileName: array[0..35] of char; // 36 temp2-file-name
temp3FileName: array[0..35] of char; // 36 temp3-file-name
apptLogName: array[0..35] of char; // appt-log-file-name
linesPerPage: array[0..1] of char; // 2 lines per page pic 9
cancelCondensedMode: array[0..15] of char ; // 16 cancel-condensed-mode
end;
{ pPCT= ^pcT;
pcT = packed record //PIBS Comm
ver : array[0..11]of char; //6
verDate : array[0..15]of char ;//8
prog : array[0..63]of char ; //32
err : array[0..5]of char; //3
first : array[0..1]of char; //1first Call
mibsFlg : array[0..1]of char; //1 y MIBS is present N = no
initFlg : array[0..1]of char; //1 y means initialized new files
//rand : smallint ; //random number
filSt : array[0..9]of char ; //5
f1 : array[0..1]of char; //1
date : array[0..15]of char ; //8 char
time : array[0..7]of char ; //4
fCmd : array[0..1]of char ; //2 File command
fName: array[1..47]of char ; //24 file name
nAcct : array[0..19]of char ; //10 Next account number
nPat : array[0..19]of char ; //10 next pat number
debug : array[0..1]of char ; //2 debug flag
lCls : array[0..15]of char ; //8 last closed date
qName : array[0..47]of char ; //24 query com are name
qAcct : array[0..23]of char ; //12 Account Number (num & type)
qPat : array[0..19]of char ; //10 pat Number
qClm : array[0..7]of char ; //4 claim number
qcurTyp : array[0..1]of char; //1 Current account type index
qCmd : array[0..1]of char; //1 command
qCmdS : array[0..1]of char; //1 sub command
qFunc : array[0..1]of char; //1 function
qMod : array[0..1]of char; //1 mode
qFuncS : array[0..1]of char ; //1 sub function
f2 : array[0..15]of char; //8 Flags to be later enumerated
pmtDate : array[0..15]of char; //8 payment date
chgDate : array[0..15]of char; //8 charge date
msg : array[0..107]of char ; //54 msg line
f3 : array[0..119]of char ; //60 function key defn
paths : array[0..1919]of char ; //960 file paths
// file open flags
accctOpen : array[0..1]of char;// 1
aTypOpen : array[0..1]of char; // 1
claimOpen : array[0..1]of char;// 1
open : array[0..153]of char; // 77 file open flag
f4 : array[0..143]of char ; // 72 filler
apptLogN: array[0..47]of char; // 24 appt log file name
f5 : array[0..67]of char ; // 34 filler
end;
{type
PnrT = ^nrT;
nrT = packed record //Name record
Name : array[0..47]of char ; //24 last,first m, tittle
acct : array[0..19]of char; //10
pat : array[0..19]of char ; //10
bir : array[0..15]of char ; //8 birth ccyymmdd
reg : array[0..11]of char ; //6 registration date
sex : array[0..2]of char ; //1
st : array[0..2]of char ; //1 status
loc : array[0..15]of char ; //8 location
end; }
{type
PcuT = ^cuT;
cuT = packed record //Customer record
Name : array[1..24]of char ; //24
addr1 : array[1..24]of char ; //24
addr2 : array[1..24]of char ; //24
city : array[1..20]of char ; //20
state : array[1..2]of char ; //2
zip : array[1..10]of char ; //10
phone : array[1..10]of char ; //10
fill : array[1..50]of char ; //50
acctNumLen : array[1..2]of char ; //2
patNumLen : array[1..2]of char ; //2
acctNumNext : array[1..10]of char ;//10
patNumNext : array[1..10]of char ; //10
acctNumChk : char ; //1
acctNumeric: char ; //1
patNumChk : char ; //1
patNumeric: char ; //1
acctNumAuto: char ; //1
patNumAuto : char ; //1
fil5 : char ; //2
filePaths : array[1..720]of char ;//720
fil6 : array[1..2]of char ; // 2
datelastDayRpt : array[1..8]of char ; //8 not used
fil2 : array[1..17]of char ;//17
dayRptByDr : char ; // 1
fil3 : array[1..144]of char ;//144?15
stmtRefNext : array[1..8]of char ; //8 Next stmt reference number
acctNumIncre :array[1..2]of char ; //2
patNumIncre :array[1..2]of char ; //2
fil4 : array[1..3]of char ; //3
fiscalYr : array[1..8]of char ; //8 fiscal year, next
dateLastUsed :array[1..8]of char ; //8 date system last used
fil7 : char ; //1
end; }
type
TForm1 = class(TForm)
InitCmd: TButton;
Edit1: TEdit;
Edit2: TEdit;
Nextcmd: TButton;
procedure InitCmdClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure AssignFixedString( Var FixedStr: Array of Char; Const S:
String );
end;
var
Form1: TForm1;
pc : pcT ;
// cNr : nrT ;
// cu : cuT ;
iLen : integer ;
const
Ez : string = '000';
implementation
{$R *.dfm}
{functions for edrio.dll}
Procedure initMIBS(var pc : pcT); stdcall ; external 'MIBSIO.dll';
//Procedure PIBSINIT(var pc : pcT); pascal ; external 'edrio.dll';
//Procedure PIBSEXIT(var pc : pcT); stdcall ; external 'edrio.dll';
//Procedure NAMEIO(var pc : pcT; nr : nrT);stdcall ; external 'edrio.dll';
//procedure CUSTIO(var pc : pcT; cu : cuT);stdcall ; external 'edrio.dll';
procedure TForm1.AssignFixedString( Var FixedStr: Array of Char; Const
S:String );
var
maxlen: Integer;
begin
maxlen := Succ( High( FixedStr ) - Low( FixedStr ));
FillChar( FixedStr, maxlen, ' ' ); { blank fixed string }
if Length(S) > maxlen then
Move( S[1], FixedStr, maxlen )
else if S <> '' then
Move( S[1], FixedStr, Length(S));
end;
procedure TForm1.InitCmdClick(Sender: TObject);
begin
//pc.mibsFlg := 'Y' ; //initialize whether MIBS present
AssignFixedString(pc.mibsFlg,'Y');
//pc.err := '000';
AssignFixedString(pc.err,'000');
// get common directory for all winMIBS applications
// some WinMibs directory information
//pc.fName := 'C:\MIBS5\'
AssignFixedString(pc.fName,'C:\MIBS5\') ;
iLen := sizeOf(pc); //..get error incompatible type 1494 in VB
//call PIBSINIT
try
//PIBSINIT(pc) ;
INITMIBS(pc); // initialize MIBS <== program exits here
except
on E : Exception do
begin
ShowMessage('Exception class name = '+E.ClassName);
// ShowMessage('Exception message = '+E.Message);
end;
end;
pc.date := '20060912' ;
//pc.chgDate := pc.chgDate ;
//pc.pmtDate := pc.pmtDate ;
pc.err := '000' ;
//CUSTIO(pc, cu);
// initialize the flags and variables
end;
end.
Rudy Velthuis [TeamB]
>
> ******************************************************************
> * *
> * PIBSCOM.COP - COMMON AREA FOR PIBS SUBROUTINES. *
Stephen, you would do everyone with a pay-per-minute dial-up connection a
favour if you could zip such long source codes up and post them to the
borland.public.attachments group instead, next time.
--
Rudy Velthuis [TeamB] http://rvelthuis.de/
"Some cause happiness wherever they go; others, whenever they go."
-- Oscar Wilde (1854-1900)