The following objects allow a user to switch between up to
16 group jobs using the attention key.
JA0507C CLLE JA0507 - Group Jobs process
JA0507CL CLLE JA0507 - Group Jobs initial
JA0507C1 CLLE JA0507 - Group Jobs attention
JA0507C2 CLLE JA0507 - Group Jobs cmd check
JA0507FM DSPF JA0507 - Group Jobs select dspf
JA0507FM1 DSPF JA0507 - Group Jobs maintain dspf
JA0507HP PNLGRP JA0507 - Group Jobs select help panel
JA0507HP1 PNLGRP JA0507 - Group Jobs maintain help panel
JA0507L LF JA0507 - Group Jobs lf
JA0507P PF JA0507 - Group Jobs pf
JA0507R RPGLE JA0507 - Group Jobs select
JA0507R1 RPGLE JA0507 - Group Jobs maintain
/*----------------------------------------------------------------*/
/* */
/* cl program: JA0507C - Process */
/* */
/* abstract: Process group job commands */
/* */
/* */
/* modifications */
/* ------------- */
/* date developer project description */
/* -------- ---------- ---------- ------------------------------- */
/* 01/05/06 jwa initial version */
/* */
/* */
/*----------------------------------------------------------------*/
Pgm
DCL VAR(&GrpCmd) TYPE(*CHAR) LEN(72)
DCL VAR(&GRPJOB) TYPE(*CHAR) LEN(10)
DCL VAR(&GrpCmd) TYPE(*CHAR) LEN(72)
monmsg msgid(cpf0000)
SetAtnPgm Pgm(JA0507C1) Set(*ON)
RTVDTAARA DTAARA(*GDA (1 72)) RTNVAR(&GRPCMD)
CALL PGM(QCMDEXC) PARM(&GRPCMD 72)
MONMSG MSGID(CPF0000) EXEC(ENDGRPJOB GRPJOB(*) +
RSMGRPJOB(*PRV) LOG(*NOLIST))
EndPgm
/*----------------------------------------------------------------*/
/* */
/* cl program: JA0507CL - initial program */
/* */
/* abstract: Sample initial program */
/* */
/* */
/* modifications */
/* ------------- */
/* date developer project description */
/* -------- ---------- ---------- ------------------------------- */
/* 01/05/06 jwa initial version */
/* */
/* */
/*----------------------------------------------------------------*/
Pgm
Loop: SetAtnPgm Pgm(JA0507C1) Set(*On)
MonMsg MsgID(CPF1318)
STRPDM
Goto CmdLbl(Loop)
EndPgm
/*----------------------------------------------------------------*/
/* */
/* JA0507C1 - Interactive Group Job - attention */
/* */
/* Abstract: This program processes the attn key */
/* */
/*----------------------------------------------------------------*/
/* modifications */
/* ------------- */
/* date developer project description */
/* -------- ---------- ---------- ------------------------------- */
/* 01/05/06 jwa initial version */
/* */
/*----------------------------------------------------------------*/
PGM
DCL VAR(&GrpName) TYPE(*CHAR) LEN(10)
DCL VAR(&GrpCmd) TYPE(*CHAR) LEN(72)
DCL VAR(&GrpJob) TYPE(*CHAR) LEN(10)
DCL VAR(&GrpList) TYPE(*CHAR) LEN(1056)
DCL VAR(&GrpCnt) TYPE(*DEC) LEN(3 0)
MONMSG MSGID(CPF0000)
/* Get Group Job Attributes */
RTVGRPA GRPJOB(&GrpJob) GRPJOBL(&GrpList) +
GRPJOBCNT(&GrpCnt)
MONMSG MsgId(CPF1311) +
EXEC(CHGGRPA GRPJOB(MAIN))
IF (&GRPJOB *EQ '*NONE ') +
THEN(CHGGRPA GRPJOB(MAIN))
SETATNPGM PGM("your attn pgm"/"Your Lib")
CALL PGM(JA0507R) PARM(&GRPJOB &GRPNAME &GRPCMD +
&GRPCNT &GRPLIST)
IF ((&GRPNAME *NE ' ') *AND +
(&GRPNAME *NE &GRPJOB)) +
THEN(DO)
ChgDtaara Dtaara(*GDA) VALUE(&GrpCmd)
TFRGRPJOB GRPJOB(&GrpName) INLGRPPGM(JA0507C)
ENDDO
ENDPGM
/*----------------------------------------------------------------*/
/* */
/* JA0507C2 - Interactive Group Job - command check */
/* */
/* Abstract: This uses API qcmdchk to verify command strings */
/* */
/*----------------------------------------------------------------*/
/* modifications */
/* ------------- */
/* date developer project description */
/* -------- ---------- ---------- ------------------------------- */
/* 01/05/06 jwa initial version */
/* */
/*----------------------------------------------------------------*/
PGM PARM(&CMD &LEN &RESULT)
DCL VAR(&CMD) TYPE(*CHAR) LEN(72)
DCL VAR(&LEN) TYPE(*DEC) LEN(15 5)
DCL VAR(&RESULT) TYPE(*CHAR) LEN(4)
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(300)
MONMSG MSGID(CPF0000)
CHGVAR VAR(&RESULT) VALUE(' ')
/* Check Command String */
CALL PGM(QCMDCHK) PARM(&CMD &LEN)
MONMSG MSGID(CPF0000) EXEC(DO)
CHGVAR VAR(&RESULT) VALUE('*ERR')
RCVMSG PGMQ(*SAME (*)) MSGQ(*PGMQ) MSGTYPE(*DIAG) +
MSGDTA(&MSGDTA) MSGID(&MSGID)
SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
TOPGMQ(*PRV)
ENDDO
ENDPGM
A*%%TS SD 20060728 140537 JOHNA REL-V5R3M0 5722-WDS
A*----------------------------------------------------------------*
A* *
A* FILE NAME: JA0507FM - PROCESS GROUP JOB SELECTION *
A* *
A* Abstract: *
A* *
A* *
A*----------------------------------------------------------------*
A* Modifications *
A* ------------- *
A* date developer project description *
A* -------- ---------- ---------- ------------------------------- *
A* 01/05/06 JWA initial version *
A* *
A* *
A*----------------------------------------------------------------*
A*%%EC
A DSPSIZ(24 80 *DS3)
A HLPTITLE('FILE LEVEL TITLE')
A HLPPNLGRP(EXTENDED JA0507HP)
A ALTHELP(CA01)
A HELP
A CF03
A CF12
A CF05
A CF06
A*---------------------------------------------------------------
A R JA0507R1
A*%%TS SD 20060728 140537 JOHNA REL-V5R3M0 5722-WDS
A RTNCSRLOC(&RCD &FLD &POS)
A CSRLOC(LINNBR POSNBR)
A OVERLAY
A H HLPPNLGRP(EXTENDEDR1 JA0507HP)
A HLPARA(*NONE)
A FLD 10A H
A RCD 10A H
A POS 4S 0H
A LINNBR 3S 0H
A POSNBR 3S 0H
A 1 2SYSNAME
A 1 11USER
A SCTITL 30A O 1 26
A SCDATE 8Y 0O 1 71EDTWRD(' / / ')
A 2 2'JA0507R1'
A SCFUNC 30A O 2 26DSPATR(HI)
A SCTIME 6Y 0O 2 73EDTWRD(' : : ')
A 5 4'Select a Group Job, press
enter.'
A COLOR(BLU)
A*
A SCOPTN01 2Y 0O 7 6EDTCDE(Z)
A SCOPTN02 2Y 0O 8 6EDTCDE(Z)
A SCOPTN03 2Y 0O 9 6EDTCDE(Z)
A SCOPTN04 2Y 0O 10 6EDTCDE(Z)
A SCOPTN05 2Y 0O 12 6EDTCDE(Z)
A SCOPTN06 2Y 0O 13 6EDTCDE(Z)
A SCOPTN07 2Y 0O 14 6EDTCDE(Z)
A SCOPTN08 2Y 0O 15 6EDTCDE(Z)
A SCOPTN09 2Y 0O 7 44EDTCDE(Z)
A SCOPTN10 2Y 0O 8 44EDTCDE(Z)
A SCOPTN11 2Y 0O 9 44EDTCDE(Z)
A SCOPTN12 2Y 0O 10 44EDTCDE(Z)
A SCOPTN13 2Y 0O 12 44EDTCDE(Z)
A SCOPTN14 2Y 0O 13 44EDTCDE(Z)
A SCOPTN15 2Y 0O 14 44EDTCDE(Z)
A SCOPTN16 2Y 0O 15 44EDTCDE(Z)
A*
A SCDESC01 30A O 7 10
A 21 DSPATR(HI)
A SCDESC02 30A O 8 10
A 22 DSPATR(HI)
A SCDESC03 30A O 9 10
A 23 DSPATR(HI)
A SCDESC04 30A O 10 10
A 24 DSPATR(HI)
A SCDESC05 30A O 12 10
A 25 DSPATR(HI)
A SCDESC06 30A O 13 10
A 26 DSPATR(HI)
A SCDESC07 30A O 14 10
A 27 DSPATR(HI)
A SCDESC08 30A O 15 10
A 28 DSPATR(HI)
A SCDESC09 30A O 7 47
A 29 DSPATR(HI)
A SCDESC10 30A O 8 47
A 30 DSPATR(HI)
A SCDESC11 30A O 9 47
A 31 DSPATR(HI)
A SCDESC12 30A O 10 47
A 32 DSPATR(HI)
A SCDESC13 30A O 12 47
A 33 DSPATR(HI)
A SCDESC14 30A O 13 47
A 34 DSPATR(HI)
A SCDESC15 30A O 14 47
A 35 DSPATR(HI)
A SCDESC16 30A O 15 47
A 36 DSPATR(HI)
A*
A SCACTV01 1A O 7 4
A SCACTV02 1A O 8 4
A SCACTV03 1A O 9 4
A SCACTV04 1A O 10 4
A SCACTV05 1A O 12 4
A SCACTV06 1A O 13 4
A SCACTV07 1A O 14 4
A SCACTV08 1A O 15 4
A SCACTV09 1A O 7 42
A SCACTV10 1A O 8 42
A SCACTV11 1A O 9 42
A SCACTV12 1A O 10 42
A SCACTV13 1A O 12 42
A SCACTV14 1A O 13 42
A SCACTV15 1A O 14 42
A SCACTV16 1A O 15 42
A*
A 17 4'Select:'
A COLOR(BLU)
A SCSLCT 2Y 0B 17 12EDTCDE(4)
A CHECK(ER)
A 17 67'(*=active)'
A COLOR(BLU)
A 19 4'Command:'
A COLOR(BLU)
A SCCMD1 64A B 19 13
A 21 4'F3/F12=Exit'
A COLOR(BLU)
A 21 17'F5=Refresh'
A COLOR(BLU)
A 21 29'F6=Update Options'
A COLOR(BLU)
*---------------------------------------------------------------
* Message Subfile
*---------------------------------------------------------------
A R MSGSFL SFL
A SFLMSGRCD(24)
A MSGKEY SFLMSGKEY
A QPPGM SFLPGMQ
*---------------------------------------------------------------
* Message Subfile Control
*---------------------------------------------------------------
A R MSGCTL SFLCTL(MSGSFL)
A SFLSIZ(2)
A SFLPAG(1)
A SFLDSP
A SFLDSPCTL
A SFLINZ
A N99 SFLEND
A QPPGM SFLPGMQ
A*----------------------------------------------------------------*
A* Name: JA0507FM1 - MAINTAIN GROUP JOB OPTIONS *
A* *
A* Abstract: *
A* *
A* Modifications *
A* ------------- *
A* date developer project description *
A* -------- ---------- ---------- ------------------------------- *
A* 01/05/06 JWA INITIAL VERSION *
A* *
A*----------------------------------------------------------------*
A DSPSIZ(24 80 *DS3)
A HLPTITLE('FILE LEVEL TITLE')
A HLPPNLGRP(EXTENDED JA0507HP1)
A ALTHELP(CA01)
A HELP
A CF03
A CF05
A CF08
A CF12
A*----------------------------------------------------------*
A R JA0507S11 SFL
A 94 SFLNXTCHG
A S1OPTN 2S 0O 7 3
A S1GRPNAME 10A B 7 8CHECK(LC)
A S1DESC 30A B 7 20CHECK(LC)
A S1GRPCMD 72A B 8 8CHECK(LC)
A 9 4' '
A*----------------------------------------------------------*
A R JA0507C11 SFLCTL(JA0507S11)
A N93 PAGEDOWN
A CSRLOC(LINNBR POSNBR)
A OVERLAY
A SFLCSRRRN(&SCCSRRRN)
A 91 SFLDSP
A 90 SFLDSPCTL
A 92 SFLCLR
A 93 SFLEND
A SFLSIZ(0016)
A SFLPAG(0004)
A H HLPPNLGRP(EXTENDEDC1 JA0507HP1)
A HLPARA(*NONE)
A*
A SCSFLRCD 4S 0H SFLRCDNBR(CURSOR)
A LINNBR 3S 0H
A POSNBR 3S 0H
A SCCSRRRN 5S 0H
A*
A 1 2SYSNAME
A 1 11USER
A SCTITL 30A O 1 32
A 1 73DATE
A EDTCDE(Y)
A 2 2'JA0507C11'
A SCFUNC 30A O 2 32COLOR(WHT)
A 2 73TIME
A 4 2'Enter/change data, press enter
to -
A verify. Press F8 to update.'
A COLOR(BLU)
A 6 2'Optn'
A DSPATR(UL)
A COLOR(WHT)
A 6 8'Job Name '
A DSPATR(HI)
A DSPATR(UL)
A 6 20'Description'
A DSPATR(UL)
A COLOR(WHT)
A*----------------------------------------------------------*
A R JA0507K11
A H HLPPNLGRP(CF03 JA0507HP)
A HLPARA(*CNST 003)
A 20 2'F3/F12=Exit'
A HLPID(003)
A COLOR(BLU)
A 20 15'F5=Refresh'
A HLPID(005)
A COLOR(BLU)
A 20 27'F8=Update'
A HLPID(008)
A COLOR(BLU)
A 20 38'PageUp/PageDn'
A HLPID(025)
A COLOR(BLU)
A*
A*----------------------------------------------------------*
A* MESSAGE SUBFILE RECORD
A*----------------------------------------------------------*
A R MSGSFL SFL
A SFLMSGRCD(24)
A MSGKEY SFLMSGKEY
A QPPGM SFLPGMQ
A*----------------------------------------------------------*
A* MESSAGE SUBFILE CONTROL RECORD
A*----------------------------------------------------------*
A R MSGCTL SFLCTL(MSGSFL)
A OVERLAY
A SFLDSP
A SFLDSPCTL
A SFLINZ
A N95 SFLEND
A SFLSIZ(0002)
A SFLPAG(0001)
A QPPGM SFLPGMQ
..*----------------------------------------------------------------*
..* *
..* Panel Name: JA0507HP - Help Panel Group Job Selection *
..* *
..* Abstract: *
..* *
..*----------------------------------------------------------------*
..* Modifications *
..* ------------- *
..* date developer project description *
..* -------- ---------- ---------- ------------------------------- *
..* 01/05/06 jwa initial version *
..* *
..* *
..*----------------------------------------------------------------*
:PNLGRP.
:HELP name=EXTENDED.
.
Help text that pertains to the entire file.
:EHELP.
:HELP name=EXTENDEDR1.Record Format JA0507R1
:xh3.Record Format JA0507R1
.
Information for record format JA0507R1
:EHELP.
:EPNLGRP.
..*----------------------------------------------------------------*
..* Name: JA0507HP1 - Enter/Update Group Jobs Help Panel *
..* *
..* Abstract: *
..* *
..* Modifications *
..* ------------- *
..* date developer project description *
..* -------- ---------- ---------- ------------------------------- *
..* 01/05/06 jwa initial version *
..* *
..*----------------------------------------------------------------*
:PNLGRP.
:HELP name=EXTENDED.
.
Help text that pertains to the entire file.
:EHELP.
:HELP name=EXTENDEDC1.Record Format JA0507C11
:xh3.Record Format JA0507C11
.
Information for record format JA0507C11.
:EHELP.
:EPNLGRP.
A*----------------------------------------------------------------*
A* *
A* FILE NAME: JA0507L - INTERACTIVE GROUP JOB - LF *
A* *
A* Abstract: This file contains informations necessary for *
A* one instance of a group job. The options can *
A* range from 1 to 24 for each user. *
A* *
A*----------------------------------------------------------------*
A* Modifications *
A* ------------- *
A* date developer project description *
A* -------- ---------- ---------- ------------------------------- *
A* 01/05/06 JWA INITIAL VERSION *
A* *
A* *
A*----------------------------------------------------------------*
A UNIQUE
A R JA0507L1 PFILE(JA0507P)
A J1USER
A J1OPTN
A J1GRPNAME
A J1DESC
A J1GRPCMD
*
A K J1USER
A K J1GRPNAME
A*----------------------------------------------------------------*
A* *
A* FILE NAME: JA0507P - INTERACTIVE GROUP JOB - PF *
A* *
A* Abstract: This file contains informations necessary for *
A* one instance of a group job. The options can *
A* range from 1 to 24 for each user. *
A* *
A*----------------------------------------------------------------*
A* Modifications *
A* ------------- *
A* date developer project description *
A* -------- ---------- ---------- ------------------------------- *
A* 01/05/06 JWA INITIAL VERSION *
A* *
A* *
A*----------------------------------------------------------------*
A UNIQUE
A R JA0507P1
A J1USER 10A TEXT('Attn Key User')
A COLHDG('User')
A J1OPTN 2S 0 TEXT('Attn Key Option')
A COLHDG('Option')
A J1GRPNAME 10A TEXT('Group Job Name')
A COLHDG('Grp Job')
A J1DESC 30A TEXT('Option Description')
A COLHDG('Description')
A J1GRPCMD 72A TEXT('Group Job Command String')
A COLHDG('Command String')
*
A K J1USER
A K J1OPTN
h dftname(JA0507)
*----------------------------------------------------------------*
* *
* Name: JA0507R - Interactive Group Job - select *
* *
* Abstract: Display and Maintain group jobs for selection *
* *
*----------------------------------------------------------------*
* Modifications *
* ------------- *
* date developer project description *
* -------- ---------- ---------- ------------------------------- *
* 01/05/06 jwa initial version *
* *
*----------------------------------------------------------------*
fJA0507FM CF E Workstn
f infds(aufds)
fJA0507P IF E K Disk
*
* Prototypes
* -----------
d pQCMDEXC PR ExtPgm('QCMDEXC')
d cmd 300A Options(*VarSize) const
d cmdlen 15P 5 const
*
d ChkCmd PR extpgm('JA0507C2')
d cmd 300A Options(*VarSize) const
d cmdlen 15P 5 const
d result 4A
*
* -----------------
* data sturctures
* -----------------
*
* program status data structure
d SPDS SDS
d qpPgm 1 10
d qpUser 254 263
*
* file information data structure - display file
d AUFDS DS
d QFAid 369 369
*
* time stamp
d DS
d ts 1 14 0
d tstime 1 6 0
d tsdate 7 14 0
*
* Group Job Options
d Optn s 2S 0 Dim(16)
d ptrOptn s * inz(%addr(Optn))
d OptnDS DS based(ptrOptn)
d SCOptn01
d SCOptn02
d SCOptn03
d SCOptn04
d SCOptn05
d SCOptn06
d SCOptn07
d SCOptn08
d SCOptn09
d SCOptn10
d SCOptn11
d SCOptn12
d SCOptn13
d SCOptn14
d SCOptn15
d SCOptn16
*
* Group Job Descriptions
d Desc s 30A Dim(16)
d ptrDesc s * inz(%addr(Desc))
d DescDS DS based(ptrDesc)
d SCDESC01
d SCDESC02
d SCDESC03
d SCDESC04
d SCDESC05
d SCDESC06
d SCDESC07
d SCDESC08
d SCDESC09
d SCDESC10
d SCDESC11
d SCDESC12
d SCDESC13
d SCDESC14
d SCDESC15
d SCDESC16
*
* Group Job Active/Inactive
d Actv s 1A Dim(16)
d ptrActv s * inz(%addr(Actv))
d ActvDS DS based(ptrActv)
d SCActv01
d SCActv02
d SCActv03
d SCActv04
d SCActv05
d SCActv06
d SCActv07
d SCActv08
d SCActv09
d SCActv10
d SCActv11
d SCActv12
d SCActv13
d SCActv14
d SCActv15
d SCActv16
*
* Group Job Names & Command Strings
d GrpName s 10A Dim(16)
d GrpCmd s 72A Dim(16)
*
*-----------------------
* Group Jobs Now Active
*-----------------------
d GrpList s 10A Dim(16)
d GrpL s 66A Dim(16)
d ptrGrpL s * inz(%addr(GrpL))
d P2GRPList s 1056A based(ptrGrpL)
*
*------------------
* named indicators
*------------------
d ptrindicators s * inz(%addr(*in))
d indicators DS based(ptrindicators)
d someInd 66 66N
*
*-----------------
* named constants
*-----------------
* function key aid return values
d cf03 c const(x'33')
d cf05 c const(x'35')
d cf06 c const(x'36')
d cf12 c const(x'3C')
d enter c const(x'F1')
d Title c ' Group Jobs Application '
d Function c ' JA0507R - Select Group Job '
*
*-----------------
* Message Subfile
*-----------------
d msgId s 7
d msgLoc s 20 inz('JAMSGF *LIBL ')
d msgData s 80
d msgDataLen s 10i 0 Inz(%Size(MsgData))
d msgType s 10 inz('*DIAG')
d msgQueue s 276A inz('*')
d msgCallStack s 10i 0 inz(0)
d msgKey s 4 inz(' ')
d msgErr s 10i 0 inz(0)
d msgrmv s 10A inz('*ALL')
*--------------------
* Stand Alone Fields
*--------------------
d Active s n
d Optn_Valid s n
d CmdRslt s 4A
d i s 3S 0
d x s 3S 0
*
d P1GRPJOB s 10A
d P1GRPNAME s like(J1GRPNAME )
d P1GRPCMD s like(J1GRPCMD )
d P1GRPCnt s 3P 0
d P1GRPList s 1056A
*
* initial processing performed by *inzsr subroutine
*
*-------------
* Entry Point
*-------------
c *entry Plist
c Parm P1GRPJOB
c Parm P1GRPNAME
c Parm P1GRPCMD
c Parm P1GRPCnt
c Parm P1GRPList
*
* Load Grp Job Options
c ExSr BldActPnl
*
* Set an indicator to highlight the current group job
c Select
c When P1Grpjob = '*NONE' or
c P1Grpjob = *blanks
c Eval *in21 = *on
c eval Actv(1) = '*'
*
c Other
C Z-ADD 1 X
C P1Grpjob LOOKUP GrpName(x) 60
c If %equal
c eval *in(x + 20) = *on
c EndIf
c EndSl
*
*--------------
* Main Section
*--------------
c DOW Active
*
c time TS
c Move tstime sctime
c Move tsdate scdate
*
* Display Active Panel
c ExSr DspActPnl
* Process Active Panel
c ExSr PrcActPnl
c EndDo
* Exit Program
c eval *inlr = *on
*-----------------------------------------------------
* Display Active Panel
*-----------------------------------------------------
c DspActPnl BegSr
* --------- -----
* write any error messages
c write msgctl
c clear SCSlct
* display active panel
c ExFmt JA0507R1
* Clear message file
c eval msgKey = *blanks
c exsr ClearMsg
c EndSr
*-----------------------------------------------------
* Process Function Keys
*-----------------------------------------------------
c PrcActPnl BegSr
* --------- -----
c SELECT
* F3/F12 = Exit
*--------------
c WHEN QFAid = CF03 or
c QFAid = CF12
c eval Active = *off
* F5=Refresh
*-----------
c WHEN QFAid = CF05
c ExSr BldActPnl
* F6=Update Options
*------------------
c WHEN QFAid = CF06
c call 'JA0507R1'
c ExSr BldActPnl
* Enter Key
*----------
c WHEN QFAid = Enter
c ExSr ValdR1
*
c If Optn_Valid
c clear SCCmd1
c eval P1GRPNAME = GrpName(SCSlct)
c eval P1GRPCMD = GrpCmd(SCSlct)
c eval Active = *off
c EndIf
*
/free
If SCCmd1 <> *blanks;
CallP(e) ChkCmd(%Trim(SCCmd1): %Len(SCCmd1):
CmdRslt );
If CmdRslt <> '*ERR';
CallP(e) pQCMDEXC( %Trim(SCCmd1):
%Len(SCCmd1) );
Clear SCCmd1;
EndIf;
EndIf;
/end-free
*
c ENDSL
c EndSr
*
*-----------------------------------------------------
* Build Active Panel
*-----------------------------------------------------
c BldActPnl BegSr
* --------- -----
*
c clear Optn
c clear Desc
c clear Actv
c clear GrpName
c clear GrpCmd
*
* Load Grp Job Options
c qpuser SetLL JA0507P1
c qpuser ReadE JA0507P1
*
c DOW not %EOF(JA0507P)
c If J1Optn > *zero and
c J1Optn < 17
c eval Optn(J1Optn) = J1Optn
c eval Desc(J1Optn) = J1Desc
c eval GrpName(J1Optn) = J1GrpName
c eval GrpCmd(J1Optn) = J1GrpCmd
*
* Is Group Job now Active?
c J1GrpName Lookup GrpList 60
c If %equal
c eval Actv(J1Optn) = '*'
c EndIf
*
c EndIf
*
c qpuser ReadE JA0507P1
c EndDo
*
c EndSr
*
*-----------------------------------------------------
* Validate R1
*-----------------------------------------------------
c ValdR1 BegSr
* ------ -----
c eval Optn_Valid = *off
c If SCSlct > 0 and
c SCSlct < 17
c If Optn(SCSlct) <> 0
c eval Optn_Valid = *on
c EndIf
c EndIf
*
c If not Optn_Valid and
c SCSlct > *zero
c movel(p) 'JWA0005' MsgId
c movel SCSlct msgData
c eval msgDataLen = %len(msgData)
c ExSr SendMsg
c Endif
*
c EndSr
*-----------------------------------------------------
* SendMsg - Send a message to the message subfile
*-----------------------------------------------------
c SendMsg Begsr
* ------- -----
c call 'QMHSNDPM'
c parm msgId
c parm msgLoc
c parm msgData
c parm msgDataLen
c parm msgType
c parm msgQueue
c parm msgCallStack
c parm msgKey
c parm msgErr
*
c endsr
*-----------------------------------------------------
* ClearMsg - Clear the messages from the screen
*-----------------------------------------------------
c ClearMsg Begsr
* -------- -----
c call 'QMHRMVPM'
c parm msgQueue
c parm msgCallStack
c parm msgKey
c parm msgRmv
c parm msgErr
c endsr
*-----------------------------------------------------
* perform initial processing
*-----------------------------------------------------
c *InzSr BegSr
* ------ -----
*
* Get Active Group Jobs
c Eval P2GRPList = P1GRPList
c Clear GrpList
c Do P1GRPCnt i
c movel GrpL(i) GrpList(i)
c EndDo
*
c eval SCTitl = Title
c eval SCFunc = Function
c eval Active = *on
c EndSr
*
h dftname(JA0507R1)
*----------------------------------------------------------------*
* *
* Name: JA0507R1 - Maintain Group Job Options (1-16) *
* *
* Abstract: *
* *
* General Logic: *
* initial processing (*inzsr) *
* *
* *
*----------------------------------------------------------------*
* Modifications *
* ------------- *
* date developer project description *
* -------- ---------- ---------- ------------------------------- *
* 01/05/06 jwa initial version *
* *
* *
* *
*----------------------------------------------------------------*
fJA0507FM1 CF E Workstn
f infds(AUINFDS)
f sfile(JA0507S11:sflrrn)
* Group Jobs Options File
fJA0507P UF A E K Disk
* ---------------
* tables/arrays
* ---------------
*
* -----------------
* data sturctures
* -----------------
*
* program status data structure
d PgmStat SDS
d qpPgm 1 10
d qpUser 254 263
*
*
* file information data structure - display file
d AUINFDS ds
*-------
d QFRcdFmt 261 270
d QFAid 369 369
d QFCsrl 370 371b 0
d QFSflRRN 376 377I 0
*------------------
* named indicators
*------------------
d ptrindicators s * inz(%addr(*in))
d indicators DS based(ptrindicators)
*
d SflDsp 90 90n
d SflDspCtl 91 91n
d SflClr 92 92n
d SflEnd 93 93n
d SflNxtChg 94 94n
d MsgSflEnd 95 95n
*
*-----------------
* named constants
*-----------------
* function key aid return values
d CF03 c const(x'33')
d CF05 c CONST(X'35')
d CF08 c CONST(X'38')
d CF12 c const(x'3C')
d Enter c const(x'F1')
d SflPage c 4
d SflSize c 16
d Title c ' Group Jobs Application '
d Function c 'JA0507R1 - Maintain Group Jobs'
d up C 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
d lo C 'abcdefghijklmnopqrstuvwxyz'
*
*-----------------
* Message Subfile
*-----------------
d msgId s 7
d msgLoc s 20 inz('JAMSGF *LIBL ')
d msgData s 80
d msgDataLen s 10i 0 Inz(%Size(MsgData))
d msgType s 10 inz('*DIAG')
d msgQueue s 276A inz('*')
d msgCallStack s 10i 0 inz(0)
d msgKey s 4 inz(' ')
d msgErr s 10i 0 inz(0)
*
d msgrmv s 10A inz('*ALL')
*
*--------------------
* Stand Alone Fields
*--------------------
d Optn s like(j1optn)
d RcdCnt s 5p 0
d SFLrrn s 5p 0
d LstSFLrrn s 5p 0
d err_Sflrrn s 5p 0
*
* Logical Variables
d Active s n
d ErrFnd s n
d ErrorsFnd s n
d SetPageRRN s n
*
*-----------
* Key Lists
*-----------
c JAKey1 Klist
c Kfld QpUser
c Kfld Optn
*
* initial processing performed by *inzsr subroutine
*--------------
* Main Section
*--------------
c ExSr ClearSFL
c ExSr LoadSFL
*
c DOW Active
*
* Clear/Load/Display the SFL
c ExSr DspSFL
*
c ExSr ProcCMD
*
c EndDo
* Exit Program
c eval *inlr = *on
*
*-----------------------------------------------------
* Display Active Panel
*-----------------------------------------------------
c DspSFL BegSr
* ~~~~~~ ~~~~~
* display SFL
c eval SflClr = *off
c eval SflDsp = *on
c eval SflDspCtl = *on
c Write JA0507K11
*
* write any error messages
c write msgctl
*
c ExFmt JA0507C11
*
c eval msgKey = *blanks
c ExSr ClearMsg
*
* Keep SFL on same page
c If SCCsrRRN <> *zero
c eval SCSFLRcd = SCCsrRRN
c EndIf
c EndSr
*-----------------------------------------------------
* Process Function Keys
*-----------------------------------------------------
c ProcCmd BegSr
* ~~~~~~~ ~~~~~
c Select
*
* CF03/CF12=Exit
c When QFAid = CF03 or
c QFAid = CF12
c eval Active = *off
*
* CF05=Refresh
c When QFAid = CF05
c ExSr ClearSfl
c ExSr LoadSFL
*
* CF08=Update
c When QFAid = CF08
c ExSr ProcSfl
c If not ErrorsFnd
c eval Active = *off
c EndIf
*
c EndSL
*
c EndSr
*-----------------------------------------------------
* Process Subfile
*-----------------------------------------------------
c ProcSfl BegSr
* ~~~~~~~ ~~~~~
c eval ErrorsFnd = *off
*
c READC(E) JA0507S11
c DOW not %EOF(JA0507FM1) and
c Active
*
c Eval ErrFnd = *off
*
c eval Optn = S1Optn
c JAKey1 Chain JA0507P1
c Eval J1User = QpUser
c Eval J1Optn = S1Optn
c Eval J1Desc = S1Desc
c Eval J1GrpName = %XLATE(lo:up: S1GrpName)
c Eval J1GrpCmd = S1GrpCmd
*
c If S1Optn = 1
c Eval J1GrpName = 'MAIN '
c EndIf
*
c If %found
c If S1GrpName <> *blanks
c Update(e) JA0507P1
*
c If %error
c eval ErrFnd = *on
c EndIf
c Else
S1GrpName = *blanks
c Delete(e) JA0507P1
c EndIf
S1GrpName <> *blanks
*
c Else
not %found
*
c If S1GrpName <> *blanks and
c S1Desc <> *blanks and
c S1GrpCmd <> *blanks
c Write(e) JA0507P1
*
c If %error
c eval ErrFnd = *on
c EndIf
*
c EndIf
S1GrpName <> *blanks
c EndIf
%found
*
c If ErrFnd
c Eval ErrorsFnd = *on
c Eval SflNxtChg = *on
c Update JA0507S11
c Eval SflNxtChg = *off
c EndIf
ErrFnd
*
c eval SCSFLRcd = SFLrrn
c READC(E) JA0507S11
*
c EndDo
not %EOF(JA0507FM1)
*
c EndSr
*-----------------------------------------------------
* Load SFL - perform initial load to an empty sfl
*-----------------------------------------------------
c LoadSFL BegSr
* ~~~~~~~ ~~~~~
c eval SFLrrn = 0
c QpUser SetLL JA0507P1
*
c eval SetPageRRN = *on
c eval RcdCnt = 0
*
c Do 16 Optn
c JAKey1 Chain JA0507P1
*
c If %found
c eval S1Desc = J1Desc
c eval S1GrpName = J1GrpName
c eval S1GrpCmd = J1GrpCmd
c Else
c clear S1Desc
c clear S1GrpName
c clear S1GrpCmd
c EndIf
*
c eval s1Optn = Optn
c eval SFLrrn = SFLrrn + 1
*
c If SetPageRRN
c eval SetPageRRN = *off
c eval SCSFLRcd = SFLrrn
c EndIf
*
c Write JA0507S11
c EndDo
*
c eval SflEnd = *on
*
c EndSr
*-----------------------------------------------------
* Clear SFL
*-----------------------------------------------------
c ClearSFL BegSr
* ~~~~~~~~ ~~~~~
c Eval SflClr = *on
c Eval SflDsp = *off
c Eval SflDspCtl = *off
c Write JA0507C11
c Eval SflClr = *off
c EndSr
*-----------------------------------------------------
* SendMsg - Send a message to the message subfile
*-----------------------------------------------------
c SendMsg Begsr
* ------- -----
c call 'QMHSNDPM'
c parm msgId
c parm msgLoc
c parm msgData
c parm msgDataLen
c parm msgType
c parm msgQueue
c parm msgCallStack
c parm msgKey
c parm msgErr
*
c endsr
*-----------------------------------------------------
* ClearMsg - Clear the messages from the screen
*-----------------------------------------------------
c ClearMsg Begsr
* -------- -----
c call 'QMHRMVPM'
c parm msgQueue
c parm msgCallStack
c parm msgKey
c parm msgRmv
c parm msgErr
*
c endsr
*
*-----------------------------------------------------
* perform initial processing
*-----------------------------------------------------
c *InzSr BegSr
* ~~~~~~ ~~~~~
c eval Active = *on
c eval SCTitl = Title
c eval SCFunc = Function
c EndSr
FAQ
Search
Profile
Private Messages
Log in
