/*Rexx*****************************************************************
***  PRODUCT:          SMARTPRODUCTION RELEASE 5.3.0 - LEVEL 2014/01. *
***  CORRECTION:       RP304                                          *
***  DESCRIPTION:      REPORT JOBS MAY BE SUBMITTED WITH INVALID JCL. *
***  AFFECTED:         ALL USERS.                                     *
***  RESOLUTION:       REPLACE MEMBER TMRRCUSA IN THE SMARTP ISPFALL  *
***                    LIBRARY WITH THE CONTENT OF THIS MEMBER.       *
***  RESTRICTIONS:     NONE.                                          *
***********************************************************************/
parse arg Panel_name dummy

address "ISPEXEC"

x = outtrap('ddlist.')

address "TSO" "LISTALC STATUS"

x = outtrap('OFF')

do i = 1 to DDlist.0
   if words(DDlist.i) = 2 then
      do
         /*----------------------------------------------------------*/
         /* parse output from lista st                               */
         /*----------------------------------------------------------*/
         previous_line = i - 1

         select
            when word(DDlist.i, 1) = "TMRLINK" then
               TMR0LINK = space(DDlist.Previous_line)
            when word(DDlist.i, 1) = "TMRPARM" then   /* RP304 */
               TMR0PRM1 = space(DDlist.Previous_line)
            when word(DDlist.i, 1) = "TMRDFLT" then
               TMR0PRM2 = space(DDlist.Previous_line)
            otherwise nop
         end
      end
   else nop
end

parse value TMR0PRM1 with TMR0PRM1"("TMR0GLBL")"

address "ISPEXEC"
"VPUT ( TMR0LINK TMR0PRM1 ) SHARED"
"VGET ( TMR0PRM3 TMR0APPL ) PROFILE"

/*-------------------------------------------------------------------*/
/* Check with EXIT 01 if entry is allowed:                           */
/* ( the call to EXIT 01 is, for now, omitted )                      */
/*-------------------------------------------------------------------*/
Exit_rc = 0
Exit_name = TMR0LINK||"(TMREX01)"
/*
if SYSDSN("'"Exit_name"'") = "OK" then
   do
      Parm = "REPORT"
      address "TSO" "CALL '"Exit_name"' '"Parm"'"
      Exit_rc = Rc
   end
else nop
*/
if Exit_rc /= 0 then
   do
      "SETMSG MSG(TMR371)"
      exit 8
   end
else nop

/*-------------------------------------------------------------------*/
/* Initialize variables.                                             */
/*-------------------------------------------------------------------*/
MAX#_OF_APPLICATIONS = 20
MAX#_OF_PREFIXES     = 50
ZTDMARK = "      **END**"
Panel_Rc = 0
ZCMD = ""
Message = ""
Panel = "TMRPCUSA"
Read_Dsn = ""
Read_Mem = ""
cPos = 0
TMREMOD1 = "OUTPUT"
TMRECOL1 = "GREEN"
Unsaved_Changes = 0
Is_Valid_Member = 0

