P001C 0001.00 /* Author.....: David Zhao 2010.07.02 */ 0002.00 PGM 0003.00 MONMSG MSGID(CPF0000 RPG0000) 0004.00 CALL PGM(*LIBL/P001R) 0005.00 ENDPGM P001C1 0001.00 /* Author.....: David Zhao 2010.07.02 */ 0002.00 PGM PARM(&MYLIB &MYSRC &MYPGM &MYOWR &MYTYP) 0003.00 DCL VAR(&MYLIB) TYPE(*CHAR) LEN(10) 0004.00 DCL VAR(&MYSRC) TYPE(*CHAR) LEN(10) 0005.00 DCL VAR(&MYPGM) TYPE(*CHAR) LEN(10) 0006.00 DCL VAR(&MYOWR) TYPE(*CHAR) LEN(10) 0007.00 DCL VAR(&MYTYP) TYPE(*CHAR) LEN(1) 0008.00 MONMSG MSGID(CPF0000 RPG0000) 0009.00 0010.00 ERROR: IF COND(&MYLIB = ' ') THEN(GOTO CMDLBL(END)) 0011.00 IF COND(&MYSRC = ' ') THEN(GOTO CMDLBL(END)) 0012.00 IF COND(&MYPGM = ' ') THEN(GOTO CMDLBL(END)) 0013.00 IF COND(&MYOWR = ' ') THEN(GOTO CMDLBL(END)) 0014.00 IF COND(&MYTYP = ' ') THEN(GOTO CMDLBL(END)) 0015.00 0016.00 IF COND(&MYTYP = '1') THEN(GOTO CMDLBL(MYMOD)) 0017.00 IF COND(&MYTYP = '2') THEN(GOTO CMDLBL(MYPGM)) 0018.00 0019.00 MYMOD: DLTMOD MODULE(&MYLIB/&MYPGM) 0020.00 SBMJOB CMD(CRTRPGMOD MODULE(&MYLIB/&MYPGM) + 0021.00 SRCFILE(&MYLIB/&MYSRC)) JOB(DAVID) + 0022.00 USER(&MYOWR) 0023.00 GOTO CMDLBL(END) 0024.00 0025.00 MYPGM: DLTPGM PGM(&MYLIB/&MYPGM) 0026.00 SBMJOB CMD(CRTPGM PGM(&MYLIB/&MYPGM) + 0027.00 MODULE(&MYLIB/&MYPGM) BNDDIR(HUBBND + 0028.00 HHSBND) OPTION(*DUPPROC)) JOB(DAVID) + 0029.00 USER(&MYOWR) 0030.00 GOTO CMDLBL(END) 0031.00 0032.00 END: ENDPGM P001D 0001.00 A* AUTHOR...: DAVID ZHAO 2010.07.02 0002.00 A DSPSIZ(24 80 *DS3) 0003.00 A CHGINPDFT 0004.00 A ALTHELP(CA01) 0005.00 A CA24(24) 0006.00 A ENTFLDATR((*DSPATR RI)) 0007.00 A HELP 0008.00 A MOUBTN(*URP CA12) 0009.00 A PRINT 0010.00 A************************************************************************** 0011.00 A R MSGSFL SFL 0012.00 A SFLMSGRCD(24) 0013.00 A MSGKEY SFLMSGKEY 0014.00 A PSPGM SFLPGMQ 0015.00 A************************************************************************** 0016.00 A R MSGCTL SFLCTL(MSGSFL) 0017.00 A OVERLAY 0018.00 A N29 SFLDSP SFLDSPCTL SFLINZ SFLEND 0019.00 A SFLSIZ(2) SFLPAG(1) 0020.00 A PSPGM SFLPGMQ 0021.00 A*========================================================================= 0022.00 A R SCR01 OVERLAY 0023.00 A CA12(12 'EXIT') 0024.00 A CSRINPONLY 0025.00 A MYDATE 8Y 0O 1 2EDTWRD('0 . . ') 0026.00 A MYTIME 6Y 0O 1 13EDTWRD('0 : : ') 0027.00 A MYTITLE 45O O 1 24COLOR(WHT) 0028.00 A MYUID 10O O 1 70 0029.00 A* 0030.00 A 3 2'Program..:' 0031.00 A D1PGM 10A B 3 13COLOR(PNK) DSPATR(UL) 0032.00 A 30 ERRMSGID(MSG0001 *LIBL/DAVIDMSGF) 0033.00 A 30 DSPATR(RI PC) 0034.00 A 4 2'Source...:' 0035.00 A D1SRC 10A B 4 13COLOR(PNK) DSPATR(UL) 0036.00 A 31 ERRMSGID(MSG0001 *LIBL/DAVIDMSGF) 0037.00 A 31 DSPATR(RI PC) 0038.00 A 5 2'Library..:' 0039.00 A D1LIB 10A B 5 13COLOR(PNK) DSPATR(UL) 0040.00 A 32 ERRMSGID(MSG0001 *LIBL/DAVIDMSGF) 0041.00 A 32 DSPATR(RI PC) 0042.00 A 6 2'Owner....:' 0043.00 A D1OWR 10A B 6 13COLOR(PNK) DSPATR(UL) 0044.00 A 33 ERRMSGID(MSG0001 *LIBL/DAVIDMSGF) 0045.00 A 33 DSPATR(RI PC) 0046.00 A 7 2'Type.....:' 0047.00 A D1TYP 1A B 7 13COLOR(PNK) DSPATR(UL) 0048.00 A VALUES(' ' '1' '2') 0049.00 A 34 ERRMSGID(MSG0001 *LIBL/DAVIDMSGF) 0050.00 A 34 DSPATR(RI PC) 0051.00 A 7 16'(1=CRTRPGMOD / 2=CRTPGM )' 0052.00 A COLOR(WHT) 0053.00 A* 0054.00 A 23 2'F12=Exit Enter=Process' P001R 0001.00 H* Author.....: David Zhao 2010.07.02 0002.00 H* Indicator..: 0 1 2 3 4 5 6 7 8 9 0003.00 H* 0 01 ** ** ** ** ** ** ** ** 0004.00 H* 1 ** ** 12 ** ** ** ** ** ** ** 0005.00 H* 2 ** ** ** ** ** ** ** ** ** ** 0006.00 H* 3 30 31 32 33 34 ** ** ** ** ** 0007.00 H* 4 ** ** ** ** ** ** ** ** ** ** 0008.00 H* 5 ** ** ** ** ** ** ** ** ** ** 0009.00 H* 6 ** ** ** ** ** ** ** ** ** ** 0010.00 H* 7 ** ** ** ** ** ** ** ** ** ** 0011.00 H* 8 ** ** ** ** ** ** ** ** ** ** 0012.00 H* 9 ** ** ** ** ** ** ** ** ** ** 0013.00 H* LR 0014.00 H* Usage......: 01 : Help 0015.00 H* 12 : Exit / cancel 0016.00 H* 30 : Program ID error 0017.00 H* 31 : Source File error 0018.00 H* 32 : Library error 0019.00 H* 33 : Owner error 0020.00 H* 34 : Type error 0021.00 H* 9x : Dummy 0022.00 H COPYRIGHT('(C) Copyright David Zhao 2010') 0023.00 H CVTOPT(*VARCHAR) 0024.00 H OPTIMIZE(*FULL) 0025.00 F* 0026.00 FP001D CF E WORKSTN USROPN 0027.00 D* 0028.00 D DummyUN SDS *Program status DS 0029.00 D UserName 254 263 *Current user name 0030.00 D* 0031.00 D DummyDT DS INZ * 0032.00 D xxDate D DATFMT(*ISO) *Dummy date 0033.00 D xxTime T TIMFMT(*HMS) *Dummy time 0034.00 D xxTimestamp Z *Dummy timestamp 0035.00 D* 0036.00 D Working DS INZ *Working variables 0037.00 D xxOK 1A INZ('N') *Data ok flag 0038.00 C********************************************************************************************** 0039.00 C* *INZSR = Program initialization. 0040.00 C********************************************************************************************** 0041.00 CSR *INZSR BEGSR 0042.00 C* 0043.00 C*--- Turn off all indicators. 0044.00 C* 0045.00 C MOVEA *OFF *IN 0046.00 C* 0047.00 C OPEN P001D 0048.00 C EXSR MYMAIN 0049.00 C* 0050.00 C*--- End of program. 0051.00 C* 0052.00 C EVAL *INLR = *ON 0053.00 C RETURN 0054.00 C* 0055.00 CSR ENDSR 0056.00 C********************************************************************************************** 0057.00 C* *MAIN = Program initializaion. 0058.00 C********************************************************************************************** 0059.00 CSR MYMAIN BEGSR 0060.00 C* 0061.00 C*--- Display screen & accept input. 0062.00 C* 0063.00 C SETOFF 12 0064.00 C SETOFF 303132 0065.00 C SETOFF 3334 0066.00 C* 0067.00 C CLEAR D1PGM 0068.00 C CLEAR D1SRC 0069.00 C EVAL D1LIB = 'GSCPDAVIDZ' 0070.00 C EVAL D1OWR = 'IAAOWNER' 0071.00 C EVAL MYUID = USERNAME 0072.00 C EVAL MYTITLE ='Create Program for Testing' 0073.00 C*** EXSR MYGETTIME *Get Time 0074.00 C* 0075.00 C DOW NOT *IN12 0076.00 C* 0077.00 C EXSR MYGETTIME *Get Time 0078.00 C EXFMT SCR01 0079.00 C SETOFF 303132 0080.00 C SETOFF 3334 0081.00 C* 0082.00 C SELECT 0083.00 C WHEN *IN12 0084.00 C EVAL *IN12 = *OFF 0085.00 C LEAVESR 0086.00 C* 0087.00 C*** WHEN *IN04 0088.00 C*** EVAL *IN04 = *OFF 0089.00 C* 0090.00 C OTHER 0091.00 C EXSR MYCHK 0092.00 C IF xxOK = 'Y' 0093.00 C EXSR MYRUN 0094.00 C ENDIF 0095.00 C ENDSL 0096.00 C ENDDO 0097.00 C* 0098.00 CSR ENDSR 0099.00 C********************************************************************************************** 0100.00 C* *GETTIME = Get Time. 0101.00 C********************************************************************************************** 0102.00 CSR MYGETTIME BEGSR 0103.00 C* 0104.00 C TIME xxTimestamp *Current DateTime 0105.00 C EVAL xxDate = %date(xxTimestamp) 0106.00 C EVAL xxTime = %time(xxTimestamp) 0107.00 C* 0108.00 C MOVEL xxDate Mydate 0109.00 C MOVEL xxTime Mytime 0110.00 C* 0111.00 CSR ENDSR 0112.00 C********************************************************************************************* 0113.00 C* /CHK01 = Check inputs. 0114.00 C********************************************************************************************* 0115.00 CSR MYCHK BEGSR 0116.00 C* 0117.00 C EVAL xxOK = 'N' 0118.00 C IF D1PGM = *BLANKS 0119.00 C EVAL *IN30 = *ON 0120.00 C LEAVESR 0121.00 C ENDIF 0122.00 C* 0123.00 C IF D1SRC = *BLANKS 0124.00 C EVAL *IN31 = *ON 0125.00 C LEAVESR 0126.00 C ENDIF 0127.00 C* 0128.00 C IF D1LIB = *BLANKS 0129.00 C EVAL *IN32 = *ON 0130.00 C LEAVESR 0131.00 C ENDIF 0132.00 C* 0133.00 C IF D1OWR = *BLANKS 0134.00 C EVAL *IN33 = *ON 0135.00 C LEAVESR 0136.00 C ENDIF 0137.00 C* 0138.00 C IF D1TYP = *BLANKS 0139.00 C EVAL *IN34 = *ON 0140.00 C LEAVESR 0141.00 C ENDIF 0142.00 C* 0143.00 C EVAL xxOK = 'Y' *Data ok 0144.00 C* 0145.00 CSR ENDSR 0146.00 C********************************************************************************************* 0147.00 C* MYRUN = Run P001C1 to Create Program. 0148.00 C********************************************************************************************* 0149.00 CSR MYRUN BEGSR 0150.00 C* 0151.00 C CALL 'P001C1' 0152.00 C PARM D1LIB 0153.00 C PARM D1SRC 0154.00 C PARM D1PGM 0155.00 C PARM D1OWR 0156.00 C PARM D1TYP 0157.00 C* 0158.00 C CLEAR D1TYP 0159.00 C* 0160.00 CSR ENDSR