Terminal alternatif évolué dans linux

/ --- Rexx --------------------------------------------------------- /
/ Visualisation d'un composant (programme, copy, dclgen) /
/ Paramètres : - Nom du composant à voir /
/ - Environnement /
/ - Langage /
/ - PDS /
/ - Type /
/ - Edit /
/ Entrée : - néant /
/ Sortie : - néant /
/ ------------------------------------------------------------------ /

Address ISREDIT
"MACRO (param)"
if param = "PARAM" then parse arg param
parse upper value param with param
/address tso "SUBCOM ISREDIT"
if rc = 0 then address ISREDIT "MACRO (param)"
else parse upper arg param/

call initialisation
call lire_param
call fin

exit

/----------------------------/
/ Initialisation des données /
/----------------------------/
initialisation:
call mesvar("-L "param)
src = mesvar("-g glChn")
lang = mesvar("-g glLang")
env = mesvar("-g glEnv")
type = mesvar("-g glEnv")
edit = mesvar("-g glEdit VIEW")
btp = mesvar("-g glBTP")
brq = mesvar("-g glBrq")
pds = "vide"

call mesvar("-p glOutils visu")

if src = "-H" ! src = "-HELP" then call aide
call variable_src

return

param_lang:

plang = ""
select
when parm = "SOURCE" then plang = parm
when parm = "SOURCEX" then plang = parm
when parm = "COBOL" then plang = parm
when parm = "COPY" then plang = parm
when parm = "DCLGEN" then plang = parm
when parm = "ASM" then plang = parm
/when parm = "APS" then plang = parm /
/when parm = "APSCOB" then plang = parm /
when parm = "NDV" then plang = parm
when parm = "JCL" then plang = parm
when parm = "JCLX" then plang = parm
when parm = "PARAM" then plang = parm
when parm = "PROC" then plang = parm
when parm = "REXX" then plang = parm
when parm = "SQL" then plang = parm
otherwise return 0
end

if lang /= "" then do
zedsmsg = "Probleme parametre langage"
zedlmsg = "Incoherence entre "lang" et "plang
address ispexec "setmsg msg(isrz001)"
exit 4
end

lang = plang

return 1

param_env:

penv = ""
select
when parm = "PERSO" then penv = parm
when parm = "OTEST" then penv = parm
when parm = "OQUAL" then penv = parm
when parm = "UQUAL" then penv = parm
when parm = "URECE" then penv = parm
when parm = "ULIVR" then penv = parm
otherwise return 0
end

if env /= "" then do
zedsmsg = "Probleme parametre environnement"
zedlmsg = "Incoherence entre "env" et "penv
address ispexec "setmsg msg(isrz001)"
exit 4
end

env = penv

return 1

param_special:

if parm = "$" then parm = mesvar(parm)

if pds = "" then
pds = parm
else do
zedsmsg = "Parametre incorrect"
zedlmsg = parm
address ispexec "setmsg msg(isrz001)"
exit 4
end

return 1

param_type:

ptype = ""
select
when parm = "OTEST" then ptype = parm
when parm = "OQUAL" then ptype = parm
when parm = "UQUAL" then ptype = parm
when parm = "URECE" then ptype = parm
when parm = "ULIVR" then ptype = parm
otherwise return 0
end

if type /= "" then do
zedsmsg = "Probleme parametre type"
zedlmsg = "Incoherence entre "type" et "ptype
address ispexec "setmsg msg(isrz001)"
exit 4
end

type = ptype

return 1

param_btp:

pbtp = ""
select
when parm = "COBCO" then pbtp = parm
when parm = "BATCH" then pbtp = parm
when parm = "TP" then pbtp = parm
otherwise return 0
end

if btp /= "" then do
zedsmsg = "Probleme parametre Batch/TP"
zedlmsg = "Incoherence entre "btp" et "pbtp
address ispexec "setmsg msg(isrz001)"
exit 4
end

btp = pbtp

return 1

param_brq:

pbrq = ""
select
when parm = "BAC" then pbrq = parm
when parm = "BRF" then pbrq = parm
when parm = "BST" then pbrq = parm
when parm = "MIG" then pbrq = parm
when parm = "STC" then pbrq = parm
when parm = "TEC" then pbrq = parm
otherwise return 0
end

if brq /= "" then do
zedsmsg = "Probleme parametre brique"
zedlmsg = "Incoherence entre "brq" et "pbrq
address ispexec "setmsg msg(isrz001)"
exit 4
end

brq = pbrq

return 1

param_edit:

pedit = ""
select
when parm = "EDIT" then pedit = parm
when parm = "VIEW" then pedit = parm
otherwise return 0
end

if edit /= "VIEW" then do
zedsmsg = "Probleme parametre edit"
zedlmsg = "Incoherence entre "edit" et "pedit
address ispexec "setmsg msg(isrz001)"
exit 4
end

edit = pedit

return 1

/------------------------------------------/
/ Lecture et interprétation des paramètres /
/------------------------------------------/
lire_param:

Address ISREDIT
select
when length(src) = 0 then do
zedsmsg = "Parametre absent"
zedlmsg = "Il me faut un nom de membre source"
address ispexec "setmsg msg(isrz001)"
exit 4
end
when datatype(src) = 'NUM' then do
zedsmsg = "Parametre incorrect"
zedlmsg = "Il me faut un nom de membre source"
address ispexec "setmsg msg(isrz001)"
exit 4
end
when datatype(src) = 'CHAR' then nop
otherwise exit
end

call affiche pds X X X
call affiche pds X "NDV" X
call affiche "OTEST.IFUS120.JCL" PERSO JCL X
call affiche "OTEST.IFUS120.JCLU" PERSO JCL X
/call affiche "OTEST.IFUS120.JCLRES" PERSO JCL X
call affiche "OTEST.IFUS120.JCLREF" PERSO JCL X/
call affiche "OTEST.IFUS120.PROC" PERSO PROC X
call affiche "OTEST.IFUS120.REXX" PERSO Rexx X
call affiche "OTEST.IFUS120.SKEL" PERSO X X
call affiche "OTEST.IFUS120.DCLGEN" PERSO DCLGEN X
call affiche "OTEST.IFUS120.SQL" PERSO SQL X
call affiche "OTEST.IFUS120.SRC" PERSO "SOURCE" X
call affiche "OTEST.IFUS120.SOURCE" PERSO "SOURCE" X
call affiche "OTEST.IFUS120.SOURCEX" PERSO SOURCEX X
call affiche "OTEST.IFUS120.COPY.IN" PERSO COPY X
call affiche "OTEST.IFUS120.COPY.OUT" PERSO COPY X
call affiche "OTEST.NDV.STC.BATCH.LOAD" OTEST X Batch
call affiche "OTEST.NDV.STC.CICS.LOAD" OTEST X TP
call affiche "OTEST.NDV.STC.COBBT.BASE" OTEST COBOL Batch
call affiche "OTEST.NDV.STC.COBCO.BASE" OTEST COBOL X
call affiche "OTEST.NDV.STC.COBTP.BASE" OTEST COBOL TP
call affiche "OTEST.NDV.STC.COPY.BASE" OTEST COPY X
call affiche "OTEST.NDV.STC.DCLGEN.BASE" OTEST DCLGEN X
call affiche "OTEST.NDV.STC.DDL.BASE" OTEST X X
call affiche "OTEST.STC.SPEC.JCL" OTEST JCLX Batch
call affiche "OTEST.NDV.STC.JCL.BASE" OTEST JCL Batch
call affiche "OQUAL.NDV.STC.BATCH.LOAD" OQUAL X Batch
call affiche "OQUAL.NDV.STC.CICS.LOAD" OQUAL X TP
call affiche "OQUAL.NDV.STC.COBBT.BASE" OQUAL COBOL Batch
call affiche "OQUAL.NDV.STC.COBCO.BASE" OQUAL COBOL X
call affiche "OQUAL.NDV.STC.COBTP.BASE" OQUAL COBOL TP
call affiche "OQUAL.NDV.STC.COPY.BASE" OQUAL COPY X
call affiche "OQUAL.NDV.STC.DCLGEN.BASE" OQUAL DCLGEN X
call affiche "OQUAL.NDV.STC.DDL.BASE" OQUAL X X
call affiche "OQUAL.STC.SPEC.JCL" OQUAL JCLX Batch
call affiche "OQUAL.NDV.STC.JCL.BASE" OQUAL JCL Batch
call affiche "UINTE.NDV.STC.BATCH.LOAD" UINTE X Batch
call affiche "UINTE.NDV.STC.CICS.LOAD" UINTE X TP
call affiche "UINTE.NDV.STC.COBBT.BASE" UINTE COBOL Batch
call affiche "UINTE.NDV.STC.COBCO.BASE" UINTE COBOL X
call affiche "UINTE.NDV.STC.COBTP.BASE" UINTE COBOL TP
call affiche "UINTE.NDV.STC.COPY.BASE" UINTE COPY X
call affiche "UINTE.NDV.STC.DCLGEN.BASE" UINTE DCLGEN X
call affiche "UINTE.NDV.STC.DDL.BASE" UINTE X X
call affiche "UINTE.NDV.STC.JCL.BASE" UINTE JCL Batch
call affiche "ULIVR.NDV.STC.BATCH.LOAD" ULIVR X Batch
call affiche "ULIVR.NDV.STC.CICS.LOAD" ULIVR X TP
call affiche "ULIVR.NDV.STC.COBBT.BASE" ULIVR COBOL Batch
call affiche "ULIVR.NDV.STC.COBCO.BASE" ULIVR COBOL X
call affiche "ULIVR.NDV.STC.COBTP.BASE" ULIVR COBOL TP
call affiche "ULIVR.NDV.STC.COPY.BASE" ULIVR COPY X
call affiche "ULIVR.NDV.STC.DCLGEN.BASE" ULIVR DCLGEN X
call affiche "ULIVR.NDV.STC.DDL.BASE" ULIVR X X
call affiche "ULIVR.NDV.STC.JCL.BASE" ULIVR JCL Batch
call affiche "OMAIN.NDV.STC.BATCH.LOAD" OMAIN X Batch
call affiche "OMAIN.NDV.STC.CICS.LOAD" OMAIN X TP
call affiche "OMAIN.NDV.STC.COBBT.BASE" OMAIN COBOL Batch
call affiche "OMAIN.NDV.STC.COBCO.BASE" OMAIN COBOL X
call affiche "OMAIN.NDV.STC.COBTP.BASE" OMAIN COBOL TP
call affiche "OMAIN.NDV.STC.COPY.BASE" OMAIN COPY X
call affiche "OMAIN.NDV.STC.DCLGEN.BASE" OMAIN DCLGEN X
call affiche "OMAIN.NDV.STC.DDL.BASE" OMAIN X X
call affiche "OMAIN.NDV.STC.JCL.BASE" OMAIN JCL Batch
call affiche "PLEXP1.JCLLIB" X PROC Batch
if pbrq <> "STC" then
call affiche env".NDV."brq"."lang".BASE" env lang X

return

affiche:
parse upper arg dsn penv plang pbtp

if env /= "" & penv /= "X" & env /= penv then return
if lang /= "" & plang /= "X" & lang /= plang then return
if btp /= "" & pbtp /= "X" & btp /= pbtp then return

if src = "-LISTE" then do
select
when env /= "" & env /= penv then return
when lang /= "" & lang /= plang then return
when btp /= "" & btp /= pbtp then return
when dsn = "VIDE" then return
otherwise nop
end
say dsn
return
end

if plang = "NDV" & lang = "NDV"
then call liste_NDV
else fichier = dsn"("src")"

