zOs/REXX.O13/CD

/* copy cd begin **************************************************
   send the file frDsn from the current not
            to the node toNode as toDsn if not empty
            using connect direct
            default attributes may be overridden (inDISP=(OLD))
            or additional connect direct attributes may be specified
            in argument 4 with syntax a=b c = d etc.
***********************************************************************/
cd: procedure expose m.
    parse upper arg frDsn, toNode, args
    if toNode == 'RZ1' | toNode == 'RZ2' then
        toNode = 'SKA.'toNode
    toDsn = 'outDsn...fehlt'
    as = wrArgs("CD.AS", 0             ,
        , "SIGNON"                     ,
        , "   SUBMIT PROC=MVS03DSN     - " ,
        , "NEWNAME=PVT760MP            - " ,
        , "MAXDELAY=UNLIMITED          - " ,
        , "&DEST="toNode              "- " ,
        , "&INDSN="frDsn              "- " ,
        , "&INDISP=(SHR,KEEP,KEEP)     - " ,
        , "&OUTDSN="toDsn             "- " ,
        , "&OUTDISP=(NEW,CATLG,DELETE) - " )
    call scanBegin s, args
    call trc 'scanBegin' args
    ax = 0
    do while scanKeyValue(s, 1, 1)
        k = m.s.key
        if k = 'DSN' | k == 'OUTDSN' then do
            k = 'OUTDSN'
            toDsn = m.s.val
            end
        do y=2 to m.as.0
            px = pos(k'=', m.as.y)
            if px > 0 then
                leave
            end
        if px > 0 then do
            m.as.y= left(m.as.y, px-1)k'='m.s.val '-'
            end
        else do
            ax = ax + 1
            call wrArgs as, , "&OPARM" || ax || "="k"="m.s.val "-"
            end
        end
    call scanVerify s, ' '
    if ^scanAtEol(s) then
        call scanErr s, 'key = value expected'
    if pos('..', toDsn) > 0 then
        call err 'no dsn specified in' args

    say 'sending' frDsn 'to' toNode toDsn 'with connect direct'
    hx = m.as.0
    m.as.hx = left(m.as.hx, length(m.as.hx) - 1)
    call wrArgs as, , 'SIGNOFF'
    if m.trace == 1 then do
        call trc 'connectDirect sysin'
        call out as
        end

    if m.foreground then
        if listdsi('dmpublib FILE') = 0 then
            call err 'dmPublib already allocated, cdadm running?'
    doAlloc = m.foreground

    call adrTso "alloc new delete  dd(sysIN) recfm(f,b) lrecl(80)"
    call writeDDBegin sysin
    call wrDSfromDS 'dd=sysIn', 'stem='as

    if doAlloc then do
        say 'dynamically allocating connectDirect files'
        call adrTso "alloc dd(DMPUBLIB) shr" ,
             "dsn('JOBP.FT1A.PRCS' 'SFT.DIV.X0.CD.PRCS')"
        call adrTso "alloc dd(DMNETMAP) shr dsn('SFT.SKA.P0.CD.NETMAP')"
        call adrTso "alloc dd(DMMSGFIL) shr dsn('SFT.DIV.X0.CD.MSG')"
        call adrTso "alloc dd(DMPRINT) sysout(T)"
        end

    call trc "everything allocated callin dmBatch"
    cdRc = adrTso("CALL *(DMBATCH) 'YYSLYNN'", '*')
    call trc 'dmBatch rc' cdRc
    call adrTso "free dd(sysin)"
    if doAlloc  then
        call adrTso "free dd(DMPUBLIB DMPRINT DMNETMAP DMMSGFIL)"
    if cdRc ^= 0 then
        call err 'rc' cdRc 'in connectDirect'
    return
endProcedure cd

/* copy cd end   ******************************************************/