**********************************************************************************************
      * DBG186R4: Work with user outqueue/spoolfile
      * Copyright (C) 2000  Martin Rowe   <martin@dbg400.net>
      *
      * This program is free software; you can redistribute it and/or modify
      * it under the terms of the GNU General Public License as published by
      * the Free Software Foundation; either version 2 of the License, or
      * (at your option) any later version.
      *
      * This program is distributed in the hope that it will be useful,
      * but WITHOUT ANY WARRANTY; without even the implied warranty of
      * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      * GNU General Public License for more details.
      *
      * You should have received a copy of the GNU General Public License
      * along with this program; if not, write to the Free Software
      * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
      **********************************************************************************************
     H DATEDIT(*YMD) DEBUG(*YES) OPTIon(*NODEBUGIO : *SRCSTMT)
      **************************************************************************
      * WRKOUTQ outfile
     FDBG1860W  If   E             DISK    INFDS(LISTDS)
      * User *OUTQ list
     FDBGUOL00  UF A E           K DISK
      * WRKUSROUTQ User settings
     FDBGWUS00  UF A E           K DISK
      *  Display screen
     FDBG186DF  CF   E             WORKSTN
     F                                     SFILE(SFL:RRN)
     F                                     SFILE(SFL2:RRN2)
     F                                     SFILE(SFL3:RRN3)
     F                                     SFILE(SFL4:RRN4)
     F                                     SFILE(SFL5:RRN5)
      **********************************************************************************************
      *  PROGRAM NAME
     D                SDS
     D PGM                           10
     D Usrprf                254    263
      * Information Data Structure
     D LISTDS          DS
      * Current relative record number
     D ListRecNbr            397    400B 0
      * ==List API structures==
      * Standard error code DS for API error handling
     D Error_Code      DS
     D  BytesProvd             1      4B 0 INZ(0)
     D  BytesAvail             5      8B 0 INZ(0)
     D  Except_ID              9     15
     D  Reserved              16     16
     D  Exception             17    272
      * Receiver value DS for user space header info (used in first call to QUSRTVUS)
     D GenRcvrDS       DS
     D  UserArea               1     64
     D  GenHdrSize            65     68B 0
     D  StrucLevel            69     72
     D  FormatName            73     80
     D  APIused               81     90
     D  CreateStamp           91    103
     D  InfoStatus           104    104
     D  SizeUSused           105    108B 0
     D  InpParmOff           109    112B 0
     D  InpParmSiz           113    116B 0
     D  HeadOffset           117    120B 0
     D  HeaderSize           121    124B 0
     D  ListOffset           125    128B 0
     D  ListSize             129    132B 0
     D  ListNumber           133    136B 0
     D  EntrySize            137    140B 0
      * QUSLOBJ format OBJL0100 structure
     D ObjL0100DS      DS
     D  ObjL0100
     D   L_Object                    10A   OVERLAY( ObjL0100 : 1 )
     D   L_ObjectLib                 10A   OVERLAY( ObjL0100 : 11 )
     D   L_ObjectTyp                 10A   OVERLAY( ObjL0100 : 21 )
      * QSPROUTQ format OUTQ0100 structure
     D OutQ0100DS      DS
     D  OutQ0100                   2000A
     D   L_BytesRtrnd                 9B 0 OVERLAY( OutQ0100 : 1 )
     D   L_BytesAvail                 9B 0 OVERLAY( OutQ0100 : 5 )
     D   L_OutQName                  10A   OVERLAY( OutQ0100 : 9 )
     D   L_OutQLib                   10A   OVERLAY( OutQ0100 : 19 )
     D   L_FileOrder                 10A   OVERLAY( OutQ0100 : 29 )
     D   L_DisplayAny                10A   OVERLAY( OutQ0100 : 39 )
     D   L_JobSeperat                 9B 0 OVERLAY( OutQ0100 : 49 )
     D   L_OperatrCtl                10A   OVERLAY( OutQ0100 : 53 )
     D   L_DataQName                 10A   OVERLAY( OutQ0100 : 63 )
     D   L_DataQLib                  10A   OVERLAY( OutQ0100 : 73 )
     D   L_CheckAuth                 10A   OVERLAY( OutQ0100 : 83 )
     D   L_NbrOfFiles                 9B 0 OVERLAY( OutQ0100 : 93 )
     D   L_OutQStatus                10A   OVERLAY( OutQ0100 : 97 )
     D   L_WtrJobName                10A   OVERLAY( OutQ0100 : 107 )
     D   L_WtrJobUser                10A   OVERLAY( OutQ0100 : 117 )
     D   L_WtrJobNbr                  6A   OVERLAY( OutQ0100 : 127 )
     D   L_WtrJobSts                 10A   OVERLAY( OutQ0100 : 133 )
     D   L_PrtDevName                10A   OVERLAY( OutQ0100 : 143 )
     D   L_OutQText                  10A   OVERLAY( OutQ0100 : 153 )
     D   L_Reserved1                  2A   OVERLAY( OutQ0100 : 203 )
     D   L_NbrSplSpec                 9B 0 OVERLAY( OutQ0100 : 205 )
     D   L_NbrWtrStrd                 9B 0 OVERLAY( OutQ0100 : 209 )
     D   L_AutoStrWtr                 9B 0 OVERLAY( OutQ0100 : 213 )
     D   L_RmtSysType                 1A   OVERLAY( OutQ0100 : 217 )
     D   L_RmtSysName               255A   OVERLAY( OutQ0100 : 218 )
     D   L_RmtPrintQ                128A   OVERLAY( OutQ0100 : 473 )
     D   L_MsgQName                  10A   OVERLAY( OutQ0100 : 601 )
     D   L_MsgQLib                   10A   OVERLAY( OutQ0100 : 611 )
     D   L_ConnectTyp                 9B 0 OVERLAY( OutQ0100 : 621 )
     D   L_DestinType                 9B 0 OVERLAY( OutQ0100 : 625 )
     D   L_VMMVSClass                 1A   OVERLAY( OutQ0100 : 629 )
     D   L_FormCtlBuf                 8A   OVERLAY( OutQ0100 : 630 )
     D   L_HostPrtTrf                 1A   OVERLAY( OutQ0100 : 638 )
     D   L_ManuTypMod                17A   OVERLAY( OutQ0100 : 639 )
     D   L_WrkCustObj                10A   OVERLAY( OutQ0100 : 656 )
     D   L_WrkCustLib                10A   OVERLAY( OutQ0100 : 666 )
     D   L_SplAuxAttr                 1A   OVERLAY( OutQ0100 : 676 )
     D   L_MaxPagOffs                 9B 0 OVERLAY( OutQ0100 : 677 )
     D   L_NbrPageRtn                 9B 0 OVERLAY( OutQ0100 : 681 )
     D   L_LenSizeEnt                 9B 0 OVERLAY( OutQ0100 : 685 )
     D   L_DestinOpts               128A   OVERLAY( OutQ0100 : 689 )
     D   L_WtrTypStrd                 1A   OVERLAY( OutQ0100 : 817 )
     D   L_PrtSepPage                 1A   OVERLAY( OutQ0100 : 818 )
     D   L_LongRmtPrt               255A   OVERLAY( OutQ0100 : 819 )
     D   L_ImgConfig                 10A   OVERLAY( OutQ0100 : 1074 )
     D   L_ImgConfLib                10A   OVERLAY( OutQ0100 : 1084 )
     D   L_Reserved2                  3A   OVERLAY( OutQ0100 : 1094 )
     D   L_SplAuxID                   9B 0 OVERLAY( OutQ0100 : 1097 )
      *
     D DspFTPLog       DS
     D   DSPPFM                      30A   INZ('DSPPFM QTEMP/FTPSRC FTPOUT')
      *
     D PcDtaQData      DS             7
     D  DtaQSflOpt                    2
     D  DtaQRRN                       9P 0
      **********************************************************************************************
      * WORK FIELDS:
      **********************************************************************************************
     D COMPNY          S             40    DTAARA(DBGCOMP)
     D Counter         S              5  0
     D CurrentEnt      S              5P 0
     D DataLength      S              9B 0 INZ(140)
     D DefaultDir      S            100    DTAARA(DBG186DA)
     D DtaLen          S              5  0
     D Errid           S              7
     D ExtendAttr      S             10    INZ('USRSPC    ')
     D FileName        S             50
     D GreenProtect    S              1    INZ(X'A0')
     D GreenULine      S              1    INZ(X'24')
     D HTMLTitle       S             50
     D IgnoreCase      S              1N
     D InitialSiz      S              9B 0 INZ(1024)
     D InitialVal      S              1    INZ(X'00')
     D LastOptionLine  S              3  0
     D ListBuilt       S              1
     D ListFormat      S              8    INZ('OBJL0100')
     D MoreDtaQRcds    S              1N
     D MsgDta          S            512
     D MsgFil          S             10
     D MsgID           S              7
     D MsgLib          S             10
     D MsgTyp          S             10
     D Nb2Dlt          S              4  0
     D ObjectType      S             10    INZ('*OUTQ     ')
     D OutQRcvrLen     S              9B 0 INZ(2000)
     D P_BatchFile     S                   LIKE(BATCHFILE)
     D PcDtaqKeyLen    S              3  0 INZ(10)
     D PcDtaqKeyOrd    S              2    INZ('EQ')
     D PcDtaqKey       S             10
     D PcDtaqLen       S              5  0 INZ(7)
     D PcDtaqLib       S             10    INZ('QTEMP')
     D PcDtaqName      S             10    INZ('DBG186DQ')
     D PcDtaqSndInf    S             10
     D PcDtaqSndLen    S              3  0 INZ(0)
     D PcDtaqWait      S              5  0 INZ(0)
     D P_CmdLength     S             15  5
     D P_CmdString     S            256
     D P_FileName      S                   LIKE(FileName)
     D P_Format        S                   LIKE(FORMAT)
     D P_Found         S              1N
     D P_FTPDir        S                   LIKE(FTPDIR)
     D Pgmq            S             10
     D PgmStk          S              5  0
     D P_HTMLTitle     S                   LIKE(HTMLTitle)
     D P_IgnoreCase    S              1N
     D P_LmtCpb        S             10
     D P_Mbropt        S             10
     D P_Outq          S             20
     D P_PCFileExt     S                   LIKE(PCFILEEXT)
     D P_Pgm           S             10
     D P_QualOutQ      S             20
     D P_RemoteMach    S                   LIKE(REMOTEMACH)
     D P_RemotePass    S                   LIKE(REMOTEPASS)
     D P_RemoteUser    S                   LIKE(REMOTEUSER)
     D P_SearchString  S             25
     D P_SplNbr        S              4
     D P_StmfDir       S                   LIKE(STMFDIR)
     D PublicAut       S             10    INZ('*ALL      ')
     D P_User          S             10
     D P_Usrprf        S             10
     D QualifyObj      S             20    INZ('*ALL      *ALL')
     D QualOutQ        S             20
     D RcdNbr          S              4  0
     D RcdsThisPage    S              4  0
     D ReadDtaQ        S              1N
     D RefreshRqd      S              1
     D Reload          S              1
     D ReplaceSpc      S             10    INZ('*YES      ')
     D Rrn2            S              4  0
     D Rrn3            S              4  0
     D Rrn4            S              4  0
     D Rrn5            S              4  0
     D Rrn             S              4  0
     D RunAPI          S              1
     D SearchString    S             25
     D Selected        S              1N
     D SFLKey          S              4  0
     D ShowFtpLog      S              1
     D SpoolDlt        S              1
     D SpoolView       S              1  0 INZ(1)
     D StartPos        S              9B 0 INZ(1)
     D TextDescrp      S             50    INZ('User space for API use')
     D TopRRN          S              5  0
     D UserSpace       S             20    INZ('DBG186US  QTEMP     ')
      **********************************************************************************************
      * CONSTANTS:
      **********************************************************************************************
      *
     D OpText1         C                   CONST('1=Send  2=Change  3=Hold  4=D-
     D                                     elete  5=Display  6=Release  8=Attri-
     D                                     butes')
     D OpText2         C                   CONST('         9=Work print st-
     D                                     s F=FTP  P=PC Open  T=Text save  V=V-
     D                                     iew formatted')
     D Up              C                   CONST(X'-
     D                                     00010203040506070809-
     D                                     0A0B0C0D0E0F10111213-
     D                                     1415161718191A1B1C1D-
     D                                     1E1F2021222324252627-
     D                                     28292A2B2C2D2E2F3031-
     D                                     32333435363738393A3B-
     D                                     3C3D3E3F404142434445-
     D                                     464748494A4B4C4D4E4F-
     D                                     50515253545556575859-
     D                                     5A5B5C5D5E5F60616263-
     D                                     6465666768696A6B6C6D-
     D                                     6E6F7071727374757677-
     D                                     78797A7B7C7D7E7F8081-
     D                                     82838485868788898A8B-
     D                                     8C8D8E8F909192939495-
     D                                     969798999A9B9C9D9E9F-
     D                                     A0A1A2A3A4A5A6A7A8A9-
     D                                     AAABACADAEAFB0B1B2B3-
     D                                     B4B5B6B7B8B9BABBBCBD-
     D                                     BEBFC0C1C2C3C4C5C6C7-
     D                                     C8C9CACBCCCDCECFD0D1-
     D                                     D2D3D4D5D6D7D8D9DADB-
     D                                     DCDDDEDFE0E1E2E3E4E5-
     D                                     E6E7E8E9EAEBECEDEEEF-
     D                                     F0F1F2F3F4F5F6F7F8F9-
     D                                     FAFBFCFDFEFF')
      *
     D Down            C                   CONST(X'-
     D                                     FFFEFDFCFBFAF9F8F7F6-
     D                                     F5F4F3F2F1F0EFEEEDEC-
     D                                     EBEAE9E8E7E6E5E4E3E2-
     D                                     E1E0DFDEDDDCDBDAD9D8-
     D                                     D7D6D5D4D3D2D1D0CFCE-
     D                                     CDCCCBCAC9C8C7C6C5C4-
     D                                     C3C2C1C0BFBEBDBCBBBA-
     D                                     B9B8B7B6B5B4B3B2B1B0-
     D                                     AFAEADACABAAA9A8A7A6-
     D                                     A5A4A3A2A1A09F9E9D9C-
     D                                     9B9A9998979695949392-
     D                                     91908F8E8D8C8B8A8988-
     D                                     87868584838281807F7E-
     D                                     7D7C7B7A797877767574-
     D                                     737271706F6E6D6C6B6A-
     D                                     69686766656463626160-
     D                                     5F5E5D5C5B5A59585756-
     D                                     5554535251504F4E4D4C-
     D                                     4B4A4948474645444342-
     D                                     41403F3E3D3C3B3A3938-
     D                                     37363534333231302F2E-
     D                                     2D2C2B2A292827262524-
     D                                     232221201F1E1D1C1B1A-
     D                                     19181716151413121110-
     D                                     0F0E0D0C0B0A09080706-
     D                                     050403020100')
      **********************************************************************************************
      *  INDICATOR USAGE
      *     Screen function keys
      *  03 (F3) Exit (all screens)
      *  05 (F5) Refresh
      *  11 (F11) View 1/2 - toggle between the two views of spoolfile details
      *  27 - ROLLUP
      *  28 - ROLLDOWN
      *     Subfile control inds
      *       Main subfile (SFL)
      *  35 - SFLEND
      *  36 - SFLDSP
      * N36 - SFLCLR
      *       Delete request subfile (SFL2)
      *  37 - SFLEND
      *  38 - SFLDSP
      * N38 - SFLCLR
      *     Screen error/dspatr inds
      *     File access inds
      *  80  81  82  83
      *     Error ind (for calls)
      *  90
      **************************************************************************
      * ENTRY PARAMETERS
      **************************************************************************
     C     *ENTRY        PList
     C                   Parm                    P_QualOutQ
     C                   Parm                    P_LmtCpb
     C                   Parm                    P_User
      **************************************************************************
      * KEY LIST DEFINITIONS
      **************************************************************************
     C     PFUOLKey      KList
     C                   KFld                    Usrprf
     C                   KFld                    AOQUE
     C                   KFld                    AOQUEL
      **************************************************************************
      * MAINLINE
      **************************************************************************
      * Program initialisation
     C                   ExSr      Inits
      *  Build first page
     C     1             SetLL     DBG1860W
     C                   ExSr      PagUp
      *  Main Screen  display loop
B001 C                   DoU       *IN03
      *  Only display subfile if records to show
     C                   Eval      *IN36 = Rrn > 0
      *  Display command key text
     C                   Write     FOOTER1
     C                   Write     MSFLC                                        MSG SUBFILE
     C                   Write     HEADER
     C                   ExFmt     SFLCTL
     C                   Read      HEADER                                 90
     C                   Eval      Reload = *off
     C                   Eval      RefreshRqd = *off
     C                   Call      'DBG045CL'                           90      REMove MSGS
      *  Process response
B002 C                   Select
      * F1/Help pressed
S002 C                   When      *IN01 = *on
      * Call the Helptext Viewer
     C                   Call      'DBG010R4'                           90      Trap errors
     C                   Parm      PGM           P_Pgm
      * F3=Exit
S002 C                   When      *IN03 = *on
     C                   Leave
      * Rollup
S002 C                   When      *IN27 = *on
     C                   ExSr      PagUp
      * Rolldown
S002 C                   When      *IN28 = *on
     C                   ExSr      PagDwn
      * F5=Refresh
S002 C                   When      *IN05 = *on
     C                   ExSr      Refresh
     C                   Eval      TopRRN = 1
     C                   Eval      Reload = *on
      * F8=PC Options
S002 C                   When      *IN08 = *on
     C                   ExSr      PCSetup
      * F11=View 1/2/3
S002 C                   When      *IN11 = *on
     C                   ExSr      SaveSFLOpts
     C                   Eval      SpoolView = SpoolView + 1
B003 C                   If        SpoolView > 3
     C                   Eval      SpoolView = 1
E003 C                   EndIf
     C                   Move      *on           Reload
      * F16=Find
S002 C                   When      *IN16 = *on
     C                   ExSr      FindString
      * F17=Outq list
S002 C                   When      *IN17 = *on
     C                   ExSr      OutList
      * F21=Command line
S002 C                   When      *IN21 = *on
     C                   ExSr      SaveSFLOpts
     C                   Call      'QUSCMDLN'                           90
      * If restriction fields changed, reload from top of list
S002 C                   When      *IN55
     C                   Eval      TopRRN = 1
     C                   Eval      Reload = *on
      * Otherwise proces any subfile record requests
S002 C                   Other
     C                   ExSr      ProcessOpts
     C                   ExSr      SetCursor
E002 C                   EndSl
      *  Reload subfile
B002 C                   If        Reload = *on
     C                   Eval      *IN35 = *off                                 SFLEND
     C     TopRRN        SetLL     DBG1860W
     C                   ExSr      PagUp
E002 C                   EndIf
E001 C                   EndDo
      *  Time to go...
     C     ENDPGM        Tag
      *    ======        ===
     C                   Eval      *INLR = *on
     C                   Return
      **************************************************************************
      * PagUp: DISPLAY NEXT PAGE
      **************************************************************************
     C     PagUp         BegSr
      * If not at SFLEND
B001 C                   If        *IN35 = *off
     C                   ExSr      SaveSFLOpts
      * Reset the relative record number & clear the subfile
     C                   Eval      Rrn = 0
     C                   Eval      RcdsThisPage = 0
     C                   Eval      Counter = 0
     C                   Eval      *IN36 = *off
     C                   Write     SFLCTL
      *
     C                   Eval      SSEL = ' '
     C                   Eval      *IN51 = *off
     C                   Eval      *IN52 = *off
     C                   Eval      *IN53 = *off
B002 C                   Select
S002 C                   When      SpoolView = 1
     C                   Eval      *IN51 = *on
S002 C                   When      SpoolView = 2
     C                   Eval      *IN52 = *on
S002 C                   When      SpoolView = 3
     C                   Eval      *IN53 = *on
E002 C                   EndSl
      * Load a page of entries
B002 C                   DoU       Counter = 13
     C                   Read      DBG1860W                               82
      * If record found
B003 C                   If        *IN82 = *off
     C                   Eval      SSEL = ' '
     C                   Eval      ReadDtaQ = *on
     C                   Eval      LISTRRN = ListRecNbr
     C                   ExSr      RcdSelect
B004 C                   If        Selected
      * Add this record to the subfile
     C                   Eval      Rrn = Rrn + 1
     C                   Eval      Counter = Rrn
     C                   Eval      RcdsThisPage = Rrn
     C                   Write     SFL
      * Store first subfile record values for roll down key positioning
B005 C                   If        Rrn = 1
     C                   Eval      TopRRN = LISTRRN
E005 C                   EndIf
E004 C                   EndIf
      * Otherwise we've hit the end of the WRKOUTQ outfile
X003 C                   Else
     C                   Eval      *IN35 = *on                                  SFLEND
     C                   Eval      Counter = 13
E003 C                   EndIf
E002 C                   EndDo
      *
     C                   ExSr      SetCursor
      * If not SFLEND
B002 C                   If        *IN35 = *off
      * Check ahead to see if there will be any more rcds next roll up - if
      * not then set SFLEND
     C     LISTRRN       SetGT     DBG1860W                           35
E002 C                   EndIf
E001 C                   EndIf
      *
     C                   EndSr
      **********************************************************************************************
      * PagDwn: DISPLAY PREVIOUS PAGE
      **********************************************************************************************
     C     PagDwn        BegSr
      *
     C                   ExSr      SaveSFLOpts
     C                   Eval      *IN35 = *off                                 SFLEND
     C                   Eval      Counter = 0
      *  Position file to first record on displayed page
     C     TopRRN        SetLL     DBG1860W
      *  Read back to equivalent of top of previous page
B001 C                   DoU       Counter = 14
     C                   ReadP     DBG1860W                               82    82
      *  If less than 'the page + a rcd' rcds exist, reset pointer to last read
B002 C                   If        *IN82 = *on
      * Cater for roll down before first record
B003 C                   If        LISTRRN = 0
     C                   Eval      LISTRRN = 1
E003 C                   EndIf
      * Cater for roll down after reading last record
B003 C                   If        LISTRRN > TopRRN
     C                   Eval      LISTRRN = TopRRN
E003 C                   EndIf
     C     LISTRRN       SetLL     DBG1860W
     C                   Leave
X002 C                   Else
     C                   Eval      LISTRRN = ListRecNbr
     C                   Eval      ReadDtaQ = *off
     C                   ExSr      RcdSelect
B003 C                   If        Selected
     C                   Eval      Counter = Counter + 1
E003 C                   EndIf
E002 C                   EndIf
E001 C                   EndDo
      *  Rebuild the page from current point
     C                   ExSr      PagUp
      *
     C                   EndSr
      **********************************************************************************************
      * SetCursor: Set cursor position
      **********************************************************************************************
     C     SetCursor     BegSr
      * Set cursor to appropriate line
B002 C                   Select
S002 C                   When      LastOptionLine = 0
     C                   Eval      CSRLIN = 9
S002 C                   When      LastOptionLine > RcdsThisPage + 8
     C                   Eval      CSRLIN = RcdsThisPage + 8
S002 C                   Other
     C                   Eval      CSRLIN = LastOptionLine
E002 C                   EndSl
     C                   Eval      CSRCOL = 3
     C                   Eval      LastOptionLine = 9
      *
     C                   EndSr
      **********************************************************************************************
      * ProcessOpts: Process subfile options
      **********************************************************************************************
     C     ProcessOpts   BegSr
      *
     C                   ExSr      SaveSFLOpts
      * Only process if subfile records to work with
     C                   ExSr      ReadDtaqRcd
      * Do while more selected records
B001 C                   DoW       MoreDtaQRcds
      *
B002 C                   Select
      * Delete requests are grouped for a delete confirmation screen later
S002 C                   When      SSEL = '4'
     C                   ExSr      FlgDlt
S002 C                   Other
      * Refresh the list if any options can change what's displayed
B003 C                   If        SSEL = '2' or SSEL = '3' or SSEL = '4'
     C                             or SSEL = '6'
     C                   Eval      RefreshRqd = *on
E003 C                   EndIf
      *
     C                   Eval      RunAPI = *on
     C                   Move      SPLNBR        P_SplNbr
      * Set default file name
     C                   Eval      FileName = %TRIM(SPLNAME) + '-' +
     C                             %TRIM(P_SplNbr) + '-' +
     C                             %TRIM(SPLJOBNAME) + '-' +
     C                             %TRIM(SPLUSERPRF) + '-' +
     C                             %TRIM(SPLJOBNBR)
      * Set default HTML title
     C                   Eval      HTMLTitle = SPLNAME
      * Set default FTP log status
     C                   Eval      ShowFtpLog = FTPLOG
      * Set screen values from defaults
     C                   Eval      FILENAME2 = FileName
     C                   Eval      PCFILEEXT2 = PCFILEEXT
     C                   Eval      STMFDIR2 = STMFDIR
     C                   Eval      FTPDIR2 = FTPDIR
     C                   Eval      BATCHFILE2 = BATCHFILE
     C                   Eval      FORMAT2 = FORMAT
     C                   Eval      RMTMACHINE = REMOTEMACH
     C                   Eval      RMTUSER = REMOTEUSER
     C                   Eval      RMTPASSWD = REMOTEPASS
     C                   Eval      HTMLTITLE2 = HTMLTitle
     C                   Eval      FTPLOG2 = FTPLOG
      * Prompt for overrides if required
B003 C                   If        OVERPROMPT = 'Y' and
     C                             (SSEL = 'F' or SSEL = 'P' or SSEL = 'T')
      * Display the prompt window
B004 C                   DoU       not *IN01
     C                   ExFmt     WINDOW
     C                   Call      'DBG045CL'                           90      REMOVE MSGS
      * F1/Help pressed
B005 C                   If        *IN01
      * Call the Helptext Viewer
     C                   Call      'DBG010R4'                           90      Trap errors
     C                   Parm      PGM           P_Pgm
E005 C                   EndIf
E004 C                   EndDo
E003 C                   EndIf
      * If F12 not pressed or prompt screen not displayed load API parms from window values
B003 C                   If        not *IN12 or OVERPROMPT = 'N'
     C                   Eval      P_FileName = FILENAME2
     C                   Eval      P_PCFileExt = PCFILEEXT2
     C                   Eval      P_StmfDir = STMFDIR2
     C                   Eval      P_FTPDir = FTPDIR2
     C                   Eval      P_BatchFile = BATCHFILE2
     C                   Eval      P_Format = FORMAT2
     C                   Eval      P_RemoteMach = RMTMACHINE
     C                   Eval      P_RemoteUser = RMTUSER
     C                   Eval      P_RemotePass = RMTPASSWD
     C                   Eval      P_HTMLTitle = HTMLTITLE2
     C                   Eval      ShowFtpLog = FTPLOG2
      * Otherwise cancel action
X003 C                   Else
     C                   Eval      RunAPI = *off
E003 C                   EndIf
      *
B003 C                   If        RunAPI = *on
     C                   Call      'DBG187CL'                           90
     C                   Parm                    SPLNAME
     C                   Parm                    SPLJOBNAME
     C                   Parm                    SPLUSERPRF
     C                   Parm                    SPLJOBNBR
     C                   Parm                    P_SplNbr
     C                   Parm                    SSEL
     C                   Parm                    P_BatchFile
     C                   Parm                    P_StmfDir
     C                   Parm                    P_FTPDir
     C                   Parm                    P_RemoteMach
     C                   Parm                    P_RemoteUser
     C                   Parm                    P_RemotePass
     C                   Parm                    P_PCFileExt
     C                   Parm                    P_Format
     C                   Parm                    P_FileName
     C                   Parm                    P_HTMLTitle
      *
B004 C                   If        ShowFtpLog = 'Y' and SSEL = 'F'
     C                   Call      'QCMDEXC'                            90
     C                   Parm      DSPPFM        P_CmdString
     C                   Parm      30            P_CmdLength
E004 C                   EndIf
E003 C                   EndIf
      *
E002 C                   EndSl
      *
      *  Next selected record
     C                   ExSr      ReadDtaqRcd
E001 C                   EndDo
      *  Process delete requests
B001 C                   If        SpoolDlt = *on
     C                   ExSr      MassDelete
E001 C                   EndIf
      * Set cursor back on line of last request, not where it actually was
     C
      *
B001 C                   If        RefreshRqd = *on
     C                   Call      'QCLRDTAQ'
     C                   Parm                    PcDtaqName
     C                   Parm                    PcDtaqLib
     C                   ExSr      Refresh
     C                   Eval      Reload = *on
E001 C                   EndIf
      *
     C                   EndSr
      **********************************************************************************************
      * RcdSelect: Record selection
      **********************************************************************************************
     C     RcdSelect     BegSr
      *
     C                   Eval      Selected = *off
      * If the restriction criteria are empty or match the starting characters of the target field
      * File name & user data can be generic - user is an exact match
B001 C                   If        (SELFILE = ' ' or %TRIM(SELFILE) =
     C                             %SUBST(SPLNAME:1:%LEN(%TRIM(SELFILE))))
     C                             and (SELUSER = ' ' or SELUSER = SPLUSERPRF)
     C                             and (SELUSRDTA = ' ' or %TRIM(SELUSRDTA) =
     C                             %SUBST(SPLUSRDTA:1:%LEN(%TRIM(SELUSRDTA))))
      * Include search criteria
B002 C                   If        SearchString <> *blanks
     C                   ExSr      SearchSpool
X002 C                   Else
     C                   Eval      Selected = *on
E002 C                   EndIf
      * If record selected
B002 C                   If        ReadDtaQ and Selected
     C                   ExSr      GetSFLOpt
E002 C                   EndIf
      * Set subfile fields
     C                   ExSr      SetSFLFields
E001 C                   EndIf
      *
     C                   EndSr
      **********************************************************************************************
      * SetSFLFields: Set subfile fields from record
      **********************************************************************************************
     C     SetSFLFields  BegSr
      *
     C                   Eval      SP_NAME = SPLNAME
     C                   Eval      SP_JOBNAME = SPLJOBNAME
     C                   Eval      SP_USRPRF1 = SPLUSERPRF
     C                   Eval      SP_USRPRF2 = SPLUSERPRF
     C                   Eval      SP_NBR = SPLNBR
     C                   Eval      SP_JOBNBR = SPLJOBNBR
     C                   Eval      SP_OUTQ = SPLOUTQ
     C                   Eval      SP_OUTQLIB = SPLOUTQLIB
     C                   Eval      SP_DEVICE = SPLDEVICE
     C                   Eval      SP_USRDTA = SPLUSRDTA
B001 C                   Select
S001 C                   When      SPLSTATUS = '*READY'
     C                   Eval      SP_STS = 'RDY'
S001 C                   When      SPLSTATUS = '*HELD'
     C                   Eval      SP_STS = 'HLD'
S001 C                   When      SPLSTATUS = '*SAVED'
     C                   Eval      SP_STS = 'SAV'
S001 C                   When      SPLSTATUS = '*WRITING'
     C                   Eval      SP_STS = 'WTR'
S001 C                   When      SPLSTATUS = '*OPEN'
     C                   Eval      SP_STS = 'OPN'
S001 C                   When      SPLSTATUS = '*CLOSED'
     C                   Eval      SP_STS = 'CLO'
S001 C                   When      SPLSTATUS = '*SENDING'
     C                   Eval      SP_STS = 'SND'
S001 C                   When      SPLSTATUS = '*DEFERRED'
     C                   Eval      SP_STS = 'DFR'
S001 C                   When      SPLSTATUS = '*PENDING'
     C                   Eval      SP_STS = 'PND'
S001 C                   When      SPLSTATUS = '*PRINTING'
     C                   Eval      SP_STS = 'PRT'
S001 C                   When      SPLSTATUS = '*MESSAGE'
     C                   Eval      SP_STS = 'MSGW'
S001 C                   Other
     C                   Eval      SP_STS = SPLSTATUS
E001 C                   EndSl
     C                   Eval      SP_TOTPAGE = SPLTOTPAGE
     C                   Eval      SP_CURPAGE = SPLCURPAGE
     C                   Eval      SP_CPYLEFT = SPLCPYLEFT
     C                   Eval      SP_FORMTYP = SPLFORMTYP
     C                   Eval      SP_PRIORTY = SPLPRIORTY
     C                   Eval      SP_DATE = SPLDATE
     C                   Eval      SP_TIME = SPLTIME
      *
     C                   EndSr
      **********************************************************************************************
      * PCSetup: Setup PC options
      **********************************************************************************************
     C     PCSetup       BegSr
      *
B001 C                   DoW       not *IN03
B002 C                   If        REMOTEPASS <> ' ' and REMOTEPASS = CONFRMPASS
     C                   Eval      PASSWRDSET = 'Password set'
X002 C                   Else
     C                   Eval      PASSWRDSET = 'Password rqd'
E002 C                   EndIf
      *  Display command key text
     C                   Write     MSFLC
     C                   ExFmt     SCREEN
     C                   Call      'DBG045CL'                           90      REMove MSGS
      *  Process response
B002 C                   Select
      * F1/Help pressed
S002 C                   When      *IN01
      * Call the Helptext Viewer
     C                   Call      'DBG010R4'                           90      Trap errors
     C                   Parm      PGM           P_Pgm
      * F3=Exit
S002 C                   When      *IN03
     C                   Leave
      * F12=Previous
S002 C                   When      *IN12
     C                   Eval      *IN12 = *off
     C                   Leave
      * F20=Save settings
S002 C                   When      *IN20
     C                   Eval      USUSER = Usrprf
     C     USUSER        Chain     DBGWUS00
     C                   Eval      USSDIR = STMFDIR
     C                   Eval      USFEXT = PCFILEEXT
     C                   Eval      USFMTO = FORMAT
     C                   Eval      USFTPL = FTPLOG
     C                   Eval      USOPMT = OVERPROMPT
     C                   Eval      USFDIR = FTPDIR
     C                   Eval      USRSCP = BATCHFILE
     C                   Eval      USRMCH = REMOTEMACH
     C                   Eval      USRUSR = REMOTEUSER
     C     Up:Down       Xlate     REMOTEPASS    USRPWD
B003 C                   If        %FOUND(DBGWUS00)
     C                   Update    PFWUS0
X003 C                   Else
     C                   Write     PFWUS0
E003 C                   EndIf
     C                   Eval      MsgID = 'GSM9999'
     C                   Eval      MsgDta = 'Settings saved for user ' +
     C                             Usrprf
     C                   Eval      DtaLen = 512
     C                   Eval      PgmStk = 0
     C                   ExSr      SndMsg
E002 C                   EndSl
E001 C                   EndDo
      *
     C                   EndSr
      **********************************************************************************************
      * FindString: Find string in selected spoolfiles
      **********************************************************************************************
     C     FindString    BegSr
      *
     C                   Eval      SearchString = *blanks
     C                   Eval      F16STS = 'Find subset *OFF*'
     C                   Eval      Reload = *on
     C                   Eval      TopRRN = 1
B001 C                   DoU       not *IN01
      *  Display command key text
     C                   Write     MSFLC
     C                   ExFmt     WINDOW2
     C                   Call      'DBG045CL'                           90      REMove MSGS
      *  Process response
B002 C                   Select
      *  F1/Help pressed
S002 C                   When      *IN01
      *  Call the Helptext Viewer
     C                   Call      'DBG010R4'                           90      Trap errors
     C                   Parm      PGM           P_Pgm
      * F12=Previous
S002 C                   When      *IN12
      * F16=Find
S002 C                   When      *IN16
     C                   Eval      SearchString = SEARCH
     C                   Eval      IgnoreCase = IGNORE = 'Y'
     C                   Eval      F16STS = 'Find subset *ON*'
     C                   Eval      Reload = *on
     C                   Eval      TopRRN = 1
     C                   Eval      *IN16 = *off
E002 C                   EndSl
E001 C                   EndDo
      *
     C                   EndSr
      **************************************************************************
      * Refresh: Refresh output queue list
      **************************************************************************
     C     Refresh       BegSr
      *
     C                   Close     DBG1860W
     C                   Eval      P_Mbropt = '*REPLACE'
B001 C                   If        SELUSER <> *blanks
     C                   Eval      P_Usrprf = SELUSER
X001 C                   Else
     C                   Eval      P_Usrprf = '*ALL'
E001 C                   EndIf
      *
B001 C                   Select
S001 C                   When      OUTQUE = '*OUTQLIST'
     C     Usrprf        Chain     DBGUOL00                           80
B002 C                   DoW       not *IN80
     C                   Eval      %SUBST(P_Outq:1:10) = ULOUTQ
     C                   Eval      %SUBST(P_Outq:11:10) = ULOUTL
     C                   Call      'DBG188R4'
     C                   Parm                    P_Usrprf
     C                   Parm                    P_Outq
     C                   Parm                    P_Mbropt
     C                   Eval      P_Mbropt = '*ADD    '
     C     Usrprf        ReadE     DBGUOL00                               80
E002 C                   EndDo
      *
S001 C                   When      OUTQUE = '*USRSPLF'
     C                   Eval      P_Outq = '*ALL'
     C                   Call      'DBG188R4'
     C                   Parm                    P_Usrprf
     C                   Parm                    P_Outq
     C                   Parm                    P_Mbropt
      *
S001 C                   Other
     C                   Call      'DBG188R4'
     C                   Parm                    P_Usrprf
     C                   Parm      P_QualOutQ    P_Outq
     C                   Parm                    P_Mbropt
E001 C                   EndSl
      *
     C                   Open      DBG1860W
      *
     C                   EndSr
      **********************************************************************************************
      * FlgDlt: Flag spoolfile for deletion
      **********************************************************************************************
     C     FlgDlt        BegSr
      *
     C                   ExSr      SetSFLFields
     C                   Eval      Rrn2 = Rrn2 + 1
     C                   Write     SFL2
     C                   Eval      Rrn4 = Rrn4 + 1
     C                   Write     SFL4
     C                   Eval      Rrn5 = Rrn5 + 1
     C                   Write     SFL5
     C                   Move      *on           SpoolDlt
      *
     C                   EndSr
      **********************************************************************************************
      * OutList: Work with output queue list
      **********************************************************************************************
     C     OutList       BegSr
      * Load all *OUTQ subfile
     C                   ExSr      LoadOutQ
     C                   Call      'DBG045CL'                           90      REMove MSGS
      *
B001 C                   DoW       not *IN03
      *  Only display subfile if records to show
     C                   Eval      *IN40 = Rrn3 > 0
     C                   Write     MSFLC
     C                   Write     FOOTER3
     C                   Write     HEADER3
     C                   ExFmt     SFLCTL3
     C                   Call      'DBG045CL'                           90      REMove MSGS
      *
B002 C                   Select
      *  F1/Help pressed
S002 C                   When      *IN01 = *on
      *  Call the Helptext Viewer
     C                   Call      'DBG010R4'                           90      Trap errors
     C                   Parm      PGM           P_Pgm
      * F3=Exit
S002 C                   When      *IN03
     C                   Leave
      * F5=Refresh list
S002 C                   When      *IN05
      * Force display to *OUTQ list mode, if not already
     C                   Eval      P_QualOutQ = '*OUTQLIST'
     C                   Eval      OUTQUE = '*OUTQLIST'
      * Load all *OUTQ subfile
     C                   ExSr      LoadOutQ
      * F12=Previous
S002 C                   When      *IN12
     C                   Leave
      * Update user list from subfile entries
S002 C                   Other
B003 C                   If        Rrn3 > 0
     C                   ReadC     SFL3                                   81
B004 C                   DoW       not *IN81
      * If current *OUTQ selected
B005 C                   If        SSEL3 = '1'
     C     PFUOLKey      SetLL     DBGUOL00                               82
      * Add it to the list if not already there
B006 C                   If        not *IN82
     C                   Eval      ULUSER = Usrprf
     C                   Eval      ULOUTQ = AOQUE
     C                   Eval      ULOUTL = AOQUEL
     C                   Write     PFUOL
E006 C                   EndIf
      * Otherwise remove it from the user's list
X005 C                   Else
     C     PFUOLKey      Delete    PFUOL                              82
E005 C                   EndIf
     C                   ReadC     SFL3                                   81
E004 C                   EndDo
      * Force display to *OUTQ list mode, if not already
     C                   Eval      P_QualOutQ = '*OUTQLIST'
     C                   Eval      OUTQUE = '*OUTQLIST'
      * Rebuild the spool file list from scratch
     C                   ExSr      Refresh
      * Set screen to load from the first spool file in the list
     C                   Eval      TopRRN = 1
     C                   Move      *on           Reload
E003 C                   EndIf
     C                   Leave
E002 C                   EndSl
      *
E001 C                   EndDo
      *
      *
     C                   EndSr
      **********************************************************************************************
      * LoadOutQ: Load all *OUTQs subfile
      **********************************************************************************************
     C     LoadOutQ      BegSr
      * Create a user space to hold the format list entries
     C                   Call      'QUSCRTUS'
     C                   Parm                    UserSpace
     C                   Parm                    ExtendAttr
     C                   Parm                    InitialSiz
     C                   Parm                    InitialVal
     C                   Parm                    PublicAut
     C                   Parm                    TextDescrp
     C                   Parm                    ReplaceSpc
     C                   Parm                    Error_Code
      * List the outqueues on the system
     C                   Call      'QUSLOBJ'
     C                   Parm                    UserSpace
     C                   Parm      'OBJL0100'    ListFormat
     C                   Parm                    QualifyObj
     C                   Parm                    ObjectType
     C                   Parm                    Error_Code
      * Get the header info for this space
     C                   Call      'QUSRTVUS'
     C                   Parm                    UserSpace
     C                   Parm                    StartPos
     C                   Parm                    DataLength
     C                   Parm                    GenRcvrDS
     C                   Parm                    Error_Code
      * Reset the relative record number & clear the subfile
     C                   Eval      Rrn3 = 0
     C                   Move      ' '           SSEL3
     C                   Eval      *IN40 = *off
     C                   Write     SFLCTL3
      * Process returned entries
B001 C                   If        ListNumber > 0
      * Set the initial offset for the start of the list entries
     C                   Eval      ListOffset = ListOffset + 1
     C                   Eval      CurrentEnt = 1
      * Loop through the entries held in the list section of the user space
B002 C                   DoW       CurrentEnt <= ListNumber
      * Get the header info for this space
     C                   Call      'QUSRTVUS'
     C                   Parm                    UserSpace
     C                   Parm                    ListOffset
     C                   Parm                    EntrySize
     C                   Parm                    ObjL0100DS
     C                   Parm                    Error_Code
      * Retrieve Output Queue info for this entry
     C                   Eval      QualOutQ = L_Object + L_ObjectLib
     C                   Call      'QSPROUTQ'                           90
     C                   Parm                    OutQ0100
     C                   Parm                    OutQRcvrLen
     C                   Parm      'OUTQ0100'    FormatName
     C                   Parm                    QualOutQ
     C                   Parm                    Error_Code
      * Include outque if API call successful
B003 C                   If        not *IN90
     C                   Eval      AOQUE = L_OutQName
     C                   Eval      AOQUEL = L_OutQLib
     C                   Eval      AOFILS = L_NbrOfFiles
     C                   Eval      AOWTR = L_WtrJobName
     C                   Eval      AOSTS = L_OutQStatus
      * Check if already in user's list - preselect if so
     C     PFUOLKey      SetLL     DBGUOL00                               80
B004 C                   If        *IN80
     C                   Eval      SSEL3 = '1'
X004 C                   Else
     C                   Eval      SSEL3 = ' '
E004 C                   EndIf
     C                   Eval      Rrn3 = Rrn3 + 1
     C                   Write     SFL3
E003 C                   EndIf
      *  Bump up the counter & offset for the next entry
     C                   Eval      ListOffset = ListOffset + EntrySize
     C                   Eval      CurrentEnt = CurrentEnt + 1
E002 C                   EndDo
E001 C                   EndIf
      *
     C                   EndSr
      **********************************************************************************************
      * MassDelete: Mass delete selected reports
      **********************************************************************************************
     C     MassDelete    BegSr
      * Only display subfile if records to show
     C                   Eval      *IN38 = Rrn2 > 0
     C                   Eval      *IN37 = *on
     C                   Eval      CSRCOL = 2
     C                   Eval      CSRLIN = 1
      * Display command key text
B001 C                   DoU       *IN12
     C                   Write     FOOTER2
     C                   Write     MSFLC                                        MSG SUBFILE
     C                   Write     HEADER2
B002 C                   Select
S002 C                   When      SpoolView = 1
     C                   ExFmt     SFLCTL2
S002 C                   When      SpoolView = 2
     C                   ExFmt     SFLCTL4
S002 C                   When      SpoolView = 3
     C                   ExFmt     SFLCTL5
E002 C                   EndSl
     C                   Call      'DBG045CL'                           90      REMOVE MSGS
B002 C                   Select
      * F1/Help pressed
S002 C                   When      *IN01 = *on
      * Call the Helptext Viewer
     C                   Call      'GSRDDT10'                           90      Trap errors
     C                   Parm      PGM           P_Pgm
      * F11=View 1/2/3 pressed
S002 C                   When      *IN11 = *on
     C                   Eval      SpoolView = SpoolView + 1
B003 C                   If        SpoolView > 3
     C                   Eval      SpoolView = 1
E003 C                   EndIf
      * Enter=Confirm Delete pressed
S002 C                   When      *IN12 = *off
     C                             and Rrn2 > 0
     C                   Eval      Nb2Dlt = Rrn2
B003 C     1             Do        Nb2Dlt        RcdNbr
     C     RcdNbr        Chain     SFL2                               80
B004 C                   If        *IN80 = *off
     C                   Move      SPLNBR        P_SplNbr
     C                   Call      'DBG187CL'                           90
     C                   Parm                    SPLNAME
     C                   Parm                    SPLJOBNAME
     C                   Parm                    SPLUSERPRF
     C                   Parm                    SPLJOBNBR
     C                   Parm                    P_SplNbr
     C                   Parm      '4'           SSEL
     C                   Parm      ' '           P_BatchFile
     C                   Parm      ' '           P_StmfDir
     C                   Parm      ' '           P_FTPDir
     C                   Parm      ' '           P_RemoteMach
     C                   Parm      ' '           P_RemoteUser
     C                   Parm      ' '           P_RemotePass
     C                   Parm      ' '           P_PCFileExt
     C                   Parm      ' '           P_Format
     C                   Parm      ' '           P_FileName
     C                   Parm      ' '           P_HTMLTitle
      *
E004 C                   EndIf
      *
E003 C                   EndDo
     C                   Eval      RefreshRqd = *on
     C                   Leave
E002 C                   EndSl
E001 C                   EndDo
      * Reset the relative record number & clear the subfiles
     C                   Eval      *IN38 = *off
     C                   Eval      Rrn2 = 0
     C                   Write     SFLCTL2
     C                   Eval      Rrn4 = 0
     C                   Write     SFLCTL4
     C                   Eval      Rrn5 = 0
     C                   Write     SFLCTL5
      *
     C                   Move      *off          SpoolDlt
     C                   Move      *on           Reload
      *
     C                   EndSr
      **********************************************************************************************
      * SearchSpool: Search spoolfiles for a string
      **********************************************************************************************
     C     SearchSpool   BegSr
      *
     C                   Move      SPLNBR        P_SplNbr
     C                   Call      'DBG195R4'                           90
     C                   Parm                    SPLNAME
     C                   Parm                    SPLJOBNAME
     C                   Parm                    SPLUSERPRF
     C                   Parm                    SPLJOBNBR
     C                   Parm                    P_SplNbr
     C                   Parm      SearchString  P_SearchString
     C                   Parm      IgnoreCase    P_IgnoreCase
     C                   Parm      *off          P_Found
      *
     C                   Eval      Selected = P_Found
      *
     C                   EndSr
      **********************************************************************************************
      * SaveSFLOpts: Save subfile options for current page
      **********************************************************************************************
     C     SaveSFLOpts   BegSr
      *
B001 C                   If        RcdsThisPage > 0
B002 C     1             Do        RcdsThisPage  SFLKey
     C     SFLKey        Chain     SFL                                81
      * Do while more selected records
B003 C                   If        not *IN81 and SSEL <> *blanks
     C                   Eval      PcDtaqKey = %EDITC(LISTRRN : 'X')
     C                   Eval      LastOptionLine = SFLKey + 8
      * Check if this record already has a dataqueue entry (read & ignore)
     C                   Call (E)  'QRCVDTAQ'
     C                   Parm                    PcDtaqName
     C                   Parm                    PcDtaqLib
     C                   Parm      7             PcDtaqLen
     C                   Parm                    PcDtaQData
     C                   Parm                    PcDtaqWait
     C                   Parm      'EQ'          PcDtaqKeyOrd
     C                   Parm                    PcDtaqKeyLen
     C                   Parm                    PcDtaqKey
     C                   Parm                    PcDtaqSndLen
     C                   Parm                    PcDtaqSndInf
      * and post a new one on
     C                   Eval      DtaQSflOpt = SSEL
     C                   Eval      DtaQRRN = LISTRRN
     C                   Eval      PcDtaqKey = %EDITC(LISTRRN : 'X')
     C                   Call (E)  'QSNDDTAQ'
     C                   Parm                    PcDtaqName
     C                   Parm                    PcDtaqLib
     C                   Parm      7             PcDtaqLen
     C                   Parm                    PcDtaQData
     C                   Parm                    PcDtaqKeyLen
     C                   Parm                    PcDtaqKey
     C                   Eval      SSEL = ' '
     C                   Eval      *IN51 = *off
     C                   Eval      *IN52 = *off
     C                   Eval      *IN53 = *off
      *
B004 C                   Select
S004 C                   When      SpoolView = 1
     C                   Eval      *IN51 = *on
S004 C                   When      SpoolView = 2
     C                   Eval      *IN52 = *on
S004 C                   When      SpoolView = 3
     C                   Eval      *IN53 = *on
E004 C                   EndSl
     C                   Update    SFL
E003 C                   EndIf
E002 C                   EndDo
E001 C                   EndIf
      *
     C                   EndSr
      **********************************************************************************************
      * GetSFLOpt: Get subfile option from dtaq
      **********************************************************************************************
     C     GetSFLOpt     BegSr
      *
     C                   Eval      PcDtaqKey = %EDITC(ListRecNbr : 'X')
      * Check if this record has a dataqueue entry
     C                   Call (E)  'QRCVDTAQ'
     C                   Parm                    PcDtaqName
     C                   Parm                    PcDtaqLib
     C                   Parm      7             PcDtaqLen
     C                   Parm                    PcDtaQData
     C                   Parm                    PcDtaqWait
     C                   Parm      'EQ'          PcDtaqKeyOrd
     C                   Parm                    PcDtaqKeyLen
     C                   Parm                    PcDtaqKey
     C                   Parm                    PcDtaqSndLen
     C                   Parm                    PcDtaqSndInf
      * Set subfile option from returned data (if any)
B001 C                   If        PcDtaqLen > 0
     C                   Eval      SSEL = DtaQSflOpt
X001 C                   Else
     C                   Eval      SSEL = *blanks
E001 C                   EndIf
      *
     C                   EndSr
      **********************************************************************************************
      * ReadDtaQRcd: Read Data queue entry & matching workfile record
      **********************************************************************************************
     C     ReadDtaqRcd   BegSr
      * Get the next available record in RRN sequence
     C                   Call (E)  'QRCVDTAQ'
     C                   Parm                    PcDtaqName
     C                   Parm                    PcDtaqLib
     C                   Parm      7             PcDtaqLen
     C                   Parm                    PcDtaQData
     C                   Parm                    PcDtaqWait
     C                   Parm      'GT'          PcDtaqKeyOrd
     C                   Parm                    PcDtaqKeyLen
     C                   Parm      *blanks       PcDtaqKey
     C                   Parm                    PcDtaqSndLen
     C                   Parm                    PcDtaqSndInf
      * Set subfile option from returned data (if any)
B001 C                   If        PcDtaqLen > 0
     C                   Eval      MoreDtaQRcds = *on
     C                   Eval      SSEL = DtaQSflOpt
     C     DtaQRRN       Chain     DBG1860W
X001 C                   Else
     C                   Eval      MoreDtaQRcds = *off
E001 C                   EndIf
      *
     C                   EndSr
      **********************************************************************************************
      * Inits: Program initialisation
      **********************************************************************************************
     C     Inits         BegSr
      *  INITIALIZE
     C                   In        COMPNY
     C                   In        DefaultDir
     C                   Eval      STMFDIR = DefaultDir
      *  Clear the delete screen first time round
     C                   Eval      Rrn2 = 0
     C                   Eval      Rrn4 = 0
     C                   Eval      Rrn5 = 0
     C                   Eval      *IN54 = P_LmtCpb = '*NO'
B001 C                   If        P_LmtCpb = '*NO'
     C                   Eval      DA_STMFDIR = GreenULine
X001 C                   Else
     C                   Eval      DA_STMFDIR = GreenProtect
E001 C                   EndIf
     C                   Eval      DA_SELUSER = GreenULine
     C                   Eval      *IN38 = *off
     C                   Eval      F16STS = 'Find subset *OFF*'
     C                   Eval      IGNORE = 'N'
     C                   Eval      OUTQUE = %SUBST(P_QualOutQ:1:10)
     C     Usrprf        Chain (N) DBGWUS00
B001 C                   If        %FOUND(DBGWUS00)
     C                   Eval      STMFDIR = USSDIR
     C                   Eval      PCFILEEXT = USFEXT
     C                   Eval      FORMAT = USFMTO
     C                   Eval      FTPLOG = USFTPL
     C                   Eval      OVERPROMPT = USOPMT
     C                   Eval      FTPDIR = USFDIR
     C                   Eval      BATCHFILE = USRSCP
     C                   Eval      REMOTEMACH = USRMCH
     C                   Eval      REMOTEUSER = USRUSR
     C     Down:Up       Xlate     USRPWD        REMOTEPASS
     C                   Eval      CONFRMPASS = REMOTEPASS
X001 C                   Else
     C                   Eval      STMFDIR = DefaultDir
     C                   Eval      PCFILEEXT = '.txt'
     C                   Eval      FORMAT = 'Y'
     C                   Eval      FTPLOG = 'Y'
     C                   Eval      OVERPROMPT = 'Y'
E001 C                   EndIf
     C                   Eval      OPTXT1 = OpText1
     C                   Eval      OPTXT2 = OpText2
     C                   Write     SFLCTL2
     C                   Eval      SpoolDlt = *off
     C                   Eval      ListBuilt = *off
      * Set user restrictor to current profile if in "WRKSPLF mode"
B001 C                   If        OUTQUE = '*USRSPLF'
B002 C                   If        P_LmtCpb = '*YES'
     C                   Eval      DA_SELUSER = GreenProtect
E002 C                   EndIf
     C                   Eval      SELUSER = P_User
E001 C                   EndIf
      *
     C                   Call      'DBG045CL'                           90      Remove msgs
      *
     C                   EndSr
      **********************************************************************************************
      * SndMsg: Send Program message
      **********************************************************************************************
     C     SndMsg        BegSr
      *
     C                   Call      'DBG044R3'
     C                   Parm                    MsgID
     C                   Parm      'DBGMSGF'     MsgFil
     C                   Parm      '*LIBL'       MsgLib
     C                   Parm                    MsgDta
     C                   Parm                    DtaLen
     C                   Parm      '*INFO'       MsgTyp
     C                   Parm      PGM           Pgmq
     C                   Parm                    PgmStk
     C                   Parm      '       '     Errid
      *
     C                   EndSr
      **********************************************************************************************


This topic: DBG400 > SourceCodeList > RpgleSource > RpgleDBG186R4
Topic revision: r2 - 01 Oct 2014 - 19:37:01 - UnknownUser
 
This site is powered by FoswikiCopyright © by the contributing authors. All material on this collaboration platform is the property of the contributing authors.
Ideas, requests, problems regarding DBG/400? Send feedback