H DFTNAME(TESTLOK) DATEDIT(*YMD/) BNDDIR('QC2LE')                                              
     F**********  標識を使わない LOOKUP 命令 *******************************                        
     F*                                                                                             
     F**********************************************************************                        
                                                                                                    
      * CRTBNDRPG PGM(OBJLIB/TESTLOK) SRCFILE(SRCLIB/QRPGLESRC) DFTACTGRP(*NO)                      
      * ACTGRP(*NEW) DBGVIEW(*SOURCE) AUT(*ALL)                                                     
                                                                                                    
     D SHCODE          S             10A                                                            
     D CDR             S             10A   DIM(256)                                                 
     D MKR             S              1A   DIM(256)                                                 
     D N               S              4S 0                                                          
                                                                                                    
     C                   MOVEL(P)  'NV-CF1'      SHCODE                                             
      *(1) 標識を使った READ 命令                                                                   
     C                   Z-ADD     1             N                                                  
     C     SHCODE        LOOKUP    CDR(N)                                 50                        
     C   50              MOVE      '*'           MKR(N)                                             
                                                                                                    
      *(2) 標識を使わない READ 命令                                                                 
     C                   EVAL      N = %LOOKUP(SHCODE:CDR)                                          
     C                   IF        N > 0                                                            
     C                   MOVE      '*'           MKR(N)                                             
     C                   ENDIF                                                                      
      /FREE                                                                                         
            N = %LOOKUP(SHCODE:CDR);                                                                
            IF N > 0;                                                                               
              MKR(N) = '*';                                                                         
            ENDIF;                                                                                  
      /END-FREE                                                                                     
     C                   SETON                                        LR                            
     C                   RETURN