|
midrange.com
A couple of weeks ago I posted situation dealing w/database triggers.
I got a few responses, implemented some of the suggestions, I still have big
problems.
I am doing my 1st trigger program.
An interavtive program gets the record and displays it on the
screeen. When entry is made, the program then does the "update"
opcode. I am using monitor on this. This does fire my trigger. The
trigger program sends back an error message if the data was not
valid, and displays the error message on the screen. That part works
ok. I am using cpf9898 to pass my message data and using a subfile
in my interactive program to retrieve and display.
The problem is .... if you change the data to correct values or even
get a new record and try to update it ... you now get error messages
cpf5147 ... instruction sequence error and/or cpf5129 that the
trigger program sort of left something hanging. I do not know how to
handle this.
I honestly do not know which program is really the problem.
I would have included code, but it seems impossible to get it into a
readable fashion w/o typing the whole thing by hand.
Anyway, with what little you have to go on, any responses would be
appreciated.
Hopefully some of you can make heads or tails out of this.
Here goes.
Here is some code for the interactive program.
//====================================================================/
// Mainline |
/
//----------------------------+---------------------------------------/
// Process screen until END requested
/
//====================================================================/
Dou *InLR;
clear CSrec1;
exfmt CSupdt01;
If *InKC or
*InKG;
*InLR = *On;
leave;
EndIf;
exsr ClrMsgs;
chain CSdlr# csxb00;
If %Found(csxb00);
Mesg = Mesg_Updt;
CsSmn#_B = CsSmn#;
CsOsm#_B = CsOsm#;
Dow Mesg <> *Blanks;
write #msgctl;
exfmt CSupdt02;
exsr ClrMsgs;
If *InKC or
*InKG or
*InKK;
If *InKK;
unlock(e) CSxb00;
Else;
eval *InLR = *On;
EndIf;
leave;
EndIf;
// Save new values
CsSmn#_A = CsSmn#;
CsOsm#_A = CsOsm#;
// Do the update
Monitor;
update CSb00;
On-Error *File;
##Errcod = 1;
Mesg = Mesg_See;
EndMon;
EndDo;
// Customer Not found
Else;
Mesg = ' Invalid Customer ';
leave;
EndIf;
EndDo;
Here is some code for the trigger program.
//====================================================================/
// Mainline |
/
//----------------------------+---------------------------------------/
// Process screen until END requested
/
//====================================================================/
Dou *InLR;
clear CSrec1;
exfmt CSupdt01;
If *InKC or
*InKG;
*InLR = *On;
leave;
EndIf;
exsr ClrMsgs;
chain CSdlr# csxb00;
If %Found(csxb00);
Mesg = Mesg_Updt;
CsSmn#_B = CsSmn#;
CsOsm#_B = CsOsm#;
Dow Mesg <> *Blanks;
write #msgctl;
exfmt CSupdt02;
exsr ClrMsgs;
If *InKC or
*InKG or
*InKK;
If *InKK;
unlock(e) CSxb00;
Else;
eval *InLR = *On;
EndIf;
leave;
EndIf;
// Save new values
CsSmn#_A = CsSmn#;
CsOsm#_A = CsOsm#;
// Do the update
Monitor;
update CSb00;
On-Error *File;
##Errcod = 1;
Mesg = Mesg_See;
EndMon;
EndDo;
// Customer Not found
Else;
Mesg = ' Invalid Customer ';
leave;
EndIf;
EndDo;
Here is some code for the trigger program
*------------------------------------------------------------------------
Documentation
*
* Trigger pgm for CSdelr maintenance (currently just testing)
* Terry N - 05/07/2004 - New
*
H Option(*SrcStmt)
H DftActGrp(*NO)
H ActGrp(*Caller)
H BndDir('EWAPPS')
FSMdlrI CT F 6 DISK
FSMdlrO CT F 6 DISK
D* Tables for testing salesmen id's
DInside S 6S 0 Dim(10) PerRcd(1) Fromfile(SMdlrI)
DOutside S 6S 0 Dim(10) PerRcd(1) Fromfile(SMdlrO)
D*------------------------------------------------------------------------
Documentation
*------------------------------------------------------------------------
* Pointers used to refer to data in the buffers
*------------------------------------------------------------------------
DpBefore S *
DpAfter S *
*------------------------------------------------------------------------
* Before and After data structures (change to file name needed)
* .... set Pointer in order to use data
*------------------------------------------------------------------------
DBefore E DS ExtName(CSdelr)
D Prefix(B_)
D Based(pBefore)
DAfter E DS ExtName(CSdelr)
D Prefix(A_)
D Based(pAfter)
*------------------------------------------------------------------------
* Trigger Constants
*------------------------------------------------------------------------
D@Insert C '1'
D@Delete C '2'
D@Update C '3'
D@Before C '2'
D@After C '1'
*------------------------------------------------------------------------
* Error Message constants
*------------------------------------------------------------------------
D@Error1 C 'Invalid Inside Salesman #'
D@Error2 C 'Invalid Outside Salesman #'
D@Error3 C 'Invalid Price Frt Zone'
D@Error4 C 'Invalid Delivery Frt Zone'
*------------------------------------------------------------------------
* Other work fields
*------------------------------------------------------------------------
D Found_I 10I 0
D Found_O 10I 0
*------------------------------------------------------------------------
* Trigger Buffer and Trigger Buffer Length Declarations
*------------------------------------------------------------------------
DBufferLen S 10I 0
DTrigBuff DS
D TrigFile 10A
D TrigLib 10A
D TrigMbr 10A
D TrigEvent 1A
D TrigTime 1A
D TrigCommit 1A
D TrigRes1 3A
D TrigCCSID 10I 0
D TrigRRN 10I 0
D TrigRes2 4A
D TrigB4OS 10I 0
D TrigB4Len 10I 0
D TrigB4NBM 10I 0
D TrigB4NBL 10I 0
D TrigAftOS 10I 0
D TrigAftLen 10I 0
D TrigAftNBM 10I 0
D TrigAftNBL 10I 0
*------------------------------------------------------------------------
* Api Declarations
*------------------------------------------------------------------------
D MsgId S 7 Inz('CPF9898')
D MsgFile S 20 Inz('QCPFMSG *LIBL ')
D MsgData S 78 Inz(' ')
D MsgRplDtaLen S 10i 0
D MsgType S 10a Inz('*ESCAPE')
D MsgQueue S 276a Inz('*')
D MsgCallStack S 10i 0 Inz(3)
Msg Call Stack
D MsgKey S 4a Inz(' ')
Msg Key
D MsgErr S 10i 0 Inz(0)
Msg Error
D SendMsg pr extpgm('QMHSNDPM')
D msgId 7a
Msg Id
D msgFile 20a
Msg File
D msgData 78a
Msg
D msgRplDtaLen 10i 0
Msg Repl Data Len
D msgType 10a
Msg Type
D msgQueue 276a
Msg Queue
D msgCallStack 10i 0
Msg Call Stack
D msgKey 4a
Msg Key
D MsgErr S 10i 0 Inz(0)
Msg Error
D SendMsg pr extpgm('QMHSNDPM')
D msgId 7a
Msg Id
D msgFile 20a
Msg File
D msgData 78a
Msg
D msgRplDtaLen 10i 0
Msg Repl Data
D msgType 10a
Msg Type
D msgQueue 276a
Msg Queue
D msgCallStack 10i 0
Msg Call Stack
D msgKey 4a
Msg Key
D msgErr 10i 0
Msg Error
*------------------------------------------------------------------------
* Input Paramaters are passed automatically when the trigger
* fires. Passed ere the trigger buffer and trigger buffer length.
*------------------------------------------------------------------------
C *Entry Plist
C Parm TrigBuff
C Parm BufferLen
/Free
//------------------------------------------------------------------------
// Map the data structures for the before and after images to
// the offset location in the trigger buffer using pointers.
//------------------------------------------------------------------------
// Set before & after values
pBefore = %Addr(TrigBuff) + TrigB4OS;
pAfter = %Addr(TrigBuff) + TrigAftOS;
// Test Trigger event
If TrigEvent = @Update or
TrigEvent = @Insert;
MsgData = *Blanks;
// Inside Salesman
If A_CSsmn# <> B_CSsmn#;
Found_I = %Lookup(A_CSsmn#:Inside);
// ... if not found - send back error msg
If Found_I < 1;
MsgData = @Error1;
exsr SendError;
A_CSsmn# = B_CSsmn#;
EndIf;
EndIf;
// Outside Salesman
If A_CSosm# <> B_CSosm#;
Found_O = %Lookup(A_CSosm#:Outside);
// ... if not found - send back error msg
If Found_O < 1;
MsgData = @Error2;
exsr SendError;
A_CSosm# = B_CSosm#;
EndIf;
EndIf;
EndIf;
// Go back to caller
Return;
// Send back error message
//====================================================================//
// Subroutine: SendError |
//
//----------------------------+---------------------------------------//
// Send escape msg back to caller
//
//====================================================================//
begsr SendError;
MsgId = 'CPF9898';
MsgRplDtaLen = %Len(%Trim(MsgData));
callp SendMsg (msgid :
msgFile :
msgData :
msgRplDtaLen :
msgType :
msgQueue :
msgCallStack :
msgKey :
msgErr);
endsr;
/End-Free
This is the cl that creates the trigger
/* Add triggers for CSdelr file */
/* */
PGM
ADDPFTRG FILE(CSDELRX) TRGTIME(*before) +
TRGEVENT(*INSERT) PGM(TRGCSDELR) +
ALWREPCHG(*YES)
ADDPFTRG FILE(CSDELRX) TRGTIME(*before) +
TRGEVENT(*UPDATE) PGM(TRGCSDELR) +
ALWREPCHG(*YES)
ENDPGM
****************** End of data ****************************************
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