/*-------------------------------------------------------------------*/
/* Main panel loop.                                                  */
/*-------------------------------------------------------------------*/
do while Panel_Rc = 0

   /*----------------------------------------------------------------*/
   /* Read application definition member                             */
   /*----------------------------------------------------------------*/
   if (Read_Dsn /= TMR0PRM3) | (Read_Mem /= TMR0APPL) |,
      (Is_Valid_Member = 0) then
      do
         if Unsaved_Changes = 0 then
            do
               Valid_Memeber = 0          /* Assume not valid        */
               call Read_Member

               Select
                  when (Result = 0) then
                     do
                        Message = ""
                        Is_Valid_Member = 1
                        Call Fill_Tables
                        /* Raise a SPFEDIT enq @@ */
                     end
                  when (Result = 4) then
                     do
                        /* Empty member */
                        Message = "TMR522"
                        Is_Valid_Member = 1
                        Call Create_Table
                     end
                  when (Result = 8) then
                     do
                        /* Not found */
                        Message = "TMR520"
                        Call Create_Table
                        Is_Valid_Member = 0
                     end
                  when (Result = 16) then
                     do
                        /* Access Denied */
                        Message = "TMR523"
                        Call Create_Table
                        Is_Valid_Member = 0
                     end
                  when (Result = 20) then
                     do
                        /* Error while attempting to access */
                        Message = "TMR530"
                        Call Create_Table
                        Is_Valid_Member = 0
                     end
                  when (Result = 24) then
                     do
                        /* Member not found */
                        Message = "TMR533"
                        Call Create_Table
                        Is_Valid_Member = 0
                     end
                  when (Result = 40) then
                     do
                        /* Invalid member */
                        Message = "TMR521"
                        Call Create_Table
                        Is_Valid_Member = 0
                     end
                  when (Result = 48) then
                     do
                        /* Invalid library */
                        Message = "TMR534"
                        Call Create_Table
                        Is_Valid_Member = 0
                     end
                  otherwise
                     Call Create_Table
               end /* select */
            end
         else
            do
               TMR0PRM3 = Read_Dsn
               TMR0APPL = Read_Mem
               "VPUT (TMR0PRM3 TMR0APPL) PROFILE"
               Message = "TMR511"
            end

      end
   else nop

   /*----------------------------------------------------------------*/
   /* Display ISPF panel (Table).                                    */
   /*----------------------------------------------------------------*/
   S = " "
   "TBTOP APPLIST"
   "TBSKIP  APPLIST NUMBER("cPos")"
   "TBDISPL APPLIST PANEL("Panel") MSG("Message") AUTOSEL(NO)",
    "POSITION(CPOS)"
   Panel_Rc = RC
   Message = ""
   if cPos = 0 then cPos = ZTDTOP /* No selection - stay put */
   "VPUT (TMR0PRM3 TMR0APPL) PROFILE"

   /*----------------------------------------------------------------*/
   /* Handle Line commands (before action characters)                */
   /*----------------------------------------------------------------*/
   Selected_Rows = ZTDSELS
   Select
      when (TMRAZCMD = "SAVE") then
         do
            if Unsaved_Changes = 1 then
               do
                  call Save_Def_Member
                  if Result = 0 then
                     do
                        Unsaved_Changes = 0
                        Message = "TMR529"
                        "SETMSG MSG("Message")"
                     end
                  else
                     Message = "TMR378"
               end
            else
               Message = "TMR510"              /* Nothing has changed */
            Panel_Rc = 0
         end
      when (Panel_Rc = 8) & (left(TMRAZCMD, 3) /= "CAN") then
         do
            if Unsaved_Changes = 1 then
               do
                  Message = "TMR511"
                  Panel_Rc = 0                 /* Ask for save/cancel */
               end
            else
               nop
         end
      when (left(TMRAZCMD, 3) = "CAN") then
         do
            Panel_Rc = 8
            if Unsaved_Changes = 1 then
               "SETMSG MSG(TMR528)"
            else
               nop
         end
      when (word(TMRAZCMD, 1) = "I") |,
           (word(TMRAZCMD, 1) = "INSERT") then
         do
            if Is_Valid_Member then
               if word(TMRAZCMD, 2) /= "" then
                  do
                     call Ins_Application(word(TMRAZCMD, 2))
                     select
                        when (Result = 4) then
                           Message = "TMR524"
                        when (Result = 8) then
                           Message = "TMR537"
                        when (Result = 16) then
                           Message = "TMR536"
                        when (Result = 20) then
                           Message = "TMR553"
                        otherwise
                           nop
                     end /* Select */
                  end
               else
                  Message = "TMR524"
            else
               Message = "TMR538"
         end
      otherwise
         nop
   end /* Select */

   /*----------------------------------------------------------------*/
   /* Handle action characters                                       */
   /*----------------------------------------------------------------*/
   do while (Selected_Rows > 0) & (Panel_Rc < 8)
      SelectC = S
      Select
         when (SelectC = 'S') | (SelectC = 'E') then
            do
               Call List_Prefixes(TBAPPNM)
               ZTDMARK = "      **END**"
            end
      /* when (SelectC = 'I') then
            do
            end */
         when (SelectC = 'D') then
           do
              call Del_Application
              if Result = 0 then
                 Message = "TMR531"
              else
                 Message = "TMR532"
           end
      otherwise
         do
            "SETMSG MSG(TMR535)"
         end
      end /* Select */
      if Selected_Rows > 1 then
         do
            "TBDISPL APPLIST"        /* Retrieve next selection */
            Panel_Rc = RC
         end
      else nop
      Selected_Rows = Selected_Rows - 1
   end /* while */
