@@@@@ 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
A 21 3'EMULATE USER ID:'
A COLOR(BLU)
A 33 V_EMULATE 10A B 21 20COLOR(PNK)
A N33 V_EMULATE2 10A O 21 20COLOR(PNK)
A 21 34'OPTION:'
A DSPATR(HI)
A COLOR(PNK)
A V_OPTION 2Y 0B 21 42COLOR(BLU)
A CHECK(ER)
A EDTCDE(Z)
A DSPATR(PC)
A PUSH_BUTN1 2Y 0B 23 5PSHBTNFLD
A PSHBTNCHC(1 'CMD3: EXIT' CA03)
A 33 23 64'CMD10: EXIT MENU'
A DSPATR(RI)
A COLOR(PNK)
A V_MESG 70A O 24 2DSPATR(HI)
****************** End of data **********************
@@@@@ 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
@@@@ EMPLYFL - Employee information file.
A UNIQUE
A R HMEMPF
A USRID 10A COLHDG('User ID')
A NAME 20A COLHDG('Name')
A DEPT 25A COLHDG('Department')
A EXT# 3S 0 COLHDG('Ext#')
A LBMNU1 15A COLHDG('Library/Menu 1')
A LBMNU2 15A COLHDG('Library/Menu 2')
A LBMNU3 15A COLHDG('Library/Menu 3')
A LBMNU4 15A COLHDG('Library/Menu 4')
A BDAY 6A COLHDG('Birthday')
A HDATE 8S 0 COLHDG('Hire Date')
A SRTNM 4A COLHDG('Sort Name')
A DEPTCD 3A COLHDG('Dept Cd')
A ACCSCD 1S 0 COLHDG('Acs Cd')
A** ACCSCD - 1 = MANAGER TYPE ACCESS
A** ACCSCD - 2 = NON-MANAGER TYPE ACCESS
A ADDR 30A COLHDG('Address')
A CITY 18A COLHDG('City')
A ST 2A COLHDG('St')
A ZIP 9A COLHDG('Zip')
A HMPHN 10S COLHDG('Hme Phn')
A OFPHN 10S COLHDG('Ofc Phn')
A FXPHN 10S COLHDG('Fax Phn')
A AUTDL 2S COLHDG('Auto')
A TDIV 3A COLHDG('Div')
A TCTR 10A COLHDG('Contractor')
A STS 1A COLHDG('Sts')
A EMPID 5S 0 COLHDG('Emp #')
A TITLE 30A COLHDG('Title')
A EMPLY# 5S 0 COLHDG('Employee No')
A COMM 50A COLHDG('Comment')
A CODE 1A COLHDG('Code')
A** C - ALLOWS ORDER TO BE COMPLETED
A ORDCD 1A COLHDG('Order Code')
A* 1 = Entry/Update
A* 2 = Inquiry Only
A DPTNME 30A COLHDG('Dept Name')
A SRTOR1 3S 0 COLHDG('Sort Order 1')
A* Sort in order for department name
A DPTSUB 30A COLHDG('Sub-Dept Name')
A SRTOR2 3S 0 COLHDG('Sort Order 2')
A* Sort in order for sub-dept within department name
A SRTOR3 3S 0 COLHDG('Sort Order 3')
A* Sort in order for within sub-dept
A SPCD1 10A COLHDG('SPECIAL CODE 1')
A SPCD2 10A COLHDG('SPECIAL CODE 2')
A SPCD3 10A COLHDG('SPECIAL CODE 3')
A SPCD4 10A COLHDG('SPECIAL CODE 4')
A SPCD5 10A COLHDG('SPECIAL CODE 5')
A SPCD6 10A COLHDG('SPECIAL CODE 6')
A SPCD7 10A COLHDG('SPECIAL CODE 7')
A SPCD8 10A COLHDG('SPECIAL CODE 8')
A SPCD9 10A COLHDG('SPECIAL CODE 9')
A SPCD10 10A COLHDG('SPECIAL CODE 10')
A SPCO1 2A COLHDG('SPECIAL CMPY 1')
A SPCO2 2A COLHDG('SPECIAL CMPY 2')
A SPCO3 2A COLHDG('SPECIAL CMPY 3')
A SPCO4 2A COLHDG('SPECIAL CMPY 4')
A SPCO5 2A COLHDG('SPECIAL CMPY 5')
A EMAIL 40A COLHDG('EMAIL ADDRESS')
A COMM2 50A COLHDG('COMMENT')
A CMPACD 50A COLHDG('COMPANY ACCESS')
A ECOMP 2S 0 COLHDG('COMPANY #')
A EFNAME 15A COLHDG('FIRST NAME')
A ELNAME 15A COLHDG('LAST NAME')
A EMAILDP 3A COLHDG('EMAILDP')
A EMAILCD 1A COLHDG('EMAILCD')
A** USE EXFLD01 TO NOT IF ALLOWED TO CANCEL/UNCANCEL ORDERS.
A EXFLD01 10A COLHDG('CANCEL/UNCANCEL')
A*** 2ST BYTE OF EXFLD01 IS USED FOR CANCEL 'N' = NOT ALLOWED
A*** 2ND BYTE OF EXFLD01 IS USED FOR UNCANCEL 'N' = NOT ALLOWED
A EXFLD02 10A COLHDG('EXTRA FILED 02')
A EXFLD03 20A COLHDG('EXTRA FILED 03')
A EXFLD04 20A COLHDG('EXTRA FILED 04')
A EXFLD05 30A COLHDG('EXTRA FILED 05')
A EXFLD06 30A COLHDG('EXTRA FILED 06')
A K USRID
******************** end of data **********************