*===================================================================== d EC ds d ByteIn 9b 0 inz(0) d ByteOut 9b 0 inz(0) d ErrorId 7 inz(' ') d Resvd1 1 inz(' ') d ErrorDta 20 inz(' ') *===================================================================== d VALIDCALL pr n d ProcArray 500 const options(*varsize) d ProcArrayL 5i 0 const *===================================================================== d PEPEnt pr n *===================================================================== d QWVRCSTK pr extpgm('QWVRCSTK') d Rcvr 4096 options(*varsize) d RcvrL 10i 0 d RcvFmt 8 const d JobIdInf 26 const options(*varsize) d JobIdFmt 8 const d ErrorCode like(EC) *++++++++ d JobIdInf ds d JobName 10 inz('*') d UserName 10 inz(' ') d JobNo 6 inz(' ') d IntJobId 16 inz(' ') d Rsvd1 2 inz(x'0000') d ThreadInd 10i 0 inz(1) d ThreadId 8 inz(x'0000000000000000') *===================================================================== d RVP s * inz(%addr(RV)) d RVL s 10i 0 inz(%len(RV)) d RV ds 65534 d BytesRet 10i 0 d BytesAvail 10i 0 d NoEntriesTh 10i 0 d CallStackOS 10i 0 d NoEntriesRet 10i 0 d ThreadIdRet 8 d InfStatus 1 d Resvd 1 *===================================================================== d CSEP s * d CSE ds 65535 based(CSEP) qualified d Len 10i 0 d StmIdOS 10i 0 d StmIdNo 10i 0 d PNOS 10i 0 d PNLen 10i 0 d ReqLev 10i 0 d ProgName 10 d ProgLib 10 d MIInstrNo 10i 0 d ModName 10 d ModLib 10 d CntrlBndry 1 d Resvd 3 d ActGrpNo 10u 0 d ActGrpName 10 d Resvd2 2 d ProgASPName 10 d ProgLibName 10 d ProgASPNo 10i 0 d ProgLibASPNo 10i 0 d ActGrpNoLong 20u 0 * Reserved CHAR(*) * Statement identifiers ARRAY(*) of CHAR(10) * Procedure name CHAR(*) *++++++++ d PP s * d PN s 256 based(PP) d PN1 s 1 based(PP) d Procedure s 256 *===================================================================== * Check for Valid Caller *===================================================================== p VALIDCALL b export d VALIDCALL pi n d ProcArray 500 const options(*varsize) d ProcArrayL 5i 0 const *===================================================== d Procs s 500 d I s 5i 0 *===================================================== /free //=================================================== monitor; //====================================== Procs = %subst(ProcArray:1:ProcArrayL); //====================================== QWVRCSTK(RV:RVL:'CSTK0100':JobIdInf:'JIDF0100':EC); CSEP = RVP + CallStackOS; //====================================== dou PEPEnt(); CSEP += CSE.Len; enddo; //====================================== Procedure = *blank; //====================================== dou Procedure <> *blank; //====================================== CSEP += CSE.Len; //====================================== if CSE.PNOS = 0; iter; endif; //====================================== PP = CSEP + CSE.PNOS; Procedure = %subst(PN:1:CSE.PNLen); //====================================== if PN1 = '_'; Procedure = *blank; iter; endif; //====================================== enddo; //====================================== if %scan(%trim(Procedure):Procs:1)<>0; return '1'; else; return '0'; endif; //====================================== on-error; ERH03(); endmon; //============================================================ /end-free p VALIDCALL e *===================================================================== * PEP: Check if CSE is PEP <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< *===================================================================== p PEPEnt b d PEPEnt pi n *===================================================== /free //=================================================== monitor; //====================================== if CSE.PNOS = 0; return '0'; endif; //====================================== PP = CSEP + CSE.PNOS; Procedure = %subst(PN:1:CSE.PNLen); //====================================== if %scan('PEP':Procedure) <> 0; return '1'; else; return '0'; endif; //====================================== on-error; ERH03(); endmon; //============================================================ /end-free p PEPEnt e *=====================================================================