end

call Delete_Table

/*-------------------------------------------------------------------*/
/* Re-allocate TMRDFLT with new application definitions              */
/*-------------------------------------------------------------------*/
New_DEFAPPL = space(TMR0PRM3)"("TMR0APPL")"

if sysdsn("'"New_DEFAPPL"'") = "OK" then
   do
      DFLTS = "'"TMR0PRM2"' '"New_DEFAPPL"'"
      address "TSO" "ALLOC F(TMRDFLT) DA("DFLTS") SHR REU"
   end
else
   do
      DFLTS = "'"TMR0PRM2"'"
      address "TSO" "ALLOC F(TMRDFLT) DA("DFLTS") SHR REU"
      "SETMSG MSG(TMR416)"
   end

exit

/* Sub-routines:                                                     */
/*-------------------------------------------------------------------*/
/* Create application table                                          */
/*-------------------------------------------------------------------*/
Create_Table:
TABKEYS = "(TBAPPNM)"
TABVARS = "(TBAPPCRE TBAPPCDT TBAPPTME TBAPPSTD " ||,
          "TBAPPSTT TBAPPENT TBAPPUSR)"
"TBCREATE APPLIST NOWRITE KEYS"TABKEYS" NAMES"TABVARS
if rc = 8 then
   do
      "TBEND APPLIST"
      "TBCREATE APPLIST NOWRITE KEYS"TABKEYS" NAMES"TABVARS
   end
else nop
Return rc

/*-------------------------------------------------------------------*/
/* Create prefixes table                                             */
/*-------------------------------------------------------------------*/
Create_Prefix_Table:
TABKEYS = "()"
TABVARS = "(TBPREPRE TBPREACT TBPREPAC)"
"TBCREATE PRELIST NOWRITE KEYS"TABKEYS" NAMES"TABVARS
if rc = 8 then
   do
      "TBEND PRELIST"
      "TBCREATE PRELIST NOWRITE KEYS"TABKEYS" NAMES"TABVARS
   end
else nop
Return rc

/*-------------------------------------------------------------------*/
/* - Fill application stem                                           */
/* - Fill ISPF application table                                     */
/*-------------------------------------------------------------------*/
Fill_Tables:

Applications.0 = 0

call Create_Table
"TBVCLEAR APPLIST"

do i = 1 to Applines.0
   if left(Applines.i, 1) /= "*" then
      do
         /* Parse input line               */
         parse upper value Applines.i with "DEFAPPL APPL="Appl_Name,
          ","Command"="Prefix" "Comment

         /*----------------------------------------------------------*/
         /* Find application. Exists - Add prefix                    */
         /*                   Does not exist - add application       */
         /*----------------------------------------------------------*/
         Found_Appl = 0
         Current_App_Index = 1
         do while (Current_App_Index <= Applications.0) &,
              (Found_Appl = 0)
            if Applications.Current_App_Index.Name = Appl_Name then
               Found_Appl = 1
            else
               Current_App_Index = Current_App_Index + 1
         end
         /*----------------------------------------------------------*/
         /* Add new application                                      */
         /*----------------------------------------------------------*/
         if Found_Appl =  0 then
            do
               Applications.Current_App_Index.Name = Appl_Name
               Applications.Current_App_Index.Deleted = "N"
               Applications.Current_App_Index.Prefixes = ""
               Applications.Current_App_Index.Startdate = "*"
               Applications.Current_App_Index.Starttime = "00:00"
               Applications.Current_App_Index.Endtime = "23:59"
               Applications.Current_App_Index.Userid = "*"
               /* Try and match comment */
               if Appl_Name = Cmt_Appl_Name then
                  do
                     Applications.Current_App_Index.Creator =,
                      Cmt_Creator
                     Applications.Current_App_Index.Date =,
                      Cmt_Date
                     Applications.Current_App_Index.Time =,
                      Cmt_Time
                  end
               else
                  do
                     Applications.Current_App_Index.Creator = "N/A"
                     Applications.Current_App_Index.Date = "N/A"
                     Applications.Current_App_Index.Time = "N/A"
                  end
               /*----------------------------------------------------*/
               /* Handle application chaining                        */
               /*----------------------------------------------------*/
               Applications.Current_App_Index.Next = 0
               Previous_App_Index = Current_App_Index - 1
               if Previous_App_Index > 0 then
                  Applications.Previous_App_Index.Next =,
                   Current_App_Index
               else nop

               Applications.0 = Current_App_Index
            end
         else nop
         /*----------------------------------------------------------*/
         /* Add prefixes to application                              */
         /*----------------------------------------------------------*/
         if (Command = "INCLJOB") | (Command = "EXCLJOB") then
            Applications.Current_App_Index.Prefixes =,
             Applications.Current_App_Index.Prefixes||,
              left(Command, 8) || left(Prefix, 8)
         else if Command = "INCLDATE" then
            do
               Applications.Current_App_Index.Startdate =,
                                                   left(Prefix, 10)
            end
         else if Command = "INCLTIME" then
            do
               Applications.Current_App_Index.Starttime =,
                                                   left(Prefix, 5)
               Applications.Current_App_Index.Endtime =,
                                                   right(Prefix, 5)
            end
         else if Command = "INCLUSER" then
            do
               Applications.Current_App_Index.Userid =,
                                                   left(Prefix, 8)
            end
      end
   else
      do
         /*----------------------------------------------------------*/
         /* In comment - Try and find Date and Creator of next       */
         /*              application defined.                        */
         /*----------------------------------------------------------*/
         parse value Applines.i with "*APPL="Cmt_Appl_Name,
          ",USER="Cmt_Creator",DATE="Cmt_Date",TIME=",
          Cmt_Time dummy
      end
