See attached source.
I purposefully kept it as simple as I could. I don't like complicated
stuff during IPL or shutdown. I also know that someone following me that
has to maintain the program would prefer that I did things simply.
Tony Thigpen
Nai, Dean wrote on 3/10/20 9:23 AM:
The assembler code would be great:
dean....@doit.nh.gov
On 3/10/20, 9:17 AM, "IBM Mainframe Discussion List on behalf of Tony Thigpen"
<IBM-MAIN@LISTSERV.UA.EDU on behalf of t...@vse2pdf.com> wrote:
EXTERNAL: Do not open attachments or click on links unless you recognize and
trust the sender.
I wrote a very small command processor that simple reads a script and
follows it for shutdown or IPL. I does have the ability to make sure a
product is fully down before continuing. The script is very simple. Here
is the script for shutdown:
ASK YES REPLY 'YES' IF YOU WANT TO CONTINUE SHUTDOWN
* ? IS PREFIX FOR TSSO
OPCMD ?.RELOAD HUP1DN
PAUSE 010
OPCMD F JQP,STATS
OPCMD P FFST
OPCMD VARY NET,INACT,ID=VDR,FORCE
OPCMD MODIFY DLF,MODE=QUIESCE
OPCMD P ENF
OPCMD $PI
PAUSE 010
OPCMD D OMVS,A=ALL
OPCMD D OMVS,U=OMVSKERN
PAUSE 010
OPCMD F OMVS,PPFS=ZFS
OPCMD $PLOGON1
PAUSE 010
OPCMD F BPXOINIT,SHUTDOWN=FORKS
PAUSE 010
OPCMD F BPXOINIT,SHUTDOWN=FORKINIT
PAUSE 010
OPCMD0 F CICSPTE2,CESN USERID=OPERACS,PS=XXXXXXXX
OPCMD0 F CICSPTE2,CEMT P SHUT
WAITDOWN 030 CICSPTE2
OPCMD P CNDLINIT
OPCMD /DBR DB ALL
OPCMD #DBR DB ALL
PAUSE 015
* / IS PREFIX FOR IMS PROD
OPCMD /CHE FREEZE
* # IS PREFIX FOR IMS DEVP
OPCMD #CHE FREEZE
WAITDOWN 010 DBCPDBRC
WAITDOWN 010 DBCPDLI
WAITDOWN 010 DBCPBC
WAITDOWN 010 DBCTDBRC
WAITDOWN 010 DBCTDLI
WAITDOWN 010 DBCTBC
OPCMD P RMM
OPCMD P DFSMSHSM
OPCMD P DSSUMON
OPCMD P JCLARCHP
PAUSE 010
OPCMD P JCLARCH
OPCMD MODIFY JQP,SHUT
OPCMD P LLA
OPCMD %P
OPCMD MODIFY RMF,P III
OPCMD P SDSF
PAUSE 010
OPCMD P LPSERVE
OPCMD P FTPD
OPCMD F ESF,PNET
OPCMD F ESF,SHUTDOWN
OPCMD P TSO
OPCMD P DLF
OPCMD P VLF
OPCMD P RMF
PAUSE 010
OPCMD $P I
OPCMD $P LINE(1-10)
OPCMD C APPC
PAUSE 010
OPCMD C LPSERVE
OPCMD C FTPD
PAUSE 010
OPCMD %STOP
PAUSE 010
OPCMD $E LINE(1-10)
WAITDOWN 010 APPC
WAITDOWN 010 CNDLINIT
WAITDOWN 010 DBCPDBC
WAITDOWN 010 DBCPDBRC
WAITDOWN 010 DBCPDLI
WAITDOWN 010 DBCTDBC
WAITDOWN 010 DBCTDBRC
WAITDOWN 010 DBCTDLI
WAITDOWN 010 DFSMSHSM
WAITDOWN 010 DLF
WAITDOWN 010 DSSUMON
WAITDOWN 010 ENF
WAITDOWN 010 EPWFFST
WAITDOWN 010 ESF
WAITDOWN 010 FTPD
WAITDOWN 010 JCLARCH
WAITDOWN 010 JCLARCHP
WAITDOWN 010 LLA
WAITDOWN 010 LPSERVE
WAITDOWN 010 RACF
WAITDOWN 010 RMF
WAITDOWN 010 RMFGAT
WAITDOWN 010 RMM
WAITDOWN 010 SDSF
WAITDOWN 010 TCPIP
WAITDOWN 010 TSO
WAITDOWN 010 VDR
WAITDOWN 010 VLF
OPCMD D A,L
* ? IS PREFIX FOR TSSO
OPCMD ?.P
OPCMD Z NET,QUICK
WAITDOWN 010 TSSO
WAITDOWN 010 NET
OPCMD $T U,ALL
OPCMD $P JES2
PAUSE 010
OPCMD $P JES2,QUICK
PAUSE 010
WAITDOWN 010 JES2
I am able to share the basic assembler code. There is nothing fancy in it.
Tony Thigpen
Nai, Dean wrote on 3/10/20 8:20 AM:
Currently we use CAS9 to start and stop everything during an IPL. CA will be
going away so I was wondering if anyone had thoughts on other cheap or free
products that will do that until we are off Z/OS. Maybe something on the CBT
tape?
Dean Nai
On 3/10/20, 7:56 AM, "IBM Mainframe Discussion List on behalf of Peter Relson"
<IBM-MAIN@LISTSERV.UA.EDU on behalf of rel...@us.ibm.com> wrote:
EXTERNAL: Do not open attachments or click on links unless you recognize and
trust the sender.
Ah, the "return code 4" smoking gun. I'm with you now...
Peter Relson
z/OS Core Technology Design
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to lists...@listserv.ua.edu with the message: INFO IBM-MAIN
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to lists...@listserv.ua.edu with the message: INFO IBM-MAIN
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to lists...@listserv.ua.edu with the message: INFO IBM-MAIN
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to lists...@listserv.ua.edu with the message: INFO IBM-MAIN
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to lists...@listserv.ua.edu with the message: INFO IBM-MAIN
TITLE 'JOBZDOIT - PROCESS A PARMLIB SCRIPT'
*
* AUTHOR: TONY THIGPEN
* THIPGEN ENTERPRISES, INC.
* WINTER HAVEN, FL
* 407-474-0770
* t...@thigpens.com
*
* DATE: 03/18/2018
*
* COPYRIGHT 2018-2020 TONY THIGPEN. ALL RIGHTS RESERVERD.
*
* PERMISSION TO USE, COPY, MODIFY, AND DISTRIBUTE THIS SOFTWARE
* AND ITS DOCUMENTATION FOR EDUCATIONAL, RESEARCH, AND NOT-FOR-PROFIT
* PURPOSES, WITHOUT FEE AND WITHOUT A SIGNED LICENSING AGREEMENT,
* IS HEREBY GRANTED, PROVIDED THAT THE ABOVE COPYRIGHT NOTICE, THIS
* PARAGRAPH AND THE FOLLOWING TWO PARAGRAPHS APPEAR IN ALL COPIES,
* MODIFICATIONS, AND DISTRIBUTIONS.
*
* IN NO EVENT SHALL TONY THIGPEN BE LIABLE TO ANY PARTY FOR DIRECT,
* NDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES, INCLUDING
* LOST PROFITS, ARISING OUT OF THE USE OF THIS SOFTWARE, AND IT'S
* DOCUMENTATION, EVEN IF TONY THIGPEN HAS BEEN ADVISED OF THE
* POSSIBILITY OF SUCH DAMAGE.
*
* TONY THIGPEN SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING,
* BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
* AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE AND
* ACCOMPANYING DOCUMENTATION, IF ANY, IS PROVIDED "AS IS". TONY
* THIGPEN HAS NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES,
* ENHANCEMENTS, OR MODIFICATIONS.
*
* USAGE:
* CARD INPUT CONTAINS:
* 1-8 ACTION:
* 'ASK ' PROMPT THE OPERATOR WITH THE MESSAGE IN 12-19.
* IF THE ANSWER EXACTLY MATCHES 9-11, THE THE
* PROGRAM WILL CONTINUE PROCESSING. ANY MIS-
* MATCH OF THE ANWSER WILL CASE THE PROGRAM TO
* DISCONTINUE PROCESSING OF COMMANDS.
* 'EXIT ' DISCONTINUE PROCESSING OF COMMANDS. USED FOR
* TESTING.
* 'OPCMD ' ISSUE CONSOLE COMMAND IN 9-71.
* 'OPCMD0 ' ISSUE CONSOLE COMMAND IN 9-71 FROM CONSID=0.
* 'PAUSE ' WAIT SECONDS SPECIFIED IN 9-11.
* 'WAITDOWN' WAIT FOR JOB IN 12-19 TO SHUT DOWN. CHECK
* ONCE EVERY N SECONDS SPECIFIED IN 9-11.
* 'WAITUP ' WAIT FOR JOB IN 12-19 TO BE STARTED. CHECK
* ONCE EVERY N SECONDS SPECIFIED IN 9-11.
* 'WAITVTAM' WAIT UNTIL A CONNECTION TO THE APPLID
* SPECIFICED IN 12-19 CAN BE ESTABLISHED. THE
* DEFAULT OF 'VTAMISUP' WILL BE USED IF SPACES.
* CHECK ONCE EVER N SECONDS SPECIFIED IN 9-11.
* 9-71 PARMS, AS DESCRIBED ABOVE.
*
* USAGE NOTES:
* ALL USE OF SECONDS IN 9-11 REQUIRE THREE NUMERICAL DIGITS. NO
* EDITING IS PERFORMED. INVALID DATA MAY CAUSE PROGRAM EXCEPTIONS.
* COMMENTS CARDS ARE ANY CARD WITH '*' IN THE FIRST POSITION.
*
* EXAMPLES (SHIFTED RIGHT 3 POSITIONS):
* THE FOLLOWING IS A PARTIAL SHUTDOWN SCRIPT
* ASK YES REPLY 'YES' IF YOU WANT TO CONTINUE SHUTDOWN
* OPCMD P RMM
* WAITDOWN 010 RMM
* OPCMD Z NET,QUICK
* WAITDOWN 010 NET
* OPCMD $T U,ALL
* OPCMD $P JES2
* PAUSE 010
* OPCMD $P JES2,QUICK
* PAUSE 010
* WAITDOWN 010 JES2
*
* THE FOLLOIWNG IS A PARTIAL STARTUP SCRIPT
* OPCMD S DLF,SUB=MSTR
* PAUSE 020 ALLOW JES2 TIME TO COME UP
* OPCMD S RMM
* OPCMD S DFSMSHSM
* PAUSE 010
* * THE FOLLOWING VERIFIES THAT JES2 IS UP
* WAITUP 010 RMM
* OPCMD S NET,,,(LIST=00)
* PAUSE 010
* WAITUP 010 NET
* WAITVTAM 010
* OPCMD S RMF.RMF,,,MEMBER(00)
* OPCMD S SDSF
* PAUSE 010
* OPCMD S TSO
* PAUSE 010
* OPCMD S TCPIP
* OPCMD S TN3270E
* PAUSE 020
* ASK YES REPLY 'YES' TO START DATABASES
* OPCMD S ADAPROD
* PAUSE 020
* OPCMD S ADATEST
* PAUSE 020
* ASK YES REPLY 'YES' TO START CICS'S
* OPCMD S CICSP
* PAUSE 020
* OPCMD S CICSD
* WAITUP 010 CICSP
* WAITUP 010 CICSD
*
* THE FOLLOWING ARE EXAMPLE PROCS:
* 'SYS1.PROCLIB(SHUTDOWN)'
* //SHUTHKYP PROC MEM='JOBZIPLD'
* //COMAND00 EXEC PGM=JOBZDOIT,REGION=3000K,TIME=50
* //CARDS DD DSN=SYS1.PARMLIB(&MEM),DISP=SHR
* //
*
* TO SHUTDOWN USING THE ABOVE SCRIPT, THE OPERATOR ISSUES:
*
* S SHUTDOWN,SUB=MSTR
*
* 'SYS1.PROCLIB(STARTUP)'
* //STRTHKYP PROC MEM='JOBZIPLU'
* //COMAND00 EXEC PGM=JOBZDOIT,REGION=3000K,TIME=50
* //CARDS DD DSN=SYS1.PARMLIB(&MEM),DISP=SHR
* //
*
* TO SHUTDOWN USING THE ABOVE SCRIPT, PLACE IN COMMMD00:
* COM='START STRTHKYP,SUB=MSTR'
*
* JOBZDOIT CAN ALSO BE USED IN NORMAL JOBS:
* //COMAND00 EXEC PGM=JOBZDOIT,REGION=3000K,TIME=50
* //CARDS DD *
* OPCMD0 V 084,CONSOLE
* //
*
R0 EQU 0
R1 EQU 1
R2 EQU 2
R3 EQU 3
R4 EQU 4
R5 EQU 5
R6 EQU 6
R7 EQU 7
R8 EQU 8
R9 EQU 9
R10 EQU 10
R11 EQU 11
R12 EQU 12
R13 EQU 13
R14 EQU 14
R15 EQU 15
JOBZDOIT CSECT
JOBZDOIT AMODE 24
JOBZDOIT RMODE 24
STM R14,R12,12(R13) SAVE REGISTERS
LR R12,R15 LOAD MY BASE REGISTER
USING JOBZDOIT,R12
L R0,=A(WORKLL) LENGTH OF WORK AREA
GETMAIN RU,LV=(0),LOC=BELOW
ST R13,4(R1) SAVE BACK CHAIN
ST R1,8(R13) SAVE FORWARD CHAIN
L R1,24(R13) RESTORE REG1
L R13,8(R13) POINT TO MY SAVE AREA
USING WORKAREA,R13
GETMYNAME DS 0H
L R10,X'021C' CURRENT TCB
L R10,12(,R10) POINT TO TIOT
MVC MYJOB,0(R10) POPULATE JOB-NUMBER
OPEN (CARD,INPUT)
READIT DS 0H
GET CARD,INCARD
CLI ACTION,C'*'
BE READIT
CLC ACTION,=CL8'ASK '
BE ASK_
MVC WS_WTOAREA,CMD_WTO
MVC WS_WTOAREA+4(8),MYJOB
MVC WS_WTOAREA+17(L'INCARD),INCARD
WTO MF=(E,WS_WTOAREA)
CLC ACTION,=CL8'OPCMD '
BE OPCMD_
CLC ACTION,=CL8'OPCMD0 '
BE OPCMD0_
CLC ACTION,=CL8'PAUSE '
BE PAUSE_
CLC ACTION,=CL8'WAITDOWN'
BE WAITDOWN_
CLC ACTION,=CL8'WAITUP '
BE WAITUP_
CLC ACTION,=CL8'WAITVTAM'
BE WAITVTAM_
CLC ACTION,=CL8'EXIT '
BE EXIT_
MVC WS_WTOAREA,CMD_BAD
MVC WS_WTOAREA+4(8),MYJOB
WTO MF=(E,WS_WTOAREA)
B READIT
OPCMD_ DS 0H
MVC CONCMD,COMMAND
LA R1,L'CONCMD
STH R1,CONCMDL
LA R1,0
STH R1,CONCMDL0
MVC CONCMDL0,CONCMDL
LA R2,CONCMDL0
MODESET MODE=SUP,KEY=ZERO
LA R1,CONCMDS
SR R0,R0 CLEAR FOR SVC 34
SVC 34 ISSUE THE COMMAND
MODESET MODE=PROB,KEY=NZERO
OC_EXIT DS 0H
B READIT
OPCMD0_ DS 0H
MVC CONCMD,COMMAND
LA R1,L'CONCMD
STH R1,CONCMDL
LA R1,0
STH R1,CONCMDL0
MVC CONCMDL0,CONCMDL
LA R2,CONCMDL0
MVC WS_MGAREA,C0_MGCRE
MODESET MODE=SUP,KEY=ZERO
MGCRE MF=(E,WS_MGAREA),TEXT=(R2),CONSID=ZERO
MODESET MODE=PROB,KEY=NZERO
OC0_EXIT DS 0H
B READIT
PAUSE_ DS 0H
CLC SECONDS,SPACES
BNE PA_WAIT
MVC SECONDS,=C'010'
PA_WAIT DS 0H
MVC SECS_Z,=C'000XXX00' ALSO ADDS SUBSECS AS ZEROS
MVC SECS_Z+3(3),SECONDS
PACK SECS_P,SECS_Z
CVB R1,SECS_P
ST R1,SECS_B
STIMER WAIT,BINTVL=SECS_B
PA_EXIT DS 0H
B READIT
WAITDOWN_ DS 0H
CLC SECONDS,SPACES
BNE WD_SCAN
MVC SECONDS,=C'010'
WD_SCAN DS 0H
*******************************************************************
* POINT TO ASVT
*******************************************************************
L R2,CVTPTR POINT TO CVT - X'10'
USING CVT,R2 MAP CVT
L R2,CVTASVT POINT TO ASVT
DROP R2 TELL ASMBLR TO STOP USING R2 FOR CVT
USING ASVT,R2 MAP ASVT
LA R4,ASVTENTY POINT TO FIRST ENTRY IN TABLE
L R3,ASVTMAXU LOAD MAX NUMBER OF ENTRIES
*******************************************************************
* THIS ROUTINE CHECKS EACH ASVT ENTRY.
* IF THE HIGH ORDER BIT IS ON, THE ENTRY IS THE ADDRESS OF THE
* NEXT AVAILABLE ASID (OR THE LAST ENTRY IF ZEROS).
* IF THE HIGH ORDER BIT IS NOT ON, THE ENTRY IS THE ADDRESS
* OF THE ASCB FOR THAT ENTRY.
*******************************************************************
WD_LOOP TM 0(R4),ASVTAVAL IS THIS AN ASCB ADDRESS ?
BO WD_NEXT
*******************************************************************
* WE HAVE A VALID ASCB ADDRESS - CHECK IT
*******************************************************************
WD_ASCB DS 0H
L R10,0(R4) POINT TO ASCB
USING ASCB,R10 MAP IT
L R5,ASCBJBNI POINT TO JOBNAME
CL R5,=F'0' WAS THIS A START/MOUNT/LOGON ?
BE WD_STC YES, BRANCH
CLC JOBNAME,0(R5) IS IT THE ASCB OF JOB ON THE PARM?
BE WD_UP YES, BRANCH
B WD_NEXT
WD_STC DS 0H
L R5,ASCBJBNS POINT TO START/MOUNT/LOGON NAME
CLC JOBNAME,0(R5) IS IT THE ASCB OF JOB ON THE PARM?
BE WD_UP YES, BRANCH
WD_NEXT DS 0H
LA R4,4(,R4) NO, POINT TO NEXT ENTRY IN ASVT
BCT R3,WD_LOOP GO CHECK NEXT ASVT ENTRY
DROP R10
WD_DOWN DS 0H
MVC WS_WTOAREA,WD_WTO1
MVC WS_WTOAREA+4(8),MYJOB
MVC WS_WTOAREA+17(8),JOBNAME
WTO MF=(E,WS_WTOAREA)
B WD_EXIT
WD_UP DS 0H
MVC WS_WTOAREA,WD_WTO2
MVC WS_WTOAREA+4(8),MYJOB
MVC WS_WTOAREA+25(8),JOBNAME
WTO MF=(E,WS_WTOAREA)
MVC SECS_Z,=C'000XXX00' ALSO ADDS SUBSECS AS ZEROS
MVC SECS_Z+3(3),SECONDS
PACK SECS_P,SECS_Z
CVB R1,SECS_P
ST R1,SECS_B
STIMER WAIT,BINTVL=SECS_B
B WD_SCAN
WD_EXIT DS 0H
B READIT
WAITUP_ DS 0H
CLC SECONDS,SPACES
BNE WU_SCAN
MVC SECONDS,=C'010'
WU_SCAN DS 0H
*******************************************************************
* POINT TO ASVT
*******************************************************************
L R2,CVTPTR POINT TO CVT - X'10'
USING CVT,R2 MAP CVT
L R2,CVTASVT POINT TO ASVT
DROP R2 TELL ASMBLR TO STOP USING R2 FOR CVT
USING ASVT,R2 MAP ASVT
LA R4,ASVTENTY POINT TO FIRST ENTRY IN TABLE
L R3,ASVTMAXU LOAD MAX NUMBER OF ENTRIES
*******************************************************************
* THIS ROUTINE CHECKS EACH ASVT ENTRY.
* IF THE HIGH ORDER BIT IS ON, THE ENTRY IS THE ADDRESS OF THE
* NEXT AVAILABLE ASID (OR THE LAST ENTRY IF ZEROS).
* IF THE HIGH ORDER BIT IS NOT ON, THE ENTRY IS THE ADDRESS
* OF THE ASCB FOR THAT ENTRY.
*******************************************************************
WU_LOOP TM 0(R4),ASVTAVAL IS THIS AN ASCB ADDRESS ?
BO WU_NEXT
*******************************************************************
* WE HAVE A VALID ASCB ADDRESS - CHECK IT
*******************************************************************
WU_ASCB DS 0H
L R10,0(R4) POINT TO ASCB
USING ASCB,R10 MAP IT
L R5,ASCBJBNI POINT TO JOBNAME
CL R5,=F'0' WAS THIS A START/MOUNT/LOGON ?
BE WU_STC YES, BRANCH
CLC JOBNAME,0(R5) IS IT THE ASCB OF JOB ON THE PARM?
BE WU_UP YES, BRANCH
B WU_NEXT
WU_STC DS 0H
L R5,ASCBJBNS POINT TO START/MOUNT/LOGON NAME
CLC JOBNAME,0(R5) IS IT THE ASCB OF JOB ON THE PARM?
BE WU_UP YES, BRANCH
WU_NEXT DS 0H
LA R4,4(,R4) NO, POINT TO NEXT ENTRY IN ASVT
BCT R3,WU_LOOP GO CHECK NEXT ASVT ENTRY
DROP R10
WU_DOWN DS 0H
MVC WS_WTOAREA,WU_WTO2
MVC WS_WTOAREA+4(8),MYJOB
MVC WS_WTOAREA+25(8),JOBNAME
WTO MF=(E,WS_WTOAREA)
MVC SECS_Z,=C'000XXX00' ALSO ADDS SUBSECS AS ZEROS
MVC SECS_Z+3(3),SECONDS
PACK SECS_P,SECS_Z
CVB R1,SECS_P
ST R1,SECS_B
STIMER WAIT,BINTVL=SECS_B
B WU_SCAN
WU_UP DS 0H
MVC WS_WTOAREA,WU_WTO1
MVC WS_WTOAREA+4(8),MYJOB
MVC WS_WTOAREA+17(8),JOBNAME
WTO MF=(E,WS_WTOAREA)
B WU_EXIT
WU_EXIT DS 0H
B READIT
WAITVTAM_ DS 0H
CLC SECONDS,SPACES
BNE WV_ACBNAME
MVC SECONDS,=C'010'
WV_ACBNAME DS 0H
MVI ACBLANE_L,X'08' ACBNAME LENGTH
MVC ACBNAME(8),=CL8'VTAMISUP'
CLI JOBNAME,C' '
BE WV_GENCB
MVC ACBNAME(8),JOBNAME ALLOW OVERRIDE ACBNAME
WV_GENCB DS 0H
LA R2,VTAMACB
LA R3,APPLID
GENCB BLK=ACB,AM=VTAM,APPLID=((R3)),MACRF=NLOGON, X
WAREA=((R2)),LENGTH=VTAMACB_L
LTR 15,15
BZ WV_SCAN
ABEND 001,DUMP
WV_SCAN DS 0H
LA R2,VTAMACB
OPEN ((2))
LTR R15,R15
BZ WV_UP
B WV_DOWN
WV_UP DS 0H
LA R2,VTAMACB
CLOSE ((2))
MVC WS_WTOAREA,WU_WTO3
MVC WS_WTOAREA+4(8),MYJOB
WTO MF=(E,WS_WTOAREA)
B WV_EXIT
WV_DOWN DS 0H
MVC WS_WTOAREA,WD_WTO3
MVC WS_WTOAREA+4(8),MYJOB
WTO MF=(E,WS_WTOAREA)
MVC SECS_Z,=C'000XXX00' ALSO ADDS SUBSECS AS ZEROS
MVC SECS_Z+3(3),SECONDS
PACK SECS_P,SECS_Z
CVB R1,SECS_P
ST R1,SECS_B
STIMER WAIT,BINTVL=SECS_B
B WV_SCAN
WV_EXIT DS 0H
B READIT
ASK_ DS 0H
MVC WS_WTOAREA,ASK_WTOR
MVC WS_WTOAREA+12(8),MYJOB
MVC WS_WTOAREA+21(L'PROMPT),PROMPT
XC ASK_ECB,ASK_ECB
LA R2,ASK_RPLY
LA R3,ASK_ECB
WTOR ,(R2),,(R3),MF=(E,WS_WTOAREA)
WAIT ECB=(R3)
OC ASK_RPLY,SPACES
CLC ANSWER,ASK_RPLY
BNE EXIT_
ASK_EXIT DS 0H
B READIT
EXIT_ DS 0H
EODINPUT DS 0H
CLOSE CARD
L R13,4(R13) RESTORE REG13 (CALLER'S AREA)
L R1,8(R13) MY SAVE AREA
L R0,=A(WORKLL) SET LENGTH
FREEMAIN RU,LV=(0),A=(1)
LM R14,R12,12(R13) RESTORE CALLER'S REGS
LA R15,0
BR R14 RETURN TO CALLER
DS 0F
CARD DCB DSORG=PS,RECFM=FB,LRECL=80,BLKSIZE=32000,DDNAME=CARDS, X
MACRF=(GM),EODAD=EODINPUT
ZERO DC A(0)
SPACES DC CL80' '
CMD_WTO WTO 'JOBZDOIT CMD= ',X
MF=L
CMD_BAD WTO 'JOBZDOIT INVALID REQUEST ',X
MF=L
WD_WTO1 WTO 'JOBZDOIT JOB XXXXXXXX IS DOWN ',X
MF=L
WD_WTO2 WTO 'JOBZDOIT WAITING FOR XXXXXXXX TO SHUTDOWN ',X
MF=L
WD_WTO3 WTO 'JOBZDOIT WAITING FOR VTAM TO START UP ',X
MF=L
WU_WTO1 WTO 'JOBZDOIT JOB XXXXXXXX IS UP ',X
MF=L
WU_WTO2 WTO 'JOBZDOIT WAITING FOR XXXXXXXX TO START UP ',X
MF=L
WU_WTO3 WTO 'JOBZDOIT VTAM IS UP ',X
MF=L
ASK_WTOR WTOR 'JOBZDOIT X
', X
0,3,0,ROUTCDE=(2),MF=L
C0_MGCRE MGCRE MF=L
LTORG
WORKAREA DSECT
SAVEAREA DS CL72
MYJOB DS CL8
*
INCARDL DC Y(80)
INCARD DS CL80
ORG INCARD
ACTION DS CL8
DS CL1
COMMAND DS 0CL(72-(*-INCARD))
ANSWER DS 0CL3
SECONDS DS CL3
DS CL1
PROMPT DS 0CL(72-(*-INCARD))
JOBNAME DS CL8
ORG
BLOCKER DS C' '
DS 0F
CONCMDS DS 0F
CONCMDL DS H
CONCMDL0 DS H
CONCMD DS CL(L'COMMAND)
DS 0F
SECS_Z DS CL8
SECS_P DS CL8
SECS_B DS CL4
APPLID DS 0XL9
ACBLANE_L DC XL1'08'
ACBNAME DC CL8'VTAMISUP' VTAM ACB NAME
VTAMACB ACB AM=VTAM,APPLID=APPLID,MACRF=NLOGON
VTAMACB_L EQU *-VTAMACB
ASK_ECB DC F'0'
ASK_RPLY DS CL3
DS 0F
WS_WTOAREA DS CL200
DS 0F
WS_MGAREA DS CL200
*
WORKLL EQU *-WORKAREA
CVT DSECT=YES
IHAASVT
IHAASCB
END JOBZDOIT
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to lists...@listserv.ua.edu with the message: INFO IBM-MAIN
