**FREE
/TITLE GETJOBTR Get Active Job Type:  Interactive, Batch, whatever
// -------------------------------------------------------------------
// This program is passed job name, user and job number and if the
// job is active, it returns the job type, otherwise returns ' '.
// Initially written to be called from GETOBJUR.
//=== Parameters =================================================
// Input Parm:
//   Job name -  10 char job name + 10 char user + 6 char job number,
//               or * for job program is running in.
// Out Parm:
//   Type - 1 character as returned by the QUSLJOB API.
//     I=Interactive, B=Batch, blank is job not active.
//     A=Autostart, M=subsystem monitor, R=spooled reader,
//     S=system job, W=spooled writer, X=SCPF system job.
//Compile: CRTBNDRPG PGM(GETJOBTR) SRCFILE(...) DBGVIEW(*LIST)
// -------------------------------------------------------------------
// 12/00/97 LENNON Original Writing
// 07/--/2021 Lennon Converted to **FREE and Linear module.
//            It was origially a standalone program. Perhaps it should
//            be a service program and perhaps some of the diract API
//            call should be in a service program.
// -------------------------------------------------------------------
ctl-opt debug option(*nodebugio: *srcstmt)
    dftactgrp(*no) actgrp(*caller)
    main(Main);
/copy USPHDR
//=== CRTUSRSPC (QUSCTRUS) Parameters ================================
dcl-s CusName char(20) inz('GETJOBTR  QTEMP');
dcl-s CusAttr char(10) inz('GETJOBTR  ');
dcl-s CusIntSize bindec(9);
dcl-s CusIntVal char(1) inz(x'00');
dcl-s CusAut char(10) inz('*CHANGE');
dcl-s CusText char(50) inz('GETJOBTR  ');
dcl-s CusReplace char(10) inz('*NO');
dcl-s CusDomain char(10) inz('*DEFAULT');
//=== List Job (QUSLJOB) Parameters ==================================
dcl-s LJBFormat char(8) inz('JOBL0100');
dcl-s LJBQJobName char(26);
dcl-s LJBStatus char(10) inz('*ACTIVE');
//=== List Job Entry Layout ==========================================
dcl-ds LJLEntry based(ljptr);
    LJJobName char(10);
    LJJobUser char(10);
    LJJobNum char(6);
    LJJobIdent char(16);
    LJJobStus char(10);
    LJJobType char(1);
    LJJobSubT char(1);
    LJReserved char(2);
end-ds;
dcl-s LJPtr pointer inz(*null);
//=== Send Pgm Message (QMHSNDPM) Parameters =========================
dcl-s MSNMsgId char(7);
dcl-s MSNFile char(20) inz('QCPFMSG   *LIBL     ');
dcl-s MSNData char(1);
dcl-s MSNLength bindec(9);
dcl-s MSNType char(10) inz('*ESCAPE');
dcl-s MSNStackE char(10) inz('*CTLBDY');
dcl-s MSNStackC bindec(9) inz(1);
dcl-s MSNMsgKey char(4);
//=== API Error Code Structure =======================================
dcl-ds APIError len(272);
    APIEProv int(10) inz(0) pos(1);
    APIEAvail int(10) inz(0) pos(5);
    APIErrId char(7) pos(9);
    APIErrRsv char(1);
    APIEData char(256);
end-ds;
dcl-pr p_qusdltus extpgm('QUSDLTUS');
    *n char(20); // CusName
    *n char(272); // APIError
end-pr;
//------------------------------------------------------
dcl-pr p_qmhsndpm extpgm('QMHSNDPM');
    *n char(7); // MSNMsgId
    *n char(20); // MSNFile
    *n char(256); // APIEData
    *n bindec(9); // MSNLength
    *n char(10); // MSNType
    *n char(10); // MSNStackE
    *n bindec(9); // MSNStackC
    *n char(4); // MSNMsgKey
    *n char(272); // APIError
end-pr;
//------------------------------------------------------
dcl-pr p_quscrtus extpgm('QUSCRTUS');
    *n char(20); // CusName
    *n char(10); // CusAttr
    *n bindec(9); // CusIntSize
    *n char(1); // CusIntVal
    *n char(10); // CusAut
    *n char(50); // Custext
    *n char(10); // CusReplace
    *n char(272); // APIError
    *n char(10); // CusDomain
end-pr;
//------------------------------------------------------
dcl-pr p_qusptrus extpgm('QUSPTRUS');
    *n char(20); // CusName
    *n pointer; // UspPtr
end-pr;
//------------------------------------------------------
dcl-pr p_qusljob extpgm('QUSLJOB');
    *n char(20); // CusName
    *n char(8); // LJBFormat
    *n char(26); // LJBQJobName
    *n char(10); // LJBStatus
end-pr;
//=== Main ===========================================================
dcl-proc Main;
    // -----------------------------------
    dcl-pi *n extpgm('GETJOBTR');
        pQJob char(26);
        pType char(1);
    end-pi;
    //=== Delete the User Space ======================================
    APIEProv=%LEN(APIError);
    p_QUSDLTUS(
            CusName:
            APIError);
    // If user space doesn't exist, accept message CPF2105, else
    // something nasty wrong - pass errors back
    if APIEAvail <> 0 and APIErrId <> 'CPF2105';
        APIEProv=0;
        MSNMsgId=APIErrId;
        MSNLength=APIEAvail-16;
        p_QMHSNDPM(
            MSNMsgId:
            MSNFile:
            APIEData:
            MSNLength:
            MSNType:
            MSNStackE:
            MSNStackC:
            MSNMsgKey:
            APIError);
    endif;
    // === Create User Space =========================================
    // We only expect one entry back since job is fully qualified, but
    // allocate enough for 10 entries in case entry size expands.
    CusIntSize=%size(UspHdr) + (%size(LJLentry)*10);
    LJBQJobname=pQJob;
    // === Create the User Space =====================================
    APIEProv = 0;
    p_QUSCRTUS(
            CusName:
            CusAttr:
            CusIntSize:
            CusIntVal:
            CusAut:
            Custext:
            CusReplace:
            APIError:
            CusDomain);
    // === Get Pointer to User Space =================================
    p_QUSPTRUS(CusName: UspPtr);
    // === Get Job Info ==============================================
    p_QUSLJOB(
            CusName:
            LJBFormat:
            LJBQJobName:
            LJBStatus);
    if UspLst#Ent>0;
        LJPtr=UspPtr+UspLstOfs;
        // All that code just to execute this one instruction...
        pType=LJJobType;
    else;
        pType=' ';
    endif;
    // === Return to Caller ==========================================
    // Leave LR Off - this isn't very big.
    return;
    //
end-proc;