Re: Open Access for RPG

Jon,

excuse my, but the interface to a file handler is easy ...

eval DMDMNO = 123456
eval FILE = 'DMREG'
eval OPCD = '*CHAIN'
call 'MYHANDLER'
parm FILE // file
parm OPCD // operationcode
parm RTCD // returncode
parm DMREC // datainterface
if RTCD = '*OK'
*** do something
else
*** do something else
endif

and the underlying handler is also simple ....

(this code is in basicaly written 22 years ago (it has been rewritten)
but is based on placing a software layer between the actual operation
code and what is going on beneath - and who was it, by the way, who
invented that - does the name Frank Soltis ring a bell ???

Please notice that the code not only serves data, but it also call
standard routines that parallellize (n) numer of on or offline
databases

*=====================================================================
* DBServer
*=====================================================================
H DatFmt(*eur)
FDMREG UF A E K DISK
F RENAME(DMREC:ÅREC1)
FDMDBS UF A E K DISK
F RENAME(DMREC:ÅREC2)
FDML01 UF A E K DISK
F RENAME(DMREC:ÅREC3)
FDML02 UF A E K DISK
F RENAME(DMREC:ÅREC4)

D ÅSERV E DS EXTNAME(ÅÅSERVUS)
D ÅREC E DS EXTNAME(DMREG)

d Åident s 3
d Åxlaccd s 2
d Åxlacno s 11 0
d Åcomm s 9999

* Get In
c *ENTRY Plist
c Parm ÅSERV
c Parm ÅREC

* Define Keylist
c ÅÅKEY1 Klist
c Kfld DMDMNO
c ÅÅKEY2 Klist
c Kfld DMÆÆNO
c ÅÅKEY3 Klist
c Kfld DMNI
c Kfld DMDMNO
c ÅÅKEY4 Klist
c Kfld DMN4
c Kfld DMNI
c Kfld DMDMNO

c Select

* Initiate Record
c When ÅÅOPCD = '*INIT
c Eval ÅÅRTCD = '*OK'
c ExSr ÅÅRECI
* Release Record
c When ÅÅOPCD = '*UNLCK ' or
c ÅÅOPCD = '*UNLOCK '
c Eval ÅÅRTCD = '*OK'
c If ÅÅFILE = 'DMREG '
c UnLock DMREG
c EndIf
c If ÅÅFILE = 'DMDBS '
c UnLock DMDBS
c EndIf
c If ÅÅFILE = 'DML01 '
c UnLock DML01
c EndIf
c If ÅÅFILE = 'DML02 '
c UnLock DML02
c EndIf

* Call File Server
c When ÅÅFILE = 'DMREG '
c ExSr ÅÅFIL1
c When ÅÅFILE = 'DMDBS '
c ExSr ÅÅFIL2
c When ÅÅFILE = 'DML01 '
c ExSr ÅÅFIL3
c When ÅÅFILE = 'DML02 '
c ExSr ÅÅFIL4

c Endsl

* Get Current Data Library Ident
c call 'TBCOM_ID'
c parm Åident
* Parallel System Support
c if Åident <> *blanks
c if ÅÅopcd = '*WRITE ' or
c ÅÅopcd = '*UPDAT ' or
c ÅÅopcd = '*UPDATE ' or
c ÅÅopcd = '*DELET ' or
c ÅÅopcd = '*DELETE '

c eval Åxlaccd = dmÆÆri
c eval Åxlacno = dmdmno
c call 'TBCOM_XK'
c parm ÅÅopcd
c parm Åident
c parm Åxlaccd
c parm Åxlacno
c eval Åcomm = 'DM' + ÅÅopcd + Årec
c callb 'TBCSND'
c parm Åcomm

c endif
c endif

* End Program
c Return

/EJECT
*=====================================================================
* INITiate all record fields
*

c ÅÅRECI Begsr

c Clear ÅREC
c Eval DMÆÆRI = 'DM'
c Eval DMÆÆNO = '*NONE'
c Eval DMÆÆST = 'A'
c Eval DMÆÆDC = 'D'
c Eval DMÆÆUD = 1

c EndSr
/EJECT
*=====================================================================
* Included Standard Routines and System Modules
*=====================================================================
/COPY QSrc,SYSFS1CC
/COPY QSrc,SYSFS2CC
/COPY QSrc,SYSFS3CC
/COPY QSrc,SYSFS4CC