2000-03-21 如何知道程式是被哪一支程式 Called (Who call me) ?

如何知道程式是被哪一支程式 Called (Who call me) ?

例如 A call B, 而且 C 也 call B,  而 B 要如何知道程式是被 A Called or C Called ?
所以要利用程式堆疊(Program Satck)及 訊息處理的技巧來決定,例如 : 
*                                                CALL STACK      */
*   TSTCALLID1 CALL                                    2         */
*                   TSTCALLIDC CALL                    1         */
*                                   CALLINGPGM         0         */
所以要知道哪一支程式 Call TSTCALLIDC, 於 TSTCALLIDC 中, 設定 Stack =2, 
CALL       PGM(CALLINGPGM) PARM(&PGMNAM &STACK), 
傳回參數 PGMNAM 即為 Calling Program 的程式名稱 

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

CLP : TSTCALLID1
/* WANT TO KNOW WHICH PROGRAM CALL TSTCALLIDC                     */ 
/*   CALL TSTCALLID1 FROM COMMAND LINE                            */ 
/*   CALL TSTCALLID1 (X'0F') RETURN 'CALLINGPGM'                  */ 
/*   CALL TSTCALLID1 (X'1F') RETURN 'TSTCALLIDC'                  */ 
/*   CALL TSTCALLID1 (X'2F') RETURN TSTCALLID1 ->     RESULT      */ 
                                                                     
/*   SO WE WANT TO WHICH PGM CALL ME                              */ 
/*   CALL CALLINGPGM (X'2F') WILL RETURN CALLING PGM NAME         */ 
                                                                     
             PGM        PARM(&STACK)                                 
             DCL        VAR(&PGMNAM) TYPE(*CHAR) LEN(10)             
             DCL        VAR(&STACK) TYPE(*DEC) LEN(1 0)              
                                                                     
             CALL       PGM(TSTCALLIDC) PARM(&PGMNAM &STACK)         
             SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&PGMNAM) 
                                                                     
             ENDPGM                                                  

CLP : TSTCALLIDC
             PGM        PARM(&PGMNAM &STACK)                          
                                                                      
             DCL        VAR(&PGMNAM) TYPE(*CHAR) LEN(10)              
             DCL        VAR(&STACK) TYPE(*DEC) LEN(1 0)               
                                                                      
             CALL       PGM(CALLINGPGM) PARM(&PGMNAM &STACK)          
                                                                      
             ENDPGM

CLP: CALLINGPGM
            PGM        PARM(&CALLINGPGM &STACK)                       
                                                                      
            DCL        VAR(&CALLINGPGM) TYPE(*CHAR) LEN(10)           
            DCL        VAR(&STACK) TYPE(*DEC) LEN(1 0)                
                                                                      
            DCL        VAR(&STKCNT) TYPE(*CHAR) LEN(4)                
            DCL        VAR(&ERRCDE) TYPE(*CHAR) LEN(4) +              
                         VALUE(X'00000000')                           
            DCL        VAR(&WAITTIME) TYPE(*CHAR) LEN(4)              
            DCL        VAR(&MSGLEN) TYPE(*CHAR) LEN(4)                
            DCL        VAR(&BLKMSGID) TYPE(*CHAR) LEN(7)              
            DCL        VAR(&BLKMSGF) TYPE(*CHAR) LEN(20)              
            DCL        VAR(&MSGKEY) TYPE(*CHAR) LEN(4)                
            DCL        VAR(&MSGTYPE) TYPE(*CHAR) LEN(10)              
            DCL        VAR(&RCVMSG) TYPE(*CHAR) LEN(200)                                                                 
            CHGVAR     VAR(%BIN(&STKCNT)) VALUE(&STACK)               
            CHGVAR     VAR(%BIN(&MSGLEN)) VALUE(5)                    
            CHGVAR     VAR(&MSGTYPE) VALUE('*INFO')                   
  /*SEND REQUEST FOR PROGRAM NAME  */                                  
            CALL       PGM(QSYS/QMHSNDPM) PARM(&BLKMSGID &BLKMSGF +   
                          'DUMMY' &MSGLEN &MSGTYPE '*' &STKCNT +       
                          &MSGKEY &ERRCDE)                             
                                                                       
            CHGVAR     VAR(%BIN(&MSGLEN)) VALUE(200)                  
            CHGVAR     VAR(%BIN(&WAITTIME)) VALUE(0)                  
                                                                       
   /*RECEIVE REQUEST FOR PROGRAM NAME  */                              
            CALL       PGM(QSYS/QMHRCVPM) PARM(&RCVMSG &MSGLEN +      
                          'RCVM0200' '*' &STKCNT &MSGTYPE &MSGKEY +    
                          &WAITTIME '*REMOVE' &ERRCDE)                 

                                                                      
            CHGVAR     VAR(&CALLINGPGM) VALUE(%SST(&RCVMSG 111 10))   
            MONMSG     MSGID(MCH3601)                                 
                                                                      
            RMVMSG     CLEAR(*ALL)                                    
                                                                      
ENDPGM:     ENDPGM