**********************************************************************************************
      * DBG195R4: Scan spooled file
      * Copyright (C) 2001  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)
      **********************************************************************************************
      * FILES:
      **********************************************************************************************
      * CPYSPLF data
     FDBG1871W  IF   F  259        DISK    INFDS(SPL_DS) USROPN
      **********************************************************************************************
      * ARRAYS:
      **********************************************************************************************
      **********************************************************************************************
      * DATA STRUCTURES:
      **********************************************************************************************
      * Program Status Data Structure
     D System#DS      SDS
     D  SDS#PGM                      10    OVERLAY(System#DS:1)
     D  SDS#User                     10    OVERLAY(System#DS:254)
      * Information Data Structure
     D Spl_DS          DS
     D  NbrOfRcds                    10I 0 OVERLAY(Spl_DS:156)
      *  Standard error code DS for API error handling
     D Error_Code      DS
     D  BytesProvd                   10I 0 INZ(16)
     D  BytesAvail                   10I 0 INZ(0)
     D  Except_ID                     7
     D  Reserved                      1
     D  Exception                   256
      * QUSRSPLA format SPLA0100 structure
     D RcvrVarDS       DS
     D  SplA0100                   1000A
     D   PrtDevType                  10    OVERLAY( SplA0100 : 319 )
      **********************************************************************************************
      * CONSTANTS:
      **********************************************************************************************
     D Lower           C                   CONST('abcdefghijklmnopqrstuvwxyz')
     D Upper           C                   CONST('ABCDEFGHIJKLMNOPQRSTUVWXYZ')
      **********************************************************************************************
      * WORK FIELDS:
      **********************************************************************************************
     D OnePercent      S             11  2
     D P_CmdString     S            256
     D P_CmdLength     S             15  5
     D P_File          S             10
     D P_Marker        S              1    INZ(X'33')
     D P_Percent       S              3  0
     D P_Text          S             20
     D P_ScanString    S             25
     D P_IgnoreCase    S              1N
     D P_Found         S              1N
     D P_Job           S             10
     D P_JobNbr        S              6
     D P_User          S             10
     D SpoolName       S             10
     D P_SpoolNbr      S              4
     D SplNbrDec       S              4  0
     D SpoolNbr        S             10I 0
     D RcdsRead        S              9  0
     D Remainder       S              9  0
     D ScanString      S             25    VARYING
     D IntJobID        S             16    INZ(' ')
     D IntSpoolID      S             16    INZ(' ')
     D ListFormat      S              8    INZ('SPLA0100')
     D RcvrVarLen      S             10I 0 INZ(1000)
     D QualifyJob      S             26
      **********************************************************************************************
      * FIELD RENAMES:
      **********************************************************************************************
      **********************************************************************************************
      * FILE LAYOUTS:
      **********************************************************************************************
     IDBG1871W  NS  01
     I                                  1  259  RECORD
      **********************************************************************************************
      * ENTRY PARAMETERS:
      **********************************************************************************************
     C     *ENTRY        PLIST
     C                   PARM                    P_File
     C                   PARM                    P_Job
     C                   PARM                    P_User
     C                   PARM                    P_JobNbr
     C                   PARM                    P_SpoolNbr
     C                   PARM                    P_ScanString
     C                   PARM                    P_IgnoreCase
     C                   PARM                    P_Found
      **********************************************************************************************
      * PARAMETER LISTS:                                                                           *
      **********************************************************************************************
      **********************************************************************************************
      * KEY LISTS:
      **********************************************************************************************
      **********************************************************************************************
      * MAINLINE:
      **********************************************************************************************
     C                   EVAL      QualifyJob = P_Job + P_User + P_JobNbr
     C                   MOVE      P_SpoolNbr    SplNbrDec
     C                   CALL      'QUSRSPLA'
     C                   PARM                    RcvrVarDS
     C                   PARM                    RcvrVarLen
     C                   PARM                    ListFormat
     C                   PARM                    QualifyJob
     C                   PARM                    IntJobID
     C                   PARM                    IntSpoolID
     C                   PARM      P_File        SpoolName
     C                   PARM      SplNbrDec     SpoolNbr
     C                   PARM                    Error_Code
      * If no error and file type can be handled by CPYSPLF
B001 C                   IF        BytesAvail = 0 AND PrtDevType = '*SCS'
     C                   EVAL      P_CmdString = 'CPYSPLF FILE(' + P_File +
     C                             ') TOFILE(QTEMP/DBG1871W) JOB(' +
     C                             P_JobNbr + '/' + %TRIM(P_User) + '/' +
     C                             %TRIM(P_Job) + ') SPLNBR(' +
     C                             %TRIM(P_SpoolNbr) + ')'
     C                   EVAL      P_CmdLength = %LEN(%TRIM(P_CmdString))
     C                   CALL (E)  'QCMDEXC'
     C                   PARM                    P_CmdString
     C                   PARM                    P_CmdLength
      *
B002 C                   IF        NOT %ERROR
      *
     C                   OPEN      DBG1871W
     C                   EVAL      OnePercent = NbrOfRcds / 100
     C                   EVAL      RcdsRead = 0
     C                   EVAL      Remainder = 0
     C                   EVAL      P_Found = *OFF
     C                   EVAL      ScanString = %TRIMR(P_ScanString)
     C                   EVAL      P_Text = 'Scanning ' + %TRIM(P_File) + ':'
      *
     C     1             SETLL     DBG1871W
     C                   READ      DBG1871W
B003 C                   DOW       NOT %EOF(DBG1871W)
      *
     C                   EVAL      RcdsRead = RcdsRead + 1
     C     RcdsRead      DIV       OnePercent    P_Percent
     C                   MVR                     Remainder
B004 C                   IF        Remainder = 0
     C                   CALL      'DBG202R4'
     C                   PARM                    P_Percent
     C                   PARM                    P_Text
     C                   PARM                    P_Marker
E004 C                   ENDIF
      *
B004 C                   IF        P_IgnoreCase
     C     Lower:Upper   XLATE     RECORD        RECORD
     C     Lower:Upper   XLATE     ScanString    ScanString
E004 C                   ENDIF
      *
B004 C                   IF        %SCAN(ScanString : RECORD) > 0
     C                   EVAL      P_Found = *ON
     C                   LEAVE
E004 C                   ENDIF
      *
     C                   READ      DBG1871W
E003 C                   ENDDO
     C                   CLOSE     DBG1871W
E002 C                   ENDIF
E001 C                   ENDIF
      *
     C                   RETURN
      **********************************************************************************************