News Stay informed about the latest enterprise technology news and product updates.

SPLFG4RP - Copy Spool File for Editing

      **********************************************************************
      *                                                                    *
      * System....... Utilities                                            *
      * Program...... SPLFG4RP - Copy Spool File for Editing.              *
      * Written by... Sudhakar Ramakrishnan Kunji                          *
      * Date......... Dec 12, 2000                                         *
      *                                                                    *
      *                     Program Description?                          *
      *                                                                    *
      *                                                                    *
      *? * * * * * * * * *  Maintenance Log? * * * * * * * * * * * * * * *
      * Req#.     Date    Programmer     Modification Reason               *
      *                                                                    *
      *         04/15/01  Sud Kunji      Introduced additional Features.   *
      **********************************************************************
      * Work files                                                         *
     FSPLFGIWP  IF   F 9999        DISK                                         COPIED SPOOL FILE
     FSPLFGOWP  O    F 9999        DISK                                         OUTPUT FILE
      *********************************************************************************************-
      ***      Data types
      *********************************************************************************************-
     DWrk_Num7         S              7P 0
     DWrk_MsgId        S              7
     DWrk_Ch001        S              1
      *********************************************************************************************-
      *  Input and output buffer.  The DSs map the very large fields in
      *  INPUT and OUTPUT to the arrays IN and OUT.
      *********************************************************************************************-
     DWrk_IData        DS          9995
     DAry_In                               DIM(9995) Like(Wrk_Ch001)
     DWrk_OData        DS          9999
     DAry_Out                              DIM(9999) Like(Wrk_Ch001)
      *********************************************************************************************-
      *  This DS is used to convert skip-to and space-before values to
      *  numeric fields.
      *********************************************************************************************-
     D                 DS
     DWrk_SkpToA                      3
     DWrk_SkpToZ                      3  0 Overlay(Wrk_SkpToA)
     DWrk_SpcBefA                     1
     DWrk_SpcBefZ                     1  0 Overlay(Wrk_SpcBefA)
      *********************************************************************************************-
      *  Parameters
      *********************************************************************************************-
     DP00_FrPage       S                   Like(Wrk_Num7)
     DP00_ToPage       S                   Like(Wrk_Num7)
     DP00_PrtCtl       S                   Like(Wrk_Ch001)
     DP00_ErrCode      S                   Like(Wrk_MsgId)
      *********************************************************************************************-
      *  Variables
      *********************************************************************************************
     DWrk_CurPag       S                   Like(Wrk_Num7)
     DWrk_CurLin       S                   Like(Wrk_Num7)
     DWrk_Err          S                   Like(Wrk_MsgId)
     DWrk_GOErrC       S                   Like(Wrk_MsgId)
     DWrk_GOErrW       S                   Like(Wrk_MsgId)
     DWrk_LasPag       S                   Like(Wrk_Num7)
     DWrk_CalLin       S                   Like(Wrk_Num7)
     DWrk_CalErr       S                   Like(Wrk_MsgId)
     DWrk_PrcErr       S                   Like(Wrk_MsgId)
     DWrk_PrWkEr       S                   Like(Wrk_MsgId)
     DWrk_PagErr       S                   Like(Wrk_MsgId)
     DWrk_PgWkEr       S                   Like(Wrk_MsgId)
     DWrk_PPgErr       S                   Like(Wrk_MsgId)
     DWrk_PPWkEr       S                   Like(Wrk_MsgId)
     DWrk_CurWPg       S                   Like(Wrk_Num7)
     DWrk_LastLn       S                   Like(Wrk_Num7)
     DI01              S                   Like(Wrk_Num7)
     DWrk_NLnErr       S                   Like(Wrk_MsgId)
     DWrk_NLWkEr       S                   Like(Wrk_MsgId)
     DWrk_LasLin       S                   Like(Wrk_Num7)
      *********************************************************************************************-
      *  The first two fields in the Input record are the skip-to line and
      *  space-line values. A new page has occurred when the skip-to value
      *  is for a smaller number than the current line number. Both the
      *  skipping and the spacing occur before the line is printed.
      *********************************************************************************************-
     ISPLFGIWP  AA
     I                                  1    3  Wrk_SkpLn
     I                                  4    4  Wrk_SpcLn
     I                                  5 9999  Wrk_IData
      *********************************************************************************************-
      ***      Parameters:
      *********************************************************************************************-
     C     *ENTRY        Plist
     C                   Parm                    P00_FrPage
     C                   Parm                    P00_ToPage
     C                   Parm                    P00_PrtCtl
     C                   Parm                    P00_ErrCode
      *********************************************************************************************-
      * Main - Main Processing Centre
      *********************************************************************************************-
      *
     C                   Eval      Wrk_CurLin = 0
     C                   Eval      Wrk_CurPag = 0
      *
      * Read pages without processing them until the first
      * page requested is reached.
      *
     C                   ExSr      PrcToFirst
     C                   MoveL(P)  Wrk_PrcErr    Wrk_Err
      *
      * Process each page until a page number one after the last
      * page is reached, or an EOF occurs:
      *
     C                   If        Wrk_Err = *Blanks
     C                   ExSr      PrcPgRange
     C                   MoveL(P)  Wrk_PagErr    Wrk_Err
     C                   EndIf
      *
      * If EOF has been reached, but we haven't gotten to the re       quested page,
      * we have an error condition.
      *
     C                   Select
     C                   When      (Wrk_Err = 'CPF0864')
     C                             And (Wrk_CurPag < P00_ToPage)
     C                   MoveL(P)  Wrk_Err       P00_ErrCode
     C                   When      (Wrk_Err = 'CPF0864')
     C                             And (Wrk_CurPag >= P00_ToPage)
     C                   Clear                   P00_ErrCode
     C                   Other
     C                   MoveL(P)  Wrk_Err       P00_ErrCode
     C                   EndSl
      *
      * Return to calling program:
      *
     C                   Eval      *InLR = *On
     C                   Return
      *
      ***********************************************************************-
      * PrcToFirst - Process until the first page of the range is reached.
      *************************************************************************-
     C     PrcToFirst    BegSr
      *
     C                   Clear                   Wrk_PrcErr
     C                   Clear                   Wrk_PrWkEr
      *
      * Process pages until the first page of the range is reached,
      * or an error occurs:
      *
     C                   ExSr      GotoNPage
     C                   MoveL(P)  Wrk_GOErrC    Wrk_PrWkEr
     C                   DoW       (Wrk_CurPag < P00_FrPage)
     C                             And (Wrk_PrWkEr = *Blanks)
     C                   ExSr      GotoNPage
     C                   MoveL(P)  Wrk_GOErrC    Wrk_PrWkEr
     C                   EndDo
      *
      * Set return code:
      *
     C                   MoveL(P)  Wrk_PrWkEr    Wrk_PrcErr
      *
     C                   EndSr
      *************************************************************************-
      * PrcPgRange -  Process the pages in the requested range
      *************************************************************************-
     C     PrcPgRange    BegSr
      *
     C                   Clear                   Wrk_PgWkEr
     C                   Clear                   Wrk_PagErr
      *
      * Process the page we've just started to read:
      *
     C
     C                   ExSr      ProcPage
     C                   MoveL(P)  Wrk_PPgErr    Wrk_PgWkEr
      *
      * Keep on processing until EOF or a page one after the
      * last page we want has been reached:
      *
     C                   DoW       (Wrk_CurPag <= P00_ToPage)
     C                             And (Wrk_PgWkEr = *Blanks)
     C                   ExSr      ProcPage
     C                   MoveL(P)  Wrk_PPgErr    Wrk_PgWkEr
     C                   EndDo
      *
      * Set return code:
      *
     C                   MoveL(P)  Wrk_PgWkEr    Wrk_PagErr
      *
     C                   EndSr
      *************************************************************************-
      * CalcNewLN - Calculate new line number
      *************************************************************************-
     C     CalcNewLN     BegSr
      *
      * If this line has a space-before value, increment the
      * line number:
      *
     C                   If        Wrk_SpcLn <> *Blanks
      *
      *        Convert value from character to numeric:
      *
     C                   MoveL(P)  Wrk_SpcLn     Wrk_SpcBefA
     C                   Eval      Wrk_CalLin = Wrk_CurLin + Wrk_SpcBefZ
     C                   Else
      *
      *        Skip-to value specified:
      *
     C                   MoveL(P)  Wrk_SkpLn     Wrk_SkpToA
     C                   Eval      Wrk_CalLin = Wrk_SkpToZ
     C                   EndIf
     C                   Clear                   Wrk_CalErr
      *
     C                   EndSr
      *************************************************************************-
      * GotoNPage - Goto next page:
      *************************************************************************-
     C     GotoNPage     BegSr
      *
     C                   Clear                   Wrk_GOErrC
     C                   Clear                   Wrk_GOErrW
      *
      * Read lines until EOF or a new page is reached:
      *
     C                   Eval      Wrk_LasPag = Wrk_CurPag
     C                   ExSr      ReadNextLn
     C                   MoveL(P)  Wrk_NLnErr    Wrk_GOErrW
     C                   DoW       (Wrk_GOErrW = *Blanks)
     C                             And(Wrk_LasPag = Wrk_CurPag)
     C                   ExSr      ReadNextLn
     C                   MoveL(P)  Wrk_NLnErr    Wrk_GOErrW
     C                   EndDo
      *
      * Set return codes:
      *
     C                   MoveL(P)  Wrk_GOErrW    Wrk_GOErrC
      *
     C                   EndSr
      *************************************************************************-
      * ProcPage - Process Page
      *************************************************************************-
     C     ProcPage      BegSr
      *
     C                   Clear                   Wrk_PpWkEr
     C                   Clear                   Wrk_PPgErr
     C                   Clear                   *IN50
      *
     C                   Eval      Wrk_CurWPg = Wrk_CurPag
     C                   Eval      Wrk_LastLn = 0
      *
     C                   DoW       (Wrk_PpWkEr = *Blanks)
     C                             And(Wrk_CurPag = Wrk_CurWPg)
     C                   If        Wrk_CurLin <> Wrk_LastLn
     C                   If        (Wrk_LastLn <> 0)
     C                             And (Wrk_OData <> *Blanks)
     C                   Write     SPLFGOWP      Wrk_OData
     C                   EndIf
      *
     C                   MoveL(P)  Wrk_IData     Wrk_OData
      *
     C                   If        P00_PrtCtl = 'Y'
     C                   Eval      Wrk_OData  = Wrk_SkpLn + Wrk_SpcLn +
     C                                          Wrk_OData
     C                   EndIf
      *
     C                   Else
      *
     C     1             Do        9995          I01
     C                   If        Ary_IN(I01) <> ' '
     C                   Move      Ary_In(I01)   Ary_Out(I01)
     C                   EndIf
     C                   EndDo
     C                   EndIf
      *
      * Set "last line":
      *
     C                   Eval      Wrk_LastLn = Wrk_CurLin
     C                   ExSr      ReadNextLn
     C                   MoveL(P)  Wrk_NLnErr    Wrk_PpWkEr
     C                   EndDo
      *
      * Print the final buffer:
      *
     C                   If        Wrk_OData <> *Blanks
     C                   Write     SPLFGOWP      Wrk_OData
     C                   EndIf
      *
      * Set the return code:
      *
     C                   MoveL(P)  Wrk_PpWkEr    Wrk_PPgErr
      *
     C                   EndSr
      *************************************************************************-
      * ReadNextLn - Read the next line from the file.
      *************************************************************************-
     C     ReadNextLn    BegSr
      *
     C                   Clear                   Wrk_NLnErr
     C                   Clear                   Wrk_NLWkEr
      *
      * Save the last line number:
      *
     C                   Eval      Wrk_LasLin = Wrk_CurLin
      *
      * Read from the file:
      *
     C                   Read      SPLFGIWP                               50
     C                   If        *IN50 <> *On
      *
      * Get the new line number resulting from this read.
      *
     C                   ExSr      CalcNewLN
     C                   Eval      Wrk_CurLin = Wrk_CalLin
     C                   MoveL(P)  Wrk_CalErr    Wrk_NLWkEr
      *
      * If the new line number is less than
      * the current line number, we have a new page.
      *
     C                   If        (Wrk_CurLin < Wrk_LasLin)
     C                             Or (Wrk_LasLin = 0)
     C                   Eval      Wrk_CurPag = Wrk_CurPag + 1
     C                   EndIf
     C                   Else
      *
      *        Deal with an EOF:
      *
     C                   MoveL(P)  'CPF0864'     Wrk_NLnErr
     C                   EndIf
      *
     C                   EndSr
      *************************************************************************-

Dig Deeper on iSeries programming commands

Start the conversation

Send me notifications when other members comment.

Please create a username to comment.

-ADS BY GOOGLE

SearchDataCenter

Close