JCL TOOL
------------
/***************REXX*****************/
"ALLOC FI(TEMPFL) DA('T01.HTC.UNITJCL.TEMPLATE(UNITTCTR)') SHR"
"EXECIO * DISKR TEMPFL (STEM DATA. FINIS"
"FREE FI(TEMPFL)"
"ALLOC FI(EMPFL) DA('T01.HTC.UNITJCL.TEMPLATE(INPUT)') SHR"
"EXECIO * DISKR EMPFL (STEM INP_DATA. FINIS"
"FREE FI(EMPFL)"
"ALLOC FI(EMPLT) DA('T01.HTC.TESTCASE.REPORT(EMPLOYEE)') SHR"
"EXECIO * DISKR EMPLT (STEM ID_ARR. FINIS"
"FREE FI(EMPLT)"
DROP OUT_DATA.
Z=0
G=0
CALL DBCONCT
CALL GET_DATA
CALL PARMCARD
CMPSIZE=TOTAL_SIZE*1
USER_ID=USERID()
USER_ID_DES=USERID()
USER_ID=SUBSTR(USER_ID,4,4)
TOTAL_SIZE="'"||TOTAL_SIZE||"',"
PARM="'"PARM"',"
IF CMPSIZE>3034 THEN
DO
DLVRY=DLVRY||"1"
REC_SIZE=32034
TRAN_ID=TX15
END
ELSE
DO
REC_SIZE=3034
TRAN_ID=TX12
END
FIRST_LETTER=SUBSTR(PGM_ID,1,1)
IDX_FIRST_LETTER=INDEX('ABCDEFGHIJKLMNOPQRSTUVWXYZ',FIRST_LETTER)
IF IDX_FIRST_LETTER=0 THEN
DO
PGM_ID='Z'||PGM_ID
END
DO I=1 TO DATA.0
CHANGE_FLAG=0
IND_TRANID=INDEX(DATA.I,'TRAN')
IF IND_TRANID>0 THEN
DO
DATA.I=SUBSTR(DATA.I,1,IND_TRANID-1)||TRAN_ID|,
|SUBSTR(DATA.I,IND_TRANID+4)
CHANGE_FLAG=1
END
IND_TRANID=INDEX(DATA.I,'TRAN')
IF IND_TRANID>0 THEN
DO
DATA.I=SUBSTR(DATA.I,1,IND_TRANID-1)||TRAN_ID|,
|SUBSTR(DATA.I,IND_TRANID+4)
CHANGE_FLAG=1
END
IND_TRANID=INDEX(DATA.I,'TRAN')
IF IND_TRANID>0 THEN
DO
DATA.I=SUBSTR(DATA.I,1,IND_TRANID-1)||TRAN_ID|,
|SUBSTR(DATA.I,IND_TRANID+4)
CHANGE_FLAG=1
END
IND_QRYID=INDEX(DATA.I,'DBACCM')
IF IND_QRYID>0 THEN
DO
DATA.I=SUBSTR(DATA.I,1,IND_QRYID-1)||QRY_PGM_ID|,
|SUBSTR(DATA.I,IND_QRYID+6)
CHANGE_FLAG=1
END
IND_CONTYP=INDEX(DATA.I,'CON_TYP')
IF IND_CONTYP>0 THEN
DO
DATA.I=SUBSTR(DATA.I,1,IND_CONTYP-1)||CON_TYP|,
|SUBSTR(DATA.I,IND_CONTYP+7)
CHANGE_FLAG=1
END
IND_USERID=INDEX(DATA.I,'USER-ID')
IF IND_USERID>0 THEN
DO
DATA.I=SUBSTR(DATA.I,1,IND_USERID-1)||USER_ID_DES|,
|SUBSTR(DATA.I,IND_USERID+7)
CHANGE_FLAG=1
END
IND_REMARK=INDEX(DATA.I,'REMRKS')
IF IND_REMARK>0 THEN
DO
DATA.I=SUBSTR(DATA.I,1,IND_REMARK-1)||REMARKS|,
|SUBSTR(DATA.I,IND_REMARK+6)
CHANGE_FLAG=1
END
IND_RECSIZE=INDEX(DATA.I,'RECSIZE')
IF IND_RECSIZE>0 THEN
DO
DATA.I=SUBSTR(DATA.I,1,IND_RECSIZE-1)||REC_SIZE|,
|SUBSTR(DATA.I,IND_RECSIZE+7)
CHANGE_FLAG=1
END
IND_TESTER=INDEX(DATA.I,'TESTER')
IF IND_TESTER>0 THEN
DO
DATA.I=SUBSTR(DATA.I,1,IND_TESTER-1)||TST_NAM|,
|SUBSTR(DATA.I,IND_TESTER+6)
CHANGE_FLAG=1
END
IND_PARMCARD=INDEX(DATA.I,'PARMCARD')
IF IND_PARMCARD>0 THEN
DO
DATA.I=SUBSTR(DATA.I,1,IND_PARMCARD-1)||PARM|,
|SUBSTR(DATA.I,IND_PARMCARD+8)
CHANGE_FLAG=1
END
IND_USER_ID=INDEX(DATA.I,'KUID')
IF IND_USER_ID>0 THEN
DO
DATA.I=SUBSTR(DATA.I,1,IND_USER_ID-1)||USER_ID|,
|SUBSTR(DATA.I,IND_USER_ID+4)
CHANGE_FLAG=1
END
IND_FIL_NO=INDEX(DATA.I,'FIL220')
FIL_NOO="FIL"||FILE_NO
IF IND_FIL_NO>0 THEN
DO
DATA.I=SUBSTR(DATA.I,1,IND_FIL_NO-1)||FIL_NOO|,
|SUBSTR(DATA.I,IND_FIL_NO+6)
CHANGE_FLAG=1
END
IND_FILE_NO=INDEX(DATA.I,'FILE220')
FILE_NOO="FILE"||FILE_NO
IF IND_FILE_NO>0 THEN
DO
DATA.I=SUBSTR(DATA.I,1,IND_FILE_NO-1)||FILE_NOO|,
|SUBSTR(DATA.I,IND_FILE_NO+7)
CHANGE_FLAG=1
END
IND_FILE_N=INDEX(DATA.I,'FIL-NO')
IF IND_FILE_N>0 THEN
DO
DATA.I=SUBSTR(DATA.I,1,IND_FILE_N-1)||FILE_NO|,
|SUBSTR(DATA.I,IND_FILE_N+6)
CHANGE_FLAG=1
END
IND_EMP_ID=INDEX(DATA.I,'EMPID')
IF IND_EMP_ID>0 THEN
DO
DATA.I=SUBSTR(DATA.I,1,IND_EMP_ID-1)||EMP_ID|,
|SUBSTR(DATA.I,IND_EMP_ID+5)
CHANGE_FLAG=1
END
IND_CYCLE=INDEX(DATA.I,'CYLC')
IF IND_CYCLE>0 THEN
DO
DATA.I=SUBSTR(DATA.I,1,IND_CYCLE-1)||VER_NO|,
|SUBSTR(DATA.I,IND_CYCLE+4)
CHANGE_FLAG=1
END
IND_TOT=INDEX(DATA.I,'TOTAL_VAL')
IF IND_TOT>0 THEN
DO
DATA.I=SUBSTR(DATA.I,1,IND_TOT-1)||TOTAL_SIZE|,
|SUBSTR(DATA.I,IND_TOT+9)
CHANGE_FLAG=1
END
IND_NAM_ID=INDEX(DATA.I,'WHERE PROGRAM_NAME')
IF IND_NAM_ID>0 THEN
DO
IND_PGM_ID_1=INDEX(DATA.I,'H30183')
IF IND_PGM_ID_1>0 THEN
DO
DATA.I=SUBSTR(DATA.I,1,IND_PGM_ID_1-1)||PGM_ID_NEW|,
|SUBSTR(DATA.I,IND_PGM_ID_1+6)
CHANGE_FLAG=1
END
END
IND_PGM_ID=INDEX(DATA.I,'H30183')
IF IND_PGM_ID>0 THEN
DO
DATA.I=SUBSTR(DATA.I,1,IND_PGM_ID-1)||PGM_ID|,
|SUBSTR(DATA.I,IND_PGM_ID+6)
CHANGE_FLAG=1
END
IND_VERSION=INDEX(DATA.I,'UTRV1')
IF IND_VERSION>0 THEN
DO
DATA.I=SUBSTR(DATA.I,1,IND_VERSION-1)||VERSION_NO|,
|SUBSTR(DATA.I,IND_VERSION+5)
CHANGE_FLAG=1
END
IND_SNAP=INDEX(DATA.I,'SNAP_05')
IF IND_SNAP>0 THEN
DO
DATA.I=SUBSTR(DATA.I,1,IND_SNAP-1)||SNAP|,
|SUBSTR(DATA.I,IND_SNAP+7)
CHANGE_FLAG=1
END
IND_DLVRY=INDEX(DATA.I,'DLVRY_PRODUCER')
IF IND_DLVRY>0 THEN
DO
DATA.I=SUBSTR(DATA.I,1,IND_DLVRY-1)||DLVRY|,
|SUBSTR(DATA.I,IND_DLVRY+14)
CHANGE_FLAG=1
END
Z=Z+1
OUT_DATA.Z=DATA.I
/*SAY OUT_DATA.Z*/
END /**********TOTAL_FILE_END*******/
PARSE SOURCE . . . . PDSNAME . . . .
PDSNAME=PDSNAME||"(DLVRYJCL)"
"ALLOC FI(TEMPF) DA('"PDSNAME"') SHR"
"EXECIO * DISKW TEMPF (STEM OUT_DATA. FINIS"
"FREE FI(TEMPF)"
CALL DBDCONT
SAY " "
SAY "**************************************************************"
SAY "*** JCL GENERATED IN CURRENT PDS WITH MEMBER NAME DLVRYJCL ***"
SAY "**************************************************************"
SAY " "
CALL CHECK_PDS
CMPA.1="CMPCOLM 1:"||CMPSIZE
CMP_APDS='T01.HTC.CMPCOLMA.FIL'||FILE_NO||'('||PGM_ID||')'
"ALLOC FI(CMPAFL) DA('"||CMP_APDS||"') SHR"
"EXECIO 1 DISKW CMPAFL (STEM CMPA. FINIS"
"FREE FI(CMPAFL)"
CMPB.1="CMPCOLM 1:"||CMPSIZE
CMP_BPDS='T01.HTC.CMPCOLMB.FIL'||FILE_NO||'('||PGM_ID||')'
"ALLOC FI(CMPBFL) DA('"||CMP_BPDS||"') SHR"
"EXECIO 1 DISKW CMPBFL (STEM CMPB. FINIS"
"FREE FI(CMPBFL)"
/*SAY " "
SAY "COMPARE COLUMNS UPDATED IN :" CMP_APDS
SAY "COMPARE COLUMNS UPDATED IN :" CMP_BPDS
SAY " "*/
SAY "DO YOU WANT TO SUBMIT THE JCL (ENTER 'Y' OR 'N')"
PULL SUBMIT_CHECK
IF SUBMIT_CHECK='Y' THEN
DO
CALL SUBMIT
END
EXIT
PARMCARD:
QRY2=
S1="SELECT END_POSITION FROM HTC1DBB.FTD_PROGRAM_TC_TD_LK WHERE "
S2="PROGRAM_TC_TD_LK_SK=(SELECT MAX(PROGRAM_TC_TD_LK_SK) FROM "
S3="HTC1DBB.FTD_PROGRAM_TC_TD_LK WHERE PGM_ID='"||PGM_ID||"')"
TOTAL_QRY=S1||S2||S3
RETURNED=SELECTDB3(TOTAL_QRY)
/*SAY RETURNED 'RETURNED'*/
/*SAY VAL 'TOTAL SIZE'*/
IF VAL=-1 THEN
DO
SAY "LINKAGE SECTION VALUES NOT AVAILABLE IN LINKAGE TABLE"
SAY "PLEASE CHECK,VALUES WILL BE SET TO ZERO"
VAL=-33
END
VAL=VAL+33
LENGTH_VAL=LENGTH(VAL)
REDUCED_LENGTH=5-LENGTH_VAL
DO Q=1 TO REDUCED_LENGTH
VAL='0'||VAL
END
TOTAL_SIZE=VAL
RETVAL=0
S="SELECT START_POSITION,END_POSITION FROM HTC1DBB.FTD_PROGRAM_TC_TD_LK"
QRY1=S||" WHERE USAGE_TYPE='ISN' AND PGM_ID='"||PGM_ID||"'"
RET2=SELECTDB1(QRY1)
/*SAY RETVAL 'HERE'*/
START_VALUE=WORD(RETVAL,1)+33
PARM=VAL||'-'||START_VALUE||' 4/'
IF RETVAL=0 THEN
DO
PARM=VAL
END
/*SAY PARM 'FINAL'*/
RETURN
SELECTDB1:
PARSE ARG SQLSTMT
SQLSTMT=STRIP(SQLSTMT)
ADDRESS DSNREXX "EXECSQL PREPARE S1 FROM:SQLSTMT"
/* SAY SQLCODE*/
ADDRESS DSNREXX "EXECSQL DECLARE C1 CURSOR FOR S1"
ADDRESS DSNREXX "EXECSQL OPEN C1"
/* SAY SQLCODE*/
DO WHILE SQLCODE = 0
ADDRESS DSNREXX "EXECSQL FETCH C1 INTO :GETV1,:GETV2"
IF SQLCODE < 0 THEN
DO
/*SAY 'FETCH'
CALL SQLCA*/
/* SAY SQLCODE "HI" */
RETURN -2
END
ELSE
DO
IF SQLCODE = 0 THEN
DO
/* IX=IX+1
RET.IX=GETV1' 'GETV2 */
RETVAL=GETV1' 'GETV2
/* LEAVE*/
END
/* ELSE
RETVAL=-1
END */
END
ADDRESS DSNREXX "EXECSQL CLOSE C1"
IF SQLCODE <> 0 THEN /*S1.CNT.0>1 & S1.CNT.0=0 | */
DO
/***** RC2=LINEOUT(ERROR,'GET_VAL :'||RECD)*****/
PUSH 'QUERY :'||SQLSTMT
"EXECIO 1 DISKW OUT"
/***** RC2=LINEOUT(ERROR,'SQLCODE='||SQLCA.SQLCODE)*****/
PUSH 'SQLCODE='||SQLCA.SQLCODE
"EXECIO 1 DISKW OUT"
/***** RC2=LINEOUT(ERROR,'MESSAGE='||SQLCA.SQLERRM)*****/
PUSH 'MESSAGE='||SQLCA.SQLERRM
"EXECIO 1 DISKW OUT"
END
RETURN RET
SELECTDB3:
PARSE ARG SQLSTMT
SQLSTMT=STRIP(SQLSTMT)
ADDRESS DSNREXX "EXECSQL PREPARE S1 FROM:SQLSTMT"
/*SAY SQLCODE*/
ADDRESS DSNREXX "EXECSQL DECLARE C1 CURSOR FOR S1"
ADDRESS DSNREXX "EXECSQL OPEN C1"
/*SAY SQLCODE*/
DO WHILE SQLCODE = 0
ADDRESS DSNREXX "EXECSQL FETCH C1 INTO :GETV1"
IF SQLCODE < 0 THEN
DO
/*SAY 'FETCH'
CALL SQLCA*/
/* SAY SQLCODE "HI" */
RETURN -2
END
ELSE
DO
IF SQLCODE = 0 THEN
DO
VAL=GETV1
LEAVE
END
ELSE
VAL=-1
END
END
ADDRESS DSNREXX "EXECSQL CLOSE C1"
IF SQLCODE <> 0 THEN /*S1.CNT.0>1 & S1.CNT.0=0 | */
DO
/***** RC2=LINEOUT(ERROR,'GET_VAL :'||RECD)*****/
PUSH 'QUERY :'||SQLSTMT
"EXECIO 1 DISKW OUT"
/***** RC2=LINEOUT(ERROR,'SQLCODE='||SQLCA.SQLCODE)*****/
PUSH 'SQLCODE='||SQLCA.SQLCODE
"EXECIO 1 DISKW OUT"
/***** RC2=LINEOUT(ERROR,'MESSAGE='||SQLCA.SQLERRM)*****/
PUSH 'MESSAGE='||SQLCA.SQLERRM
"EXECIO 1 DISKW OUT"
END
RETURN VAL
GET_DATA:
SAY "______________________DELIVERY JCL_______________________________"
SAY "_____________________GENERATION TOOL_____________________________"
SAY "__________________WITH TEST RESULTS UPDATION_____________________"
SAY "ENTER ACCESS MODULE ID"
PULL PGM_ID
CALL VALIDATE(PGM_ID)
QRY_PGM_ID=STRIP(PGM_ID)
SAY ' '
CALL MAIN_RETRIEVE
SAY ' '
SAY 'HIT ENTER IF EMP ID IS RIGHT OR ENTER THE EMP ID'
PULL EMP_ID
IF EMP_ID/=' ' THEN
DO
TST_EMP_ID=EMP_ID
CALL EMP_RETRIEVE
IF EMP_CHK_FLAG=0 THEN
DO
SAY "ENTER EMPLOYEE ID"
PULL EMP_ID
TST_EMP_ID=EMP_ID /****/
CALL EMP_RETRIEVE
END
IF EMP_CHK_FLAG=0 THEN
DO
SAY 'EMP ID KOODA THERILA! PUDICHU JAILA PODUNGA SIR IVANA'
EXIT
END
END
PGM_ID=STRIP(PGM_ID)
CON_TYP="FULL"
SAY 'HIT ENTER FOR FULLY CONVERTED CODE OR "Y" FOR PARTIALLY CONVERTED CODE'
PULL CON_TYP_IN
IF CON_TYP_IN \=' ' & CON_TYP\='Y' THEN
DO
SAY 'HIT ENTER FOR FULLY CONVERTED CODE OR "Y" FOR PARTIALLY CONVERTED CODE'
PULL CON_TYP_IN
END
IF CON_TYP_IN \=' ' & CON_TYP\='Y' THEN
DO
SAY "ONLY 'ENTER KEY' AND 'Y' ARE ALLOWED SO TRY AGAIN"
EXIT
END
IF CON_TYP_IN = 'Y' THEN
DO
CON_TYP='PARTIAL'
END
SAY 'HIT ENTER TO CONTINUE OR "Y" TO ENTER REMARKS'
PULL REMARKS_INPUT
IF REMARKS_INPUT \= ' ' & REMARKS_INPUT \= 'Y' THEN
DO
SAY 'HIT ENTER TO CONTINUE OR "Y" TO ENTER REMARKS'
PULL REMARKS_INPUT
END
IF REMARKS_INPUT \= ' ' & REMARKS_INPUT \= 'Y' THEN
DO
SAY 'TOOL EXITING!!!!!!! TRY AGAIN................'
EXIT
END
IF REMARKS_INPUT = 'Y' THEN
DO
CALL REMARKS
END
ELSE
DO
REMARKS= ' '
END
IF LENGTH(PGM_ID)>6 THEN
DO
PGM_ID=STRIP(SUBSTR(PGM_ID,2,6))
END
CHECK_QRY="SELECT DB_ACCESS_MODULE_ID FROM HTC1DBB.TES_DB_ACCESS_MODULE WHERE
DB_ACCESS_MODULE_ID = '"||PGM_ID||"'"
/*SAY CHECK_QRY*/
NEW_RET=SELECTDB4(CHECK_QRY)
IF NEW_VAL=-1 THEN
DO
/*SAY "INVALID PROGRAM ID"*/
/*EXIT*/
END
SAY "ENTER SNAP_TABLE NO EX 1,2,3,4,10 ETC"
PULL SNAP
SNAP=STRIP(SNAP)
IF SNAP=' ' THEN
DO
SAY "ENTER SNAP_TABLE NO EX 1,2,3,4,10 ETC"
PULL SNAP
END
IF SNAP=' ' THEN
DO
SAY "ENTER VALID SNAP_TABLE NO EX 1,2,3,4,10 ETC"
PULL SNAP
END
IF SNAP=' ' THEN
DO
SAY "TOOL EXITING!!!!!!!! TRY WITH A VALID SNAP NUMBER"
EXIT
END
IF LENGTH(SNAP)=2 THEN
DO
SNAP="SNAP_"||SNAP
END
ELSE
DO
SNAP="SNAP_0"||SNAP
END
SAY "ENTER VERSION NO AS 1,2,3,4 ETC FOR UTRVX"
PULL VERSION_NO
IF VERSION_NO= ' ' THEN
DO
SAY "ENTER VERSION NO AS 1,2,3,4 ETC FOR UTRVX"
PULL VERSION_NO
END
IF VERSION_NO= ' ' THEN
DO
SAY "ENTER VALID VERSION NO AS 1,2,3,4 ETC FOR UTRVX"
PULL VERSION_NO
END
IF VERSION_NO= ' ' THEN
DO
SAY "TRY WITH A VALID VERSION NO! TOOL EXITING"
EXIT
END
VERSION_NO=STRIP(VERSION_NO)
VER_NO=VERSION_NO
VERSION_NO="UTRV"||VERSION_NO
CALL GET_DETAILS
IF INDEX(FILE_TYPE,'CICS') THEN
DO
PGM_ID_NEW='L'||PGM_ID||'P'
END
ELSE
DO
PGM_ID_NEW=PGM_ID
END
CALL GET_DLVRY
RETURN
GET_DETAILS:
A="SELECT FD.FILE_NUMBER,DAM.MODULE_TYPE "
B="FROM HTC1DBB.TES_FILE_DEFINITION FD JOIN "
C="HTC1DBB.TES_FILE_ACCESS_MODULE FAM "
D="ON FD.FILE_DEFINITION_SK = FAM.FILE_DEFINITION_SK "
E="JOIN HTC1DBB.TES_DB_ACCESS_MODULE DAM "
F="ON DAM.DB_ACCESS_MODULE_SK = FAM.DB_ACCESS_MODULE_SK "
G="WHERE DAM.DB_ACCESS_MODULE_ID = '"||PGM_ID||"' "
GET_QUERY=A||B||C||D||E||F||G
RET4=SELECTDB1(GET_QUERY)
/*SAY RETVAL 'NOT FOUND'*/
FILE_TYPE=WORD(RETVAL,2)
FILE_NO=WORD(RETVAL,1)
IF RETVAL='RETVAL' THEN
DO
SAY "ENTER FILE NO"
PULL FILE_NO
FILE_NO=STRIP(FILE_NO)
SAY "ENTER 'C' FOR CICS OR 'B' FOR BATCH"
PULL FILE_TYPE
FILE_TYPE=STRIP(FILE_TYPE)
IF FILE_TYPE='C' THEN
FILE_TYPE='CICS'
IF FILE_TYPE='B' THEN
FILE_TYPE='BATCH'
END
IF LENGTH(FILE_NO)=1 THEN
DO
FILE_NO='00'||FILE_NO
END
IF LENGTH(FILE_NO)=2 THEN
DO
FILE_NO='0'||FILE_NO
END
/*SAY FILE_TYPE 'TYPE'
SAY FILE_NO 'NO'*/
RETURN
GET_DLVRY:
DO J=1 TO INP_DATA.0
FILE_NAME=WORD(INP_DATA.J,1)
DLVRY_NAME=WORD(INP_DATA.J,5)
IF STRIP(FILE_NAME)=STRIP(FILE_NO) THEN
DO
/* SAY 'AM IN'*/
DLVRY="DLVRY_"||DLVRY_NAME
J=INP_DATA.0
END
END
RETURN
DBCONCT:
DBNAME = 'DB0I' /* DEFAULT DATABASE */
SUBCOM DSNREXX
IF RC THEN
DO
S_RC=RXSUBCOM('ADD','DSNREXX','DSNREXX')
/* SAY 'DB CONNECTED SUCCESSFULLY'*/
END
ADDRESS DSNREXX 'CONNECT DB0I'
IF SQLCODE <> 0 THEN
DO
CALL SQLCA
END
RETURN
DBDCONT:
ADDRESS DSNREXX "DISCONNECT"
S_RC=RXSUBCOM('DELETE','DSNREXX','DSNREXX')
IF RC =0 THEN
/*SAY 'DISCONNECTED SUCCESSFULLY'*/
RETURN
SELECTDB4:
PARSE ARG SQLSTMT
SQLSTMT=STRIP(SQLSTMT)
ADDRESS DSNREXX "EXECSQL PREPARE S1 FROM:SQLSTMT"
/*AY SQLCODE*/
ADDRESS DSNREXX "EXECSQL DECLARE C1 CURSOR FOR S1"
ADDRESS DSNREXX "EXECSQL OPEN C1"
/*SAY SQLCODE*/
DO WHILE SQLCODE = 0
ADDRESS DSNREXX "EXECSQL FETCH C1 INTO :GETV1"
IF SQLCODE < 0 THEN
DO
/*SAY 'FETCH'
CALL SQLCA*/
/* SAY SQLCODE "HI" */
RETURN -2
END
ELSE
DO
IF SQLCODE = 0 THEN
DO
NEW_VAL=GETV1
LEAVE
END
ELSE
NEW_VAL=-1
END
END
ADDRESS DSNREXX "EXECSQL CLOSE C1"
IF SQLCODE <> 0 THEN /*S1.CNT.0>1 & S1.CNT.0=0 | */
DO
/***** RC2=LINEOUT(ERROR,'GET_VAL :'||RECD)*****/
PUSH 'QUERY :'||SQLSTMT
"EXECIO 1 DISKW OUT"
/***** RC2=LINEOUT(ERROR,'SQLCODE='||SQLCA.SQLCODE)*****/
PUSH 'SQLCODE='||SQLCA.SQLCODE
"EXECIO 1 DISKW OUT"
/***** RC2=LINEOUT(ERROR,'MESSAGE='||SQLCA.SQLERRM)*****/
PUSH 'MESSAGE='||SQLCA.SQLERRM
"EXECIO 1 DISKW OUT"
END
RETURN NEW_VAL
CHECK_PDS:
PDS_NAME = "T01.HTC.CMPCOLMA.FIL"||FILE_NO
PDS_NAME_2 = "T01.HTC.CMPCOLMB.FIL"||FILE_NO
IF SYSDSN("'"PDS_NAME"'") = "OK" THEN
DO
NOP
END
ELSE
DO
USER_ID=USERID()
A_PDS_NAME= USER_ID||".T01.HTC.CMPCOLMA.FIL"||FILE_NO
"ALLOCATE DATASET('"A_PDS_NAME"') CATALOG LRECL (80),
BLKSIZE(27920) RECFM(F B) DSORG(PO) TRACKS SPACE(1 5) DIR(30)"
"ALTER '"A_PDS_NAME"' NEWNAME('"PDS_NAME"')"
END
IF SYSDSN("'"PDS_NAME_2"'") = "OK" THEN
DO
NOP
END
ELSE
DO
USER_ID=USERID()
B_PDS_NAME= USER_ID||".T01.HTC.CMPCOLMB.FIL"||FILE_NO
"ALLOCATE DATASET('"B_PDS_NAME"') CATALOG LRECL (80),
BLKSIZE(27920) RECFM(F B) DSORG(PO) TRACKS SPACE(1 5) DIR(30)"
"ALTER '"B_PDS_NAME"' NEWNAME('"PDS_NAME_2"')"
END
RETURN
EMP_RETRIEVE:
EMP_CHK_FLAG=0
DO L=1 TO ID_ARR.0
PARSE VAR ID_ARR.L EMP_ID '/' EMP_NAME '/'
IF EMP_ID=TST_EMP_ID THEN
DO
TST_NAM=STRIP(EMP_NAME)
EMP_CHK_FLAG=1
LEAVE
END
END
RETURN
MAIN_RETRIEVE:
DO MM=1 TO ID_ARR.0
PARSE VAR ID_ARR.MM EMP_ID '/' EMP_NAME '/' MAIN_ID
MAIN_ID=STRIP(MAIN_ID)
INPUT_ID=USERID()
INPUT_ID=STRIP(INPUT_ID)
IF MAIN_ID=INPUT_ID THEN
DO
SAY 'EMPLOYEE NAME AND ID :' EMP_NAME
TST_NAM=STRIP(EMP_NAME)
LEAVE
END
END
RETURN
REMARKS:
SELECT_QRY='SELECT PROGRAM_REMARKS_SK,REMARKS_DESCRIPTION,ACTIVE '
SELECT_QRY=SELECT_QRY||'FROM HTC1DBB.FTD_PROGRAM_REMARKS WHERE'
SELECT_QRY=SELECT_QRY||" ACTIVE='Y' "
RETUTN_VAL=SELECTDB5(SELECT_QRY)
DO R=1 TO G
NUMBER.R=WORD(VALUE.R,1)
DESC.R=WORD(VALUE.R,2)
STAT.R=WORD(VALUE.R,3)
SAY '('R') 'DESC_OUTPUT.R
END
SAY " "
SAY "ENTER REMARK NO OR ENTER 'N' TO CREATE NEW REMARK"
PULL INPUT_NO
INPUT_NO=STRIP(INPUT_NO)
IF INPUT_NO\='N' THEN
DO
REMARKS=DESC_OUTPUT.INPUT_NO
END
IF INPUT_NO='N' THEN
DO
SAY "ENTER THE REMARKS NOT GREATER THAN 55 CHARACTERS"
PULL REMARKS
IF LENGTH(REMARKS)>55 THEN
DO
SAY "ABBREVIATE REMARKS LESS THAN 55 CHARACTERS"
PULL REMARKS
END
IF LENGTH(REMARKS)>55 THEN
DO
SAY "TOOL EXITING! BETTER LUCK NEXT TIME"
EXIT
END
SELET_QRY='SELECT PROGRAM_REMARKS_SK,REMARKS_DESCRIPTION,ACTIVE '
SELET_QRY=SELET_QRY||'FROM HTC1DBB.FTD_PROGRAM_REMARKS WHERE '
SELET_QRY=SELET_QRY||"REMARKS_DESCRIPTION='"||REMARKS||"' "
TEST_FLAG=0
RET_SEL=SELECTDB5(SELET_QRY)
IF TEST_FLAG=0 THEN
DO
CALL INSERT_FUNC
END
END
RETURN
SELECTDB5:
PARSE ARG SQLSTMT
SQLSTMT=STRIP(SQLSTMT)
ADDRESS DSNREXX "EXECSQL PREPARE S1 FROM:SQLSTMT"
/*SAY SQLCODE*/
ADDRESS DSNREXX "EXECSQL DECLARE C1 CURSOR FOR S1"
ADDRESS DSNREXX "EXECSQL OPEN C1"
/*SAY SQLCODE*/
DO WHILE SQLCODE = 0
ADDRESS DSNREXX "EXECSQL FETCH C1 INTO :GETV1,:GETV2,:GETV3"
IF SQLCODE < 0 THEN
DO
/*SAY 'FETCH'
CALL SQLCA*/
/* SAY SQLCODE "HI" */
RETURN -2
END
ELSE
DO
IF SQLCODE = 0 THEN
DO
TEST_FLAG=1
G=G+1
VALUE.G=GETV1' 'GETV2' 'GETV3
DESC_OUTPUT.G=GETV2
END
ELSE
VAL=-1
END
END
ADDRESS DSNREXX "EXECSQL CLOSE C1"
IF SQLCODE <> 0 THEN /*S1.CNT.0>1 & S1.CNT.0=0 | */
DO
/***** RC2=LINEOUT(ERROR,'GET_VAL :'||RECD)*****/
PUSH 'QUERY :'||SQLSTMT
"EXECIO 1 DISKW OUT"
/***** RC2=LINEOUT(ERROR,'SQLCODE='||SQLCA.SQLCODE)*****/
PUSH 'SQLCODE='||SQLCA.SQLCODE
"EXECIO 1 DISKW OUT"
/***** RC2=LINEOUT(ERROR,'MESSAGE='||SQLCA.SQLERRM)*****/
PUSH 'MESSAGE='||SQLCA.SQLERRM
"EXECIO 1 DISKW OUT"
END
RETURN VAL
INSERT_FUNC:
COLUMN_NAME="(PROGRAM_REMARKS_SK,REMARKS_DESCRIPTION,ACTIVE)"
COLUMN_VALUES="(NEXT VALUE FOR HTC1DBB.PROGRAM_REMARKS_SQ,'"|,
|REMARKS||"','N') "
/* SAY COLUMN_VALUES */
TABLE_NAME=HTC1DBB.FTD_PROGRAM_REMARKS
CALL EXECUTE TABLE_NAME COLUMN_NAME COLUMN_VALUES
RETURN
EXECUTE:
PARSE ARG TABLE COLUMN_NAME VAL
DL1 = ","
/*
SAY 'INSIDE THE EXECUTE ****************'
SAY ' TABLE' TABLE
SAY '*************************************'
SAY ' COLS' COLUMN_NAME
SAY '*************************************'
SAY 'VALUE' VALUE
SAY '*************************************'
*/
VALUE1='INSERT INTO '||TABLE ||COLUMN_NAME||'VALUES'||VAL||' '
/*SAY VALUE1 'ACTUAL QUERY'*/
SQLSTMT=VALUE1
ADDRESS DSNREXX "EXECSQL "SQLSTMT
/*SAY 'SQLCODE INSERT :'SQLCODE*/
IF SQLCODE <>0 THEN
DO
CALL SQLCA
END
ELSE
DO
IF SQLCODE = 0 THEN
DO
/* SAY 'REMARKS INSERTED SUCCESSFULLY'*/
/* SAY '****************************'
SAY ' '*/
/*SAY TABLE||' INSERTED SUCCESSFULLY'*/
/*SAY ' '
SAY '****************************'*/
END
END
RETURN 0
SQLCA:
SAY 'INSIDE THE SQLCA'
SAY 'SQLSTATE' SQLSTATE
SAY 'SQLWARN' SQLWARN.0 || SQLWARN.1 || SQLWARN.2 || SQLWARN.3
SAY 'SQLERRD' SQLERRD.1
SAY 'SQLERRMC' SQLERRMC
SAY 'SQLCODE ' SQLCODE
RETURN 0
SUBMIT:
ADDRESS TSO
"SUBMIT '"||PDSNAME||"'"
SAY " "
SAY "COMPARE DATASET :T01.HTC.FILE"||FILE_NO||"."||PGM_ID|,
|"*.COMPARE."||VERSION_NO
RETURN
VALIDATE:
PARSE ARG CHECK_VAR
IF LENGTH(PGM_ID)\=6 THEN
DO
SAY 'WARNING 1: ENTER A VALID PROGRAM ID'
PULL PGM_ID
PGM_ID=STRIP(PGM_ID)
END
IF LENGTH(PGM_ID)\=6 THEN
DO
SAY 'WARNING 2: LAST CHANCE BETTER USE IT'
PULL PGM_ID
PGM_ID=STRIP(PGM_ID)
END
IF LENGTH(PGM_ID)\=6 THEN
DO
SAY 'BYE BYE !!!! BETTER LUCK NEXT TIME'
EXIT
END
RETURN
No comments:
Post a Comment