David Anderson -- maintenance process

David Anderson -- maintenance process

 
VMYMENUMNT

A                                      DSPSIZ(24 80 *DS3)      
A                                      PRINT(*LIBL/QSYSPRT)    
A                                      CA03(03 'END OF JOB')   
A                                      CF05(05 'ADD/UPDATE')   
A          R SFL001                    SFL                     
A            H_SEQ          4S 0H                              
A            S_SEL          1A  B  7  2COLOR(PNK)              
A                                      DSPATR(PC)              
A            S_USER        10A  O  7  4                        
A            S_DESC        35A  O  7 15                        
A            S_CMD         25A  O  7 51                        
A            S_SEQ          4Y 0O  7 77EDTCDE(Z)               
A          R SFLCTL1                   SFLCTL(SFL001)          
A                                      SFLSIZ(1200)            
A                                      SFLPAG(0015)            
A                                      OVERLAY                 
A N29                                  SFLDSPCTL               
A N29N25                               SFLDSP                  
A  29                                  SFLCLR                  
A N29N25                               SFLEND(*MORE)           
A                                  1  2'EM400/MYMNUMNTRP'      
A                                  1 29'MYMENUPF MAINTENANCE'  
A                                      DSPATR(HI)              
A                                      DSPATR(UL)              
A                                  1 62TIME                    
A                                  1 71DATE          
A                                      EDTCDE(Y)     
A            $USER         10A  O  2 62              
A                                  3  2'USER:'       
A                                      DSPATR(HI)    
A                                      COLOR(RED)    
A            S_RUSER       10A  B  3  8COLOR(BLU)    
A                                  5  1'SEL'         
A                                      DSPATR(HI)    
A                                      DSPATR(UL)    
A                                  5  7'USER'        
A                                      DSPATR(HI)    
A                                      DSPATR(UL)    
A                                  5 15'DESCRIPTION' 
A                                      DSPATR(HI)    
A                                      DSPATR(UL)    
A                                  5 51'COMMAND'     
A                                      DSPATR(HI)             
A                                      DSPATR(UL)             
A                                  5 77'SEQ#'                 
A                                      DSPATR(HI)             
A                                      DSPATR(UL)             
A          R BTM001                                           
A                                 23  2'CMD3-EXIT'            
A                                      DSPATR(HI)             
A                                      DSPATR(RI)             
A                                      COLOR(RED)             
A                                 23 14'CMD5-ADD'             
A                                      DSPATR(HI)             
A                                      DSPATR(RI)             
A                                 23 25'X-SELECT FOR UPDATE'  
A                                 23 46'D-DELETE'             
A                                 23 56'C-COPY TO USER'       
A          R FMT001                                           
A                                  1  2'EM400/MYMNUMNTRP'     
A                                  1 30'MYMENUPF MAINTENANCE' 
A                                      DSPATR(HI)             
A                                      DSPATR(UL)             
A                                  1 62TIME                   
A                                  1 71DATE                   
A                                      EDTCDE(Y)              
A            $USER         10A  O  2 62                       
A                                  3  1'USER:'                
A                                      DSPATR(HI)             
A            VUSER         10A  B  3  7                       
A  50                                  DSPATR(PR)             
A                                  3 18'SEQ#:'                
A                                      DSPATR(HI)             
A            VSEQ           4S 0B  3 24                       
A N50                              3 30'<  --- IF NO SEQ# ENTERED, ONE WILL - 
A                                      BE ASSIGNED'                     
A                                      COLOR(PNK)                       
A                                  4  1'DESC:'                          
A                                      DSPATR(HI)                       
A            VDESC         50A  B  4  7                                 
A  60                                  DSPATR(PC)                       
A                                  5  1'PROGRAM:'                       
A                                      DSPATR(HI)                       
A            VPROG1        70A  B  5 10                                 
A            VPROG2        79A  B  6  1                                 
A            VPROG3        79A  B  7  1                                 
A                                  8  1'COMMAND:'                       
A                                      DSPATR(HI)                       
A            VCMND1        70A  B  8 10                                 
A            VCMND2        79A  B  9  1                                 
A            VCMND3        79A  B 10  1          
A                                 11  1'MENU:'            
A                                      DSPATR(HI)         
A            VMENU         20A  B 11  7                   
A                                 13  1'SELECT/OMIT USER:'
A                                      DSPATR(HI)         
A            VUSER1        10A  B 13 19                   
A            VUSER2        10A  B 13 30                   
A            VUSER3        10A  B 13 41                   
A            VUSER4        10A  B 13 52                   
A            VUSER5        10A  B 13 63                   
A                                 16  1'SELECT/OMIT DEPT:'
A                                      DSPATR(HI)         
A            VDEPT1        10A  B 16 19                  
A            VDEPT2        10A  B 16 30                  
A            VDEPT3        10A  B 16 41                  
A            VDEPT4        10A  B 16 52                  
A            VDEPT5        10A  B 16 63                  
A            VMESG         70A  O 21  1DSPATR(HI)        
A                                 23  2'CMD3-EXIT'       
A                                      DSPATR(RI)        
A                                      DSPATR(HI)        
A                                      COLOR(RED)        
A                                 23 14'CMD5-ADD/UPDATE' 
A                                      DSPATR(HI)        
A                                      DSPATR(RI)                       
A          R WIN001                                                     
A                                      WINDOW(11 15 7 50)               
A                                      KEEP                             
A                                      WDWBORDER((*COLOR BLU) (*DSPATR RI)-  
A                                       (*CHAR '@@@@@@@@'))             
A                                  1  2'EM400/VMYMNUMNT'                
A                                  1 42TIME                             
A                                  2  2'WIN001'                         
A                                  2 20'CMD3-EXIT'                      
A                                      DSPATR(HI)                       
A                                      COLOR(RED)                       
A                                      DSPATR(RI)                       
A                                  2 42DATE                             
A                                      EDTCDE(Y)                        
A                                  4  2'ARE YOU SURE YOU WANT TO DELETE TH-
A                                      IS RECORD??'                    
A                                      DSPATR(HI)                      
A                                  5  2'USER:'                         
A                                      DSPATR(HI)                      
A            WUSER         10A  O  5  8                                
A                                  5 19'SEQ#:'                         
A                                      DSPATR(HI)                      
A            WSEQ           4S 0O  5 25                                
A                                  6 10'PRESS ENTER TO DELETE RECORD!!'
A                                      COLOR(PNK)                      
A                                      DSPATR(BL)                      
A          R WIN002                                                    
A                                      WINDOW(11 15 7 50)              
A                                      KEEP                            
A                                      WDWBORDER((*COLOR BLU) (*DSPATR 
A                                       (*CHAR '@@@@@@@@'))            
A                                  1  2'EM400/VMYMNUMNT'       
A                                  1 42TIME                    
A                                  2  2'WIN002'                
A                                  2 20'CMD3-EXIT'             
A                                      DSPATR(HI)              
A                                      COLOR(RED)              
A                                      DSPATR(RI)              
A                                  2 42DATE                    
A                                      EDTCDE(Y)               
A                                  4  2'COPY TO USER:'         
A                                      DSPATR(HI)              
A            W2_CUSER      10   B  4 16                        
A                                  6 13'PRESS ENTER TO COPY!!' 
A                                      COLOR(PNK)              
A                                      DSPATR(BL)              
****************** End of data ********************************

MYMENUMNTRP

FVMYMNUMNT CF   E             WORKSTN                                 
F                                     SFILE(SFL001:RRN001)            
FMYMENUPF  UF A E           K DISK                                    
FMYMENULF1 IF   E           K DISK    RENAME(RMYMENU:RMY2) PREFIX(W)  
D*                                                                    
D MSG             S             75    DIM(2) CTDATA PERRCD(1)         
D*                                                                    
D PROGDS         SDS                                                  
D  $PGM             *PROC                                             
D  $CRT                 244    253                                    
D  $USER                254    263                                    
D  $DATE                276    281  0                                 
D  $TIME                282    287  0                                 
D*                                                                    
D W_USER          S             10                                    
D*                                                                    
D                 DS                                                  
D PARM1                   1    256                             
D  P_USER                 1     10                             
D*                                                             
C*                                                             
C*                                                             
C     *ENTRY        PLIST                                      
C                   PARM                    P_PARM1         256
C                   EVAL      PARM1 = P_PARM1                  
C*                                                             
C*                                                             
C     MYKEY         KLIST                                      
C                   KFLD                    S_USER             
C                   KFLD                    H_SEQ              
C*                                                             
C     MYKEY2        KLIST                                      
C                   KFLD                    VUSER              
C                   KFLD                    VSEQ               
C*                                                               
C     MYKEY3        KLIST                                        
C                   KFLD                    VUSER                
C                   KFLD                    W_SEQ                
C*                                                               
C     MYKEY4        KLIST                                        
C                   KFLD                    W2_CUSER             
C                   KFLD                    W_SEQ                
C*                                                               
C*---------------------------------------------------------------
C* SUBFILE                                                       
C*---------------------------------------------------------------
C                   IF        P_USER = *BLANKS                   
C                   EVAL      W_USER = $USER                     
C                   ELSE                                         
C                   EVAL      W_USER = P_USER                    
C                   ENDIF                                        
C                   EVAL      S_RUSER = W_USER                         
C     DISPLY        TAG                                                
C                   MOVE      '0'           *IN(50)                    
C                   MOVEL     *BLANKS       S_SEL                      
C                   MOVE      *ON           *IN(29)                    
C                   MOVE      *ON           *IN(25)                    
C                   WRITE     SFLCTL1                                  
C                   MOVE      *OFF          *IN(29)                    
C                   Z-ADD     0             RRN001            4 0      
C     W_USER        SETLL     MYMENUPF                                 
C                   READ(N)   RMYMENU                                94
C                   DOW       *IN(94) = '0'                            
C                             AND RRN001 <   1201                        
C** LOAD SUBFILE FIELDS                                                
C                   MOVEL     MYM_USERID    S_USER                     
C                   MOVEL     MYM_OPTION    S_SEQ                      
C                   MOVEL     MYM_OPTION    H_SEQ                      
C                   MOVEL     MYM_DESC      S_DESC           35  
C** GET COMMAND                                                  
C                   MOVEL     *BLANKS       S_CMD            25  
C                   IF        MYM_PROG <   *BLANKS                 
C                   EVAL      S_CMD = 'CALL ' + MYM_PROG         
C                   ELSE                                         
C                   IF        MYM_CMND <   *BLANKS                 
C                   EVAL      S_CMD = MYM_CMND                   
C                   ELSE                                         
C                   IF        MYM_MENU <   *BLANKS                 
C                   EVAL      S_CMD = 'GO ' + MYM_MENU           
C                   ENDIF                                        
C                   ENDIF                                        
C                   ENDIF                                        
C*                                                               
C                   ADD       1             RRN001               
C                   WRITE     SFL001                             
C     NXTRD         TAG                                                
C                   READ(N)   RMYMENU                                94
C                   ENDDO                                              
C*                                                                     
C                   IF        RRN001 <   0                               
C                   MOVE      *OFF          *IN(25)                    
C                   ELSE                                               
C                   MOVE      *ON           *IN(25)                    
C                   END                                                
C*                                                                     
C                   WRITE     BTM001                                   
C                   EXFMT     SFLCTL1                                  
C*                                                                     
C     *IN(03)       CABEQ     *ON           ENDIT                      
C*----------------------------------------------------------------     
C* WRITE NEW RECORD                                                    
C*----------------------------------------------------------------     
C                   IF        *IN(05) = '1'        
C                   EVAL      VUSER = *BLANKS      
C                   EVAL      *IN(60) = '0'        
C     TAG001A       TAG                            
C                   Z-ADD     0             VSEQ   
C                   EVAL      VDESC = *BLANKS      
C                   EVAL      VPROG1 = *BLANKS     
C                   EVAL      VPROG2 = *BLANKS     
C                   EVAL      VPROG3 = *BLANKS     
C                   EVAL      VCMND1 = *BLANKS     
C                   EVAL      VCMND2 = *BLANKS     
C                   EVAL      VCMND3 = *BLANKS     
C                   EVAL      VMENU = *BLANKS      
C                   EVAL      VUSER1 = *BLANKS     
C                   EVAL      VUSER2 = *BLANKS     
C                   EVAL      VUSER3 = *BLANKS     
C                   EVAL      VUSER4 = *BLANKS     
C                   EVAL      VUSER5 = *BLANKS     
C                   EVAL      VDEPT1 = *BLANKS     
C                   EVAL      VDEPT2 = *BLANKS     
C                   EVAL      VDEPT3 = *BLANKS     
C                   EVAL      VDEPT4 = *BLANKS     
C                   EVAL      VDEPT5 = *BLANKS     
C                   MOVEL     *BLANKS       VMESG  
C     TAG001        TAG                                            
C                   EVAL      *IN(50) = '0'                        
C                   EXFMT     FMT001                               
C                   IF        *IN(03) <  <   '1'                       
C                             AND *IN(05) <  <   '1'                   
C                   GOTO      TAG001                               
C                   ENDIF                                          
C     *IN(03)       CABEQ     *ON           DISPLY                 
C*                                                                 
C                   IF        *IN(05) = '1'                        
C*                                                                 
C                   IF        VSEQ <   0                             
C     MYKEY2        CHAIN     MYMENULF1                          36
C                   IF        *IN(36) = '0'                        
C                   MOVEL     MSG(1)        VMESG                  
C                   GOTO      TAG001                               
C                   ENDIF                                          
C                   ELSE                                                
C                   Z-ADD     9999          W_SEQ             4 0       
C     MYKEY3        SETGT     MYMENULF1                                 
C     VUSER         READPE    RMY2                                   96 
C                   IF        *IN(96) = '0'                             
C                   EVAL      VSEQ = WMYM_OPTION + 10                   
C                   ELSE                                                
C                   EVAL      VSEQ = 10                                 
C                   ENDIF                                               
C                   ENDIF                                               
C*                                                                      
C                   EVAL      MYM_USERID = VUSER                        
C                   Z-ADD     VSEQ          MYM_OPTION                  
C                   EVAL      MYM_PROG = VPROG1 + VPROG2 + VPROG3       
C                   EVAL      MYM_CMND = VCMND1 + VCMND2 + VCMND3       
C                   EVAL      MYM_MENU = VMENU                          
C                   EVAL      MYM_DESC = VDESC                          
C                   EVAL      MYM_USER1 = VUSER1   
C                   EVAL      MYM_USER2 = VUSER2   
C                   EVAL      MYM_USER3 = VUSER3   
C                   EVAL      MYM_USER4 = VUSER4   
C                   EVAL      MYM_USER5 = VUSER5   
C                   EVAL      MYM_DEPT1 = VDEPT1   
C                   EVAL      MYM_DEPT2 = VDEPT2   
C                   EVAL      MYM_DEPT3 = VDEPT3   
C                   EVAL      MYM_DEPT4 = VDEPT4   
C                   EVAL      MYM_DEPT5 = VDEPT5   
C*                                                                     
C                   WRITE     RMYMENU                                  
C                   EVAL      *IN(60) = '1'                            
C                   GOTO      TAG001A                                  
C*                                                                     
C                   ENDIF                                              
C*                                                                     
C                   ENDIF                                              
C*----------------------------------------------------------------     
C* READ CHANGED RECORDS.                                               
C*----------------------------------------------------------------     
C                   IF        RRN001 <   0                               
C                   EVAL      W2_CUSER = *BLANKS                       
C                   READC     SFL001                                 92
C                   DOW       *IN(92) = '0'                           
C*                                                                    
C                   IF        S_SEL <  <   'X'                            
C                             AND S_SEL <  <   'D'                        
C                             AND S_SEL <  <   'C'                        
C                   GOTO      DISPLY                                  
C                   ENDIF                                             
C*                                                                    
C                   IF        S_SEL = 'X'                             
C                   MOVE      '1'           *IN(50)                   
C     MYKEY         CHAIN     MYMENUPF                           35   
C                   IF        *IN(35) = '0'                           
C                   EVAL      VUSER = MYM_USERID                      
C                   Z-ADD     MYM_OPTION    VSEQ                      
C                   EVAL      VDESC = MYM_DESC                        
C                   EVAL      VPROG1 = %SUBST(MYM_PROG:1:70)          
C                   EVAL      VPROG2 = %SUBST(MYM_PROG:71:79)         
C                   EVAL      VPROG3 = %SUBST(MYM_PROG:149:79) 
C                   EVAL      VCMND1 = %SUBST(MYM_CMND:1:70)   
C                   EVAL      VCMND2 = %SUBST(MYM_CMND:71:79)  
C                   EVAL      VCMND3 = %SUBST(MYM_CMND:149:79) 
C                   EVAL      VMENU = MYM_MENU                 
C                   EVAL      VUSER1 = MYM_USER1               
C                   EVAL      VUSER2 = MYM_USER2               
C                   EVAL      VUSER3 = MYM_USER3               
C                   EVAL      VUSER4 = MYM_USER4               
C                   EVAL      VUSER5 = MYM_USER5               
C                   EVAL      VDEPT1 = MYM_DEPT1               
C                   EVAL      VDEPT2 = MYM_DEPT2               
C                   EVAL      VDEPT3 = MYM_DEPT3      
C                   EVAL      VDEPT4 = MYM_DEPT4      
C                   EVAL      VDEPT5 = MYM_DEPT5      
C                   MOVEL     *BLANKS       VMESG     
C     TAG002        TAG                               
C                   EXFMT     FMT001                  
C                   IF        *IN(03) <  <   '1'          
C                             AND *IN(05) <  <   '1'      
C                   GOTO      TAG002                  
C                   ENDIF                             
C     *IN(03)       CABEQ     *ON           NXTCHG    
C*                                                    
C                   IF        *IN(05) = '1'                          
C*                                                                   
C                   IF        VSEQ <  <   H_SEQ                          
C     MYKEY2        CHAIN     MYMENULF1                          36  
C                   IF        *IN(36) = '0'                          
C                   MOVEL     MSG(1)        VMESG                    
C                   GOTO      TAG002                                 
C                   ENDIF                                            
C                   ENDIF                                            
C*                                                                   
C                   EVAL      MYM_USERID = VUSER                     
C                   Z-ADD     VSEQ          MYM_OPTION               
C                   EVAL      MYM_DESC = VDESC                       
C                   EVAL      MYM_PROG = VPROG1 + VPROG2 + VPROG3    
C                   EVAL      MYM_CMND = VCMND1 + VCMND2 + VCMND3    
C                   EVAL      MYM_MENU = VMENU                       
C                   EVAL      MYM_USER1 = VUSER1                     
C                   EVAL      MYM_USER2 = VUSER2    
C                   EVAL      MYM_USER3 = VUSER3    
C                   EVAL      MYM_USER4 = VUSER4    
C                   EVAL      MYM_USER5 = VUSER5    
C                   EVAL      MYM_DEPT1 = VDEPT1    
C                   EVAL      MYM_DEPT2 = VDEPT2    
C                   EVAL      MYM_DEPT3 = VDEPT3    
C                   EVAL      MYM_DEPT4 = VDEPT4    
C                   EVAL      MYM_DEPT5 = VDEPT5    
C                   UPDATE    RMYMENU                               
C                   GOTO      NXTCHG                                
C                   ENDIF                                           
C                   ENDIF                                           
C                   ENDIF                                           
C*                                                                  
C                   IF        S_SEL = 'D'                           
C                   EVAL      WUSER = S_USER                        
C                   Z-ADD     H_SEQ         WSEQ                    
C                   EXFMT     WIN001                                
C     *IN(03)       CABEQ     '1'           NXTCHG                  
C     MYKEY         CHAIN     MYMENUPF                           40 
C                   IF        *IN(40) = '0'                         
C                   DELETE    RMYMENU                               
C                   GOTO      NXTCHG                                
C                   ENDIF                                              
C                   ENDIF                                              
C*                                                                     
C                   IF        S_SEL = 'C'                              
C                   IF        W2_CUSER = *BLANKS                       
C     WINTAG        TAG                                                
C                   EXFMT     WIN002                                   
C     *IN(03)       CABEQ     '1'           NXTCHG                     
C     W2_CUSER      CABEQ     *BLANKS       WINTAG                     
C                   ENDIF                                              
C     MYKEY         CHAIN     MYMENUPF                           40    
C                   IF        *IN(40) = '0'                            
C                   EVAL      MYM_USERID = W2_CUSER                    
C                   Z-ADD     9999          W_SEQ             4 0      
C     MYKEY4        SETGT     MYMENULF1                                
C     W2_CUSER      READPE    RMY2                                   96
C                   IF        *IN(96) = '0'                            
C                   EVAL      MYM_OPTION = WMYM_OPTION + 10             
C                   ELSE                                                
C                   EVAL      MYM_OPTION = 10                           
C                   ENDIF                                               
C                   WRITE     RMYMENU                                   
C                   ENDIF                                               
C                   ENDIF                                               
C*                                                                      
C     NXTCHG        TAG                                                 
C*                                                                      
C                   READC     SFL001                                 92 
C                   ENDDO                                               
C                   ENDIF                                               
C*----------------------------------------------------------------      
C*                                                                      
C*----------------------------------------------------------------      
C                   MOVEL     S_RUSER       W_USER                      
C                   GOTO      DISPLY                                    
C*                                                                      
C     ENDIT         TAG                                                 
C                   SETON                                        LR     
C                   RETURN                                              
C*                                                                    * 
** MSG - DISPLAY MESSAGES                                        
RECORD ALREADY EXISTS!! TRY ANOTHER SEQ#.                        
                                                                 
****************** End of data **********************************        

Dig deeper on iSeries skills

0 comments

Oldest 

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

-ADS BY GOOGLE

SearchEnterpriseLinux

SearchDataCenter

Close