|
Code:
- H Copyright('(C) Copyright Group Dekko Services, LLC')
- H ActGrp(*CALLER)
- H DftActGrp(*NO)
- H ExprOpts(*RESDECPOS)
- H Bnddir('ROUTINES/SRVPGM':'QC2LE')
- H OPTION(*NODEBUGIO)
- ****************************************************************
- * Created By:
-
- * Group Dekko International Inc.
- * P.O. Box 2000
- * U.S. 6 and C.R. 400 E
- * Kendallville, IN 46755
-
- * CHGSCHJOB- Change Scheduled Jobs
-
- *--------------------------------------------------------------
- * LTS 02/15/07 Initial write
- * LTS 01/23/08 If a job being released missed a submit,
- * do a submit immeditate. Submitting these jobs
- * will require a high level of authority.
- * LTS01 03/12/13 Prevent library list errors on jobs submitted immediately.
-
- *--------------------------------------------------------------
- * This program is used to hold scheduled jobs before a MIMIX
- * failover. It is then used to release scheduled jobs after
- * the return to the normal production platform.
- * Only SCD and HLD status codes are of interest to this process.
- * Only jobs held by the current user can be released.
- ****************************************************************
- * 1. Process by *ALL, or a Job name. (Wildcard * is valid as
- * (Wildcard * is valid as the last character of a job name.)
- * 2. Commands can be Hold, Release, or Purge List.
- * 3. Process the job list using the user index.
- * (The file will only contain jobs placed on hold by this process.)
- * A. Holding Jobs
- * 1). Hold the schedule entry
- * 2). Updated the list
- * B. Releasing Jobs that are on the list.
- * 1). Restore status
- * 2). Remove from the list.
- * C. Purging the List
- * 1). If job is on list, remove the index entry.
- * 2). If not on list, ignore the request.
- ****************************************************************
- *Called Programs:
-
- * Program Name Description
- * API QWCLSCDE List Job Schedule Entries
- * API QUSRTVUS Retrieve User Space entry
- * API QUSCRTUS Create User Space
- * API QUSCUSAT Change User Space Attributes
- * CLP GETHDGC Retrieve system name
-
- ****************************************************************
-
- FCHGSCDJOB UF A E K DISK
-
- *****************************************************************
-
- D Date S D
- D DateWk S D
- D Apos S 1A INZ(X'7D')
- D JobDsc S 21A Inz(*Blanks)
- D JobQue S 21A Inz(*Blanks)
- D MsgQue S 21A Inz(*Blanks)
-
- *****************************************************************
- * API Variables
- *****************************************************************
- * Execute Command (system) Subprocedure Variables
- D SystemCmd PR 10I 0 ExtProc('system')
- D CmdText * Value Options(*String) Command text string
-
- D Cmd S 32702A Varying Command to execute
- D ErrorCPF S 7A Import('_EXCP_MSGID') Error number
-
- D IBMDtDS DS
- D IBMDate 10A
- D IBMC 1 1
- D IBMYY 2 3
- D IBMMM 4 5
- D IBMDD 6 7
-
- D MDYDS DS
- D MDYMM 1 2
- D MDYDD 3 4
- D MDYYY 5 6
- D MDYMDY 1 6 0
-
- ****************************************************************
- * API parms
- ****************************************************************
-
- D sjRtv DS
- D sjInfSts 1 1 Information Status
- D sjJobNam 2 11 Job Name
- D sjEntry 12 21 Entry Number
- D sjScdDate 22 31 Sched Date
- D sjScdDays 32 101 Sched Days
- D sjScdTime 102 107 Sched Time
- D sjScdFreq 108 117 Sched Frequency
- D sjScdDOM 118 167 Reltv Day of Month
- D sjRecover 168 177 Recovery Action
- D sjNxtSbm 178 187 Next Submit Date
- D sjStatus 188 197 Status
- D sjJobQNm 198 207 Job Queue Name
- D sjJobQLb 208 217 Job Queue Libr
- D sjAddUser 218 227 Added by User
- D sjLstSbmD 228 237 Last Submit Date
- D sjLstSbmT 238 243 Last Submit Time
- D sjText 244 293 Text
- D sjReserv1 294 316 Reserved
- D sjJQStat 317 326 Job Queue Status
- D sjDtOmit 327 526 Dates Omitted
- D sjJobDNm 527 536 Job Desc Name
- D sjJobDLb 537 546 Job Desc Libr
- D sjJobUser 547 556 Job User
- D sjMsgQNm 557 566 Msg Queue Name
- D sjMsgQLb 567 576 Msg Queue Libr
- D sjSavEnt 577 586 Save Entry
- D sjLstJobN 587 596 Last Sbm Job Name
- D sjLstUser 597 606 Last Sbm User Name
- D sjLstJob# 607 612 Last Sbm Job Number
- D sjLstAtDt 613 622 Last Sbm Attemp Date
- D sjLstAtTm 623 628 Last Sbm Attemp Time
- D sjLstAtSt 629 638 Last Sbm Attemp Stat
- D sjReserv2 639 640 Reserved
- LTS02D sjCmdLen 641 644B 0 Len of Cmd String
- LTS02D sjCmd 645 1156 Command String
-
- ****************************************************************
- * API Header Fields
- * Header data starts at position 65
- ****************************************************************
- DQUSH0100 DS
- D QUSUA 1 64 User Area
- D QUSSGH 65 68B 0 Generic Header Size
- D QUSSRL 69 72 Structure Rel Level
- D QUSFN 73 80 Format Name
- D QUSAU 81 90 API Used
- D QUSDTC 91 103 Date Time Created
- D QUSSIS 104 104 Information Status
- D QUSSUS 105 108B 0 Size User Space
- D QUSOIP 109 112B 0 Offset Input Parm
- D QUSSI0 113 116B 0 Size Input Parm
- D QUSOHS 117 120B 0 Offset Header Sectn
- D QUSSHS 121 124B 0 Size Header Sectn
- D QUSOLD 125 128B 0 Offset List Data
- D QUSSLD 129 132B 0 Size List Data
- D QUSNBRLE 133 136B 0 Number List Entries
- D QUSSEE 137 140B 0 Size Each Entry
- D QUSSIDLE 141 144B 0 CCSID List Entry
- D QUSCID 145 146 Country ID
- D QUSLID 147 149 Language ID
- D QUSSLID 150 150 Subset List Ind
- D QRESRVD 151 192 Reserved
-
- ****************************************************************
- * API Error Structure parms
- ****************************************************************
- D ERRC0100 DS
- D ErrorBytes 10I 0 Inz(%Size(ERRC0100)) Bytes provided
- D BytesAvail 10I 0 Inz(0) Bytes available
- D ExceptionID 7A Exception ID
- D Reserved1 1A Reserved
- D ExceptData 256A Exception data
-
- ****************************************************************
- * API Variables defined
- ****************************************************************
- D DS
- D Offset 1 4B 0
- D ValLen 5 8B 0
- D JobEntPos 9 12B 0
-
- D UserSpace S 20
- D SpaceLib S 10 INZ('QTEMP')
- D Extatr S 10
- D Lendata S 10i 0
- D Public S 10
- D USText S 50
- D ReplUS S 10
- D InzValue S 1
-
- * Working data structure for QUsChgUsA API
- D USAttr DS
- D QUsNumRec 9B 0 Inz(1)
- D QUsKey 9B 0 Inz(3)
- D QUsRecLen 9B 0 Inz(1)
- D QUsRecData 1A Inz('1')
-
- ****************************************************************
- * Misc
- ****************************************************************
-
- D Up C 'ABCDEFGHIJKLMNOPQRS-
- D TUVWXYZ'
- D Lo C 'abcdefghijklmnopqrs-
- D tuvwxyz'
- ****************************************************************
-
- D SDS
- D PgmNam 1 10
- D JobNam 244 253
- D JobUsr 254 263
- D JobNbr 264 269
-
- *****************************************************************
-
- C If CurCmd = HoldCmd
- C ExSr $Hld
- C EndIf
-
- C If CurCmd = PurgeCmd
- C ExSr $Prg
- C EndIf
-
- C If CurCmd = ReleaseCmd
- C ExSr $Rls
- C EndIf
-
- C Move *On *InLR
- C Return
- ***********************************************************
- ** Hold scheduled jobs
- ***********************************************************
- C $Hld BegSr
-
- C ExSr $CrtLst
- C ExSr $RtvJob
- C
- C DoW JobRtvCnt < JobCount
-
- C If %Subst(CurJob:1:NameLen) =
- C %Subst(sjJobNam:1:NameLen) or
- C CurJob = All10
-
- C If sjStatus = scheduled
- C Eval CMD = 'HLDJOBSCDE '
- C + 'JOB('
- C + %Trim(sjJobNam) + ') '
- C + 'ENTRYNBR('
- C + %Trim(sjEntry) + ')'
- C ExSr $System
-
- * If the job status is Scheduled and it appears in the file,
- * a manual reset must have been done. But the operator
- * has requested a hold, so the job will be held again.
- C Eval cjSys = SystemName
- C Eval cjJob = sjJobNam
- C Eval cjEnt = sjEntry
- C LstKey Chain CHGSCDJOB
-
- C Eval cjSys = SystemName
- C Eval cjJob = sjJobNam
- C Eval cjEnt = sjEntry
- C Eval cjDate = Today
- C Eval cjUser = JobUsr
- C Eval IBMDate = sjNxtSbm
- C Eval MDYYY = IBMYY
- C Eval MDYMM = IBMMM
- C Eval MDYDD = IBMDD
- C Monitor
- C *MDY Move MDYMDY DateWk
- C *ISO Move DateWk cjNxDt
- C On-Error
- C Eval cjNxDt = Today
- C EndMon
-
- C Move sjScdTime cjNxTm
-
- C If %Found(CHGSCDJOB)
- C Update cjRec
- C Else
- C Write cjRec
- C EndIf
-
- C EndIf
- C EndIf
-
- C ExSr $RtvJob
- C EndDo
-
- C ExSr $DltUs
-
- C #Hld EndSr
- ***********************************************************
- ** Purge jobs from the file
- ***********************************************************
- C $Prg BegSr
-
- C Eval cjSys = SystemName
- C Eval cjJob = *Blanks
- C Eval cjEnt = *Blanks
- C LstKey SetLL CHGSCDJOB
- C Read CHGSCDJOB
-
- C DoW Not %EOF(CHGSCDJOB) and
- C cjSys = SystemName
- C If cjUser = JobUsr
- C If %Subst(CurJob:1:NameLen) =
- C %Subst(cjJob:1:NameLen) or
- C CurJob = All10
- C Delete cjRec
- C EndIf
- C EndIf
- C Read CHGSCDJOB
- C EndDo
-
- C #Prg EndSr
- ***********************************************************
- ** Release scheduled jobs
- ***********************************************************
- ** Previously, the control file was simply read and any
- ** held jobs were ordered released.
- ***********************************************************
- ** The new approach reads a list of held jobs, and each is
- ** compared to the control file to see the job was held by
- ** the specified user, and to see if a submit was missed
- ** during the down time. If a submit was missed, the
- ** job will be sumitted immeditate as well as being released.
- ** After this loop, the file will be read to remove any
- ** remaining obsolete control records for the specified
- ** user.
- ***********************************************************
- C $Rls BegSr
-
- C ExSr $CrtLst
- C ExSr $RtvJob
- C
- C DoW JobRtvCnt < JobCount
-
- C If %Subst(CurJob:1:NameLen) =
- C %Subst(sjJobNam:1:NameLen) or
- C CurJob = All10
-
- C If sjStatus = Held
- C Eval cjSys = SystemName
- C Eval cjJob = sjJobNam
- C Eval cjEnt = sjEntry
- C LstKey Chain CHGSCDJOB
- C If %Found(CHGSCDJOB) and
- C cjUser = JobUsr
- C Eval CMD = 'RLSJOBSCDE '
- C + 'JOB('
- C + %Trim(cjJob) + ') '
- C + 'ENTRYNBR('
- C + %Trim(cjEnt) + ')'
- C ExSr $System
- C Delete cjRec
-
- * Submit immediate.
- * Last Attempt Status codes are are follows:
- * 0 = Job not previously submitted.
- * 1 = Job successfully submitted.
- * 2 = Last job submission failed. Check the message queue for details.
- * 3 = Job not submitted due to held status.
- * 4 = Job submitted after scheduled time as specified by recovery action.
- * 5 = Job not submitted as specified by recovery action.
- C* ** If sjRecover = SbmRls and
- C* ** sjLstAtSt = '3'
- C* ** ExSr $Immed
- C* ** EndIf
-
- * Submit immediate.
- * Questions have been raised about the reliability of last attemp status codes
- * in submitting jobs missed during the hold status.
- * The new approach will submit jobs the had a next submit date and time that
- * fell during the time window of the hold.
- C Time UTime 6 0
- C Time Date
- C *ISO Move Date Today8 8 0
- C If sjRecover = SbmRls and
- C ((cjNxDt < Today8) or
- C (cjNxDt = Today8 and
- C cjNxTm < UTime))
- C ExSr $Immed
- C EndIf
-
- C EndIf
- C EndIf
- C EndIf
-
- C ExSr $RtvJob
- C EndDo
-
-
- * Begin the cleanup loop.
- C Eval cjSys = SystemName
- C Eval cjJob = *Blanks
- C Eval cjEnt = *Blanks
- C LstKey SetLL CHGSCDJOB
- C Read CHGSCDJOB
-
- C DoW Not %EOF(CHGSCDJOB) and
- C cjSys = SystemName
- C If cjUser = JobUsr
- C If %Subst(CurJob:1:NameLen) =
- C %Subst(cjJob:1:NameLen) or
- C CurJob = All10
- C Delete cjRec
- C EndIf
- C EndIf
- C Read CHGSCDJOB
- C EndDo
-
- C #Rls EndSr
- ***********************************************************
- * If a submit was missed during the downtime,
- * do a submit immediate.
- ***********************************************************
- * Job Schedule entries are usually one of three types:
- * 1. SBMJOB CMD(.....)
- * 2. CALL .....
- * 3. COMMAND
- *
- * In each case a job will be submitted by this subroutine.
- * Submitting all commands as jobs will allow retaining the
- * intended run environment for each entry.
- * Since the scheduler does not populate the *LDA, the current
- * actual contents of the *LDA should not be of significance.
- ***********************************************************
- C $Immed BegSr
-
- LTS01C Eval Cmd = 'RUNJOBSCDE '
- LTS01C + 'JOB('
- LTS01C + %Trim(sjJobNam) + ') '
- LTS01C + 'ENTRYNBR('
- LTS01C + %Trim(sjEntry) + ') '
- LTS01C ExSr $System
-
-
-
- * Format the Job Queue specification.
- C*LTS01 If %Subst(sjJobQNm:1:1) = Asterisk
- C*LTS01 Eval JobQue = sjJobQNm
- C*LTS01 Else
- C*LTS01 Eval JobQue = %Trim(sjJobQLb) + '/'
- C*LTS01 + %Trim(sjJobQNm)
- C*LTS01 EndIf
-
- * Format the Job Description specification.
- C*LTS01 If %Subst(sjJobDNm:1:1) = Asterisk
- C*LTS01 Eval JobDsc = sjJobDNm
- C*LTS01 Else
- C*LTS01 Eval JobDsc = %Trim(sjJobDLb) + '/'
- C*LTS01 + %Trim(sjJobDNm)
- C*LTS01 EndIf
-
- * Format the Nessage Que Description specification.
- C*LTS01 If %Subst(sjMsgQNm:1:1) = Asterisk
- C*LTS01 Eval MsgQue = sjMsgQNm
- C*LTS01 Else
- C*LTS01 Eval MsgQue = %Trim(sjMsgQLb) + '/'
- C*LTS01 + %Trim(sjMsgQNm)
- C*LTS01 EndIf
-
- C*LTS01 Eval Cmd = 'SBMJOB CMD('
- C*LTS01 + %Trim(sjCmd) + ') '
- C*LTS01 + 'JOB('
- C*LTS01 + %Trim(sjJobNam) + ') '
- C*LTS01 + 'JOBQ('
- C*LTS01 + %Trim(JobQue) + ') '
- C*LTS01 + 'JOBD('
- C*LTS01 + %Trim(JobDsc) + ') '
- C*LTS01 + 'MSGQ('
- C*LTS01 + %Trim(MsgQue) + ') '
- C*LTS01 + 'USER('
- C*LTS01 + %Trim(sjJobUser) + ') '
- C*LTS01 + 'SYSLIBL(*SYSVAL) '
- C*LTS01 + 'CURLIB(*USRPRF) '
- C*LTS01 + 'INLLIBL(*JOBD) '
- C*LTS01 ExSr $System
-
- C #Immed EndSr
- ***********************************************************
- ** Retrieve Job Entry from the user space **
- ***********************************************************
- C $RtvJob BegSr
-
- C CALL 'QUSRTVUS'
- C Parm UserSpace
- C Parm JobEntPos
- C Parm JobEntSiz ValLen
- C Parm sjRtv
- C Parm ErrC0100
-
- C BytesAvail IfEq 0
- C Add JobEntSiz JobEntPos
- C Add 1 JobRtvCnt
- C EndIf
-
- C #RtvJob EndSr
- ***********************************************************
- ** Retireve a list of all scheduled jobs **
- ***********************************************************
- C $CrtLst BegSr
-
- C ExSr $CrtUS
-
- C CALL 'QWCLSCDE'
- C Parm UserSpace
- C Parm 'SCDL0200' JoblFmt 8
- C Parm All10 JobName 10
- C Parm *Blanks ContHand 16
- C Parm ErrC0100
-
-
- * Retrieve user space header
-
- C CALL 'QUSRTVUS'
- C Parm UserSpace
- C Parm 1 Offset
- C Parm 192 ValLen
- C Parm QUSH0100
- C Parm ErrC0100
- C*
- C BytesAvail IfEq 0
- C QUSOLD Add 1 JobOffset 9 0
- C Z-Add QUSSEE JobEntSiz 9 0
- C Z-Add QUSNBRLE JobCount 9 0
- C Z-ADD JobOffset JobEntPos
- C Else
- C Z-Add 0 JobOffset
- C Z-Add 0 JobEntSiz
- C Z-Add 0 JobCount
- C EndIf
-
- C Z-Add 0 JobRtvCnt 9 0
-
- C #CrtLst EndSr
- ***********************************************************
- * Create a user space in QTEMP to hold the job list.
- ***********************************************************
- C $CrtUs BegSr
-
- C Eval UserSpace = 'SCDJ' + JobNbr + SpaceLib
-
- C Eval Cmd = 'DLTUSRSPC USRSPC(QTEMP/' +
- C %Trim(%Subst(UserSpace:1:10)) + ')'
- C ExSr $System
-
- C Call 'QUSCRTUS'
- C Parm UserSpace
- C Parm 'ScdJobLst' Extatr
- C Parm 10000 Lendata
- C Parm *Blank Inzvalue
- C Parm '*ALL' Public
- C Parm USText
- C Parm '*NO' ReplUS
- C Parm ErrC0100
-
- C BytesAvail IfGt 0
- C Move Failed Result
- C Else
-
- * Change the user space size to grow automatically
- * (Parms are defined and initialized above)
- C Call 'QUSCUSAT'
- C Parm SpaceLib
- C Parm UserSpace
- C Parm UsAttr
- C Parm ErrC0100
-
- C BytesAvail IfGt 0
- C Move Failed Result
- C Else
- C Move Okay Result
- C EndIf
- C EndIf
-
- C #CrtUs EndSr
- ***********************************************************
- * Delete the user space in QTEMP.
- ***********************************************************
- C $DltUs BegSr
-
- C Eval Cmd = 'DLTUSRSPC USRSPC(QTEMP/' +
- C %Trim(%Subst(UserSpace:1:10)) + ')'
- C ExSr $System
-
- C #DltUs EndSr
- *****************************************************************
- * Perform system command
- *****************************************************************
- C $System BegSr
-
- C Eval ErrorCPF = *Blanks
-
- C If 0 <> SystemCmd(Cmd)
- C Move Failed Result 1
- C Else
- C Move Okay Result
- C EndIf
-
- C #System EndSr
- ****************************************************************
- * Initialization subroutine *
- ****************************************************************
- C *InzSr BegSr
-
- * The command can be H=Hold, R=Release, or P=Purge from List
- * The job can be a specific job name, or *ALL.
-
- C *Entry PList
- C Parm CmdParm 1
- C Parm JobParm 10
-
- C LstKey KList
- C KFld cjSys
- C KFld cjJob
- C KFld cjEnt
-
- C Lo:Up XLATE CmdParm CmdParm
- C Lo:Up XLATE JobParm JobParm
-
-
- * Get current system name.
- C Call 'GETHDGC'
- C Parm SystemName 8
-
-
- C Move 'H' HoldCmd 1
- C Move 'P' PurgeCmd 1
- C Move 'R' ReleaseCmd 1
- C MoveL '*SBMRLS' SbmRls 10
- C Move *Blank CurCmd 1
- C If CmdParm = HoldCmd or
- C CmdParm = PurgeCmd or
- C CmdParm = ReleaseCmd
- C Move CmdParm CurCmd 1
- C Else
- C Move *Blank CurCmd
- C EndIf
-
- C Move JobParm CurJob 10
-
- C Move '*ALL ' ALL10 10
- LTS01C Move *On Failed 1
- LTS01C Move *Off Okay 1
- LTS01C Move 'N' No 1
- LTS01C Move 'Y' Yes 1
- LTS01C Move '*' Asterisk 1
- LTS01C Z-Add *Zero NameLen 3 0
- LTS01C MoveL 'SCD' Scheduled 10
- LTS01C MoveL 'HLD' Held 10
-
- C Eval NameLen = %Scan(Asterisk:CurJob:2)
- C If NameLen > 1
- C Eval NameLen -= 1
- C Else
- C Eval NameLen = %Len(CurJob)
- C EndIf
-
-
- * Get current date
- C Time Date
- C *ISO Move Date Today 8 0
-
- C #InzSr EndSr
- ***********************************************************
|
|