The following example shows invoking the FLMLNK NOPROM service to set the member FLM01EQU as non-promotable. Using the NOREBUILD parameter causes SCLM to promote everything except the FLM01EQU member and its accounting record.

For more information, see the NOPROM service in Chapter 15.

IDENTIFICATION DIVISION.
 PROGRAM-ID.   FLM02CBL.
*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
*@@.THIS PROGRAM ALLOWS YOU TO CALL SCLM SERVICES FROM A COBOL   @
*@@ PROGRAM.                                                     @
*@@                                                              @
*@@.THE FUNCTION OF THIS PROGRAM IS TO PERFORM AN SCLM NOPROM ON @
*@@ THE COPYBOOK FLM01EQU IN THE DEV1 GROUP.                     @
*@@                                                              @
*@@ 5647-A01 (C) COPYRIGHT IBM CORP. 1987, 2000                  @
*@@                                                              @
*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 ENVIRONMENT DIVISION.
 DATA DIVISION.
 WORKING-STORAGE SECTION.
 01  PROGRAM-NAME       PIC X(08) VALUE 'FLM02CBL'.
 01  SCLM-SERVICE       PIC X(08).
 01  SCLM-PROJECT       PIC X(08).
 01  SCLM-ALT-PROJ      PIC X(08).
 01  SCLM-GROUP         PIC X(08).
 01  SCLM-TYPE          PIC X(08).
 01  SCLM-MEMBER        PIC X(08).
 77  SCLM-SCLM-ID       PIC X(08) VALUE SPACE.
 77  SCLM-APPL-ID       PIC X(08) VALUE SPACE.
 77  SCLM-AUTHCODE      PIC X(08) VALUE SPACE.
 77  SCLM-NOPROM-FIELD  PIC X(16).
 77  SCLM-ACCESS-KEY    PIC X(16) VALUE SPACE.
 77  SCLM-ACCT-INFO     PIC S9(04) COMP VALUE ZERO.
 77  SCLM-LIST-INFO     PIC S9(04) COMP VALUE ZERO.
 77  SCLM-MSG-ARRAY     PIC S9(04) COMP VALUE ZERO.
 77  SCLM-DD-PRSLIST    PIC X(08) VALUE 'SYSOUT'.
 77  SCLM-DD-MSGS       PIC X(08) VALUE 'MDS3602M'.
 77  SCLM-DD-EXIT       PIC X(08) VALUE SPACE.
 77  SCLM-MSG-LINE      PIC X(80) VALUE SPACE.
*
 LINKAGE SECTION.
PROCEDURE DIVISION.
1-DRIVER.
*---------------------------------------------------------
* FLMLNK NOPROM,JPHILP,OS2G,DEV1,SOURCE,FLM01EQU,NOREBUILD
*---------------------------------------------------------
     MOVE 'SCLMPROJ'      TO SCLM-PROJECT
     MOVE 'SCLMPROJ'      TO SCLM-ALT-PROJ
     MOVE 'DEV1'          TO SCLM-GROUP
     MOVE 'SOURCE'        TO SCLM-TYPE
     MOVE 'FLM01EQU'      TO SCLM-MEMBER
     MOVE 'NOREBUILD'     TO SCLM-NOPROM-FIELD

     MOVE 'START'     TO SCLM-SERVICE
     CALL 'FLMLNK' USING SCLM-SERVICE
                         SCLM-APPL-ID.
     DISPLAY 'START RETURN CODE =  ' RETURN-CODE.
     MOVE 'INIT'      TO SCLM-SERVICE
     CALL 'FLMLNK' USING SCLM-SERVICE
                         SCLM-APPL-ID
                         SCLM-PROJECT
                         SCLM-ALT-PROJ
                         SCLM-SCLM-ID
                         SCLM-MSG-LINE.
     DISPLAY 'INIT  RETURN CODE =  ' RETURN-CODE.

     MOVE 'NOPROM'    TO SCLM-SERVICE
     CALL 'FLMLNK' USING SCLM-SERVICE
                         SCLM-SCLM-ID
                         SCLM-GROUP
                         SCLM-TYPE
                         SCLM-MEMBER
                         SCLM-NOPROM-FIELD
                         SCLM-ACCESS-KEY
                         SCLM-MSG-LINE.
     DISPLAY 'NOPROM RETURN CODE =  ' RETURN-CODE.
     IF RETURN-CODE > 0 THEN
         DISPLAY SCLM-MSG-LINE.
     MOVE 'FREE'      TO SCLM-SERVICE
     CALL 'FLMLNK' USING SCLM-SERVICE
                         SCLM-SCLM-ID
                         SCLM-MSG-LINE.
     DISPLAY 'FREE  RETURN CODE =  ' RETURN-CODE.

     MOVE 'END'       TO SCLM-SERVICE
     CALL 'FLMLNK' USING SCLM-SERVICE
                         SCLM-APPL-ID
                         SCLM-MSG-LINE.
     DISPLAY 'END   RETURN CODE =  ' RETURN-CODE.
     DISPLAY ' '.
     DISPLAY 'NOPROM COMPLETED'.
     DISPLAY 'LOAD FLM02CBL ENDED'.

     GOBACK.
 1-EXIT. EXIT.