* PROCESS ; 00000001
/***** PL/I - IKJEFF18 INTERFACE *****/ 00000020
/* FUNCTION: */ 00000030
/* LINK TO IKJEFF18 TO WRITE A DAIR ERROR MESSAGE */ 00000040
/* PARAMETERS: */ 00000050
/* UPT,ECT,ECB,PSCB,DAPB : PARAMETERS FOR IKJDAIR */ 00000060
/* RETC : RETURN CODE FROM IKJDAIR */ 00000070
/* EXTERNAL REFERENCE: */ 00000080
/* PLILINK : PL/I SVC 6 INTERFACE */ 00000090
/* FETCHED DYNAMICALLY: 00000100
/* IKJEFF18: TSO DAIR ERROR ANALYZER */ 00000110
0PLIDAER: PROC(UPT,ECT,ECB,PSCB,DAPB,RETC) 00000120
OPTIONS(REENTRANT) RECURSIVE REORDER; 00000130
0 DCL UPT, 00000140
ECT, 00000150
ECB, 00000160
PSCB, 00000170
1 DAPB, 00000180
2 DACD BIN(15,0), 00000190
2 DAETCETERA, 00000200
RETC BIN(31,0); 00000210
0 DCL 1 DAPL, 00000220
2 DAPLUPT PTR INIT(ADDR(UPT)), 00000230
2 DAPLECT PTR INIT(ADDR(ECT)), 00000240
2 DAPLECB PTR INIT(ADDR(ECB)), 00000250
2 DAPLPSCB PTR INIT(ADDR(PSCB)), 00000260
2 DAPLDAPB PTR INIT(ADDR(DAPB)); 00000270
DCL FF02 BIN(31,0) INIT(0), 00000280
ERRCD BIN(15,0) INIT(1); 00000290
DCL PLILINK ENTRY OPTIONS(ASM INTER RETCODE); 00000300
0 CALL PLILINK('IKJEFF18',DAPL,RETC,FF02,ERRCD); 00000310
END; 00000320
/*********************************************************************/ 00000321
* PROCESS ; 00000330
/***** PL/I - IKJDAIR INTERFACE FOR ALLOCATING EXISTING DATASET *****/ 00000340
/* FUNCTION: */ 00000350
/* ALLOCATE A EXISTING DATASET */ 00000360
/* PARAMETERS: */ 00000370
/* UPT : USER PROFILE TABLE */ 00000380
/* ECT : ENVIRONMENT CONTROL TABLE */ 00000390
/* PSCB : PROTECTED STEP CONTROL BLOCK */ 00000400
/* DSN : DATASET NAME */ 00000500
/* DDN : DDNAME (IF BLANK, RECEIVES THE DDNAME CHOSEN BY IKJDAIR) */ 00000600
/* MNM : MEMBER NAME */ 00000700
/* PSWD : PASSWORD */ 00000800
/* DSP123 : STATUS AND DISPOSITIONS */ 00000900
/* CTL : CONTROL BYTE */ 00001000
/* DSO : DATASET ORGANISATION, RECEIVES THE DSORG FOUND BY IKJDAIR */ 00001100
/* ALN : ATTRIBUTE LIST NAME */ 00001200
/* RETC : RETURN CODE, RECEIVES THE RETURN CODE FROM IKJDAIR */ 00001300
/* THE INITIAL VALUE SELECTS THE ERROR ACTION */ 00001400
/* ERROR ACTION : */ 00001500
/* IF IKJDAIR RETCODE = 0 THEN RETURN */ 00001600
/* ELSE */ 00001700
/* IF RETCODE = -RETC THEN SUPPRESS ERROR MESSAGE, RETURN */ 00001800
/* ELSE */ 00001900
/* IF RETCODE = RETC THEN WRITE ERROR MESSAGE, RETURN */ 00002000
/* ELSE WRITE ERROR MESSAGE, SIGNAL COND(DAIRERR) */ 00002100
/* EXTERNAL REFERENCES: */ 00002200
/* PLITSSR : PL/I INTERFACE TO TSO SERVICE ROUTINES */ 00002300
/* PLIDAER : IKJDAIR ERROR MESSAGE WRITER */ 00002400
/* FETCHED DYNAMICALLY: */ 00002500
/* IKJDAIR : TSO DAIR SERVICE ROUTINE */ 00002600
0PLIDAEX: PROC(UPT,ECT,PSCB,DSN,DDN,MNM,PSWD,DSP123,CTL,DSO,ALN,RETC) 00002700
OPTIONS(REENTRANT) RECURSIVE REORDER; 00002800
0 DCL UPT, 00002900
ECT, 00003000
PSCB, 00003100
DSN CHAR(44) VAR, 00003200
DDN CHAR(8), 00003300
MNM CHAR(8), 00003400
PSWD CHAR(8), 00003500
DSP123 BIT(24) ALIGNED, 00003600
CTL BIT(8) ALIGNED, 00003700
DSO BIT(8) ALIGNED, 00003800
ALN CHAR(8), 00003900
RETC BIN(31,0); 00004000
0 DCL PLITSSR ENTRY OPTIONS(ASM INTER RETCODE), 00004100
PLIDAER ENTRY; 00004200
DCL ECB BIN(31,0) INIT(0), 00004300
SPEZRETC BIN(31,0) INIT(RETC); 00004400
1 DCL 1 DA08PB, /* IKJDAIR PARAMETER BLOCK, CODE 08 */ 00004500
2 DA08CD BIN(15,0) INIT(8), 00004600
2 DA08FLG BIT(16) ALIGNED INIT(0), 00004700
2 DA08DARC BIN(15,0) INIT(0), 00004800
2 DA08CTRC BIN(15,0) INIT(0), 00004900
2 DA08PDSN PTR, 00005000
2 DA08DDN CHAR(8), 00005100
2 DA08UNIT CHAR(8) INIT(''), 00005200
2 DA08SER CHAR(8) INIT(''), 00005300
2 DA08BLK BIN(31,0) INIT(0), 00005400
2 DA08PQTY BIN(31,0) INIT(0), 00005500
2 DA08SQTY BIN(31,0) INIT(0), 00005600
2 DA08DQTY BIN(31,0) INIT(0), 00005700
2 DA08MNM CHAR(8), 00005800
2 DA08PSWD CHAR(8), 00005900
2 DA08DSP123 BIT(24) ALIGNED, 00006000
2 DA08CTL BIT(8) ALIGNED, 00006100
2 DA08RES BIT(24) ALIGNED INIT(0), 00006200
2 DA08DSO BIT(8) ALIGNED INIT(0), 00006300
2 DA08ALN CHAR(8); 00006400
0 IF CTL & '00000100'B THEN /* DUMMY DATASET */ 00006500
DO; 00006600
UNSPEC(DA08PDSN) = 0; /* IGNORE DSNAME */ 00006700
DA08DSP123 = '00000100'B; 00006800
END; 00006900
ELSE 00007000
DO; 00007100
DA08PDSN = ADDR(DSN); 00007200
DA08DSP123 = DSP123 & (3)'00001111'B; 00007300
END; 00007400
DA08DDN = DDN; 00007500
DA08MNM = MNM; 00007600
DA08PSWD = PSWD; 00007700
IF ALN = '' THEN 00007800
DA08CTL = CTL & '00111100'B; 00007900
ELSE /* TURN ON ATTRLIST BIT */ 00008000
DA08CTL = CTL & '00111100'B | '00000010'B; 00008100
DA08ALN = ALN; 00008200
0 CALL PLITSSR('IKJDAIR ',UPT,ECT,ECB,PSCB,DA08PB); 00008300
RETC = PLIRETV(); 00008400
IF RETC =0 THEN 00008500
DO; 00008600
DDN = DA08DDN; 00008700
DSO = DA08DSO; 00008800
END; 00008900
0 ELSE /* ANALYZE IKJDAIR ERROR */ 00009000
IF RETC ^= -SPEZRETC THEN 00009100
DO; 00009200
CALL PLIDAER(UPT,ECT,ECB,PSCB,DA08PB,RETC); 00009300
IF RETC ^= SPEZRETC THEN 00009400
SIGNAL COND(DAIRERR); 00009500
END; 00009600
END; 00009700
/*********************************************************************/ 00009800
* PROCESS ; 00009900
/***** DAIR CODE 00 : SEARCH DSE *****/ 00010000
0PLIDA00: PROC(UPT,ECT,PSCB,DSN,DDN,CTL,FLG,DSO) 00010100
OPTIONS(REENTRANT) RECURSIVE REORDER; 00010200
0 DCL DSN CHAR(44) VAR, 00010300
DDN CHAR(8), 00010400
CTL BIT(8) ALIGNED, 00010500
FLG BIT(16) ALIGNED, /* RECEIVES THE FLAG RETURNED BY IKJDAIR */ 00010600
DSO BIT(8) ALIGNED; /* RECEIVES THE DSO RETURNED BY IKJDAIR */ 00010700
0 DCL 1 DA00PB, 00010800
2 DA00CD BIN(15,0), 00010900
2 DA00FLG BIT(16) ALIGNED, 00011000
2 DA00PDSN PTR, 00011100
2 DA00DDN CHAR(8), 00011200
2 DA00CTL BIT(8) ALIGNED, 00011300
2 DA00RES BIN(15,0) UNAL, 00011400
2 DA00DSO BIT(8) ALIGNED; 00011500
0 DCL PLITSSR ENTRY OPTIONS(ASM INTER RETCODE), 00011600
PLIDAER ENTRY; 00011700
DCL ECB BIN(31,0) INIT(0), 00011800
RETCODE BIN(31,0); 00011900
DA00CD = 0; 00012000
DA00FLG = 0; 00012100
DA00DDN = DDN; 00012200
IF DDN = '' THEN 00012300
DA00PDSN = ADDR(DSN); 00012400
ELSE 00012500
UNSPEC(DA00PDSN) = 0; 00012600
DA00CTL = CTL & '00100000'B; 00012700
DA00RES = 0; 00012800
DA00DSO = 0; 00012900
0 CALL PLITSSR('IKJDAIR ',UPT,ECT,ECB,PSCB,DA00PB); 00013000
RETCODE = PLIRETV(); 00013100
IF RETCODE > 0 THEN 00013200
DO; 00013300
CALL PLIDAER(UPT,ECT,ECB,PSCB,DA00PB,RETCODE); 00013400
SIGNAL COND(DAIRERR); 00013500
END; 00013600
ELSE 00013700
DO; 00013800
FLG = DA00FLG; 00013900
DSO = DA00DSO; 00014000
END; 00014100
END; 00014200
/*********************************************************************/ 00014300
* PROCESS ; 00014400
/***** SINGLE INFORMATIONAL MESSAGE *****/ 00014500
0PLIPTIS: PROC(UPT,ECT,INFO) OPTIONS(REENTRANT) RECURSIVE REORDER; 00014600
0 DCL INFO CHAR(254) VAR; 00014700
DCL 1 INFOLINE, 00014800
2 ISCT BIN(31,0), 00014900
2 ISPMSG PTR, 00015000
2 ISLEN BIN(15,0), 00015100
2 ISOFF BIN(15,0), 00015200
2 ISTEXT CHAR(256); 00015300
DCL 1 PUTLPB, 00015400
2 PTPBCTL BIT(16) ALIGNED, 00015500
2 PTPBTPUT BIN(15,0) INIT(0), 00015600
2 PTPBOPUT PTR, 00015700
2 PTPBFLN PTR INIT(NULL()); 00015800
DCL (ECB,RETCODE) BIN(31,0) INIT(0); 00015900
DCL PLITSSR ENTRY OPTIONS(ASM INTER RETCODE), 00016000
PLISVC ENTRY(BIN(15,0),BIN(31,0),PTR,BIN(31,0)) 00016100
OPTIONS(ASM INTER); 00016200
DCL R0 BIN(31,0), 00016300
R1 PTR; 00016400
DCL 1 ERRMSG, 00016500
2 ERRTEXT CHAR(26) INIT('PUTLINE ERROR, RETURN CODE'), 00016600
2 RETCH PIC'ZZZZ9'; 00016700
0 ISCT = 1; 00016800
ISPMSG = ADDR(ISLEN); 00016900
ISLEN = LENGTH(INFO)+4; 00017000
ISOFF = 0; 00017100
ISTEXT = INFO; 00017200
PTPBCTL = '00010010'B; 00017300
PTPBOPUT = ADDR(INFOLINE); 00017400
0 CALL PLITSSR('IKJPUTL ',UPT,ECT,ECB,PUTLPB); 00017500
RETCODE = PLIRETV(); 00017600
IF RETCODE > 4 THEN 00017700
DO; 00017800
RETCH = RETCODE; 00017900
R0 = LENGTH(ERRTEXT)+5; 00018000
R1 = ADDR(ERRMSG); 00018100
CALL PLISVC(93,R0,R1,RETCODE); 00018200
IF RETCODE > 0 THEN 00018300
SIGNAL ERROR; 00018400
END; 00018500
END; 00018600
/*********************************************************************/ 00018700
* PROCESS ; 00018800
/*********** PL/I - IKJSCAN INTERFACE ***************/ 00018900
/* FUNCTION: */ 00019000
/* CALL IKJSCAN SERVICE ROUTINE, ANALYZE ITS OUTPUT. */ 00019100
/* EXTERNAL REFERENCES: */ 00019200
/* PLIPTIS : PL/I - PUTLINE INTERFACE (SINGLE INFOMSG) */ 00019300
/* PLITSSR : PL/I INTERFACE TO TSO SERVICE ROUTINES */ 00019400
/* FETCHED DYNAMICALLY: */ 00019500
/* IKJSCAN : TSO IKJSCAN SERVICE ROUTINE */ 00019600
0PLISCAN: PROC(CBUF,UPT,ECT) RETURNS(CHAR(8)) 00019700
OPTIONS(REENTRANT) RECURSIVE REORDER; 00019800
0 DCL 1 IKJECT BASED(ADDR(ECT)), 00019900
2 UNUSED CHAR(28), 00020000
2 ECTSWS BIT(8) ALIGNED; 00020100
DCL 1 CSPARMS, 00020200
2 CSECB BIN(31,0) INIT(0), 00020300
2 CSFLG BIT(8) ALIGNED INIT(0), 00020400
2 CSRES BIT(24) ALIGNED INIT(0), 00020500
2 CSOA, 00020600
3 CSOACNM PTR, 00020700
3 CSOALNM BIN(15,0), 00020800
3 CSOAFLG BIT(8) ALIGNED, 00020900
3 CSOARES BIT(8) ALIGNED INIT(0); 00021000
DCL CMD CHAR(8) BASED(CSOACNM); 00021100
DCL ERRMSG CHAR(34) VAR INIT('IKJSCA01I SCAN PARAMETER ERROR'), 00021200
NOINFO CHAR(34) VAR INIT('IKJSCA02I NO INFORMATION AVAILABLE'), 00021300
INVAL CHAR(34) VAR INIT('IKJSCA03I INVALID COMMAND SYNTAX'); 00021400
DCL PLITSSR ENTRY OPTIONS(ASM INTER RETCODE), 00021500
PLIPTIS ENTRY; 00021600
0 CALL PLITSSR('IKJSCAN ',UPT,ECT,CSECB,CSFLG,CSOA,CBUF, 00021700
'IKJSCAN DOESNT LIKE VL BIT ON 6. PARAMETER'); 00021800
IF PLIRETV() > 0 THEN 00021900
DO; 00022000
CALL PLIPTIS(UPT,ECT,ERRMSG); 00022100
SIGNAL ERROR; 00022200
END; 00022300
IF CSOALNM > 0 THEN 00022400
DO; /* VALID COMMAND NAME FOUND */ 00022500
IF CSOAFLG = '10000000'B THEN /* INDICATE PARMS IN ECTSWS */ 00022600
ECTSWS = ECTSWS & '01111111'B; 00022700
ELSE /* INDICATE NO PARMS IN ECTSWS */ 00022800
ECTSWS = ECTSWS | '10000000'B; 00022900
RETURN(SUBSTR(CMD,1,CSOALNM)); 00023000
END; 00023100
SELECT (CSOAFLG); /* NO VALID CMDNAME FOUND */ 00023200
WHEN ('00100000'B) 00023300
CALL PLIPTIS(UPT,ECT,NOINFO); 00023400
WHEN ('00010000'B) ; 00023500
WHEN ('00001000'B) 00023600
CALL PLIPTIS(UPT,ECT,INVAL); 00023700
END; 00023800
RETURN(''); 00023900
END; 00024000
/*********************************************************************/ 00024100
* PROCESS ; 00024200
/***** PL/I - IKJSTCK INTERFACES (CREATE/DELETE DS) *****/ 00024300
/* GENERAL PHILOSOPHY: */ 00024400
/* CONSTRUCT STACK PARAMETER BLOCK, */ 00024500
/* LINK TO IKJSTCK */ 00024600
/* RETURN IF IKJSTCK RETCODE = 0 */ 00024700
/* ELSE WRITE AN ERROR MESSAGE USING PLIPTIS */ 00024800
/* EXTERNAL REFERENCES: */ 00024900
/* PLIPTIS : PL/I - PUTLINE INTERFACE (SINGLE INFOMSG) */ 00025000
/* PLITSSR : PL/I INTERFACE TO TSO SERVICE ROUTINES */ 00025100
/* FETCHED DYNAMICALLY: */ 00025200
/* IKJSTCK : TSO STACK SERVICE ROUTINE */ 00025300
0/***** CREATE AND STACK A OUTPUT DATASET ELEMENT *****/ 00025400
0PLISTAD: PROC(UPT,ECT,DDN,LIST) 00025500
OPTIONS(REENTRANT) RECURSIVE REORDER; 00025600
0 DCL DDN CHAR(8), 00025700
LIST BIN(15,0); 00025800
DCL 1 STACKPB, 00025900
2 STPBOPCD BIT(8) ALIGNED INIT('10000000'B), 00026000
2 STPBELCD BIT(8) ALIGNED, 00026100
2 STPBRES BIN(15,0) INIT(0), 00026200
2 STPBALSD BIN(31,0) INIT(0), 00026300
2 STPBIDDP BIN(31,0) INIT(0), 00026400
2 STPBODDP PTR INIT(ADDR(DDN)); 00026500
DCL ECB BIN(31,0) INIT(0); 00026600
DCL MSG CHAR(34) VAR INIT('IKJSTK01I STACK PARAMETER ERROR'); 00026700
DCL PLITSSR ENTRY(CHAR(8),*,*,*,*) OPTIONS(ASM INTER RETCODE), 00026800
PLIPTIS ENTRY; 00026900
0 IF LIST = 1 THEN 00027000
STPBELCD = '10010001'B; 00027100
ELSE 00027200
STPBELCD = '10010000'B; 00027300
0 CALL PLITSSR('IKJSTCK ',UPT,ECT,ECB,STACKPB); 00027400
IF PLIRETV() > 0 THEN 00027500
DO; 00027600
CALL PLIPTIS(UPT,ECT,MSG); 00027700
SIGNAL ERROR; 00027800
END; 00027900
END; 00028000
/*********************************************************************/ 00028100
* PROCESS ; 00028200
/***** DELETE STACK ELEMENT(S) *****/ 00028300
0PLISTD: PROC(UPT,ECT,DELTYPE) 00028400
OPTIONS(REENTRANT) RECURSIVE REORDER; 00028500
0 DCL DELTYPE BIT(8) ALIGNED; 00028600
DCL 1 STACKPB, 00028700
2 STPBOPCD BIT(8) ALIGNED INIT('01000000'B), 00028800
2 STPBELCD BIT(8) ALIGNED INIT(0), 00028900
2 STPBRES BIN(15,0) INIT(0), 00029000
2 STPBALSD BIN(31,0) INIT(0), 00029100
2 STPBIDDP BIN(31,0) INIT(0), 00029200
2 STPBODDP BIN(31,0) INIT(0); 00029300
DCL ECB BIN(31,0) INIT(0); 00029400
DCL MSG CHAR(34) VAR INIT('IKJSTK01I STACK PARAMETER ERROR'); 00029500
DCL PLITSSR ENTRY(CHAR(8),*,*,*,*) OPTIONS(ASM INTER RETCODE), 00029600
PLIPTIS ENTRY; 00029700
0 IF DELTYPE & '00100000'B THEN 00029800
STPBOPCD = '00100000'B; 00029900
ELSE 00030000
IF DELTYPE & '00010000'B THEN 00030100
STPBOPCD = '00010000'B; 00030200
0 CALL PLITSSR('IKJSTCK ',UPT,ECT,ECB,STACKPB); 00030300
IF PLIRETV() > 0 THEN 00030400
DO; 00030500
CALL PLIPTIS(UPT,ECT,MSG); 00030600
SIGNAL ERROR; 00030700
END; 00030800
END; 00030900
/*********************************************************************/ 00031000
* PROCESS ; 00031100
/************* TSODS COMMAND PROCESSOR FOR TSO ***************/ 00031200
/* TO BE CALLED AT ENTRY POINT PLICALLA. */ 00031300
/* FUNCTION: CREATE A OUTPUT DATASET ELEMENT IN THE TSO STACK */ 00031400
/* AND LINK TO THE COMMAND SPECIFIED. */ 00031500
/* SYNTAX: TSODS 'TSO COMMAND' */ 00031600
/* EXTERNAL REFERENCES: */ 00031700
/* PLISTAD: PL/I IKJSTCK INTERFACE (ADD DATASET ELEMENT) */ 00031800
/* PLISTD : PL/I IKJSTCK INTERFACE (DELETE STACK ELEMET(S)) */ 00031900
/* PLISCAN: PL/I IKJSCAN INTERFACE (SCAN INPUT BUFFER) */ 00032000
/* PLILINK: PL/I LINK SVC INTERFACE */ 00032100
/* PLIPTIS: PL/I PUTLINE INTERFACE (WRITE SINGLE MESSAGE) */ 00032200
/* PLIDA00: PL/I IKJDAIR INTERFACE (VERIFY FILE ALLOCATED) */ 00032300
0TSODS: PROC(CBUF,UPT,PSCB,ECT) OPTIONS(MAIN REENTRANT) REORDER; 00032400
0 DCL PLIXOPT CHAR(30) VAR INIT('ISA(4K),NOSTAE') STATIC EXT; 00032500
DCL RETCODE BIN(31,0) INIT(0); 00032600
DCL PLISTAD ENTRY(*,*,CHAR(8),BIN(15,0)), 00032700
PLISTD ENTRY(*,*,BIT(8) ALIGNED), 00032800
PLISCAN ENTRY RETURNS(CHAR(8)), 00032900
PLILINK ENTRY 00033000
OPTIONS(ASM INTER RETCODE), 00033100
PLIPTIS ENTRY, 00033200
PLIDA00 ENTRY; 00033300
DCL 1 IKJECT BASED(ADDR(ECT)), 00033400
2 UNUSED CHAR(12), 00033500
2 ECTPCMD CHAR(8), 00033600
2 ECTSCMD CHAR(8), 00033700
2 ECTSWS BIT(8) ALIGNED; 00033800
DCL DSN CHAR(44) VAR INIT(''), 00033900
SAVECMD CHAR(8) INIT(ECTPCMD), 00034000
MAINCMD CHAR(8) INIT('TSODS'), 00034100
DELTOP BIT(8) ALIGNED INIT('01000000'B), 00034200
CTL BIT(8) ALIGNED INIT(0), 00034300
FLG BIT(16) ALIGNED INIT(0), 00034400
DSO BIT(8) ALIGNED INIT(0); 00034500
DCL NOALC CHAR(78) VAR INIT('IKJTSD01I FILE TSODS NOT ALLOCATED'), 00034600
NOCMD CHAR(78) VAR INIT('IKJTSD00I COMMAND MISSING'), 00034700
MSG CHAR(78) VAR; 00034800
DCL CMD CHAR(8); 00034900
DCL 1 CMDLIST STATIC EXT, /* LIST OF ALLOWED COMMANDS */ 00035000
2 COUNT BIN(15,0) INIT(23), /* NUMBER OF COMMANDS IN LIST */ 00035100
2 CMDOKAY(40) CHAR(8) INIT( 00035200
'LDS','LISTD','LISTDS', 00035300
'SP','SPACE', 00035400
'L','LIST', 00035500
'LA','LISTA','LISTALC', 00035600
'LB','LISTB','LISTBC', 00035700
'ST','STATUS', 00035800
(25)(8)'*'); 00035900
1/***** VARIOUS TESTS *****/ 00036000
0 IF ECTSWS & '10000000'B THEN 00036100
DO; /* NO COMMAND SPECIFIED */ 00036200
CALL PLIPTIS(UPT,ECT,NOCMD); 00036300
STOP; 00036400
END; 00036500
CMD = PLISCAN(CBUF,UPT,ECT); 00036600
IF CMD = '' THEN /* INVALID COMMAND SYNTAX OR '?' */ 00036700
STOP; 00036800
SELECT(CMD); /* SOME COMMANDS NEED SPECIAL TREATMENT */ 00036900
WHEN('TIME') 00037000
CMD = 'IKJEFT25'; 00037100
WHEN('H','HELP'); 00037200
OTHERWISE 00037300
ALLOWED: 00037400
DO; 00037500
LEAVE ALLOWED ; 00037600
00037700
DO I=1 TO COUNT; /* LOOK IN LIST OF ALLOWED COMMANDS */ 00037800
IF CMD = CMDOKAY(I) THEN 00037900
LEAVE ALLOWED; 00038000
END; 00038100
MSG = 'IKJTSD04I COMMAND '||CMD||' INVALID UNDER TSODS'; 00038200
CALL PLIPTIS(UPT,ECT,MSG); 00038300
STOP; 00038400
END; 00038500
END; 00038600
CALL PLIDA00(UPT,ECT,PSCB,DSN,MAINCMD,CTL,FLG,DSO); 00038700
IF (FLG & '00000110'B) ^= '00000010'B THEN 00038800
DO; /* FILE TSODS NOT ALLOCATED */ 00038900
CALL PLIPTIS(UPT,ECT,NOALC); 00039000
ECTPCMD = SAVECMD; 00039100
STOP; 00039200
END; 00039300
0/***** STACK OUTPUT DATASET ELEMENT AND LINK TO COMMAND *****/ 00039400
ECTPCMD = CMD; 00039500
0 CALL PLISTAD(UPT,ECT,MAINCMD,0); 00039600
CALL PLILINK(CMD,CBUF,UPT,PSCB,ECT); 00039700
RETCODE = PLIRETV(); 00039800
ECTPCMD = SAVECMD; 00039900
0/***** DELETE TOP STACK ELEMENT AND CHECK RETURN CODE FROM LINK *****/ 00040000
0 CALL PLISTD(UPT,ECT,DELTOP); 00040100
CALL PLIRETC(RETCODE); 00040200
END; 00040300