      /TITLE CHKIFS  Check IFS
      *--------------------------------------------------------------*
      *  Programmers Group & Management Resources   Copyright  2003  *
      *                                                              *
      *                           \\\\\\\                            *
      *                          ( o   o )                           *
      *---------------------oOOO----(_)----OOOo----------------------*
      *                                                              *
      *  System name. . : IT/Operations                            *
      *  Module/Program : CHKIFS                                   *
      *  Text . . . . . : Check IFS Existence & Authority          *
      *  Author . . . . : Alex Nubla                               *
      *                                                              *
      *                   ooooO              Ooooo                   *
      *                   (    )             (    )                  *
      *--------------------(   )-------------(   )-------------------*
      *                     (_)               (_)                    *
      *                                                              *
      *  Description. . :  This program checks to make sure the IFS  *
      *                    exist and the user running the job has    *
      *                    authority to the IFS.                     *
      *                                                              *
      *--------------------------------------------------------------*
      * Modification Log :                                           *
      *                                                              *
      *           Ticket  Programmer/                                *
      *Date    No.   Description                               *
      *                   Alex Nubla                                 *
      *                                                              *
      *--------------------------------------------------------------*
     H Copyright('(C) Alex Nubla of PGMR, Inc.  2003')
     H Debug Option(*SRCSTMT:*NODEBUGIO)
     H DFTACTGRP(*NO) ACTGRP('PGMRTOOL')

      ****************************************************************
      *       D E F I N I T I O N     S P E C I F I C A T I O N      *
      ****************************************************************

      *--------------------------------------------------------------*
      *
      *  Prototype for Access (Access an IFS file)
      *
     DAccess           PR            10I 0 extproc('access')
     DIFSPtr                           *   Value
     DMode                           10I 0 Value

      *--------------------------------------------------------------*
      *
      *  Send program message
      *
     D SndPgmMsg       PR              N
     D Qmsgid                         7    Const
     D Qmsgf                         20    Const
     D Qmsg                          80    Const
     D Qmsgtp                        10    Const Options(*NOPASS)
      *--------------------------------------------------------------*
      *
      *  Standalone fields
      *
     D IFS             S            256
     D PathMsg         S             80A   Inz
     D Path            S            257A   Inz
     D F_OK            S             10I 0 Inz(0)
     D GoodResult      S             10I 0 Inz

      *--------------------------------------------------------------*
      *
      *  Constants
      *
     D Null            C                   const(x'00')

      ****************************************************************
      *     C A L C U L A T I O N     S P E C I F I C A T I O N      *
      ****************************************************************
     C     *Entry        Plist
     C                   Parm                    IFS
      *
     C                   Eval      Path        = %trimr(IFS) + Null
     C                   Eval      GoodResult  = Access(%addr(Path): F_OK)
      * Ouch
     C                   If        GoodResult <> 0
     C                   Eval      PathMsg     = %trimr(IFS)
     C                   Callp     SndPgmMsg('ITGA0A9': 'PGMRMSG':
     C                                       PathMsg: '*DIAG')
     C                   EndIf
     C                   Eval      *InLr       = *On
     C                   Return
      *==============================================================*
      *                                                              *
      *  Send Program Message                                        *
      *                                                              *
     P SndPgmMsg       B
      *==============================================================*

      *--------------------------------------------------------------*
      *
      *  Prototype input
      *
     D                 PI              N
     D Msgid                          7    Const
     D MsgF                          20    Const
     D Msgdta                        80    Const
     D Msgtp                         10    Const OPTIONS(*NOPASS)

      *--------------------------------------------------------------*
      *
      *  Standalone fields
      *
     D Qmsgid          S              7
     D Qmsgf           S             20
     D Qmsgdta         S            128
     D Qmsgln          S             10I 0
     D Qmsgtp          S             10
     D Qmsgq           S             10
     D Qmsgqn          S             10I 0 INZ(3)
     D Qmsgky          S              4
     D Qmsger          S             15

      *----------------------------------------------------*
      *  Move default if *MSGF library is blanks           *
      *----------------------------------------------------*
     C                   Eval      Qmsgid      = Msgid
     C                   Eval      Qmsgf       = Msgf
     C                   Eval      Qmsgdta     = Msgdta
      *
     C                   If        %subst(Qmsgf:11:10) = *Blank
     C                   Eval      %subst(Qmsgf:11:10) = '*LIBL'
     C                   Endif
      *
     C                   Eval      Qmsgln      = %len(%trim(Qmsgdta))
     C                   Eval      Qmsgq       = '*'
     C                   Eval      Qmsgtp      = '*DIAG'
     C                   If        %Parms      > 3
     C                   Eval      Qmsgtp      = Msgtp
     C                   Endif
     C                   If        Qmsgtp      = '*STATUS'
     C                   Eval      Qmsgq       = '*EXT'
     C                   Endif

      *----------------------------------------------------*
      *  Send program message                              *
      *----------------------------------------------------*
     C                   Call      'QMHSNDPM'                           99
     C                   Parm                    Qmsgid
     C                   Parm                    Qmsgf
     C                   Parm                    Qmsgdta
     C                   Parm                    Qmsgln
     C                   Parm                    Qmsgtp
     C                   Parm                    Qmsgq
     C                   Parm                    Qmsgqn
     C                   Parm                    Qmsgky
     C                   Parm      *LOVAL        Qmsger
      *
     C                   Return    *On
     P                 E
