Calling IDMSIN01 from a COBOL Program

When calling IDMSIN01 from a COBOL program, the first two parameters passed are always the address of an RPB block and the address of the function REQUEST-CODE and RETURN-CODE fields. The rest of the parameters depend on what service is being called.
idmscu19
When calling IDMSIN01 from a COBOL program, the first two parameters passed are always the address of an RPB block and the address of the function REQUEST-CODE and RETURN-CODE fields. The rest of the parameters depend on what service is being called.
COBOL Program Calling IDMSIN01
COBOL programs can use standard calling conventions. The following is an example of calling all IDMSIN01 functions from a COBOL program.
      ENVIRONMENT DIVISION.         DATA DIVISION.       WORKING-STORAGE SECTION.        **************************************************************      *     The following is the 1st parameter on all IDMSIN01 calls      **************************************************************       01  RPB.           02  FILLER             PIC X(36).        **************************************************************      *     The following is the 2nd parameter on all IDMSIN01 calls      **************************************************************       01  REQ-WK.           02  REQUEST-CODE      PIC S9(8) COMP.               88  IN01-FN-TRACE            VALUE 00.               88  IN01-FN-NOTRACE          VALUE 01.               88  IN01-FN-GETPROF          VALUE 02.               88  IN01-FN-SETPROF          VALUE 03.               88  IN01-FN-GETMSG           VALUE 04.               88  IN01-FN-GETDATE          VALUE 05.               88  IN01-FN-GETUSER          VALUE 08.               88  IN01-FN-SYSCTL           VALUE 10.               88  IN01-FN-TRINFO           VALUE 16.               88  IN01-FN-TXNSON           VALUE 28.               88  IN01-FN-TXNSOFF          VALUE 29.               88  IN01-FN-RRSCTX           VALUE 30.               88  IN01-FN-STRCONV          VALUE 34.               88  IN01-FN-ENVINFO          VALUE 36.               88  IN01-FN-FRMTDBK          VALUE 40.           02  REQUEST-RETURN     PIC S9(8) COMP.        **************************************************************      *     The following work fields are used by a variety of      *     IDMSIN01 calls      **************************************************************       01  WORK-FIELDS.           02  WK-DTS-FORMAT          PIC S9(8) COMP VALUE 0.           02  LINE-CNT               PIC S9(4) COMP.           02  WK-DTS                 PIC X(8).           02  WK-CDTS                PIC X(26).           02  WK-KEYWD               PIC X(8).           02  WK-VALUE               PIC X(32).           02  WK-DBNAME              PIC X(8).           02  WK-USERID              PIC X(32).           02  WK-SYSCTL              PIC X(8).           02  WK-TIME-INTERNAL       PIC X(8).           02  WK-TIME-EXTERNAL       PIC X(8).           02  WK-DATE-INTERNAL       PIC X(8).           02  WK-DATE-EXTERNAL       PIC X(10).           02  WK-RRS-FAKE-FUNCTION   PIC S9(4) COMP.               88  IN01-FN-RRSCTX-GET       VALUE 01.               88  IN01-FN-RRSCTX-SET       VALUE 02.           02  WK-RRS-FUNCTION-REDEF    REDEFINES WK-RRS-FAKE-FUNCTION.               03  WK-RRS-FAKE-FILLER PIC X.               03  WK-RRS-FUNCTION    PIC X.           02  WK-RRS-CONTEXT         PIC X(16).           02  WK-STRING-FUNCTION     PIC X(4).               88  CONVERT-EBCDIC-TO-ASCII  VALUE 'ETOA'.               88  CONVERT-ASCII-TO-EBCDIC  VALUE 'ATOE'.           02  WK-STRING              PIC X(17)                                            VALUE 'String to convert'.           02  WK-STRING-LENGTH       PIC S9(8) COMP VALUE 17.           02  WK-DBKEY-OUTPUT        PIC X(12).        **************************************************************      *     The following group item is only used by the call that      *     returns runtime environment information.      **************************************************************       01  EVBLOCK.           02  EV$SIZE            PIC S9(4) COMP VALUE +31.           02  EV$MODE            PIC X.           02  EV$TAPE#           PIC X(6).           02  EV$REL#            PIC X(6).           02  EV$SPACK           PIC X(2).           02  EV$DMCL            PIC X(8).           02  EV$NODE            PIC X(8).        **************************************************************      *     The following group item is only used by the call that      *     retrieves SQL error messages      **************************************************************       01  SQLMSGB.           02  SQLMMAX            PIC S9(8) COMP VALUE +6.           02  SQLMSIZE           PIC S9(8) COMP VALUE +80.           02  SQLMCNT            PIC S9(8) COMP.           02  SQLMLINE           OCCURS 6 TIMES PIC X(80).        **************************************************************      *     The following SQL include statement is needed only for      *     the call that retrieves SQL error messages, and is only      *     required if the program contains no other SQL statements.      **************************************************************       EXEC SQL           INCLUDE SQLCA       END-EXEC.        *********************************************************       PROCEDURE DIVISION.      *********************************************************        *********************************************************      *  Call IDMSIN01 to deactivate the DML trace or SQL trace      *  which was originally activated by the corresponding      *  SYSIDMS parm (DMLTRACE=ON or SQLTRACE=ON).      *      *    Parm 1 is the address of the RPB.      *    Parm 2 is the address of the REQUEST-CODE and RETURN-CODE.      *********************************************************             SET IN01-FN-NOTRACE TO TRUE.           CALL 'IDMSIN01' USING RPB REQ-WK.        *********************************************************      *  Call IDMSIN01 to request a 'GETPROF' to get the user      *  profile default DBNAME, which was established by the      *  SYSIDMS parm DBNAME=xxxxxxxx when running batch, or      *  by the DCUF SET DBNAME xxxxxxxx when running under CV.      *      *    Parm 1 is the address of the RPB.      *    Parm 2 is the address of the REQUEST-CODE and RETURN-CODE.      *    Parm 3 is the address of the 8 byte GETPROF keyword.      *    Parm 4 is the address of the 32 byte GETPROF returned value.      *********************************************************             SET IN01-FN-GETPROF TO TRUE.           MOVE 'DBNAME' TO WK-KEYWD           CALL 'IDMSIN01' USING RPB REQ-WK WK-KEYWD             WK-VALUE.           MOVE WK-VALUE TO WK-DBNAME.           IF WK-DBNAME = SPACES             DISPLAY 'DBNAME is set to BLANKS'                    ELSE             DISPLAY 'DBNAME is set to ' WK-DBNAME.        *********************************************************      *  Call IDMSIN01 to activate Transaction Sharing for this      *  task.      *      *    Parm 1 is the address of the RPB.      *    Parm 2 is the address of the REQUEST-CODE and RETURN-CODE.      *********************************************************             SET IN01-FN-TXNSON  TO TRUE.           CALL 'IDMSIN01' USING RPB REQ-WK.        *********************************************************      *  Call IDMSIN01 to deactivate Transaction Sharing for this      *  task.      *      *    Parm 1 is the address of the RPB.      *    Parm 2 is the address of the REQUEST-CODE and RETURN-CODE.      *********************************************************             SET IN01-FN-TXNSOFF TO TRUE.           CALL 'IDMSIN01' USING RPB REQ-WK.        *********************************************************      *  Call IDMSIN01 to request a 'SETPROF' to set the user      *  profile default SCHEMA to the value 'SYSTEM'.      *      *    Parm 1 is the address of the RPB.      *    Parm 2 is the address of the REQUEST-CODE and RETURN-CODE.      *    Parm 3 is the address of the 8 byte SETPROF keyword.      *    Parm 4 is the address of the 32 byte SETPROF value.      *********************************************************             SET IN01-FN-SETPROF TO TRUE.           MOVE 'SCHEMA' TO WK-KEYWD           MOVE 'SYSTEM' TO WK-VALUE           CALL 'IDMSIN01' USING RPB REQ-WK WK-KEYWD             WK-VALUE.           IF REQUEST-RETURN NOT = 0             DISPLAY 'SETPROF returned error ' REQUEST-RETURN.        *********************************************************      *  Call IDMSIN01 to request the current USERID established      *  by the executed JCL information when running batch, or      *  by the SIGNON USER xxxxxxxx when running under CV.      *      *    Parm 1 is the address of the RPB.      *    Parm 2 is the address of the REQUEST-CODE and RETURN-CODE.      *    Parm 3 is the address of the 32 byte USERID returned value.      *********************************************************             SET IN01-FN-GETUSER TO TRUE.           CALL 'IDMSIN01' USING RPB REQ-WK WK-USERID.           IF WK-USERID = SPACES             DISPLAY 'USERID is set to BLANKS'                    ELSE             DISPLAY 'USERID is set to ' WK-USERID.        *********************************************************      *  Call IDMSIN01 to establish the SYSCTL DDNAME to be used      *  when running a Batch/CV job.      *      *    Parm 1 is the address of the RPB.      *    Parm 2 is the address of the REQUEST-CODE and RETURN-CODE.      *    Parm 3 is the address of the 8 byte SYSCTL DDNAME passed.      *********************************************************             SET IN01-FN-SYSCTL  TO TRUE.           MOVE 'SYSCTL73' TO WK-SYSCTL.           CALL 'IDMSIN01' USING RPB REQ-WK WK-SYSCTL.         ******************************************************************       * Call IDMSIN01 to retrieve the current RRS context token.       * Uses an alternate method to set the function by using the       * SET statement, which allows exploiting the LEVEL 88 definitions.       ******************************************************************              SET IN01-FN-RRSCTX       TO TRUE.            SET IN01-FN-RRSCTX-GET   TO TRUE.            CALL 'IDMSIN01' USING RPB,                                  REQ-WK,                                  WK-RRS-FUNCTION,                                  WK-RRS-CONTEXT.         ******************************************************************       * Call IDMSIN01 to request string conversion from EBCDIC to ASCII.       ******************************************************************              SET IN01-FN-STRCONV           TO TRUE.            SET CONVERT-EBCDIC-TO-ASCII   TO TRUE.            CALL 'IDMSIN01' USING RPB,                                  REQ-WK,                                  WK-STRING-FUNCTION,                                  WK-STRING,                                  WK-STRING-LENGTH.         ******************************************************************       * Call IDMSIN01 to request string conversion from ASCII to EBCDIC.       ******************************************************************              SET IN01-FN-STRCONV           TO TRUE.            SET CONVERT-ASCII-TO-EBCDIC   TO TRUE.            CALL 'IDMSIN01' USING RPB,                                  REQ-WK,                                  WK-STRING-FUNCTION,                                  WK-STRING,                                  WK-STRING-LENGTH.          *********************************************************      *  Call IDMSIN01 to have an 8 byte internal DATETIME stamp      *  returned as a displayable 26 character DATE/TIME display.      *      *    Parm 1 is the address of the RPB.      *    Parm 2 is the address of the REQUEST-CODE and RETURN-CODE.      *    Parm 3 is the address of the 4 byte format indicator (0).      *    Parm 4 is the address of the 8 byte internal DATETIME stamp.      *    Parm 5 is the address of the 26 byte DATE/TIME returned.      *********************************************************             SET IN01-FN-GETDATE TO TRUE.              MOVE 0 TO WK-DTS-FORMAT              MOVE 'UNKNOWN' TO WK-CDTS           CALL 'IDMSIN01' USING RPB REQ-WK                 WK-DTS-FORMAT WK-DTS WK-CDTS.              DISPLAY 'THE DATE AND TIME IS -->  ' WK-CDTS.        *********************************************************      *  Call IDMSIN01 to have the current DATE and TIME      *  returned as a displayable 26 character DATE/TIME display.      *      *    Parm 1 is the address of the RPB.      *    Parm 2 is the address of the REQUEST-CODE and RETURN-CODE.      *    Parm 3 is the address of the 4 byte format indicator (1).      *    Parm 4 is the address of the 26 byte DATE/TIME returned.      *********************************************************             SET IN01-FN-GETDATE TO TRUE.              MOVE 1 TO WK-DTS-FORMAT           CALL 'IDMSIN01' USING RPB REQ-WK                 WK-DTS-FORMAT WK-CDTS.              DISPLAY 'THE DATE AND TIME IS -->  ' WK-CDTS.        *********************************************************      *  Call IDMSIN01 to have a 26 byte external DATE/TIME display      *  returned as an 8 byte DATETIME stamp.      *      *    Parm 1 is the address of the RPB.      *    Parm 2 is the address of the REQUEST-CODE and RETURN-CODE.      *    Parm 3 is the address of the 4 byte format indicator (2).      *    Parm 4 is the address of the 26 byte DATE/TIME.      *    Parm 5 is the address of the 8 byte DATETIME stamp returned.      *********************************************************             SET IN01-FN-GETDATE TO TRUE.              MOVE 2 TO WK-DTS-FORMAT              MOVE '1994-07-18-12.01.18.458382' TO WK-CDTS           CALL 'IDMSIN01' USING RPB REQ-WK                 WK-DTS-FORMAT WK-CDTS WK-DTS.        *********************************************************      *  Call IDMSIN01 to have a 8 byte external TIME display      *  returned as an 8 byte TIME stamp.      *      *    Parm 1 is the address of the RPB.      *    Parm 2 is the address of the REQUEST-CODE and RETURN-CODE.      *    Parm 3 is the address of the 4 byte format indicator (4).      *    Parm 4 is the address of the 8 byte external TIME.      *    Parm 5 is the address of the 8 byte TIME stamp returned.      *********************************************************             SET IN01-FN-GETDATE TO TRUE.              MOVE 4 TO WK-DTS-FORMAT              MOVE '13.58.11' TO WK-TIME-EXTERNAL           CALL 'IDMSIN01' USING RPB REQ-WK WK-DTS-FORMAT                 WK-TIME-EXTERNAL WK-TIME-INTERNAL.        *********************************************************      *  Call IDMSIN01 to have an 8 byte internal TIME stamp      *  returned as a displayable 8 character TIME display.      *      *    Parm 1 is the address of the RPB.      *    Parm 2 is the address of the REQUEST-CODE and RETURN-CODE.      *    Parm 3 is the address of the 4 byte format indicator (3).      *    Parm 4 is the address of the 8 byte internal TIME stamp.      *    Parm 5 is the address of the 8 byte external TIME returned.      *********************************************************             SET IN01-FN-GETDATE TO TRUE.              MOVE 3 TO WK-DTS-FORMAT           CALL 'IDMSIN01' USING RPB REQ-WK WK-DTS-FORMAT                 WK-TIME-INTERNAL WK-TIME-EXTERNAL.              DISPLAY 'THE EXTERNAL TIME IS -->  ' WK-TIME-EXTERNAL.        *********************************************************      *  Call IDMSIN01 to have a 10 byte external DATE display      *  returned as an 8 byte DATE stamp.      *      *    Parm 1 is the address of the RPB.      *    Parm 2 is the address of the REQUEST-CODE and RETURN-CODE.      *    Parm 3 is the address of the 4 byte format indicator (6).      *    Parm 4 is the address of the 10 byte external DATE.      *    Parm 5 is the address of the 8 byte DATE stamp returned.      *********************************************************             SET IN01-FN-GETDATE TO TRUE.              MOVE 6 TO WK-DTS-FORMAT              MOVE '2003-03-10' TO WK-DATE-EXTERNAL           CALL 'IDMSIN01' USING RPB REQ-WK WK-DTS-FORMAT                 WK-DATE-EXTERNAL WK-DATE-INTERNAL.        *********************************************************      *  Call IDMSIN01 to have an 8 byte internal DATE stamp      *  returned as a displayable 10 character DATE display.      *      *    Parm 1 is the address of the RPB.      *    Parm 2 is the address of the REQUEST-CODE and RETURN-CODE.      *    Parm 3 is the address of the 4 byte format indicator (5).      *    Parm 4 is the address of the 8 byte internal DATE stamp.      *    Parm 5 is the address of the 10 byte external DATE returned.      *********************************************************             SET IN01-FN-GETDATE TO TRUE.              MOVE 5 TO WK-DTS-FORMAT           CALL 'IDMSIN01' USING RPB REQ-WK WK-DTS-FORMAT                 WK-DATE-INTERNAL WK-DATE-EXTERNAL.              DISPLAY 'THE EXTERNAL DATE IS -->  ' WK-DATE-EXTERNAL.        *********************************************************      *  Call IDMSIN01 to have an 8 byte internal DATETIME stamp      *  converted from UTC to local time returned as a            *  displayable 26 character DATE/TIME display.      *      *    Parm 1 is the address of the RPB.      *    Parm 2 is the address of the REQUEST-CODE and RETURN-CODE.      *    Parm 3 is the address of the 4 byte format indicator (0).      *    Parm 4 is the address of the 8 byte internal      *              UTC formatted DATETIME stamp.      *    Parm 5 is the address of the 26 byte local      *              DATE/TIME returned.      *********************************************************             SET IN01-FN-GETDATE TO TRUE.              MOVE 7 TO WK-DTS-FORMAT              MOVE 'UNKNOWN' TO WK-CDTS           CALL 'IDMSIN01' USING RPB REQ-WK                 WK-DTS-FORMAT WK-DTS WK-CDTS.              DISPLAY 'THE LOCAL DATE AND TIME IS -->  ' WK-CDTS.        *********************************************************      *  Call IDMSIN01 to retrieve SQL error messages into a user      *  buffer that will then be displayed back to the user.      *  Whats passed is the SQLCA block and a message control      *  block consisting of the following fields:      *      *           - Maximum number of lines in user buffer.      *           - The size (width) of one line in the user buffer.      *           - The actual number of lines returned from IDMSIN01.      *           - The user buffer where the message lines are returned.      *      *  A return code of 4 means that there were no SQL error messages.      *  A return code of 8 means that there were more SQL error lines      *  in the SQLCA than could fit into the user buffer, meaning      *  truncation has occurred.      *      *    Parm 1 is the address of the RPB.      *    Parm 2 is the address of the REQUEST-CODE and RETURN-CODE.      *    Parm 3 is the address of the SQLCA block.      *    Parm 4 is the address of the message control block.      *********************************************************             SET IN01-FN-GETMSG  TO TRUE.           CALL 'IDMSIN01' USING RPB, REQ-WK,                 SQLCA, SQLMSGB.           IF REQUEST-RETURN NOT = 4             MOVE 1 TO LINE-CNT             PERFORM DISP-MSG UNTIL LINE-CNT > SQLMCNT.         DISP-MSG SECTION.           DISPLAY SQLMLINE (LINE-CNT).           ADD 1 TO LINE-CNT.        *********************************************************      *  Call IDMSIN01 to reactivate the DML trace or SQL trace      *  which was originally activated by the corresponding      *  SYSIDMS parm (DMLTRACE=ON or SQLTRACE=ON), that has      *  been previously deactivated earlier on in this job.      *      *    Parm 1 is the address of the RPB.      *    Parm 2 is the address of the REQUEST-CODE and RETURN-CODE.      *********************************************************             SET IN01-FN-TRACE   TO TRUE.           CALL 'IDMSIN01' USING RPB REQ-WK.        *********************************************************      *  Call IDMSIN01 to request that it return runtime      *  environment information.      *      *  Parm 1 is the address of the RPB.      *  Parm 2 is the address of the REQUEST-CODE and RETURN-CODE.      *  Parm 3 is the address of the ENVINFO return area.      *********************************************************             SET IN01-FN-ENVINFO TO TRUE.           CALL 'IDMSIN01' USING RPB REQ-WK EVBLOCK.           DISPLAY 'Runtime mode is  ' EV$MODE.           DISPLAY 'CA IDMS tape volser is  ' EV$TAPE#.           DISPLAY 'CA IDMS release number is  ' EV$REL#.           DISPLAY 'CA IDMS service pack number is  ' EV$SPACK.           DISPLAY 'DMCL name is  ' EV$DMCL.           DISPLAY 'System node name is  ' EV$NODE.        *********************************************************      *  Call IDMSIN01 to format dbkey stored in SUBSCHEMA-CTRL      *********************************************************              SET IN01-FN-FRMTDBK TO TRUE.            CALL 'IDMSIN01' USING RPB,                                  REQ-WK,                                  DBKEY,                                  PAGE-INFO-DBK-FORMAT,                                  WK-DBKEY-OUTPUT.            DISPLAY ‘DBKEY = ‘ WK-DBKEY-OUTPUT.