├── DB2 ├── GetNewParts.JCL ├── CatalogQueries │ ├── getPartitionSpace.sql │ ├── columnDetails.sql │ ├── getMultColumns.sql │ ├── accessMatrix.sql │ └── getSpaceDetails.sql └── commands.db2 ├── REXX ├── new.rexx ├── RunSQL.rexx └── delempo.rexx ├── Cobol ├── basics │ ├── abc.cbl │ └── var.cbl ├── db2oper │ ├── pcledit.jcl │ ├── rundb2.jcl │ ├── bind.jcl │ ├── db2curs.cbl │ └── db2oper.cbl ├── SpecialNames.cob ├── cics │ ├── calc.cpybk │ ├── calc.bms │ └── calc.cbl └── fileop │ └── READPS.cob ├── .project ├── README.md ├── JCL ├── sort │ ├── sortcnt.jcl │ ├── icecnt.jcl │ ├── sortht.jcl │ ├── sortsplit.jcl │ ├── compare.jcl │ └── sortdup.jcl ├── basics │ ├── listcat.jcl │ ├── delete.jcl │ ├── rename.jcl │ ├── iebcopy.jcl │ └── compare.jcl ├── db2-utils │ ├── db2commands.jcl │ ├── unload.jcl │ └── bind.jcl └── utils │ ├── decompress.jcl │ ├── compress.jcl │ └── timestamp.jcl └── PL1 ├── basics └── datatyp.pli └── builtin └── string.pli /DB2/GetNewParts.JCL: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /REXX/new.rexx: -------------------------------------------------------------------------------- 1 | /*REXX*/ -------------------------------------------------------------------------------- /DB2/CatalogQueries/getPartitionSpace.sql: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /REXX/RunSQL.rexx: -------------------------------------------------------------------------------- 1 | /*REXX*/ 2 | /*Rexx script to run DB2 SQL using Rexx */ 3 | -------------------------------------------------------------------------------- /DB2/CatalogQueries/columnDetails.sql: -------------------------------------------------------------------------------- 1 | select c.name,c.tbname,t.creator,t.owner 2 | from sysibm.syscolumns c, sysibm.systables t 3 | where t.name = c.tbname; 4 | 5 | -------------------------------------------------------------------------------- /Cobol/basics/abc.cbl: -------------------------------------------------------------------------------- 1 | 01 WS-COPY. 2 | 05 WS-COPY-1 PIC 9(2) VALUE 24. 3 | 05 WS-COPY-2 PIC X(2) VALUE 'AB'. 4 | 01 WS-NAMES. 5 | 05 WS-FIRSTNAME PIC X(20) VALUE 'FIRST'. 6 | 05 WS-LASTNAME PIC X(20) VALUE 'LAST'. 7 | -------------------------------------------------------------------------------- /.project: -------------------------------------------------------------------------------- 1 | 2 | 3 | myMainframe 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | -------------------------------------------------------------------------------- /DB2/CatalogQueries/getMultColumns.sql: -------------------------------------------------------------------------------- 1 | --lists multiple columns which are present insame table 2 | select * from sysibm.syscolumns c1 3 | where name in ('COL1','COL2') 4 | and tbname = (select name from sysibm.syscolumns c2 5 | where c1.tbname = c2.tbname and c1.name = c2.name) -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # myMainframe 2 | - Useful mainframe related tips and quick codes which can help to start working or understanding on mainframe related. 3 | - Many updates will come soon 4 | - Quick rexx codes for Automation 5 | - Usefull JCL's that can help debug 6 | - Programs for error handling 7 | - Many more 8 | -------------------------------------------------------------------------------- /JCL/sort/sortcnt.jcl: -------------------------------------------------------------------------------- 1 | //* JCL TO COUNT THE RECORDS IN INPUT FILE(BASED ON COND) 2 | //STEP010 EXEC PGM=SORT 3 | //SORTIN DD DSN= 4 | //SORTOUT DD SYSOUT=* /* DISPLAY IN SPOOL 5 | //SYSIN DD * 6 | OPTION COPY 7 | OUTFIL REMOVECC,NODETAIL 8 | SECTIONS=(1,2, 9 | TRAILER3=(1,2,X,COUNT=(M11,LENGTH=9))) 10 | /* 11 | //* Group from input the counts of Unique Values in Position 1,2 12 | -------------------------------------------------------------------------------- /JCL/sort/icecnt.jcl: -------------------------------------------------------------------------------- 1 | //* TO GET THE REPORT OF FILE BASED ON 2 | //* SPECIFIC COLUMN 3 | //STEP010 EXEC PGM=ICETOOL 4 | //INDD DD DSN=,DISP=SHR 5 | //RPT DD DSN=* /* OR CHANGE TO ANY FILE 6 | //TOOLIN DD * 7 | OCCURS FROM(INDD) ON(1,10,CH) - 8 | ON(20,3,CH) - 9 | ON(VALCNT) BLANK- 10 | HEADER('FCOL') HEADER('SCOL') HEADER('TCOL') 11 | /* 12 | -------------------------------------------------------------------------------- /JCL/sort/sortht.jcl: -------------------------------------------------------------------------------- 1 | //* ICETOOL to remove Header and Trailer from i/p file 2 | //STEP001 EXEC PGM=ICETOOL 3 | //TOOLMSG DD SYSOUT=* 4 | //DFSMSG DD SYSOUT=* 5 | //INDD DD DSN=,DISP=SHR 6 | //OUTDD DD DSN=,DISP=MOD 7 | //TOOLIN DD * 8 | SUBSET FROM(INDD) TO(OUTDD) INPUT REMOVE HEADER TRAILER 9 | /* 10 | //CTL1CNT DD * 11 | SORT FIELDS=COPY 12 | /* 13 | //* TO REMOVE LAST RECORD WE CAN USE 14 | //* REMOVE INPUT LAST 15 | -------------------------------------------------------------------------------- /Cobol/db2oper/pcledit.jcl: -------------------------------------------------------------------------------- 1 | //IBMLIB JCLLIB ORDER='SYS1.ADMIN.PROCLIB' 2 | //JS0010 EXEC DSNH7COB,MEMBER=DB2CURS, 3 | // SRCELIB=TRNG497.COBOL.SRC, 4 | // DBRMLIB=TRNG497.COBOL.DBRM, 5 | //* INCLLIB=TRNG01.DCLGEN(M1), 6 | // LOADLIB=TRNG497.COBOL.LOAD 7 | //*SYSOUT DD SYSOUT=* 8 | //*SYSPRINT DD SYSOUT=* 9 | /* 10 | -------------------------------------------------------------------------------- /JCL/basics/listcat.jcl: -------------------------------------------------------------------------------- 1 | //* JCL List cat to find out all details about a file *// 2 | //* Modified: 26-12-2016 By : Phani *// 3 | //* *// 4 | //STEP010 EXEC PGM=IDCAMS 5 | //SYSPRINT DD SYSOUT=* 6 | //SYSIN DD * 7 | LISTCAT ENTRIES('filename') VOLUME/ALL/ALLOCATION 8 | /* -------------------------------------------------------------------------------- /JCL/basics/delete.jcl: -------------------------------------------------------------------------------- 1 | //* Delete gdg,vsam files *// 2 | //* Modified: 26-12-2016 By : Phani *// 3 | //* *// 4 | //STEP1 EXEC PGM=IDCAMS 5 | //SYSPRINT DD SYSOUT=* 6 | //SYSIN DD * 7 | DELETE ()GDG FORCE 8 | /* -------------------------------------------------------------------------------- /JCL/sort/sortsplit.jcl: -------------------------------------------------------------------------------- 1 | //* JCL TO SORT AND SPLIT THE FILE INTO MULTIPLE FILES 2 | //* BASED ON GIVEN CONDITION 3 | //STEP010 EXEC PGM=SORT 4 | //SORTIN DD DSN=,DISP=SHR 5 | //SORTOF1 DD DSN=,DISP=OLD /* CHANGE TO NEW FOR NEW 6 | //SORTOF2 DD DSN=,DISP=OLD /* CHANGE TO NEW FOR NEW 7 | //SYSIN DD * 8 | SORT FIELDS=COPY 9 | OUTFIL FILE=01, 10 | INCLUDE=(1,2,CH,EQ,'AB',AND,5,2,CH,EQ,'12') 11 | OUTFILE FILE=02, 12 | INCLUDE=(1,2,CH,NE,'AB',AND',5,2,CH,NE,'12') 13 | /* 14 | -------------------------------------------------------------------------------- /JCL/basics/rename.jcl: -------------------------------------------------------------------------------- 1 | //* JCL to RENAME ANY FILE, VSAM,PS,PDS ETC *// 2 | //* Modified: 26-12-2016 By : Phani *// 3 | //* *// 4 | //STEP010 EXEC PGM=IDCAMS,COND=(0,NE) 5 | //SYSPRINT DD SYSOUT=* 6 | //SYSIN DD * 7 | ALTER - 8 | NEWNAME() 9 | /* -------------------------------------------------------------------------------- /JCL/db2-utils/db2commands.jcl: -------------------------------------------------------------------------------- 1 | //* JCL to RUN SQL COMMANDS (DB2I, DB2 INTERACTIVE) *// 2 | //* Modified: 26-12-2016 By : Phani *// 3 | //* *// 4 | //STEP01 EXEC PGM=IKJEFT01,DYNAMNBR=20 5 | //SYSTSPRT DD SYSOUT=* 6 | //SYSPRINT DD SYSOUT=* 7 | //SYSUDUMP DD SYSOUT=* 8 | //SYSOUT DD SYSOUT=* 9 | //SYSTSIN DD * 10 | DSN SYSTEM() 11 | -DISPLAY DATABASE() SPACENAM(*) 12 | END 13 | //SYSIN DD DUMMY -------------------------------------------------------------------------------- /DB2/CatalogQueries/accessMatrix.sql: -------------------------------------------------------------------------------- 1 | SELECT distinct GRANTEE, STNAME AS TABEL_VIEW, 2 | CASE SELECTAUTH WHEN 'Y' THEN 'SEL' ELSE '...' END AS SEL, 3 | CASE INSERTAUTH WHEN 'Y' THEN 'INS' ELSE '...' END AS INS, 4 | CASE UPDATEAUTH WHEN 'Y' THEN 'UPD' ELSE '...' END AS UPD, 5 | CASE DELETEAUTH WHEN 'Y' THEN 'DEL' ELSE '...' END AS DEL 6 | FROM SYSIBM.SYSCOLUMNS a, SYSIBM.SYSTABAUTH ac 7 | where 1=1 8 | and a.TBCREATOR = '<>' --Schema 9 | and a.TBNAME = '<>' -- Table Name 10 | --and grantee like '%<>%' -- Package name 11 | and a.tbname = ac.stname 12 | --and (INSERTAUTH = 'Y' or UPDATEAUTH = 'Y') 13 | order by 1, 2, 3, 4 14 | FETCH FIRST 200 ROWS ONLY ; 15 | -------------------------------------------------------------------------------- /JCL/basics/iebcopy.jcl: -------------------------------------------------------------------------------- 1 | //* JCL EXAMPLE IEBCOPY,PDS MEMBER TO PDS MEMBER(SELECTED) *// 2 | //* Modified: 26-12-2016 By : Phani *// 3 | //* *// 4 | //IEBCOP1 EXEC IEBCOPY 5 | //DDIN DD DSN=,DISP=SHR 6 | //DDOUT DD DSN=,DISP=SHR 7 | //SYSPRINT DD SYSOUT=* 8 | //SYSOUT DD SYSOUT=* 9 | //SYSIN DD 10 | COPY INDDN=DDIN,OUTDDN=DDOUT 11 | SELECT MEMBER= 12 | /* 13 | // -------------------------------------------------------------------------------- /Cobol/db2oper/rundb2.jcl: -------------------------------------------------------------------------------- 1 | //JS0010 EXEC PGM=IKJEFT01,DYNAMNBR=20 COND=(4,LT) 2 | //STEPLIB DD DSN=DSN810.SDSNLOAD,DISP=SHR 3 | //SYSTSPRT DD SYSOUT=* 4 | //SYSPRINT DD SYSOUT=* 5 | //SYSUDUMP DD SYSOUT=* 6 | //SYSOUT DD SYSOUT=* 7 | //SYSTSIN DD * 8 | DSN SYSTEM(DB2P) 9 | RUN PROGRAM(DB2OPER) PLAN(DB2OPER) LIB('TRNG497.COBOL.LOAD') 10 | END 11 | //* 12 | -------------------------------------------------------------------------------- /JCL/basics/compare.jcl: -------------------------------------------------------------------------------- 1 | //* COMPARE TWO PDS AND DISPLAY DIFFERENCES IN SPOOL *// 2 | //* Modified: 26-12-2016 By : Phani *// 3 | //* *// 4 | //SUPERC EXEC PGM=ISRSUPC, 5 | // PARM=(DELTAL,LINECMP,'','') 6 | //OLDDD DD DSN=,DISP=SHR 7 | //NEWDD DD DSN=,DISP=SHR 8 | //OUTDD DD SYSOUT=A 9 | //SYSPRINT DD SYSOUT=* 10 | //SYSDUMP DD SYSOUT=* 11 | /* -------------------------------------------------------------------------------- /DB2/commands.db2: -------------------------------------------------------------------------------- 1 | 2 | -Commands for DB2i - Interactive commands 3 | 4 | -DIS DATABASE() SPACENAM() 5 | 6 | # Gives status of Database and if spacenam is specified for a specific space 7 | generally used to know if the DB is in rw mode or any other 8 | 9 | # spacenam can be either tablespace name or indexspace name 10 | 11 | # avoid spacenam to know the status of all spaces in DB 12 | 13 | # Use additional keyword RESTRICT to know the space in restricted mode 14 | 15 | 16 | 17 | -START DATABSE(DBNAME) SPACENAME() 18 | 19 | # To start a database , use optional parameters to start in a specific mode 20 | 21 | 22 | -DIS UTIL() 23 | -TERM UTIL() 24 | 25 | # Used to ge the Utility id and to terminates 26 | # extremely useful when we have a Load Utility Job failure abnormally 27 | 28 | 29 | 30 | -------------------------------------------------------------------------------- /JCL/db2-utils/unload.jcl: -------------------------------------------------------------------------------- 1 | //* JCL TO CREATE UNLOAD FROM A SPECIFIC TABLE 2 | //* USING IKJEFT01 3 | //STEP001 EXEC PGM=IKJEFT01 4 | //STEPLIB DD DSN=,DISP=SHR 5 | //* CHECK WITH YOUR PEERS FOR PROPER STEPLIB 6 | //SYSTSPRT DD SYSOUT=* 7 | //SYSUDUMP DD SYSOUT=* 8 | //SYSPRINT DD SYSOUT=* 9 | //SYSPUNCH DD DSN=,DISP=(,CATLG,DELETE), 10 | // RECFM=FB.LRECL=100,UNIT=DISK,SPACE=(TRK,(10,10),RLSE) 11 | //SYSREC DD DSN=,DISP=(,CATLG,DELETE), 12 | // RECFM=FB.LRECL=100,UNIT=DISK,SPACE=(CYL,(10,10),RLSE) 13 | //SYSTIN DD * 14 | DSN SYSTEM() * CHANGE TO YOUR DB2 SUBSYSTE 15 | RUN PROG(DSNTIUAL) - 16 | PLAN(DSNTIUAL) - 17 | LIB() - 18 | PARMS('SQL') - 19 | /* 20 | //SYSIN DD * 21 | SELECT * FROM .; 22 | /* 23 | // 24 | -------------------------------------------------------------------------------- /Cobol/db2oper/bind.jcl: -------------------------------------------------------------------------------- 1 | //BIND EXEC PGM=IKJEFT01,DYNAMNBR=20 2 | //STEPLIB DD DSN=DSN810.SDSNLOAD,DISP=SHR 3 | //SYSTSPRT DD SYSOUT=* 4 | //SYSPRINT DD SYSOUT=* 5 | //SYSUDUMP DD SYSOUT=* 6 | //SYSTSIN DD * 7 | DSN SYSTEM(DB2P) 8 | BIND PLAN(DB2OPER) MEM(DB2OPER) ACT(REP) ISOLATION(CS) - 9 | EXPLAIN (NO) - 10 | LIB('TRNG497.COBOL.DBRM')- 11 | OWNER(TRNGGRP) 12 | END 13 | /* 14 | // 15 | -------------------------------------------------------------------------------- /JCL/utils/decompress.jcl: -------------------------------------------------------------------------------- 1 | //* DECOMPRESS THE COMPRESSED FILE TO ORIGINAL FILES(UNZIP) *// 2 | //* Modified: 26-12-2016 By : Phani *// 3 | //* *// 4 | //STEP010 EXEC PGM=ADRDSSU, 5 | // REGION=32M 6 | //SYSPRINT DD SYSOUT=* 7 | //DATA DD DSN=,DISP=SHR <- the same file that is compressed using adrdssu 8 | //OUTD1 DD UNIT=3390,VOL=SER=vol1,SPACE=(CYL,(1000,500),RLSE) <- adjust parameters accordingly 9 | //SYSIN DD * 10 | RESTORE DS(INC(**)) - 11 | RENUNC(*.*.**,) - <- Change HLQ and MLQ accordingly 12 | IDD(DATA) ODD(OUTD1) CAT 13 | /* -------------------------------------------------------------------------------- /JCL/utils/compress.jcl: -------------------------------------------------------------------------------- 1 | //* COMPRESS MULTIPLE FILES TO ONE FILE (ZIP) *// 2 | //* Modified: 26-12-2016 By : Phani *// 3 | //* *// 4 | //GETUDATA EXEC PGM=ADRDSSU,REGION=4M 5 | //* 6 | //SYSPRINT DD SYSOUT=* 7 | //ECSOUT DD DISP=(NEW,CATLG), 8 | // DSN=, <- change accordingly 9 | // SPACE=(CYL,(100,50),RLSE),UNIT=SYSDA 10 | //SYSIN DD * 11 | DUMP DS(INC( - 12 | - 13 | - 14 | - 15 | - 16 | )) - 17 | ALLDATA(*) - 18 | ODD(ECSOUT) COMPRESS SHARE 19 | /* -------------------------------------------------------------------------------- /JCL/db2-utils/bind.jcl: -------------------------------------------------------------------------------- 1 | //* JCL TO BE USED FOR BIND(EXAMPLE ONLY) *// 2 | //* Modified: 26-12-2016 By : Phani *// 3 | //* *// 4 | //STEP010 EXEC PGM=IKJEFT1B, 5 | // DYNAMNBR=2, 6 | // REGION=0K 7 | //**SCEERUN & SDSNLOAD lib Lib differs from system 8 | //*check with sysadmin for details 9 | //STEPLIB DD DSN=,DISP=SHR 10 | // DD DSN=<&DB2LOAD>,DISP=SHR 11 | // DD DSN=,DISP=SHR 12 | //SYSTSPRT DD SYSOUT=* 13 | //SYSPRINT DD SYSOUT=* 14 | //DBRMLIB DD DSN=,DISP=SHR 15 | //SYSTSIN DD * 16 | DSN SYSTEM() 17 | BIND PACKAGE() - 18 | OWNER() - 19 | QUALIFIER() - 20 | MEMBER() - 21 | ACTION(REPLACE/ADD) - 22 | VALIDATE(BIND) - 23 | DEGREE(1)- 24 | ISOLATION(CS) - <- * Other Isolation are RR,UR 25 | EXPLAIN(NO) - <- * Change to yes for capturing details in plan_table 26 | ENABLE(BATCH,CICS,DLIBATCH); 27 | // -------------------------------------------------------------------------------- /JCL/sort/compare.jcl: -------------------------------------------------------------------------------- 1 | //* JCL to compare two files and create match and unmatch files *// 2 | //* Modified: 26-12-2016 By : Phani *// 3 | //* *// 4 | //STEP0001 EXEC PGM=SORT 5 | //SYSOUT DD SYSOUT=* 6 | //IN1 DD DISP=SHR,DSN= 7 | //IN2 DD DISP=SHR,DSN= 8 | //MATCHED DD DISP=OLD,DSN= 9 | //UNMATCH DD DISP=OLD,DSN= 10 | //* Documentation: 11 | //* Change Joinkeys to have the selected fields from files 12 | //* Reformat the data available 13 | //* More documentation : http://www.ibm.com/support/knowledgecenter/SSLTBW_2.1.0/ 14 | //* com.ibm.zos.v2r1.icea100/ice2ca_Example_5_-_Paired_and_unpaired_F1_F2_records__indicator_method_.htm 15 | //SYSIN DD * 16 | OPTION COPY 17 | JOINKEYS F1=INA,FIELDS=(1,300,A) 18 | JOINKEYS F2=INB,FIELDS=(1,300,A) 19 | JOIN UNPAIRED 20 | REFORMAT FIELDS=(F1:1,300,F2:1,300,?) 21 | INREC IFTHEN=(WHEN=(601,1,CH,EQ,C'2'),OVERLAY=(1:301,300)) 22 | OUTFIL FNAMES=MATCHED,INCLUDE=(601,1,CH,EQ,C'B'),BUILD=(1,300) 23 | OUTFIL FNAMES=UNMATCH,INCLUDE=(601,1,SS,EQ,C'1,2'),BUILD=(1,300) 24 | /* -------------------------------------------------------------------------------- /JCL/sort/sortdup.jcl: -------------------------------------------------------------------------------- 1 | //* JCL to Sort and eliminate/include only duplicates ICETOOL *// 2 | //* Modified: 26-12-2016 By : Phani *// 3 | //* *// 4 | //STEP010 EXEC PGM=ICETOOL 5 | //TOOLMSG DD SYSOUT=* 6 | //DFSMSG DD SYSOUT=* 7 | //INP DD DSN=IN14267.TEST.INPUT,DISP=SHR 8 | //BCKP DD DSN=IN14267.TEST.OUTPUT,DISP=OLD 9 | //TOOLIN DD * 10 | SELECT FROM(INP) TO(BCKP) ON(1,10,CH) FIRSTDUP 11 | /* 12 | // 13 | //*OTHER POSSIBLE COMBINATIONS 14 | //*FIRST - keep only the first record for each value (that is, records with non-duplicate values, and the first record for duplicate values) 15 | //*FIRST(n) - keep only the first n records for each value (that is, records with non-duplicate values, and the first n records for duplicate values) 16 | //*LAST - keep only the last record for each value (that is, records with non-duplicate values, and the last record for duplicate values) 17 | //*FIRSTDUP - only keep the first record for duplicate values 18 | //*FIRSTDUP(n) - only keep the first n records for duplicate values 19 | //*LASTDUP - only keep the last record for duplicate values 20 | //*ALLDUPS - only keep records with duplicate values 21 | //*NODUPS - only keep records with non-duplicate values 22 | //*EQUAL(n) - only keep records with values that occur n times 23 | //*HIGHER(n) - only keep records with values that occur more than n times 24 | //*LOWER(n) - only keep records with values that occur less than n times 25 | -------------------------------------------------------------------------------- /DB2/CatalogQueries/getSpaceDetails.sql: -------------------------------------------------------------------------------- 1 | -- For Non Partition tables 2 | SELECT SUBSTR(B.NAME,1,18) "TABLE" 3 | , A.PARTITION "PARTITION" 4 | , CHAR(DECIMAL((ROUND(DEC(SPACE,8,0)/1048576,2)),4,2)) "SPACE GB" 5 | , SUBSTR(CHAR((DECIMAL((ROUND(DEC(SPACE,8,0)/1048576,2)),4,2))*100/64),7,5) "PERCENTAGE" 6 | , CHAR(A.CARD) "RECORDS" 7 | , A.STATSTIME "STATSTIME" 8 | FROM SYSIBM.SYSTABLEPART A, SYSIBM.SYSTABLES B 9 | WHERE B.CREATOR IN ('') -- update the schema of tables 10 | --AND A.SPACE >= 8388608 11 | AND A.PARTITION = 0 12 | AND A.TSNAME = B.TSNAME 13 | AND A.DBNAME = B.DBNAME 14 | AND B.TYPE <> 'V' 15 | order by PERCENTAGE desc,"SPACE GB" DESC; 16 | 17 | -- For Partitioned tables 18 | SELECT SUBSTR(B.NAME, 1, 18) AS TABLE 19 | , A.PARTITION "PARTITION" 20 | , SUBSTR(A.LIMITKEY, 1, 16) as LIMITKEY 21 | , CHAR(DECIMAL((ROUND(DEC(A.SPACE, 8, 0) / 1048576, 2)), 4, 2)) "SPACE GB" 22 | , (DECIMAL((ROUND(DEC(A.SPACE, 8, 0) / 1048576, 2)), 4, 2)/decimal(C.DSSIZE/1048576)) * 100 "PERCENTAGE" 23 | , C.DSSIZE 24 | , CHAR(A.CARD) "RECORDS" 25 | , A.STATSTIME 26 | FROM SYSIBM.SYSTABLEPART AS A, SYSIBM.SYSTABLES AS B, SYSIBM.SYSTABLESPACE AS C 27 | WHERE B.CREATOR IN ('') -- uPdate schema or owner here 28 | AND A.SPACE >= 2097152 29 | AND A.PARTITION <> 0 30 | AND A.TSNAME = B.TSNAME 31 | AND A.TSNAME = C.NAME 32 | AND A.DBNAME = B.DBNAME 33 | AND A.DBNAME = C.DBNAME 34 | AND B.TYPE <> 'V' 35 | and c.dssize <> 0 36 | order by PERCENTAGE desc,"SPACE GB" DESC ; 37 | -------------------------------------------------------------------------------- /Cobol/SpecialNames.cob: -------------------------------------------------------------------------------- 1 | IDENTIFICATION DIVISION. 2 | PROGRAM-ID. SPECIAL. 3 | ENVIRONMENT DIVISION. 4 | CONFIGURATION SECTION. 5 | SOURCE-COMPUTER. IBM-370. 6 | SPECIAL-NAMES. 7 | CLASS WS-VALID-ALPHA IS 8 | '0' THRU '9' 9 | 'A' THRU 'J' 10 | 'J' THRU 'R' 11 | 'S' THRU 'Z' 12 | '@' '#' '*' 13 | DATA DIVISION. 14 | WORKING-STORAGE SECTION. 15 | 01 WS-INP PIC X(8). 16 | PROCEDURE DIVISION. 17 | MOVE 'ABJKST01' TO WS-INP 18 | PERFORM VALIDATE-CUSIP 19 | MOVE 'CDLMUV23' TO WS-INP 20 | PERFORM VALIDATE-CUSIP 21 | MOVE 'EFNOWX45' TO WS-INP 22 | MOVE 'GHPQYZ67' TO WS-INP 23 | PERFORM VALIDATE-CUSIP 24 | MOVE 'IJRSAB89' TO WS-INP 25 | PERFORM VALIDATE-CUSIP 26 | MOVE 'KLTUCD@#' TO WS-INP 27 | PERFORM VALIDATE-CUSIP 28 | MOVE 'MNVWEF#*' TO WS-INP 29 | PERFORM VALIDATE-CUSIP 30 | MOVE '@#*@#*@#' TO WS-INP 31 | PERFORM VALIDATE-CUSIP 32 | MOVE 'IM SPACE' TO WS-INP 33 | PERFORM VALIDATE-CUSIP 34 | MOVE 'PERCENT%' TO WS-INP 35 | PERFORM VALIDATE-CUSIP 36 | GOBACK. 37 | VALIDATE-CUSIP. 38 | IF WS-INP IS NOT WS-VALID-ALPHA 39 | THEN 40 | DISPLAY 'WS-INP >' WS-INP '< IS NOT VALID.' 41 | ELSE 42 | DISPLAY 'WS-INP >' WS-INP '< IS VALID.' 43 | END-IF. 44 | -------------------------------------------------------------------------------- /REXX/delempo.rexx: -------------------------------------------------------------------------------- 1 | /* REXX PROGRAM TO DELETE ALL EMPTY PDS MEMBERS FROM LIST IN */ 2 | /* FILE 'USERID().LIST.DATASETS */ 3 | /* TO GENERATE ABOVE FILE OPEN FILES IN PATTERN */ 4 | /* AND THEN DO SAVE LIST */ 5 | /* FILE 'USERID().LIST.DATASETS */ 6 | TRACE O 7 | MSETTING = MSG(OFF) 8 | /* ENABLE TRACE I OR TRACE R , MSG(ON) TO DEBUG */ 9 | R = "" 10 | SAY "**************************************************" 11 | SAY "** TOOL INFO ** DELETE ALL PDS IF THEY ARE EMTPY**" 12 | SAY "**************************************************" 13 | SAY " " 14 | DSNP = USERID()".LIST.DATASETS" 15 | 16 | /* REMOVE SPACES FROM ABOVE LIST FILE */ 17 | /* ENABLE BELOW LINES OF CODE INCASE IF YOU WANT TO ACCEPT */ 18 | /* THE FILE BY ENTERING INPUT */ 19 | /* SAY 'ENTER LIST FILES' */ 20 | /* PARSE UPPER DSNP */ 21 | 22 | DSNP = STRIP(DSNP) 23 | ADDRESS TSO "ALLOC DA('"DSNP"') DD(LISFIL) SHR LRECL(140), 24 | RECFM(F B) BLKSIZE(6160) SPACE(10 10) TRACK UNIT(3390), 25 | CATALOG" 26 | /* SAY 'RC DURING ALLOCATION' RC*/ 27 | /* INCASE ALLOCATION OF FILE ALLOCATION FAILED THEN */ 28 | /* FREE THE FILESPACE AND THEN RETRY THE COMMAND */ 29 | IF RC >= 12 THEN 30 | DO 31 | "FREE FI(LISFIL)" 32 | SAY 'SOME PROBLEM DURING ALLOCATION - RETRY PLS' 33 | EXIT 12 34 | END 35 | /* NORMAL PROCESSING */ 36 | ELSE 37 | ADDRESS TSO "EXECIO * DISKR LISFIL (STEM LISFIL. FINIS" 38 | SAY 'RC FOR READ' RC 39 | LEN = RIGHT(LISFIL.0,6) 40 | /* SAY LEN*/ 41 | DO LINE = 1 TO LEN 42 | CURPDS = STRIP(SUBSTR(LISFIL.LINE,1,45)) 43 | SAY CURPDS 44 | DUMMY = OUTTRAP("MEMB.","*") 45 | ADDRESS TSO 46 | "LISTDS '"CURPDS"' MEMBERS" 47 | DUMMY = OUTTRAP("OFF") 48 | SAY MEMB.0 49 | IF MEMB.0 = 6 THEN 50 | DO 51 | ADDRESS TSO "DELETE" "'"CURPDS"'" 52 | END 53 | ELSE DO 54 | SAY 'MEMBERS EXIST IN' CURPDS 55 | END 56 | END 57 | "FREE FI(LISFIL)" 58 | EXIT 59 | 60 | -------------------------------------------------------------------------------- /Cobol/cics/calc.cpybk: -------------------------------------------------------------------------------- 1 | 01 MAPCALI. 2 | 02 FILLER PIC X(12). 3 | 02 NUMONEL COMP PIC S9(4). 4 | 02 NUMONEF PICTURE X. 5 | 02 FILLER REDEFINES NUMONEF. 6 | 03 NUMONEA PICTURE X. 7 | 02 FILLER PICTURE X(1). 8 | 02 NUMONEI PIC 9(5). 9 | 02 NUMTWOL COMP PIC S9(4). 10 | 02 NUMTWOF PICTURE X. 11 | 02 FILLER REDEFINES NUMTWOF. 12 | 03 NUMTWOA PICTURE X. 13 | 02 FILLER PICTURE X(1). 14 | 02 NUMTWOI PIC 9(5). 15 | 02 ADDRESL COMP PIC S9(4). 16 | 02 ADDRESF PICTURE X. 17 | 02 FILLER REDEFINES ADDRESF. 18 | 03 ADDRESA PICTURE X. 19 | 02 FILLER PICTURE X(1). 20 | 02 ADDRESI PIC 9(6). 21 | 02 SUBRESL COMP PIC S9(4). 22 | 02 SUBRESF PICTURE X. 23 | 02 FILLER REDEFINES SUBRESF. 24 | 03 SUBRESA PICTURE X. 25 | 02 FILLER PICTURE X(1). 26 | 02 SUBRESI PIC 9(6). 27 | 02 MULRESL COMP PIC S9(4). 28 | 02 MULRESF PICTURE X. 29 | 02 FILLER REDEFINES MULRESF. 30 | 03 MULRESA PICTURE X. 31 | 02 FILLER PICTURE X(1). 32 | 02 MULRESI PIC 9(10). 33 | 02 DIVRESL COMP PIC S9(4). 34 | 02 DIVRESF PICTURE X. 35 | 02 FILLER REDEFINES DIVRESF. 36 | 03 DIVRESA PICTURE X. 37 | 02 FILLER PICTURE X(1). 38 | 02 DIVRESI PIC 9(5). 39 | 02 MSGIL COMP PIC S9(4). 40 | 02 MSGIF PICTURE X. 41 | 02 FILLER REDEFINES MSGIF. 42 | 03 MSGIA PICTURE X. 43 | 02 FILLER PICTURE X(1). 44 | 02 MSGII PIC X(30). 45 | 02 LEV1L COMP PIC S9(4). 46 | 02 LEV1F PICTURE X. 47 | 02 FILLER REDEFINES LEV1F. 48 | 03 LEV1A PICTURE X. 49 | 02 FILLER PICTURE X(1). 50 | 02 LEV1I PIC X(8). 51 | 01 MAPCALO REDEFINES MAPCALI. 52 | 02 FILLER PIC X(12). 53 | 02 FILLER PICTURE X(3). 54 | 02 NUMONEC PICTURE X. 55 | 02 NUMONEO PIC 9(5). 56 | 02 FILLER PICTURE X(3). 57 | 02 NUMTWOC PICTURE X. 58 | 02 NUMTWOO PIC 9(5). 59 | 02 FILLER PICTURE X(3). 60 | 02 ADDRESC PICTURE X. 61 | 02 ADDRESO PIC 9(6). 62 | 02 FILLER PICTURE X(3). 63 | 02 SUBRESC PICTURE X. 64 | 02 SUBRESO PIC 9(6). 65 | 02 FILLER PICTURE X(3). 66 | 02 MULRESC PICTURE X. 67 | 02 MULRESO PIC 9(10). 68 | 02 FILLER PICTURE X(3). 69 | 02 DIVRESC PICTURE X. 70 | 02 DIVRESO PIC 9(5). 71 | 02 FILLER PICTURE X(3). 72 | 02 MSGIC PICTURE X. 73 | 02 MSGIO PIC X(30). 74 | 02 FILLER PICTURE X(3). 75 | 02 LEV1C PICTURE X. 76 | 02 LEV1O PIC X(8). 77 | 78 | -------------------------------------------------------------------------------- /Cobol/cics/calc.bms: -------------------------------------------------------------------------------- 1 | MAPAB54 DFHMSD TYPE=&SYSPARM,MODE=INOUT,TERM=ALL, X00010001 2 | LANG=COBOL,TIOAPFX=YES,CTRL=(FREEKB), X00020001 3 | DSATTS=COLOR,MAPATTS=COLOR 00030001 4 | MAPCAL DFHMDI SIZE=(24,80),LINE=1,COLUMN=1 00040001 5 | DFHMDF POS=(1,25),LENGTH=16,ATTRB=PROT, X00050001 6 | INITIAL='CICS CALCULATOR ' 00060001 7 | DFHMDF POS=(3,10),LENGTH=20,ATTRB=PROT,COLOR=WHITE, X00070001 8 | INITIAL='NUMBER ONE ' 00080001 9 | NUMONE DFHMDF POS=(3,35),LENGTH=05, X00081001 10 | INITIAL='_____',ATTRB=(UNPROT,IC),COLOR=WHITE 00082001 11 | DFHMDF POS=(5,10),LENGTH=20,ATTRB=PROT,COLOR=WHITE, X00083001 12 | INITIAL='NUMBER TWO ' 00084001 13 | NUMTWO DFHMDF POS=(5,35),LENGTH=05, X00085001 14 | INITIAL='_____',ATTRB=(UNPROT,IC),COLOR=WHITE 00086001 15 | DFHMDF POS=(8,10),LENGTH=05,ATTRB=PROT,COLOR=WHITE, X00087001 16 | INITIAL='ADD :' 00088001 17 | ADDRES DFHMDF POS=(8,17),LENGTH=06, X00089001 18 | INITIAL='______',ATTRB=(UNPROT,IC),COLOR=WHITE 00090001 19 | DFHMDF POS=(8,30),LENGTH=05,ATTRB=PROT,COLOR=WHITE, X00100001 20 | INITIAL='SUB :' 00110001 21 | SUBRES DFHMDF POS=(8,36),LENGTH=06, X00120001 22 | INITIAL='______',ATTRB=(UNPROT,IC),COLOR=WHITE 00130001 23 | DFHMDF POS=(10,10),LENGTH=05,ATTRB=PROT,COLOR=WHITE, X00140001 24 | INITIAL='MUL :' 00150001 25 | MULRES DFHMDF POS=(10,17),LENGTH=10, X00160001 26 | INITIAL='__________',ATTRB=(UNPROT,IC),COLOR=WHITE 00170001 27 | DFHMDF POS=(10,30),LENGTH=05,ATTRB=PROT,COLOR=WHITE, X00180001 28 | INITIAL='DIV :' 00190001 29 | DIVRES DFHMDF POS=(10,36),LENGTH=05, X00200001 30 | INITIAL='_____',ATTRB=(UNPROT,IC),COLOR=WHITE 00210001 31 | DFHMDF POS=(20,10),LENGTH=8,INITIAL='MESSAGE:', X00230001 32 | ATTRB=ASKIP,COLOR=NEUTRAL 00240001 33 | MSGI DFHMDF POS=(20,20),LENGTH=30,ATTRB=(PROT,NUM), X00250001 34 | COLOR=RED,INITIAL='_____________________' 00260001 35 | LEV1 DFHMDF POS=(24,1),LENGTH=8,ATTRB=PROT,INITIAL='F3=EXIT' 00270001 36 | DFHMDF POS=(24,55),LENGTH=18,ATTRB=PROT, X00280001 37 | INITIAL='ENTER= PROCEED' 00290001 38 | DFHMSD TYPE=FINAL 00300001 39 | END 00310001 40 | 41 | -------------------------------------------------------------------------------- /Cobol/db2oper/db2curs.cbl: -------------------------------------------------------------------------------- 1 | *PROGRAM TO TEST DB2 CURSORS 00010000 2 | *USED CENSUS DATA AS SAMPLE 00020000 3 | *JUST SELECTS THE DATA 00030000 4 | *AND DISPLAYS IN SPOOL 00040000 5 | IDENTIFICATION DIVISION. 00060000 6 | PROGRAM-ID. DB2CURS. 00070000 7 | ENVIRONMENT DIVISION. 00080000 8 | DATA DIVISION. 00090000 9 | WORKING-STORAGE SECTION. 00100000 10 | EXEC SQL 00110000 11 | INCLUDE SQLCA 00120000 12 | END-EXEC. 00130000 13 | EXEC SQL 00131000 14 | DECLARE CURS_CE CURSOR FOR 00132000 15 | SELECT STATE_UT,POPULATION 00133000 16 | FROM CENSUS 00135000 17 | END-EXEC. 00136000 18 | 01 NIND PIC S9(4) COMP. 00140000 19 | 01 DCLCENSUS. 00180000 20 | 10 STATE-UT PIC X(30). 00190000 21 | 10 POPULATION PIC S9(9) USAGE COMP. 00200000 22 | 10 GROWTH-PER PIC S9(9) USAGE COMP. 00210000 23 | 10 RURAL-POP PIC S9(9) USAGE COMP. 00220000 24 | 10 URBAN-POP PIC S9(9) USAGE COMP. 00230000 25 | 10 YEAR-OF-SUR PIC S9(9) USAGE COMP. 00240000 26 | 10 RATIO PIC S9(9) USAGE COMP. 00250000 27 | PROCEDURE DIVISION. 00260000 28 | MAIN-PARA. 00270000 29 | * SELECT ALL RECORDS USING CURSOR AND DISPLAY REPORT IN SPOOL 00280000 30 | EXEC SQL 00290000 31 | OPEN CURS_CE 00300000 32 | END-EXEC. 00301000 33 | PERFORM 000-FETCH-PARA UNTIL SQLCODE = 100. 00302000 34 | * FETCH THE RECORDS 00302100 35 | 000-FETCH-PARA. 00303000 36 | EXEC SQL 00304000 37 | FETCH CURS_CE INTO :STATE-UT,:POPULATION 00305100 38 | END-EXEC. 00308000 39 | DISPLAY 'STATE ', STATE-UT , ' HAS ', POPULATION. 00309003 40 | 001-CLOSE-PARA. 00310000 41 | EXEC SQL 00320000 42 | CLOSE CURS_CE 00330000 43 | END-EXEC. 00340000 44 | STOP RUN. 00910000 45 | 46 | -------------------------------------------------------------------------------- /Cobol/fileop/READPS.cob: -------------------------------------------------------------------------------- 1 | *SAMPLE PROGRAM TO READ FILE AND DISPLAY IN SPOOL 00010004 2 | IDENTIFICATION DIVISION. 00020000 3 | PROGRAM-ID. READPS. 00030005 4 | *ENVIRONMENTAL STARTS HERE 00040004 5 | ENVIRONMENT DIVISION. 00050000 6 | INPUT-OUTPUT SECTION. 00060000 7 | FILE-CONTROL. 00070000 8 | SELECT SAMPLE ASSIGN TO FILEDD1 00080006 9 | ORGANIZATION IS SEQUENTIAL 00090023 10 | FILE STATUS WS-IN1. 00100014 11 | *DATA DIVISION STARTS HERE 00110004 12 | DATA DIVISION. 00120000 13 | FILE SECTION. 00130000 14 | *FILE DEFINITION 00140004 15 | FD SAMPLE. 00150004 16 | 01 SAMPLE-FILE. 00160009 17 | 05 SAMPLE-DATA1 PIC A(20). 00170010 18 | 05 SAMPLE-DATA2 PIC A(30). 00180010 19 | 05 FILLER PIC X(30). 00181024 20 | WORKING-STORAGE SECTION. 00190000 21 | *WORKING STORAGE VARIABLE FOR FILES 00200004 22 | 77 WS-IN1 PIC X(2). 00201016 23 | 01 WS-FILE. 00210009 24 | 05 WS-DATA1 PIC A(20). 00220010 25 | 05 WS-DATA2 PIC A(30). 00230010 26 | 05 FILLER PIC X(30). 00231024 27 | 01 WS-EOF PIC X(01) VALUE 'N'. 00240013 28 | 88 WS-EOF-N VALUE 'N'. 00250013 29 | 88 WS-EOF-Y VALUE 'Y'. 00260017 30 | *ACTUAL PROCESS STARTS HERE. 00270004 31 | PROCEDURE DIVISION. 00280000 32 | DISPLAY 'PROGRAM STARTED' 00281021 33 | PERFORM 000-OPEN-PARA. 00290012 34 | PERFORM 001-READ-PARA UNTIL WS-EOF-Y. 00300012 35 | PERFORM 003-CLOSE-PARA. 00320012 36 | STOP RUN. 00330012 37 | 000-OPEN-PARA. 00340012 38 | DISPLAY 'IN OPEN PARA' 00341022 39 | OPEN INPUT SAMPLE. 00350012 40 | DISPLAY WS-IN1 'FILE STATUS'. 00360022 41 | IF WS-IN1 NOT = '00' 00370012 42 | SET WS-EOF-Y TO TRUE 00380012 43 | END-IF. 00390012 44 | 001-READ-PARA. 00400012 45 | DISPLAY 'IN READ PARA' 00401025 46 | READ SAMPLE 00410019 47 | AT END 00420020 48 | MOVE 'Y' TO WS-EOF 00430020 49 | NOT AT END 00440020 50 | MOVE SAMPLE-FILE TO WS-FILE. 00441026 51 | PERFORM 002-ACTION-PARA. 00450020 52 | 002-ACTION-PARA. 00470012 53 | DISPLAY 'IN ACTION PARA' 00471025 54 | DISPLAY WS-FILE. 00480018 55 | 003-CLOSE-PARA. 00490012 56 | CLOSE SAMPLE. 00500018 57 | -------------------------------------------------------------------------------- /JCL/utils/timestamp.jcl: -------------------------------------------------------------------------------- 1 | //* CREATES MODULE TIMESTAMP LIST FROM AMBLIST OUTPUT *// 2 | //* Modified: 26-12-2016 By : Phani *// 3 | //* *// 4 | //*-------------------------------------------------------------------* 5 | //* RUN AMBLIST 6 | //*-------------------------------------------------------------------* 7 | //LIST1 EXEC PGM=AMBLIST 8 | //SYSPRINT DD DSN=&&AMBLIST,DISP=(,PASS),UNIT=SYSDA, 9 | // SPACE=(CYL,(4,4),RLSE),DCB=(RECFM=FBA,LRECL=121) 10 | //SYSLIB DD DSN=,DISP=SHR <-SPECIFY LOAD MODULE LIB 11 | //SYSIN DD * 12 | LISTIDR 13 | /* 14 | //*-------------------------------------------------------------------* 15 | //* SELECT MODULE NAME AND TIMESTAMP 16 | //*-------------------------------------------------------------------* 17 | //SELECT EXEC PGM=SORT 18 | //SYSOUT DD SYSOUT=* 19 | //SORTIN DD DSN=&&AMBLIST,DISP=(OLD,DELETE) 20 | //MODNAM DD DSN=&&MODNAM,DISP=(,PASS),UNIT=SYSDA, 21 | // SPACE=(CYL,(1,1),RLSE),DCB=(RECFM=FB,LRECL=80) 22 | //MODTIM DD DSN=&&MODTIM,DISP=(,PASS),UNIT=SYSDA, 23 | // SPACE=(CYL,(1,1),RLSE),DCB=(RECFM=FB,LRECL=80) 24 | //SYSIN DD * 25 | OPTION COPY 26 | OUTFIL FNAMES=MODNAM, 27 | INCLUDE=(6,12,CH,EQ,C'MEMBER NAME:'), 28 | OUTREC=(20,8,64X,SEQNUM,8,ZD) 29 | OUTFIL FNAMES=MODTIM, 30 | INCLUDE=(11,31,CH,EQ,C'THIS LOAD MODULE WAS PRODUCED BY'), 31 | OUTREC=(104,4,C'/',92,3,1X,112,8,55X,SEQNUM,8,ZD) 32 | /* 33 | //*-------------------------------------------------------------------* 34 | //* JOINING MODULE NAMES AND TIMESTAMPS 35 | //*-------------------------------------------------------------------* 36 | //JOIN EXEC PGM=ICETOOL 37 | //TOOLMSG DD SYSOUT=* 38 | //DFSMSG DD SYSOUT=* 39 | //TOOLIN DD * 40 | * REFORMAT MODNAM TO T1 SO IT CAN BE SPLICED 41 | COPY FROM(MODNAM) TO(T1) USING(CTL1) 42 | * REFORMAT MODTIM TO T1 SO IT CAN BE SPLICED 43 | COPY FROM(MODTIM) TO(T1) USING(CTL2) 44 | * SPLICE RECORDS IN T1 WITH MATCHING ON FIELDS 45 | SPLICE FROM(T1) - 46 | ON(73,8,CH) - SEQNUM 47 | WITH(11,8) - BUILD DATE 48 | WITH(21,8) - BUILD TIMESTAMP 49 | TO(OUT) 50 | /* 51 | //MODNAM DD DSN=&&MODNAM,DISP=(OLD,DELETE) 52 | //MODTIM DD DSN=&&MODTIM,DISP=(OLD,DELETE) 53 | //T1 DD DSN=&&T1,UNIT=SYSDA,SPACE=(CYL,(1,1)),DISP=(MOD,PASS) 54 | //OUT DD DSN=&SYSUID..DS.LIST,DISP=(,CATLG),UNIT=SYSDA, 55 | // SPACE=(CYL,(4,4),RLSE) 56 | //CTL1CNTL DD * 57 | * MOVE MODNAM FIELDS TO THEIR LOCATIONS FOR THE OUTPUT DATA SET 58 | OUTREC FIELDS=(1:1,8, MODULE NAME 59 | 73:73,8) SEQUENCE NUMBER 60 | /* 61 | //CTL2CNTL DD * 62 | * MOVE MODTIM FIELDS TO THEIR LOCATIONS FOR THE OUTPUT DATA SET 63 | OUTREC FIELDS=(11:1,8, BUILD DATE 64 | 21:10,8, BUILD TIMESTAMP 65 | 73:73,8) SEQUENCE NUMBER 66 | /* -------------------------------------------------------------------------------- /PL1/basics/datatyp.pli: -------------------------------------------------------------------------------- 1 | DATATYP:PROC OPTIONS(MAIN); 2 | /* PL/1 PROGRAM TO DEFINE ALL KNOWN DATATYPES */ 3 | /* DECLARE ALL PL/1 DATA TYPES */ 4 | /* NUMERIC DATA */ 5 | DCL NUM_FB FIXED BINARY INIT(122.22); /* 122 */ 6 | DCL NUM_FLB FLOAT BINARY INIT(122.22); /* 1.222200E+02 */ 7 | DCL NUM_FB_V FIXED BINARY(10,2) INIT(122.22); /* 122.0 */ 8 | DCL NUM_FD FIXED DECIMAL INIT(122.22); /* 122 */ 9 | DCL NUM_FLD FLOAT DECIMAL INIT(122.22); /* 1.22220E+02 */ 10 | DCL NUM_FD_V FIXED DECIMAL(10,2) INIT(122.22); /* 122.22 */ 11 | /* NUMERIC DATA(WITH PIC CLASS) */ 12 | DCL NUM_P9 PIC '99' INIT(23.4); /* 23 */ 13 | DCL NUM_P9_9 PIC '99.9' INIT(23.4); /*02.3*/ 14 | DCL NUM_P9V9 PIC '99V9' INIT(23.4); /* 233 */ 15 | DCL NUM_P9V_9 PIC '99V.9' INIT(23.4); /* 23.3 */ 16 | DCL NUM_PZV_9 PIC 'Z9V.9' INIT(23.4); /* 23.3 */ 17 | DCL NUM_$ZV_9 PIC '$Z9V.9' INIT(23.4); /* $23.3*/ 18 | /* CHARECTER DATA */ 19 | DCL CHAR_01 CHAR(10) INIT('ABC'); 20 | DCL CHAR_02 CHAR(10) VARYING INIT('ABCD'); 21 | DCL CHAR_TB(4) CHAR(2) VARYING INIT((4)'CD'); 22 | /* BIT data */ 23 | DCL BIT8 BIT(8) , CHAR1 CHAR(1); 24 | DCL(ST1,ST2) BIT(10); 25 | DCL A BIT(3), B BIT(5), C BIT(8); 26 | CHAR1 = 'A' 27 | /* BIT8 = CHAR1; This gives error */ 28 | 29 | /* OTHER DECLARES */ 30 | DCL STG BUILTIN; /* STORAGE BUILTIN */ 31 | PUT SKIP LIST('NUMERIC DATA TYPES PL/1 (122.22),STORAGE') 32 | PUT SKIP LIST('--------------------------------'); 33 | PUT SKIP LIST('NUM_FB :',NUM_FB ,STG(NUM_FB )); 34 | PUT SKIP LIST('NUM_FLB :',NUM_FLB ,STG(NUM_FLB )); 35 | PUT SKIP LIST('NUM_FB_V:',NUM_FB_V,STG(NUM_FB_V)); 36 | PUT SKIP LIST('NUM_FD :',NUM_FD ,STG(NUM_FD )); 37 | PUT SKIP LIST('NUM_FLD :',NUM_FLD ,STG(NUM_FLD )); 38 | PUT SKIP LIST('NUM_FD_V:',NUM_FD_V,STG(NUM_FD_V)); 39 | /* PIC CLASS VARIABLES */ 40 | PUT SKIP LIST('PIC CLASS REPRESENTATION '); 41 | PUT SKIP LIST('--------------------------------') 42 | PUT SKIP LIST('NUM_P9 ',NUM_P9 ,STG(NUM_P9 )); /* 23,2 */ 43 | PUT SKIP LIST('NUM_P9_9 ',NUM_P9_9 ,STG(NUM_P9_9 )); /*02.3,4*/ 44 | PUT SKIP LIST('NUM_P9V9 ',NUM_P9V9 ,STG(NUM_P9V9 )); /* 233,3 */ 45 | PUT SKIP LIST('NUM_P9V_9',NUM_P9V_9,STG(NUM_P9V_9)); /* 23.3,4 */ 46 | PUT SKIP LIST('NUM_PZV_9',NUM_PZV_9,STG(NUM_PZV_9)); /* 23.3,4 */ 47 | PUT SKIP LIST('NUM_$ZV_9',NUM_$ZV_9,STG(NUM_$ZV_9)); /* $23.3,5*/ 48 | /* ARTHEMETIC OPERATIONS */ 49 | PUT SKIP LIST('ARTHEMETIC ON NUMERIC DATA'); 50 | PUT SKIP LIST('--------------------------------') 51 | PUT SKIP LIST('NUM_FB + NUM_FLB',NUM_FB + NUM_FLB); /*2.442200E+02*/ 52 | PUT SKIP LIST('NUM_P9V9+ NUM_P9', NUM_P9V9+ NUM_P9); /* 23.4 + 23 */ 53 | /* CHARECTER DATA */ 54 | PUT SKIP LIST('CHARECTER DATA EXPLORATION'); 55 | PUT SKIP LIST('--------------------------------'); 56 | PUT SKIP LIST('CHAR_01 :',CHAR_01,STG(CHAR_01)); 57 | PUT SKIP LIST('CHAR_02 :',CHAR_02,STG(CHAR_02)); 58 | CHAR_TB(2) = 'XY'; /* MODIFY 2ND ELEM OF TABLE */ 59 | PUT SKIP LIST('CHAR_TB(2):',CHAR_TB(2),STG(CHAR_TB(2))); 60 | CHAR_01 = STRING(CHAR_TB); 61 | PUT SKIP LIST('STRING(CHAR_TB) :',STRING(CHAR_TB), 62 | STG(CHAR_01)); 63 | PUT SKIP LIST('--------------------------------'); 64 | PUT SKIP LIST('BIT OPERATIONS'); 65 | ST1 = '110011'B; /* 51 */ 66 | ST2='1100110000'B; /* 816*/ 67 | SELECT; 68 | WHEN(ST1ST2) PUT LIST('C'); 71 | END; /* END SELECT */ 72 | A= '011'B; 73 | B='10101'B; 74 | C= BOOL(A,B,'1000'B); /* PERFORMS BOOLIAN OP ON TWO BIT STRINGS */ 75 | /* OPERATION IS AS BELOW */ 76 | /* A = '01100'B /* BITS OF A ARE SHORTER SO EXTENDED TO RIGHT */ 77 | /* B = '10101'B */ 78 | /* C = '0010000'B /* 00 - 1ST , 01 - 2ND, 10 -3RD, 11 - 4TH */ 79 | /* TWO EXTRA BITS '00'B WILL BE PADDED TO RIGHT BASED ON LEN OF C */ 80 | PUT SKIP LIST(C); /* '00010000'B */ 81 | END DATATYP; -------------------------------------------------------------------------------- /Cobol/cics/calc.cbl: -------------------------------------------------------------------------------- 1 | 000100 IDENTIFICATION DIVISION. 00010000 2 | 000200 PROGRAM-ID. PROGAB54. 00020002 3 | 000300 DATA DIVISION. 00030000 4 | 000400 FILE SECTION. 00040000 5 | 000500 WORKING-STORAGE SECTION. 00050000 6 | 000501 COPY DFHAID. 00050107 7 | 000502 COPY DFHBMSCA. 00050207 8 | 000510 COPY MAPAB54. 00051003 9 | 000520 01 WS-STRING PIC A(75). 00052003 10 | 000530 01 WS-N1 PIC 99999. 00053003 11 | 000540 01 WS-N2 PIC 99999. 00054003 12 | 000550 01 WS-AD PIC 999999. 00055003 13 | 000560 01 WS-SU PIC S9(6). 00056003 14 | 000570 01 WS-MU PIC 9(10). 00057003 15 | 000580 01 WS-DI PIC 9(10). 00058003 16 | 000600 01 WS-MESSAGE PIC X(40). 00060000 17 | 000700 01 WS-LENGTH PIC S9(4) COMP. 00070000 18 | 000800 PROCEDURE DIVISION. 00080000 19 | 000900 A000-MAIN-PARA. 00090000 20 | IF EIBAID = DFHPF12 THEN 00091010 21 | EXEC CICS 00092010 22 | RETURN 00093010 23 | END-EXEC. 00094010 24 | IF EIBCALEN = 0 00095010 25 | 001000 MOVE LOW-VALUES TO MAPCALO. 00100006 26 | 001010 PERFORM SEND-MAP-PARA. 00101006 27 | 001020 PERFORM RECV-MAP-PARA. 00102006 28 | 001030 PERFORM COMPUTE-PARA. 00103006 29 | 001040 PERFORM SEND-MAP-PARA. 00104006 30 | 001050 PERFORM CLOSE-PARA. 00105006 31 | 001060 SEND-MAP-PARA. 00106003 32 | EXEC CICS SEND MAP('MAPCAL') 00106112 33 | MAPSET('MAPAB54') 00106212 34 | ERASE 00106312 35 | FREEKB 00106412 36 | END-EXEC. 00106513 37 | 001070* EXEC CICS 00107012 38 | 001080* SEND MAP('MAPCAL') MAPSET('MAPAB54') FROM MAPCALO 00108012 39 | 001090* END-EXEC. 00109012 40 | 001100 RECV-MAP-PARA. 00110003 41 | 001200 EXEC CICS 00120003 42 | 001300 RECEIVE MAP('MAPCAL') MAPSET('MAPAB54') INTO (MAPCALI) 00130005 43 | 001400 END-EXEC. 00140003 44 | 001500 COMPUTE-PARA. 00150003 45 | 001600 MOVE NUMONEI TO WS-N1. 00160003 46 | 001700 MOVE NUMTWOI TO WS-N2. 00170003 47 | 001710* ADDITION 00171003 48 | 001800 ADD NUMONEI TO NUMTWOI GIVING WS-AD. 00180003 49 | 001900* SUBTRACTION 00190003 50 | 002000 SUBTRACT NUMTWOI FROM NUMONEI GIVING WS-SU. 00200003 51 | 002100* MULTIPLY 00210003 52 | 002200 MULTIPLY NUMONEI BY NUMTWOI GIVING WS-MU. 00220003 53 | 002300* DIVISION 00230003 54 | 002400 DIVIDE NUMONEI INTO NUMTWOI GIVING WS-DI. 00240003 55 | 002500 MOVE WS-AD TO ADDRESO. 00250004 56 | 002600 MOVE WS-SU TO SUBRESO. 00260004 57 | 002700 MOVE WS-MU TO MULRESO. 00270004 58 | 002800 MOVE WS-DI TO DIVRESO. 00280004 59 | 002900 CLOSE-PARA. 00290003 60 | 003000 EXEC CICS 00300003 61 | 003100 RETURN 00310003 62 | 003200 END-EXEC. 00320003 63 | 64 | -------------------------------------------------------------------------------- /Cobol/basics/var.cbl: -------------------------------------------------------------------------------- 1 | IDENTIFICATION DIVISION. 2 | PROGRAM-ID. VAR-COB1. 3 | DATA DIVISION. 4 | WORKING-STORAGE SECTION. 5 | 01 WS-BASIC-VAR. 6 | 05 WS-INT PIC 9(3) VALUE 01. 7 | 05 WS-CHAR PIC A(2) VALUE 'AB'. 8 | 05 WS-ALPH PIC X(2) VALUE 'z1'. 9 | 05 WS-DEC PIC 9V99 VALUE 2.14. 10 | 05 WS-SIGN PIC S9(2) VALUE -24. 11 | 05 WS-ADEC PIC PPP999. 12 | 05 WS-DATE PIC X(6). 13 | 01 WS-ADDRESS. 14 | 05 WS-NAME PIC X(20). 15 | 05 WS-PIN PIC 9(5). 16 | 01 WS-ADDRESS-NEW REDEFINES WS-ADDRESS PIC X(20). 17 | 01 WS-NUM1 PIC 9(2) USAGE IS COMP VALUE 24. 18 | 01 WS-NUM2 USAGE IS COMP-1 VALUE 24. 19 | 01 WS-NUM3 USAGE IS COMP-2 VALUE 24. 20 | 01 WS-NUM4 PIC 9(2) USAGE IS COMP-3 VALUE 24. 21 | 01 WS-TABLE. 22 | 05 WS-A OCCURS 3 TIMES INDEXED BY I. 23 | 10 WS-B PIC A(2). 24 | 10 WS-C OCCURS 2 TIMES INDEXED BY J. 25 | 15 WS-D PIC X(3). 26 | COPY abc. 27 | 01 WS-MARK. 28 | 88 PASS VALUES ARE 041 THRU 100. 29 | 88 FAIL VALUES ARE 000 THRU 40. 30 | PROCEDURE DIVISION. 31 | PERFORM A-PARA. 32 | A-PARA. 33 | DISPLAY '* DIFFERENT VARIABLE TYPES IN COBOL *'. 34 | DISPLAY 'INTEGER: ',WS-INT. 35 | DISPLAY 'CHAR: ', WS-CHAR. 36 | DISPLAY 'ALPHA :', WS-ALPH. 37 | DISPLAY 'DECIMAL :', WS-DEC. 38 | DISPLAY 'SIGNED : ', WS-SIGN. 39 | MOVE WS-INT TO WS-ADEC. 40 | DISPLAY 'ASSUMED DECIMAL: ', WS-ADEC. 41 | ACCEPT WS-DATE FROM DATE. 42 | DISPLAY 'DATE: ', WS-DATE. 43 | DISPLAY '* INITIALIZATION *' 44 | DISPLAY 'BEFORE INIT: ', WS-ADDRESS. 45 | INITIALIZE WS-NAME REPLACING NUMERIC DATA BY 00 ALPHANUMERIC DATA BY 'UNKNOWN'. 46 | DISPLAY 'AFTER-INIT :', WS-ADDRESS. 47 | PERFORM B-PARA THROUGH F-PARA. 48 | 49 | B-PARA. 50 | DISPLAY '* COMPUTE *' 51 | COMPUTE WS-PIN = WS-INT * 2 . 52 | DISPLAY WS-PIN. 53 | 54 | C-PARA. 55 | DISPLAY '* REDEFINES *' 56 | DISPLAY 'STORAGE USED FOR NEW:', WS-ADDRESS-NEW. 57 | MOVE '00' TO WS-ADDRESS-NEW. 58 | DISPLAY 'AFTER CHANGING ORIGINAL:', WS-ADDRESS. 59 | DISPLAY 'AFTER CHANGING REDEFINED:', WS-ADDRESS-NEW. 60 | 61 | D-PARA. 62 | DISPLAY '* COMP *' 63 | DISPLAY 'COMP,COMP-1,COMP-2,COMP-3', WS-NUM1,WS-NUM2,WS-NUM3,WS-NUM4. 64 | 65 | E-PARA. 66 | DISPLAY '* COPY BOOKS *' 67 | DISPLAY WS-COPY. 68 | 69 | F-PARA. 70 | DISPLAY '* IF *' 71 | IF WS-INT IS POSITIVE THEN 72 | DISPLAY 'IT IS POSITIVE' 73 | ELSE 74 | IF WS-INT IS LESS THAN OR EQUAL TO 0 THEN 75 | DISPLAY 'IT IS NEGATIVE' 76 | ELSE 77 | DISPLAY 'IT IS ZERO' 78 | END-IF. 79 | DISPLAY 'CONDITIONAL LEVEL 88/EVALUATE'. 80 | MOVE 085 TO WS-MARK. 81 | DISPLAY WS-MARK. 82 | IF PASS 83 | DISPLAY 'PASSED'. 84 | IF FAIL 85 | DISPLAY 'FAILED'. 86 | PERFORM G-PARA THROUGH Z-PARA. 87 | 88 | G-PARA. 89 | DISPLAY 'STRING OPERATIONS'. 90 | MOVE 'PHANIKIRAN' TO WS-NAME. 91 | MOVE 00 TO WS-INT. 92 | DISPLAY ' COUNT NO OF CHARECTERS'. 93 | INSPECT WS-NAME TALLYING WS-INT FOR ALL CHARACTERS. 94 | DISPLAY 'NO OF CHAR: ', WS-INT. 95 | MOVE 00 TO WS-INT. 96 | INSPECT WS-NAME TALLYING WS-INT FOR ALL 'AN' 97 | DISPLAY 'NO OF AN: ', WS-INT. 98 | DISPLAY 'REPLACE SPECIFIC CHARS' 99 | INSPECT WS-NAME REPLACING ALL 'AN' BY 'an'. 100 | DISPLAY WS-NAME. 101 | DISPLAY '*STRING*'. 102 | MOVE 0 TO WS-INT . 103 | STRING WS-NAME DELIMITED BY SPACE 104 | WS-NAME DELIMITED BY SIZE 105 | INTO WS-NAME 106 | WITH POINTER WS-INT 107 | ON OVERFLOW DISPLAY 'OVERFLOW' 108 | NOT ON OVERFLOW DISPLAY 'NOT OVERFLOW' 109 | END-STRING. 110 | DISPLAY WS-NAME,WS-INT. 111 | DISPLAY '* UNSTRING *' 112 | MOVE 0 TO WS-INT. 113 | UNSTRING WS-NAME DELIMITED BY 'a' 114 | INTO WS-FIRSTNAME,WS-NAME 115 | WITH POINTER WS-INT 116 | ON OVERFLOW DISPLAY 'OVERFLOW' 117 | NOT ON OVERFLOW DISPLAY 'NOT OVERFLOW' 118 | END-UNSTRING. 119 | DISPLAY WS-FIRSTNAME, ' ', WS-NAME. 120 | DISPLAY WS-INT. 121 | 122 | H-PARA. 123 | DISPLAY '* TABLE/ARRAYS *'. 124 | MOVE '12ABCDEF34GHIJKL56MNOPQR' TO WS-TABLE. 125 | DISPLAY WS-TABLE. 126 | DISPLAY 'WS-TABLE : ' WS-TABLE. 127 | DISPLAY 'WS-A(1) : ' WS-A(1). 128 | DISPLAY 'WS-B(1) : ' WS-B(1). 129 | DISPLAY 'WS-C(1,1) : ' WS-C(1,1). 130 | DISPLAY 'WS-C(1,2) : ' WS-C(1,2). 131 | DISPLAY 'WS-A(2) : ' WS-A(2). 132 | DISPLAY 'WS-B(2) : ' WS-B(2). 133 | DISPLAY 'WS-C(2,1) : ' WS-C(2,1). 134 | DISPLAY 'WS-C(2,2) : ' WS-C(2,2). 135 | DISPLAY 'WS-A(3) : ' WS-A(3). 136 | DISPLAY 'WS-C(3,1) : ' WS-C(3,1). 137 | DISPLAY 'WS-C(3,2) : ' WS-C(3,2). 138 | DISPLAY ' * ACCESS BY INDEX * ' 139 | SET I J TO 1. 140 | DISPLAY WS-C(I,J). 141 | SET I J UP BY 1. 142 | DISPLAY WS-C(I,J). 143 | DISPLAY '* SEARCH/SEACHALL *' 144 | SEARCH WS-A 145 | AT END DISPLAY 'NOT FOUND' 146 | WHEN WS-A(I) = 'A' 147 | DISPLAY 'LETTER FOUND' 148 | END-SEARCH. 149 | Z-PARA. 150 | STOP RUN. 151 | 152 | 153 | -------------------------------------------------------------------------------- /PL1/builtin/string.pli: -------------------------------------------------------------------------------- 1 | STRINGP:PROC OPTIONS(MAIN); 2 | /* DECLARATIONS */ 3 | DCL NAME01 CHAR(10) VARYING INIT('PHANI'); 4 | DCL NAME02 CHAR(10) VARYING INIT('PHANI'); 5 | DCL NUM01 FIXED DEC(2,0) INIT(10); 6 | DCL BIT2(2) BIT(2) INIT((2)'01'B) ; 7 | /* FUNCTION BIT */ 8 | PUT SKIP LIST('BIT :',BIT(NUM01)); 9 | /* CONVERTS DATA TO BIT (ONLY NUM) */ 10 | /* FUNCTION BOOL */ 11 | PUT SKIP LIST('BOOL',BOOL(BIT2(1),BIT2(2),'1000'B)); /* RETURN '10'B */ 12 | /* PERFORMS BOOLIAN OP IN TWO BIT STRINGS*/ 13 | /* CENTERLEFT */ 14 | PUT SKIP LIST('CENTERLEFT',CENTERLEFT(NAME01,40,'+')); 15 | /* RETURNS STRING WITH VALUE CENTERED LFT */ 16 | /* +++++++++++++++++PHANI++++++++++++++++++ */ 17 | /* CHARACTER */ 18 | NAME02 = CHAR(NUM01); 19 | PUT SKIP LIST('CHARACTER',CHARACTER(NUM01),STG(NUM01), 20 | STG(NAME02)); 21 | /* CONVERTS DATA TO CHARECTER */ 22 | /* COPY */ 23 | PUT SKIP LIST('COPY',COPY(NAME01,2)); 24 | /* COPIES STRING TO SPECIFIED TIMES */ 25 | /* HIGH */ 26 | PUT SKIP LIST('HIGH',HIGH(3)); 27 | /* RETURNS HEX HIGH VALUES OF SPEC LEN */ 28 | /* INDEX */ 29 | PUT SKIP LIST('INDEX PH',INDEX(NAME01,'PH')); 30 | PUT SKIP LIST('INDEX 01',INDEX(NAME01,'01')); 31 | /* RETURNS THE POS OF STRING IN MAIN STR */ 32 | /* IF NOT FOUND OR NULL STRING RETURNS 0 */ 33 | /* LEFT */ 34 | PUT SKIP LIST('LEFT :',LEFT(NAME01,20)); 35 | /* ALLIGNS THE STRING TO LEFT OF SPEC CHARS */ 36 | /* LENGTH */ 37 | PUT SKIP LIST('LENGTH:',LENGTH(NAME01)); 38 | /* RETURNS LENGTH OF STRING */ 39 | /* LOW */ 40 | PUT SKIP LIST('LOW:',LOW(2)); 41 | /* RETURNS LOW CHARECTERS LEN */ 42 | /* LOWERCASE */ 43 | PUT SKIP LIST('LOWERCASE',LOWERCASE(NAME01)); 44 | /* RETURNS LOWERCASE OF SPEC STRING */ 45 | /* MAXLENGTH */ 46 | PUT SKIP LIST('MAXLENGTH',MAXLENGTH(NAME01)); 47 | /* RETURNS MAXLENGHT OF A STRING */ 48 | /* REPEAT */ 49 | PUT SKIP LIST('REPEAT',REPEAT(NAME01,02)); 50 | /* REPEATS STRING N TIMES */ 51 | /* REVERSE */ 52 | PUT SKIP LIST('REVERSE',REVERSE(NAME01)); 53 | /* RETURNS THE REVERS OF A STRING */ 54 | /* SEARCH */ 55 | NAME01 = 'PHANIKIRAN' 56 | PUT SKIP LIST('SEARCH',SEARCH(NAME01,'A')); 57 | PUT SKIP LIST('SEARCH POS',SEARCH(NAME01,'A',5)); 58 | PUT SKIP LIST('SEARCHR',SEARCHR(NAME01,'A')); 59 | /* RETURNS POSITION OF SEARCH STRING */ 60 | /* SUBSTR */ 61 | PUT SKIP LIST('SUBSTR',SUBSTR(NAME01,2,3)); 62 | PUT SKIP LIST('SUBSTR',SUBSTR(NAME01,2)); 63 | /* RETURNS SUBSTRING FROM A STRING */ 64 | /* TALLY */ 65 | PUT SKIP LIST('TALLY',"'A' APPEARS :" ||TRIM(TALLY(NAME01,'A'))); 66 | PUT SKIP LIST('TALLY',"'AN' APPEARS :" ||TRIM(TALLY(NAME01,'AN'))); 67 | /* RETURNS THE #OF OCCURANCES OF STRING IN A STRING */ 68 | /* TRANSLATE */ 69 | NAME01 = 'ABCD' 70 | NAME02 = '3456' 71 | PUT SKIP LIST('TRANSLATE',TRANSLATE('STB3DCABYZQ',NAME02,NAME01)); 72 | /* TRANSLATES INPUT STRING WITH REPLACING CHARECTERS FROM 73 | NAME02 FOR ALL CHARECTERS THAT APPEAR IN NAME01 */ 74 | /* TRIM */ 75 | NAME01 = ' PHANIKIRAN ' /* PADDED SPACES */ 76 | PUT SKIP LIST('TRIM',TRIM(NAME01)); 77 | /* TRIMS THE LEFT AND RIGHT MOST SPACES */ 78 | /* UPPERCASE */ 79 | NAME01 = LOWERCASE(TRIM(NAME01)); 80 | PUT SKIP LIST('UPPERCASE',UPPERCASE(NAME01)); 81 | /* RETURNS THE UPPERCASE OF A STRING */ 82 | /* VERIFY */ 83 | PUT SKIP LIST('VERIFY',VERIFY('2A56B','0123456789')); 84 | PUT SKIP LIST('VERIFYR',VERIFY('2A56B','0123456789')); 85 | PUT SKIP LIST('VERIFY',VERIFY('2256B','0123456789AB')); 86 | /* RETURNS 0 IF ALL IN S FOUND IN C */ 87 | /* ELSE RETURNS FIRST NON OCC POSITION */ 88 | /* WHIGH WLOW */ 89 | PUT SKIP LIST('WHIGH,WLOW',WHIGH(2),WLOW(2)); 90 | /* RETURNS WIDECHAR HIGH AND LOW VALUES */ 91 | /* WIDECHAR */ 92 | PUT SKIP LIST('WIDECHAR',WIDECHAR(NAME01)); 93 | /* CONVERTS STRING TO WIDECHAR STRING*/ 94 | END STRINGP; -------------------------------------------------------------------------------- /Cobol/db2oper/db2oper.cbl: -------------------------------------------------------------------------------- 1 | *PROGRAM TO TEST DB2 OPERATIONS 00010004 2 | *USED CENSUS DATA AS SAMPLE 00020004 3 | *TESTS THREE BASIC FUNCTIONS 00030004 4 | *SELECT UPDATE DELETE 00040004 5 | *ALSO HANDLES ERRORS 00050004 6 | IDENTIFICATION DIVISION. 00060000 7 | PROGRAM-ID. DB2OPER. 00070000 8 | ENVIRONMENT DIVISION. 00080000 9 | DATA DIVISION. 00090000 10 | WORKING-STORAGE SECTION. 00100000 11 | EXEC SQL 00110000 12 | INCLUDE SQLCA 00120000 13 | END-EXEC. 00130000 14 | 01 NIND PIC S9(4) COMP. 00131028 15 | *01 EMP-REC. 00140004 16 | * 05 EMPNO PIC 9(4). 00150004 17 | * 05 EMPNAME PIC X(30). 00160004 18 | 01 DCLCENSUS. 00170004 19 | 10 STATE-UT PIC X(30). 00180004 20 | 10 POPULATION PIC S9(9) USAGE COMP. 00190004 21 | 10 GROWTH-PER PIC S9(9) USAGE COMP. 00200004 22 | 10 RURAL-POP PIC S9(9) USAGE COMP. 00210004 23 | 10 URBAN-POP PIC S9(9) USAGE COMP. 00220004 24 | 10 YEAR-OF-SUR PIC S9(9) USAGE COMP. 00230004 25 | 10 RATIO PIC S9(9) USAGE COMP. 00240004 26 | PROCEDURE DIVISION. 00250000 27 | MAIN-PARA. 00260000 28 | * SELECT FIRST ROW BY POPULATION AND DISPLAY ITS VALUE IN SPOOL 00270004 29 | EXEC SQL 00280000 30 | SELECT STATE_UT 00290004 31 | INTO :STATE-UT 00300005 32 | FROM CENSUS 00310004 33 | ORDER BY POPULATION DESC 00320004 34 | FETCH FIRST ROW ONLY 00330002 35 | END-EXEC. 00340000 36 | IF SQLCODE = 0 00341013 37 | DISPLAY 'MOST POP STATE IS:' STATE-UT 00343015 38 | ELSE 00344013 39 | DISPLAY 'ERROR/SELECT' 00345022 40 | DISPLAY 'SQL CODE:' SQLCODE 00350016 41 | END-IF. 00360013 42 | * INSERT NEW RECORDS 00370007 43 | MOVE 'WEST BENGAL' TO STATE-UT. 00371021 44 | MOVE 091347736 TO POPULATION. 00372021 45 | MOVE 13 TO GROWTH-PER. 00373021 46 | MOVE 062213676 TO RURAL-POP. 00374021 47 | MOVE 2913460 TO URBAN-POP. 00375021 48 | MOVE 2011 TO YEAR-OF-SUR. 00376021 49 | MOVE 947 TO RATIO. 00377021 50 | EXEC SQL 00380007 51 | INSERT INTO CENSUS 00390010 52 | VALUES(:STATE-UT,:POPULATION,:GROWTH-PER,:RURAL-POP, 00400019 53 | :URBAN-POP,:YEAR-OF-SUR,:RATIO) 00410019 54 | END-EXEC. 00420007 55 | IF SQLCODE = 0 00421018 56 | DISPLAY 'RECORD INSERTED' 00422015 57 | ELSE 00423013 58 | DISPLAY 'ERROR/INSERT' 00424016 59 | DISPLAY 'SQL CODE:' SQLCODE 00430016 60 | DISPLAY 'SQL STATE:' SQLSTATE 00440016 61 | END-IF. 00450013 62 | * UPDATE EXISTING RECORDS 00460011 63 | MOVE 2016 TO YEAR-OF-SUR. 00461023 64 | EXEC SQL 00470011 65 | UPDATE CENSUS 00480011 66 | SET YEAR_OF_SUR = :YEAR-OF-SUR 00490026 67 | WHERE YEAR_OF_SUR = 2011 00491027 68 | END-EXEC. 00500011 69 | IF SQLCODE = 0 00501018 70 | DISPLAY 'RECORDS UPDATED' 00502015 71 | ELSE 00503013 72 | DISPLAY 'ERROR/UPDATE' 00504022 73 | DISPLAY 'SQL CODE:' SQLCODE 00510016 74 | DISPLAY 'SQLSTATE:' SQLSTATE 00511022 75 | END-IF. 00520013 76 | * TRY TO MOVE NULL TO NOT NULL VALUE OF STATE 00521028 77 | MOVE -1 TO NIND. 00522028 78 | MOVE LOW-VALUES TO STATE-UT. 00522131 79 | EXEC SQL 00523030 80 | UPDATE CENSUS 00524028 81 | SET STATE_UT = :STATE-UT:NIND 00525031 82 | WHERE YEAR_OF_SUR = 2016 00526028 83 | END-EXEC. 00527028 84 | IF SQLCODE = 0 00528028 85 | DISPLAY 'RECORDS UPDATED' 00529028 86 | ELSE 00529128 87 | DISPLAY 'ERROR/UPDATE/NIND' 00529228 88 | DISPLAY 'SQL CODE:' SQLCODE 00529328 89 | DISPLAY 'SQLSTATE:' SQLSTATE 00529428 90 | END-IF. 00529528 91 | STOP RUN. 00530011 92 | 93 | --------------------------------------------------------------------------------