Refer to shipped RPG source file QRPGLRSRC and CRTDEMO program source in QCLSRC source file.
This service uses files that have been shipped in the JSM instance folder.
H OPTION(*SRCSTMT : *NODEBUGIO) DFTACTGRP(*NO) ACTGRP(*CALLER)
H BNDDIR('JSMBNDDIR')
*
* V6R1 - Limits
* Maximum data structure size is 16,773,104 bytes
* Data structure size = element size * occurrence
*
D FieldDef1 S 60A DIM(11) CTDATA
D FieldDefSize S 10I 0 INZ(0)
D FieldEntSize S 10I 0 INZ(0)
D ListDef1 S 60A DIM(1) CTDATA
D ListDef2 S 60A DIM(3) CTDATA
D ListDefSize S 10I 0 INZ(0)
D ListEntSize S 10I 0 INZ(0)
D ListCount S 10I 0 INZ(0)
D ListMaxCount S 10I 0 INZ(0)
*
D JSMHDL S 4A INZ(*BLANKS)
D JSMSRV S 50A INZ(*BLANKS)
D JSMSTS S 20A INZ(*BLANKS)
D JSMMSG S 512A INZ(*BLANKS)
D JSMCMD S 512A INZ(*BLANKS)
D ZEROLENGTH S 10I 0 INZ(0)
*
D FLD1 DS
D PRDID 10A INZ('CORD443')
D PRDAVL 200A
D PRDDSC 200A
D PRDAMTMP 10P 2 INZ(499.99)
D PRDAMTYP 10P 2 INZ(499.99)
D PRDAMTB10 10P 2 INZ(431.99)
D PRDAMTB20 10P 2 INZ(413.99)
D PRDAMTB30 10P 2 INZ(359.99)
D PRDCOUNT 3S 0 INZ(25)
D PRDDATE D DATFMT(*ISO)
D PRDDATETIME Z
*
D LST1 DS OCCURS(10)
D TEXT 30A
*
D LST2 DS OCCURS(10)
D COL1 10A
D COL2 10A
D COL3 10P 2
*
* JSMX_BEGIN
*
C CALLB(D) 'JSMX_BEGIN'
C PARM *OMIT
C PARM ZEROLENGTH
*
* JSMX_OPEN - USE JSMCLTDTA FOR SERVER
*
C CLEAR JSMSRV
C EVAL JSMSRV = ''
C CALLB(D) 'JSMX_OPEN'
C PARM JSMHDL
C PARM JSMSRV
C PARM JSMSTS
C PARM JSMMSG
C CALLP checkSTS(JSMSTS:JSMMSG)
*
* SERVICE_LOAD
*
C CLEAR JSMCMD
C EVAL JSMCMD = 'SERVICE_LOAD' +
C ' SERVICE(PDFDocumentService)' +
C ' TRACE(*YES)'
C CALLB(D) 'JSMX_COMMAND'
C PARM JSMHDL
C PARM JSMCMD
C PARM JSMSTS
C PARM JSMMSG
C CALLP checkSTS(JSMSTS:JSMMSG)
*
* CREATE
*
C CLEAR JSMCMD
C EVAL JSMCMD = 'CREATE' +
C ' DOCUMENT(demo.pdf)' +
C ' CONTENT(demo-product.xml)'
C CALLB(D) 'JSMX_COMMAND'
C PARM JSMHDL
C PARM JSMCMD
C PARM JSMSTS
C PARM JSMMSG
C CALLP checkSTS(JSMSTS:JSMMSG)
*
* ADD PRODUCT - BIND FIELDS
*
C EVAL PRDAVL = 'Available in 24 hours'
C EVAL PRDDSC = '18V Compact Hammer.' +
C ' Power output 350W.'
C EVAL PRDDATE = %DATE()
C EVAL PRDDATETIME = %TIMESTAMP()
*
C EVAL FieldDefSize = %SIZE(FieldDef1:*ALL)
C EVAL FieldEntSize = %SIZE(FLD1)
C CALLB(D) 'JSMX_BINDFLD'
C PARM JSMHDL
C PARM FieldDef1
C PARM FieldDefSize
C PARM FLD1
C PARM FieldEntSize
C PARM JSMSTS
C PARM JSMMSG
C CALLP checkSTS(JSMSTS:JSMMSG)
*
* ADD PRODUCT - BIND LIST
*
C 1 OCCUR LST1
C EVAL TEXT = '4-piece combo kit'
C 2 OCCUR LST1
C EVAL TEXT = '3-speed transmission'
*
* Reset list to beginning
C 1 OCCUR LST1
C EVAL ListDefSize = %SIZE(ListDef1:*ALL)
C EVAL ListEntSize = %SIZE(LST1)
C EVAL ListCount = 2
C EVAL ListMaxCount = %ELEM(LST1)
C CALLB(D) 'JSMX_BINDLST'
C PARM JSMHDL
C PARM ListDef1
C PARM ListDefSize
C PARM LST1
C PARM ListEntSize
C PARM ListCount
C PARM ListMaxCount
C PARM JSMSTS
C PARM JSMMSG
C CALLP checkSTS(JSMSTS:JSMMSG)
*
* ADD PRODUCT
*
C CLEAR JSMCMD
C EVAL JSMCMD = 'ADD' +
C ' CONTENT(product)'
C CALLB(D) 'JSMX_COMMAND'
C PARM JSMHDL
C PARM JSMCMD
C PARM JSMSTS
C PARM JSMMSG
C CALLP checkSTS(JSMSTS:JSMMSG)
*
* ADD TABLE - BIND LIST
*
C 1 OCCUR LST2
C EVAL COL1 = 'Text 11'
C EVAL COL2 = 'Text 12'
C EVAL COL3 = 100.34
C 2 OCCUR LST2
C EVAL COL1 = 'Text 21'
C EVAL COL2 = 'Text 22'
C EVAL COL3 = 145.67
*
* Reset list to beginning
C 1 OCCUR LST2
C EVAL ListDefSize = %SIZE(ListDef2:*ALL)
C EVAL ListEntSize = %SIZE(LST2)
C EVAL ListCount = 2
C EVAL ListMaxCount = %ELEM(LST2)
C CALLB(D) 'JSMX_BINDLST'
C PARM JSMHDL
C PARM ListDef2
C PARM ListDefSize
C PARM LST2
C PARM ListEntSize
C PARM ListCount
C PARM ListMaxCount
C PARM JSMSTS
C PARM JSMMSG
C CALLP checkSTS(JSMSTS:JSMMSG)
*
* ADD TABLE
*
C CLEAR JSMCMD
C EVAL JSMCMD = 'ADD' +
C ' CONTENT(table)'
C CALLB(D) 'JSMX_COMMAND'
C PARM JSMHDL
C PARM JSMCMD
C PARM JSMSTS
C PARM JSMMSG
C CALLP checkSTS(JSMSTS:JSMMSG)
*
* CLOSE
*
C CLEAR JSMCMD
C EVAL JSMCMD = 'CLOSE'
C CALLB(D) 'JSMX_COMMAND'
C PARM JSMHDL
C PARM JSMCMD
C PARM JSMSTS
C PARM JSMMSG
C CALLP checkSTS(JSMSTS:JSMMSG)
*
* SERVICE_UNLOAD
*
C CLEAR JSMCMD
C EVAL JSMCMD = 'SERVICE_UNLOAD'
C CALLB(D) 'JSMX_COMMAND'
C PARM JSMHDL
C PARM JSMCMD
C PARM JSMSTS
C PARM JSMMSG
C CALLP checkSTS(JSMSTS:JSMMSG)
*
* JSMX_CLOSE
*
C CALLB(D) 'JSMX_CLOSE'
C PARM JSMHDL
C PARM JSMSTS
C PARM JSMMSG
C CALLP checkSTS(JSMSTS:JSMMSG)
*
* JSMX_END
*
C CALLB(D) 'JSMX_END'
*
C SETON LR
********************************
* Procedure to check JSM status
********************************
P checkSTS B
D checkSTS PI N
D csJSMSTS CONST LIKE(JSMSTS)
D csJSMMSG CONST LIKE(JSMMSG)
D csMSGTXT S 512A
C IF csJSMSTS <> 'OK'
C EVAL csMSGTXT = %TRIM(csJSMSTS) + ' ' +
C %TRIM(csJSMMSG)
C CALLP sendMSG(csMSGTXT)
C RETURN *OFF
C ENDIF
C RETURN *ON
P E
**************************************
* Procedure to send a program message
**************************************
P sendMSG B
D sendMSG PI
D smMSGTXT 512A VALUE
D smMSGT S 10A INZ('*DIAG')
D smMSGI S 7A INZ('CPF9897')
D smMSGF S 20A INZ('QCPFMSG *LIBL ')
D smMSGL S 10I 0 INZ(%SIZE(smMSGTXT))
D smSTKE S 10A INZ('*')
D smSTKC S 10I 0 INZ(1)
D smMSGK S 4A INZ(*BLANK)
D smERRC S 10I 0 INZ(0)
C CALL 'QMHSNDPM'
C PARM smMSGI
C PARM smMSGF
C PARM smMSGTXT
C PARM smMSGL
C PARM smMSGT
C PARM smSTKE
C PARM smSTKC
C PARM smMSGK
C PARM smERRC
P E
**CTDATA FieldDef1
PRDID A000001000
PRDAVL A000020000
PRDDSC A000020000
PRDAMTMP P000001002
PRDAMTYP P000001002
PRDAMTB10 P000001002
PRDAMTB20 P000001002
PRDAMTB30 P000001002
PRDCOUNT S000000300
PRDDATE A000001000
PRDDATETIME A000002600
**CTDATA ListDef1
TEXT A000003000
**CTDATA ListDef2
COL1 A000001000
COL2 A000001000
COL3 P000001002