end

/*-------------------------------------------------------------------*/
/* Fill the ISPF table                                               */
/*-------------------------------------------------------------------*/
i = 1
do while i > 0
   TBAPPNM  = Applications.i.Name
   TBAPPCRE = Applications.i.Creator
   TBAPPCDT = Applications.i.Date
   TBAPPTME = Applications.i.Time
   TBAPPSTD = Applications.i.Startdate
   TBAPPSTT = Applications.i.Starttime
   TBAPPENT = Applications.i.Endtime
   TBAPPUSR = Applications.i.Userid
   "TBADD APPLIST"
   i = Applications.i.Next
end

Return rc
/*-------------------------------------------------------------------*/
/* Delete application table                                          */
/*-------------------------------------------------------------------*/
Delete_Table:
"TBEND APPLIST"
Return rc

/*-------------------------------------------------------------------*/
/* Read application member                                           */
/*-------------------------------------------------------------------*/
Read_Member:
Valid_Member = 8         /* Assume data set does not exist */

App_dsn = space(TMR0PRM3)||"("||TMR0APPL||")"


y = MSG("OFF")
SYSDSN_Result = SYSDSN("'"App_Dsn"'")
y = MSG("ON")


if SYSDSN_Result = "MEMBER NOT FOUND" then
   do
      "ADDPOP POPLOC(ZCMD) ROW(11) COLUMN(-4)"
      TMRCRTXT = "Member does not exist. Create it? "
      "DISPLAY PANEL(TMRPCVPO)"
      Confirmation_Rc = Rc
      "REMPOP"

      if (TMRCREQ = "Y" ) & (Confirmation_Rc = 0) then
         do
            /* Make data set provided is in fact a PARMLIB library */
            Rc = LISTDSI("'"TMR0PRM3"'")
            if Rc = 0 then
               if (SYSDSORG /= "PO") | (SYSRECFM /= "FB") |,
                  (SYSLRECL /= "80") then
                   return 48
               else nop
            else nop
            /* Create an empty new member using ISPF services. ?? */
            "LMINIT DATAID("LIBID") DATASET('"TMR0PRM3"') ENQ(SHRW)"
            "LMOPEN DATAID("LIBID") OPTION(OUTPUT)"
            if Rc = 0 then
               do
                  DRec = left("*TMR000 TEMPORARY CONTENT", 80)
                  "LMPUT DATAID("LIBID") MODE(INVAR) DATALOC(DRec) ",
                   "DATALEN(80)"
                  "LMMADD DATAID("LIBID") MEMBER("TMR0APPL")"
               end
            else
               Valid_Member = 16

            "LMFREE DATAID("LIBID")"
            SYSDSN_Result = SYSDSN("'"App_Dsn"'")  /* Re-test */
         end
      else nop
   end