if sysdsn(fichier) = 'OK' then do
call mesvar("-p glDSN "dsn)
address ISPEXEC edit" dataset('"fichier"')"
call mesvar("<")
exit 0
end
else do
if ^(plang = "NDV" & lang = "NDV") then return
zedsmsg = "Fichier non trouve"
zedlmsg = "Erreur "fichier" non trouve"
address ispexec "setmsg msg(isrz001)"
exit 4
end

return

liste_NDV:

call ndvsrc (src env brq)
liste = mesvar("-g glLstPrm")
parse value liste with nb"//"prg brq stag elmt typ"/"liste
fichier = stag".NDV."brq"."typ".BASE("elmt")"

return

variable_src:

if src = "*" ! src = "=" then do
src = mesvar(src)
if datatype(src) = 'NUM' then do
zedsmsg = "Erreur "src
zedlmsg = "Erreur "src" a l'appel du module 'variable'"
address ispexec "setmsg msg(isrz001)"
exit 4
end
end
else
call mesvar ("-p glChn" src)

return

fin:
address ISPEXEC
zedsmsg = src" non trouve"
zedlmsg = src lang env pbrq
address ispexec "setmsg msg(isrz001)"

return

aide:

say "Visualisation d'un membre apres l'avoir ",
"recherche dans le PDS qui va bien ..."
say
say "Usage : visu <membre> <environnement> <langage> <pds> <t ype>"
say
say " membre -> nom du membre a visualiser"
say " environnement -> vide / TEST / RECE / CINTE / EXPL"
say " langage -> vide / COBOL / APS / JCL / APSCOB",
" / COPY / DCLGEN / PARAM"
say " pds -> vide / PDS contenant le membre"
say " type -> vide / Batch / TP"
say " * valeur par defaut"

exit

/ --- Rexx --------------------------------------------------------- /
/ recherche d'une description de table DB2 /
/ Paramètres : - nom de la table à décrire /
/ Entrée : - néant /
/ Sortie : - néant /
/ ------------------------------------------------------------------ /

Address ISREDIT
"MACRO (param)"
if param = "PARAM" then parse arg param
parse upper value param with param

call initialisation
call traitement
call fin

exit

initialisation:
topca = 0
call mesvar("-L "param)
TABLE = mesvar("-g glChn")
SSID = mesvar("-g glSSID DO31")
CREATOR = mesvar("-g glOwner TOZ0")

TABLE6 = ""

select
when index(TABLE,"%") > 0 then TABLE = "like '"TABLE"'"
when index(TABLE,"_") > 0 then TABLE = "like '"TABLE"'"
otherwise do
TABLE6 = substr(TABLE, 2, 6)
TABLE = "= '"TABLE"'"
end
end

call init_db2

return

traitement:

call preparer_table
call preparer_colonnes
call preparer_index
call preparer_foreign_keys
call preparer_sequence
if TABLE6 ^= "" then call preparer_packages

return

fin:

call fin_db2

return

preparer_table:

req = "select name, creator, type, remarks, dbname, "
req = req!!"tsname, colcount, parents, children, keycolumns, "
req = req!!"status, tablestatus, label, checkflag "
req = req!!"from sysibm.systables "
req = req!!"where name "!!TABLE
req = req!!" and creator = '"!!CREATOR!!"' "

ligne_titre = "Table Creator Remarque"
ligne_valeur = 'tb" "creator""rmk'
fetch_into = ":tb, :creator, :type, :rmk, :dbname, :tsname, "
fetch_into = fetch_into!!":nbcol, :parent, :enfant, :colclef, "
fetch_into = fetch_into!!":status, :etattab, :label, :chkflag"
/csv_t = "Table;Creator;Type;Remarque;DBName;TSName;"
csv_t = csv_t!!"Nombre de colonnes;Nb colonnes dans Clef primaire;"
csv_t = csv_t!!"Parents;Enfants;Libelle;Statut;Etat;Check Flag"
detail.0 = 8
detail.1 = '"Table = "tb" - Dbname/TableSpace = "dbname"/"tsname'
detail.1 = detail.1!!'" / Creator = "creator'
detail.2 = '"Detail = "rmk'
detail.3 = '"Libelle = "label'
select
when type = 'A' then ltype = 'Alias'
when type = 'C' then ltype = 'Table clone'
when type = 'G' then ltype = 'Global temporary table'
when type = 'M' then ltype = 'Query table materialisee'
when type = 'P' then ltype = 'Table implicite pour colonnes XML'
when type = 'T' then ltype = 'Table'
when type = 'V' then ltype = 'Vue'
when type = 'X' then ltype = 'Table auxiliaire'
otherwise ltype = type!!' pas compris'
end
detail.4 = '"Type = "ltype" - Parent = "parent" - Enfant = "enfant'
detail.5 = '"Nb Col = "nbcol" - Clef primaire = "colclef" colonnes"'
select
when status = 'I' then lstatus = 'Definition incomplete'
when status = 'R' then lstatus = 'Erreur regeneration'
when status = 'X' then lstatus = 'OK'
when status = '' then lstatus = 'Ok mais pas de clef primaire'
otherwise lstatus = status!!' pas compris'
end
select
when etattab = 'L' then etattab = 'Manque table/index auxiliaire'
when etattab = 'P' then etattab = 'Manque clef primaire'
when etattab = 'R' then etattab = 'Manque index sur champ ID'
when etattab = 'U' then etattab = 'Manque index sur clef unique'
when etattab = 'V' then etattab = 'Erreur regeneration vue'
when etattab = '' then etattab = 'OK'
otherwise etattab = etattab!!' pas compris'
end
select
when chkflag = 'C' then do
chkflag = 'Attention CHEKPENDING ou '
chkflag = chkflag!!'donnees incoherentes'
end
when chkflag = '' then chkflag = 'OK'
otherwise chkflag = chkflag!!' pas compris'
end
detail.6 = '"Statut = "lstatus'
detail.7 = '"Etat table = " etattab'
detail.8 = '"Checl flag = " chkflag'/

call traiter_requete
/do i = 1 to detail.0
interpret say detail.i
end
say ""/

return

preparer_colonnes:

req = "select c.name, c.colno, c.coltype, c.length, c.nulls, "
req = req!!"c.remarks "
req = req!!"from sysibm.syscolumns c "
req = req!!"where c.tbname "!!TABLE
req = req!!" and c.tbcreator = '"!!CREATOR!!"' "
req = req!!"order by c.colno"

ligne_titre = "NCol Colonne Type Lgr Null"
ligne_titre = ligne_titre!!" Remarks"
ligne_valeur = 'right(ncol,4)" "left(col,20)'
ligne_valeur = ligne_valeur'" "left(type,8)'
ligne_valeur = ligne_valeur'" "right(lgr,5)" "null" " rmk'
fetch_into = ":col, :ncol, :type, :lgr, :null, :rmk"

call traiter_requete

return

preparer_index:

req = "select t.name, i.name, c.name, i.colcount, k.colseq, "
req = req!!"c.coltype, c.length, c.nulls, i.uniquerule, k.ordering, "
req = req!!"c.colno "
req = req!!"from sysibm.systables t "
req = req!!" inner join sysibm.syscolumns c "
req = req!!" on c.tbname = t.name "
req = req!!" and c.tbcreator = t.creator "
req = req!!" inner join sysibm.sysindexes i "
req = req!!" on i.tbname = t.name "
req = req!!" and i.tbcreator = t.creator "
req = req!!" inner join sysibm.syskeys k "
req = req!!" on k.colname = c.name "
req = req!!" and k.colno = c.colno "
req = req!!" and k.ixname = i.name "
req = req!!" and k.ixcreator = i.creator "
req = req!!"where t.name"!!TABLE
req = req!!"and t.creator = '"!!CREATOR!!"' "
req = req!!"order by t.name, i.name, k.colseq"

ligne_titre = "Table Index Colonne Ordre Type "
ligne_titre = ligne_titre!!" Lgr Null Uniq Tri Ncol"
ligne_valeur = 'tb" "idx" "left(col, 20)" "strip(nseq)"/"'
ligne_valeur = ligne_valeur'strip(nbcol)" "left(typ,8)" "right(lgr,4)'
ligne_valeur = ligne_valeur'" "nul" "unq" "right(nord,4)'
ligne_valeur = ligne_valeur'" "right(ncol,4)'
fetch_into = ":tb, :idx, :col, :nbcol, :nseq, :typ, :lgr, :nul, :unq"
fetch_into = fetch_into!!", :nord, :ncol"

call traiter_requete

return

preparer_foreign_keys:

req = "select substr(f.relname, 1, 8), r.colcount, "
req = req!!"f.colseq, substr(r.reftbname, 1, 8), "
req = req!!"substr(c.tbname, 1, 8), substr(c.name, 1, "
req = req!!"20), r.deleterule, r.checkexistingdata "
req = req!!"from sysibm.syscolumns c "
req = req!!" inner join sysibm.sysforeignkeys f "
req = req!!" on f.tbname = c.tbname "
req = req!!" and f.creator = c.tbcreator "
req = req!!" and f.colname = c.name "
req = req!!" inner join sysibm.sysrels r "
req = req!!" on r.tbname = f.tbname "
req = req!!" and r.creator = f.creator "
req = req!!" and r.relname = f.relname "
req = req!!"where (c.tbname"!!TABLE
req = req!!"and c.tbcreator = '"!!CREATOR!!"') "
req = req!!"union "
req = req!!"select substr(f.relname, 1, 8), r.colcount, "
req = req!!"f.colseq, substr(r.reftbname, 1, 8), "
req = req!!"substr(c.tbname, 1, 8), substr(c.name, 1, "
req = req!!"20), r.deleterule, r.checkexistingdata "
req = req!!"from sysibm.syscolumns c "
req = req!!" inner join sysibm.sysforeignkeys f "
req = req!!" on f.tbname = c.tbname "
req = req!!" and f.creator = c.tbcreator "
req = req!!" and f.colname = c.name "
req = req!!" inner join sysibm.sysrels r "
req = req!!" on r.tbname = f.tbname "
req = req!!" and r.creator = f.creator "
req = req!!" and r.relname = f.relname "
req = req!!"where (r.reftbname"!!TABLE
req = req!!"and r.reftbcreator = '"!!CREATOR!!"') "
req = req!!"order by 1 asc, 2 asc"

ligne_titre = "FKey NbCol Seq TbMaitre TbFille Colonne "
ligne_titre = ligne_titre!!" PropagDel VerfImmediat"
ligne_valeur = 'fkey" "right(nbcol,5)" "right(seq, 3)" "'
ligne_valeur = ligne_valeur'tb_maitre" "tb_fille'
ligne_valeur = ligne_valeur'" "left(col, 20)" "left(propagation, 10)'
ligne_valeur = ligne_valeur'" "verif_immediate'
fetch_into = ":fkey, :nbcol, :seq, :tb_maitre, :tb_fille, :col, "
fetch_into = fetch_into!!":propagation, :verif_immediate"

call traiter_requete

return

preparer_packages:

/*req = "select d.bname, d.btype, d.dname, p.creator, p.bindtime, "
req = req!!"p.pctimestamp, p.pdsname, p.dynamicrules "
req = req!!"from sysibm.syspackdep d inner join sysibm.syspackage p "
req = req!!"on p.name = d.dname and p.owner = d.bqualifier "
req = req!!"where substr(bname, 2, 6) = '"!!TABLE6!!"'"
req = req!!"and bqualifier = '"!!CREATOR!!"' "
req = req!!"order by d.bname asc, d.dname asc"

ligne_titre = "Objet Type Composant"
ligne_valeur = 'substr(obj, 1, 8, " ")" "type" "composant'
fetch_into = ":obj, :type, :composant, :creator, :bnd, :pcts, :pds, "
fetch_into = fetch_into!!":dynamrul"*/

