Figure II

* ===================================================================

* ——————————————————————-
* – RtvNbrStkEnt – Retrieve number of call stack entries –
* ——————————————————————-
D RtvNbrStkEnt PR 1à˜I à˜
D 1à˜ Value
D 1à˜ Value
D 6 Value
D 272 Options( *NoPass )

* ——————————————————————-
* – RtvStkEnt – Retrieve call stack entry –
* ——————————————————————-
D RtvStkEnt PR N
D 1à˜ Value
D 1à˜ Value
D 6 Value
D 1à˜I à˜ Value
D 1à˜I à˜
D 1à˜
D 1à˜
D 1à˜
D 1à˜
D 1à˜
D 4à˜96
D 272 Options( *NoPass )

* ——————————————————————-
* – RtvCallStkAPI – Retrieve call stack API –
* ——————————————————————-
D RtvCallStkAPI PR ExtPgm( ‘QWVRCSTK’ )
D 65535
D 1à˜I à˜
D 8
D 56
D 8
D 272

* ===================================================================
* = Procedure….. RtvNbrStkEnt =
* = Description… Retrieve number of call stack entries =
* ===================================================================

.
.
.

D RtvInfoDS DS 65535
D 8
D TotStkEnt 1à˜I à˜
D 4
D NbrStkEnt 1à˜I à˜
D 8
D Status 1

.
.
.

D RtvInfoDS DS 65535
D 8
D TotStkEnt 1à˜I à˜
D FirstEntOff 1à˜I à˜
D NbrStkEnt 1à˜I à˜
D 8
D Status 1

D RtvInfoDSLen S 1à˜I à˜ Inz( %Len( RtvInfoDS ) )
D RtvInfoFmt S 8 Inz( ‘CSTKà˜1à˜à˜’ )

D StkEntDS DS Based( StkEntPtr )
D EntLen 1à˜I à˜
D 8
D PrcDisplace 1à˜I à˜
D PrcNameLen 1à˜I à˜
D RequestLevel 1à˜I à˜
D PgmName 1à˜
D PgmLibName 1à˜
D 4
D ModName 1à˜
D ModLibName 1à˜
D 8
D ActGrpName 1à˜

StkEntPtr S *

PrcNameArea S 4à˜96 Based( PrcNamePtr )
PrcNamePtr S *

D PrcName S 4à˜96

D JobIDInfoDS DS
D JobName 1à˜ Inz( *Blank )
D JobUser 1à˜ Inz( *Blank )
D JobNbr 6 Inz( *Blank )
D 16 Inz( *Blank )
D 2 Inz( *AllX’à˜à˜’ )
D 1à˜I à˜ Inz( 2 )
D 8 Inz( *AllX’à˜à˜’ )

D JobIDFmt S 8 Inz( ‘JIDFà˜1à˜à˜’ )$
D BadStatusError DS
D 1à˜I à˜ Inz( %Size( BadStatusError
D 1à˜I à˜ Inz( 16 )
D 7 Inz( ‘CPF9898′ )
D 1 Inz( X’à˜à˜’ )
D 256 Inz( ‘Unexpected error’ )

D BadEntNbrError DS
D 1à˜I à˜ Inz( %Size( BadEntNbrError ) )
D 1à˜I à˜ Inz( 2à˜ )
D 7 Inz( ‘CPF9898′ )
D 1 Inz( X’à˜à˜’ )
D 256 Inz( ‘Invalid entry number’ )

D RcvSizeError DS
D 1à˜I à˜ Inz( %Size( RcvSizeError ) )
D 1à˜I à˜ Inz( 16 )
D 7 Inz( ‘CPF9898′ )
D 1 Inz( X’à˜à˜’ )
D 256 Inz( ‘Receiver too small’ )

* ——————————————————————-
* – Determine whether API error parameter was passed –
* ——————————————————————-
C If %Parms > 11
C Eval APIErrorPassed = *On
C EndIf

* ——————————————————————-
* – Load input parameters –
* ——————————————————————-
C Eval JobName = JobNameIn
C Eval JobUser = JobUserIn
C Eval JobNbr = JobNbrIn

* ——————————————————————-
* – Retrieve call stack –
* ——————————————————————-
C Reset APIErrorDS
C CallP RtvCallStkAPI(
C R tvInfoDS :
C RtvInfoDSLen:
C RtvInfoFmt :
C JobIDInfoDS :
C JobIDFmt :
C APIErrorDS
C )
C If BytesAvail <> NoAPIError
C ExSr ReturnError
C EndIf

H
I
J
C If EntNbr <= *Zero or
C EntNbr > NbrStkEnt
C Eval APIErrorDS = BadEntNbrError
C ExSr ReturnError
C EndIf

C If Status <> *Blank
C Eval APIErrorDS = BadStatusError
C ExSr ReturnError
C EndIf

C If NbrStkEnt <> TotStkEnt
C Eval APIErrorDS = RcvSizeError
C ExSr ReturnError
C EndIf

* ——————————————————————-
* – Extract call stack entry information –
* ——————————————————————-
C Eval StkEntPtr = %Addr( RtvInfoDS ) +
C FirstEntOff
C Do EntNbr
C Eval PrcNamePtr = StkEntPtr + PrcDisplace
C Eval PrcName = %Subst( PrcNameArea:
C 1 :
C PrcNameLen )
C Eval RtnRqsLvl = RequestLevel
C Eval RtnPgmName = PgmName
C Eval RtnPgmLib = PgmLibName
C Eval RtnModName = ModName
C Eval RtnModLib = ModLibName
C Eval RtnActGrpName = ActGrpName
C Eval RtnPrcName = PrcName
C Eval StkEntPtr = StkEntPtr + EntLen
C EndDo
C Return *Off

* ——————————————————————-
* – Subroutine…. ReturnError –
* – Description… Return error condition to caller –
* ——————————————————————-
C ReturnError BegSr
C If APIErrorPassed
C Eval APIError = APIErrorDS
C EndIf
C Return *On
C EndSr