|
midrange.com
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.
5722WDS V5R2M0 020719 SEU SOURCE LISTING
05/19/04 10:51:19 PAGE 1
SOURCE FILE . . . . . . . EXPRDPGM/QRPGSRC
MEMBER . . . . . . . . . TRGCSDELR
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7
...+... 8 ...+... 9 ...+... 0
100
*------------------------------------------------------------------------
Documentation 05/07/04
200 *
05/18/04
300 * Trigger pgm for CSdelr maintenance (currently just testing)
05/18/04
400 * Terry N - 05/07/2004 - New
05/07/04
500 *
05/18/04
600 H Option(*SrcStmt)
05/18/04
700 H DftActGrp(*NO)
05/14/04
800 H ActGrp(*Caller)
05/14/04
900 H BndDir('EWAPPS')
05/07/04
1000 FSMdlrI CT F 6 DISK
05/07/04
1100 FSMdlrO CT F 6 DISK
05/07/04
1200 D* Tables for testing salesmen id's
05/07/04
1300 DInside S 6S 0 Dim(10) PerRcd(1)
Fromfile(SMdlrI) 05/07/04
1400 DOutside S 6S 0 Dim(10) PerRcd(1)
Fromfile(SMdlrO) 05/07/04
1500
05/18/04
1600
D*------------------------------------------------------------------------
Documentation 05/07/04
1700
05/06/04
1800
*------------------------------------------------------------------------
05/06/04
1900 * Pointers used to refer to data in the buffers
05/06/04
2000
*------------------------------------------------------------------------
05/06/04
2100 DpBefore S *
05/06/04
2200 DpAfter S *
05/06/04
2300
*------------------------------------------------------------------------
05/06/04
2400 * Before and After data structures (change to file name
needed) 05/06/04
2500 * .... set Pointer in order to use data
05/06/04
2600
*------------------------------------------------------------------------
05/06/04
2700 DBefore E DS ExtName(CSdelr)
05/06/04
2800 D Prefix(B_)
05/06/04
2900 D Based(pBefore)
05/06/04
3000 DAfter E DS ExtName(CSdelr)
05/06/04
3100 D Prefix(A_)
05/06/04
3200 D Based(pAfter)
05/06/04
3300
*------------------------------------------------------------------------
05/06/04
3400 * Trigger Buffer and Trigger Buffer Length Declarations
05/06/04
3500
*------------------------------------------------------------------------
05/06/04
3600 DBufferLen S 10I 0
05/07/04
3700 DTrigBuff DS
05/06/04
3800 D TrigFile 10A
05/06/04
3900 D TrigLib 10A
05/06/04
4000 D TrigMbr 10A
05/06/04
4100 D TrigEvent 1A
05/06/04
4200 D TrigTime 1A
05/06/04
4300 D TrigCommit 1A
05/06/04
4400 D TrigRes1 3A
05/06/04
4500 D TrigCCSID 10I 0
05/06/04
4600 D TrigRRN 10I 0
05/06/04
4700 D TrigRes2 4A
05/06/04
4800 D TrigB4OS 10I 0
05/06/04
4900 D TrigB4Len 10I 0
05/06/04
5000 D TrigB4NBM 10I 0
05/06/04
5100 D TrigB4NBL 10I 0
05/06/04
5200 D TrigAftOS 10I 0
05/06/04
5300 D TrigAftLen 10I 0
05/06/04
5722WDS V5R2M0 020719 SEU SOURCE LISTING
05/19/04 10:51:19 PAGE 2
SOURCE FILE . . . . . . . EXPRDPGM/QRPGSRC
MEMBER . . . . . . . . . TRGCSDELR
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7
...+... 8 ...+... 9 ...+... 0
5400 D TrigAftNBM 10I 0
05/06/04
5500 D TrigAftNBL 10I 0
05/06/04
5600
*------------------------------------------------------------------------
05/07/04
5700 * Api Declarations
05/07/04
5800
*------------------------------------------------------------------------
05/07/04
5900 DSMMsgId S 7 Inz('CPF9898')
05/07/04
6000 DSMMsgFile S 20 Inz('QCPFMSG *LIBL')
05/17/04
6100 DSMMsgTxt S 100
05/07/04
6200 DSMMsgLen S 10I 0 Inz(%Size(SMMsgTxt))
05/07/04
6300 DSMMsgType S 10 Inz('*ESCAPE')
05/17/04
6400 DSMMsgQ S 10 Inz('*')
05/18/04
6500 DSMStack# S 10I 0 Inz(3)
05/19/04
6600 DSMMsgKey S 10I 0
05/18/04
6700 *
05/07/04
6800 DAPIErrorDS DS
05/07/04
6900 D APIBytes 10I 0 Inz(%Size(APIErrorDS))
05/07/04
7000 D APIBytesOut 10I 0
05/07/04
7100 D APIErrID 7A
05/07/04
7200 D APIReserved 1A
05/07/04
7300 D APIErInDta 256A
05/07/04
7400
*------------------------------------------------------------------------
05/06/04
7500 * Trigger Constants
05/06/04
7600
*------------------------------------------------------------------------
05/06/04
7700 D@Insert C '1'
05/06/04
7800 D@Delete C '2'
05/06/04
7900 D@Update C '3'
05/06/04
8000 D@Before C '2'
05/06/04
8100 D@After C '1'
05/06/04
8200
*------------------------------------------------------------------------
05/07/04
8300 * Error Message constants
05/07/04
8400
*------------------------------------------------------------------------
05/07/04
8500 D@Error1 C 'Invalid Inside Salesman #'
05/07/04
8600 D@Error2 C 'Invalid Outside Salesman #'
05/07/04
8700 D@Error3 C 'Invalid Price Frt Zone'
05/07/04
8800 D@Error4 C 'Invalid Delivery Frt Zone'
05/17/04
8900
*------------------------------------------------------------------------
05/07/04
9000 * Other work fields
05/07/04
9100
*------------------------------------------------------------------------
05/07/04
9200 D Found_I 10I 0
05/07/04
9300 D Found_O 10I 0
05/07/04
9400
*------------------------------------------------------------------------
05/18/04
9500 * Other work fields
05/18/04
9600
*------------------------------------------------------------------------
05/18/04
9700 D Mesg 52
05/18/04
9800
*------------------------------------------------------------------------
05/06/04
9900 * Input Paramaters are passed automatically when the trigger
05/06/04
10000 * fires. Passed ere the trigger buffer and trigger buffer length.
05/06/04
10100
*------------------------------------------------------------------------
05/06/04
10200 C *Entry Plist
05/06/04
10300 C Parm TrigBuff
05/06/04
10400 C Parm BufferLen
05/06/04
10500
*------------------------------------------------------------------------
05/06/04
10600 * Map the data structures for the before and after images to
05/06/04
5722WDS V5R2M0 020719 SEU SOURCE LISTING
05/19/04 10:51:19 PAGE 3
SOURCE FILE . . . . . . . EXPRDPGM/QRPGSRC
MEMBER . . . . . . . . . TRGCSDELR
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7
...+... 8 ...+... 9 ...+... 0
10700 * the offset location in the trigger buffer using pointers.
05/06/04
10800
*------------------------------------------------------------------------
05/06/04
10900
05/17/04
11000 * Set before & after values
05/17/04
11100 C Eval pBefore = %Addr(TrigBuff) + TrigB4OS
05/06/04
11200 C Eval pAfter = %Addr(TrigBuff) +
TrigAftOS 05/06/04
11300
05/07/04
11400 * Test Trigger event
05/17/04
11500 C If TrigEvent = @Update or
05/07/04
11600 C TrigEvent = @Insert
05/07/04
11700
05/07/04
11800 C eval SMMsgTxt = *Blanks
05/07/04
11900
05/07/04
12000 * Inside Salesman
05/17/04
12100 C If A_CSsmn# <> B_CSsmn#
05/07/04
12200 C Eval Found_I = %Lookup(A_CSsmn#:Inside)
05/07/04
12300 C If Found_I < 1
05/07/04
12400 C eval SMMsgTxt = @Error1
05/07/04
12500 C exsr SendError
05/07/04
12600 C EndIf
05/07/04
12700 C EndIf
05/07/04
12800 * Outside Salesman
05/17/04
12900 C If A_CSosm# <> B_CSosm#
05/07/04
13000 C Eval Found_O = %Lookup(A_CSosm#:Outside)
05/07/04
13100 C If Found_O < 1
05/07/04
13200 C eval SMMsgTxt = @Error2
05/07/04
13300 C exsr SendError
05/07/04
13400 C EndIf
05/07/04
13500 C EndIf
05/07/04
13600
05/07/04
13700 C EndIf
05/07/04
13800
05/07/04
13900 * Go back to caller
05/17/04
14000 C Return
05/07/04
14100
05/17/04
14200 * Send back error message
05/17/04
14300 C SendError BegSr
05/07/04
14400
05/18/04
14500 C Call 'QMHSNDPM'
05/07/04
14600 C Parm SMMsgId
05/07/04
14700 C Parm SMMsgFile
05/07/04
14800 C Parm SMMsgTxt
05/07/04
14900 C Parm SMMsgLen
05/07/04
15000 C Parm SMMsgType
05/07/04
15100 C Parm SMMsgQ
05/07/04
15200 C Parm SMStack#
05/07/04
15300 C Parm SMMsgKey
05/07/04
15400 C Parm APIErrorDS
05/07/04
15500
05/07/04
15600 C EndSr
05/07/04
* * * * E N D O F S O U R C E * * * *
5722WDS V5R2M0 020719 SEU SOURCE LISTING
05/19/04 10:51:15 PAGE 1
SOURCE FILE . . . . . . . EXPRDPGM/QRPGSRC
MEMBER . . . . . . . . . CSUPDT
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7
...+... 8 ...+... 9 ...+... 0
100 H DFTNAME(CSUPDT)
TK 12/13/91 05/07/04
200 H Option(*SrcStmt)
05/17/04
300 H DftActGrp(*NO)
05/07/04
400 H ActGrp('QILE')
05/07/04
500 H BndDir('EWAPPS')
05/07/04
600 0002 F*
700 0003 F* Change salesman #'s ... testing triggers
05/07/04
800 0004 F*
900 0005 FCSUPDTFM CF E WORKSTN
05/07/04
1000 F INFDS(ROLUPD)
1100 0005 FCSxb00 UF E K Disk
05/11/04
1200 0022
06/24/02
1300 0029 D*
1400 0033 D*----------------------------------------------- DATA STRUCTURES
1500 0034 D
07/27/01
1600 0035 D ROLUPD DS
1700 0036 D STATUS *STATUS
1800 0034 D
07/27/01
1900 0037 D CSrec1 E DS EXTNAME(CSdelr) Inz
05/19/04
2000 0034 D
05/18/04
2100 D Alpha DS Inz
06/24/02
2200 D Mesg 50
05/17/04
2300 D Mesg_Updt S 50 Inz(' Update the salesmen
#s') 05/17/04
2400 0034 D
05/18/04
2500
*------------------------------------------------------------------------
05/14/04
2600 * Api Declarations
05/14/04
2700
*------------------------------------------------------------------------
05/14/04
2800
05/14/04
2900 DApiQmhRcvPm DS
05/18/04
3000 D RcvData 100 Inz('*')
05/19/04
3100 D RcvDtaLen 10I 0 Inz(%Size(RcvData))
05/14/04
3200 d RcvFormat 8 Inz('RCVM0200')
05/18/04
3300 D RcvMsgQ 10 Inz('*')
05/18/04
3400 D RcvStack 10I 0 Inz(3)
05/19/04
3500 D RcvType 10 Inz('*ESCAPE')
05/19/04
3600 D RcvKey 10I 0
05/19/04
3700 D RcvAction 10 Inz('*OLD')
05/19/04
3800 D RcvWait 10I 0 Inz(0)
05/18/04
3900
05/14/04
4000 DAPIErrorDS DS
05/18/04
4100 D APIBytes 10I 0 Inz(%Size(APIErrorDS))
05/14/04
4200 D APIBytesOut 10I 0 Inz(0)
05/18/04
4300 D APIErrID 7A
05/14/04
4400 D APIReserved 1A
05/14/04
4500 D APIErInDta 256A
05/14/04
4600 0055
05/17/04
4700 0056 C Dou *InLR
05/07/04
4800 0057 C clear CSrec1
05/11/04
4900 0057 C exfmt CSupdt01
05/11/04
5000 0057 C If *InKC or
05/07/04
5100 0057 C *InKG
05/07/04
5200 0057 C eval *InLR = *On
05/07/04
5300 0057 C leave
05/07/04
5722WDS V5R2M0 020719 SEU SOURCE LISTING
05/19/04 10:51:15 PAGE 2
SOURCE FILE . . . . . . . EXPRDPGM/QRPGSRC
MEMBER . . . . . . . . . CSUPDT
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7
...+... 8 ...+... 9 ...+... 0
5400 0057 C EndIf
05/07/04
5500 0057 * KK .. go back to screen 1
05/17/04
5600 0057 * ...
05/17/04
5700 0057 * Otherwise process screen 2
05/17/04
5800 0057 C If Not *InKK
05/17/04
5900 0057 C CSdlr# chain csxb00
05/07/04
6000 0057 C If %Found(csxb00)
05/11/04
6100 0057 C eval Mesg = Mesg_Updt
05/17/04
6200 0057 C Dow Mesg <> *Blanks
05/17/04
6300 0057 C exfmt CSupdt02
05/11/04
6400 0057 C If *InKC or
05/11/04
6500 0057 C *InKG
05/11/04
6600 0057 C eval *InLR = *On
05/11/04
6700 0057 C leave
05/11/04
6800 0057 C EndIf
05/11/04
6900
05/17/04
7000 c eval Mesg = *Blanks
05/17/04
7100 0057 C Monitor
05/18/04
7200 0057 C update CSb00
05/17/04
7300 0057 C on-error
05/18/04
7400 0057 C exsr RecvError
05/17/04
7500 0057 C Endmon
05/18/04
7600 0058 C EndDo
05/14/04
7700 0058 * Customer Not found
05/17/04
7800 0058 C Else
05/14/04
7900 0057 C eval Mesg = ' Invalid Customer '
05/14/04
8000 0057 C EndIf
05/11/04
8100 0058
05/14/04
8200 0057 C EndIf
05/17/04
8300 0058 C EndDo
05/14/04
8400
05/17/04
8500 * Receive program error message
05/17/04
8600 C RecvError BegSr
05/14/04
8700 C CALL 'QMHRCVPM'
Recv Error Message 05/14/04
8800 C PARM RcvData
05/14/04
8900 C PARM RcvDtaLen
05/14/04
9000 C PARM RcvFormat
05/14/04
9100 C PARM RcvMsgQ
05/14/04
9200 C PARM RcvStack
05/14/04
9300 C PARM RcvType
05/14/04
9400 C PARM RcvKey
05/14/04
9500 C PARM RcvWait
05/14/04
9600 C PARM RcvAction
05/14/04
9700 C PARM ApiErrorDs
Error Code 05/14/04
9800
05/19/04
9900
05/17/04
10000 c If RcvDtaLen = 0
05/17/04
10100 c leavesr
05/17/04
10200 c EndIf
05/17/04
10300
05/19/04
10400 * Show me if anything came back
05/19/04
10500 C eval Mesg = 'xxx ' +
%Trim(%Editc(ApiBytes:'Z')) 05/17/04
10600 C + ' ' +
%Trim(%Editc(ApiBytesOut:'Z')) 05/17/04
5722WDS V5R2M0 020719 SEU SOURCE LISTING
05/19/04 10:51:15 PAGE 3
SOURCE FILE . . . . . . . EXPRDPGM/QRPGSRC
MEMBER . . . . . . . . . CSUPDT
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7
...+... 8 ...+... 9 ...+... 0
10700 C + ' ' +
%Triml(%Trimr(RcvData)) 05/17/04
10800 C + ' ' +
%Trim(%Editc(RcvDtaLen:'Z')) 05/17/04
10900 C + ' ' +
%Triml(%Trimr(ApiErrId)) 05/17/04
11000 C + ' ' +
%Triml(%Trimr(ApiErInDta))) 05/17/04
11100 * Just get out of here
05/17/04
11200 c leavesr
05/17/04
11300
**************************************************************************************
05/17/04
11400
05/19/04
11500 * Load the message if any
05/19/04
11600 c eval Mesg = ApiErrId
05/17/04
11700
05/19/04
11800 C EndSr
05/14/04
* * * * E N D O F S O U R C E * * * *
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.