req = "select distinct d.dname, hex(p.contoken), p.pctimestamp, "
req = req!!"p.pdsname "
req = req!!"from sysibm.syspackdep d inner join sysibm.syspackage p "
req = req!!"on p.name = d.dname and p.owner = d.bqualifier "
req = req!!"where substr(bname, 2, 6) = '"!!TABLE6!!"'"
req = req!!"and bqualifier = '"!!CREATOR!!"' "

ligne_titre = "Accesseurs ConToken DB2 ConToken Load "
ligne_titre = ligne_titre!!" PCTimeStamp"
ligne_valeur = 'obj" "ct" "right(ct, 8)left(ct, 8)" "pcts'
ligne_valeur = ligne_valeur!!'" "pdsn'
fetch_into = ":obj, :ct, :pcts, :pdsn"

call traiter_requete

return

preparer_sequence:

req = "select s.name, s.seqtype, s.sequenceid, s.increment, "
req = req!!"s.start, s.maxvalue, s.minvalue, s.cycle, "
req = req!!"s.maxassignedval, s.remarks, s.precision, s.restartwith "
req = req!!"from sysibm.syssequences s "
req = req!!"where substr(name, 2, 6) = '"!!TABLE6!!"'"
req = req!!"and schema = '"!!CREATOR!!"' "

ligne_titre = "Sequence Type Id Incr Start "
ligne_titre = ligne_titre!!"Cycle AssignMax Restart "
ligne_titre = ligne_titre!!"MinVal MaxVal"
ligne_valeur = 'name" "type" "seqid" "incr" "'
ligne_valeur = ligne_valeur'start" "cycle" "'
ligne_valeur = ligne_valeur'maxassignv" "restart" "'
ligne_valeur = ligne_valeur'minv" "maxv'
fetch_into = ":name, :type, :seqid, :incr, :start, :maxv, :minv, "
fetch_into = fetch_into!!":cycle, :maxassignv :maxassignvnull, "
fetch_into = fetch_into!!":remarks, :precis, :restart :restartnull"

call traiter_requete

return

traiter_requete:

say ligne_titre

call open_curseur
do until sqlcode = -100 ! sqlcode = 100
call fetch_curseur
if sqlcode = 0 then do
interpret say ligne_valeur
end
end
call close_curseur
say ""

return

init_db2:

call connect_db2

return

fin_db2:

call disconnect_db2

return

connect_db2:

address tso "SUBCOM DSNREXX"
if rc = 1 then s_rc = rxsubcom('ADD','DSNREXX','DSNREXX')

address DSNREXX "CONNECT" SSID
if sqlcode ^= 0 then call sqlca

return

disconnect_db2:

address DSNREXX "DISCONNECT"
s_rc = RXSUBCOM('DELETE','DSNREXX','DSNREXX')
if sqlcode ^= 0 then call sqlca

return

exec_req:

address dsnrexx "execsql" req
if sqlcode <> 0 then call sqlca

return

open_curseur:

declare_cursor = "declare c1 cursor for s1"
address dsnrexx "execsql "!!declare_cursor
if sqlcode <> 0 then call sqlca
address dsnrexx "execsql prepare s1 from :req"
if sqlcode <> 0 then call sqlca
address dsnrexx "execsql open c1"
if sqlcode ^= 0 then call sqlca

return

fetch_curseur:

address dsnrexx "execsql fetch c1 into" fetch_into
if sqlcode = 0 then return
if sqlcode = +100 then return
if sqlcode = -100 then return

call sqlca

return

close_curseur:

address dsnrexx "execsql close c1"
if sqlcode <> 0 then call sqlca

return

sqlca:

address tso
say 'SQLCODE =' SQLCODE
say 'SQLSTATE =' SQLSTATE
say 'SQLERRP =' SQLERRP
say 'SQLERRMC =' SQLERRMC
do i=0 to 9
say 'SQLWARN'I' =' SQLWARN.i
end
say 'SQLWARN10=' SQLWARN.10
do i=1 to 6
say 'SQLERRD'I' =' SQLERRD.i
end

exit 12

/ --- Rexx --------------------------------------------------------- /
/ Fonction EDIT d'un PDS ou d'un membre /
/ Paramètres : - néant /
/ Entrée : - néant /
/ Sortie : - néant /
/ ------------------------------------------------------------------ /

Address ISREDIT
"MACRO (DSN)"
"(LigCurs, ColCurs) = CURSOR"
if DSN = "DSN" then parse upper arg DSN

call initialisation
call lire_param

call restpref
exit

/----------------------------/
/ Initialisation des données /
/----------------------------/
initialisation:
fichier = ""
dsnpos = 0
call SavePref
return

/------------------------------------------/
/ Lecture et interprétation des paramètres /
/------------------------------------------/
lire_param:

Address ISREDIT
select
when length(DSN) = 0 then do
"(Lig, Col) = CURSOR"
if Lig = 0 then do
"(PDSJCL, ,) = DATASET"
"(MEMBRE) = MEMBER"
fichier = PDS!!'('!!MEMBRE!!')'
end
"(LINEDATA) = LINE .ZCSR"
end
when datatype(DSN) = 'NUM' then do
"CURSOR="DSN" 0"
"(LINEDATA) = LINE .ZCSR"
end
when datatype(DSN) = 'CHAR' then do
fichier = DSN
dsnpos = 1
end
otherwise exit
end

Address ISPEXEC
if length(fichier) = 0 then do
lig=translate(LINEDATA,' ','=')
lig=translate(lig,' ',',')
dsnpos=wordpos('DSN',lig)
end
if dsnpos=0 then do
zedsmsg = ""
zedlmsg = "Pas de fichier ou de PDS sur la ligne"
"setmsg msg(isrz001)"
end
else do
if length(fichier) = 0 then fichier=word(lig,dsnpos+1)
bof = sysdsn(fichier)
if bof = 'OK' then do
Address TSO
say centre('LISTDSI',75)
say center('=======',75)
"ALLOC DD(IN) DS("fichier") SHR REUSE"
"EXECIO * DISKR IN (STEM in. FINIS"
say '"ALLOC DD(IN) DS('fichier') SHR REUSE "'
say 'LISTDSI(IN FILE)'
bof = listdsi(IN file)
say
say ' sysDSNAME ----> 'sysDSNAME
say ' sysVOLUME ----> 'sysVOLUME
say ' sysUNIT ----> 'sysUNIT
say ' sysDSORG ----> 'sysDSORG
say ' sysRECFM ----> 'sysRECFM
say ' sysLRECL ----> 'sysLRECL
say ' sysBLKSIZE ----> 'sysBLKSIZE
say ' sysALLOC ----> 'sysALLOC
say ' sysUSED ----> 'sysUSED
say ' sysPRIMARY ----> 'sysPRIMARY
say ' sysSECONDS ----> 'sysSECONDS
say ' sysUNITS ----> 'sysUNITS
say ' sysEXTENTS ----> 'sysEXTENTS
say ' sysADIRBLK ----> 'sysADIRBLK
say ' sysUDIRBLK ----> 'sysUDIRBLK
say ' sysMEMBERS ----> 'sysMEMBERS
say ' Nombre de lignes dans le fichier : 'in.0
say ' <ENTER>'
do 8;say;end
say centre('LISTDSI',75)
say center('=======',75)
say
say 'LISTDSI(IN FILE DIRECTORY)'
bof = listdsi(IN file directory)
"FREE F(IN)"
say
say ' sysDSNAME ----> 'sysDSNAME
say ' sysVOLUME ----> 'sysVOLUME
say ' sysUNIT ----> 'sysUNIT
say ' sysDSORG ----> 'sysDSORG
say ' sysRECFM ----> 'sysRECFM
say ' sysLRECL ----> 'sysLRECL
say ' sysBLKSIZE ----> 'sysBLKSIZE
say ' sysALLOC ----> 'sysALLOC
say ' sysUSED ----> 'sysUSED
say ' sysPRIMARY ----> 'sysPRIMARY
say ' sysSECONDS ----> 'sysSECONDS
say ' sysUNITS ----> 'sysUNITS
say ' sysEXTENTS ----> 'sysEXTENTS
say ' sysADIRBLK ----> 'sysADIRBLK
say ' sysUDIRBLK ----> 'sysUDIRBLK
say ' sysMEMBERS ----> 'sysMEMBERS' <ENTER>'
end
else do
zedsmsg = "Fichier non catalogué"
zedlmsg = fichier' 'bof
"setmsg msg(isrz001)"
end
end
return

/---------------------/
/ save prefix routine /
/---------------------/
savepref:

Address ISREDIT
sprefx = '' / save prefix /
uprefx = userid() / user prefix /
prefx = sysvar(syspref) / get prefix variable /
if prefx <> '' then do / if profile prefix /
sprefx = prefx / save it /
"profile noprefix" / work without prefix /
end
return / return to caller /

/------------------------/
/ restore prefix routine /
/------------------------/
restpref:

Address ISREDIT
prefx = sysvar(syspref) / get prefix variable /
if prefx = '' then do / if profile noprefix /
if sprefx <> '' then do / if saved /
prefx = sprefx / restore it /
"profile prefix("prefx")" / work with prefix /
end
end
return / return to caller /

Liste des notices d’installation de toutes les box internet (neuf-box, dartybox, etc.) et avec plusieurs versions.

Cours pour débuter en CSS

Site en anglais

Un article intéressant chez Les Numériques

Peut servir

/====================== REXX Exec ==================================

• Name: condcode *
• Type: Rexx Exec *
• *
• Purpose: Retrieve Condition Codes for each prior step. *
• Abstract: Follow MVS control blocks to the STEP CONTROL TABLE, *
• then decipher status bytes to display what occurred *
• for each of the prior steps. *
• *
• Syntax: %condcode *
• *
• Example: %condcode *
• *
• Author: Kenneth E. Tomiak *
• Date: 2003-03-13 2003.072 *
• E-Mail: K.Tomiak@Schunk-IT.com *
• SNAIL-MAIL: Schunk AND AssocIATES, INC. *
• 7 INNIS AVENUE *
• P.O. BOX 474 *
• NEW PALTZ, NY 12561-0474 *
• U.S.A. *
• PHONE: (845) 256-1010 *
• FAX2EMAIL: (888) 785-7710 *
• WEB: HTTP://WWW.Schunk-IT.COM *
• *
• *
• Important Guidelines: *
• This code was written as an information gathering sub-routine *
• intended to be called and its results used as the invoker saw *
• fit. It was intended to be a report generator. With that thought *
• in mind, carefully consider whether your change affects how a *
• parsing program will interpret the output. If a flaw in the *
• original format is found, it will have to be corrected, and then *
• any parsing invokers will have to verify they still work. Please *
• make note of such activity so that the callers are forewarned. *
• Use the line below to show you made format changes. *

• FORMAT CHANGES <<<<< *

