/* DVHCMD EXEC */
/* modified to not use LASTING GLOBALV */
COPYRIGHT_NOTICE = ,
' LICENSED MATERIALS - PROGRAM PROPERTY OF IBM.' ,
' RESTRICTED MATERIALS OF IBM.' ,
' 5748-XE4M (C) COPYRIGHT IBM CORPORATION 1979, 1995.' ,
' All rights reserved.' ,
' US Government Users Restricted Rights -' ,
' Use, duplication, or disclosure restricted by GSA ADP' ,
' schedule contract with IBM Corporation.' ,
' Part Name:  DVHCMD   EXEC' ,
' Interface:  199702 VM61741'
Address 'COMMAND'
Parse Arg cmd_string
global_group  = 'DVH15'
global_get    = 'GLOBALV SELECT' global_group 'GET'
global_put    = 'GLOBALV SELECT' global_group 'PUT'
global_perm   = 'GLOBALV SELECT' global_group 'PUT'
global_setlp  = 'GLOBALV SELECT' global_group 'SETL'
Call DO_CMD global_get 'TRACE CMDLEVEL CMDSET LANG MAILSTAMP PRESET'
Select
When Pos(' DVHCMD=',' 'trace' ') ^= 0
Then Parse Var trace . 'DVHCMD=' trace_opt .
When Pos(' DVH*=',' 'trace' ') ^= 0
Then Parse Var trace . 'DVH*=' trace_opt .
Otherwise trace_opt = ''
End
If trace_opt ^= ''
Then Do
'EXEC DVHMSG 116101 * DVHCMD' 'DVHCMD' cmd_string
Trace Value trace_opt
End
validlvls     = '199701 199601 199501 199702'
xmitfile      = ''
Parse Var validlvls dvhlevel .
cms_cmd = 'PIPE (Name Find_Config_Info End ?)' ,
'  COMMAND LISTFILE CONFIG* DATADVH *' ,
'| SORT UNIQUE 1.17 DESCENDING' ,
'| GETFILES ' ,
'| STRIP' ,
'| NFIND /'||,
'|A:L (1.17) /DEFAULT_CMDLEVEL=/' ,
'| STRIP LEADING STRING /DEFAULT_CMDLEVEL=/' ,
'| STRIP' ,
'| TAKE 1' ,
'| STEM DFLT_CMDLVL.'
cms_cmd = cms_cmd ,
'?A:' ,
'|B:L /_MSGS_/' ,
'| CHANGE /_MSGS_/ /' ,
'| SPECS W2 1' ,
'| SORT UNIQUE' ,
'| JOIN * /=/' ,
'| CHANGE /==/ /' ,
'| CHANGE /=/ /' ,
'| STRIP' ,
'| VAR VALIDCMDS'
cms_cmd = cms_cmd ,
'?B:' ,
'|C:L (1.33) /COMMAND_BEFORE_PARSING_USER_EXIT=/' ,
'|  Take 1' ,
'|  Count Lines' ,
'|  Var BeforeParseExit' ,
'?C:' ,
'|D:L (1.36) /COMMAND_BEFORE_PROCESSING_USER_EXIT=/' ,
'|  Take 1' ,
'|  Count Lines' ,
'|  Var BeforeProcExit' ,
'?D:' ,
'|  L (1.35) /COMMAND_AFTER_PROCESSING_USER_EXIT=/' ,
'|  Take 1' ,
'|  Count Lines' ,
'|  Var AfterProcExit'
Call DO_CMD cms_cmd
search_string = 'DEFAULT_CMDSET.'||cmdlevel||'='
ssl = Length(search_string)
cms_cmd = 'PIPE (Name Find_Valid_CMDLEVELS)' ,
'  COMMAND LISTFILE CONFIG* DATADVH *' ,
'| SORT UNIQUE 1.17 DESCENDING' ,
'| GETFILES ' ,
'| STRIP' ,
'| LOCATE (1.'ssl') /'search_string'/' ,
'| STRIP LEADING STRING /'search_string'/' ,
'| STRIP' ,
'| TAKE 1' ,
'| STEM DFLT_CMDSET.'
Call DO_CMD cms_cmd
If dflt_cmdset.0 = 0 | dflt_cmdset.1 = ''
Then dflt_cmdset = ''
Else Parse Upper Var dflt_cmdset.1 dflt_cmdset .
If Pos(dflt_cmdset,cmdset) = 0
Then cmdset = dflt_cmdset||cmdset
If Pos(' 'cmdlevel' ',' 'validcmds' ') = 0
Then Do
If dflt_cmdlvl.0 = 0 | dflt_cmdlvl.1 = ''
Then cmdlevel = '150A'
Else Parse Upper Var dflt_cmdlvl.1 cmdlevel .
End
interface  = dvhlevel'.'cmdlevel
interface. = '199501.'||cmdlevel
interface.DVHCXA = '199702.'||cmdlevel
interface.DVHCXB = '199702.'||cmdlevel
interface.DVHCXC = '199702.'||cmdlevel
prompt = ''
Call CHECK_NEWS
Call DO_CMD global_put ,
'CMDLEVEL CMDSET DVHLEVEL INTERFACE' ,
'INTERFACE.DVHCXA INTERFACE.DVHCXB INTERFACE.DVHCXC' ,
'INTERFACE.DVHPXA INTERFACE.DVHPXR INTERFACE.DVHPXV' ,
'PROMPT VALIDCMDS VALIDLVLS XMITFILE'
If cmd_string = ''
Then Do
'EXEC DVHMSG 128101 * DVHCMD'
r = rc
Signal DONE
End
If BeforeParseExit
Then Do
'EXEC DVHCEXIT USER COMMAND_BEFORE_PARSING_USER_EXIT=' ,
cmd_string
r = rc
Select
When r = 30
Then Nop
When r = 31
Then Nop
Otherwise Signal DONE
End
End
'EXEC DVHCEXIT USER PARSER_'cmdlevel'=' '*USER*' cmd_string
r = rc
If r = 30
Then 'EXEC DVHMSG 128401 * DVHCMD' r
If r ^= 0
Then Signal DONE
If BeforeProcExit
Then Do
'EXEC DVHCEXIT USER COMMAND_BEFORE_PROCESSING_USER_EXIT='
r = rc
Select
When r = 30
Then Nop
When r = 31
Then Nop
Otherwise Signal DONE
End
End
get_list = 'ASUSER BYUSER FORUSER ATNODE'
Call DO_CMD global_get get_list
Parse Var cmd_string cmd cmd_parameters
Upper cmd
If WordPos(foruser,'$DIRCTL$ $DIRGRP$') ^= 0 ,
& WordPos(cmd,'AUTHFOR DROPFOR GET REPLACE LOCK UNLOCK') = 0
Then Do
'EXEC DVHMSG 128001 * DVHCMD' foruser cmd
r = rc
Signal DONE
End
'EXEC DVHFNDCS DVHCMD' cmd
r = rc
If r ^= 0
Then Signal DONE
Parse Upper Var cmd_definition fullcmd user_handler serv_handler ,
pw_reqd reqd_cmdset .
If 0 Then Do
Do i = 1 To Length(cmdset)
x = Pos(Substr(cmdset,i,1),reqd_cmdset)
If x ^= 0
Then Leave
End
If x = 0
Then Do
'EXEC DVHMSG 128301 * DVHCMD' cmd
r = rc
Signal DONE
End
End
Call DO_CMD global_put 'PW_REQD'
'EXEC' user_handler cmd cmd_parameters
r = rc
If AfterProcExit
Then 'EXEC DVHCEXIT USER COMMAND_AFTER_PROCESSING_USER_EXIT=' r cmd
DONE:
If preset <> ''
Then Call DO_CMD_A global_setlp 'PRESET'
If trace_opt ^= ''
Then 'EXEC DVHMSG 116201 * DVHCMD' 'DVHCMD' r
Exit r
DO_CMD:
Parse Arg cms_cmd
''cms_cmd
r = rc
If r ^= 0
Then Do
'EXEC DVHMSG 111901 * DVHCMD' sigl r cms_cmd
r = rc
Signal DONE
End
Return
DO_CMD_A:
Parse Arg cms_cmd
''cms_cmd
If rc ^= 0
Then Do
'EXEC DVHMSG 111901 * DVHCMD' sigl rc cms_cmd
if r = 0
then r = rc
End
Return
CHECK_NEWS:
'PIPE (Name CHECK_NEWS_DATE)' ,
'  COMMAND LISTFILE DIRMAINT NEWMAIL * (DATE)' ,
'| DROP 1' ,
'| SPECS W8-9 1' ,
'| STEM NEWSDATE.'
If rc ^= 0 | newsdate.0 = 0
Then Return
If mailstamp = ''
Then mailstamp = '1900/01/01 00:00:00'
lasttime = mailstamp
Do i = 1 To newsdate.0
Parse Var newsdate.i mo'/'da'/'yr hh':'mm':'ss .
If yr > 80
Then yr = yr + 1900
Else yr = yr + 2000
newsdate.i = Right(yr,4,'0')'/'Right(mo,2,'0')'/'Right(da,2,'0') ,
Right(hh,2,'0')':'Right(mm,2,'0')':'Right(ss,2,'0')
If newsdate.i > lasttime
Then lasttime = newsdate.i
End
If lasttime ^= mailstamp
Then Do
mailstamp = lasttime
''global_perm 'MAILSTAMP'
If rc ^= 0
Then Do
Call DO_CMD global_put 'MAILSTAMP'
'EXEC DVHMSG 118601 * DVHCMD'
End
'EXEC DVHCMD NEWS'
End
Return