Ü  EXSR (Execute Subroutine)

·         It is used to call and process a subroutine.

·         *PSSR used as subroutine-name operand specifies that the program exception/error subroutine is to be processed.

·         *INZSR as the subroutine-name operand specifies that the program initialization subroutine is to be processed.

 

Example

       I.            *INZSR and other subroutine


0006.09  *____________________________________________________________________
0009.00 C     *IN03         DOWEQ     *OFF
0010.00 C                   EXSR      MAIN                    >>>>>>>>>>>>>>>>>
0010.03 C                   EXSR      DSPSFL                  >>>>>>>>>>>>>>>>>
0011.00 C                   ENDDO
0012.00 C                   SETON                                            LR
0013.00 C*
0014.00 C*_____________________________________________
0015.00 C*____________MAIN SUBROUTINE BEGINS HERE______
0016.00 C*_____________________________________________
0017.00 C     MAIN          BEGSR
0018.00 C**** some operation code comes here
0019.00 C                   ENDSR
0020.00 C*_________________________________________________
0021.00 C*_________________________________________________
0022.00 C*_______________CLEAR SUBFILE_____________________
0023.00 C*_________________________________________________
0024.00 C     CLRSFL        BEGSR
0024.01 C**** Clear the subfile
0029.00 C                   ENDSR
0030.00 C*_________________________________________________
0031.00 C*_______________FIRST FUBROUTINE__________________
0032.00 C*_________________________________________________
0033.00 C*
0034.00 C     *INZSR        BEGSR                              >>>>>>>>>>>>>>>>>>
0034.01 C                   SETOFF                                       505152
0034.02 C                   SETOFF                                       45
0035.00 C                   Z-ADD     *ZEROS        RRN               4 0
0035.01 C                   EVAL      S_RECNO=1
0040.00 C                   ENDSR
0041.00 C*_________________________________________________
0042.00 C*_______________FILL SUBFILE__________________
0043.00 C*_________________________________________________
0044.00 C*
0045.00 C     FILSFL        BEGSR
0047.00 C*** Fill the subfile Buffer
0061.00 C                   ENDSR
0062.00 C*_________________________________________________
0063.00 C*
0064.00 C     DSPSFL        BEGSR
0065.00 C**** Display the subfile
0069.00 C                   ENDSR
****************** End of data ****************************************

 

 

     II.            *PSSR subroutine


Columns . . . :    6  80               Browse                               AMITCC/QRPGLESRC
 SEU==>                                                                            PSDS_PGM2
FMT H  HKeywords++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
*************** Beginning of data *********************************************************
0001.00 HOPTION(*SRCSTMT)                                                               130122
0002.00 DMYPSDS          SDS                                                            130121
0003.00 DPROC_NAME          *PROC                                                       130121
0004.00  * Procedure name                                                               130121
0005.00 DPGM_STATUS         *STATUS                                                     130122
0006.00  * Status code                                                                  130121
0007.00                                                                                 130121
0008.00 D LINE_NUM               21     28                                              130121
0009.00  * Source statement line no.                                                    130122
0010.00                                                                                 130121
0011.00 DA                S              2  0 INZ(*ZEROS)                               130122
0012.00 DB                S              2  0 INZ(10)                                   130122
0013.00 DC                S              2  0 INZ(*ZEROS)                               130122
0014.00 D@ERR             S             50    INZ(*BLANKS)                              130122
0015.00 C     B             DIV       A             C                                   130122
0016.00 C     TAG1          TAG                                                         130122
0017.00 C     'C=Infinite'  DSPLY                                                       130122
0018.00 C                   SETON                                        LR             130122
0019.00 C     *PSSR         BEGSR                  >>>>>>>>>>                           130122
0020.00 C                   IF        PGM_STATUS=00102                                  130122
0021.00 C                   EVAL      @ERR='Error at line no.'+                         130122
0022.00 C                                  LINE_NUM + ' with status code '+             130122
0023.00 c                                  %CHAR(PGM_STATUS)                            130122
0024.00 C     @ERR          DSPLY                                                       130122
0025.00 C                   GOTO      TAG1                                              130122
0026.00 C*                  MOVE      '*GETIN'      Retur             6                 130122
0027.00 C                   ELSE                                                        130122
0028.00 C     'FATAL ERR'   DSPLY                                                       130122
0029.00 C                   MOVE      '*CANCL'      Retur             6                 130122
0030.00 C                   ENDIF                                                       130122
0031.00 C                   ENDSR     Retur                                             130122
****************** End of data **************************************************************











User Comments:



Copyright © www.go4as400.com, 2013-2023. Copyright notice   Terms of services   Privacy policy