• *
• Disclaimers: *
• I have no special knowledge of the inner workings of the *
• operating system. I attempted to return one value back to *
• indicate the same value you would have received if you used *
• NOTIFY= on the jobcard. I was working on using the highest *
• numeric COND CODE, unless there was a SYSTEM abend, unless *
• there was a USER abend. It then became desirable to show the *
• outcome of all of the steps, just as most IEFACTRT exits show *
• in your JESMSGLG. At that point I included LASTABEND= to show *
• what the jct indicates and HIGHCOND= to show what may be *
• considered the most severe error of the job using the COND CODE, *
• SYSTEM, USER sequence described above. *
• *
• The original code was developed and tested using the DATA AREAS *
• manuals and MACLIB entries from OS/390 2.10 and z/OS 1.2. My *
• testing includes steps that are designed to fail. Not every *
• system abend, user abend, nor return code value; but at least *
• two of each. *
• *
• I support my code using a best-effort philosophy. As long as I *
• have access to an image where I can test, I will maintain it as *
• best as I can. If you find a flaw, please do let me know. *
• *
• The code released by Kenneth E. Tomiak does not alter anything. *
• It follows control blocks that are outside of the IBM defined *
• 'Programming Interface'. BUYER BEWARE! Your decision to execute *
• this code means you accept responsibility for the consequences. *
• What could go wrong? If control blocks are changed or used in *
• some way I did not anticipate you may find this loops wildly; *
• tries to access storage it should not; or other yet to be *
• conceived problems. BUYER BEWARE! Always test this in a sandbox *
• MVS image if you have concerns. *
• *
• In no event will the author be liable to the user of this code *
• for any damages. Including, but not limited to, any lost *
• profits, lost savings or other incidental, consequential or *
• special damages arising out of the operation of or inability to *
• operate this code, even if the user has been advised of the *
• possibility of such damages. *
• *
• With that stated, enjoy all this has to offer. *
• 
  ===================================================================*
• *
• History of changes (top entry is the most recent change) *
• *
• 2004-04-22 Lionel B. Dyck lionel.b.dyck@kp.org *
• Correction for high condition code testing/report *
• *
• 2003-06-20 Kenneth E. Tomiak K.Tomiak@Schunk-IT.com *

• FORMAT CHANGES <<<<< *

• lengthened static 0's on Harry's "U" abend corrections *
• and converted not equal compares to ><. *
• Coded "S" indent in a different manner. Removed logic *
• inclusion of sctxabcc = '00' until I see it ever *
• occurs when sctabcnd = '04'. I did find assembler *
• invoked abends were not being handled properly so I *
• had to do some logic changes, too. *
• *
• 2003-04-19 Harry van Burik h.vanburik@pinkroccade.com *

• FORMAT CHANGES <<<<< *

• Several minor corrections to formatting *
• Indent step level "S" abend. *
• Increase length of User abend to four digits. *
• Added a check of sctxabcc=00 under sctabcnd=04. *
• *
• 2003-03-26 Kenneth E. Tomiak K.Tomiak@Schunk-IT.com *

• FORMAT CHANGES <<<<< *

• Fixed compare of high_cond when using sctsexec and *
• removed "R" if no abend occurred. *
• *
• 2003-03-24 Lionel B. Dyck lionel.b.dyck@kp.org *

• FORMAT CHANGES <<<<< *

• Split the JOB= line into two lines. *
• Set last_abend and high_cond to 0. *
• *
• 2003-03-18 Kenneth E. Tomiak K.Tomiak@Schunk-IT.com *

• FORMAT CHANGES <<<<< *

• Format Jctacode, show lastabend and highest condcode, *
• include SSIB jobid, and completed changes to swareq. *
• *
• 2003-03-17 Kenneth E. Tomiak K.Tomiak@Schunk-IT.com *
• Correct sctsexec from 9,1 to 8,2, *
• replaced Foreground check with first step check. *
• *
• 2003-03-17 Lionel B. Dyck lionel.b.dyck@kp.org *
• Add test for Foreground environment. *
• *
• 2003-03-16 Lionel B. Dyck lionel.b.dyck@kp.org *

• FORMAT CHANGES <<<<< *

• Nop other message for sctabcnd if not 04. *
• *
• 2003-03-14 Lionel B. Dyck lionel.b.dyck@kp.org *

• FORMAT CHANGES <<<<< *

• Minor cleanup (comments and spacing), *
• Changed wording of the generated messages, *
• Changed for 4 bytes for Jctacode. *
• *
• 2003-03-14 Kenneth E. Tomiak K.Tomiak@Schunk-IT.com *
• Added check for steps bypassed due to a RESTART= and *
• spruced up the comments, far more than any code I *
• usually write. Hopefully this will make it easy to *
• understand and maintain. *
• *
• 2003-03-13 Kenneth E. Tomiak K.Tomiak@Schunk-IT.com *
• Inserted SWAREQ routine from code written by: *
• Gilbert Saint-flour gsf@pobox.com *
• *
• 2003-03-13 Kenneth E. Tomiak K.Tomiak@Schunk-IT.com *
• Revamped code received from: *
• Lionel B. Dyck Lionel.B.Dyck@KPM.org *
• Original code submitted by: *
• Barry Gilder gilderb@anz.com *
• 
  ===================================================================*/

Rexx_condcode:

Parse Upper Arg Other_Junk / No parameters are used /

/+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++/
/ MAIN procedure which invokes sub-functions. /
/+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++/
Numeric Digits 12
Call Init_condcode
Call Main_condcode
Call Term_condcode
Exit Final_Rc

/+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++/
/ Initialize variables used by the code. /
/+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++/
Init_condcode:

/-------------------------------------------------------------------/
/ Follow the control blocks to the Step Control Table. /
/-------------------------------------------------------------------/
/ Psa Prefix Save Area /
/ Psa@540 Pointer of PSATOLD /
/ Psa@540=>tcb Task Control Block /
/ Psa@540=>tcb+181 Pointer of TCBJSCBB /
/ Psa@540=>tcb+181=>jscb JOBSTEP Control BLock /
/ Psa@540=>tcb+181=>jscb+261 Pointer to Job Control Table /
/ Psa@540=>tcb+181=>jscb+261=>jct Job Control Table /
/ Psa@540=>tcb+181=>jscb+261=>jct+329 Pointer to Step Control Table /
/ Psa@540=>tcb+181=>jscb+261=>jct+329=>sct Step Control Table /
/ Psa@540=>tcb+181=>jscb+261=>jct+36=>jctx Pointer to JCT eXtended /
/-------------------------------------------------------------------/
Psatold = Storage(D2x(540),4)
Tcbjscbb = Storage(D2x(C2d(Psatold)+181),3)
Jscbjct = Swareq(Storage(D2x(C2d(Tcbjscbb)+261),3))
Currsct = Swareq(Storage(D2x(C2d(Tcbjscbb)+329),3))
jctx = Storage(D2x(C2d(Tcbjscbb)+329),4)
Jscbstep = C2d(Storage(D2x(C2d(tcbjscbb)+228),1)) / Step number /
jscbssib = STORAGE(D2X(C2D(tcbjscbb)+316),4) / Pointer to SSIB /
ssibjbid = STORAGE(D2X(C2D(jscbssib)+12),8) / job identifier /

/-------------------------------------------------------------------/
/ Save A Few Fields From The Jct. /
/-------------------------------------------------------------------/
Jctjstat = Storage(D2x(C2d(Jscbjct)+ 5),1) / Job Status /
Jctjname = Storage(D2x(C2d(Jscbjct)+ 8),8) / Job Name /
Jctjfail = C2x(Storage(D2x(C2d(Jscbjct)+ 52),1)) / Job Failure /
Jctacode = Storage(D2x(C2d(Jscbjct)+168),4) / Job Abend /

Job_Stat = c2x(jctjstat)
Select
When (Bitand('20'x,jctjstat) = '20'x) Then
Job_Stat = job_stat "Cancelled By Condition Codes"
When (Bitand('08'x,jctjstat) = '08'x) Then
Job_Stat = job_stat "JCT ABend"
When (Bitand('04'x,jctjstat) = '04'x) Then
Job_Stat = job_stat "Job Failed"
When (Bitand('02'x,jctjstat) = '02'x) Then
Job_Stat = job_stat "Catalog Job"
Otherwise nop
End

Last_Abend = Interpret_Condcode(Jctacode)

High_Cond = "R000"

Final_Rc = 0
Return

/+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++/
/ The meat and potatoes of the code. /

/+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++/
/ Loop through every SCT. /
/ Determine the status of the step. /
/+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++/
Main_condcode:
/-------------------------------------------------------------------/
/ Jct+32=>1st Sct /
/-------------------------------------------------------------------/
Thissct = Swareq(Storage(D2x(C2d(Jscbjct)+32),3))

Do until ((Thissct = '10'x) ! (Thissct = Currsct))

                    /* Internal Step Status                      */
Sctsstat =    C2x(Storage(D2x(C2d(Thissct) +  4),1))

                    /* Step Status Code passed to initiator      */
Sctsexec =    C2d(Storage(D2x(C2d(Thissct) +  8),2))

                    /* Name of step that called procedure        */
Sctsclpc =  Strip(Storage(D2x(C2d(Thissct) + 44),8))

                    /* Step name                                 */
Sctsname =  Strip(Storage(D2x(C2d(Thissct) + 52),8))

                    /* Step SYStem Code                          */
Sctssysc =    c2x(Storage(D2x(C2d(Thissct) + 62),2))

                    /* Pointer to SCT Extension                  */
Sctxbttr = Swareq(Storage(D2x(C2d(Thissct) + 68),3))

                    /* Program name                              */
Sctpgmnm =        Storage(D2x(C2d(Thissct) +108),8)

                    /* 8th slot  (looks like abend code to me)   */
Sctabcnd =    C2x(Storage(D2x(C2d(Thissct) +160),1))

                    /* Start End status flags                    */
Sctstend =        Storage(D2x(C2d(Thissct) +172),1)

/-------------------------------------------------------------------/
/ Piece together a procstep.stepname combination. /
/-------------------------------------------------------------------/
If (Sctsclpc >< " ") Then
Procstep = Left(Sctsclpc"."Sctsname,17)
Else
Procstep = Left(Sctsname,17)

/-------------------------------------------------------------------/
/ Determine final status of step. /
/-------------------------------------------------------------------/
Sctxabcc = Storage(D2x(C2d(Sctxbttr)+112),4)
select
when (Jscbstep = 1) then,
do
cond_code = "Active"
Queue left(procstep,30) left(SCTpgmnm,9) Cond_Code
leave
end
when (Sctsstat = '01') Then
Cond_Code = "FLUSH - STEP WAS NOT EXECUTED"
when (Bitand('10'x,Sctstend) = '10'x) Then
Cond_Code = "FLUSH -",
"STEP WAS NOT RUN BECAUSE OF CONDITION CODES," ,
"STEP WAS NOT EXECUTED."
when (Sctabcnd = '04') Then,
Do
Sctxabcc = Storage(D2x(C2d(Sctxbttr)+112),4)
Cond_Code = Interpret_condcode(Sctxabcc)
If (Cond_code > High_cond) then,
High_Cond = Cond_code
End
when (Bitand('C0'x,Sctstend) = 'C0'x) Then,
Do
Cond_Code = Right(" "sctsexec,5)
sctsexec = right(sctsexec+100000,4)
If ("R"sctsexec > High_cond) then,
High_Cond = "R"sctsexec
End
when (Bitand('40'x,Sctstend) = '40'x) Then
Cond_Code = "BYPASSED DUE TO RESTART - STEP WAS NOT EXECUTED"
otherwise
Cond_Code = "Help me!",
sctsstat'-'sctsexec'-'sctssysc'-'sctabcnd'-'c2x(sctstend)
end
/
say "sctabcnd="sctabcnd",sctxabcc="c2x(sctxabcc),
"condcode="cond_code "high="high_cond,
"abend="last_abend
/
if (left(cond_code,1) = "S") then
Queue left(procstep,30) left(SCTpgmnm,9) " "!!Cond_Code
else
Queue left(procstep,30) left(SCTpgmnm,9) Cond_Code

