* 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