**********************************************************************************************
      * DBG187R4: Transfer from spoolfile (maintain formatting)
      * 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)
      **********************************************************************************************
     FDBG1871W  IF   F  259        DISK    INFDS(SPL_DS)
     FDBG1872W  O    F  255        DISK
      **********************************************************************************************
      * DATA STRUCTURES:
      **********************************************************************************************
      * 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             1      4B 0 INZ(16)
     D  BytesAvail             5      8B 0 INZ(0)
     D  Except_ID              9     15
     D  Reserved              16     16
     D  Exception             17    272
      * QUSRSPLA format SPLA0100 structure
     D RcvrVarDS       DS
     D  SplA0100                   1000A
     D   PageLength                   9B 0 OVERLAY( SplA0100 : 425 )
      **********************************************************************************************
      * WORK FIELDS:
      **********************************************************************************************
     D CurrentLine     S              3  0 INZ(1)
     D FirstLine       S              1    INZ('1')
     D OnePercent      S             11  2
     D P_Marker        S              1    INZ(X'33')
     D P_Percent       S              3  0
     D P_Text          S             20
     D PageBreak       S              1    INZ(X'0C')
     D RcdsRead        S              9  0
     D Record          S            255
     D Remainder       S              9  0
     D ResultLine      S            256
     D Skip            S              3  0
     D SourceLine      S            256
     D Space           S              1  0
     D TargetLine      S            256
     D IntJobID        S             16    INZ(' ')
     D IntSpoolID      S             16    INZ(' ')
     D ListFormat      S              8    INZ('SPLA0100')
     D RcvrVarLen      S              9B 0 INZ(1000)
     D QualifyJob      S             26
     D P#Job           S             10
     D P#JobNbr        S              6
     D P#User          S             10
     D P#SpoolName     S             10
     D SpoolName       S             10
     D P#SpoolNbr      S              4  0
     D SpoolNbr        S              9B 0
      **********************************************************************************************
     IDBG1871W  NS  01
     I                                  1    3  SKIPVALUE
     I                                  4    4  SPACEVALUE
     I                                  5  259  SPOOLDATA
      **********************************************************************************************
      *  ENTRY PARAMETERS
      **********************************************************************************************
     C     *ENTRY        PLIST
     C                   PARM                    P#Job
     C                   PARM                    P#User
     C                   PARM                    P#JobNbr
     C                   PARM                    P#SpoolName
     C                   PARM                    P#SpoolNbr
      **********************************************************************************************
      * MAINLINE:
      **********************************************************************************************
     C                   EVAL      QualifyJob = P#Job + P#User + P#JobNbr
     C                   CALL      'QUSRSPLA'
     C                   PARM                    RcvrVarDS
     C                   PARM                    RcvrVarLen
     C                   PARM                    ListFormat
     C                   PARM                    QualifyJob
     C                   PARM                    IntJobID
     C                   PARM                    IntSpoolID
     C                   PARM      P#SpoolName   SpoolName
     C                   PARM      P#SpoolNbr    SpoolNbr
     C                   PARM                    Error_Code
      * If error, set to default length of 66 (in case it's just been deleted?)
B001 C                   IF        BytesAvail > 0
     C                   EVAL      PageLength = 66
E001 C                   ENDIF
      *
     C                   EVAL      OnePercent = NbrOfRcds / 100
     C                   EVAL      P_Text = 'Loading ' +
     C                                      %TRIM(P#SpoolName) + ':'
      *
     C     1             SETLL     DBG1871W
     C                   READ      DBG1871W                               80
      *
B001 C                   DOW       NOT *IN80
      *
     C                   EVAL      RcdsRead = RcdsRead + 1
     C     RcdsRead      DIV       OnePercent    P_Percent
     C                   MVR                     Remainder
B002 C                   IF        Remainder = 0
     C                   CALL      'DBG202R4'
     C                   PARM                    P_Percent
     C                   PARM                    P_Text
     C                   PARM                    P_Marker
E002 C                   ENDIF
      *
B002 C                   SELECT
      * If not overprinting
S002 C                   WHEN      SKIPVALUE <> '   '
      * Write out what's in the buffer before continuing
B003 C                   IF        FirstLine = *OFF
     C                   EXSR      WRITERECORD
E003 C                   ENDIF
     C                   MOVE      SKIPVALUE     Skip
B003 C                   DOW       CurrentLine <> Skip
     C                   EVAL      Record = *BLANKS
     C                   EXSR      WRITERECORD
E003 C                   ENDDO
     C                   EVAL      Record = SPOOLDATA
      * If overprinting
S002 C                   WHEN      SPACEVALUE = '0'
      * Merge the current line with what's left from the last record
     C                   CALL      'DBG042R3'
     C                   PARM      SPOOLDATA     SourceLine
     C                   PARM      Record        TargetLine
     C                   PARM      *BLANKS       ResultLine
      *
     C                   EVAL      Record = ResultLine
      * If not overprinting, write out what's in the buffer before continuing
S002 C                   WHEN      SPACEVALUE <> ' '
      * Write out what's in the buffer before continuing
     C                   EXSR      WRITERECORD
     C                   MOVE      SPACEVALUE    Space
     C                   EVAL      Space = Space - 1
B003 C                   IF        Space > 0
B004 C                   DO        Space
     C                   EVAL      Record = *BLANKS
     C                   EXSR      WRITERECORD
E004 C                   ENDDO
E003 C                   ENDIF
     C                   EVAL      Record = SPOOLDATA
E002 C                   ENDSL
      *
     C                   READ      DBG1871W                               80
E001 C                   ENDDO
      *
     C                   EVAL      Record = SPOOLDATA
     C                   EXSR      WRITERECORD
      *
     C                   EVAL      *INLR = *ON
     C                   RETURN
      **********************************************************************************************
      * WRITERECORD: Write a record to the file
      **********************************************************************************************
     C     WRITERECORD   BEGSR
      * If not the first line in the file, but the first line of a 'new page'
B001 C                   IF        FirstLine = *OFF
     C                             AND CurrentLine = 1
      * Insert page break at the start of the line
      * If the first character is empty, use that
B002 C                   IF        %SUBST(Record:1:1) = ' '
     C                   EVAL      %SUBST(Record:1:1) = PageBreak
      * Otherwise push line along one so page break character can be at the start
X002 C                   ELSE
     C                   EVAL      Record = PageBreak + %TRIMR(Record)
E002 C                   ENDIF
E001 C                   ENDIF
      * Write out the current line
     C                   EXCEPT    TFRFORMAT
      * Keep CurrentLine counter correct
     C                   EVAL      CurrentLine = CurrentLine + 1
B001 C                   IF        CurrentLine > PageLength
     C                   EVAL      CurrentLine = 1
E001 C                   ENDIF
     C                   EVAL      FirstLine = *OFF
      *
     C                   ENDSR
      **********************************************************************************************
     ODBG1872W  E            TFRFORMAT
     O                       Record             255