/-------------------------------------------------------------------/
/ sct+20=>nextsct or '00000010'x. /
/-------------------------------------------------------------------/
Thissct = Swareq(Storage(D2x(C2d(Thissct)+20),3))
End
Return

/+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++/
/ Interprète le cond code /
/+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++/
Interpret_condcode:

select
when (Left(C2x(arg(1)),2) = '40') !,
(Left(C2x(arg(1)),2) = '80') !,
(Left(C2x(arg(1)),2) = 'C0') Then,
CC = "U"right("0000"c2d(Right(arg(1),3)),4)
when (Left(C2x(arg(1)),2) = '00') !,
(Left(C2x(arg(1)),2) = '04') !,
(Left(C2x(arg(1)),2) = '84') Then,
Do
If (substr(C2x(arg(1)),3,3) = "000") then
CC = "U"right("0000"c2d(Right(arg(1),3)),4)
Else
CC = "S"substr(C2x(arg(1)),3,3)
End
otherwise CC=0
End

Return CC

/+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++/
/ Post processing cleanup, if necessary. None required this time. /
/+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++/
Term_condcode:
High_Cond = Strip(Strip(High_Cond,"L"," "),"L","R")
Say "JOB="jctjname"("ssibjbid") JCTACODE="c2x(Jctacode),
"FAIL="jctjfail "STAT="Job_Stat
Say left(" ",22) "LASTABEND="Last_Abend,
"HIGHESTCOND="High_cond
Say left("Step.ProcStep",30) left("Program",9) " Code"
Do while Queued() > 0
parse pull stepline
say stepline
end
Return

/===================================================================/
/ Other called routines /
/===================================================================/
/+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++/
/ SWAREQ - AUTHOR = Gilbert Saint-flour gsf@pobox.com /
/ Ken says - If argument is below (not sure what that means), /
/ add 16. Otherwise, access the QMPL and add QMATs. /
/+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++/
Swareq: Procedure
If Right(C2x(Arg(1)),1) >< 'F' Then / Swa=Below ? /
Do
Result = D2c(C2d(Arg(1))+16) / Yes, Return Arg(1)+16 /
Return Result
End

/+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++/
/ Ken says - During testing of condcode I never found the code /
/ below to be referenced. It remains here because it /
/ may get copied to other programs that need it. /
/+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++/
Sva = C2d(Arg(1)) / Convert to decimal /
psatold = Storage(021C,4) / psatold /
tcbjscbb = Storage(D2x(C2d(psatold)+181),3) / tcbjscbb /
jscbqmpi = Storage(D2x(C2d(tcbjscbb)+244),4) / jscbqmpi /
qmadd = Storage(D2x(C2d(jscbqmpi)+24),4) / qmadd /
Do While Sva>65536
qmadd = Storage(D2x(C2d(qmadd)+12),4) / Next qmadd=qmadd+12 /
Sva = sva - 65536 / 010006F -> 000006F /
End
Result = , / Add qmadd to Arg(1). /
d2c(c2d(Storage(d2x(c2d(qmadd)+sva+1),4)) + 16)
Return Result

/ --- Rexx --------------------------------------------------------- /
/ Fonction EDIT d'un PDS ou d'un membre /
/ Paramètres : - néant /
/ Entrée : - néant /
/ Sortie : - néant /
/ ------------------------------------------------------------------ /

Address ISREDIT
"MACRO (param)"
if param = "PARAM" then parse arg param
parse upper value param with param
/address tso "SUBCOM ISREDIT"
if rc = 0 then address ISREDIT "MACRO (param)"
else parse upper arg param/

call initialisation
call lire_param
call ou_est_ce
call fin

exit

/----------------------------/
/ Initialisation des données /
/----------------------------/
initialisation:
call mesvar("-l "param)
src = mesvar("-g glChn")
ndv = mesvar("-g glLang")
env = mesvar("-g glEnv")
brq = mesvar("-g glBrq")
call mesvar("-p glOutils whereis")
nb = 0
trouve = 0
if src = "*" then src = mesvar(src)
return

/------------------------------------------/
/ Lecture et interprétation des paramètres /
/------------------------------------------/
lire_param:

Address ISPEXEC
select
when length(src) = 0 then do
zedsmsg = "Parametre absent"
zedlmsg = "Il me faut un nom de membre source"
"setmsg msg(isrz001)"
exit 4
end
when length(src) > 8 then do
zedsmsg = "Parametre trop long"
zedlmsg = "Il me faut un nom de membre source <8 carateres"
"setmsg msg(isrz001)"
exit 4
end
when datatype(src) = 'NUM' then do
zedsmsg = "Parametre incorrect"
zedlmsg = "Il me faut un nom de membre source"
"setmsg msg(isrz001)"
exit 4
end
when datatype(src) = 'CHAR' then nop
otherwise do
zedsmsg = "Cas non prevu"
zedlmsg = "Je ne sais pas quoi faire"
"setmsg msg(isrz001)"
exit 4
end
end

if src = "*" ! src = "=" then src = mesvar(src)

return

ou_est_ce:

if ndv = "NDV" then
call liste_ndv

else do
call cherche_presence "OTEST.NDV.STC.COBBT.BASE"
call cherche_presence "OTEST.NDV.STC.COBCO.BASE"
call cherche_presence "OTEST.NDV.STC.COBTP.BASE"
call cherche_presence "OTEST.NDV.STC.COPY.BASE"
call cherche_presence "OTEST.NDV.STC.DCLGEN.BASE"
call cherche_presence "OTEST.NDV.STC.JCL.BASE"
call cherche_presence "OQUAL.NDV.STC.COBBT.BASE"
call cherche_presence "OQUAL.NDV.STC.COBCO.BASE"
call cherche_presence "OQUAL.NDV.STC.COBTP.BASE"
call cherche_presence "OQUAL.NDV.STC.COPY.BASE"
call cherche_presence "OQUAL.NDV.STC.DCLGEN.BASE"
call cherche_presence "OQUAL.NDV.STC.JCL.BASE"
call cherche_presence "ULIVR.NDV.STC.COBBT.BASE"
call cherche_presence "ULIVR.NDV.STC.COBCO.BASE"
call cherche_presence "ULIVR.NDV.STC.COBTP.BASE"
call cherche_presence "ULIVR.NDV.STC.COPY.BASE"
call cherche_presence "ULIVR.NDV.STC.DCLGEN.BASE"
call cherche_presence "ULIVR.NDV.STC.JCL.BASE"
call cherche_presence "UINTE.NDV.STC.COBBT.BASE"
call cherche_presence "UINTE.NDV.STC.COBCO.BASE"
call cherche_presence "UINTE.NDV.STC.COBTP.BASE"
call cherche_presence "UINTE.NDV.STC.COPY.BASE"
call cherche_presence "UINTE.NDV.STC.DCLGEN.BASE"
call cherche_presence "UINTE.NDV.STC.JCL.BASE"
call cherche_presence "OMAIN.NDV.STC.COBBT.BASE"
call cherche_presence "OMAIN.NDV.STC.COBCO.BASE"
call cherche_presence "OMAIN.NDV.STC.COBTP.BASE"
call cherche_presence "OMAIN.NDV.STC.COPY.BASE"
call cherche_presence "OMAIN.NDV.STC.DCLGEN.BASE"
call cherche_presence "OMAIN.NDV.STC.JCL.BASE"
call cherche_presence "OTEST.IFUS120.REXX"
call cherche_presence "ET03.CMDPROC"
call cherche_presence "SYS1.SICECLIB"
call cherche_presence "ISP.SISPCLIB"
call cherche_presence "DB2.T$$$.SDSNCLST"
call cherche_presence "ISR.ETUD.CLIS3"
call cherche_presence "USYST.ETUD.CLIST"
call cherche_presence "ISP.SISPEXEC"
call cherche_presence "PLEX1.JCLLIB"
end

return

cherche_presence:
parse upper arg dsn

if sysdsn(dsn"("src")") = 'OK' then do
say dsn"("src")"
trouve = trouve + 1
if trouve = 1 then
call mesvar("-p glDSN "dsn)
return 1
end

return

liste_ndv:

call ndvsrc (src Env Brq)
liste = mesvar("-g glLstPrm")
parse value liste with nb"//"liste
trouve = trouve + nb

do i=1 to nb
parse value liste with prg brq stag elmt typ"/"liste
fichier = prg brq stag typ elmt
fichier = fichier!!" -> "stag".NDV."brq"."typ".BASE("elmt")"
say fichier
end

return

fin:
if trouve = 0 then
say "Aucune occurence de "src" trouvee"
else
say "Trouve "trouve" occurence(s) de "src

return

/ REXX /
ADDRESS ISREDIT
"MACRO ()"
"NUM OFF"
"CHANGE ALL 73 P'££££££££' ' '"
"LEFT MAX"
"UP MAX"
"RESET"

/ --- Rexx --------------------------------------------------------- /
/ Recherche d'une chaine dans un ensemble de PDS /
/ Paramètres : - Chaine /
/ - Environnement /
/ - Langage /
/ - PDS /
/ - Type /
/ - Edit /
/ Entrée : - néant /
/ Sortie : - néant /
/ ------------------------------------------------------------------ /

Address ISREDIT
"MACRO (param)"
if param = "PARAM" then parse arg param
parse upper value param with param

call initialisation
call traitement
call fin

exit

initialisation:

Address TSO
"ALLOC F(sysin) NEW REU UNIT(VIO) RECFM(F B) LRECL(80)"
Queue "SRCHFOR '&DB2$$$$'"
Queue "SRCHFOR '&CREATOR'"
Queue "SRCHFOR '&COLL$$$'"
Queue "SRCHFOR '&COLL1$$'"
Queue "SRCHFOR '&PLAN$$$'"
Queue "SRCHFOR '&DZ00$$$'"
Queue "SRCHFOR '&DBPA$$$'"
Queue "SRCHFOR '&DBGS$$$'"
Queue "SRCHFOR '&SG$$$$$'"
Queue "SRCHFOR '&SGIX$$$'"
Queue "SRCHFOR '&BPTS$$$'"
Queue "SRCHFOR '&BPTX$$$'"
Queue "SRCHFOR '&PDSDBRM'"
Queue "SRCHFOR '&OWNER$$'"
Queue "SRCHFOR '&QUALIF$'"
Queue "SRCHFOR '&PCTFRE1'"
Queue "SRCHFOR '&PCTFRE2'"
Queue "SRCHFOR '&PCTFR31'"
Queue "SRCHFOR '&PCTFR32'"
Queue "SRCHFOR '&PCTFRE4'"
Queue "SRCHFOR '&PCTFRE5'"
Queue "SRCHFOR '&PCTFREE'"
Queue "SRCHFOR '&FREEPA1'"
Queue "SRCHFOR '&FREEPA2'"
Queue "SRCHFOR '&FREEP31'"
Queue "SRCHFOR '&FREEP32'"
Queue "SRCHFOR '&FREEPA4'"
Queue "SRCHFOR '&FREEPA5'"
Queue "SRCHFOR '&FREEPAG'"
Queue "SRCHFOR '&CLOSE$$'"
Queue "SRCHFOR '&ERASE$$'"
Queue "SRCHFOR '&COMPRES'"
Queue "SRCHFOR '&LOCKSIZ'"
Queue "SRCHFOR '&DEFER$$'"
Queue "SRCHFOR '&CURENTD'"
Queue "SRCHFOR '&EXPLAIN'"
Queue "SRCHFOR '&DEGREE$'"
Queue "SRCHFOR '&VALIDAT'"
Queue "SRCHFOR '&ACTION$'"
Queue "SRCHFOR '&SQLERRO'"
Queue "SRCHFOR '&REOPT$$'"
Queue "SRCHFOR '&RELEASE'"
Queue "SRCHFOR '&KEEPDYN'"
Queue "SRCHFOR '&DBPROTO'"
Queue "SRCHFOR '&ENCODIN'"
Queue "SRCHFOR '&IMMEDWR'"
Queue "SRCHFOR '&FLAG$$$'"
Queue "SRCHFOR '&BPTS4$$'"
Queue "SRCHFOR '&BPTS8$$'"
Queue "SRCHFOR '&BPTS16$'"
Queue "SRCHFOR '&BPTS32$'"
Queue "SRCHFOR '&BPTS64$'"
Queue "SRCHFOR 'NOTIFY='"
Queue "SRCHFOR 'NOTIFY=&SYSUID'"
Queue "SRCHFOR 'PZ00MBDJ'"
Queue "SRCHFOR 'PZ00MBDF'"
Queue "SRCHFOR '&PDS$$$$'"
Queue "SRCHFOR '&ACT$$$$'"
Queue "SRCHFOR '&CLASS$$'"
Queue "SRCHFOR '&JOBLIB$'"
Queue "SRCHFOR '&PROCLIB'"
Queue "SRCHFOR '&NOM$$$$'"
Queue "SRCHFOR '&ALIAS$$'"
Queue "SRCHFOR '&ENVDB2$'"
Queue "SRCHFOR '&REGION$'"
Queue "SRCHFOR '&MSGCLAS'"
Queue "SRCHFOR '&SYSOUT$'"
Queue "SRCHFOR '&UNIT$$$'"
Queue "SRCHFOR '&UPGM$$$'"
Queue "SRCHFOR '&DB2PROC'"
Queue "SRCHFOR '&DB2UTID'"
Queue "SRCHFOR '&UTCHECK'"
Queue "SRCHFOR '&UTFIC$$'"
Queue "SRCHFOR '&UTSTAT$'"
Queue "SRCHFOR '&UTUNLOA'"
Queue "SRCHFOR '&UTREORG'"
Queue "SRCHFOR '&UTREBLD'"
Queue "SRCHFOR '&UTLOADR'"
Queue "SRCHFOR '&UTLOADA'"
Queue "SRCHFOR '&UTLOADV'"
Queue "SRCHFOR '&UTPROGU'"
Queue "SRCHFOR 'CHECK '"
Queue "SRCHFORC ' DATA'"
Queue "SRCHFOR 'RUNSTATS'"
Queue "SRCHFOR 'IMAGE '"
Queue "SRCHFORC ' COPY'"
Queue "SRCHFOR 'UNLOAD'"
Queue "SRCHFOR 'REORG'"
Queue "SRCHFOR 'REBUILD'"
Queue "SRCHFOR 'LOAD'"
Queue "SRCHFOR 'DSNTEP2'"
Queue "SRCHFOR 'DSNTEP4'"
Queue "SRCHFOR 'DSNTIAUL'"
"EXECIO "Queued()" DISKW sysin (FINIS"

return

traitement:

call liste "ULIVR.NDV.STC.JCL.BASE" ULIVR JCL Batch

return

fin:

return

liste:
parse arg pds reste

Address TSO
"ALLOC F(newdd) DA('"pds"') SHR REU"
"ALLOC F(outdd) NEW REU UNIT(VIO) SP(1,1) CYLINDERS"
"CALL (ISRSUPC) 'SRCHCMP,ANYC'"
"EXECIO DISKR outdd (STEM supc. FINIS"
Do i = 1 To supc.0
Parse Var supc.i word1 word2 word3 word4 .
If c2x(left(word1, 1)) ^= 'FE' &,
word2 = '---------' &,
word3 = 'STRING(S)' &,
word4 = 'FOUND' Then
say word1
End
"FREE F(newdd)"
"FREE F(outdd)"

return

Une lib JS pour afficher des formules mathématiques dans les pages web. Le rendu peut être fait en HTML et même SVG.
Il utilise la syntaxe TEX et/ou MathML.

Pour l’ajouter à une page, inclure ce fichier dans le code source : http://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML (ou télécharger le JS sur l'hébergement et lier ce fichier là).

MathJax est sous licence Apache.

IDENTIFICATION DIVISION.
PROGRAM-ID. PLANTER.

   DATA DIVISION.
   WORKING-STORAGE SECTION.

   01 PARAMETRE.
      05 P-RC          PIC X(5).
      05 FILLER        PIC X(76).

   77 TILT             PIC X            VALUE SPACES.

   77 IX               PIC XX           VALUE SPACE.
   77 I9               REDEFINES IX
                       PIC S9(3) COMP-3.

   01 TABLEAU.
      05 T-IND         PIC S99          VALUE ZERO.
      05 T-OCC                          OCCURS 10.
         10 T-LIGNE    PIC X(8).

   77 CEE3DMP          PIC X(8)         VALUE 'CEE3DMP'.
   77 CEE3ABD          PIC X(8)         VALUE 'CEE3ABD'.

   01 ABEND-CODE          PIC S9(7) BINARY VALUE 2011.
   01 ABEND-TYPE          PIC S9(7) BINARY VALUE 1.

   PROCEDURE DIVISION.

       ACCEPT PARAMETRE

       EVALUATE P-RC
       WHEN 'ABEND'
          CALL CEE3ABD USING ABEND-CODE ABEND-TYPE

       WHEN 'RC04'
          MOVE  4                TO RETURN-CODE

       WHEN 'RC08'
          MOVE  8                TO RETURN-CODE

       WHEN 'RC12'
          MOVE 12                TO RETURN-CODE

       WHEN 'RC16'
          MOVE 16                TO RETURN-CODE

       WHEN 'S806'
          CALL TILT

       WHEN 'S0C4'
          PERFORM VARYING T-IND FROM 1 BY -1 UNTIL T-IND = 12
             MOVE T-LIGNE(T-IND) TO TILT
          END-PERFORM

       WHEN 'S0C7'
          ADD 1                  TO I9

       WHEN 'S0CB'
          MOVE 1                 TO I9
          DIVIDE I9 BY T-IND GIVING T-IND

       WHEN 'U4087'
          CALL CEE3DMP

       WHEN OTHER
          MOVE ZERO              TO RETURN-CODE

       END-EVALUATE

       STOP RUN.

/ REXX /

Parse Upper Arg OPT InfoSup
if OPT = '' then do
'ISREDIT MACRO (PARAM1) NOPROCESS'
Parse Upper var PARAM1 OPT InfoSup
end
Info.0 = Words(InfoSup)
If Info.0 > 1 Then ,
Parse Upper Var InfoSup Info.1 " " Info.2 " " Info.3 " " Info.4
else Info.1 = InfoSup

Address ISPEXEC
"CONTROL ERRORS RETURN"
ZEDSMSG = ""
ZEDLMSG = ""
MSG000b = " "
EDIT = "BROWSE"
Panel = "UTSO01"

If OPT = "H" ! OPT = "AIDE" Then do
Help:
MSG0001 = "Option U (Utilities),"
MSG0002 = "ou 1,2,3,4,5,6,8,9,10,11,12,13,14, "
MSG0003 = "Option S(SYSVIEW) "
MSG0004 = "Option F(FileAid), DCF(DCF) ET DT(Dialog Test), "
MSG0005 = "Option B(Browse), E(Edit), PDS(PDSman)... "
MSG0006 = "Option REC(RECovery), INITREC(INIT RECovery). "
ZEDLMSG = ZEDLMSG!!MSG0001!!MSG0002!!MSG000b
ZEDLMSG = ZEDLMSG!!MSG0003!!MSG000b!!MSG0004!!MSG000b
ZEDLMSG = ZEDLMSG!!MSG0005!!MSG000b
Address ISPEXEC "SETMSG MSG(ISRZ000)"
exit
End

Parm = ""
Applid = "()"
do i=1 to Info.0
Select
When (Info.i = "TEST" ! Info.i = "TRACE") Then Trace I
When (Info.i = "H") Then PARM = "H"
When (Info.i = "I") Then PARM = "I"
When (Info.i = "O") Then PARM = "O"
When (Info.i = "DA") Then PARM = "DA OJOB"
When (Info.i = "LOG") Then PARM = "LOG"
When (substr(Info.i,1,2) = "A(") ,
Then Applid = substr(Info.I,2,8)
When (substr(Info.i,1,2) = "M(") ,
Then Membre = substr(Info.I,2,8)
When (substr(Info.i,1,1) = "E") Then Do
EDIT = "EDIT"
Panel = "UTSO02"
End
Otherwise Nop
End
End

IF DataType(OPT) = NUM & ,
OPT ^= 7 & ,
OPT ^> 15 ,
Then "SELECT PANEL(ISRUTIL) OPT("OPT")"
ELSE DO
IF DataType(OPT) = NUM Then OPT = "U"
SELECT
WHEN OPT="S" Then do
"SELECT CMD(GSVXSPF ) NEWAPPL(GSVX) NOCHECK MODE(FSCR)"
end

     WHEN OPT="B" Then "SELECT PGM(ISRBRO) PARM(ISRBRO01)"

     WHEN OPT="E" Then "SELECT PGM(ISREDIT) PARM(P,ISREDM01)"

     WHEN OPT="U" Then "SELECT PANEL(ISRUTIL)"

     WHEN OPT="PRIM" Then "SELECT PANEL(ISRàPRIM)"

     WHEN OPT="MSTR" Then "SELECT PANEL(ISPàMSTR)"

WHEN OPT="V" Then "EDIT DATASET('"userid().UTSO"') PANEL(UTSO02)"

     WHEN OPT="W" THEN DO
           "VGET (ZSSFLDS)"
           ZODSN = ZSSFLDS
           ""EDIT" DATASET("ZODSN") PANEL("PANEL")"
         END
     WHEN OPT="Y" THEN DO
           "VGET (SCEOTFL)"
           ZODSN = SCEOTFL
           ""EDIT" DATASET("ZODSN") PANEL("PANEL")"
         END

     WHEN OPT="G" Then Do
           M = Strip(Membre)
           ZODSN = "'P893LB.SOURCE.GENPGM"M"'"
           ""EDIT" DATASET("ZODSN") PANEL("Panel")"
         End

     WHEN OPT="DT" Then DO
         "SELECT PGM(ISPYXDR) PARM"Applid" NOCHECK"
         End

     WHEN OPT="INITREC" Then DO
         "EDREC INIT"
         If RC = 4 Then Say " ALREADY EXISTS "
         End

     WHEN OPT="REC" Then DO
         "SELECT PGM(ISREDIT) PARM(P,ISREDM01) NEWAPPL"Applid
         End

     WHEN OPT="PDS" Then Address TSO "%PDSM£C18"
     WHEN OPT="P"   Then Address TSO "%PDSALC1"
     WHEN OPT="P7"  Then Address TSO "%PDSMAN OPT(7)"
     WHEN OPT="P13" Then Address TSO "%PDSMAN OPT(13)"

     WHEN OPT="DCF" Then "SELECT PGM(ISRFPR) PARM((ISRFP09) 9) NEWPOOL"

     WHEN OPT="F" Then "SELECT CMD(%FLAALC) NOCHECK"

     WHEN OPT="DB2" Then "SELECT CMD(%DB2ALC) NOCHECK"

     OtherWise Do
          MSG0err = "Option Invalide"
          ZEDLMSG =  ZEDLMSG!!MSG0err!!MSG000b
          Signal Help

     End
   End
 End