else nop

select
   when SYSDSN_Result = "OK" then
      do
         /*-------------------------------------------------------*/
         /* Read application definition member                    */
         /*-------------------------------------------------------*/
         address "TSO" "ALLOC F(TMRAPPL) DA('"App_dsn"') SHR REU"
         address "TSO" "EXECIO * DISKR TMRAPPL (STEM Applines. ",
          "FINIS"
         address "TSO" "FREE F(TMRAPPL)"
         Execio_rc = Rc
         Read_Dsn = TMR0PRM3
         Read_Mem = TMR0APPL
         Applications.0 = 0
         call Chk_Appmember
         Valid_Member = Result
      end
   when SYSDSN_Result = "PROTECTED DATASET" then
      do
         Valid_Member = 16
      end
   when SYSDSN_Result = "MEMBER NOT FOUND" then
      do
         if Valid_Member /= 16 then Valid_Member = 24
      end
   when SYSDSN_Result /= "DATASET NOT FOUND" then
      do
         Valid_Member = 20
      end
   otherwise
      nop
end /* select */

return Valid_Member

/*-------------------------------------------------------------------*/
/* Check Application member                                          */
/*-------------------------------------------------------------------*/
Chk_Appmember:

Valid = 0
Valid_Lines = 0

do i = 1 to Applines.0 while Valid = 0
   if (word(Applines.i, 1) /= "DEFAPPL") &,
       (left(Applines.i, 1) /= "*") then
      do
         Valid = 40
         TMREINVL = i
      end
   else
      if word(Applines.i, 1) = "DEFAPPL" then
         Valid_Lines = Valid_Lines + 1
      else nop
end

if Valid = 0 then
   if Valid_Lines = 0 then Valid = 4
else nop

Return Valid

/*-------------------------------------------------------------------*/
/* Check Application member                                          */
/*-------------------------------------------------------------------*/
List_Prefixes:
arg App_Name

call Create_Prefix_Table
call Fill_Prefix_Table(App_Name)

"ADDPOP POPLOC(TMR0PRM3) ROW(-3)" /* in 32x80 should fit in 1 screen */
/* ZWINTTL = "Definition for "TBAPPNM */
ZTDMARK = "        **END**"
Pop_Panel = "TMRPCAPO"
Pop_Message = ""
Pop_Rc = 0
CPopPos = 0
Cura_Changed = 0
TMREZCMD = ""
TMRECURS = "ZCMD    "
Before_TBAPPSTD = TBAPPSTD
Before_TBAPPSTT = TBAPPSTT
Before_TBAPPENT = TBAPPENT
Before_TBAPPUSR = TBAPPUSR

