|
midrange.com
Thanks for responding William Washington.
This is an interactive program which does the update, which fires the
trigger. I want the message to come back to my program so I can display
it as an error.
I'm not sure quite what happened, but my attachments turned into
whatever it was you received. Although they did come back fine for me.
They were just
a txt file.
I did try what I think you were telling me before sending this, and that
doesn't work.
There is a stack # in both the send and receive ... should they be the
same or different. If I change it to 1, I get a trigger exception error.
Here is the flow ... both run in activation group Qile
Call CSupdtxCL ... (1)
Load file ...
Call CSupdt ... (2)
Trigger caused by an update ... (3)
I used 3 as my stack # when qmhsndpm was called in the trigger program
... should the recv stack # be the same or am I confusing that piece as
being something it is not?
Anyway ... following is the interactive program that does the update and
forces the trigger .... CSupdt
H DFTNAME(CSUPDT) TN
05/10/04
H Option(*SrcStmt)
H DftActGrp(*NO)
H ActGrp('QILE')
H BndDir('EWAPPS')
F*
F* Change salesman #'s ... testing triggers
F*
FCSUPDTFM CF E WORKSTN
F INFDS(ROLUPD)
FCSxb00 UF E K Disk
D*
D*----------------------------------------------- DATA STRUCTURES
D
D ROLUPD DS
D STATUS *STATUS
D
D CSrec1 E DS EXTNAME(CSdelr) Inz
D
D Alpha DS Inz
D Mesg 50
D Mesg_Updt S 50 Inz(' Update the salesmen #s')
D
*-----------------------------------------------------------------------
-
* Api Declarations
*-----------------------------------------------------------------------
-
DApiQmhRcvPm DS
D RcvData 100 Inz('*')
D RcvDtaLen 10I 0 Inz(%Size(RcvData))
d RcvFormat 8 Inz('RCVM0200')
D RcvMsgQ 10 Inz('*')
D RcvStack 10I 0 Inz(3)
D RcvType 10 Inz('*ESCAPE')
D RcvKey 10I 0
D RcvAction 10 Inz('*OLD')
D RcvWait 10I 0 Inz(0)
DAPIErrorDS DS
D APIBytes 10I 0 Inz(%Size(APIErrorDS))
D APIBytesOut 10I 0 Inz(0)
D APIErrID 7A
D APIReserved 1A
D APIErInDta 256A
C Dou *InLR
C clear CSrec1
C exfmt CSupdt01
C If *InKC or
C *InKG
C eval *InLR = *On
C leave
C EndIf
* KK .. go back to screen 1
* ...
* Otherwise process screen 2
C If Not *InKK
C CSdlr# chain csxb00
C If %Found(csxb00)
C eval Mesg = Mesg_Updt
C Dow Mesg <> *Blanks
C exfmt CSupdt02
C If *InKC or
C *InKG
C eval *InLR = *On
C leave
C EndIf
c eval Mesg = *Blanks
C Monitor
C update CSb00
C on-error
C exsr RecvError
C Endmon
C EndDo
* Customer Not found
C Else
C eval Mesg = ' Invalid Customer '
C EndIf
C EndIf
C EndDo
* Receive program error message
C RecvError BegSr
C
C CALL 'QMHRCVPM' Recv
ErrorMessage
C PARM RcvData
C PARM RcvDtaLen
C PARM RcvFormat
C PARM RcvMsgQ
C PARM RcvStack
C PARM RcvType
C PARM RcvKey
C PARM RcvWait
C PARM RcvAction
C PARM ApiErrorDs Error Code
c If RcvDtaLen = 0
c leavesr
c EndIf
* Show me if anything came back
C eval Mesg = 'xxx ' +
%Trim(%Editc(ApiBytes:'Z'))
C + ' ' +
%Trim(%Editc(ApiBytesOut:'Z'))
C + ' ' + %Triml(%Trimr(RcvData))
C + ' ' +
%Trim(%Editc(RcvDtaLen:'Z'))
C + ' ' + %Triml(%Trimr(ApiErrId))
C + ' ' +
%Triml(%Trimr(ApiErInDta)))
* Just get out of here
c leavesr
*********************************************************************
* Load the message if any
c eval Mesg = ApiErrId
C EndSr
************************************************************************
****
Here is the trigger program ... TRGCSDELR
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*----------------------------------------------------------------------
--
*-----------------------------------------------------------------------
-
* 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 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
*-----------------------------------------------------------------------
-
DSMMsgId S 7 Inz('CPF9898')
DSMMsgFile S 20 Inz('QCPFMSG *LIBL')
DSMMsgTxt S 100
DSMMsgLen S 10I 0 Inz(%Size(SMMsgTxt))
DSMMsgType S 10 Inz('*ESCAPE')
DSMMsgQ S 10 Inz('*')
DSMStack# S 10I 0 Inz(3)
DSMMsgKey S 10I 0
*
DAPIErrorDS DS
D APIBytes 10I 0 Inz(%Size(APIErrorDS))
D APIBytesOut 10I 0
D APIErrID 7A
D APIReserved 1A
D APIErInDta 256A
*-----------------------------------------------------------------------
-
* 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
*-----------------------------------------------------------------------
-
* Other work fields
*-----------------------------------------------------------------------
-
D Mesg 52
*-----------------------------------------------------------------------
-
* 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
*-----------------------------------------------------------------------
-
* Map the data structures for the before and after images to
* the offset location in the trigger buffer using pointers.
*-----------------------------------------------------------------------
-
* Set before & after values
C Eval pBefore = %Addr(TrigBuff) + TrigB4OS
C Eval pAfter = %Addr(TrigBuff) + TrigAftOS
* Test Trigger event
C If TrigEvent = @Update or
C TrigEvent = @Insert
C eval SMMsgTxt = *Blanks
* Inside Salesman
C If A_CSsmn# <> B_CSsmn#
C Eval Found_I = %Lookup(A_CSsmn#:Inside)
C If Found_I < 1
C eval SMMsgTxt = @Error1
C exsr SendError
C EndIf
C EndIf
* Outside Salesman
C If A_CSosm# <> B_CSosm#
C Eval Found_O = %Lookup(A_CSosm#:Outside)
C If Found_O < 1
C eval SMMsgTxt = @Error2
C exsr SendError
C EndIf
C EndIf
C EndIf
* Go back to caller
C Return
* Send back error message
C SendError BegSr
C Call 'QMHSNDPM'
C Parm SMMsgId
C Parm SMMsgFile
C Parm SMMsgTxt
C Parm SMMsgLen
C Parm SMMsgType
C Parm SMMsgQ
C Parm SMStack#
C Parm SMMsgKey
C Parm APIErrorDS
C EndSr
-----Original Message-----
From: rpg400-l-bounces@xxxxxxxxxxxx
[mailto:rpg400-l-bounces@xxxxxxxxxxxx] On Behalf Of William Washington
III
Sent: Wednesday, May 19, 2004 2:16 PM
To: rpg400-l@xxxxxxxxxxxx
Subject: Re: Problems using api's qmhsndpm amd qmhrcvpm
Sounds like you're trying to use the wrong API. Try QEZSNDMG.
What would happen if your file with the trigger is updated by a batch
program? What message queue should the message go to?
I believe QMHSNDPM will attempt to send a message to a program message
queue, which is different than a "regular" message queue.
If this isn't the case, please let me know a bit more about where you
expect your trigger to occur, and where you wish the message to be sent.
(If you're expecting this trigger to occur in an interactive program
only, and you want to send the message "up the call stack" back to the
calling program, you need to change your call stack value - field
SMSTACK# - to 1 to tell how far back up the call stack to send the
message. If there is an intermediate program between the program doing
the update and the trigger program sending the message, set the value to
2.)
William
date: Wed, 19 May 2004 12:26:05 -0700
from: "Terry Nonamaker"
subject: Problems using api's qmhsndpm amd qmhrcvpm
I have been been working on my 1st trigger and api program and have been
having a heck of a time making the api's work.
My 2 programs are attached . they are just spool files copied to
desktop. If they do not appear properly go to format and uncheck word
wrap.
Any way, my trigger does seem to be firing and it is making the send api
happen.
. I say this because when I look at my job log I see the proper error
message there. The trigger program is TRGCSDELR.
> call csupdtxcl
600 - OVRDBF FILE(CSXB00) TOFILE(CSXB00X)
800 - CALL PGM(CSUPDT)
Invalid Outside Salesman #.
I/O error CPF9898 was detected in file CSXB00.
1000 - DLTOVR FILE(*ALL)
- RETURN /* RETURN due to end of CL program */
> wtp
I have been using the AS/400 Programmer's Handbook and Api's at Work, in
addition to searching everywhere I can think of on the net.
There seem to be no good examples of using qmhrcvpm.
Basically I seem to be getting nothing back to my base program . CSUPDT.
It is highly like I am using Monitor improperly, but no good examples of
that either. Or maybe I should not be using monitor.
But if I don't, I get system forced messages.
Any help would be appreciated, no snickers allowed.
For some reason this is just not coming together for me.
Thanks in advance to all that respond.
Terry Nonamaker
tnonamaker@xxxxxxxxxxxxxxxx
Exterior Wood Inc.
------------------------------
_______________________________________________
This is the RPG programming on the AS400 / iSeries (RPG400-L) mailing
list
To post a message email: RPG400-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/rpg400-l
or email: RPG400-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/rpg400-l.
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.
