      /TITLE TS0010R  RMTWTR: Work with Remote Writers
      ****************************************************************
      *                                                              *
      *  Program name . :  TS0010R                                   *
      *  Text . . . . . :  WRKRMTWTR: Work with Remote Writer        *
      *                                                              *
      *  Author . . . . :  Alex Nubla                                *
      *                                                              *
      *  Description. . :  This program display the overall status   *
      *                    of each remote output queues in the       *
      *                    system.                                   *
      *                                                              *
      *                    To create this module, use the CRTRPGMOD  *
      *                    command.  After the module is created,    *
      *                    use the CRTPGM/UPDPGM command for program *
      *                    TS0010R.                                  *
      *                                                              *
      ****************************************************************
      * MODULES:                                                     *
      *                                                              *
      * 1. TS0010R      Work with Remote Writers                     *
      * 2. TS0011C      Local & Remote OUTQ Device Driver            *
      *                                                              *
      * PROGRAMSl                                                    *
      *                                                              *
      * 1. UT0010C      Message subfile handling program             *
      *                                                              *
      ****************************************************************
      /EJECT
      ****************************************************************
      *  F I L E   D E S C R I P T I O N   S P E C I F I C A T I O N *
      ****************************************************************
     FTSRMOQ    UF A E           K DISK
      *
      *  Remote Output Queue
      *
      *--------------------------------------------------------------*
     FTS0010RD  CF   E             WORKSTN SFILE(TS0010S1:RRN1)
     F                                     INFDS(DSPIDS)
      *
      *  WRKRMTWTR Display File
      *
      *--------------------------------------------------------------*
     FXFPAPEER  IF   E           K DISK
      *
      *  PEER Device File - used for APPC
      *
      *--------------------------------------------------------------*
     D/EJECT
      ****************************************************************
      *       D E F I N I T I O N     S P E C I F I C A T I O N      *
      ****************************************************************
      *
      *  Program Status Data Structure
      *
     D PGMDS          SDS
     D  Pgmq##           *PROC
     D  ErrorSts         *STATUS
     D  PrvStatus             16     20S 0
     D  SrcLinNum             21     28
     D  Routine          *ROUTINE
     D  NumParms         *PARMS
     D  ExcpType              40     42
     D  ExcpNum               43     46
      *
     D  PgmLib                81     90
     D  ExcpData              91    170
     D  ExcpId               171    174
     D  LastFile             201    208
     D  FileErr              209    243
     D  JobName              244    253
     D  User                 254    263
     D  JobNumA              264    269
     D  JobNum               264    269S 0
     D  JobDate              270    275S 0
     D  RunDate              276    281S 0
     D  RunTime              282    287S 0
     D  PgmCrtDt             288    293
     D  PgmCrtTm             294    299
     D  CmplrLvl             300    303
     D  SrcFile              304    313
     D  SrcLib               314    323
     D  SrcMbr               324    333
     D  ProcPgm              334    343
     D  ProcMod              344    353
      *
      *  File Information data structure
      *
     D DSPIDS          DS
     D  DspAID               369    369
     D  CursorLoc            370    371B 0
     D  SubfileRRN           376    377B 0
     D  MinimumRRN           378    379B 0
     D  TotalSfl             380    381B 0
      *
      *  Retrieve Network Attributes (QWCRNETA) API
      *
     D@RtnNetAtr       DS
     D  @Rtn#Attr                     9B 0
     D  @RtnOffset                    9B 0
     D  @RtnAtrNam                   10
     D  @RtnDtaTyp                    1
     D  @RtnInfSts                    1
     D  @RtnAtrLen                    9B 0
     D  @RtnSystem                    8
      *
      *  Retrieve Output Queue Information (QSPROUTQ) API
      *    using format OUTQ0100
      *
     D@RtnOQInfo       DS
     D  @Rtn#Bytes                    9B 0
     D  @Rtn#Avail                    9B 0
     D  @RtnOutqNm                   10
     D  @RtnOutqLb                   10
     D  @RtnOrdfil                   10
     D  @RtnDspfil                   10
     D  @RtnJobSep                    9B 0
     D  @RtnOprCtl                   10
     D  @RtnDtaqNm                   10
     D  @RtnDtaqLb                   10
     D  @RtnAutChk                   10
     D  @Rtn#File                     9B 0
     D  @RtnOQSts                    10
     D  @RtnWJob                     10
     D  @RtnWUser                    10
     D  @RtnWNbr                      6
     D  @RtnWSts                     10
     D  @RtnDevNm                    10
     D  @RtnDesc                     50
     D  @Reservd2                     2
     D  @Rtn#Page                     9B 0
     D  @Rtn#WStr                     9B 0
     D  @Rtn#AStr                     9B 0
     D  @RtnRmTyp                     1
     D  @RtnRmSys                   255
     D  @RtnRmWtr                   128
     D  @RtnMsgqNm                   10
     D  @RtnMsgqLb                   10
     D  @RtnCnnTyp                    9B 0
     D  @RtnDstTyp                    9B 0
     D  @RtnVmMvs                     1
     D  @RtnFrmCtl                    8
     D  @RtnScsAsc                    1
     D  @RtnMfgTyp                   17
     D  @RtnCObjNm                   10
     D  @RtnCObjLb                   10
     D  @Reservd3                     1
     D  @RtnOffSt                     9B 0
     D  @Rtn#SzEnt                    9B 0
     D  @RtnLenEnt                    9B 0
     D  @RtnDstOpt                  128
      *
      *  Record structure for error code parameter
      *
     D@ErrData         DS
     D  @BytesProv                    9B 0 Inz(100)
     D  @BytesAval                    9B 0
     D  @ExcpId                       7
     D  @Reserved1                    1
     D  @ExcpData                   184
      *
      *  Target OUTQ Information comparison
      *
     D@TInfo           DS
     D  @TGTM                        10
     D  @TOQN                        10
     D  @TOQL                        10
      *
     DDFInfo           DS
     D  DFTGTM                       10
     D  DFTOQN                       10
     D  DFTOQL                       10
      *
      *  Constants
      *
     D @Yes            C                   CONST('Y')
     D @No             C                   CONST('N')
     D @Ttl2_Desc      C                   CONST('Description')
     D @Ttl1_Sts       C                   CONST('Target     Tgt OUTQ   Tgt OUT-
     D                                     Q            ')
     D @Ttl2_Sts       C                   CONST('Machine    Name       Library-
     D                                                  ')
     D @NoRec          C                   CONST('* -- No Remote OUTQ to list --
     D                                     - *')

     D @Title_1        C                   CONST('      Add New Remote-
     D                                      Output Queue       ')
     D @Title_2        C                   CONST('     Work with Remot-
     D                                     e Output Queue      ')
     D @Title_3        C                   CONST('   Press Enter to De-
     D                                     lete Output Queue   ')
     D @Title_4        C                   CONST(' Press Enter to Disc-
     D                                     onnect Output Queue ')

     D @TagStrWtr      C                   CONST('STRWTR')
     D @TagHldWtr      C                   CONST('HLDWTR')
     D @TagEndWtr      C                   CONST('ENDWTR')
     D @TagRlsWtr      C                   CONST('RLSWTR')
     D @TagWrkOQ       C                   CONST('WRKOUTQ')

     D @Add            C                   CONST('A')
     D @Delete         C                   CONST('D')
     D @Disconnec      C                   CONST('X')
     D @Edit           C                   CONST('E')

     D @ErrSOQN        C                   CONST('Source OUTQ Name required')
     D @ErrSOQL        C                   CONST('Source OUTQ Library required')
     D @ErrLIBL        C                   CONST('*LIBL not allowed for library-
     D                                      name')
     D @ErrTGTM        C                   CONST('Target Machine required')
     D @ErrPEER1       C                   CONST('Target Machine')
     D @ErrPEER2       C                   CONST('not a valid PEER device for')
     D @ErrTOQN        C                   CONST('Target OUTQ Name required')
     D @ErrTOQL        C                   CONST('Target OUTQ Library required')
     D @ErrWActv1      C                   CONST('Target info cannot be changed-
     D                                     . F12 and end the writer first')
     D @ErrWActv2      C                   CONST('Writer cannot be deleted. F12-
     D                                      and end the writer first')
     D @ErrWActv3      C                   CONST('Writer cannot be disconnected-
     D                                     . F12 and end the writer first')
     D @ErrConfrm      C                   CONST('Press Enter to confirm delete-
     D                                      of writer. Press F12 to cancel')
     D @ErrConf        C                   CONST('You requested to delete ')
     D @ErrConfB       C                   CONST('both Source & Target OUTQ')
     D @ErrConfS       C                   CONST('the Source OUTQ only')
     D @ErrConfT       C                   CONST('the Target OUTQ only')

     D @WrkOutq        C                   CONST('WRKOUTQ OUTQ(')
     D @ChgOutq1       C                   CONST('CHGOUTQ OUTQ(')
     D @ChgOutq2       C                   CONST(') TEXT(')
     D @StrRmtWtr      C                   CONST('STRRMTWTR OUTQ(')
     D @HldWtr1        C                   CONST('HLDWTR WTR(')
     D @HldWtr2        C                   CONST(') OPTION(*IMMED)')
     D @EndWtr1        C                   CONST('ENDWTR WTR(')
     D @EndWtr2        C                   CONST(') OPTION(*IMMED)')
     D @RlsWtr         C                   CONST('RLSWTR WTR(')
      *
      *  Standalone fields
      *
     D @MsgId          S              7
     D @MsgDta         S            200
     D AControl        S              1
      *                                    I: send message & use message id
      *                                    M: impromptu message (cpf9898)
      *                                    C: clear message queue
      *                                    S: status message
     D AMsgId          S              7
     D AMsgDta         S            200
     D AMessage        S             80
     D AMsgfile        S             10    Inz('QCPFMSG')
     D YourMsg         S             80
     D BuildReq        S              1    INZ(@No)
     D Error2          S              1    INZ(@No)
     D Confirm2        S              1    INZ(@No)
     D @Err            S              5P 0 Inz(0)
     D Command         S             80
     D Length          S             15  5
     D @OQRcvLen       S              9P 0 INZ(2000)
     D @OQFmtNam       S              8    INZ('OUTQ0100')
     D @OQNamLib       S             20
     D @Action         S              1
     D @Tag            S             10
     D @SflPage        S              5P 0 INZ(11)
     D SvPos1          S                   LIKE(DFPOS1)
     D RRN1            S              5P 0 Inz(0)
     D @NetRcvLen      S              9B 0 Inz(32)
     D @NetRtvAtr      S              9B 0 Inz(1)
     D @NetAtrNam      S             10    Inz('SYSNAME')
     D DFDELT          S              1    Inz('B')

     D Counter         S                   LIKE(RRN1)
     D BldCtr          S                   LIKE(RRN1)
     D LastRRN1        S                   LIKE(RRN1)
     D LastSOQN        S                   LIKE(TSSOQN)
     D LastSOQL        S                   LIKE(TSSOQL)
     D KYSOQN          S                   LIKE(TSSOQN)
     D KYSOQL          S                   LIKE(TSSOQL)
     D KYLCLL          S                   LIKE(APLCLL)
     D KYRMTL          S                   LIKE(APRMTL)
     D KYSEQ#          S                   LIKE(APSEQ#)
      *
      *  AID Generation Code
      *
     D Enter           C                   CONST(X'F1')
     D Rollup          C                   CONST(X'F5')
     D PageDown        C                   CONST(X'F5')
     D RollDown        C                   CONST(X'F4')
     D PageUp          C                   CONST(X'F4')
     D Help            C                   CONST(X'F3')
     D Print           C                   CONST(X'F6')
     D BackSpace       C                   CONST(X'F8')
     D Home            C                   CONST(X'F8')
     D Clear           C                   CONST(X'BD')
     D Fkey01          C                   CONST(X'31')
     D Fkey02          C                   CONST(X'32')
     D Fkey03          C                   CONST(X'33')
     D Fkey04          C                   CONST(X'34')
     D Fkey05          C                   CONST(X'35')
     D Fkey06          C                   CONST(X'36')
     D Fkey07          C                   CONST(X'37')
     D Fkey08          C                   CONST(X'38')
     D Fkey09          C                   CONST(X'39')
     D Fkey10          C                   CONST(X'3A')
     D Fkey11          C                   CONST(X'3B')
     D Fkey12          C                   CONST(X'3C')
     D Fkey13          C                   CONST(X'B1')
     D Fkey14          C                   CONST(X'B2')
     D Fkey15          C                   CONST(X'B3')
     D Fkey16          C                   CONST(X'B4')
     D Fkey17          C                   CONST(X'B5')
     D Fkey18          C                   CONST(X'B6')
     D Fkey19          C                   CONST(X'B7')
     D Fkey20          C                   CONST(X'B8')
     D Fkey21          C                   CONST(X'B9')
     D Fkey22          C                   CONST(X'BA')
     D Fkey23          C                   CONST(X'BB')
     D Fkey24          C                   CONST(X'BC')
     I/EJECT
     C/EJECT
     C
      ****************************************************************
      *     C A L C U L A T I O N     S P E C I F I C A T I O N      *
      ****************************************************************
      *
     C                   Eval      *In31    = *Off
     C                   Eval      DfTtl1   = @Ttl1_Sts
     C                   Eval      DfTtl2   = @Ttl2_Sts
     C                   Reset                   @SflPage
     C                   Exsr      $ClrMsg
      *----------------------------------------------------*
      *  Retrieve system name from network attributes      *
      *----------------------------------------------------*
     C                   CALL      'QWCRNETA'
     C                   PARM                    @RtnNetAtr
     C                   PARM                    @NetRcvLen
     C                   PARM                    @NetRtvAtr
     C                   PARM                    @NetAtrNam
     C                   PARM                    @ErrData
      *
     C                   If        @BytesAval > 0
     C                   Eval      @MsgId   = @ExcpId
     C                   Eval      @MsgDta  = @ExcpData
     C                   Eval      YourMsg  = *Blanks
     C                   Eval      AControl = 'I'
     C                   Exsr      $SndMsg
     C                   EndIf
      *
     C                   Eval      KYLCLL   = @RtnSystem                           SFLDSP
     C                   Eval      KYSEQ#   = 1                                    SFLDSP
      *----------------------------------------------------*
      *  Mainline Routine                                  *
      *----------------------------------------------------*
      *
      *  Rebuild the subfile
     C                   Exsr      $ClearSfl1
      *
      *----------------------------------------------------*
      *  Loop until F3=Exit is requested                   *
      *----------------------------------------------------*
     C                   Dow       Not *In03
      *
      *  Build the subfile
     C     BuildReq      CasEq     @Yes          $BuildSfl1
     C                   EndCs
      *
      *  Remote OUTQ records exist in the SFL, turn *ON SFLDSP
     C                   If        RRN1     > *Zero
     C                   Eval      *IN34    = *On                                  SFLDSP
     C                   Else
     C                   Eval      *IN34    = *Off                              No SFLDSP
     C                   Eval      *IN41    = *On                               No SFLDSP
     C                   Eval      @OPT     = *Zero
     C                   Eval      @SOQN    = *BLANKS
     C                   Eval      @SOQL    = *BLANKS
     C                   Eval      @STS     = *BLANKS
     C                   Eval      @DESC    = *BLANKS
     C                   Eval      @TGTM    = *BLANKS
     C                   Eval      @TOQN    = *BLANKS
     C                   Eval      @TOQL    = *BLANKS
     C                   Eval      @INFO    = @NoRec
     C                   Eval      RRN1     = RRN1 + 1
     C                   Eval      Counter  = Counter + 1
     C                   Write     TS0010S1
     C                   EndIf

      *
      *  Display the error line
     C                   Write     MSGCTL
      *
      *  Write the command line (for the first page only)
     C                   Write     TS0010D1
      *
     C                   Exfmt     TS0010C1
      *
      *  Process Screen 1
     C                   EXSR      $Process1
     C     CmdCancel     TAG
      *
     C                   EndDo
      *
      *  Exit the program
     C                   Eval      *InLR    = *On
     C                   Return
      *
      /EJECT
      ****************************************************************
      *                    S U B R O U T I N E S                     *
      ****************************************************************
      /SPACE
      *==============================================================*
      *                                                              *
      *  Definition and Key List Subroutine                          *
      *                                                              *
     C     $DEFN         BEGSR                                                            *
      *==============================================================*
      *------------------------------------------*
      *  Key List                                *
      *------------------------------------------*
      *
      *  Remote Output Queue File
      *
     C     LastOQKey     Klist
     C                   Kfld                    LastSOQN
     C                   Kfld                    LastSOQL
      *
     C     OutqKey       Klist
     C                   Kfld                    KYSOQN
     C                   Kfld                    KYSOQL
      *
     C     MchKey        Klist
     C                   Kfld                    KYLCLL
     C                   Kfld                    KYRMTL
     C                   Kfld                    KYSEQ#
      *
     C     #DEFN         ENDSR
      /SPACE 4
      *==============================================================*
      *                                                              *
      *  Clear Subfile                                               *
      *                                                              *
     C     $ClearSfl1    BegSr                                                            *
      *==============================================================*
     C                   Eval      BuildReq = @Yes
     C                   Eval      RRN1     = 0
     C                   Eval      LastRRN1 = 0
      *
     C                   Eval      *In33    = *On                                  SFLCLR
     C                   Eval      *In34    = *Off                              No SFLDSP
      *
      *  Clear the subfile
     C                   Write     TS0010C1
     C                   Eval      *In33    = *Off                              No SFLCLR
      *
      *  Position the cursor from the last position
     C     SvPos1        Setll     TSRMOQ
      *
     C     #ClearSfl1    EndSr                                                            *
      /SPACE 4
      *==============================================================*
      *                                                              *
      *  Build the subfile - one page at a time  (11 records) for    *
      *                      screen 1.                               *
      *                                                              *
     C     $BuildSfl1    BegSr                                                            *
      *==============================================================*
     C                   Eval      BuildReq = @No
      *
     C                   Eval      RRN1     = LastRRN1
     C                   Eval      Counter  = *ZERO
     C                   Eval      *IN41    = *Off                              No SFL Opt
      *
      *  Read the next record
     C                   Read      TSRMOQ                                 99
      *
      *  Build 11 records at a time
     C                   Dow       (Not *IN99     And
     C                              Counter < @SflPage)
     C                   Eval      *In36    = *On
     C                   Eval      @OPT     = *Zero
     C                   Eval      @SOQN    = TSSOQN
     C                   Eval      @SOQL    = TSSOQL
     C                   Eval      @DESC    = TSSOQT
     C                   Eval      @TGTM    = TSTGTM
     C                   Eval      @TOQN    = TSTOQN
     C                   Eval      @TOQL    = TSTOQL
     C                   Eval      @INFO    = *BLANKS
      *------------------------------------------*
      *  Check remote writer status              *
      *------------------------------------------*
     C                   Exsr      $ChkStatus
      *------------------------------------------*
      *  Load Target Machine Information         *
      *------------------------------------------*
     C                   If        *In31
     C                   Eval      @INFO    = @DESC
     C                   Else
     C                   Eval      @INFO    = @TGTM  +  ' '  +
     C                                        @TOQN  +  ' '  +
     C                                        @TOQL
     C                   EndIf
     C                   Eval      RRN1     = RRN1 + 1
     C                   Eval      Counter  = Counter + 1
     C                   Write     TS0010S1
     C                   If        Counter  = @SflPage
     C                   Leave
     C                   EndIf
     C                   Read      TSRMOQ                                 99
     C                   Enddo
      *
      *  Read 1 more record to determine SFLEND & allow ROLLUP
     C                   If        Not *In99
     C                   Read      TSRMOQ                                 99
     C                   IF        NOT *IN99
     C                   Readp     TSRMOQ                                 97
     C                   EndIf
     C                   EndIf
     C                   Eval      *In35    = *In99                             SFLEND
      *  Save the last key
     C                   Eval      LastRRN1 = RRN1
     C                   If        RRN1     > 0
     C                   Eval      LastSOQN = TSSOQN
     C                   Eval      LastSOQL = TSSOQL
     C                   Else
     C                   Eval      LastSOQN = *Blanks
     C                   Eval      LastSOQL = *Blanks
     C                   EndIf
      *  Release the record lock
     C                   If        Not *In99
     C                   Unlock    TSRMOQ
     C                   EndIf
      *  Position the subfile on the top RRN of the current page
     C                   EVAL      RRNPAG1  = SubfileRRN - Counter + 1          SFLDSP
      *
     C     #BuildSfl1    ENDSR                                                            *
      /SPACE 4
      *==============================================================*
      *                                                              *
      *  Check Writer STatus for Screen 1                            *
      *                                                              *
     C     $ChkStatus    BegSr                                                            *
      *==============================================================*
     C                   Eval      @Sts     = *BLANKS
     C                   Eval      @OQNamLib= @SOQN + @SOQL
      *----------------------------------------------------*
      *  Retrieve the output queue information             *
      *----------------------------------------------------*
     C     ChkWtr        Tag
     C                   CALL      'QSPROUTQ'
     C                   PARM                    @RtnOQInfo
     C                   PARM                    @OQRcvLen
     C                   PARM                    @OQFmtNam
     C                   PARM                    @OQNamLib
     C                   PARM                    @ErrData
      *
      *------------------------------------------*
      *  The OUTQ does not exist, create it.     *
      *------------------------------------------*
     C                   If        @BytesAval > 0     And
     C                             @ExcpId  = 'CPF3357'
     C                   Eval      DFSOQN   = @SOQN
     C                   Eval      DFSOQL   = @SOQL
     C                   Eval      DFSOQT   = @DESC
     C                   Eval      DFTGTM   = @TGTM
     C                   Eval      DFTOQN   = @TOQN
     C                   Eval      DFTOQL   = @TOQL
     C                   Exsr      $TS0011C
     C                   Goto      ChkWtr
     C                   EndIf
      *
     C                   If        @BytesAval > 0
     C                   Eval      @MsgId   = @ExcpId
     C                   Eval      @MsgDta  = @ExcpData
     C                   Eval      YourMsg  = *Blanks
     C                   Eval      @Err     = @Err + 1
     C                   Eval      AControl = 'I'
     C                   Exsr      $SndMsg
     C                   Goto      #ChkStatus
     C                   EndIf
      *
      *------------------------------------------*
      *  No remote outq attached to the writer   *
      *  but the writer exist in the system.     *
      *------------------------------------------*
     C                   If        @Rtn#AStr= 0        Or
     C                             @RtnRmSys= *Blanks  Or
     C                             @RtnRmSys<>@TGTM    Or
     C                             @RtnRmWtr<>@TOQN
     C                   Eval      DFSOQN   = @SOQN
     C                   Eval      DFSOQL   = @SOQL
     C                   Eval      DFSOQT   = @DESC
     C                   Eval      DFTGTM   = @TGTM
     C                   Eval      DFTOQN   = @TOQN
     C                   Eval      DFTOQL   = @TOQL
     C                   Exsr      $TS0011C
     C                   Goto      ChkWtr
     C                   EndIf
      *------------------------------------------*
      *  Move the writer status                  *
      *------------------------------------------*
     C                   Eval      @Sts     = @RtnWSts
     C                   If        @Sts     = *Blanks
     C                   Eval      @Sts     = '*NA'
     C                   EndIf
      *
     C     #ChkStatus    ENDSR                                                            *
      /SPACE 4
      *==============================================================*
      *                                                              *
      *  Process function keys for Screen 1                          *
      *                                                              *
     C     $Process1     BEGSR                                                            *
      *==============================================================*
      *
      *  Position the subfile page to where the user pressed Enter
     C                   EVAL      RRNPAG1  = MinimumRRN                        SFLDSP
      *
      *  Clear & reset message subfile
     C                   Exsr      $ClrMsg
      *
      *------------------------------------------*
      *  Function Keys                           *
      *------------------------------------------*
      *
      *  F3=Exit
     C     *In03         CabEq     *On           #Process1
      *
      *  F5=Refresh
     C                   If        *In05
     C                   Eval      LastSOQN = *Blanks
     C                   Eval      LastSOQL = *Blanks
     C                   EVAL      SVPOS1   = *BLANKS
     C                   EVAL      DFPOS1   = *BLANKS
     C                   Movea     '00'          *IN(25)                        Reset Roll Keys
     C                   Movea     '00'          *IN(98)                        Reset Roll Keys
     C                   Exsr      $ClearSfl1
     C                   Goto      #Process1
     C                   EndIf
      *
      *  F9=Add
     C                   IF        *IN09
     C                   Eval      @Action  = @Add
     C                   Eval      @STS     = '*NA'
     C                   Eval      @SOQN    = *BLANKS
     C                   Eval      @SOQL    = *BLANKS
     C                   Eval      @DESC    = *BLANKS
     C                   Eval      @TGTM    = *BLANKS
     C                   Eval      @TOQN    = *BLANKS
     C                   Eval      @TOQL    = *BLANKS
     C                   Movea     '100'         *IN(20)
     C                   Eval      TTL1     = @Title_1
     C                   Exsr      $Display2
      *------------------------------------------*
      *  Rebuild the subfile                     *
      *------------------------------------------*
     C     BuildReq      Ifeq      @Yes
     C                   Eval      LastSOQN = *Blanks
     C                   Eval      LastSOQL = *Blanks
     C                   Eval      SVPOS1   = *BLANKS
     C                   Eval      DFPOS1   = *BLANKS
     C                   Exsr      $ClearSfl1
     C                   Else
      *  Write the command line
     C                   Write     TS0010D1
     C                   EndIf
     C                   Goto      #Process1
     C                   EndIf
      *
      *  F11=Alternative view
     C                   If        *In11
     C                   If        *In31    = *On
     C                   Eval      *In31    = *Off
     C                   Eval      DfTtl1   = @Ttl1_Sts
     C                   Eval      DfTtl2   = @Ttl2_Sts
     C                   ELSE
     C                   Eval      *IN31    = *On
     C                   Eval      DfTtl1   = *Blanks
     C                   Eval      DfTtl2   = @Ttl2_Desc
     C                   EndIf

     C                   Readc     TS0010S1                               96
     C                   Dow       Not *In96
     C                   If        @Opt     <> 0
     C                   Eval      *In36    = *On
     C                   EndIf
     C                   If        *In31
     C                   Eval      @INFO    = @DESC
     C                   ELSE
     C                   Eval      @INFO    = @TGTM  +  ' '  +
     C                                        @TOQN  +  ' '  +
     C                                        @TOQL
     C                   EndIf
     C                   Update    TS0010S1
     C                   Readc     TS0010S1                               96
     C                   EndDo

     C                   GOTO      #Process1
     C                   ENDIF

      *------------------------------------------*
      *  Process Roll Keys                       *
      *------------------------------------------*
      *
      *  Rollup
     C                   IF        *IN25
     C                   EVAL      BuildReq = @Yes
     C                   GOTO      #Process1
     C                   ENDIF
      *
      *  Rolldown
     C                   IF        *IN26
     C                   EVAL      Counter  = *ZERO
     C                   EVAL      *IN98    = *OFF
     C                   IF        *IN35                                        SFLEND
     C     LastOQKey     SetLL     TSRMOQ
     C                   EndIf

     C                   Dow       (Not *IN98    And
     C                              Counter < (Subfilerrn + (@SflPage - 1)))
     C                   Readp     TSRMOQ                                 98
     C                   EVAL      Counter  = Counter + 1
     C                   EndDo

     C                   If        *In98
     C                   Eval      SVPOS1   = *BLANKS
     C                   Eval      DFPOS1   = *BLANKS
     C                   Eval      LastSOQN = *Blanks
     C                   Eval      LastSOQL = *Blanks
     C                   Else
     C                   Eval      LastSOQN = TSSOQN
     C                   Eval      LastSOQL = TSSOQL
     C                   EndIf
     C                   Eval      BuildReq = @Yes
     C                   Exsr      $ClearSfl1
     C                   Goto      #Process1
     C                   EndIf
      *------------------------------------------*
      *  Process remote output queue position to *
      *------------------------------------------*
     C                   If        DfPos1  <> SvPos1
     C                   Eval      SvPos1   = DfPos1
     C                   Eval      LastSOQN = DFPOS1
     C                   Eval      LastSOQL = *Blanks
     C                   Movea     '00'          *IN(25)                        Reset Roll Keys
     C                   Movea     '00'          *IN(98)                        Reset Roll Keys
     C                   Exsr      $ClearSfl1
     C                   Goto      #Process1
     C                   EndIf
      *------------------------------------------*
      * Process user options                     *
      *------------------------------------------*
     C     *In34         CabEq     *Off          #Process1
      *
     C                   Readc     TS0010S1                               96

     C                   Dow       Not *In96
     C                   Eval      @Tag     = *Blanks
     C                   Select
      *
      *  1=Start Remote Writer
     C                   When      @Opt = 1
     C                   Eval      @Tag     = @TagStrWtr
     C                   Eval      Command  = @StrRmtWtr    +
     C                                        %Trimr(@SOQL) + '/' +
     C                                        %Trimr(@SOQN) + ')'
     C                   Eval      Length   = 80
     C                   CALL      'QCMDEXC'
     C                   Parm                    Command
     C                   Parm                    Length
     C                   Exsr      $ChkStatus
      *
      *  2=Edit OUTQ
     C                   When      @Opt = 2
     C                   Eval      @Action  = @Edit
     C                   Movea     '110'         *IN(20)
     C                   Eval      TTL1     = @Title_2
     C                   Exsr      $Display2
      *
      *  3=Hold the Writer Immediately
     C                   When      @Opt = 3
     C                   Eval      @Tag     = @TagHldWtr
     C                   Eval      Command  = @HldWtr1      +
     C                                        %Trimr(@SOQN) +
     C                                        @HldWtr2
     C                   Eval      Length   = 80
     C                   Call      'QCMDEXC'
     C                   Parm                    Command
     C                   Parm                    Length
     C                   Exsr      $ChkStatus
      *
      *  4=End the Writer Immediately
     C                   When      @Opt = 4
     C                   Eval      @Tag     = @TagEndWtr
     C                   Eval      Command  = @EndWtr1      +
     C                                        %Trimr(@SOQN) +
     C                                        @EndWtr2
     C                   Eval      Length   = 80
     C                   Call      'QCMDEXC'
     C                   Parm                    Command
     C                   Parm                    Length
     C                   Eval      @Sts     = '*NA'
      *
      *  5=Work with Output Queue
     C                   When      @Opt = 5
     C                   Eval      @Tag     = @TagWrkOQ
     C                   Eval      Command  = @WrkOutq      +
     C                                        %Trimr(@SOQL) + '/' +
     C                                        %Trimr(@SOQN) + ')'
     C                   Eval      Length   = 80
     C                   Call      'QCMDEXC'
     C                   Parm                    Command
     C                   Parm                    Length
      *
      *  6=Release the Writer
     C                   When      @Opt = 6
     C                   Eval      @Tag     = @TagRlsWtr
     C                   Eval      Command  = @RlsWtr       +
     C                                        %Trimr(@SOQN) + ')'
     C                   Eval      Length   = 80
     C                   Call      'QCMDEXC'
     C                   Parm                    Command
     C                   Parm                    Length
     C                   Exsr      $ChkStatus
      *
      *  13=Delete the OUTQ
     C                   WHEN      @Opt = 13
     C                   Eval      @Action  = @Delete
     C                   Movea     '011'         *IN(20)
     C                   Eval      TTL1     = @Title_3
     C                   Exsr      $Display2
      *
      *  17=Disconnect from remote outq
     C                   WHEN      @Opt = 17
     C                   Eval      @Action  = @Disconnec
     C                   Movea     '011'         *IN(20)
     C                   Eval      TTL1     = @Title_4
     C                   Exsr      $Display2
      *
     C                   EndSl
      *
      *  F3=Exit requested on the 2nd Screen
     C                   If        *In03
     C                   Leave
     C                   EndIf
      *
     C                   Eval      @Opt     = *ZERO
     C                   If        *In31
     C                   Eval      @INFO    = @DESC
     C                   ELSE
     C                   Eval      @INFO    = @TGTM  +  ' '  +
     C                                        @TOQN  +  ' '  +
     C                                        @TOQL
     C                   EndIf
     C                   Update    TS0010S1
     C                   Readc     TS0010S1                               96
     C                   EndDo
      *------------------------------------------*
      *  Rebuild the subfile                     *
      *------------------------------------------*
     C     BuildReq      Ifeq      @Yes
     C                   Eval      LastSOQN = *Blanks
     C                   Eval      LastSOQL = *Blanks
     C                   Eval      SVPOS1   = *BLANKS
     C                   Eval      DFPOS1   = *BLANKS
     C                   Exsr      $ClearSfl1
     C                   EndIf
      *
     C     #Process1     EndSr                                                            *
      /EJECT
      *==============================================================*
      *                                                              *
      *  Display Screen 2                                            *
      *                                                              *
     C     $Display2     BegSr                                                            *
      *==============================================================*
     C                   Exsr      $ClrMsg2
     C                   Exsr      $ClearDsp2
     C                   Reset                   DFDELT
      *------------------------------------------*
      *  Loop until exit, or update to file      *
      *  has been executed.                      *
      *------------------------------------------*
     C                   Dou       *IN03          Or
     C                             *IN12          Or
     C                             DspAID   = Enter
     C                   Write     TS0010D2
     C                   Write     MSGCTL2
     C                   Read      TS0010D2                               90
     C                   Exsr      $ClrMsg2
      *
      *  F5 = Refresh
     C     *In05         CasEq     *On           $ClearDsp2
     C                   EndCs
      *
      *  ENTER = Delete the OUTQ - Local & Remote
     C                   If        DSPAID   = Enter   And
     C                             @Action  = @Delete
      *------------------------------------------*
      *  Writer cannot be deleted if writer is   *
      *  active.  End the writer first.          *
      *------------------------------------------*
     C                   If        @Sts    <> '*NA'
     C                   Eval      YourMsg  = @ErrWActv2
     C                   Eval      BuildReq = @No
     C                   Eval      AControl = 'M'
     C                   Exsr      $SndMsg
     C                   Eval      DSPAID   = *Blanks
     C                   Eval      *In24    = *On

      *------------------------------------------*
      *  Send confirmation message for deletion  *
      *  of writer first.  If Enter is pressed   *
      *  again, then execute the $Delete2.       *
      *------------------------------------------*
     C                   Else
     C                   If        Confirm2 = @No
     C                   Eval      YourMsg  = @ErrConfrm
     C                   Eval      BuildReq = @No
     C                   Eval      AControl = 'M'
     C                   Exsr      $SndMsg
     C                   Eval      DSPAID   = *Blanks
     C                   Eval      Confirm2 = @Yes
     C                   Eval      *In23    = *On
     C                   Select
     C                   When      DFDELT  = 'B'
     C                   Eval      DFCONF  = @ErrConf  +  @ErrConfB
     C                   When      DFDELT  = 'T'
     C                   Eval      DFCONF  = @ErrConf  +  @ErrConfT
     C                   When      DFDELT  = 'S'
     C                   Eval      DFCONF  = @ErrConf  +  @ErrConfS
     C                   EndSl
     C                   Else
     C                   Exsr      $Delete2
     C                   EndIf
     C                   EndIf
     C                   EndIf
      *
      *  ENTER = Disconnect from remote outq
     C                   If        DSPAID   = Enter   And
     C                             @Action  = @Disconnec
      *------------------------------------------*
      *  Writer cannot be disconnected if the    *
      *  writer is active. End the writer first. *
      *------------------------------------------*
     C                   If        @Sts    <> '*NA'
     C                   Eval      YourMsg  = @ErrWActv3
     C                   Eval      BuildReq = @No
     C                   Eval      AControl = 'M'
     C                   Exsr      $SndMsg
     C                   Eval      DSPAID   = *Blanks
     C                   Else
     C                   Exsr      $Delete2
     C                   EndIf
     C                   EndIf
      *
      *  ENTER = Update the Database
     C                   IF        DSPAID   = Enter      And
     C                             (@Action <> @Delete   And
     C                              @Action <> @Disconnec)
     C                   Eval      Error2   = @No
     C                   Exsr      $Check2
     C                   If        Error2   = @Yes
     C                   Eval      DSPAID   = *Blanks
     C                   Else
     C                   Exsr      $Update2
     C                   EndIf
     C                   EndIf
     C                   EndDo
      *
     C     #Display2     EndSr                                                            *
      /SPACE 4
      *==============================================================*
      *                                                              *
      *  Clear display 2                                             *
      *                                                              *
     C     $ClearDsp2    BegSr                                                            *
      *==============================================================*
     C                   Movea     '00000'       *IN(51)
     C                   Eval      KYSOQN   = @SOQN
     C                   Eval      KYSOQL   = @SOQL
     C                   Eval      DFSOQN   = @SOQN
     C                   Eval      DFSOQL   = @SOQL
     C                   Eval      DFSOQT   = @DESC
     C                   Eval      DFTGTM   = @TGTM
     C                   Eval      DFTOQN   = @TOQN
     C                   Eval      DFTOQL   = @TOQL
     C                   Reset                   Confirm2
     C                   Eval      *In23    = *Off
     C                   Eval      *In24    = *Off
     C                   If        @Action  = @Disconnec
     C                   Eval      *In23    = *On
     C                   Eval      *In24    = *On
     C                   EndIf
     C     @SOQN         Casne     *Blanks       $BuildDsp2
     C                   EndCs
      *
     C     #ClearDsp2    EndSr                                                            *
      /SPACE 4
      *==============================================================*
      *                                                              *
      *  Build display 2                                             *
      *                                                              *
     C     $BuildDsp2    BEGSR                                                            *
      *==============================================================*
     C     OutqKey       CHAIN(N)  TSRMOQ                             97
     C                   If        Not *In97
     C                   EVAL      DFSOQN   = KYSOQN
     C                   EVAL      DFSOQL   = KYSOQL
     C                   EVAL      DFSOQT   = TSSOQT
     C                   EVAL      DFTGTM   = TSTGTM
     C                   EVAL      DFTOQN   = TSTOQN
     C                   EVAL      DFTOQL   = TSTOQL
     C                   EndIf
      *------------------------------------------*
      *  Send Warning message: Delete not        *
      *  allowed, user must end the writer first *
      *------------------------------------------*
     C                   If        @Action  = @Delete And
     C                             @Sts    <> '*NA'
     C                   Eval      YourMsg  = @ErrWActv2
     C                   Eval      BuildReq = @No
     C                   Eval      AControl = 'M'
     C                   Exsr      $SndMsg
     C                   Eval      *In24    = *On
     C                   EndIf
      *------------------------------------------*
      *  Send Warning message: Disconnect not    *
      *  allowed, user must end the writer first *
      *------------------------------------------*
     C                   If        @Action  = @Disconnec And
     C                             @Sts    <> '*NA'
     C                   Eval      YourMsg  = @ErrWActv3
     C                   Eval      BuildReq = @No
     C                   Eval      AControl = 'M'
     C                   Exsr      $SndMsg
     C                   EndIf
      *
     C     #BuildDsp2    ENDSR                                                            *
      /SPACE 4
      *==============================================================*
      *                                                              *
      *  Validate Screen 2                                           *
      *                                                              *
     C     $Check2       BEGSR                                                            *
      *==============================================================*
      *
      *------------------------------------------*
      *  Source OUTQ Name required               *
      *------------------------------------------*
     C                   If        DFSOQN   = *Blanks
     C                   Eval      YourMsg  = @ErrSOQN
     C                   Eval      BuildReq = @No
     C                   Eval      @Err     = @Err + 1
     C                   Eval      AControl = 'M'
     C                   Eval      *In51    = *On
     C                   EVAL      Error2   = @Yes
     C                   Exsr      $SndMsg
     C                   EndIf
      *------------------------------------------*
      *  Source OUTQ Library required            *
      *------------------------------------------*
     C                   If        DFSOQL   = *Blanks
     C                   Eval      YourMsg  = @ErrSOQL
     C                   Eval      BuildReq = @No
     C                   Eval      @Err     = @Err + 1
     C                   Eval      AControl = 'M'
     C                   Eval      *In52    = *On
     C                   EVAL      Error2   = @Yes
     C                   Exsr      $SndMsg
     C                   EndIf
      *------------------------------------------*
      *  *LIBL not allowed for library name      *
      *------------------------------------------*
     C                   If        DFSOQL   = '*LIBL'
     C                   Eval      YourMsg  = @ErrLIBL
     C                   Eval      BuildReq = @No
     C                   Eval      @Err     = @Err + 1
     C                   Eval      AControl = 'M'
     C                   Eval      *In52    = *On
     C                   EVAL      Error2   = @Yes
     C                   Exsr      $SndMsg
     C                   EndIf
      *------------------------------------------*
      *  Target Machine required                 *
      *------------------------------------------*
     C                   If        DFTGTM   = *Blanks
     C                   Eval      YourMsg  = @ErrTGTM
     C                   Eval      BuildReq = @No
     C                   Eval      @Err     = @Err + 1
     C                   Eval      AControl = 'M'
     C                   Eval      *In53    = *On
     C                   EVAL      Error2   = @Yes
     C                   Exsr      $SndMsg
     C                   EndIf
      *------------------------------------------*
      *  Target Machine not a valid PEER device  *
      *------------------------------------------*
     C                   If        DFTGTM  <> *Blanks And
     C                             DFSOQN  <> *Blanks
     C                   Eval      KYRMTL   = DFTGTM
     C     MchKey        Chain     XFPAPEER                           53
     C                   If        *In53
     C                   Eval      YourMsg  = @ErrPEER1      + ' ' +
     C                                        %Trimr(DFTGTM) + ' ' +
     C                                        @ErrPEER2      + ' ' +
     C                                        %Trimr(DFSOQN)
     C                   Eval      BuildReq = @No
     C                   Eval      @Err     = @Err + 1
     C                   Eval      AControl = 'M'
     C                   EVAL      Error2   = @Yes
     C                   Exsr      $SndMsg
     C                   EndIf
     C                   EndIf
      *------------------------------------------*
      *  Target OUTQ name required               *
      *------------------------------------------*
     C                   If        DFTOQN   = *Blanks
     C                   Eval      YourMsg  = @ErrTOQN
     C                   Eval      BuildReq = @No
     C                   Eval      @Err     = @Err + 1
     C                   Eval      AControl = 'M'
     C                   Eval      *In54    = *On
     C                   EVAL      Error2   = @Yes
     C                   Exsr      $SndMsg
     C                   EndIf
      *------------------------------------------*
      *  Target OUTQ library required            *
      *------------------------------------------*
     C                   If        DFTOQL   = *Blanks
     C                   Eval      YourMsg  = @ErrTOQL
     C                   Eval      BuildReq = @No
     C                   Eval      @Err     = @Err + 1
     C                   Eval      AControl = 'M'
     C                   Eval      *In55    = *On
     C                   EVAL      Error2   = @Yes
     C                   Exsr      $SndMsg
     C                   EndIf
      *------------------------------------------*
      *  *LIBL not allowed for library name      *
      *------------------------------------------*
     C                   If        DFTOQL   = '*LIBL'
     C                   Eval      YourMsg  = @ErrLIBL
     C                   Eval      BuildReq = @No
     C                   Eval      @Err     = @Err + 1
     C                   Eval      AControl = 'M'
     C                   Eval      *In55    = *On
     C                   EVAL      Error2   = @Yes
     C                   Exsr      $SndMsg
     C                   EndIf
      *------------------------------------------*
      *  Writer must be ended before Target info *
      *  can be changed.                         *
      *------------------------------------------*
     C                   If        @TInfo  <> DFInfo  And
     C                             @Sts    <> '*NA'
     C                   Eval      YourMsg  = @ErrWActv1
     C                   Eval      BuildReq = @No
     C                   Eval      @Err     = @Err + 1
     C                   Eval      AControl = 'M'
     C                   EVAL      Error2   = @Yes
     C                   Exsr      $SndMsg
     C                   EndIf
      *
     C     #Check2       ENDSR                                                            *
      /SPACE 4
      *==============================================================*
      *                                                              *
      *  Update the Record                                           *
      *                                                              *
     C     $Update2      BEGSR                                                            *
      *==============================================================*
      *
     C                   Eval      KYSOQN   = DFSOQN
     C                   Eval      KYSOQL   = DFSOQL
     C     OutqKey       Chain     TSRMOQ                             97
     C                   Eval      TSSOQT   = DFSOQT
     C                   Eval      TSTGTM   = DFTGTM
     C                   Eval      TSTOQN   = DFTOQN
     C                   Eval      TSTOQL   = DFTOQL
      *----------------------------------------------------*
      *  Update Existing OUTQ                              *
      *----------------------------------------------------*
     C                   If        Not *In97
     C                   Update    TSRMOQR
      *------------------------------------------*
      *  If only text changes, use the CHGOUTQ   *
      *  command to change the text              *
      *------------------------------------------*
     C                   If        @TInfo   = DFInfo
     C                   Eval      Command  = @ChgOutq1      +
     C                                        %Trimr(DFSOQL) + '/' +
     C                                        %Trimr(DFSOQN) +
     C                                        @ChgOutq2      + '''' +
     C                                        %Trimr(DFSOQT) + ''')'
     C                   Eval      Length   = 80
     C                   Call      'QCMDEXC'
     C                   Parm                    Command
     C                   Parm                    Length
      *
      *------------------------------------------*
      *  If Target info changes, end the writer  *
      *  first if attached.                      *
      *  If Add mode but OUTQ found in the file, *
      *  update the file. End the writer first   *
      *  if OUTQ is started (attached).          *
      *------------------------------------------*
     C                   Else
     C                   Eval      @SOQN    = DFSOQN
     C                   Eval      @SOQL    = DFSOQL
     C                   Exsr      $Chkstatus
     C                   If        @Sts    <> '*NA'
     C                   Eval      Command  = @EndWtr1       +
     C                                        %Trimr(DFSOQN) +
     C                                        @EndWtr2
     C                   Eval      Length   = 80
     C                   Call      'QCMDEXC'
     C                   Parm                    Command
     C                   Parm                    Length
     C                   EndIf
     C                   Exsr      $TS0011C
      *------------------------------------------*
      *  Start the new writer attached to old    *
      *  OUTQ. Check the status again. TS0011C   *
      *  also starts the writer.                 *
      *------------------------------------------*
     C                   Exsr      $Chkstatus
     C                   If        @Sts     = '*NA'
     C                   Eval      Command  = @StrRmtWtr     +
     C                                        %Trimr(DFSOQL) + '/' +
     C                                        %Trimr(DFSOQN) + ')'
     C                   Eval      Length   = 80
     C                   CALL      'QCMDEXC'
     C                   Parm                    Command
     C                   Parm                    Length
     C                   EndIf
     C                   EndIf
      *
      *----------------------------------------------------*
      *  Write new Remote OUTQ                             *
      *----------------------------------------------------*
     C                   Else
     C                   Eval      TSSOQN   = DFSOQN
     C                   Eval      TSSOQL   = DFSOQL
     C                   Write     TSRMOQR
     C                   Exsr      $TS0011C
      *------------------------------------------*
      *  Start the new writer immediately but    *
      *  check the status first since TS0011C    *
      *  also starts the writer.                 *
      *------------------------------------------*
     C                   Eval      @SOQN    = DFSOQN
     C                   Eval      @SOQL    = DFSOQL
     C                   Exsr      $Chkstatus
     C                   If        @Sts     = '*NA'
     C                   Eval      Command  = @StrRmtWtr     +
     C                                        %Trimr(DFSOQL) + '/' +
     C                                        %Trimr(DFSOQN) + ')'
     C                   Eval      Length   = 80
     C                   CALL      'QCMDEXC'
     C                   Parm                    Command
     C                   Parm                    Length
     C                   EndIf
     C                   EndIf
      *------------------------------------------*
      *  Reset all the fields for display 1      *
      *------------------------------------------*
     C                   Eval      @SOQN    = DFSOQN
     C                   Eval      @SOQL    = DFSOQL
     C                   Eval      @DESC    = DFSOQT
     C                   Eval      @TGTM    = DFTGTM
     C                   Eval      @TOQN    = DFTOQN
     C                   Eval      @TOQL    = DFTOQL
     C                   Eval      BuildReq = @Yes
      *
     C     #Update2      EndSr                                                            *
      /SPACE 4
      *==============================================================*
      *                                                              *
      *  Delete the Remote Output Queue Record                       *
      *                                                              *
     C     $Delete2      BegSr                                                            *
      *==============================================================*
      *
      *------------------------------------------*
      *  Delete the record if the user presses   *
      *  Enter.                                  *
      *------------------------------------------*
     C                   If        *Blanks <> @SOQN   and
     C                             *Blanks <> @SOQL   and
     C                             (@Action = @Delete or
     C                              @Action = @Disconnec)
     C                   Eval      KYSOQN   = @SOQN
     C                   Eval      KYSOQL   = @SOQL
      *
     C     OutqKey       Chain     TSRMOQ                             97
     C                   If        Not *In97
      *-------------------------------------*
      *  OUTQ to delete is Target only,     *
      *  update TSRMOQ file blanking out    *
      *  all target information.            *
      *-------------------------------------*
     C                   If        DFDELT = 'T'
     C                   Eval      TSTGTM   = *BLanks
     C                   Eval      TSTOQN   = *Blanks
     C                   Eval      TSTOQL   = *Blanks
     C                   Update    TSRMOQR
     C                   Eval      @TGTM    = *Blanks
     C                   Eval      @TOQN    = *Blanks
     C                   Eval      @TOQL    = *Blanks
      *-------------------------------------*
      *  Delete remote output queue record  *
      *-------------------------------------*
     C                   Else
     C                   Delete    TSRMOQR
     C                   Eval      @SOQN    = *Blanks
     C                   Eval      @SOQL    = *Blanks
     C                   Eval      @DESC    = *Blanks
     C                   Eval      @TGTM    = *Blanks
     C                   Eval      @TOQN    = *Blanks
     C                   Eval      @TOQL    = *Blanks
     C                   EndIf
     C                   EndIf
      *------------------------------------------*
      *  Delete the Local & Remote OUTQ Device   *
      *  if necessary.                           *
      *------------------------------------------*
     C                   Exsr      $TS0011C
      *------------------------------------------*
      *  Reset all the fields for display 1      *
      *------------------------------------------*
     C                   Eval      BuildReq = @Yes
     C                   EndIf
      *
     C     #Delete2      EndSr                                                            *
      /EJECT
      *==============================================================*
      *                                                              *
      *  Call module TS0011C to create/update/delete/disconnect      *
      *  Local & Remote OUTQ requested by the user.                  *
      *                                                              *
     C     $TS0011C      BEGSR                                                            *
      *==============================================================*
      *
      *------------------------------------------*
      *  Local & Remote OUTQ Device Driver       *
      *------------------------------------------*
     C                   Callb     'TS0011C'
     C                   Parm                    @Action
     C                   Parm                    DFSOQN
     C                   Parm                    DFSOQL
     C                   Parm                    DFSOQT
     C                   Parm                    DFTGTM
     C                   Parm                    DFTOQN
     C                   Parm                    DFTOQL
     C                   Parm                    Pgmq##
     C                   Parm                    DFDELT
      *
     C     #TS0011C      EndSr                                                            *
      /EJECT
      *==============================================================*
      *                                                              *
      *  Clear message subfile                                       *
      *                                                              *
     C     $ClrMsg       BEGSR                                                            *
      *==============================================================*
     C                   Eval      *In43    = *On
     C                   WRITE     MSGCTL
     C                   Eval      *In43    = *Off
      *
     C                   Eval      AControl = 'C'
     C                   Exsr      $SndMsg
      *
     C     #ClrMsg       ENDSR                                                            *
      *==============================================================*
      *                                                              *
      *  Clear message subfile 2                                     *
      *                                                              *
     C     $ClrMsg2      BEGSR                                                            *
      *==============================================================*
     C                   Eval      *In43    = *On
     C                   Write     MSGCTL2
     C                   Eval      *In43    = *Off
      *
     C                   Eval      AControl = 'C'
     C                   Exsr      $SndMsg
      *
     C     #ClrMsg2      ENDSR                                                            *
      *==============================================================*
      *                                                              *
      *  Send message to the program message queue                   *
      *                                                              *
     C     $SndMsg       BEGSR                                                            *
      *==============================================================*
     C                   Select
     C                   When      AControl = 'I'
     C                   Eval      AMsgId   = @MsgId
     C                   Eval      AMsgDta  = @MsgDta
     C                   Eval      AMessage = *Blanks
      *
     C                   When      AControl = 'M'
     C                   Eval      AMsgId   = *Blanks
     C                   Eval      AMsgDta  = *Blanks
     C                   Eval      AMessage = YourMsg
      *
     C                   When      AControl = 'C'
     C                   Eval      AMsgId   = *Blanks
     C                   Eval      AMsgDta  = *Blanks
     C                   Eval      AMessage = *Blanks
     C                   EndSl
      *
     C                   CALL      'UT0010C'
     C                   PARM                    AControl
     C                   PARM                    AMsgId
     C                   PARM                    AMsgDta
     C                   PARM                    AMessage
     C                   PARM                    AMsgfile
     C                   PARM                    Pgmq##
      *
     C     #SndMsg       ENDSR                                                            *
      /SPACE 4
      *==============================================================*
      *                                                              *
      *  Program Error Subroutine                                    *
      *                                                              *
     C     *PSSR         BEGSR                                                            *
      *==============================================================*
      *------------------------------------------*
      * 202 Cancel requested for the Call        *
      *------------------------------------------*
     C                   If        ErrorSts = 202
     C                   Move      *Blanks       ReturnPt          6

     C                   If        @Tag     = @TagStrWtr   Or
     C                             @Tag     = @TagHldWtr   Or
     C                             @Tag     = @TagEndWtr   Or
     C                             @Tag     = @TagRlsWtr   Or
     C                             @Tag     = @TagWrkOQ
     C                   Eval      *In36    = *On
     C                   Eval      @Opt     = *ZERO
     C                   Update    TS0010S1
     C                   EndIf
     C                   Goto      CmdCancel
     C                   Else
     C     ErrorSts      Dsply
     C                   Move      '*CANCL'      ReturnPt
     C                   Endif
      *
     C                   EndSr     ReturnPt                                               *
