* * THIS PROGRAM CAN BE USED IN PLACE OF IDCAMS WHEN SUBSTATION OF JCL * PARMS ARE REQUIRE WHEN PROCESSING SYSIN. * USE '// EXEC IDCAMSV' WHERE EVER YOU WOULD NORMALLY EXEC 'IDCAMS'. * * EXAMPLE: * // JOB XXX * // SETPARM PREFIX='PRD' * // EXEC IDCAMSV,SIZE=AUTO * DELETE &PREFIX..STU.V.STDW08 CLUSTER PURGE - * CATALOG(&PREFIX..CATALOG) * /* * * IDCAMS WILL DELETE 'PRD.STU.V.STDW08' IN CATALOG 'PRD.CATALOG' * * THIS PROGRAM WAS DERIVED FROM A PROGRAM WRITTEN BY DAVE DEWOLF OF * FLORENCE, AL AT CHEM-HAULERS, INC. DAVE NO LONGER IS IN DATA * PROCESSING AND CHEM-HAULERS WAS PURCHASED AND DISSOLVED AROUND 1982. * THE ORIGINAL PROGRAM DISPLAYED ANY INPUT CARDS ON THE CONSOLE, IT * DISPLAYED ANY MESSAGES RETURNED FROM IDCAMS ON THE CONSOLE, AND IT * PREVENTED ANY SYSLST OUTPUT FROM BEING DISPLAYED UNLESS AN UPSI WAS * SET. I TELL YOU THAT, SO YOU WILL KNOW SOME OF THE POTENTIALS THAT * THIS PROGRAM HAS. AND TO GIVE CREDIT TO THE ORIGINAL AUTHOR. * * IN 1998, I RESURRECTED THIS PROGRAM, REMOVED THE ORIGINAL FUNCTIONS, * AND ADDED THE PARM SUBSTATION LOGIC. SOME OF WHICH WAS DERIVED FROM * EXAMPLES THAT SHOULD BE CREDITED TO LEO LANGEVIN. * * THIS CODE IS MEANT AS AN EXAMPLE. USE AT YOUR OWN RISK. IT'S * FUNCTIONALITY SHOULD BE VERIFIED BE BEING USED IN A PRODUCTION * SITUATION. * * IF YOU WISH TO CONTACT ME ABOUT THIS PROGRAM, I CAN BE FOUND ON * THE VSE-L LIST. * TONY THIGPEN * * NOW ON TO THE REAL CODE: * * THE FOLLOWING CODE IS THE MAINLINE PORTION OF THE PROGRAM, WHICH * LOADS THE IDCAMS UTILITY AND TRANSFERS CONTROL TO IT. * * REVISION 1: VARIABLE SUBSTUTION WAS STOPING AT THE FIRST OCCURACE OF * A BLANK IN THE VARIABLE VALUE. 3/22/02 * IDCAMSV START 0 BALR R12,0 ESTABLISH ADDRESSABILITY OF USING *,R12 MAINLINE PROGRAM. PRGBASE EQU * B START1 . MYNAME DC C'IDCAMSV ' . START1 CDLOAD IDCAMS LOAD VSAM IDCAMS UTILITY. LA R1,6(0,R1) INCREMENT IDCAMS ENTRY BY 6. LR R15,R1 POINT R15 TO IDCAMS ENTRY ADDRESS. LA R1,IDCMARGS POINT R1 TO IDCAMS ARGUMENT LIST. LA R13,SAVEAREA POINT R13 TO SUBROUTINE SAVE AREA. BALR R14,R15 BRANCH TO IDCAMS UTILITY. * RETURN TO SUPERVISOR AFTER IDCAMS C R15,=F'16' CHECK RETURN CODE FOR CODE 16 BE SYSIPT18 BRANCH TO ERROR 16 ROUTINE EOJ RC=(15) HAS BEEN EXECUTED. * * DATA AND CONSTANT AREA - MAINLINE PROGRAM * DDSYSIPT DC C'DDSYSIPT ' CONSTANT TO SPECIFY IDCAMS I/O MGMT. * IDCMARGS DS 0F MAP ARGUMENTS ON FULL WORD BOUNDARY. DC A(OPTIONS) ADDRESS OF 'PARMS' OPTIONS LIST. DC A(DNAMES) ADDRESS OF 'DNAMES' LIST (MUST BE * SET TO ZERO FOR DOS/VSE). DC A(PAGENO) ADDRESS OF PAGE NUMBER LIST. DC A(IOLIST) ADDRESS OF I/O LIST. ORG *-4 (INDICATES DC X'80' END OF ORG *+3 ARGUMENT LIST.) * DNAMES DC H'0' (NO DNAMES SPECIFIED). * IOLIST DC F'1' ONE I/O LIST ENTRY SPECIFIED. DC A(DDSYSIPT) ADDRESS OF CONSTANT FOR SYSIPT. DC A(SYSIPT) ADDRESS OF SYSIPT I/O ROUTINE. DC A(DDSYSIPT) USED BY I/O ROUTINE TO FIGURE OUT * WHICH FUNCTION IT IS PROCESSING. * OPTIONS DC H'0' OPTIONS NOT USED BY THIS PROGRAM. PAGENO DC H'4' LENGTH OF PAGE NUMBER FIELD DC C'0000' INITIAL VALUE OF PAGE NUMBER SAVEAREA DS 18F SAVE AREA USED BY IDCAMS * * * THE FOLLOWING CODE IS THE INPUT/OUTPUT ROUTINE WHICH INTERCEPTS * THE SYSIPT INPUT FOR IDCAMS AND REPLACES THE PARMS. * SYSIPT SAVE (0,12) SAVE IDCAMS REGISTERS. *********************************************************************** BALR R12,0 ESTABLISH SYSIPTET SR R11,R11 ADDRESSABILITY LA R11,(SYSIPTET-PRGBASE) OF SYSIPT SR R12,R11 ENTRY POINT. *********************************************************************** STM R13,R14,R13R14SV SAVE REGISTERS 13-14 FOR RETURN. LA R13,LSCALLRG POINT REGISTER 13 TO THIS ENTRY'S * SAVE AREA FOR CALLS TO OTHER S/R'S. LR R5,R1 SET UP PARAMETER LIST ADDRESS IN R5. L R2,0(R5) GET USER DATA ADDRESS CLC =CL8'DDSYSIPT',0(R2) IS THIS A CALL TO SYSIPT I/O? BE SYSIPT01 YES, CONTINUE TESTING. MVC ABEND3MS,=CL20'NO SYSIPT ENT' NO, CANCEL JOB W/ * CALL TO 'ABEND3'. * SYSIPT00 EQU * COMMON CALL TO CANCEL JOB. STM R0,R1,R0R1SAVE PDUMP ABEND3MS,ENDPROG LM R0,R1,R0R1SAVE B SYSIPT03 * SYSIPT01 EQU * L R2,4(R5) GET I/O FLAGS ADDRESS CLI 0(R2),X'00' IS THIS AN OPEN OPERATION? BNE SYSIPT04 NO, CONTINUE TESTING. NI 1(R2),X'80' YES, MASK OUT BITS. CLI 1(R2),X'80' IS THIS AN INPUT OPERATION? BE SYSIPT02 YES, OPEN FILES MVC ABEND3MS,=CL20'SYSIPT NT O/P' NO, CANCEL JOB W/ B SYSIPT00 CALL TO 'ABEND3'. * SYSIPT02 EQU * OPEN SYSINPT OPEN SYSIPT DEVICE FILE. MVI IPTOPEN,C'Y' INDICATE SYSIPT IS OPEN. * * ('SYSIPT03' IS A COMMON RETURN TO CALLING ROUTINE.) * SYSIPT03 EQU * RETURN TO CALLER ROUTINE LM R13,R14,R13R14SV L R15,R15RETCD MVC R15RETCD,=F'0' RETURN (0,12) * SYSIPT04 EQU * CLI 0(R2),X'04' TEST FOR CLOSS PROCESSING BNE SYSIPT05 CLOSE SYSINPT MVI IPTOPEN,C'N' B SYSIPT03 * SYSIPT05 EQU * CLI 0(R2),X'08' TEST FOR READ OPERATION BE SYSIPT06 MVC ABEND3MS,=CL20'BAD SYSIPT ACT' B SYSIPT00 * SYSIPT06 EQU * SET UP TO MOVE CARDIN TO CARDOUT MVC CARDOUT,CSPACE CLEAR CARD OUT TO SPACES GET SYSINPT GET SYSIPT RECORD LA R6,CARDIN SET POINTERS FOR INPUT AREA LA R7,CARDIN+72 LA R8,CARDOUT SET POINTERS FOR OUTPUT AREA LA R9,CARDOUT+72 SYSIPT07 EQU * CLI 0(R6),C'&&' IS THIS THE START OF A PARM NAME? BE SYSIPT08 MVC 0(1,R8),0(R6) NO, LETS MOVE AND BUMP POINTERS LA R6,1(R6) LA R8,1(R8) CR R8,R9 END OF OUTPUT? BE SYSIPT16 CR R6,R7 END OF INPUT? BE SYSIPT16 B SYSIPT07 CONTINUE LOOKING FOR PARMS SYSIPT08 EQU * SET UP FOR PARM NAME MOVE LA R6,1(R6) POINT TO NEXT CHARACTER AFTER & MVC PARMNAME,PNSPACE LA R10,PARMNAME LA R11,PARMNAME+72 SYSIPT09 EQU * CLI 0(R6),C'.' CHECK FOR PARM END CHARACTER BE SYSIPT11 CLI 0(R6),C'@' CHECK FOR PARM END DELIMITER BE SYSIPT10 @,#,$,A-Z,0-9 ARE GOOD CHARACTERS CLI 0(R6),C'#' BE SYSIPT10 CLI 0(R6),C'$' BE SYSIPT10 CLI 0(R6),C'A' BL SYSIPT12 CLI 0(R6),C'9' BH SYSIPT12 CLI 0(R6),C'Z' BNH SYSIPT10 CLI 0(R6),C'0' BL SYSIPT12 SYSIPT10 EQU * MOVE PARM NAME CHARACTERS MVC 0(1,R10),0(R6) LA R6,1(R6) POINT TO NEXT CHARACTER IN LA R10,1(R10) POINT TO NEXT PARM CHARACTER CR R6,R7 END OF INPUT? BE SYSIPT12 CR R10,R11 END OF PARM AREA? BE SYSIPT12 B SYSIPT09 SYSIPT11 EQU * LA R6,1(R6) INCREMENT AROUND ENDING PERIOD SYSIPT12 EQU * GET PARM VALUE MVC PARMINFO,PSPACE MVC PARMLONG(2),=H'50' LOAD $IJBPROC LR R15,R1 LA R1,PARMCNTL BALR R14,R15 LTR R15,R15 BZ SYSIPT14 CH R15,=H'16' BE SYSIPT13 STM R0,R1,R0R1SAVE BAD PARM RETURN PDUMP ABEND3MS,ENDPROG LM R0,R1,R0R1SAVE MVC CARDOUT(72),CARDIN MOVE CARD WITHOUT CHANGES B SYSIPT16 SYSIPT13 EQU * MVI PARMINFO,C'&&' NO PARM FOUND SO SUBSTUTE THE MVC PARMINFO+1(50),PARMNAME PARM NAME BACK IN WITH THE '&' BCTR R6,0 AND IF A '.' WAS THE END CHARACTER CLI 0(R6),C'.' BACKUP THE INPUT BUFFER 1 POS BE SYSIPT14 LA R6,1(R6) SYSIPT14 EQU * SETUP TO MOVE PARM VALUE LA R10,PARMINFO * LA R11,PARMINFO+50 ..REMOVED 3/22/02 LR R11,R10 ..ADDED 3/22/02 AH R11,PARMLONG ..ADDED 3/22/02 SYSIPT15 EQU * * CLI 0(R10),C' ' ..REMOVED 3/22/02 * BE SYSIPT07 ..REMOVED 3/22/02 MVC 0(1,R8),0(R10) LA R10,1(R10) POINT TO NEXT CHARACTER IN LA R8,1(R8) POINT TO NEXT CHARACTER OUT CR R8,R9 END OF OUTPUT? BE SYSIPT16 CR R10,R11 END OF PARM AREA BE SYSIPT07 B SYSIPT15 SYSIPT16 EQU * MVC CARDOUT+72(8),CARDIN+72 MOVE SEQUENCE NUMBERS L R2,8(R5) LOAD R2 WITH PARAMETER LIST ADDRESS. MVC 0(4,R2),CARDADDR CARDOUT ADDRESS TO CALLER'S LIST. MVC 4(4,R2),=F'80' CARDOUT LENGTH TO CALLER'S LIST. B SYSIPT03 RETURN TO CALLER. * * END OF FILE ROUTINE FOR SYSIPT DEVICE. * SYSIPT17 EQU * MVC R15RETCD,=F'4' INDICATE END OF FILE FOR SYSIPT. B SYSIPT03 RETURN TO CALLER. * * SYSIPT18 EQU * MVC ABEND3MS,=CL20'IDCAMS CANCEL' CANCEL JOB W/ B SYSIPT00 CALL TO 'ABEND3'. * * * DATA AND CONSTANT AREA - SYSLST I/O ROUTINE * ABEND3MS DC CL20'NO CARDOUT' ABEND3 CARDOUT IPTOPEN DC C'N' SYSIPT OPEN SWITCH. DS 0F ALIGN ON FULL WORD BOUND. LSCALLRG DS 18F I/O ROUTINES REGISTER SAVE AREA. PNSPACE DC C' ' PARMNAME DC CL72' ' PARMCNTL DC X'01000000',AL4(PARMNAME),AL4(PARMINFO),AL4(PARMLONG) PARMPASS DS 0CL52 PARMLONG DS H PSPACE DC C' ' PARMINFO DC CL50' ' CSPACE DC C' ' SPACE CONSTANT. CARDOUT DS CL80 CARDOUT AREA. CARDADDR DC A(CARDOUT) ADDRESS OF CARDOUT AREA DS 0F ALIGN ON FULL WORD BOUND. CARDIN DS CL80 CARD INPUT AREA DS CL8'*R0R1SV*' R0R1SAVE DS 2F REGISTERS 0-1 SAVE AREA. R13R14SV DS 2F REGISTERS 13-14 SAVE AREA. R15RETCD DC 1F'0' R15 RETURN CODE SAVE AREA. DS 0F ALIGN ON FULL WORD BOUND. * * DUMP ROUTINE USED FOR TEST PURPOSES ONLY. * DUMPIT STM R0,R1,R0R1SAVE SAVE REGISTERS 0-1 PDUMP ABEND3MS,ENDPROG DUMP DATA AND DTF AREAS LM R0,R1,R0R1SAVE RESTORE REGISTERS 0-1 BR R7 RETURN TO CALLER * * REGISTER USEAGE (BOTH FOR MAINLINE AND I/O ROUTINES) * R0 EQU 0 R1 EQU 1 POINTS TO PARAMETER LIST * FOR SUBROUTINE CALLS. R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 ADDRESS OF IDCAMS PARAMETER LIST R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 BASE REGISTER FOR THIS PROGRAM R13 EQU 13 POINTS TO SAVE AREA FOR REGISTERS R14 EQU 14 RETURN ADDRESS OF CALLING PROGRAM R15 EQU 15 ENTRY POINT OF SUBROUTINE * * DTF MACROS FOR SYSLOG, SYSLST, SYSIPT * SYSINPT DTFDI DEVADDR=SYSIPT, X IOAREA1=CARDIN, X RECSIZE=80, X EOFADDR=SYSIPT17 * LTORG MAP LITERAL POOL HERE * ENDPROG DC C'IDCAMSV PROG END' DUMMY TAG FOR DUMP COMMAND * END