Fix your abend here

Find your abend and fix it

Wednesday 16 January 2013


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