home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / 3x400 / pgmrexit.lzh / PMRGSRCO.RPG < prev   
Text File  |  1987-06-30  |  7KB  |  81 lines
  1.      H* CRTOPT GENOPT(*OPTIMIZE)                                                
  2.      H* CRTOPT PUBAUT(*ALL)                                                     
  3.      H                                                                          
  4.       /SPACE 1                                                                  
  5.      H********************************************************************      
  6.      H* PROGRAM-             PMRGSRCO                                    *      
  7.      H* AUTHOR-              GREG THIELEN                                *      
  8.      H* DATE WRITTEN-        JUNE 4, 1986                                *      
  9.      H* PROGRAM DESCRIPTION- EXTRACT CREATE OPTIONS FROM SOURCE MEMBER.  *      
  10.      H********************************************************************      
  11.      FSRCFILE IF  F      92            DISK                                     
  12.      E                    RQS       512  1                REQUEST DATA          
  13.      E                    OPT        50  1                CREATE OPTION         
  14.      E                    PAT        11  1                SEARCH PATTERN        
  15.      ISRCRCD      DS                             92                             
  16.      I                                       21  26 OPTID                       
  17.      I                                       28  77 OPT                         
  18.      C           *ENTRY    PLIST                                                
  19.      C                     PARM           RQS                                   
  20.      C                     PARM           RL      30                            
  21.       /SPACE 1                                                                  
  22.      C           SCPLST    PLIST                                                
  23.      C                     PARM           RQS                                   
  24.      C                     PARM           RL                                    
  25.      C                     PARM 1         STRPOS  30                            
  26.      C                     PARM           PAT                                   
  27.      C                     PARM           PL      30                            
  28.      C                     PARM '0'       XLATE   1                             
  29.      C                     PARM '0'       TRIM    1                             
  30.      C                     PARM           WILD    1                             
  31.      C                     PARM           RESULT  30                            
  32.       /SPACE 1                                                                  
  33.      C                     Z-ADD512       RQSLEN  30                            
  34.      C                     Z-ADD50        OPTLEN  30                            
  35.      C*                                                                         
  36.      C                     READ SRCFILE   SRCRCD         90                     
  37.      C           *IN90     DOWEQ'0'                                             
  38.      C           OPTID     ANDEQ'CRTOPT'                                        
  39.      C           RQSLEN    SUB  RL        AVL     30                            
  40.      C                     ADD  1         AVL                                   
  41.      C*                                                                         
  42.      C                     Z-ADD1         OB      30                            
  43.      C           OB        DOWLEOPTLEN                                          
  44.      C           OPT,OB    ANDEQ*BLANK                                          
  45.      C                     ADD  1         OB                                    
  46.      C                     END                                                  
  47.      C*                                                                         
  48.      C           OB        IFLE OPTLEN                                          
  49.      C*                                                                         
  50.      C                     Z-ADDOPTLEN    OE      30                            
  51.      C           OE        DOWGEOB                                              
  52.      C           OPT,OE    ANDEQ*BLANK                                          
  53.      C                     SUB  1         OE                                    
  54.      C                     END                                                  
  55.      C*                                                                         
  56.      C           OE        SUB  OB        OL      30                            
  57.      C                     ADD  2         OL                                    
  58.      C           OL        IFLE AVL                                             
  59.      C*                                                                         
  60.      C                     MOVE *ZEROS    RESULT                                
  61.      C                     MOVE *BLANKS   PAT                                   
  62.      C                     MOVEAOPT,OB    PAT                                   
  63.      C                     Z-ADD1         PL                                    
  64.      C           '('       LOKUPPAT,PL                   10                     
  65.      C           *IN10     IFEQ '1'                                             
  66.      C                     CALL 'QCLSCAN' SCPLST                                
  67.      C                     END                                                  
  68.      C*                                                                         
  69.      C           RESULT    IFEQ *ZEROS                                          
  70.      C           RL        ADD  2         X       30                            
  71.      C                     MOVEAOPT,OB    RQS,X                                 
  72.      C                     ADD  OL        RL                                    
  73.      C                     END                                                  
  74.      C*                                                                         
  75.      C                     END                                                  
  76.      C                     END                                                  
  77.      C                     READ SRCFILE   SRCRCD         90                     
  78.      C                     END                                                  
  79.      C                     SETON                     LR                         
  80.      C                     RETRN                                                
  81.