do while Pop_Rc = 0
   /*----------------------------------------------------------------*/
   /* Display ISPF panel (Table).                                    */
   /*----------------------------------------------------------------*/
   "TBTOP PRELIST"
   "TBSKIP  PRELIST NUMBER("cPopPos")"
   "TBDISPL PRELIST PANEL("Pop_Panel") MSG("Pop_Message") AUTOSEL(NO)",
    "POSITION(CPOPPOS)"
   Pop_Rc = Rc

   if cPopPos = 0 then cPopPos = ZTDTOP /* No selection - stay put */
   if Pop_Message = "" then TMRECURS = "ZCMD"

   if ZTDSELS > 0 then
      do
         Cura_Changed = 1
         "TBPUT PRELIST"
         call Add_To_TMRCPREF

         Changed_Rows = ZTDSELS
         do While Changed_Rows > 1
            "TBDISPL PRELIST"
            Pop_Rc = Rc
            "TBPUT PRELIST"
            call Add_To_TMRCPREF
            Changed_Rows = Changed_Rows - 1
         end
      end
   else nop

   if (TBAPPSTT /= Before_TBAPPSTT | TBAPPENT /= Before_TBAPPENT |,
      TBAPPUSR /= Before_TBAPPUSR | TBAPPSTD /= Before_TBAPPSTD) then
      do
         if Verify_Jobname(TBAPPUSR) > 0 then
            do
               Pop_Message = "TMR557"
               TMRECURS = "TBAPPUSR"
            end
         else
            do
               Pop_Message = ""
               Cura_Changed = 1
            end
      end
   else nop

   if Pop_Message /= "" then Pop_Rc = 0  /* Don't let out of panel */

   if left(TMREZCMD, 3) = "CAN" then
      do
         if Cura_Changed = 1 then Message = "TMR528"
         TBAPPSTD = Before_TBAPPSTD
         TBAPPSTT = Before_TBAPPSTT
         TBAPPENT = Before_TBAPPENT
         TBAPPUSR = Before_TBAPPUSR
         Pop_Rc = 16
      end
   else nop

   if (TMREZCMD = "SAVE") | (Pop_Rc = 8) then
      do
         if Cura_Changed = 1 then
            do
               /* Save changes to the Application table */
               temp_Date = Date('S')
               TBAPPCDT = left(temp_Date, 4) || "/" ||,
                substr(temp_date, 5, 2) || "/" ||,
                right(temp_Date, 2)
               TBAPPTME = left(Time("N"), 5)
               TBAPPCRE = Userid()
               "TBPUT APPLIST"

               Applications.i.Startdate = TBAPPSTD
               Applications.i.Starttime = TBAPPSTT
               Applications.i.Endtime = TBAPPENT
               Applications.i.Userid = TBAPPUSR

               i = 1
               do while (Applications.i.Name /= TBAPPNM)
                  i = Applications.i.Next
               end
               /* Application found. Reset its Prefixes and re-build */
               /* them.                                              */
               Applications.i.Prefixes = ""
               Applications.i.Creator = TBAPPCRE
               Applications.i.Date = TBAPPCDT
               Applications.i.Time = TBAPPTME
               "TBTOP PRELIST"
               do j = 1 to 20
                  "TBSKIP PRELIST"
                  if space(TBPREPRE) /= "" then
                     do
                        if TBPREACT = "I" then
                           Applications.i.Prefixes =,
                           Applications.i.Prefixes || "INCLJOB "
                        else
                           Applications.i.Prefixes =,
                           Applications.i.Prefixes || "EXCLJOB "
                        Applications.i.Prefixes =,
                         Applications.i.Prefixes || left(TBPREPRE, 8)
                     end
                  else nop
               end

               if Pop_Rc = 8 then
                  /* Exiting panel, msg should show on main */
                  /* Message = "TMR527" */
                  nop
               else
                  Pop_Message = "TMR527"
               Cura_Changed = 0
               Unsaved_Changes = 1
            end
         else nop
         /* if Pop_Rc = 8 then
                  Exiting panel, msg should show on main
               Message = "TMR510"
            else
               Pop_Message = "TMR510" - omit message */
      end
   else nop


end /* While */

"TBEND PRELIST"
"REMPOP"

Return Rc
/*-------------------------------------------------------------------*/
/* Fill prefix table                                                 */
/*-------------------------------------------------------------------*/
Fill_Prefix_Table:
arg App_Name
TMRCPREF = ""
TMRCINC# = 0
TMRCEXC# = 0

i = 1
do while Applications.i.Name /= App_Name
   i = Applications.i.Next
end

Prefix_Pointer = 1

do while substr(Applications.i.Prefixes, Prefix_Pointer, 8) /=,
    left(" ", 8)
   TBPREACT = substr(Applications.i.Prefixes, Prefix_Pointer, 1)
   TBPREPRE = substr(Applications.i.Prefixes, Prefix_Pointer + 8, 8)
   TBPREPAC = TBPREACT
   Prefix_Pointer = Prefix_Pointer + 16
   "TBADD PRELIST"
   TMRCPREF = TMRCPREF || left(TBPREPRE, 8)
   if TBPREACT = "I" then
      TMRCINC# = TMRCINC# + 1
   else
      TMRCEXC# = TMRCEXC# + 1
end

"TBQUERY PRELIST ROWNUM(ROWNUM)"
"TBVCLEAR PRELIST"

do j = Rownum + 1 to MAX#_OF_PREFIXES
   "TBADD PRELIST"
end
Return Rc

/*-------------------------------------------------------------------*/
/* Save Definition member                                            */
/*-------------------------------------------------------------------*/
Save_Def_Member:

Member.0 = 4
Member.1 = "*"
Member.2 = "* SmartProduction Application Definition member, "||,
             "generated via Panel 0."
