Before you try out your first IMS/DC program using the BTS simulator, you must have a test database. In this course you will use the Patient Data Base that was illustrated in the IMS DB class. You will then write IMS/DC application program(s) to try out this database. The program will use MFS to capture user input and will display output data using MFS. To start you off, the following artifacts are provided:-
DBD for the database using HISAM (PNTDBHIS)
PSB for loading the database (PNTPHISL)
PSB for reading from the database (PNTPHISG)
A load program written in COBOL (LOADPGM)
A Read program written in COBOL suitable for BATCH (READPGM)
A MFS Format set that can accept a PATNO and output PATIENT details (TEST1).
An IMS DC program that reads a PATNO from the screen and outputs the PATIENT segment (READPGMO).
Test Data to Load the database.
The following Program preparation artifacts are provided but need customization. The lines that need customization are colored blue.
A DBDGEN procedure
A PSBGEN procedure
A COBOL compile and link procedure customized for COBOL / IMS (IGYWCL)
A MFSUTL procedure for preparing your message format sets (MFSUTL).
A DLIBATCH procedure for running your LOAD and READ programs in batch (DLIBATCH)
A BTS procedure (BTS)
DBD preparation JCL (DBD)
PSB preparation JCL (PSB)
JCL to define your VSAM clusters for the sample database
COBOL preparation JCL (COBCL)
MFS preparation JCL (MFS)
JCL to run your Batch IMS program. Use it to load your database and test whether it has been loaded properly. (IMSRUN)
JCL to run a Batch Program under BTS (BTSRUNB)
JCL to run a DC Program under BTS (BTSRUNO)
The hierarchic structure of the database is given below:-
+----------+
¦ PATIENT ¦
+----------+
¦
+----------------+----------------+
¦ ¦ ¦
+----------+ +----------+ +-----------+
¦ ILLNESS ¦ ¦ BILLING ¦ ¦ HOUSHOLD ¦
+----------+ +----------+ +-----------+
¦ ¦
+----------+ +----------+
¦TREATMNT ¦ ¦ PAYMENT ¦
+----------+ +----------+
|
PATIENT SEGMENT, PATIENT has a unique key field: PATNO. PATIENT segments are stored in ascending order of their patient numbers.
+----------------------------+
¦ PATNO ¦ NAME ¦ ADDR ¦
+--------+----------+--------¦
¦ 5 ¦ 10 ¦ 30 ¦
+----------------------------+ |
ILLNESS SEGMENT, The key field is ILLDATE. Because it is possible for a patient to come to the clinic with more than one illness on the same date, this key field is not unique; For segments with equal keys or no keys, the RULES keyword determines where the segment is inserted.
Where RULES=LAST, ILLNESS segments that have an equal key are stored on a first-in first-out basis among those with equal keys. ILLNESS segments with unique keys are stored in ascending order on the date field, regardless of RULES. ILLDATE is specified in the format YYYYMMDD.
+---------------------+
¦ ILLDATE ¦ ILLNAME ¦
+---------+-----------¦
¦ 8 ¦ 10 ¦
+---------------------+ |
TREATMNT SEGMENT, The key field of the TREATMNT segment is DATE. Because a patient may receive more than one treatment on the same date, DATE is a non unique key field. TREATMNT, like ILLNESS, has been specified as having RULES=LAST. TREATMNT segments with equal date keys are also stored on a first-in-first-out basis. DATE is specified in the same format as ILLDATE--YYYYMMDD.
+---------------------------------------+
¦ DATE ¦ MEDICINE ¦ QUANTITY ¦ DOCTOR ¦
+------+-----------+----------+---------¦
¦ 8 ¦ 10 ¦ 4 ¦ 10 ¦
+---------------------------------------+ |
BILLING SEGMENT, BILLING has no key field.
+----------+
¦ BILLING ¦
+----------¦
¦ 6 ¦
+----------+ |
PAYMENT SEGMENT, the PAYMENT segment has no key field.
+-----------+
¦ PAYMENT ¦
+-----------¦
¦ 6 ¦
+-----------+ |
HOUSHOLD SEGMENT, RELNAME is the key field.
+-----------------+
¦RELNAME ¦ RELATN ¦
+--------+--------¦
¦ 10 ¦ 8 ¦
+-----------------+ |
Create the following datasets before you begin the setup
USERID.DBD.SOURC FB PDS 80/800 USERID.PSB.SOURCE FB PDS 80/800 USERID.COBOL.SOURCE FB PDS 80/800 USERID.JCL FB PDS 80/800 USERID.PROCLIB FB PDS 80/800 USERID.MFS.SOURCE FB PDS 80/800 USERID.LOAD.DATA FB PDS 80/800 USERID.REFERAL FB PDS 80/10720 USERID.LOADLIB U PDS /32760 USERID.DBDLIB U PDS /32760 USERID.PSBLIB U PDS /32760 USERID.TFORMAT U PDS /23200 |
DBD NAME=PNTDBHIS,ACCESS=HISAM DATASET DD1=PNTDBHIS,OVFLW=PNTOVFLW SEGM NAME=PATIENT,BYTES=45,PARENT=0 FIELD NAME=(PATNO,SEQ,U),BYTES=5,START=1,TYPE=C FIELD NAME=NAME,BYTES=10,START=6,TYPE=C FIELD NAME=ADDR,BYTES=30,START=16,TYPE=C SEGM NAME=ILLNESS,BYTES=18,PARENT=PATIENT FIELD NAME=(ILLDATE,SEQ,M),BYTES=8,START=1,TYPE=C FIELD NAME=ILLNAME,BYTES=10,START=9,TYPE=C SEGM NAME=TREATMNT,BYTES=32,PARENT=ILLNESS FIELD NAME=(DATE,SEQ,M),BYTES=8,START=1,TYPE=C FIELD NAME=MEDICINE,BYTES=10,START=9,TYPE=C FIELD NAME=QUANTITY,BYTES=4,START=19,TYPE=C FIELD NAME=DOCTOR,BYTES=10,START=23,TYPE=C SEGM NAME=BILLING,BYTES=6,PARENT=PATIENT FIELD NAME=BILLING,BYTES=6,START=1,TYPE=C SEGM NAME=PAYMENT,BYTES=6,PARENT=BILLING FIELD NAME=PAYMENT,BYTES=6,START=1,TYPE=C SEGM NAME=HOUSHLD,BYTES=18,PARENT=PATIENT FIELD NAME=RELNAME,BYTES=10,START=1,TYPE=C FIELD NAME=RELATN,BYTES=8,START=11,TYPE=C DBDGEN FINISH END |
PCB TYPE=DB,NAME=PNTDBHIS,PROCOPT=LS,KEYLEN=21 SENSEG NAME=PATIENT,PARENT=0 SENSEG NAME=ILLNESS,PARENT=PATIENT SENSEG NAME=TREATMNT,PARENT=ILLNESS SENSEG NAME=BILLING,PARENT=PATIENT SENSEG NAME=PAYMENT,PARENT=BILLING SENSEG NAME=HOUSHLD,PARENT=PATIENT PSBGEN PSBNAME=PNTPHISL,LANG=COBOL END |
PCB TYPE=DB,NAME=PNTDBHIS,PROCOPT=A,KEYLEN=21 SENSEG NAME=PATIENT,PARENT=0 SENSEG NAME=ILLNESS,PARENT=PATIENT SENSEG NAME=TREATMNT,PARENT=ILLNESS SENSEG NAME=BILLING,PARENT=PATIENT SENSEG NAME=PAYMENT,PARENT=BILLING SENSEG NAME=HOUSHLD,PARENT=PATIENT PSBGEN PSBNAME=PNTPHISG,LANG=COBOL END |
IDENTIFICATION DIVISION.
PROGRAM-ID. LOADPGM.
******************************************************************
* E N V I R O N M E N T D I V I S I O N *
******************************************************************
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT INFILE ASSIGN TO INFILE
ORGANIZATION IS SEQUENTIAL
ACCESS IS SEQUENTIAL
FILE STATUS IS FILE-STAT.
******************************************************************
* D A T A D I V I S I O N *
******************************************************************
DATA DIVISION.
FILE SECTION.
FD INFILE
RECORD CONTAINS 80 CHARACTERS.
01 IN-REC PIC X(80).
******************************************************************
* W O R K I N G S T O R A G E *
******************************************************************
WORKING-STORAGE SECTION.
01 WORK-AREAS.
05 PARM-COUNT PIC S9(09) COMP VALUE 3.
05 FUNCN PIC X(4) VALUE 'ISRT'.
05 FILE-STAT PIC X(2) VALUE ' '.
01 IO-BUFFER.
05 SSA PIC X(10).
05 SEG-IO-AREA PIC X(70).
01 SWITCHES.
05 S-FLAG-BIT PIC X(01) VALUE LOW-VALUES.
88 S-FLAG VALUE HIGH-VALUES.
LINKAGE SECTION.
01 PCBMASK.
05 DBD-NAME PIC X(08).
05 SEG-ID PIC X(02).
05 STATS PIC X(02).
05 PROCOPT PIC X(04).
05 FILLER PIC X(04).
05 SEGMENT-NAME PIC X(08).
05 LENGTH-FDBK PIC S9(05) COMP.
05 NUMBER-SENSEGS PIC S9(05) COMP.
05 KEY-FDBK-AREA PIC X(21).
******************************************************************
* PROCEDURE DIVISION *
******************************************************************
PROCEDURE DIVISION.
ENTRY 'DLITCBL' USING PCBMASK
PERFORM MAIN-PARA
PERFORM FINAL-PARA.
MAIN-PARA.
OPEN INPUT INFILE
PERFORM UNTIL S-FLAG
READ INFILE RECORD INTO IO-BUFFER
AT END MOVE HIGH-VALUES TO S-FLAG-BIT
END-READ
IF NOT S-FLAG
CALL 'CBLTDLI' USING FUNCN,
PCBMASK,
SEG-IO-AREA,
SSA
DISPLAY SEG-IO-AREA
END-IF
END-PERFORM.
FINAL-PARA.
DISPLAY 'END OF PROGRAM'
GOBACK.
A100-EXIT.
EXIT. |
IDENTIFICATION DIVISION.
PROGRAM-ID. READPGM.
******************************************************************
* E N V I R O N M E N T D I V I S I O N *
******************************************************************
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
******************************************************************
* D A T A D I V I S I O N *
******************************************************************
DATA DIVISION.
FILE SECTION.
******************************************************************
* W O R K I N G S T O R A G E *
******************************************************************
WORKING-STORAGE SECTION.
01 WORK-AREAS.
05 PARM-COUNT PIC S9(09) COMP VALUE 3.
05 FUNCN PIC X(4) VALUE 'GN '.
05 SEG-IO-AREA PIC X(45).
05 SSA PIC X(09) VALUE 'PATIENT'.
01 CONSTANTS.
05 C-GB PIC X(2) VALUE 'GB'.
01 SWITCHES.
05 S-FLAG-BIT PIC X(01) VALUE LOW-VALUES.
88 S-FLAG VALUE HIGH-VALUES.
LINKAGE SECTION.
01 PCBMASK.
05 DBD-NAME PIC X(08).
05 SEG-ID PIC X(02).
05 STATS PIC X(02).
05 PROCOPT PIC X(04).
05 FILLER PIC X(04).
05 SEGMENT-NAME PIC X(08).
05 LENGTH-FDBK PIC S9(05) COMP.
05 NUMBER-SENSEGS PIC S9(05) COMP.
05 KEY-FDBK-AREA PIC X(21).
******************************************************************
* PROCEDURE DIVISION *
******************************************************************
PROCEDURE DIVISION.
ENTRY 'DLITCBL' USING PCBMASK
PERFORM MAIN-PARA
PERFORM FINAL-PARA.
MAIN-PARA.
CALL 'CBLTDLI' USING FUNCN,
PCBMASK,
SEG-IO-AREA.
DISPLAY 'SEGMENT NAME ' SEGMENT-NAME
DISPLAY 'SEGMENT AREA ' SEG-IO-AREA
PERFORM UNTIL S-FLAG
MOVE SPACES TO SEG-IO-AREA
CALL 'CBLTDLI' USING FUNCN,
PCBMASK,
SEG-IO-AREA
IF STATS NOT = C-GB
DISPLAY 'SEGMENT NAME ' SEGMENT-NAME
DISPLAY 'SEGMENT AREA ' SEG-IO-AREA
END-IF
IF STATS = C-GB
DISPLAY 'NON BLANK FROM GN CALL ' STATS
MOVE HIGH-VALUES TO S-FLAG-BIT
END-IF
END-PERFORM.
FINAL-PARA.
DISPLAY 'END OF PROGRAM'
GOBACK.
A100-EXIT.
EXIT. |
PRINT NOGEN
TEST1F FMT
DEV TYPE=3270-A2,FEAT=IGNORE,PFK=(PFKEYSOO, X
3='/FOR TEST1O')
DIV TYPE=INOUT
DPAGE CURSOR=((06,25)),FILL=PT
DFLD 'TEST1F',POS=(01,2),ATTR=(NUM,PROT,HI)
DFLD 'PATIENT INQUIRY PROGRAM',POS=(01,26), X
ATTR=(ALPHA,PROT,HI)
DFLD 'READPGMO',POS=(01,56),ATTR=(ALPHA,PROT,HI)
DFLD 'DATE:',POS=(02,2),ATTR=(ALPHA,PROT,HI)
SYSDATE DFLD POS=(02,8),LTH=8,ATTR=(ALPHA,PROT,NORM)
DFLD 'TIME:',POS=(02,56),ATTR=(ALPHA,PROT,HI)
SYSTIME DFLD POS=(02,62),LTH=08,ATTR=(ALPHA,PROT,NORM)
DFLD 'PATIENT NUMBER:',POS=(06,02),ATTR=(ALPHA,PROT,HI)
PATNO DFLD POS=(06,25),LTH=05,ATTR=(NUM,NOPROT,NORM,MOD)
DFLD '(PF3 - RETURN TO MENU)',POS=(09,02), X
ATTR=(ALPHA,PROT,HI)
DFLD '=======================================================X
==',POS=(10,2),ATTR=(ALPHA,PROT,HI)
DFLD 'PATIENT NAME :',POS=(11,02), X
ATTR=(ALPHA,PROT,HI)
NAME DFLD POS=(11,25),LTH=10,ATTR=(ALPHA,PROT,NORM)
DFLD 'PATIENT ADDRESS :',POS=(13,02), X
ATTR=(ALPHA,PROT,HI)
ADDRESS DFLD POS=(13,25),LTH=30,ATTR=(ALPHA,PROT,NORM)
DFLD 'IO-STAT :',POS=(14,02), X
ATTR=(ALPHA,PROT,HI)
IOSTAT DFLD POS=(14,25),LTH=2,ATTR=(ALPHA,PROT,NORM)
DFLD 'DB-STAT :',POS=(15,02), X
ATTR=(ALPHA,PROT,HI)
DBSTAT DFLD POS=(15,25),LTH=2,ATTR=(ALPHA,PROT,NORM)
FMTEND
TEST1I MSG TYPE=INPUT,SOR=(TEST1F,IGNORE),OPT=1,NXT=TEST1O
SEG
MFLD (PFKEYSOO,'READPGMO '),LTH=14,JUST=L,ATTR=NO
MFLD PATNO,LTH=05,JUST=R,ATTR=NO,FILL=C'0'
MSGEND
TEST1O MSG TYPE=OUTPUT,SOR=(TEST1F,IGNORE),OPT=1,PAGE=NO, X
NXT=TEST1I
SEG
MFLD (SYSDATE,DATE2)
MFLD (SYSTIME,TIME)
MFLD PATNO,LTH=05,JUST=R
MFLD NAME,LTH=10,JUST=L
MFLD ADDRESS,LTH=30,JUST=L
MFLD IOSTAT,LTH=2,JUST=L
MFLD DBSTAT,LTH=2,JUST=L
MSGEND
END |
IDENTIFICATION DIVISION.
PROGRAM-ID. READPGMO.
******************************************************************
* E N V I R O N M E N T D I V I S I O N *
******************************************************************
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
******************************************************************
* D A T A D I V I S I O N *
******************************************************************
DATA DIVISION.
FILE SECTION.
******************************************************************
* W O R K I N G S T O R A G E *
******************************************************************
WORKING-STORAGE SECTION.
01 WORK-AREAS.
05 PARM-COUNT PIC S9(09) COMP VALUE 3.
05 C-GU PIC X(4) VALUE 'GU '.
05 C-ISRT PIC X(4) VALUE 'ISRT'.
01 SEG-IO-AREA.
05 DB-PATNO PIC X(5).
05 DB-NAME PIC X(10).
05 DB-ADDRESS PIC X(30).
01 SSA-Q.
05 FILLER PIC X(08) VALUE 'PATIENT'.
05 FILLER PIC X VALUE '('.
05 FILLER PIC X(8) VALUE 'PATNO'.
05 FILLER PIC X(2) VALUE ' ='.
05 SSA-ARG PIC X(5).
05 FILLER PIC X VALUE ')'.
01 IO-IN-AREA.
05 IN-LL PIC S9(4) COMP.
05 IN-ZZ PIC S9(4) COMP.
05 IN-TRANCODE PIC X(14).
05 IN-PATNO PIC X(5).
01 IO-OUT-AREA.
05 OUT-LL PIC S9(4) COMP VALUE 53.
05 OUT-ZZ PIC S9(4) COMP VALUE 0.
05 OUT-PATNO PIC X(5).
05 OUT-NAME PIC X(10).
05 OUT-ADDRESS PIC X(30).
05 OUT-IO-STAT PIC X(2).
05 OUT-DB-STAT PIC X(2).
LINKAGE SECTION.
01 IO-PCB.
05 FILLER PIC X(10).
05 IO-STAT PIC X(02).
01 PCBMASK.
05 DBD-NAME PIC X(08).
05 SEG-ID PIC X(02).
05 DB-STAT PIC X(02).
05 PROCOPT PIC X(04).
05 FILLER PIC X(04).
05 SEGMENT-NAME PIC X(08).
05 LENGTH-FDBK PIC S9(05) COMP.
05 NUMBER-SENSEGS PIC S9(05) COMP.
05 KEY-FDBK-AREA PIC X(21).
******************************************************************
* PROCEDURE DIVISION *
******************************************************************
PROCEDURE DIVISION.
ENTRY 'DLITCBL' USING IO-PCB PCBMASK
PERFORM MAIN-PARA
PERFORM FINAL-PARA.
MAIN-PARA.
CALL 'CBLTDLI' USING C-GU,
IO-PCB,
IO-IN-AREA
MOVE IN-PATNO TO SSA-ARG
MOVE IO-STAT TO OUT-IO-STAT
CALL 'CBLTDLI' USING C-GU,
PCBMASK,
SEG-IO-AREA,
SSA-Q
MOVE DB-STAT TO OUT-DB-STAT
MOVE DB-PATNO TO OUT-PATNO
MOVE DB-NAME TO OUT-NAME
MOVE DB-ADDRESS TO OUT-ADDRESS
CALL 'CBLTDLI' USING C-ISRT,
IO-PCB,
IO-OUT-AREA.
FINAL-PARA.
GOBACK.
A100-EXIT.
EXIT. |
PATIENT 00001ABCDEF1 18,CHN 600023-1 ILLNESS 01012000MALARIA TREATMNT 01012000QUININE 0004DR.DOBBS BILLING 000600 PAYMENT 000600 HOUSHLD MOHAN FATHER PATIENT 00002ABCDEF2 18,CHN 600023-2 ILLNESS 01012000JAUNDICE TREATMNT 01012000AYURVEDIC 0004DR.JAMES BILLING 000500 PAYMENT 000400 PAYMENT 000100 HOUSHLD MEERA MOTHER PATIENT 00003ABCDEF3 18,CHN 600023-3 ILLNESS 01012000FLU TREATMNT 01012000CROCIN 0004DR.PILOO BILLING 000400 PAYMENT 000400 HOUSHLD JAYA SISTER PATIENT 00004ABCDEF4 18,CHN 600023-4 ILLNESS 01012000MEASLES TREATMNT 01012000NEEMLEAVES0004DR.TOM BILLING 000300 PAYMENT 000200 PAYMENT 000100 HOUSHLD MAYA SISTER PATIENT 00005ABCDEF5 18,CHN 600023-5 ILLNESS 01012000TYPHOID TREATMNT 01012000ANTIBIOTIC0004DR.YOUNG BILLING 000200 PAYMENT 000200 HOUSHLD LATA SISTER |
The following need customization where shown in back lighted blue
// PROC MBR=TEMPNAME,SOUT=A,RGN=0M,SYS2= //C EXEC PGM=ASMA90,REGION=&RGN, // PARM='OBJECT,NODECK,NODBCS' //SYSLIB DD DSN=IMS.&SYS2.MACLIB,DISP=SHR //SYSLIN DD UNIT=SYSDA,DISP=(,PASS), // SPACE=(80,(100,100),RLSE), // DCB=(BLKSIZE=80,RECFM=F,LRECL=80) //SYSPRINT DD SYSOUT=&SOUT,DCB=BLKSIZE=1089, // SPACE=(121,(300,300),RLSE,,ROUND) //SYSUT1 DD UNIT=SYSDA,DISP=(,DELETE), // SPACE=(CYL,(10,5)) //L EXEC PGM=IEWL,PARM='XREF,LIST', // COND=(0,LT,C),REGION=120K //SYSLIN DD DSN=*.C.SYSLIN,DISP=(OLD,DELETE) //SYSPRINT DD SYSOUT=&SOUT,DCB=BLKSIZE=1089, // SPACE=(121,(90,90),RLSE) //SYSLMOD DD DISP=SHR, // DSN=USER01.PSBLIB(&MBR) //SYSUT1 DD UNIT=(SYSDA,SEP=(SYSLMOD,SYSLIN)), // SPACE=(1024,(100,10),RLSE),DISP=(,DELETE) |
// PROC MBR=TEMPNAME,SOUT=A,RGN=0M,SYS2= //C EXEC PGM=ASMA90,REGION=&RGN, // PARM='OBJECT,NODECK,NODBCS' //SYSLIB DD DSN=IMS.&SYS2.MACLIB,DISP=SHR //SYSLIN DD UNIT=SYSDA,DISP=(,PASS), // SPACE=(80,(100,100),RLSE), // DCB=(BLKSIZE=80,RECFM=F,LRECL=80) //SYSPRINT DD SYSOUT=&SOUT,DCB=BLKSIZE=1089, // SPACE=(121,(300,300),RLSE,,ROUND) //SYSUT1 DD UNIT=SYSDA,DISP=(,DELETE), // SPACE=(CYL,(10,5)) //L EXEC PGM=IEWL,PARM='XREF,LIST', // COND=(0,LT,C),REGION=120K //SYSLIN DD DSN=*.C.SYSLIN,DISP=(OLD,DELETE) //SYSPRINT DD SYSOUT=&SOUT,DCB=BLKSIZE=1089, // SPACE=(121,(90,90),RLSE) //SYSLMOD DD DISP=SHR, // DSN=USER01.DBDLIB(&MBR) //SYSUT1 DD UNIT=(SYSDA,SEP=(SYSLMOD,SYSLIN)), // SPACE=(1024,(100,10),RLSE),DISP=(,DELETE) |
//IGYWCL PROC LNGPRFX='IGY.V2R1M0',SYSLBLK=3200, // LIBPRFX='CEE', // PGMLIB='&&GOSET',GOPGM=GO //COBOL EXEC PGM=IGYCRCTL,REGION=2048K //STEPLIB DD DSNAME=&LNGPRFX..SIGYCOMP, // DISP=SHR //SYSPRINT DD SYSOUT=* //SYSLIN DD DSNAME=&&LOADSET,UNIT=SYSDA, // DISP=(MOD,PASS),SPACE=(TRK,(3,3)), // DCB=(BLKSIZE=&SYSLBLK) //SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(1,1)) //SYSUT2 DD UNIT=SYSDA,SPACE=(CYL,(1,1)) //SYSUT3 DD UNIT=SYSDA,SPACE=(CYL,(1,1)) //SYSUT4 DD UNIT=SYSDA,SPACE=(CYL,(1,1)) //SYSUT5 DD UNIT=SYSDA,SPACE=(CYL,(1,1)) //SYSUT6 DD UNIT=SYSDA,SPACE=(CYL,(1,1)) //SYSUT7 DD UNIT=SYSDA,SPACE=(CYL,(1,1)) //LKED EXEC PGM=HEWL,COND=(8,LT,COBOL),REGION=1024K //SYSLIB DD DSNAME=&LIBPRFX..SCEELKED,DISP=SHR //RESLIB DD DSNAME=IMS.RESLIB,DISP=SHR //SYSPRINT DD SYSOUT=* //SYSLIN DD DSNAME=&&LOADSET,DISP=(OLD,DELETE) // DD DSNAME=USER01.PROCLIB(CBLTDLI),DISP=SHR // DD DDNAME=SYSIN //SYSLMOD DD DSNAME=&PGMLIB(&GOPGM), // SPACE=(TRK,(10,10,1)), // UNIT=SYSDA,DISP=(MOD,PASS) //SYSUT1 DD UNIT=SYSDA,SPACE=(TRK,(10,10)) |
// PROC RGN=360K,SOUT=A,SNODE=yournode, // MBR=NOMBR,PXREF=NOXREF, // PCOMP=NOCOMP,PSUBS=NOSUBS,PDIAG=NODIAG, // COMPR=NOCOMPRESS,COMPR2=COMPRESS, // LN=55,SN=8,DEVCHAR=0,COMPR3=NOCOMPREND, // DIRUPDT=UPDATE //S1 EXEC PGM=DFSUPAA0,REGION=&RGN, // PARM=(&PXREF,&PCOMP,&PSUBS,&PDIAG,&COMPR, // 'LINECNT=&LN,STOPRC=&SN,DEVCHAR=&DEVCHAR') //STEPLIB DD DSN=IMSVS.&SNODE..RESLIB,DISP=SHR //*SYSLIB - USER OPTION //SYSIN DD DSN=USER01.MFS.SOURCE(&MBR),DISP=SHR //REFIN DD DSN=USER01.REFERAL,DISP=OLD //REFOUT DD DSN=USER01.REFERAL,DISP=OLD //REFRD DD DSN=USER01.REFERAL,DISP=OLD //SYSTEXT DD DSN=&&TXTPASS,UNIT=SYSDA, // SPACE=(CYL,(1,1)),DCB=BLKSIZE=800 //SYSUT3 DD UNIT=SYSDA,SPACE=(CYL,(1,1)) //SYSUT4 DD UNIT=SYSDA,SPACE=(CYL,(1,1)) //DUMMY DD DSN=IMSVS.&SNODE..PROCLIB(REFCPY),DISP=SHR //UTPRINT DD SYSOUT=&SOUT //SYSPRINT DD SYSOUT=&SOUT,DCB=(RECFM=FBA,LRECL=133,BLKSIZE=1330) //SYSUDUMP DD SYSOUT=&SOUT //SEQBLKS DD DSN=&&BLKS,DISP=(NEW,PASS), // UNIT=SYSDA,SPACE=(CYL,(1,1)) //S2 EXEC PGM=DFSUNUB0,REGION=&RGN, // PARM=(&COMPR2,&COMPR3,&DIRUPDT, // 'DEVCHAR=&DEVCHAR'),COND=(8,LT,S1) //STEPLIB DD DSN=IMSVS.&SNODE..RESLIB,DISP=SHR //SEQBLKS DD DSN=&&BLKS,DISP=(OLD,DELETE) //UTPRINT DD SYSOUT=&SOUT,DCB=(RECFM=FBA,LRECL=133,BLKSIZE=1330) //SYSUDUMP DD SYSOUT=&SOUT //FORMAT DD DSN=USER01.TFORMAT,DISP=SHR //DUMMY DD DSN=IMSVS.&SNODE..PROCLIB(FMTCPY),DISP=SHR //SYSPRINT DD SYSOUT=&SOUT //SYSUT3 DD UNIT=SYSDA,SPACE=(CYL,(1,1)) //SYSUT4 DD UNIT=SYSDA,SPACE=(CYL,(1,1)) |
// PROC MBR=TEMPNAME,PSB=,BUF=7, // SPIE=0,TEST=0,EXCPVR=0,RST=0,PRLD=, // SRCH=0,CKPTID=,MON=N,LOGA=0,FMTO=T, // IMSID=,SWAP=,DBRC=,IRLM=,IRLMNM=, // BKO=N,IOB=,SSM=,APARM=, // RGN=2048K, //* SOUT=A,LOGT=2400,SYS2=, // SOUT=A,SYS2=, // LOCKMAX=,GSGNAME=,TMINAME= //G EXEC PGM=DFSRRC00,REGION=&RGN, // PARM=(DLI,&MBR,&PSB,&BUF, // &SPIE&TEST&EXCPVR&RST,&PRLD, // &SRCH,&CKPTID,&MON,&LOGA,&FMTO, // &IMSID,&SWAP,&DBRC,&IRLM,&IRLMNM, // &BKO,&IOB,&SSM,'&APARM', // &LOCKMAX,&GSGNAME,&TMINAME) //STEPLIB DD DSN=IMS.&SYS2.RESLIB,DISP=SHR // DD DSN=IMS.&SYS2.PGMLIB,DISP=SHR // DD DSN=USER01.LOADLIB,DISP=SHR //DFSRESLB DD DSN=IMS.&SYS2.RESLIB,DISP=SHR //IMS DD DSN=USER01.PSBLIB,DISP=SHR // DD DSN=USER01.DBDLIB,DISP=SHR //PROCLIB DD DSN=IMS.&SYS2.PROCLIB,DISP=SHR //IEFRDER DD DSN=USER01.IMSLOG,DISP=(NEW,KEEP), // DCB=(RECFM=VB,BLKSIZE=1920, // LRECL=1916,BUFNO=2),SPACE=(TRK,(1,1)) //SYSUDUMP DD SYSOUT=&SOUT, // DCB=(RECFM=FBA,LRECL=121,BLKSIZE=605), // SPACE=(605,(500,500),RLSE,,ROUND) //IMSMON DD DUMMY |
//BTS PROC KW=DLI, REGION TYPE // BUF=, ISAM/OSAM BUFFER POOL SIZE // SPIE=0,TEST=0, * // EXCPVR=0,RST=0, * SEE // PRLD=, * IMS/VS // SRCH=0, * MANUALS // CKPTID=, * FOR // MON=N, * THESE // LOGA=0, * PARMS // FMTO=T, * // IMSID=, * // SWAP=, * // DBRC=N, * // IOSEG=512, MAXIMUM IO PCB SEGMENT SIZE // IOBLK=3072, MAXIMUM MESSAGE QUEUE BLOCK SIZE // ALTSEG=536, MAXIMUM ALTERNATE PCB SEGMENT SIZE // IMS=XXXXXXXX, MIDDLE QUALIFIER OF DATASET // SOUT=A SYSOUT CLASS //* //G EXEC PGM=BTSRC000,REGION=512K, // PARM=(&KW,&BUF,&SPIE&TEST&EXCPVR&RST,&PRLD,&SRCH, // &CKPTID,&MON,&LOGA,&FMTO,&IMSID,&SWAP,&DBRC) //DFSRESLB DD DISP=SHR,DSN=IMSVS.&IMS..RESLIB //STEPLIB DD DISP=SHR,DSN=IMSVS.BTSLIB // DD DISP=SHR,DSN=IMSVS.&IMS..RESLIB // DD DISP=SHR,DSN=USER01.LOADLIB //IMS DD DISP=SHR,DSN=USER01.PSBLIB // DD DISP=SHR,DSN=USER01.DBDLIB //FORMAT DD DSN=USER01.TFORMAT,DISP=SHR //IEFRDER DD DUMMY //SYSUDUMP DD SYSOUT=&SOUT //BTSOUT DD SYSOUT=&SOUT, // DCB=(RECFM=FBA,LRECL=133,BLKSIZE=133) //BTSSNAP DD SYSOUT=&SOUT,SPACE=(TRK,(10,15)) //QIOPCB DD UNIT=SYSDA,SPACE=(CYL,1), // DCB=(LRECL=&IOSEG,BLKSIZE=&IOBLK) //QALTPCB DD UNIT=SYSDA,SPACE=(CYL,1), // DCB=(LRECL=&IOSEG,BLKSIZE=&IOBLK) //QALTRAN DD UNIT=SYSDA,SPACE=(CYL,1),DCB=BLKSIZE=&ALTSEG //BTSIN DD DUMMY |
//USER011 JOB NOTIFY=&SYSUID,CLASS=A,MSGLEVEL=(1,1),REGION=0M // JCLLIB ORDER=(USER01.PROCLIB) //STEP1 EXEC DBDGEN,MBR=memname //C.SYSIN DD DSN=USER01.DBD.SOURCE(memname),DISP=SHR // |
//USER011 JOB NOTIFY=&SYSUID,CLASS=A,MSGLEVEL=(1,1),REGION=0M // JCLLIB ORDER=(USER01.PROCLIB) //STEP1 EXEC PSBGEN,MBR=memname //C.SYSIN DD DSN=USER01.PSB.SOURCE(memname),DISP=SHR // |
//USER011 JOB NOTIFY=&SYSUID,CLASS=A,MSGLEVEL=(1,1) // JCLLIB ORDER=(USER01.PROCLIB) //STEP1 EXEC PGM=IDCAMS //SYSPRINT DD SYSOUT=* //SYSIN DD * DELETE USER01.PNTDBHIS CLUSTER DELETE USER01.PNTOVFLW CLUSTER DEFINE CLUSTER (NAME(USER01.PNTOVFLW) NONINDEXED - RECORDSIZE(52,52) TRACKS(1,1) CONTROLINTERVALSIZE(2048)) DEFINE CLUSTER (NAME(USER01.PNTDBHIS) INDEXED KEYS(5,6) - RECORDSIZE(52,52) TRACKS(1,1)) DATA(CONTROLINTERVALSIZE(2048)) // |
//USER011 JOB NOTIFY=&SYSUID,CLASS=A,MSGLEVEL=(1,1) // JCLLIB ORDER=(USER01.PROCLIB) //STEP1 EXEC IGYWCL,REGION=0M //COBOL.SYSIN DD DSN=USER01.COBOL.SOURCE(LOADPGM),DISP=SHR //LKED.SYSLMOD DD DSN=USER01.LOADLIB(LOADPGM),DISP=SHR // |
//USER01L JOB (XXXXXX),NOTIFY=&SYSUID,CLASS=X // JCLLIB ORDER=(USER01.PROCLIB) //JS010 EXEC MFSUTL,MBR=TEST1 // |
//USER011 JOB NOTIFY=&SYSUID,CLASS=A,MSGLEVEL=(1,1) // JCLLIB ORDER=(USER01.PROCLIB) //STEP1 EXEC DLIBATCH,MBR=LOADPGM,PSB= PNTPHISL,DBRC=N //G.SYSPRINT DD SYSOUT=* //* //* THIS IS FOR THE HISAM PATIENT DATABASE //G.PNTDBHIS DD DSN=USER01.PNTDBHIS,DISP=SHR //G.PNTOVFLW DD DSN=USER01.PNTOVFLW,DISP=SHR //* //* THIS IS THE LOAD DATA FOR PATIENT DATABASE //G.SYSIN DD DSN=USER01.LOAD.DATA(DATA),DISP=SHR //* //G.DFSVSAMP DD * VSRBF=2048,4 /* // |
//USER01R JOB (xxxxxx),NOTIFY=&SYSUID,CLASS=X,MSGLEVEL=(1,1) // JCLLIB ORDER=(USER01.PROCLIB) //STEP1 EXEC BTS //G.SYPRINT DD SYSOUT=* //G.BTSIN DD * ./T TC=DUMMY MBR=READPGM PSB=PNTPHISG LANG=CBL TYPE=DLI DUMMY $ /* //* THIS IS FOR THE HISAM PATIENT DATABASE //G.PNTDBHIS DD DSN=USER01.PNTDBHIS,DISP=SHR //G.PNTOVFLW DD DSN=USER01.PNTOVFLW,DISP=SHR //* //G.DFSVSAMP DD * VSRBF=2048,4 /* // |
//USER01R JOB (xxxxxx),NOTIFY=&SYSUID,CLASS=X,MSGLEVEL=(1,1) // JCLLIB ORDER=(USER01.PROCLIB) //STEP1 EXEC BTS //G.SYPRINT DD SYSOUT=* //G.BTSIN DD * ./D TYPE=3270-A2 SIZE=(24,80) ./O ATR=NO ./T TC=READPGMO MBR=READPGMO PSB=PNTPHISG LANG=CBL TYPE=MSG /FOR TEST1O L06C25 '00001' ENTER $ /* //* THIS IS FOR THE HISAM PATIENT DATABASE //G.PNTDBHIS DD DSN=USER01.PNTDBHIS,DISP=SHR //G.PNTOVFLW DD DSN=USER01.PNTOVFLW,DISP=SHR //* //G.DFSVSAMP DD * VSRBF=2048,4 /* // |
If you have any doubts or queries related to this chapter, get them clarified from our Mainframe experts on IBMMainframer Community!