News Stay informed about the latest enterprise technology news and product updates.

Code for working with menus

Code for working with menus

   
@@@@@  VMYMENU2B - Menu display file
A                                      DSPSIZ(24 80 *DS3)              
A                                      PRINT                           
A                                      CA03(03 'EXIT PROGRAM')         
A                                      CA10(10 'EXIT MENU')            
A          R MNUBAR1                   MNUBAR                          
A                                      OVERLAY                         
A                                      MNUBARDSP                       
A                                      MNUCNL(CA10)                    
A            MNU_SEL1       2Y 0B  1  2MNUBARCHC(1 PULL1 '>Reports')   
A                                      MNUBARCHC(2 PULL2 '>Jobs')      
A                                      MNUBARCHC(3 PULL3 '>Messages')  
A                                      MNUBARCHC(4 PULL4 '>Tools')     
A                                      MNUBARCHC(5 PULL5 '>Menu Admin')
A                                      MNUBARCHC(6 PULL6 '>Exit')  
A          R PULL1                     PULLDOWN                    
A            PULL_1         2Y 0B  1  2SNGCHCFLD                   
A                                      CHOICE(1 '>Find Member')    
A          R PULL2                     PULLDOWN                    
A            PULL_2         2Y 0B  1  2SNGCHCFLD                   
A                                      CHOICE(1 '>Submitted Jobs') 
A                                      CHOICE(2 '>Active Jobs')    
A          R PULL3                     PULLDOWN                    
A            PULL_3         2Y 0B  1  2SNGCHCFLD                   
A                                      CHOICE(1 '>DeskMaster')     
A                                      CHOICE(2 '>Pager Messages') 
A          R PULL4                     PULLDOWN                    
A            PULL_4         2Y 0B  1  2SNGCHCFLD                
A                                      CHOICE(1 '>Job Scheduler'
A                                      CHOICE(2 '>Spool Files') 
A                                      CHOICE(3 '>Command Line')
A          R PULL5                     PULLDOWN                 
A            PULL_5         2Y 0B  1  2SNGCHCFLD                
A                                      CHOICE(1 '>Add Menu Title
A                                      CHOICE(2 '>Copy User')   
A                                      CHOICE(3 '>Add Menu Item'
A          R PULL6                     PULLDOWN                 
A            PULL_6         2Y 0B  1  2SNGCHCFLD                
A                                      CHOICE(1 '>Exit Menu')   
A          R FMT001                                             
A                                      CF05(05 'UPDATE')        
A                                      CF12(12 'PREVIOUS')              
A                                  1  2'EM400/MYMENURP/VMYMENU'         
A            MY2_DESC      30   O  1 27DSPATR(HI)                       
A                                      DSPATR(RI)                       
A                                  1 71DATE                             
A                                      EDTCDE(Y)                        
A                                  2  2USER                             
A                                  2 71TIME                             
A                                  7 22'FROM USER ID:'                  
A                                      COLOR(BLU)                       
A            V_FROMUSER    10A  B  7 36COLOR(PNK)                       
A  68                                  ERRMSG('USER NOT FOUND IN MYMENUPF' 68) 
A                                  9 24'TO USER ID:'                    
A                                      COLOR(BLU)                       
A            V_TOUSER      10A  B  9 36COLOR(PNK)                       
A  67                                  ERRMSG('USER ID ALREADY EXIST IN MY- 
A                                      MENUPF' 67)                     
A            PUSH_BUTN2     2Y 0B 21  4PSHBTNFLD                       
A                                      PSHBTNCHC(1 'CMD3: EXIT' CA03)  
A                                      PSHBTNCHC(2 'CMD5: UPDATE' CF05)
A                                      PSHBTNCHC(3 'CMD12: PREVIOUS' CF12)
A            V_MESG        70A  O 23  2DSPATR(HI)                      
A          R SFL001                    SFL                             
A            H1_OPTION      4S 0H                                      
A            S1_OPTION      2Y 0O  5  2DSPATR(HI)                      
A                                      EDTCDE(Z)                       
A  37                                  DSPATR(ND)                      
A            S1_DESC       30A  O  5  5                                
A  37                                  DSPATR(HI)                      
A          R SFLCTL1                   SFLCTL(SFL001)                  
A  *DS3                                SFLLIN(0002)    
A                                      SFLSIZ(0099)                
A                                      SFLPAG(0030)                
A  29                                  SFLDSPCTL                   
A  31                                  SFLDSP                      
A  30                                  SFLCLR                      
A  31                                  SFLEND(*SCRBAR *MORE)       
A            RRN001         4S 0H      SFLRCDNBR                   
A                                  3  2'EM400/MYMENURP2/VMYMENU2'  
A            MY2_DESC      30A  O  3 29DSPATR(HI)                  
A                                      DSPATR(RI)                  
A                                  3 71DATE                        
A                                      EDTCDE(Y)                   
A                                  4  2USER                        
A                                  4 71TIME                        
A          R BTM001                                                
A                                      OVERLAY     

@@@@@  MYMENURP2B - RPGLE program to display menu options.
FVMYMENU2B CF   E             WORKSTN                                   
F                                     SFILE(SFL001:RRN001)              
FMYMENUPF  IF A E           K DISK                                      
FMYMENUPF2 IF   E           K DISK                                      
FEMPLYFL   IF   E           K DISK                                      
D lower           C                   CONST('abcdefghijklmnopqrstuvwxyz') 
D UPPER           C                   CONST('ABCDEFGHIJKLMNOPQRSTUVWXYZ') 
D DBU             S             40    INZ('CALL MYMNUMNTRP')            
D DBU2            S             40    INZ('DBU MYMENUPF2')              
D QCMND           S            256                                      
D PROG            S            256                                      
D CMND            S            256                                      
D MENU            S             40                                      
D HLD_USER        S             10                                      
D HLD_DEPT        S              3                                      
D W_PROGRAM       S             10                                      
D H_EMULATE       S             10    
D PROGDS         SDS                  
D  $CRT                 244    253    
D    DSP_TEST           244    246    
D  $USER                254    263    
D                 DS                  
D USER_DS                 1    100    
D   MYM_USER1             1     20    
D   MYM_USER2            21     40    
D   MYM_USER3            41     60    
D   MYM_USER4            61     80    
D   MYM_USER5            81    100    
D                 DS                                          
D DEPT_DS                 1    100                            
D   MYM_DEPT1             1     20                            
D   MYM_DEPT2            21     40                            
D   MYM_DEPT3            41     60                            
D   MYM_DEPT4            61     80                            
D   MYM_DEPT5            81    100                            
D                 DS                                          
D MYM_DESC                1     50                            
D   MYM_DESC_CMN          1      1                            
C* IF USER CODE PASSED INTO PROGRAM, USE IT IN PLACE OF $USER.
C     *ENTRY        PLIST                
C                   PARM                    P_USER           10      
C     lower:UPPER   XLATE     P_USER        P_USER                   
C                   EVAL      V_EMULATE = P_USER                     
C                   EVAL      V_EMULATE2 = P_USER                    
C*                                                                   
C* KEY LIST FOR MENU DATA FILE(MYMENUPF).                            
C     KEY_MENU      KLIST                                            
C                   KFLD                    V_EMULATE                
C                   KFLD                    H1_OPTION                
C********************************************************************
C                   EVAL      HLD_USER = $USER                       
C                   IF        $USER = 'QSECOFR'                      
C                   MOVE      '1'           *IN(33)                  
C                   ELSE                                             
C     $USER         CHAIN     EMPLYFL                            72  
C     *IN(72)       CABEQ     '1'           END_IT                   
C     STS           CABEQ     'X'           END_IT                   
C                   EVAL      HLD_DEPT = DEPTCD                 
C                   IF        DEPTCD = 'MIS' AND $USER <> 'RICH'
C                   MOVE      '1'           *IN(33)             
C                   ENDIF                                       
C                   ENDIF                                       
C                   MOVE      '0'           *IN(76)             
C                   IF        DSP_TEST = 'DSP'                  
C                   MOVE      '1'           *IN(76)             
C                   ENDIF                                       
C***************************************************************
C     RELOAD        TAG                                         
C                   IF        V_EMULATE = *BLANKS               
C                   EVAL      V_EMULATE = $USER                 
C                   EVAL      V_EMULATE2 = $USER                
C                   ENDIF                                       
C** POSITION POINTER IN SUBFILE                                 
C                   Z-ADD     0             RRN001              
C                   EVAL      V_MESG = 'PLEASE SELECT YOUR OPTION'      
C                   MOVEA     '010'         *IN(29)                     
C                   WRITE     SFLCTL1                                   
C                   SETOFF                                       3025   
C** READ THE FILE                                                       
C     V_EMULATE     SETLL     MYMENUPF                           94     
C     V_EMULATE     READE     RMYMENU                                94 
C                   EVAL      MY2_DESC = 'MENU OPTIONS FOR - ' + $USER  
C                   IF        NOT *IN(94)                               
C     V_EMULATE     CHAIN     MYMENUPF2                          83     
C                   ENDIF                                               
C     *IN(94)       DOWEQ     '0'                                       
C*USER SELECT / OMITT CHECK.                                            
C                   MOVE      '1'           *IN(50)                     
C                   IF        USER_DS <> *BLANKS AND HLD_DEPT <> 'MIS'  
C                             AND HLD_USER <> 'QSECOFR'                 
C     '*ALL'        SCAN      USER_DS                                50 
C  N50HLD_USER      SCAN      USER_DS                                50
C                   ENDIF                                              
C* DEPARTMENT CODE SELECT / OMITT CHECK.                               
C                   IF        DEPT_DS <> *BLANKS AND HLD_DEPT <> 'MIS' 
C                             AND HLD_USER <> 'QSECOFR' AND *IN(50)    
C     '*ALL'        SCAN      DEPT_DS                                50
C  N50HLD_DEPT      SCAN      DEPT_DS                                50
C                   ENDIF                                              
C                   IF        *IN(50)                                  
C                   ADD       1             RRN001                     
C                   Z-ADD     MYM_OPTION    H1_OPTION                  
C                   Z-ADD     RRN001        S1_OPTION                  
C                   EVAL      S1_DESC = MYM_DESC                       
C                   IF        MYM_DESC_CMN = '*' AND MYM_PROG = *BLANKS
C                             AND MYM_CMND = *BLANKS AND MYM_MENU = ' '
C                   MOVE      '1'           *IN(37)                    
C                   ELSE                                               
C                   MOVE      '0'           *IN(37)                    
C                   ENDIF                                              
C                   WRITE     SFL001                                   
C                   ENDIF                                              
C     V_EMULATE     READE     RMYMENU                                94
C                   ENDDO                                              
C** WRITE THE SUBFILE TO THE SCREEN IF FULL                            
C                   EVAL      H_EMULATE = V_EMULATE                    
C     DSP_SFL001    TAG                                                
C                   Z-ADD     0             V_OPTION                   
C                   IF        RRN001 > 0                               
C                   Z-ADD     1             NUMB              4 0      
C     NUMB          CHAIN     SFL001                             97    
C                   SETON                                        3129  
C                   ELSE                                               
C                   SETON                                        29    
C                   MOVE      '1'           *IN(25)                    
C                   EVAL      V_MESG = 'NO OPTIONS IN MYMENUPF FILE'  
C                   ENDIF                                             
C                   WRITE     SFLCTL1                                 
C                   IF        *IN(33) AND NOT *IN(76)                 
C                   WRITE     MNUBAR1                                 
C                   ENDIF                                             
C                   EXFMT     BTM001                               88 
C                   SETOFF                                       3129 
C* EXIT PROGRAM.                                                      
C     *IN(88)       CABEQ     '1'           END_IT                    
C     *IN(03)       CABEQ     '1'           END_IT                    
C* RESELECT USER ID.                                                  
C     V_EMULATE     CABNE     H_EMULATE     RELOAD                    
C* BEGINNING OF MENU SELECTION.                                      *
C* MUST BE MIS AND NOT A "DSP" WORKSTATION.                           
C                   IF        *IN(33) AND NOT *IN(76)                 
C                   READ      MNUBAR1                                 
C* EXIT MENU.                                                        
C     *IN(10)       CABEQ     '1'           RELOAD                   
C* REPORTS OPTIONS.                                                  
C                   IF        MNU_SEL1 = 1                           
C                   READ      PULL1                                  
C                   IF        PULL_1 = 1                             
C                   CALL      'DSPMBRLST'                          77
C                   GOTO      RELOAD                                 
C                   ENDIF                                            
C                   ELSE                                             
C* JOBS OPTIONS                                                      
C                   IF        MNU_SEL1 = 2                           
C                   READ      PULL2                                  
C                   IF        PULL_2 = 1                             
C                   EVAL      QCMND = 'WRKSBMJOB'                    
C                   CALL      'QCAEXEC'                            77
C                   PARM                    QCMND                    
C                   PARM      256           ALEN             15 5    
C                   GOTO      RELOAD                                 
C                   ELSE                                             
C                   IF        PULL_2 = 2                             
C                   EVAL      QCMND = 'WRKACTJOB'                    
C                   CALL      'QCAEXEC'                            77
C                   PARM                    QCMND                    
C                   PARM      256           ALEN             15 5    
C                   GOTO      RELOAD                                 
C                   ENDIF                                            
C                   ENDIF                                            
C                   ELSE                                             
C* MESSAGES OPTION.                                                  
C                   IF        MNU_SEL1 = 3                           
C                   READ      PULL3                                  
C                   IF        PULL_3 = 1                             
C                   EVAL      QCMND = 'STRDM'                        
C                   CALL      'QCAEXEC'                            77   
C                   PARM                    QCMND                       
C                   PARM      256           ALEN             15 5       
C                   GOTO      RELOAD                                    
C                   ELSE                                                
C                   IF        PULL_3 = 2                                
C                   EVAL      QCMND = 'SNDPGRMSG'                       
C                   CALL      'QCAEXEC'                            77   
C                   PARM                    QCMND                       
C                   PARM      256           ALEN             15 5       
C                   GOTO      RELOAD                                    
C                   ENDIF                                               
C                   ENDIF                                               
C                   ELSE                                                
C* TOOLS OPTIONS                                                        
C                   IF        MNU_SEL1 = 4                              
C                   READ      PULL4                                     
C                   IF        PULL_4 = 1                              
C                   EVAL      QCMND = 'WRKJOBSCDE'                    
C                   CALL      'QCAEXEC'                            77 
C                   PARM                    QCMND                     
C                   PARM      256           ALEN             15 5     
C                   GOTO      RELOAD                                  
C                   ELSE                                              
C                   IF        PULL_4 = 2                              
C                   EVAL      QCMND = 'WRKSPLF'                       
C                   CALL      'QCAEXEC'                            77 
C                   PARM                    QCMND                     
C                   PARM      256           ALEN             15 5     
C                   GOTO      RELOAD                                  
C                   ELSE                                              
C                   IF        PULL_4 = 3                              
C                   CALL      'QCMD'                               77 
C                   GOTO      RELOAD                                  
C                   ENDIF                                             
C                   ENDIF                                             
C                   ENDIF                                             
C                   ELSE                                              
C* MENU ADMINISTRATION.                                               
C                   IF        MNU_SEL1 = 5                            
C                   READ      PULL5                                   
C                   IF        PULL_5 = 1                              
C                   EVAL      QCMND = 'DBU MYMENUPF2'                 
C                   CALL      'QCAEXEC'                            77 
C                   PARM                    QCMND                     
C                   PARM      256           ALEN             15 5     
C                   GOTO      RELOAD                                  
C                   ELSE                                              
C                   IF        PULL_5 = 2                              
C                   EVAL      V_MESG = 'PRESS COMMAND 5 TO UPDATE'    
C                   EVAL      V_FROMUSER = *BLANKS                    
C                   EVAL      V_TOUSER = *BLANKS                        
C     DISP_FMT001   TAG                                                 
C                   EXFMT     FMT001                                    
C* EXIT PROGRAM.                                                        
C     *IN(03)       CABEQ     '1'           END_IT                      
C* PREVIOUS SCREEN.                                                     
C     *IN(12)       CABEQ     '1'           RELOAD                      
C* COPY MENU OPTIONS FROM ONE USER TO A NEW USER ID.                    
C                   IF        *IN(05)                                   
C     V_TOUSER      CHAIN     MYMENUPF                           65     
C     *IN(65)       CABEQ     '0'           DISP_FMT001              67 
C     V_FROMUSER    SETLL     MYMENUPF                           68     
C     V_FROMUSER    READE     RMYMENU                                68 
C     *IN(68)       CABEQ     '1'           DISP_FMT001                 
C                   DOW       NOT *IN(68)                               
C                   EVAL      MYM_USERID = V_TOUSER                     
C                   WRITE     RMYMENU                                   
C     V_FROMUSER    READE     RMYMENU                                68 
C                   ENDDO                                               
C                   GOTO      RELOAD                                    
C                   ENDIF                                               
C                   GOTO      DISP_FMT001                               
C                   ELSE                                                
C                   IF        PULL_5 = 3                                
C                   MOVEL     V_EMULATE     QCMND                       
C                   CALL      'MYMNUMNTRP'                         77   
C                   PARM                    QCMND                       
C                   PARM      256           ALEN             15 5       
C                   GOTO      RELOAD                                    
C                   ENDIF                                               
C                   ENDIF                                               
C                   ENDIF                                               
C                   ELSE                                                
C* EXIT OPTIONS                                                         
C                   IF        MNU_SEL1 = 6                             
C                   READ      PULL6                                    
C     PULL_6        CABEQ     1             RELOAD                     
C                   ENDIF                                              
C                   ENDIF                                              
C                   ENDIF                                              
C                   ENDIF                                              
C                   ENDIF                                              
C                   ENDIF                                              
C                   ENDIF                                              
C* END OF MENU SELECTION.                                             *
C* READ SELECTED RECORDS.                                              
C     V_OPTION      CABEQ     0             DSP_SFL001                 
C     V_OPTION      CHAIN     SFL001                             90    
C                   IF        NOT *IN(90)                              
C     KEY_MENU      CHAIN     MYMENUPF                           90    
C                   IF        NOT *IN(90)                              
C                   IF        MYM_CMND <> *BLANKS                    
C                   EVAL      CMND = MYM_CMND                        
C                   CALL      'QCAEXEC'                            77
C                   PARM                    CMND                     
C                   PARM      256           ALEN             15 5    
C                   ELSE                                             
C                   IF        MYM_PROG <> *BLANKS                    
C                   EVAL      W_PROGRAM = MYM_PROG                   
C                   EVAL      PROG = 'CALL ' + MYM_PROG              
C                   CALL      'QCAEXEC'                            77
C                   PARM                    PROG                     
C                   PARM      256           ALEN             15 5    
C                   ELSE                                             
C                   IF        MYM_MENU <> *BLANKS                    
C                   EVAL      MENU = 'GO ' + MYM_MENU                
C                   CALL      'QCAEXEC'                            77
C                   PARM                    MENU                     
C                   PARM      40            ALEN             15 5   
C                   ENDIF                                           
C                   ENDIF                                           
C                   ENDIF                                           
C                   ENDIF                                           
C                   ENDIF                                           
C                   GOTO      RELOAD                                
C     END_IT        TAG                                             
C                   SETON                                        LR 
C                   RETURN                                          
                     
@@@@@  MYMENUPF - Menmu option database file.
A          R RMYMENU                   TEXT('MENU BY USER/DEPT')
A            MYM_USERID    10A         TEXT('FOR USER ID')      
A            MYM_OPTION     4S 0       TEXT('OPTION/SEQ NUMBER')
A* EITHER PROGRAM, COMMAND OR MENU NEED ENTRY!!!!!              
A            MYM_PROG     256A         TEXT('PROGRAM')          
A            MYM_CMND     256A         TEXT('COMMAND')          
A            MYM_MENU      20A         TEXT('MENU NAME')        
A            MYM_DESC      50A         TEXT('DESCRIPTION')      
A* USE *ALL OR LEAVE ALL THE FIELDS BLANK FOR EVERYBODY.        
A            MYM_USER1     20A         TEXT('SELECT/OMIT ID 1') 
A            MYM_USER2     20A         TEXT('SELECT/OMIT ID 2') 
A            MYM_USER3     20A         TEXT('SELECT/OMIT ID 3') 
A            MYM_USER4     20A         TEXT('SELECT/OMIT ID 4') 
A            MYM_USER5     20A         TEXT('SELECT/OMIT ID 5') 
A* USE *ALL OR LEAVE ALL THE FIELDS BLANK FOR EVERYBODY.        
A            MYM_DEPT1     20A         TEXT('DEPT CODE 1')      
A            MYM_DEPT2     20A         TEXT('DEPT CODE 2')      
A            MYM_DEPT3     20A         TEXT('DEPT CODE 3')      
A            MYM_DEPT4     20A         TEXT('DEPT CODE 4')      
A            MYM_DEPT5     20A         TEXT('DEPT CODE 5')      
A          K MYM_USERID                                         
A          K MYM_OPTION       

MYMENUPF2 - Menu title database file.

A          R RMYMENU2                  TEXT('MENU BY USER/DESC') 
A            MY2_USERID    10A         TEXT('FOR USER ID')       
A            MY2_DESC      30A         TEXT('USER DESCRIPTION')  
A          K MY2_USERID                                                                            

 

Dig Deeper on iSeries skills

Start the conversation

Send me notifications when other members comment.

Please create a username to comment.

-ADS BY GOOGLE

SearchDataCenter

Close