parse value Date() with Uc_Date
Member.3 = "* Last update was on "Uc_Date" by TSO user "Userid()"."
Member.4 = "*"

/* Make sure there are any applications defined */

if Applications.0 > 0 then
   i = 1
else
   i = 0

do while (i > 0)
   if Applications.i.Deleted \= "Y" then
      do
         /* For each application - save its definition */
         Line_no = Member.0 + 1
         Member.Line_no = "*"
         Line_no = Line_no + 1
         Member.Line_no = "*APPL="space(Applications.i.Name)||,
                ",USER="space(Applications.i.Creator)||,
                ",DATE="Applications.i.Date",TIME="Applications.i.Time
         Line_no = Line_no + 1
         Member.Line_no= "DEFAPPL APPL="space(Applications.i.Name)","||,
                "INCLTIME="||,
                left(Applications.i.Starttime, 5)"-"||,
                left(Applications.i.Endtime, 5)

         if Applications.i.Startdate /= "" &,
            Applications.i.Startdate /= "*" then
            do
               Line_no = Line_no + 1
               Member.Line_no = "DEFAPPL APPL="||,
                    space(Applications.i.Name)||,
                   ",INCLDATE="left(Applications.i.Startdate, 10)
            end
         else nop
         if Applications.i.Userid /= "*" &,
            Applications.i.Userid /= "" then
            do
               Line_no = Line_no + 1
               Member.Line_no = "DEFAPPL APPL="||,
                space(Applications.i.Name)","||,
                 "INCLUSER="left(Applications.i.Userid, 8)
            end
         else nop
         Member.0 = Line_no
         Prefix_Pointer = 1

         do while substr(Applications.i.Prefixes, Prefix_Pointer, 8) /=,
                   left(" ", 8)

            j = Member.0 + 1
            /* Prepare DEFAPPL line */
            Member.j = "DEFAPPL APPL="space(Applications.i.Name)","||,
         space(substr(Applications.i.Prefixes, Prefix_Pointer, 8))"="||,
          space(substr(Applications.i.Prefixes, Prefix_Pointer+8, 8))
            Member.0 = j
            Prefix_Pointer = Prefix_Pointer + 16

         end
      end
   else nop
   i = Applications.i.Next
end


/*-------------------------------------------------------------------*/
/* Save (replace) the new application definitions                    */
/*-------------------------------------------------------------------*/
LIBID = ""
"LMINIT DATAID(LIBID) DATASET('"TMR0PRM3"') ENQ(SHRW)"
"LMOPEN DATAID("LIBID") OPTION(OUTPUT)"

do i = 1 to Member.0
   Record = Member.i
   "LMPUT DATAID("LIBID") MODE(INVAR) DATALOC(Record) ",
    "DATALEN(80)"
end

"LMMREP DATAID("LIBID") MEMBER("TMR0APPL")" /* STATES(YES)?   */
"LMFREE DATAID("LIBID")"

Return Rc

/*-------------------------------------------------------------------*/
/* Delete an application                                             */
/*-------------------------------------------------------------------*/
Del_Application:

/*-------------------------------------------------------*/
/* Verify delete and delete state records                */
/*-------------------------------------------------------*/
"ADDPOP POPLOC(TBAPPNM)"
TMRCRTXT = "Please confirm application "TBAPPNM" delete:"
"DISPLAY PANEL(TMRPCVPO)"
Confirmation_Rc = Rc
"REMPOP"

if ( TMRCREQ = "Y" ) & (Confirmation_Rc = 0) then
  do


      do i = 1 to Applications.0
         if Applications.i.Name = TBAPPNM then
            do
               /* Mark application as Deleted */
               Applications.i.Deleted = "Y"
            end
         else nop
      end

      "TBDELETE APPLIST"
      Unsaved_Changes = 1           /* Make note of change */
  end
else nop

Return Rc

Ins_Application:
arg App_Name dummy

Ins_Rc = 0   /* Assume invalid application name */

if Applications.0 >= MAX#_OF_APPLICATIONS then
   do
      Ins_Rc = 20
      return Ins_Rc
   end
else nop

if (length(App_Name) > 7) | (datatype(left(App_Name, 1)) = "NUM") |,
   (datatype(App_Name, "A") /= 1) then
   Ins_Rc  = 4
