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