/ Rexx ------------------------------------- QDS Display Des Doubles /
/ Appel _ QDS COL LG LDEB LFIN SELECT /
/ Param tres _ COL Colonne de recherche (position) /
/ _ LG Longueur du crit re de recherche /
/ _ LDEB,LFIN Ligne D but et Ligne fin /
/ _ SELECT = ALL pour afficher l'enreg. et son double /
/ SELECT = " " pour afficher les doubles seulement /
/ Defauts : QDS 1 LRECL .ZF .ZL /
/ ---------------------------------------------- Display Des Doubles /
Address ISPEXEC
"IsrEdit Macro (COL LG LDEB LFIN SELECT)"
Upper COL LG LDEB LFIN SELECT
If Col='?' Then
Do
Call Help
Exit
End
"ISREDIT (LONG) = LRECL"
If LG = "ALL" ! COL = "ALL" ! LDEB = "ALL" ! LFIN = "ALL" ,
Then SELECT = "ALL"
If COL = "" ! COL = "ALL" Then COL = 1
If LG = "" ! LG = "ALL" Then LG = LONG - COL + 1
If LDEB = "" ! LDEB = "ALL" Then LDEB = .ZF
If LFIN = "" ! LFIN = "ALL" Then LFIN = .ZL

"ISREDIT (LPOS) = CURSOR" / Sauvegarde Positionnement /
"ISREDIT CURSOR = "LFIN
"ISREDIT (LMAX) = CURSOR" / Limite Superieure /
"ISREDIT CURSOR = "LDEB
"ISREDIT (LINE) = CURSOR" / Limite Inferieure /
fin=Lg+col-1
"Isredit Sort "Col fin
"ISREDIT EXCLUDE ALL"

EXLINE = 0
"ISREDIT (DataLine) = LINE "LINE
SEARCH = SUBSTR(DataLine,COL,LG)
LINE = LINE + 1
Do While LINE <= LMAX
"ISREDIT (LINEDATA) = LINE "LINE
If SubStr(LINEDATA,COL,LG) <> SEARCH Then Do
PREV = LINE - 1
If SELECT= "ALL" Then "ISREDIT RESET "PREV LINE
ELSE do
"ISREDIT RESET "LINE LINE
Exline=Exline+1
End
SEARCH = SubStr(LINEDATA,COL,LG)
End
Else Do
PREV = LINE - 1
"IsrEdit Exclude '"Search"'"
Exline=Exline-1
End
LINE = LINE + 1
End
Exline=Exline+1
ZEDLMSG = "Recherche en colonne "COL" sur "LG" de long . "!!,
Exline" Lignes affich es."
"SETMSG MSG(ISRZ000)"

"ISREDIT CURSOR = "LPOS
exit
Help:
Say "------------ Q D S ----- Quick Display Single --------------"
Say " Appel QDS COL LG LDEB LFIN SELECT "
say " Parametres COL Colonne de recherche (position) "
say " LG Longueur du critere de recherche "
Say " LDEB,LFIN Ligne Debut et Ligne fin "
Say " _ SELECT = ALL pour afficher l'enreg. en double "
SAy " SELECT = ' ' pour afficher les 'Single' seulement"
Say " Defauts : QDS 1 LRECL .ZF .ZL "
Say " Attention les enreg. sont tries sur le critere de recherche. "
Say " --------------------------------------- Display Des 'Single'-"
Return

/ REXX /
ADDRESS ISREDIT
"MACRO ()"
"NUM OFF"
"CHANGE ALL 73 P'££££££££' ' '"
"CHANGE ALL 1 P'======' ' '"
"HILITE AUTO PAREN"
"CAPS ON"
"LEFT MAX"
"UP MAX"
"RESET"

/ REXX /
ADDRESS ISREDIT
"MACRO (M)"
'RECOVERY ON'
'NUMBER OFF'
'CHANGE ALL 73 P"££££££££" " "'
'LEFT MAX'
'RESET'
'DELETE NX ALL'
IF M = '' THEN '(M) = MEMBER'
'PASTE 'M

/ REXX /
ADDRESS ISREDIT
"MACRO (M)"
'RESET'
IF M = '' THEN '(M) = MEMBER'
'CUT .ZF .ZL 'M

FREE FI(SYSPROC)
ALLOC FI(SYSPROC) SHR REUSE +
DA( +
'OTEST.&SYSUID..REXX' +
'ET03.CMDPROC' +
'SYS1.ISP.SISPCLIB' +
'DSN810.SDSNCLST.D2011179' +
'ISR.ETUD.CLIS3' +
'USYST.ETUD.CLIST' +
)
/ /
FREE FI(SYSEXEC)
ALLOC FI(SYSEXEC) SHR REUSE +
DA( +
'OTEST.&SYSUID..REXX' +
'ISP.SISPEXEC' +
)
/ /

/ --- Rexx --------------------------------------------------------- /
/ MesVar V2 Guillaume LACAN /
/ /
/ Sauvegarde et récupération de variables d'environnement perso /
/ /
/ Syntaxe : - mesvar2 [-l] /
/ lecture des paramètres passés en ligne /
/ - mesvar2 -g <param> [defaut] /
/ retourne la valeur stockée pour <param>/
/ retourne la valeur [defaut] si <param> /
/ n'est pas stocké /
/ - mesvar2 -p <param> <valeur> /
/ stocke la <valeur> pour <param> /
/ /
/ Paramètres : - variable à écrire ou lire /
/ - valeur de la variable à écrire /
/ - rebelotte le cas échéant /
/ /
/ Variables spéciales : - -> derniere chaine traitée /
/ - = -> membre actuellement ouvert /
/ - $ -> dernier DSN traité /
/ - > -> sauve le dernier outil appelé /
/ - < -> retire le dernier outil appelé /
/ - <<<< -> vide la liste des outils /
/ /
/ Entrée : - néant /
/ /
/ Sortie : - valeur de la variable lue /
/ ou - code retour d'exécution du module /
/ /
/ ------------------------------------------------------------------ */

parse upper arg option parametre valeur
/say ">>"option"+"parametre"+"valeur/

call initialisation
call traiter_les_parametres
call fin

initialisation:

glChn = "" / Chaîne de caractères /
glMmb = "" / Membre /
glDSN = "" / DSN /
glLstPrm = "" / Liste des paramètres passés en ligne de commande /
glEnv = "" / Environnement TSO /
glSSID = "" / SSID DB2 /
glOwner = "" / Owner DB2 /
glLang = "" / Langage informatique /
glBTP = "" / Batch / TP / mixte /
glBrq = "" / Brique /
glEdit = "" / Edit / View /
glStdOut = "" / Sortie standard /

glLigCrs = "" / Ligne où est positionné le curseur /
glColCrs = "" / Colonne où est positionné le curseur /
glLigFic = "" / Contenu de la ligne pointée par le curseur /
glMotCur = "" / Mot pointé par le curseur /

if option = "-L" then do
address ispexec "vput glMmb"
address ispexec "vput glDSN"
address ispexec "vput glLstPrm"
address ispexec "vput glEnv"
address ispexec "vput glSSID"
address ispexec "vput glOwner"
address ispexec "vput glLang"
address ispexec "vput glBTP"
address ispexec "vput glBrq"
address ispexec "vput glEdit"
end

alphabet = "a b c d e f g h i j k l m n o p q r s t u v w x y z"
alphabet = alphabet" A B C D E F G H I J"
alphabet = alphabet" K L M N O P Q R S T U V W X Y Z"
alphabet = alphabet" 0 1 2 3 4 5 6 7 8 9"
lst_param_spec = "= * $ < > <<<<"
renvoyer = ""

call traiter_le_curseur

return

traiter_les_parametres:

select
/when option = "" then call lire_param_ligne_commande/
when option = "-L" then call lire_param_ligne_commande
when option = "-G" then call get_param
when option = "-P" then call put_param
when wordpos(option,lst_param_spec) /= 0
then do
parametre = option
renvoyer = param_special()
end
otherwise call anomalie_parametre
end

return

fin:

exit renvoyer
return

traiter_le_curseur:

address tso "subcom isredit"
if rc = 0 then return

address ISREDIT "(glLigCrs, glColCrs) = CURSOR"
address ISREDIT "(glLigFic) = LINE .ZCSR"

if glColCrs = 0 then return
if glColCrs = "" then return
say glLigCrs glColCrs

do i = glColCrs to 1 by -1
lettre = substr(glLigFic,i,1)
if wordpos(lettre,alphabet) = 0 then leave
else motd = i
end
do i = glColCrs + 1 to length(linedata)
lettre = substr(glLigFic,i,1)
if wordpos(lettre,alphabet) = 0 then leave
else motf = i
end
lg = motf - motd + 1
glMotCur = substr(glLigFic,motd,lg)
glChn = substr(glLigFic,motd,lg)

return

lire_param_ligne_commande:

param = strip(parametre" "valeur)
if param = "" then do
zedsmsg = "Erreur parametres"
zedlmsg = "Il n'y a pas de parametres en lignes de commande"
address ispexec "setmsg msg(isrz001)"
exit 8
end

glLstPrm = param
address ispexec "vput glLstPrm"

do forever
if param = "" then leave
parse upper value param with parametre param

 if glChn = "" then do
    if wordpos(parametre,lst_param_spec) /= 0 then do
       call param_special
       parametre = renvoyer
       end
    glMmb = parametre
    address ispexec "vput glMmb"
    glChn = parametre
    address ispexec "vput glChn"
    iterate
 end

 if param_DB2()     then iterate
 if param_lang()    then iterate
 if param_env()     then iterate
 if param_brq()     then iterate
 if param_btp()     then iterate
 if param_edit()    then iterate
 if param_special() then iterate
 if param_stdout()  then iterate

end

return

param_DB2:

if glOwner <> "" then return 0

select
when parametre = "SYSIBM" then do
if glSSID = "" then glSSID = "DO31"
glOwner = parametre
end
when parametre = "TM00" then do / ROL UR /
glSSID = "DT41"
glOwner = parametre
end
when parametre = "TOZ0" then do / Test BT /
glSSID = "DO31"
glOwner = parametre
end
when parametre = "TOM0" then do / MAC 0 /
glSSID = "DO31"
glOwner = parametre
end
when parametre = "TOM1" then do / MAC 1 /
glSSID = "DO31"
glOwner = parametre
end
when parametre = "TOM2" then do / MAC 2 /
glSSID = "DO31"
glOwner = parametre
end
when parametre = "TOM3" then do / MAC 3 /
glSSID = "DO31"
glOwner = parametre
end
when parametre = "QOZ0" then do / Intégration BT /
glSSID = "DO31"
glOwner = parametre
end
when parametre = "IUZ0" then do / PréProd BT /
glSSID = "DI31"
glOwner = parametre
end
when parametre = "IX01" then do
glSSID = "DI41"
glOwner = parametre
end
when parametre = "QUG1" then do
glSSID = "DU31"
glOwner = parametre
end
when parametre = "QUZ9" then do
glSSID = "DU31"
glOwner = parametre
end
when parametre = "TOP1" then do
glSSID = "DO31"
glOwner = parametre
end
when parametre = "QOF0" then do
glSSID = "DO31"
glOwner = parametre
end
when parametre = "QUP1" then do
glSSID = "DU31"
glOwner = parametre
end
when parametre = "RA86" then do
glSSID = "DR41"
glOwner = parametre
end
otherwise nop
end

if glOwner = "" then return 0
else do
address ispexec "vput glSSID"
address ispexec "vput glOwner"
end