else
   do
      /* Make sure application name does not already exist, and add */
      i = 1

      if Applications.0 > 0 then
         do while ((Applications.i.Name /= App_Name) & (i > 0))
            Previous_App = i
            i = Applications.i.Next
         end
      else
         i = 0

      if i > 0 then
         /* Application name exists */
         Ins_Rc = 8
      else
         do
            TBAPPNM = App_Name
            TBAPPCRE = Userid()
            temp_Date = Date('S')
            TBAPPCDT = left(temp_Date, 4) || "/" ||,
             substr(temp_date, 5, 2) || "/" ||,
             right(temp_Date, 2)
            TBAPPTME = left(Time("N"), 5)
            TBAPPSTD = ""
            TBAPPSTT = "00:00"
            TBAPPENT = "23:59"
            TBAPPUSR = ""

            "TBBOTTOM APPLIST NOREAD"
            "TBADD APPLIST"
            if Rc = 0 then
               do
                  /* Add to Application stem */
                  i = Applications.0 + 1
                  if Applications.0 > 0 then
                     Applications.Previous_App.Next = i
                  else nop
                  Applications.i.Name = TBAPPNM
                  Applications.i.Deleted = "N"
                  Applications.i.Creator = TBAPPCRE
                  Applications.i.Date = TBAPPCDT
                  Applications.i.Time = TBAPPTME
                  Applications.i.Startdate = TBAPPSTD
                  Applications.i.Starttime = TBAPPSTT
                  Applications.i.Endtime = TBAPPENT
                  Applications.i.Userid = TBAPPUSR
                  Applications.i.Prefixes = ""
                  Applications.i.Next = 0
                  Applications.0 = i
                  Unsaved_Changes = 1      /* Mark save is needed */
               end
            else
               Ins_Rc = 16
         end
   end

Return Ins_Rc

/*-------------------------------------------------------------------*/
/* Add prefix name to TMRCPREF (variable contains all prefixes       */
/* for check by the ISPF panel).                                     */
/*-------------------------------------------------------------------*/
Add_To_TMRCPREF:
Add_Rc = 0

"TBGET PRELIST ROWID(CURROWID) NOREAD"

TMRCPREF = left(TMRCPREF, 200)

TMRCPREF = left(TMRCPREF, (CURROWID - 1) * 8) ||,
           left(" ", 8) ||,
           substr(TMRCPREF, (CURROWID * 8) + 1)

if wordpos(TBPREPRE, TMRCPREF) > 0 then
   do
      TMRECURS = "TBPREPRE"
      Pop_Message = "TMR552"
      Add_Rc = 16
   end
else if Verify_Jobname(TBPREPRE) > 0 then
   do
      TMRECURS = "TBPREPRE"
      Pop_Message = "TMR303"
      Add_Rc = 16
   end
else
   do
      TMRCPREF = left(TMRCPREF, (CURROWID - 1) * 8) ||,
                 left(TBPREPRE, 8) ||,
                 substr(TMRCPREF, (CURROWID * 8) + 1)
      Pop_Message = ""
   end

/*-------------------------------------------------------------------*/
/* Keep track on the number of include and exclude statement in      */
/* order to enforce maximum number of statements allowed.            */
/*-------------------------------------------------------------------*/
if TBPREPAC /= "" then
   if TBPREPAC = "I" then
      TMRCINC# = TMRCINC# - 1
   else
      TMRCEXC# = TMRCEXC# - 1
else nop

if space(TBPREPRE) /= "" then
   if TBPREACT = "I" then
      TMRCINC# = TMRCINC# + 1
   else
      TMRCEXC# = TMRCEXC# + 1
else nop

TBPREPAC = TBPREACT

Return Add_Rc


/*-------------------------------------------------------------------*/
/* Verify jobname is valid                                           */ 
/*-------------------------------------------------------------------*/
Verify_Jobname:
arg Jobname dummy

if Jobname = "" then Return 0

Valid_Jobname_First = "ABCDEFGHIJKLMNOPQRSTUVWXYZ$#@?%*"
Valid_Jobname_Chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789$#@?%*"

Verify_Rc = verify(left(Jobname, 1), Valid_Jobname_First)

if Verify_Rc = 0 then
   Verify_Rc = verify(Jobname, Valid_Jobname_Chars)
else nop

Return Verify_Rc