DSN8IP6
THIS MODULE RECEIVES INPUT MESSAGE AND DEFORMATS IT, CALLS DSN8IP7, FORMATS OUTPUT MESSAGE AND SENDS IT.
DSN8IP6: PROC(IOPCB_ADDR,ALTPCB_ADDR) OPTIONS (MAIN); 00010000
/********************************************************************* 00020000
* * 00030000
* MODULE NAME = DSN8IP6 * 00040000
* * 00050000
* DESCRIPTIVE NAME = DB2 SAMPLE APPLICATION * 00060000
* SUBSYSTEM INTERFACE MODULE * 00070000
* IMS * 00080000
* PL/I * 00090000
* PROJECT * 00100000
* * 00110000
* COPYRIGHT = 5740-XYR (C) COPYRIGHT IBM CORP 1982, 1985 * 00120000
* REFER TO COPYRIGHT INSTRUCTIONS FORM NUMBER G120-2083 * 00130000
* * 00140000
* STATUS = RELEASE 2, LEVEL 0 * 00150000
* * 00160000
* FUNCTION = THIS MODULE RECEIVES INPUT MESSAGE AND DEFORMATS IT, * 00170000
* CALLS DSN8IP7, FORMATS OUTPUT MESSAGE AND SENDS IT. * 00180000
* * 00190000
* NOTES = NONE * 00200000
* * 00210000
* MODULE TYPE = PL/I PROC OPTIONS(MAIN) * 00220000
* PROCESSOR = PL/I OPTIMIZER * 00230000
* MODULE SIZE = SEE LINKEDIT * 00240000
* ATTRIBUTES = REUSABLE * 00250000
* * 00260000
* ENTRY POINT = DSN8IP6 * 00270000
* PURPOSE = SEE FUNCTION * 00280000
* LINKAGE = FROM IMS * 00290000
* * 00300000
* INPUT = PARAMETERS EXPLICITLY PASSED TO THIS FUNCTION: * 00310000
* COMMON AREA: * 00320000
* * 00330000
* SYMBOLIC LABEL/NAME = COMPARM.PFKIN * 00340000
* DESCRIPTION = 00/01/02/03/08/10 * 00350000
* * 00360000
* SYMBOLIC LABEL/NAME = COMPARM.INAREA * 00370000
* DESCRIPTION = USER INPUT * 00380000
* * 00390000
* INPUT-MESSAGE: * 00400000
* * 00410000
* SYMBOLIC LABEL/NAME = DSN8IPFI * 00420000
* DESCRIPTION = GENERAL MENU * 00430000
* * 00440000
* SYMBOLIC LABEL/NAME = DSN8IPEI * 00450000
* DESCRIPTION = SECONDARY SELECTION MENU * 00460000
* * 00470000
* OUTPUT = PARAMETERS EXPLICITLY RETURNED: * 00480000
* COMMON AREA: * 00490000
* * 00500000
* SYMBOLIC LABEL/NAME = COMPARM.OUTAREA * 00510000
* DESCRIPTION = USER OUTPUT * 00520000
* * 00530000
* SYMBOLIC LABEL/NAME = COMPARM.LASTSCR * 00540000
* DESCRIPTION = DSN8001/DSN8002 * 00550000
* * 00560000
* OUTPUT-MESSAGE: * 00570000
* * 00580000
* SYMBOLIC LABEL/NAME = DSN8IPFO * 00590000
* DESCRIPTION = GENERAL MENU * 00600000
* * 00610000
* SYMBOLIC LABEL/NAME = DSN8IPEO * 00620000
* DESCRIPTION = SECONDARY SELECTION MENU * 00630000
* * 00640000
* EXIT-NORMAL = * 00650000
* * 00660000
* EXIT-ERROR = * 00670000
* * 00680000
* RETURN CODE = NONE * 00690000
* * 00700000
* ABEND CODES = NONE * 00710000
* * 00720000
* ERROR-MESSAGES = * 00730000
* DSN8064E - INVALID DL/I STC-CODE ON GU MSG * 00740000
* DSN8065E - INVALID DL/I STC-CODE ON ISRT MSG * 00750000
* * 00760000
* EXTERNAL REFERENCES = * 00770000
* ROUTINES/SERVICES = MODULE DSN8IP7 * 00780000
* MODULE PLITDLI * 00790000
* MODULE DSN8MPG * 00800000
* * 00810000
* DATA-AREAS = * 00820000
* DSN8MPCA - PARAMETER TO BE PASSED TO DSN8CP7 * 00830000
* CONTAINS TERMINAL INPUT AND * 00840000
* OUTPUT AREAS. * 00850000
* IN_MESSAGE - MFS INPUT * 00860000
* OUT_MESSAGE - MFS OUTPUT * 00870000
* * 00880000
* CONTROL-BLOCKS = NONE * 00890000
* * 00900000
* TABLES = NONE * 00910000
* * 00920000
* CHANGE-ACTIVITY = NONE * 00930000
* * 00940000
* *PSEUDOCODE* * 00950000
* PROCEDURE * 00960000
* DECLARATIONS. * 00970000
* ALLOCATE PL/I WORK AREA FOR COMMAREA. * 00980000
* INITIALIZATION. * 00990000
* PUT MODULE NAME 'DSN8IP6' IN AREA USED BY ERROR-HANDLER* 01000000
* PUT MODNAME 'DSN8IPFO' IN MODNAME FIELD. * 01010000
* * 01020000
* STEP1. * 01030000
* CALL DLI GU INPUT MESSAGE. * 01040000
* IF STATUS CODE NOT OK THEN SEND ERROR MESSAGE AND * 01050000
* STOP PROGRAM. * 01060000
* * 01070000
* IF SCREEN CLEARED/UNFORMATTED , MOVE '00' TO PFKIN. * 01080000
* MOVE INPUT MESSAGE FIELDS TO CORRESPONDING * 01090000
* INAREA FIELDS IN COMPARM. * 01100000
* CALL DSN8IP7 (COMMAREA) * 01110000
* MOVE OUTAREA FIELDS IN PCONVSTA TO CORRESPONDING * 01120000
* OUTPUT MESSAGE FIELDS. * 01130000
* IF LASTSCR 'DSN8001' MOVE 'DSN8IPFO' TO MODNAME FIELD * 01140000
* ELSE MOVE 'DSN8IPEO' TO MODNAME FIELD. * 01150000
* * 01160000
* CALL DLI ISRT OUTPUT MESSAGE. * 01170000
* IF STATUS CODE NOT OK THEN SEND ERROR MESSAGE AND * 01180000
* STOP PROGRAM. * 01190000
* * 01200000
* END. * 01210000
* * 01220000
*--------------------------------------------------------------------* 01230000
/********************************************************/ 01240000
/* ** FIELDS SENT TO MESSAGE ROUTINE */ 01250000
/********************************************************/ 01260000
01270000
DCL MODULE CHAR (07) INIT ('DSN8IP6'); 01280000
DCL OUTMSG CHAR (69); 01290000
01300000
1/*********************************************************************/01310000
/* DECLARATION FOR INPUT: MIDNAME DSN8IPFI/DSN8IPEI */01320000
/*********************************************************************/01330000
0DCL 1 IN_MESSAGE STATIC, 01340000
2 LL BIN FIXED (31), 01350000
2 Z1 CHAR (1), 01360000
2 Z2 CHAR (1), 01370000
2 TC_CODE CHAR (7), 01380000
2 MESSAGE, 01390000
3 INPUT, 01400000
5 MAJSYS CHAR (1), 01410000
5 ACTION CHAR (1), 01420000
5 OBJFLD CHAR (2), 01430002
5 SEARCH CHAR (2), 01440000
5 PFKIN CHAR (2), 01450000
5 DATA CHAR (60), 01460000
5 TRANDATA(15) CHAR (40); 01470000
-/*********************************************************************/01480000
/* DECLARATION FOR OUTPUT: MODNAME DSN8IPFO/DSN8IPEO */01490000
/*********************************************************************/01500000
0DCL 1 OUT_MESSAGE STATIC, 01510000
2 LL BIN FIXED (31) INIT (1613), 01520000
2 ZZ BIN FIXED (15) INIT (0), 01530000
2 OUTPUT, 01540000
3 OUTPUTAREA, 01550000
5 MAJSYS CHAR (1), 01560000
5 ACTION CHAR (1), 01570000
5 OBJFLD CHAR (2), 01580002
5 SEARCH CHAR (2), 01590000
5 DATA CHAR (60), 01600000
5 TITLE CHAR (50), 01610000
5 DESC2 CHAR (50), 01620000
5 DESC3 CHAR (50), 01630000
5 DESC4 CHAR (50), 01640000
5 MSG CHAR (79), 01650000
5 PFKTEXT CHAR (79), 01660000
5 OUTPUT, 01670000
7 LINE (15) CHAR (79); 01680000
1/*********************************************************************/01690000
/* DECLARATION FOR PASSING INPUT/OUTPUT DATA BETWEEN THE */01700000
/* SUBSYSTEM DEPENDENT MODULE IMS/DL1 AND SQL1 AND SQL2 */01710000
/*********************************************************************/01720000
EXEC SQL INCLUDE DSN8MPCA; 01730000
1/*********************************************************************/01740000
/* DECLARATION FOR PGM-LOGIC */01750000
/*********************************************************************/01760000
0DCL ONE BIN FIXED (31) INIT (1) STATIC; 01770000
DCL THREE BIN FIXED (31) INIT (3) STATIC; 01780000
DCL FOUR BIN FIXED (31) INIT (4) STATIC; 01790000
0DCL GU_FKT CHAR (4) INIT ('GU ') STATIC; 01800000
DCL ISRT_FKT CHAR (4) INIT ('ISRT') STATIC; 01810000
DCL CHNG_FKT CHAR (4) INIT ('CHNG') STATIC; 01820000
DCL ROLL_FKT CHAR (4) INIT ('ROLL') STATIC; 01830000
0DCL MODNAME CHAR (8) STATIC; 01840000
0DCL (ADDR,LOW) BUILTIN; 01850000
0DCL PLITDLI EXTERNAL ENTRY; 01860000
DCL DSN8IP7 EXTERNAL ENTRY; 01870000
0DCL (IOPCB_ADDR,ALTPCB_ADDR) POINTER; 01880000
0DCL DSN8MPG EXTERNAL ENTRY; 01890000
1/*********************************************************************/01900000
/* DECLARATION FOR IO / ALTPCB MASK */01910000
/*********************************************************************/01920000
0DCL 1 IOPCB BASED (IOPCB_ADDR), 01930000
2 IOLTERM CHAR (8), 01940000
2 FILLER CHAR (2), 01950000
2 STC_CODE CHAR (2), 01960000
2 CDATE CHAR (4), 01970000
2 CTIME CHAR (4), 01980000
2 SEQNUM CHAR (4), 01990000
2 MOD_NAME CHAR (8), 02000000
2 USERID CHAR (8); 02010000
0DCL 1 ALTPCB BASED (ALTPCB_ADDR), 02020000
2 ALTLTERM CHAR (8), 02030000
2 FILLER CHAR (2), 02040000
2 STC_CODE CHAR (2); 02050000
02060000
/****************************************************************/ 02070000
/* ALLOCATE COBOL WORK AREA /INITIALIZATIONS */ 02080000
/****************************************************************/ 02090000
02100000
0 ALLOCATE COMMAREA SET(COMMPTR); 02110000
COMMAREA = ''; /* CLEAR COMMON AREA*/ 02120000
IN_MESSAGE = ''; /* CLEAR INPUT FIELD*/ 02130000
MODNAME = 'DSN8IPFO'; /* GET MODULE NAME */ 02140000
DSN8_MODULE_NAME.MAJOR = 'DSN8IP6'; /* GET MODULE NAME */ 02150000
OUTAREA.MAJSYS = 'P'; /* MAJOR SYSTEM - P */ 02160000
02170000
/****************************************************************/ 02180000
/* CALL DL1 GU INPUT MESSAGE */ 02190000
/* PRINT ERROR MESSAGE IF STATUS CODE NOT OK */ 02200000
/****************************************************************/ 02210000
02220000
0 CALL PLITDLI (THREE,GU_FKT,IOPCB,IN_MESSAGE); /* CALL DL1 GU */ 02230000
02240000
0 IF IOPCB.STC_CODE ^= ' ' THEN /* ERROR? */ 02250000
DO; 02260000
/* PRINT MESSAGE */ 02270000
CALL DSN8MPG (MODULE, '064E', OUTMSG); 02280000
OUTPUTAREA.MSG = OUTMSG|| 02290000
IOPCB.STC_CODE; 02300000
02310000
GO TO CSEND; /*CALL DL1 ISRT OUTPUT MESSAGE */ 02320000
END; 02330000
02340000
/****************************************************************/ 02350000
/* CLEARED AND UNFORMATTED SCREEN? */ 02360000
/****************************************************************/ 02370000
02380000
IF Z2 = LOW(1) THEN COMPARM.PFKIN = '00'; 02390000
0 PCONVSTA.CONVID = IOPCB.IOLTERM||USERID; 02400000
INAREA = INPUT, BY NAME; /*MOVE INPUT MESSAGE */ 02410000
INAREA.MAJSYS = 'P'; /*FIELDS TO INAREA FIELDS*/ 02420000
02430000
0 CALL DSN8IP7 (COMMPTR); 02440000
02450000
/*MOVE OUTAREA FIELDS */ 02460000
0 OUTPUTAREA = OUTAREA , BY NAME; /*TO OUTPUT MESSAGE FIELDS*/ 02470000
02480000
0 IF LASTSCR = 'DSN8002' THEN MODNAME = 'DSN8IPEO'; 02490000
ELSE MODNAME = 'DSN8IPFO'; 02500000
02510000
/****************************************************************/ 02520000
/* CALL DL ISRT OUTPUT MESSAGE */ 02530000
/* PRINT ERROR MESSAGE IF STATUS CODE NOT OK */ 02540000
/****************************************************************/ 02550000
02560000
CSEND: 02570000
02580000
/* CALL DL1 ISRT*/ 02590000
CALL PLITDLI (FOUR,ISRT_FKT,IOPCB,OUT_MESSAGE,MODNAME); 02600000
02610000
02620000
0 IF IOPCB.STC_CODE = ' ' THEN GO TO CEND; /* STATUS CODE OK*/ 02630000
02640000
/*PRINT ERROR MESSAGE*/ 02650000
CALL DSN8MPG (MODULE, '065E', OUTMSG); 02660000
OUTPUTAREA.MSG = OUTMSG||IOPCB.STC_CODE; 02670000
02680000
0 CALL PLITDLI (THREE,CHNG_FKT,ALTPCB,IOLTERM); /* CALL DL1 CHNG */ 02690000
02700000
0 IF ALTPCB.STC_CODE ^= ' ' THEN GO TO CSEND1; /* ERROR? */ 02710000
02720000
/* CALL DL1 ISRT */ 02730000
0 CALL PLITDLI (FOUR,ISRT_FKT,ALTPCB,OUT_MESSAGE,MODNAME); 02740000
02750000
0CSEND1: /* PERFORM ROLLBACK */ 02760000
CALL PLITDLI (ONE,ROLL_FKT); 02770000
02780000
0CEND: /* RETURN */ 02790000
END DSN8IP6; 02800000