return 1

param_lang:

if glLang <> "" then return 0

select
when parametre = "SOURCE" then glLang = parametre
when parametre = "SOURCEX" then glLang = parametre
when parametre = "COBOL" then glLang = parametre
when parametre = "COPY" then glLang = parametre
when parametre = "DCLGEN" then glLang = parametre
when parametre = "ASM" then glLang = parametre
/when parametre = "APS" then glLang = parametre /
/when parametre = "APSCOB" then glLang = parametre /
when parametre = "NDV" then glLang = parametre
when parametre = "JCL" then glLang = parametre
when parametre = "JCLX" then glLang = parametre
when parametre = "PARAM" then glLang = parametre
when parametre = "PROC" then glLang = parametre
when parametre = "REXX" then glLang = parametre
when parametre = "SQL" then glLang = parametre
otherwise nop
end

if glLang = "" then return 0
else address ispexec "vput glLang"

return 1

param_env:

if glEnv <> "" then return 0

select
when parametre = "PERSO" then glEnv = parametre
when parametre = "OTEST" then glEnv = parametre
when parametre = "OQUAL" then glEnv = parametre
when parametre = "UQUAL" then glEnv = parametre
when parametre = "URECE" then glEnv = parametre
when parametre = "ULIVR" then glEnv = parametre
otherwise nop
end

if glEnv = "" then return 0
else address ispexec "vput glEnv"

return 1

param_brq:

if glBrq <> "" then return 0

select
when parametre = "BAC" then glBrq = parametre
when parametre = "BRF" then glBrq = parametre
when parametre = "BST" then glBrq = parametre
when parametre = "MIG" then glBrq = parametre
when parametre = "STC" then glBrq = parametre
when parametre = "TEC" then glBrq = parametre
otherwise nop
end

if glBrq = "" then return 0
else address ispexec "vput glBrq"

return 1

param_btp:

if glBTP <> "" then return 0

select
when parametre = "COBCO" then glBTP = parametre
when parametre = "BATCH" then glBTP = parametre
when parametre = "TP" then glBTP = parametre
otherwise nop
end

if glBTP = "" then return 0
else address ispexec "vput glBTP"

return 1

param_edit:

if glEdit <> "" then return 0

select
when parametre = "EDIT" then glEdit = parametre
when parametre = "VIEW" then glEdit = parametre
otherwise
end

if glEdit = "" then return 0
else address ispexec "vput glEdit"

return 1

param_special:

select
when parametre = "" then do
/ Dernière chaîne paramétrée */
address ispexec "vget glChn"
renvoyer = glChn
return 1
end

when parametre = "=" then do
/ Membre actuellement ouvert /
address isredit "(glMmb) = member"
renvoyer = glMmb
return 1
end

when parametre = "$" then do
/ Récupération du dernier DSN paramétré /
address ispexec "vget glDSN"
renvoyer = glDSN
return 1
end

when parametre = ">" then do
/ Enregistrement du dernier outil perso appelé à la liste /
address ispexec "vget glOutils"
renvoyer = word(glOutils,words(glOutils))
return 1
end

when parametre = "<" then do
/ Suppression du dernier outil perso appelé de la liste /
address ispexec "vget glOutils"
if rc = 0 then do
renvoyer = wordindex(glOutils,words(glOutils))-1
glOutils = left(glOutils,renvoyer)
address ispexec "vput glOutils"
renvoyer = rc
end
return 1
end

when parametre = "<<<<" then do
/ RAZ de glOutils /
address ispexec "verase glOutils"
renvoyer = rc
return 1
end

when listdsi(parametre) < 5 then do
/ Enregistrement du dernier DSN paramétré /
glDSN = parametre
address ispexec "vput glDSN"
return 1
end

otherwise nop

end

return 0

param_stdout:

if glStdOut <> "" then return 0

if parametre(1:1) = ">" then
glStdOut = right(parametre, length(parametre)-1)

if glStdOut = "" then return 0
else address ispexec "vput glStdOut"

return 0

get_param:

select
when parametre = "GLCHN" then do
address ispexec "vget glChn"
if glChn <> "" then valeur = glChn
end
when parametre = "GLMMB" then do
address ispexec "vget glMmb"
if glMmb <> "" then valeur = glMmb
end
when parametre = "GLDSN" then do
address ispexec "vget glDSN"
if glDSN <> "" then valeur = glDSN
end
when parametre = "GLLSTPRM" then do
address ispexec "vget glLstPrm"
if glLstPrm <> "" then valeur = glLstPrm
end
when parametre = "GLENV" then do
address ispexec "vget glEnv"
if glEnv <> "" then valeur = glEnv
end
when parametre = "GLSSID" then do
address ispexec "vget glSSID"
if glSSID <> "" then valeur = glSSID
end
when parametre = "GLOWNER" then do
address ispexec "vget glOwner"
if glOwner <> "" then valeur = glOwner
end
when parametre = "GLLANG" then do
address ispexec "vget glLang"
if glLang <> "" then valeur = glLang
end
when parametre = "GLBTP" then do
address ispexec "vget glBTP"
if glBTP <> "" then valeur = glBTP
end
when parametre = "GLBRQ" then do
address ispexec "vget glBrq"
if glBrq <> "" then valeur = glBrq
end
when parametre = "GLEDIT" then do
address ispexec "vget glEdit"
if glEdit <> "" then valeur = glEdit
end
when parametre = "GLSTDOUT" then do
address ispexec "vget glStdOut"
if glStdOut <> "" then valeur = glStdOut
end
otherwise nop
end

renvoyer = valeur

return

put_param:

select
when parametre = "GLCHN" then do
glChn = valeur
address ispexec "vput glChn"
end
when parametre = "GLMMB" then do
glMMb = valeur
address ispexec "vput glMmb"
end
when parametre = "GLDSN" then do
glDSN = valeur
address ispexec "vput glDSN"
end
when parametre = "GLLSTPRM" then do
glLstPrm = valeur
address ispexec "vput glLstPrm"
end
when parametre = "GLENV" then do
glEnv = valeur
address ispexec "vput glEnv"
end
when parametre = "GLSSID" then do
glSSID = valeur
address ispexec "vput glSSID"
end
when parametre = "GLOWNER" then do
glOwner = valeur
address ispexec "vput glOwner"
end
when parametre = "GLLANG" then do
glLang = valeur
address ispexec "vput glLang"
end
when parametre = "GLBTP" then do
glBTP = valeur
address ispexec "vput glBTP"
end
when parametre = "GLBRQ" then do
glBrq = valeur
address ispexec "vput glBrq"
end
when parametre = "GLEDIT" then do
glEdit = valeur
address ispexec "vput glEdit"
end
when parametre = "GLSTDOUT" then do
glStdOut = valeur
address ispexec "vput glStdOut"
end
otherwise nop
end

renvoyer = rc

return

anomalie_parametre:

zedsmsg = "Option eronnee"
zedlmsg = "-g / -l / -p"
address ispexec "setmsg msg(isrz001)"
/say "Option demandee : "option
say "Parametre passe : "parametre
say "Valeur donnee : "valeur/
exit 8

return

/ --- Rexx --------------------------------------------------------- /
/ Fonction EDIT d'un PDS ou d'un membre /
/ Paramètres : - néant /
/ Entrée : - néant /
/ Sortie : - néant /
/ ------------------------------------------------------------------ /

Address ISREDIT
"MACRO (DSN)"
"(LigCurs, ColCurs) = CURSOR"
if DSN = "DSN" then parse upper arg DSN

call initialisation
call lire_param

call restpref
exit

/----------------------------/
/ Initialisation des données /
/----------------------------/
initialisation:
fichier = ""
dsnpos = 0
call SavePref
return

/------------------------------------------/
/ Lecture et interprétation des paramètres /
/------------------------------------------/
lire_param:

fichier = àjcl$dd(DSN)
if datatype(fichier) = 'CHAR' then do
Address ISPEXEC
"edit dataset('"fichier"')"
end

return

/---------------------/
/ save prefix routine /
/---------------------/
savepref:

Address ISREDIT
sprefx = '' / save prefix /
uprefx = userid() / user prefix /
prefx = sysvar(syspref) / get prefix variable /
if prefx <> '' then do / if profile prefix /
sprefx = prefx / save it /
"profile noprefix" / work without prefix /
end
return / return to caller /

/------------------------/
/ restore prefix routine /
/------------------------/
restpref:

Address ISREDIT
prefx = sysvar(syspref) / get prefix variable /
if prefx = '' then do / if profile noprefix /
if sprefx <> '' then do / if saved /
prefx = sprefx / restore it /
"profile prefix("prefx")" / work with prefix /
end
end
return / return to caller /

end

return / return to caller /

/ --- Rexx --------------------------------------------------------- /
/ Fonction EDIT d'un PDS ou d'un membre /
/ Paramètres : - néant /
/ Entrée : - néant /
/ Sortie : - néant /
/ ------------------------------------------------------------------ /

Address ISREDIT
"MACRO (DSN)"
"(LigCurs, ColCurs) = CURSOR"
if DSN = "DSN" then parse upper arg DSN

call initialisation
call lire_param

call restpref
exit

/----------------------------/
/ Initialisation des données /
/----------------------------/
initialisation:
fichier = ""
dsnpos = 0
call SavePref
return

/------------------------------------------/
/ Lecture et interprétation des paramètres /
/------------------------------------------/
lire_param:

Address ISREDIT
select
when length(DSN) = 0 then do
"(Lig, Col) = CURSOR"
"(LINEDATA) = LINE .ZCSR"
end
when datatype(DSN) = 'NUM' then do
"CURSOR="DSN" 0"
"(LINEDATA) = LINE .ZCSR"
end
when datatype(DSN) = 'CHAR' then do
fichier = DSN
dsnpos = 1
end
otherwise exit
end

Address ISPEXEC
if length(fichier) = 0 then do
lig=translate(LINEDATA,' ','=')
lig=translate(lig,' ',',')
dsnpos=wordpos('DSN',lig)
end
if dsnpos=0 then do
zedsmsg = ""
zedlmsg = "Pas de fichier ou de PDS sur la ligne"
"setmsg msg(isrz001)"
end
else do
if length(fichier) = 0 then fichier=word(lig,dsnpos+1)
bof = sysdsn(fichier)
if bof = 'OK' then do
Address TSO
"ALLOC DD(IN) DS("fichier") SHR REUSE"
"EXECIO * DISKR IN (STEM bof. FINIS"
"FREE F(IN)"
Address ISPEXEC
if bof.0 > 0 then
"browse dataset('"fichier"')"
else do
zedsmsg = "Fichier vide"
zedlmsg = ""
"setmsg msg(isrz001)"
end
end
else do
zedsmsg = "Fichier non catalogué"
zedlmsg = fichier' 'bof
"setmsg msg(isrz001)"
end
end
return

/---------------------/
/ save prefix routine /
/---------------------/
savepref:

Address ISREDIT
sprefx = '' / save prefix /
uprefx = userid() / user prefix /
prefx = sysvar(syspref) / get prefix variable /
if prefx <> '' then do / if profile prefix /
sprefx = prefx / save it /
"profile noprefix" / work without prefix /
end
return / return to caller /

/------------------------/
/ restore prefix routine /
/------------------------/
restpref:

Address ISREDIT
prefx = sysvar(syspref) / get prefix variable /
if prefx = '' then do / if profile noprefix /
if sprefx <> '' then do / if saved /
prefx = sprefx / restore it /
"profile prefix("prefx")" / work with prefix /
end
end
return / return to caller /