Sample Program to Call IDMSTBLU BUILD Function

Products

• IDMS

Issue/Introduction

This is a sample program to call IDMSTBLU as the first step in a MAINTAIN INDEX utility to build the User-Owned index for the EMP-COVERAGE set referenced in Knowledge doc 138937  

 

Environment

Release: All Supported Releases

Component:  IDMS DB

Resolution

      *RETRIEVAL                                                      
      *NO-ACTIVITY-LOG                                                
      *DMLIST                                                         
       IDENTIFICATION DIVISION.                                       
       PROGRAM-ID.               CTICOBL.                             
       ENVIRONMENT DIVISION.                                          
       IDMS-CONTROL SECTION.                                          
       PROTOCOL. MODE IS BATCH DEBUG                                  
                 IDMS-RECORDS WITHIN WORKING-STORAGE.                 
                                                                      
       DATA DIVISION.                                                 
                                                                      
       SCHEMA SECTION.                                                
      ************************************************************'   
      *EMPSS01 = OLD-SSC                                              
      *EMPSCHM = OLD-SCHEMA                                           
      ************************************************************'   
       DB EMPSS01  WITHIN EMPSCHM  VERSION 100.                       
                                                                      
       WORKING-STORAGE SECTION.                                       
       01  MISC-WORK-FIELDS.                                          
           02 WS-END-OF-MEM1-SW        PIC X(01) VALUE 'N'.           
              88  END-OF-MEM1                    VALUE 'Y'.           
           02 WS-END-OF-OWN1-SW        PIC X(01) VALUE 'N'.           
              88  END-OF-OWN1                    VALUE 'Y'.           
           02 WS-END-OF-MEM2-SW        PIC X(01) VALUE 'N'.           
              88  END-OF-MEM2                    VALUE 'Y'.           
           02 WS-END-OF-OWN2-SW        PIC X(01) VALUE 'N'.           
              88  END-OF-OWN2                    VALUE 'Y'.           
      ********************************************                    
      *          EMPSS02  -> NEW-SSC                                  
      *          EMPDEMO  -> DBNAME                                   
      *          R180DMCL -> DMCL                                     
      ********************************************                    
       01  SUBSCHEMA-TYPE.                                            
           02  FILLER            PIC S9(8)   COMP VALUE +1.           
           02  FILLER            PIC X(8)     VALUE IS 'EMPSS02 '.    
           02  FILLER            PIC X(8)     VALUE IS 'EMPDEMO '.    
           02  FILLER            PIC X(8)     VALUE IS 'R180DMCL'.    
                                                                      
       01  OWNER-TYPE.                                                
           02  FILLER            PIC S9(8)    COMP VALUE +2.          
           02  OWNER-FUNCTION    PIC X(8).                            
           02  OWNER-SET         PIC X(16).                           
           02  OWNER-DBKEY       PIC S9(8)    COMP.                   
                                                                      
       01  MEMBER-TYPE.                                               
           02  FILLER            PIC S9(8)    COMP  VALUE +3.         
           02  MEMBER-REC        PIC X(16).                           
           02  MEMBER-DBKEY      PIC S9(8)    COMP.                   
           02  MEMBER-NUM-SETS   PIC S9(8)    COMP  VALUE IS +1.      
           02  MEMBER-SET        PIC X(16).                           
           02  MEMBER-OWN-DBK    PIC S9(8)    COMP.                   
                                                                      
       01  EOF-TYPE.                                                  
           02  FILLER            PIC S9(8)    COMP VALUE IS -1.       
                                                                      
      *                                                               
       PROCEDURE DIVISION.                                            
      *                                                               
       0010-INITIALIZATION SECTION.                                   
      *                                                               
           MOVE 'CTICOBL ' TO PROGRAM-NAME.                           
           BIND RUN-UNIT.                                             
           PERFORM IDMS-STATUS.                                       
           BIND EMPLOYEE.                                             
           PERFORM IDMS-STATUS.                                       
           BIND COVERAGE.                                             
           PERFORM IDMS-STATUS.                                       
           READY USAGE-MODE IS  RETRIEVAL.                            
           PERFORM IDMS-STATUS.                                       
           CALL 'IDMSTBLU' USING SUBSCHEMA-TYPE.                      
      *************************************************************** 
      *  MAIN PROCESSING LOOP                                         
      *EMPLOYEE      ->  OWNER RECORD                                 
      *EMP-DEMO-REGION ->  OWNER AREA                                 
      *************************************************************** 
           OBTAIN FIRST EMPLOYEE WITHIN EMP-DEMO-REGION.              
           IF DB-STATUS-OK                                            
               PERFORM 2200-REPORT-OWNER THRU 2299-EXIT               
                   UNTIL END-OF-OWN2                                  
           ELSE                                                       
               DISPLAY 'NO EMPLOYEES IN DB '                          
                       '(ERROR STATUS: ' ERROR-STATUS ')'.            
           CALL 'IDMSTBLU' USING EOF-TYPE.                            
           FINISH.                                                    
           PERFORM IDMS-STATUS.                                       
           GOBACK.                                                    
                                                                      
      *************************************************************** 
       2200-REPORT-OWNER.                                             
           MOVE 'N' TO WS-END-OF-MEM2-SW.                             
                                                                      
      *************************************************************** 
      *EMP-COVERAGE    -> SET NAME                                    
      *************************************************************** 
           MOVE 'BUILD   ' TO OWNER-FUNCTION.                         
           MOVE 'EMP-COVERAGE   ' TO OWNER-SET.                       
           MOVE DBKEY TO OWNER-DBKEY.                                 
           CALL 'IDMSTBLU' USING OWNER-TYPE.                          
                                                                      
      *************************************************************** 
      *COVERAGE       ->  MEMBER RECORD                               
      *EMP-COVERAGE   ->  SET NAME                                    
      *************************************************************** 
           OBTAIN FIRST COVERAGE WITHIN EMP-COVERAGE.                 
           IF DB-STATUS-OK                                            
               PERFORM 2300-REPORT-MEM THRU 2399-EXIT                 
                   UNTIL END-OF-MEM2                                  
           ELSE                                                       
               DISPLAY '   NO COVERAGES FOR THIS EMPLOYEE '           
                       '(ERROR STATUS: ' ERROR-STATUS ')'.            
                                                                      
       2280-GET-NEXT-OWN.                                             
      *************************************************************** 
      *EMPLOYEE        ->  OWNER RECORD                               
      *EMP-DEMO-REGION ->  OWNER AREA                                 
      *************************************************************** 
           OBTAIN NEXT EMPLOYEE WITHIN EMP-DEMO-REGION.               
           IF ERROR-STATUS = '0307'                                   
               MOVE 'Y' TO WS-END-OF-OWN2-SW.                         
                                                                      
       2299-EXIT.                                                     
           EXIT.                                                      
                                                                      
      *************************************************************** 
      *COVERAGE      ->  MEMBER RECORD                                
      *EMP-COVERAGE  ->  SET NAME                                     
      *************************************************************** 
       2300-REPORT-MEM.                                               
           MOVE 'COVERAGE        ' TO MEMBER-REC.                     
           MOVE 'EMP-COVERAGE   ' TO MEMBER-SET.                      
           MOVE OWNER-DBKEY  TO MEMBER-OWN-DBK.                       
           MOVE DBKEY TO MEMBER-DBKEY.                                
           CALL 'IDMSTBLU' USING MEMBER-TYPE.                         
                                                                      
      *************************************************************** 
      *COVERAGE      ->  MEMBER RECORD                                
      *EMP-COVERAGE  ->  SET NAME                                     
      *************************************************************** 
       2380-GET-NEXT-COVERAGE.                                        
           OBTAIN NEXT COVERAGE WITHIN EMP-COVERAGE.                  
           IF ERROR-STATUS = '0307'                                   
               MOVE 'Y' TO WS-END-OF-MEM2-SW.                         
                                                                      
       2399-EXIT.                                                     
           EXIT.                                                      
      *                                                               
      *                                                               
       COPY IDMS IDMS-STATUS                                          
       IDMS-ABORT SECTION.                                            
       IDMS-ABORT-EXIT.                                               
           EXIT.                      

Additional Information

Note: For more information see the "Maintaining user-owned indexes" heading in the USAGE section of the Maintain Index documentation