./ ADD NAME=$$$INDEX
*---------------------------------------------------------------------*
*              Directory list of ABBYDALE.ALLFREE.EMACS               *
*---------------------------------------------------------------------*
|  Member  | Description                                              |
*---------------------------------------------------------------------*
| $$$INDEX | This member.                                             |
*---------------------------------------------------------------------*
| ALIAS    | Creates an alias for the current member.                 |
*---------------------------------------------------------------------*
| ASMTIDY  | Cleans up an assembler source program.                   |
*---------------------------------------------------------------------*
| CENTER   | Centers text on a line.                                  |
*---------------------------------------------------------------------*
| CHGLOG   | Add a chage log box to a rexx exec.                      |
*---------------------------------------------------------------------*
| CLEANIT  | Removes extraneous numbers from columns 73-80            |
*---------------------------------------------------------------------*
| COMMENT  | Comments a line of block of lines in a member. It will   |
|          | determine the comment format by checking the data type.  |
*---------------------------------------------------------------------*
| COPYRITE | Add a copyright notice to a member.                      |
*---------------------------------------------------------------------*
| COPYTO   | Copies the member being edited to a different dataset.   |
*---------------------------------------------------------------------*
| DSNINFO  | Displays the dataset information of the dataset that is  |
|          | currently being edited.                                  |
*---------------------------------------------------------------------*
| FIXPREP  | Applies the fix to ISPPREPA to save the input and output |
|          | datasets in the TSO profile.                             |
*---------------------------------------------------------------------*
| INDEXIT  | Creates an index of members within a PDS.                |
*---------------------------------------------------------------------*
| JOBCARD  | Adds a jobcard to the member being edited.               |
*---------------------------------------------------------------------*
| ONLY     | Display only lines containing the string passed as a     |
|          | parameter to the macro.                                  |
*---------------------------------------------------------------------*
| PRINTIT  | Prints the current dataset member.                       |
*---------------------------------------------------------------------*
| REXXIT   | Creates a Rexx boilerplate and adds some error checking  |
|          | to a Rexx exec.                                          |
*---------------------------------------------------------------------*
| RUNJCL   | Submits a job from a PDS. The default PDS can be changed |
|          | by using "RUNJCL /".                                     |
*---------------------------------------------------------------------*
| SETLANG  | Sets the correct highlighting for the edit member.       |
*---------------------------------------------------------------------*
| STARTASM | Builds an assembler program boilerplate and sets ISPF    |
|          | to highlight assembler.                                  |
*---------------------------------------------------------------------*
| STARTCOB | Builds a Cobol prgram boilerplate and sets ISPF to       |
|          | highlight Cobol.                                         |
*---------------------------------------------------------------------*
| STARTMAC | Builds an assembler DSECT boilerplate and sets ISPF to   |
|          | highlight assembler. It also sets the member to CAPS OFF.|
*---------------------------------------------------------------------*
| STARTPNL | Builds an ISPF panel skeleton.                           |
*---------------------------------------------------------------------*
|                 ©Copyright of Abbydale Systems LLC.                 |
*---------------------------------------------------------------------*
./ ADD NAME=ALIAS
/* rexx */
/*-------------------------------------------------------------------*/
/*                                                                   */
/*                         REXX Exec : ALIAS                         */
/*                                                                   */
/*                      ***** Edit Macro *****                       */
/*                                                                   */
/*  Description : Define an alias for the current member name.       */
/*                                                                   */
/*  Created on : 15 Jul 2023                                         */
/*  Created by : Wendy Miller                                        */
/*             : Userid MIT002                                       */
/*             : Using ABBYDALE.PROD.EMACS(ALIAS)                    */
/*                                                                   */
/*  Called by :                                                      */
/*                                                                   */
/*  Calls : RENAME                                                   */
/*                                                                   */
/*  Panels Used : None                                               */
/*                                                                   */
/*  Change Activity :                                                */
/*                                                                   */
/*                ©Copyright of Abbydale Systems LLC.                */
/*                                                                   */
/*-------------------------------------------------------------------*/
Parse Arg Help         /* Check for Help */
If SYSVAR("SYSISPF")<>"ACTIVE" then do
   Say "ISPF must be active to use "ALIAS
   exit(16)
end
Address ISREDIT "MACRO (Help) PROCESS"
If Help = "?" Then do
   Call Disp_Help
   exit(4)
end
signal on halt         /* attention key      */
z = OUTTRAP('ON')
Address ISREDIT "(MEM) = MEMBER"
z = OUTTRAP('OFF')
if rc = 20 then do
   ZEDSMSG = 'Invalid for dataset'
   ZEDLMSG = 'Alias is not allowed for the dataset'
   signal setmsg
end
signal on novalue      /* un-initialized vars*/
if LENGTH(help) > 8 then do
   ZEDSMSG = 'Invalid alias name'
   ZEDLMSG = 'Alias name is too long'
setmsg:
   Address ISPEXEC "VPUT (ZDLMSG ZDLMSG) SHARED"
   Address ISPEXEC "SETMSG MSG(ISRZ001)"
   exit(8)
end
forbid = '*%!&^}{[_]:,;()'  /* characters forbidden in member name */
forbid2 = '1234567890'      /* Invalid first characters */
if POS(SUBSTR(help,1,1),forbid2) > 0 then do
   ZEDSMSG = 'Invalid alias name'
   ZEDLMSG = 'Invalid first character' SUBSTR(help,1,1)
   signal setmsg
end
x = 1
do until x = LENGTH(forbid)
   if POS(SUBSTR(forbid,x,1),help) > 0 then do
      k = POS(SUBSTR(forbid,x,1),help)
      ZEDSMSG = 'Invalid alias name'
      ZEDLMSG = 'Invalid character in ALIAS name' SUBSTR(help,k,1)
      signal setmsg
   end
   x = x + 1
end
Address ISREDIT "(DSN) = DATASET"
UPPER = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
LOWER = "abcdefghijklmnopqrstuvwxyz"
help = TRANSLATE(help)
z = OUTTRAP('list.')
 x = SYSDSN(''''DSN'('help')''')
z = OUTTRAP("OFF")
if x = 'OK' then do
   ZEDSMSG = 'Member name 'help' exists'
   ZEDLMSG = 'The member name 'help' already exists'
   signal setmsg
end
/* "ALLOC F(ALIAS) DA('"dsn"') SHR REUS" */
z = OUTTRAP('ON')
       "REN '"dsn"("mem")' ("help") ALIAS"
 /* "RENAME "dsn"("mem") "dsn"("help") ALIAS" */
z = OUTTRAP("OFF")
if rc = 12 then do
   ZEDSMSG = 'dataset allocated elsewhere'
   ZEDLMSG = 'The dataset 'dsn' is allocated to another task'
   signal setmsg
end
ZEDSMSG = 'Alias created'
ZEDLMSG = 'Alias 'help' successfully created'
ZDLMSG = 'Alias successful'
Address ISPEXEC "VPUT (ZDLMSG ZDLMSG) SHARED"
Address ISPEXEC "SETMSG MSG(ISRZ001)"
return
/*-------------------------------------------------------------------*/
/*                        Disp_Help Procedure                        */
/*-------------------------------------------------------------------*/
Disp_Help: Procedure
say "ALIAS - This edit macro will create an alias for the member "
say "        currently open for edit."
say""
say "Usage: ALIAS xxxxx | ?"
say""
say"    ?        - Generates this information."
say""
say"   Return Codes :"
say"                 0 - Alias created successfully"
say"                 4 - Help displayed"
say"                 8 - Invalid use of ALIAS"
say"                16 - Not under ISPF"
say""
Return
/*-------------------------------------------------------------------*/
/*                    End of Disp_Help Procedure                     */
/*-------------------------------------------------------------------*/
/*-------------------------------------------------------------------*/
/*                      Trap NOVALUE Condition                       */
/*-------------------------------------------------------------------*/
novalue:
say "NOVALUE entered from line" sigl
say condition("D")
say "The instruction is suppressed"
address "TSO"
"delstack"
exit(16)
/*-------------------------------------------------------------------*/
/*                        Trap HALT Condition                        */
/*-------------------------------------------------------------------*/
halt:
say "HALT acknowledged in line" sigl
say "Cleanup processing in progress"
address "TSO"
"delstack"
exit(16)
/*-------------------------------------------------------------------*/
/*                           End of ALIAS                            */
/*-------------------------------------------------------------------*/
./ ADD NAME=ASMTIDY
/* rexx */
/*-------------------------------------------------------------------*/
/*                                                                   */
/*                        REXX Exec : ASMTIDY                        */
/*                                                                   */
/*                      ***** Edit Macro *****                       */
/*                                                                   */
/*  Description : Tidy an assembler program up a little              */
/*                                                                   */
/*  Created on : 16 Jun 2023                                         */
/*  Created by : Kevin Ferguson                                      */
/*             : Userid MIT001                                       */
/*             : Using ABBYDALE.PROD.EMACS(ASMTIDY)                  */
/*                                                                   */
/*  Called by : Command Line                                         */
/*                                                                   */
/*  Calls : Word, Words                                              */
/*                                                                   */
/*  Panels Used : None                                               */
/*                                                                   */
/*  Change Activity :                                                */
/*                                                                   */
/*                ©Copyright of Abbydale Systems LLC.                */
/*                                                                   */
/*-------------------------------------------------------------------*/
parse Arg Help         /* Check for Help */
If SYSVAR("SYSISPF")<>"ACTIVE" then DO
   say "ISPF must be active to use "ASMTIDY
   exit(16)
end
Address ISREDIT "MACRO (Help) PROCESS"
If Help = "?" Then DO
   Call Disp_Help
   exit(4)
end
ISREDIT "(NUMLAST) = LINENUM .ZLAST"
ISREDIT "(CRSLINE,CRSCOL) =  CURSOR"
ISREDIT "(LINEDATA) = LINE"  CRSLINE
lne = 1
cnt = 0
UPPER = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
lower = "abcdefghijklmnopqrstuvwxyz"
ISREDIT "X ALL"
ISREDIT "NUM"
ISREDIT "UNNUM"
Do Until Lne > numlast
   ISREDIT "(LINEDATA) = LINE"  Lne
   test =  word(linedata,1)
   test = translate(test,upper,lower)
   if test = 'LTORG' then do
      lne = numlast
      iterate
   end
   Lne = Lne + 1
   if Words(linedata) > 1 then do
      if substr(linedata,1,1) = "/" then iterate
      if substr(linedata,1,1) = "&" then iterate
      if substr(linedata,1,1) = "*" then iterate
      n = 1
      if substr(linedata,1,1) <> " " then do
         n = 2
      end
         x = Lne-1
         K = word(Linedata,n)
         K = Translate(K,upper,lower)
         If K = "EQU" then do
            if word(linedata,N+1) = "*" then do
               ISREDIT "X ALL"
               ISREDIT "RESET EXCLUDED" x x
               ISREDIT "C "Word(Linedata,n)" DS ALL NX"
               ISREDIT "C '*' '0H' ALL NX"
            end
         end
         If K = "BAL" then do
            ISREDIT "RESET EXCLUDED" x x
            ISREDIT "C "Word(Linedata,n)" BAS ALL NX"
         end
         ISREDIT "RESET EXCLUDED" x x
         ISREDIT "C '"Word(Linedata,n)"' '"K"' ALL NX 2 16"
         cnt = cnt + 1
      end
end
ISREDIT "RESET EXCLUDED"
ISREDIT "RESET"
Signal on novalue      /* un-initialized vars*/
Signal on halt         /* attention key      */
Return
/*-------------------------------------------------------------------*/
/*                        Disp_Help Procedure                        */
/*-------------------------------------------------------------------*/
DISP_HELP: Procedure
say "ASMTIDY - Tidy up an assembler prgram."
say""
say "Usage: ASMTIDY | ?"
say""
say"    ?        - Generates this information."
say""
say"   RETURN Codes :"
say"                 4 - Help displayed"
say"                16 - Not under ISPF"
say""
return
/*-------------------------------------------------------------------*/
/*                    End of Disp_Help Procedure                     */
/*-------------------------------------------------------------------*/
/*-------------------------------------------------------------------*/
/*                      Trap NOVALUE Condition                       */
/*-------------------------------------------------------------------*/
novalue:
say "NOVALUE entered from line" sigl
say condition("D")
say "The instruction is suppressed"
ADDRESS "TSO"
"delstack"
Exit(16)
/*-------------------------------------------------------------------*/
/*                        Trap HALT Condition                        */
/*-------------------------------------------------------------------*/
halt:
say "HALT acknowledged in line" sigl
say "Cleanup processing in progress"
Address "TSO"
"delstack"
exit(16)
/*-------------------------------------------------------------------*/
/*                          End of ASMTIDY                           */
/*-------------------------------------------------------------------*/
./ ADD NAME=CENTER
/* Rexx */
/*-------------------------------------------------------------------*/
/*                                                                   */
/*                      Edit Macro : CENTER                          */
/*                                                                   */
/*                      ***** Edit Macro *****                       */
/*                                                                   */
/*  Description : Centers the lines on the line                      */
/*                                                                   */
/*  Created on : 18 Oct 1998                                         */
/*  Created by : Kevin Ferguson                                      */
/*             : Userid(MIT001)                                      */
/*             : using ABBYDALE.ALLFREE.EMACS(CENTER)                */
/*                                                                   */
/*  Called by : Nothing                                              */
/*                                                                   */
/*  Calls : Nothing                                                  */
/*                                                                   */
/*  Change Activity :                                                */
/*                                                                   */
/*                ©Copyright of Abbydale Systems LLC.                */
/*                                                                   */
/*-------------------------------------------------------------------*/
Address ISREDIT "MACRO (left,right) NOPROCESS"
If left = "?" Then do
    'ISPEXEC DISPLAY PANEL(ASLCNTR1)'
    Exit (1)
End
If left /= ""  & right = " " then do
    Address ISREDIT "(L2,right) = BOUNDS"
    End
Address ISPEXEC "CONTROL ERRORS RETURN"
Address ISREDIT "PROCESS RANGE C"
Address ISREDIT "(RC) = RANGE_CMD"
If rc = 4 Then Do
    zedsmsg = "NO RANGE SPECIFIED"
    zedlmsg = "You MUST specify a range of lines to be centered using Cnn or CC"
    Address ISPEXEC "SETMSG MSG(ISRZ001)"
    Exit (12)
End
address ISREDIT "(FR)  = LINENUM .ZFRANGE"
address ISREDIT "(LR)  = LINENUM .ZLRANGE"
address ISREDIT "(LB,RB) = BOUNDS"
If right /=  "" Then Do
    rb = right
    lb = left
    End
i = fr
Do while (i <= lr)
  /* Address ISREDIT */
  Address ISREDIT "LABEL" i ".LJ"
  Address ISREDIT "SEEK P'-' .LJ .LJ" lb rb "FIRST"
  Address ISREDIT "(LLINE,LCOL) = CURSOR"
  Address ISREDIT "SEEK P'-' .LJ .LJ" lb rb "LAST"
  Address ISREDIT "(RLINE,RCOL) = CURSOR"
  midpt = (rb  - lb) % 2
  midpt = midpt + lb
  left = midpt - lcol
  right = rcol - midpt
  count = (left  - right + 1) % 2
  If count > 0
    Then
      Address ISREDIT "SHIFT )" i count
    Else
      If count < 0 Then Do
          count = -1*count
          Address ISREDIT "SHIFT (" i count
          End
  If i = fr
    Then
      Address ISREDIT "LABEL" i ".LJX"
  i = i + 1
  End
Address ISREDIT "SEEK P'=' .LJ .LJ FIRST"
Exit (0)
/*-------------------------------------------------------------------*/
/*                           End of CENTER                           */
/*-------------------------------------------------------------------*/
./ ADD NAME=CHGLOG
/* rexx */
/*-------------------------------------------------------------------*/
/*                                                                   */
/*                        REXX Exec : CHGLOG                         */
/*                                                                   */
/*                      ***** Edit Macro *****                       */
/*                                                                   */
/*  Description : Add change log to a rexx exec                      */
/*                Use the line command "A" to specify where to place */
/*                the comments. If no line command is found the box  */
/*                is placed at the top of the member.                */
/*                If the Rexx exec has been created by Rexxit or it  */
/*                contains the string "Change Activity" the box is   */
/*                positioned immediately following the text          */
/*                                                                   */
/*  Created on : 13 Jun 2021                                         */
/*  Created by : Kevin Ferguson                                      */
/*             : Userid MIT001                                       */
/*             : Using ABBYDALE.DEVL.EMACS(CHGLOG)                   */
/*                                                                   */
/*  Called by : Nothing                                              */
/*                                                                   */
/*  Calls : Nothing                                                  */
/*                                                                   */
/*  Panels Used : None                                               */
/*                                                                   */
/*  Change Activity :                                                */
/*                                                                   */
/*                ©Copyright of Abbydale Systems LLC.                */
/*                                                                   */
/*-------------------------------------------------------------------*/
Parse Arg Help         /* Check for Help */
If SYSVAR("SYSISPF")<>"ACTIVE" then do
   Say "ISPF must be active to use "CHGLOG
   exit(16)
end
Address ISREDIT "MACRO (Help) NOPROCESS"
If Help = "?" Then do
   Call Disp_Help
   exit(4)
end
signal on novalue      /* un-initialized vars*/
signal on halt         /* attention key      */
chg = "N"
Address ISPEXEC "CONTROL ERRORS RETURN"
Address ISREDIT "(CR, CC) = CURSOR"
Address ISREDIT "CAPS OFF"
Address ISREDIT "PROCESS RANGE A"
Address ISREDIT "(RC) = RANGE_CMD"
kef = rc
Address ISREDIT "(FIRST) = LINENUM .ZFRANGE"
if kef = 0   then do
/* if first > 1 then do  */
   num = first
   signal doit
end
else do
   If First > 1 then do
      num = first
   end
   else do
      fndparm = """Change Activity"""
      Address ISREDIT "(LEFTON,RIGHTON) = BOUNDS"
      Address ISREDIT "SCAN OFF"
      Address ISREDIT "SEEK" fndparm "FIRST"    /* find the string */
      if rc > 0 then do
         num = 0
      end
      else do
         Address ISREDIT "(NUM) = LINENUM .ZCSR"
         chg = "Y"
      end
   end
end
doit:
if first = 0 then num = first
blankout='/*'||copies(' ',67)||'*/'
lineout ='/*'||copies('-',67)||'*/'
headout='/*  MM/DD/YYYY  ID   Comment'||copies(' ',41)||'*/'
chgout='/*  Change Activity :'||copies(' ',48)||'*/'
ulinout='/*  '||copies('-',63)||'  */'
if chg = "N" then do
   Address ISREDIT "LINE_AFTER "num "= '"lineout"'"
   Address ISREDIT "LINE_AFTER "num + 1 "= '"blankout"'"
   Address ISREDIT "LINE_AFTER "num + 2"= '"chgout"'"
   num = num + 3
end
Address ISREDIT "LINE_AFTER "num "= '"blankout"'"
Address ISREDIT "LINE_AFTER "num + 1" ='"headout"'"
Address ISREDIT "LINE_AFTER "num + 2" ='"ulinout"'"
Address ISREDIT "LINE_AFTER "num + 3" ='"blankout"'"
Address ISREDIT "LINE_AFTER "num + 4" ='"blankout"'"
if chg = "N" then do
   Address ISREDIT "LINE_AFTER "num + 5"= '"lineout"'"
   num = num + 1
end
/* Address ISREDIT "SAVE" */
return
/*-------------------------------------------------------------------*/
/*                        Disp_Help Procedure                        */
/*-------------------------------------------------------------------*/
Disp_Help: Procedure
say "CHGLOG -"
say""
say "Usage: CHGLOG | ?"
say""
say"    ?        - Generates this information."
say""
say"   Return Codes :"
say"                 4 - Help displayed"
say"                16 - Not under ISPF"
say""
Return
/*-------------------------------------------------------------------*/
/*                    End of Disp_Help Procedure                     */
/*-------------------------------------------------------------------*/
/*-------------------------------------------------------------------*/
/*                      Trap NOVALUE Condition                       */
/*-------------------------------------------------------------------*/
novalue:
say "NOVALUE entered from line" sigl
say condition("D")
say "The instruction is suppressed"
address "TSO"
"delstack"
exit(16)
/*-------------------------------------------------------------------*/
/*                        Trap HALT Condition                        */
/*-------------------------------------------------------------------*/
halt:
say "HALT acknowledged in line" sigl
say "Cleanup processing in progress"
address "TSO"
"delstack"
exit(16)
/*-------------------------------------------------------------------*/
/*                           End of CHGLOG                           */
/*-------------------------------------------------------------------*/
./ ADD NAME=CLEANIT
/* rexx */
/*-------------------------------------------------------------------*/
/*                                                                   */
/*                        REXX Exec : CLEANIT                        */
/*                                                                   */
/*                      ***** Edit Macro *****                       */
/*                                                                   */
/*  Description : Remove extraneous numbers from columns 73-80       */
/*                                                                   */
/*  Created on : 25 Jun 2022                                         */
/*  Created by : Wendy Miller                                        */
/*             : Userid MIT002                                       */
/*             : Using ABBYDALE.DEVL.REXX(CLEANIT)                   */
/*                                                                   */
/*  Called by : User                                                 */
/*                                                                   */
/*  Calls : Nothing                                                  */
/*                                                                   */
/*  Panels Used : None                                               */
/*                                                                   */
/*  Change Activity :                                                */
/*                                                                   */
/*                ©Copyright of Abbydale Systems LLC.                */
/*                                                                   */
/*-------------------------------------------------------------------*/
Parse Arg Help         /* Check for Help */
If SYSVAR("SYSISPF")<>"ACTIVE" then do
   Say "ISPF must be active to use "CLEANIT
   exit(16)
end
Address ISREDIT "MACRO (Help) PROCESS"
If Help = "?" Then do
   Call Disp_Help
   exit(4)
end
Address TSO "ISREDIT NUM"
Address TSO "ISREDIT RESET"
Address TSO "ISREDIT UNNUM"
address TSO "ISREDIT SAVE"
return
/*-------------------------------------------------------------------*/
/*                        Disp_Help Procedure                        */
/*-------------------------------------------------------------------*/
Disp_Help: Procedure
say "CLEANIT - Remove extraneous numbers from column 73-80"
say""
say "Usage: CLEANIT"
say""
say"    ?        - Generates this information."
say""
say"   Return Codes :"
say"                 4 - Help displayed"
say"                16 - Not under ISPF"
say""
Return
/*-------------------------------------------------------------------*/
/*                    End of Disp_Help Procedure                     */
/*-------------------------------------------------------------------*/
/*-------------------------------------------------------------------*/
/*                          End of CLEANIT                           */
/*-------------------------------------------------------------------*/
./ ADD NAME=COMMENT
/* rexx */
/*-------------------------------------------------------------------*/
/*                                                                   */
/*                        REXX Exec : COMMENT                        */
/*                                                                   */
/*                      ***** Edit Macro *****                       */
/*                                                                   */
/*  Description : Change lines into comments                         */
/*                Use the Q line command or QQ block commands        */
/*                                                                   */
/*  Created on : 26 Aug 2023                                         */
/*  Created by : Kevin Ferguson                                      */
/*             : Userid MIT001                                       */
/*             : Using ABBYDALE.DEVL.EMACS(COMMENT)                  */
/*                                                                   */
/*  Called by : Edit macro                                           */
/*                                                                   */
/*  Calls : strRepl, setlang                                         */
/*                                                                   */
/*  Panels Used : none                                               */
/*                                                                   */
/*  Change Activity :                                                */
/*                                                                   */
/*  MM/DD/YYYY  ID   Comment                                         */
/*  ---------------------------------------------------------------  */
/*  08/28/2023  NON  Remove the ugly seek highlight                  */
/*                                                                   */
/*                ©Copyright of Abbydale Systems LLC.                */
/*                                                                   */
/*-------------------------------------------------------------------*/
Parse Arg Help         /* Check for Help */
dialogid = sysvar(sysicmd)
parse source Exec_String
excnme = word(Exec_String,3)
If SYSVAR("SYSISPF")<>"ACTIVE" then do
   Say "ISPF must be active to use "COMMENT
   exit(16)
end
Address ISREDIT "MACRO (Help) NOPROCESS"
If Help = "?" Then do
   ZEDSMSG = 'Help displayed'
   ZEDLMSG = 'Help was displayed. No other action taken'
   ZDLMSG = 'Help displayed'
   Address ISPEXEC "VPUT (ZDLMSG ZDLMSG) SHARED"
   Address ISPEXEC "SETMSG MSG(ISRZ001)"
   Call Disp_Help
   exit(4)
end
Address ISPEXEC "CONTROL ERRORS RETURN"
Address ISREDIT "(CR, CC) = CURSOR"
Address ISREDIT "PROCESS RANGE Q"
Address ISREDIT "(RC) = RANGE_CMD"
Address ISREDIT "(FAR) = LINENUM .ZLAST"
Address ISREDIT "(LAR) = LINENUM .ZFIRST"
address ISREDIT "(FR)  = LINENUM .ZFRANGE"
address ISREDIT "(LR)  = LINENUM .ZLRANGE"
address ISREDIT "(whower) = MEMBER"
if fr = 0 then do
   if lr = 0 then do
      ZEDSMSG = 'Invalid call'
      ZEDLMSG = 'No QQ block detected'
      Address ISPEXEC "VPUT (ZDLMSG ZDLMSG) SHARED"
      Address ISPEXEC "SETMSG MSG(ISRZ001)"
      exit(8)
   end
end
"ISREDIT SCAN OFF"
"ISREDIT SEEK 'PROC ' FIRST"
if rc = 0 then do
   do k = lar to far
      Address ISREDIT "(temp) = LINE" k
      if words(temp) = 0 then iterate
      if word(temp,1) = "/*" then iterate
      tester = word(temp,1)
      parse upper var tester
      if tester = "PROC" then k = far
   end
   if tester = "PROC" then do
      mystar = fr
      myend  = lr
      do k = mystar to myend
         Address ISREDIT "(temp) = LINE" k
         if words(temp) = 0 then iterate
         if substr(word(temp,1),1,2) = "/*" then iterate
         if substr(temp,1,2) <> "  " then do
            temp = "/*"||substr(temp,1,72)
         end
         else do
            temp = "/*"||substr(temp,3,72)
         end
         address ISREDIT "LINE "k "= (temp)"
      end
      k = k - 1
      if k = mystar then signal SingleOut
      signal MultiOut
   end
end
if whower <> "COMMENT" then do
   "ISREDIT SEEK 'Identification Division' FIRST"
   If rc = 0 then do
      "ISREDIT SEEK 'Environment Division' FIRST"
      If rc = 0 then do
         "ISREDIT SEEK 'Data Division' FIRST"
         If rc = 0 then do
            "ISREDIT SEEK 'Procedure Division' FIRST"
            If rc = 0 then do
               mystar = fr
               myend  = lr
               do k = mystar to myend
                  Address ISREDIT "(temp) = LINE" k
                  temp = substr(temp,1,6)||"*"||substr(temp,8,72)
                  address ISREDIT "LINE "k "= (temp)"
               end
               k = k - 1
               if k = mystar then signal SingleOut
               signal MultiOut
            end
         end
      end
   end
end
"ISREDIT SEEK '/*' FIRST"    /* look for the string */
If rc = 0 then do
   "ISREDIT (NUM1) = LINENUM .ZCSR"
   "ISREDIT SEEK '*/' FIRST"    /* look for the string */
   If rc = 0 then do
      "ISREDIT (NUM2) = LINENUM .ZCSR"
      "ISREDIT SEEK 'rexx' FIRST"    /* look for the string */
ClistFound:
      If rc = 0 then do
         heads = """/*"""
         tails = """*/"""
         if fr = lar then do
            if lr = Far then do
InsertItRexx:
               Address ISREDIT "(temp) = LINE" cr
               temp = strRepl(temp,'/*','%*')
               temp = strRepl(temp,'*/','*%')
               Address ISREDIT "LINE "cr "= (temp)"
               Address ISREDIT "LINE_AFTER" cr "=" tails
               Address ISREDIT "LINE_BEFORE" cr "=" heads
               signal SingleOut
            end
         end
         if fr = lr then do
            cr = fr
            signal InsertItRexx
         end
         mystar = fr
         myend  = lr
         do k = mystar to myend
            Address ISREDIT "(temp) = LINE" k
            temp = strRepl(temp,'/*','%*')
            temp = strRepl(temp,'*/','*%')
            address ISREDIT "LINE "k "= (temp)"
         end
         Address ISREDIT "LINE_AFTER" lr "=" tails
         Address ISREDIT "LINE_BEFORE" fr "=" heads
         signal MultiOUT
      end
   end
end
else do
   "ISREDIT SEEK ' CSECT ' FIRST 2 66"    /* look for the string */
   If rc = 0 then do
      "ISREDIT SEEK ' USING ' FIRST 2 66"    /* look for the string */
      If rc = 0 then do
         mystar = fr
         myend  = lr
         do k = mystar to myend
            Address ISREDIT "(temp) = LINE" k
            if substr(temp,1,1) = " " then do
               if substr(temp,72,1) = " " then do
                  temp = "*"||substr(temp,2,71)
               end
               else do
                  temp = "*"||substr(temp,2,69)||"* "
               end
            end
            else do
               if substr(temp,1,1) = "*" then iterate
               if substr(temp,72,1) = " " then do
                  temp = "*"||substr(temp,1,71)
               end
            end
            address ISREDIT "LINE "k "= (temp)"
         end
         k = k - 1
         if k = mystar then signal SingleOut
         signal MultiOut
      end
   end
end
"ISREDIT SEEK '//'  FIRST 1 2"    /* look for the string */
if rc = 0 then do
   "ISREDIT SEEK ' EXEC '  FIRST 3 66"    /* look for the string */
   If rc = 0 then do
      mystar = fr
      myend  = lr
      do k = mystar to myend
         Address ISREDIT "(temp) = LINE" k
         if substr(temp,1,2) = "//" then do
            temp = strRepl(temp,"//","//*",1)
         end
         if substr(temp,1,1) <> "/" then do
            temp = "*"||temp
            if length(temp) > 72 then temp = substr(temp,1,72)
         end
         address ISREDIT "LINE "k "= (temp)"
      end
      k = k - 1
      if k = mystar then signal SingleOut
      signal MultiOut
      say k fr
      say "JCL"
   end
end
ZEDSMSG = 'Unknown file type'
ZEDLMSG = 'Unable to determine data type'
Address ISPEXEC "VPUT (ZDLMSG ZDLMSG) SHARED"
Address ISPEXEC "SETMSG MSG(ISRZ001)"
exit(12)
SingleOut:
ZEDSMSG = 'Line commented out'
ZEDLMSG = 'Line 'strip(cr,l,"0") 'commented out'
signal LeaveIt
multiOut:
ZEDSMSG = 'Lines commented out'
ZEDLMSG = 'Lines 'strip(fr,l,"0") '-' strip(lr,l,"0") 'commented out'
LeaveIt:
Address ISPEXEC "VPUT (ZDLMSG ZDLMSG) SHARED"
Address ISPEXEC "SETMSG MSG(ISRZ001)"
Address ISREDIT "UP MAX"
count = 0
Address ISREDIT "LOCATE FIRST MSGLINE"
if rc = 0 then do
   do until rc > 0
      count = count + 1
      Address ISREDIT "LOCATE NEXT MSGLINE"
   end
end
fr = strip(fr,'l',"0")
Address ISREDIT "FIND ' '"                                      /*NON*/
Address ISREDIT "RESET FIND"                                    /*NON*/
Address ISREDIT "DOWN" fr
Address ISREDIT "CURSOR" fr "1"
exit(0)
/*-------------------------------------------------------------------*/
/*                        Disp_Help Procedure                        */
/*-------------------------------------------------------------------*/
Disp_Help: Procedure EXPOSE excnme
excnme = RIGHT(excnme,8," ")
say ""excnme " - Will comment out a line or lines in a Rexx Exec"
say             "To comment out a block use QQ in the line column"
say""
say "Usage: "excnme " xxxxx | ?"
say""
say"    ?        - Generates this information."
say""
say"   Return Codes :"
say"                 4 - Help displayed"
say"                 8 - Invlaid call"
say"                12 - Unknown file type"
say"                16 - Not under ISPF or Halt(PA1) pressed"
say""
Return
/*-------------------------------------------------------------------*/
/*                    End of Disp_Help Procedure                     */
/*-------------------------------------------------------------------*/
/*                        Trap HALT Condition                        */
/*-------------------------------------------------------------------*/
halt:
say "HALT acknowledged in line" sigl
say "Cleanup processing in progress"
address "TSO"
"delstack"
exit(16)
/*-------------------------------------------------------------------*/
/*                          End of COMMENT                           */
/*-------------------------------------------------------------------*/
./ ADD NAME=COPYRITE
/* rexx */
/*-------------------------------------------------------------------*/
/*                                                                   */
/*                        REXX Exec : COPYRITE                       */
/*                                                                   */
/*  Description : Add a copyright notice at the position of the      */
/*                cursor or where there is an "A" line command.      */
/*                If the member is detected to be a Rexx exec proper */
/*                format comments are generated, otherwise asterisks */
/*                are used to wrap the copyrite notice.              */
/*                                                                   */
/*  Created on : 27 Jun 2021                                         */
/*  Created by : Kevin Ferguson                                      */
/*             : Userid MIT001                                       */
/*             : Using ABBYDALE.DEVL.REXX(COPYRIT)                   */
/*                                                                   */
/*  Called by :                                                      */
/*                                                                   */
/*  Calls :                                                          */
/*                                                                   */
/*  Panels Used :                                                    */
/*                                                                   */
/*  Change Activity :                                                */
/*                                                                   */
/*  MM/DD/YYYY  ID   Comment                                         */
/*  ---------------------------------------------------------------  */
/*  07/18/2021  DTE  Changed date used from Normal to Standard to    */
/*                   compensate for different regional settings      */
/*                                                                   */
/*                                                                   */
/*                ©Copyright of Abbydale Systems LLC.                */
/*                                                                   */
/*-------------------------------------------------------------------*/
Parse Arg Help         /* Check for Help */
If SYSVAR("SYSISPF")<>"ACTIVE" then do
   Say "ISPF must be active to use "COPYRIT
   exit(16)
end
Address ISREDIT "MACRO (Help) NOPROCESS"
If Help = "?" Then do
   Call Disp_Help
   exit(4)
end
signal on novalue      /* un-initialized vars*/
signal on halt         /* attention key      */
Address ISPEXEC "CONTROL ERRORS RETURN"
Address ISREDIT "(CR, CC) = CURSOR"
Address ISREDIT "CAPS OFF"
Address ISREDIT "PROCESS RANGE A"
Address ISREDIT "(RC) = RANGE_CMD"
kef = cr
rexx = "N"
pre = "**"
suf = "**"
Fill = "*"
Address ISREDIT "(FIRST) = LINENUM .ZFRANGE"
fndparm = """/*"""
Address ISREDIT "(LEFTON,RIGHTON) = BOUNDS"
Address ISREDIT "SCAN OFF"
Address ISREDIT "SEEK" fndparm "FIRST"
if rc = 0 then do
   Address ISREDIT "(NUM) = LINENUM .ZCSR"
   commentLine = num
   fndparm = """*/"""
   Address ISREDIT "SEEK" fndparm "FIRST"
   if rc = 0 then do
      Address ISREDIT "(NUM) = LINENUM .ZCSR"
      if num = commentLine then do
         rexx = "Y"
         pre = "/*"
         suf = "*/"
         Fill = "-"
      end
   end
end
/*-------------------------------------------------------------------*/
/*   Change the values for Startyear and LLC to reflect the year to  */
/*   be used as the start year for the copyright and the name of the */
/*   copyright holder. No other changes need be made as lengths are  */
/*   calculated from the variables,                                  */
/*-------------------------------------------------------------------*/
StartYear = '2017'
LLC = 'Copyright Abbydale Systems LLC.'
/*-------------------------------------------------------------------*/
if length(llc) > 60 then do
   mess = 'LLC length is too long. Must be < 60. Length is currently'
   say mess length(LLC)
   exit 8
end
say substr(date('s'),1,4,'0')                                   /*DTE*/
if StartYear > substr(date('s'),1,4,'0') then do                /*DTE*/
   say 'StartYear cannot be higher than current year'
   exit 12
end
if StartYear < 1961 then do
   say 'Oh come on get real! 1961 is the earliest start date allowed'
   exit 13
end
LLC = LLC Startyear '-' substr(date('s'),1,4,'0')               /*DTE*/
len1 = (71 - (length(LLC)+5))%2
len2 = 71 - (len1+(length(LLC)+5))
lineout =pre||copies(Fill,67)||suf
cpy =pre||copies(' ',len1)
cpy = cpy||'©'||LLC
cpy = cpy||copies(' ',len2)||suf
Address ISREDIT "LINE_AFTER" kef" ='"lineout"'"
Address ISREDIT "LINE_AFTER" kef+1" ='"cpy"'"
Address ISREDIT "LINE_AFTER" kef+2" ='"lineout"'"
Address ISREDIT "RESET"
address ISREDIT "DOWN" kef
exit
/*-------------------------------------------------------------------*/
/*                        Disp_Help Procedure                        */
/*-------------------------------------------------------------------*/
Disp_Help: Procedure
say "COPYRITE - This edit macro will add a copyright notice to a file"
say""
say"            The macro will automatically detect whether the file"
say"            being processed is a rexx file of not and the comments"
say"            modified accordingly. To change the copyright owner and"
say"            start year change the values defined within the macro"
say""
say "Usage: COPYRITE | ?"
say""
say"    ?        - Generates this information."
say""
say"   Return Codes :"
say"                 4 - Help displayed"
say"                 8 - LLC length error"
say"                12 - LLC length error"
say"                13 - LLC length error"
say"                16 - Not under ISPF"
say""
Return
/*-------------------------------------------------------------------*/
/*                    End of Disp_Help Procedure                     */
/*-------------------------------------------------------------------*/
/*-------------------------------------------------------------------*/
/*                      Trap NOVALUE Condition                       */
/*-------------------------------------------------------------------*/
novalue:
say "NOVALUE entered from line" sigl
say condition("D")
say "The instruction is suppressed"
address "TSO"
"delstack"
exit(16)
/*-------------------------------------------------------------------*/
/*                        Trap HALT Condition                        */
/*-------------------------------------------------------------------*/
halt:
say "HALT acknowledged in line" sigl
say "Cleanup processing in progress"
address "TSO"
"delstack"
exit(16)
/*-------------------------------------------------------------------*/
/*                          End of COPYRIT                           */
/*-------------------------------------------------------------------*/
./ ADD NAME=COPYTO
/* rexx */
/*-------------------------------------------------------------------*/
/*                                                                   */
/*                        REXX Exec : COPYTO                         */
/*                                                                   */
/*                      ***** Edit Macro *****                       */
/*                                                                   */
/*  Description : Copy current member to a different dataset. This   */
/*                can be very useful as it copies the member as it   */
/*                was immediately following the last save (or as it  */
/*                was before you started to edit).                   */
/*                                                                   */
/*  Created on : 10 Oct 2001                                         */
/*  Created by : Kevin Ferguson                                      */
/*             : Userid MIT001                                       */
/*             : using ABBYDALE.PROD.EMACS(COPYTO)                   */
/*                                                                   */
/*  Called by :                                                      */
/*                                                                   */
/*  Calls : checkdsn                                                 */
/*                                                                   */
/*  Panels Used : None                                               */
/*                                                                   */
/*  Change Activity :                                                */
/*                                                                   */
/*                ©Copyright of Abbydale Systems LLC.                */
/*                                                                   */
/*-------------------------------------------------------------------*/
ARG test
ADDRESS ISREDIT "MACRO (test) PROCESS"
ADDRESS ISREDIT "(DSNAME) = DATASET"
ADDRESS ISREDIT "(MEMBER) = MEMBER"
ADDRESS ISREDIT '(LASTLINE) = LINENUM .ZLAST'
dsn = ""
if test = "" then do
   do while dsn = ""
      Say 'Where to? (use QUIT or END to terminate)'
      parse upper pull dsn
      if dsn = 'QUIT' then exit
      if dsn = 'END' then exit
      checkdsn dsn
      if rc <> 0 then do
         if rc = 12 then do
            say "the dataset must already exist"
         end
         dsn = ""
      end
   end
end
else do
   do while dsn = ""
   checkdsn test
   if rc = 0 then do
      dsn = test
   end
   else do
      if rc = 12 then do
         say "the dataset must already exist"
      end
      Say 'Where to? (use QUIT or END to terminate)'
      parse upper pull test
      if test = 'QUIT' then exit
      if test = 'END' then exit
   end
   end
end
"ALLOC F(ASLIN01) DATASET('"dsname"("member")') shr reus"
"EXECIO * DISKR ASLIN01 (STEM LINE. FINIS"
"FREE F(ASLIN01)"
"ALLOC F(ASLOUT1) DATASET('"dsn"("member")') shr reus"
"EXECIO * DISKW ASLOUT1 (STEM LINE. FINIS"
"FREE F(ASLOUT1)"
ZEDSMSG = "Copied"
ZEDLMSG = "Member "member "copied to "newname
ZDLMSG = "Member copied"
Address ISPEXEC "VPUT (ZDLMSG ZDLMSG) SHARED"
address ISPEXEC "SETMSG MSG(ISRZ001)"
exit
/*-------------------------------------------------------------------*/
/*                           End of COPYTO                           */
/*-------------------------------------------------------------------*/
./ ADD NAME=DSNINFO
/* rexx */
/*-------------------------------------------------------------------*/
/*                                                                   */
/*                        REXX Exec : DSNINFO                        */
/*                                                                   */
/*  Description : Returns dataset information                        */
/*                                                                   */
/*  Created on : 05 AUG 2010                                         */
/*  Created by : Kevin Ferguson                                      */
/*             : Userid(MIT001)                                      */
/*             : using ABBYDALE.PROD.EMACS(DSNINFO)                  */
/*                                                                   */
/*  Called by :                                                      */
/*                                                                   */
/*  Calls : LISTDSI                                                  */
/*                                                                   */
/*  Change Activity :                                                */
/*                                                                   */
/*                ©Copyright of Abbydale Systems LLC.                */
/*                                                                   */
/*-------------------------------------------------------------------*/
ADDRESS ISREDIT "MACRO PROCESS"
ADDRESS ISREDIT "(DSNAME) = DATASET"
dsname = strip(dsname,b,"'")
kf = outtrap('on')
DSN_STATUS = LISTDSI(''''dsname'''' directory smsinfo)
kf = outtrap('off')
say 'Dataset information for 'dsname
say ' '
say 'Number of extents.... =' sysextents
say 'Volume Serial........ =' sysvolume
say 'Unit................. =' sysunit
say 'SMS Stoage class..... =' sysstorclass
say 'DSORG................ =' sysdsorg
say 'Record Format........ =' sysrecfm
say 'Record Length........ =' syslrecl
say 'Blocksize ........... =' sysblksize
say 'Keylength ........... =' syskeylen
say 'Allocation units..... =' sysunits
say 'Allocation Size...... =' sysalloc
say 'Primary Allocation... =' sysprimary
say 'Secondary Allocation. =' sysseconds
say 'Track per Cylinder... =' systrkscyl
say 'Blocks per Track..... =' sysblkstrk
say 'Space used........... =' sysused
test = substr(sysdsorg,1,2)
if test = "PO" then do
   say 'Directory Blocks..... =' sysadirblk
   say 'Used Directory Blocks =' sysudirblk
end
exit
/*-------------------------------------------------------------------*/
/*                          End of DSNINFO                           */
/*-------------------------------------------------------------------*/
./ ADD NAME=FIXPREP
/* rexx */
/*-------------------------------------------------------------------*/
/*                                                                   */
/*                        REXX Exec : FIXPREP                        */
/*                                                                   */
/*                      ***** Edit Macro *****                       */
/*                                                                   */
/*  Description : Apply fix to ISPPREPA Panel to save input and      */
/*                output datasets.                                   */
/*                                                                   */
/*  Created on : 11 Sep 2023                                         */
/*  Created by : Wendy Miller                                        */
/*             : Userid MIT002                                       */
/*             : Using ABBYDALE.DEVL.EMACS(FIXPREP)                  */
/*                                                                   */
/*  Called by : Nothing                                              */
/*                                                                   */
/*  Calls :                                                          */
/*                                                                   */
/*  Panels Used : ISPPREPA changed by this macro                     */
/*                                                                   */
/*  Change Activity :                                                */
/*                                                                   */
/*                ©Copyright of Abbydale Systems LLC.                */
/*                                                                   */
/*-------------------------------------------------------------------*/
Parse Arg Help         /* Check for Help */
If SYSVAR("SYSISPF")<>"ACTIVE" then do
   Say "ISPF must be active to use "FIXPREP
   exit(16)
end
Address ISREDIT "MACRO NOPROCESS"
Address ISREDIT "(mac) = MACRO_LEVEL"
if mac = "MAC" then do
   ZEDSMSG = 'Not run'
   ZEDLMSG = 'This is an edit macro. Invalid call'
   Address ISPEXEC "SETMSG MSG(ISRZ001)"
   exit(16)
end
indsn = "ZPREPIN"
outdsn = "ZPREPOUT"
"ISREDIT FIND 'ZWINTTL' FIRST"    /* look for the string */
If rc = 0 then do
   Address ISREDIT "(CR, CC) = CURSOR"
   Address ISREDIT "(Tri) = LINE" cr
   if pos("ISPPREP",tri) > 0 then do
      Address ISREDIT "(CR, CC) = CURSOR"
      Address ISREDIT "(temp) = LINE" cr+1
      if pos("VGET",temp) <> 0 then do
         ZEDSMSG = 'Fix already on'
         ZEDLMSG = 'Fix has already been applied. Return code 16'
         Address ISPEXEC "SETMSG MSG(ISRZ001)"
         exit(16)
      end
      else do
         gets = '"VGET ('indsn outdsn') PROFILE"'
         puts = '"VPUT ('indsn outdsn') PROFILE"'
         Address ISREDIT "LINE_AFTER" cr "=" gets
         Address ISREDIT "RESET FIND"
         "ISREDIT FIND ')END' FIRST"
         Address ISREDIT "(CR, CC) = CURSOR"
         If rc = 0 then do
            Address ISREDIT "LINE_BEFORE" cr "=" puts
            ZEDSMSG = 'Fix applied'
            ZEDLMSG = 'The fix was successfully applied'
            Address ISPEXEC "SETMSG MSG(ISRZ001)"
            exit(0)
         end
      end
   end
end
ZEDSMSG = 'Not PREP panel'
ZEDLMSG = 'The panel is not ISPPREPA. Return code 8'
Address ISPEXEC "SETMSG MSG(ISRZ001)"
Address ISREDIT "RESET FIND"
exit(8)
/*-------------------------------------------------------------------*/
/*                          End of FIXPREP                           */
/*-------------------------------------------------------------------*/
./ ADD NAME=INDEXIT
/* rexx */
/*-------------------------------------------------------------------*/
/*                                                                   */
/*                        REXX Exec : INDEXIT                        */
/*                                                                   */
/*                      ***** Edit Macro *****                       */
/*                                                                   */
/*  Description : Builds an Index Member in current Dataset          */
/*                                                                   */
/*  Created on : 07 Aug 2007                                         */
/*  Created by : Kevin Ferguson                                      */
/*             : Userid MIT001                                       */
/*             : using ABBYDALE.PROD.EMACS(INDEXIT)                  */
/*                                                                   */
/*  Called by :                                                      */
/*                                                                   */
/*  Calls : CHECKDSN, LM Utilities                                   */
/*                                                                   */
/*  Change Activity :                                                */
/*                                                                   */
/*                ©Copyright of Abbydale Systems LLC.                */
/*                                                                   */
/*-------------------------------------------------------------------*/
parse upper ARG test dx fred
Address ISREDIT "MACRO (test do) PROCESS"
Address ISREDIT "(mac)  = MACRO_LEVEL"
if mac = "MAC" then do
   dsname = test
   dsname = strip(dsname,b,"'")
   test = dx
   dx = fred
   lastline = 9
   if dsname = "" then do
      say 'Invalid call for INDEXXIT'
      say
      ZEDSMSG = 'Invalid call'
      ZEDLMSG = 'INDEXIT called incorrectly'
      ZDLMSG = 'Help displayed'
      Address ISPEXEC "VPUT (ZDLMSG ZDLMSG) SHARED"
      Address ISPEXEC "SETMSG MSG(ISRZ001)"
      Call disp_help
      exit(12)
   end
end
else do
Address ISREDIT "(DSNAME) = DATASET"
Address ISREDIT '(LASTLINE) = LINENUM .ZLAST'
end
mem = "$$$INDEX"
if test = "?" then do
   Call disp_help
   ZEDSMSG = 'Help displayed'
   ZEDLMSG = 'Help information was displayed'
   ZDLMSG = 'Help displayed'
   Address ISPEXEC "VPUT (ZDLMSG ZDLMSG) SHARED"
   Address ISPEXEC "SETMSG MSG(ISRZ001)"
   exit(4)
end
if test <> "" then do
   if length(test) < 9 then do
      mem = test
   end
else do
   ZEDSMSG = "Cancelled"
   ZEDLMSG = "Passed index name too long"
   ZDLMSG = "Action Cancelled"
   Address ISPEXEC "VPUT (ZDLMSG ZDLMSG) SHARED"
   Address ISPEXEC "SETMSG MSG(ISRZ001)"
   exit 8
end
end
upper mem
fulldsn = dsname||"("||mem||")"
checkdsn fulldsn
if rc = 0 then do
   ZEDSMSG = "Cancelled"
   ZEDLMSG = "Index name already exists"
   ZDLMSG = "Action Cancelled"
   Address ISPEXEC "VPUT (ZDLMSG ZDLMSG) SHARED"
   Address ISPEXEC "SETMSG MSG(ISRZ001)"
   exit 8
end
newstack
row = 1
if  lastline > 0 then
fill = '-'
tline = '-'
call putline
fill = ' '
tline = 'Directory list of 'dsname
call putline
fill = '-'
tline = '-'
call putline
fill = ' '
tline  = '  Member  | Description'
call putleft
fill = '-'
tline = '-'
call putline
fill = ' '
tline = ' '||left(mem,8,' ')' | This member.'
call putleft
fill = '-'
tline = '-'
call putline
if dx <> "NOMEM" then do
 Address ISPEXEC "LMINIT DATAID(RES) DATASET('"dsname"') ENQ(SHR)"
 Address ISPEXEC "LMOPEN DATAID("RES") OPTION(INPUT)"
 do while rc = 0
 Address ISPEXEC "LMMLIST  DATAID("RES") MEMBER(lst) OPTION(LIST),
         STATS(NO)"
 if rc = 0 then do
   fill = ' '
   tline = ' '||left(lst,8,' ')' |            '
   call putleft
   fill = '-'
   tline = '-'
   call putline
   end
 end
 Address ISPEXEC "LMCLOSE DATAID("RES")"
 Address ISPEXEC "LMFREE DATAID("RES")"
end
else do
 fill = ' '
 tline = '          |            '
 call putleft
 fill = '-'
 tline = '-'
 call putline
end
fill = ' '
tline = '©Copyright of Abbydale Systems LLC.'
call putline
fill = '-'
tline = '-'
call putline
row = row - 1
"ALLOC  F(ASLOUT01) DA('"fulldsn"') SHR REUS"
"EXECIO * DISKW ASLOUT01 (STEM Line. FINIS"
"FREE F(ASLOUT01)"
ZEDSMSG = 'Index created'
ZEDLMSG = 'Index member' mem 'successfully created'
ZDLMSG = 'Index created'
ZDLREF = 'Y'
Address ISPEXEC "VPUT (ZDLMSG ZDLMSG) SHARED"
Address ISPEXEC "SETMSG MSG(ISRZ001)"
exit
putline:
if substr(tline,1,1) = "©" then do
mline = '|'CENTER(tline,69,fill)'|'
end
else do
mline = '*'CENTER(tline,69,fill)'*'
end
Line.row = mline
row = row + 1
return
putleft:
mline = '|'LEFT(tline,69,fill)'|'
Line.row = mline
row = row + 1
return
/*-------------------------------------------------------------------*/
/*                      disp_help procedure                          */
/*-------------------------------------------------------------------*/
disp_help: procedure
say "INDEXIT - can be called as an edit macro or as a Rexx command"
say "          It will build an index member of all the members in the"
say "          dataset. By default the index member will be named"
say "          $$$INDEX"
say ""
say "Usage: INDEXIT indmemb NOMEM | ? "
say ""
say "    indmemb - (optional) The name to be used for the index member."
say "              If omitted the name $$$INDEX will be used."
say "    NOMEM   - (optional). If NOMEM is passed as a second"
say "              parameter then the index will NOT written the member"
say "              list to the indmemb member."
say "    ?       - generates this information."
say ""
say "    Return Codes : 0 - Dataset name is valid"
say "                   4 - Help displayed"
say "                  12 - Invalid call"
return
/*-------------------------------------------------------------------*/
/*                          End of INDEXIT                           */
/*-------------------------------------------------------------------*/
./ ADD NAME=JOBCARD
/* rexx */
/*-------------------------------------------------------------------*/
/*                                                                   */
/*                        REXX Exec : JOBCARD                        */
/*                                                                   */
/*                      ***** Edit Macro *****                       */
/*                                                                   */
/*  Description :  This ISPF EDIT macro will generate a jobcard at   */
/*               the top of a JCL stream. The two character job      */
/*               suffix can be passed on the call as can the job     */
/*               class. The suffix will be appended to the TSO userid*/
/*               of the user running the macro.                      */
/*                                                                   */
/*  Created on : 26 Mar 2018                                         */
/*  Created by : Kevin Ferguson                                      */
/*             : Userid MIT001                                       */
/*             : using ABBYDALE.XFER.EMACS(JOBCARD)                  */
/*                                                                   */
/*  Called by :                                                      */
/*                                                                   */
/*  Calls :                                                          */
/*                                                                   */
/*  Change Activity :                                                */
/*                                                                   */
/*                ©Copyright of Abbydale Systems LLC.                */
/*                                                                   */
/*-------------------------------------------------------------------*/
ADDRESS ISREDIT "MACRO (JN CLASS)"
if jn = "" then jn = "XX"           /* Change if required            */
if class = "" then class = "A"      /* Change if required            */
/*-------------------------------------------------------------------*/
/* Site variables follow                                             */
/*-------------------------------------------------------------------*/
account = '(ASL,'userid()',291108)' /* Change to your site accounts  */
comment = 'ABBYDALE'                /* Change if required            */
region = '3'                        /* Default region size           */
/*-------------------------------------------------------------------*/
/* End of site variables                                             */
/*-------------------------------------------------------------------*/
ADDRESS ISREDIT "(DSN) = DATASET"
ADDRESS ISREDIT "(MEM) = MEMBER"
Card1 = '//'USERID()jn' JOB 'account','comment','
Card2 = '//       CLASS='class',MSGLEVEL=(1,1),MSGCLASS=A,'
Card3 = '//       REGION='region'M,USERID='USERID()',NOTIFY='USERID()
Card4 = '//*                                                       '
Card5 = '//*   in dataset 'DSN'('MEM')'
Card6 = '//*                                                       '
Address ISREDIT "LINE_AFTER 0 ='"Card1"'"
Address ISREDIT "LINE_AFTER 1 ='"Card2"'"
Address ISREDIT "LINE_AFTER 2 ='"Card3"'"
Address ISREDIT "LINE_AFTER 3 ='"Card4"'"
Address ISREDIT "LINE_AFTER 4 ='"Card5"'"
Address ISREDIT "LINE_AFTER 5 ='"Card6"'"
exit
./ ADD NAME=ONLY
/* rexx */
/*-------------------------------------------------------------------*/
/*                                                                   */
/*                         REXX Exec : ONLY                          */
/*                                                                   */
/*                      ***** Edit Macro *****                       */
/*                                                                   */
/*  Description : The ONLY macro will display only lines containing  */
/*                the passed string.                                 */
/*                It is based on the ONLY CLIST that is contained in */
/*                in file 454 of the Share tape but it has been      */
/*                Rexxed.                                            */
/*                                                                   */
/*  Created on : 29 Mar 2018                                         */
/*  Created by : Kevin Ferguson                                      */
/*             : Userid MIT001                                       */
/*             : using ABBYDALE.XFER.EMACS(ONLY)                     */
/*                                                                   */
/*  Called by :                                                      */
/*                                                                   */
/*  Calls :                                                          */
/*                                                                   */
/*  Change Activity :                                                */
/*                                                                   */
/*                ©Copyright of Abbydale Systems LLC.                */
/*                                                                   */
/*-------------------------------------------------------------------*/
Address ISREDIT "MACRO (FNDPARM)"
signal on halt         /* attention key      */
if fndparm ="" then do
    zedsmsg = "No search string"
    zedlmsg = "NO Paramemter passed. Please retry"
    Address ISPEXEC "SETMSG MSG(ISRZ001)"
    rc = 8
    exit (rc)
end
Address ISREDIT "(RECFM) = RECFM"      /* Get record format      */
Address ISREDIT "(NUMMODE,NUMTYPE) = NUMBER"  /* Get NUM MODE INFO*/
sysdval = numtype           /* NUMBER RETURNS A STRING*/
Parse var sysdval STD COBOL DISPLAY /* PARSE NUMTYPE INTO ITS 3*/ .
If nummode="ON" then do
    If recfm = "V |" cobol="COBOL" then do
        ISREDIT "(LEFTON,RIGHTON) = BOUNDS"  /* NOTE THE CURRENT*/
        ISREDIT "NUMBER OFF"               /* THIS MAY CAUSE THE LEFT*/
        ISREDIT "(LEFTOFF,RIGHTOFF) = BOUNDS" /* NOTE WHERE THE BOUNDS*/
        If leftoff=1 then do
            lefton = /* BLANK THE VALUES TO BE*/
            righton = /* RESTORED TO CAUSE*/
            If recfm="V" then do
                ISREDIT "BOUNDS = 9 *"      /* OVERRIDE THE LEFT TO*/
               end
            else do
               If std="STD" then do
                ISREDIT "(LRECL) = LRECL"
                ISREDIT "BOUNDS = 7" eval(lrecl-8) /* OVERRIDE BOTH*/
                End
               Else do
                ISREDIT "BOUNDS = 7 *"    /* FOR NOSTD OVERRIDE ONLY*/
               End
            End
        End
    End
End
sysscan = 1             /* stop substitution of & in search string */
Address ISREDIT "SCAN OFF"
ISREDIT "SEEK" fndparm "FIRST"    /* seek the string */
If rc=0 then do
    ISREDIT "EXCLUDE ALL"         /* Hide the lines         */
    ISREDIT "FIND" fndparm "ALL"  /* Show line with string  */
    rc = 0
    End
  Else Do
    zedsmsg = "STRING NOT FOUND"
    sysscan = 2                    /* Rescan for &STR() for clists */
    zedlmsg = """"fndparm""" NOT FOUND IN THE ENTIRE FILE"
    Address ISPEXEC "SETMSG MSG(ISRZ001)"      /* Sound the alarm.*/
    rc = 12
    End
If nummode = "ON" & "("recfm = "V |" cobol="COBOL)"
  Then
    Do                              /* IF NUMBER WAS TURNED*/
    ISREDIT "NUMBER = (NUMMODE,NUMTYPE)" /* OFF, TURN IN BACK ON AND*/
    ISREDIT "BOUNDS =" lefton righton  /* RESTORE THE BOUNDS.*/
    End
Exit (rc)
Exit 0
eval: Procedure
  Return arg(1)
/*-------------------------------------------------------------------*/
/*                        Trap HALT Condition                        */
/*-------------------------------------------------------------------*/
halt:
say "HALT acknowledged in line" sigl
say "Cleanup processing in progress"
address "TSO"
"delstack"
exit(16)
/*-------------------------------------------------------------------*/
/*                            End of ONLY                            */
/*-------------------------------------------------------------------*/
./ ADD NAME=PRINTIT
/* rexx */
/*-------------------------------------------------------------------*/
/*                                                                   */
/*                        REXX Exec : PRINTIT                        */
/*                                                                   */
/*                      ***** Edit Macro *****                       */
/*                                                                   */
/*  Description : Prints a dataset                                   */
/*                                                                   */
/*  Created on : 01 May 2007                                         */
/*  Created by : Kevin Ferguson                                      */
/*             : Userid MIT001                                       */
/*             : Using ABBYDALE.DEVL.REXX(PRINTIT)                   */
/*                                                                   */
/*  Called by : Nothing                                              */
/*                                                                   */
/*  Calls : PRINTDS (IBM Supplied Program)                           */
/*                                                                   */
/*  Panels Used : None                                               */
/*                                                                   */
/*  Change Activity :                                                */
/*                                                                   */
/*                ©Copyright of Abbydale Systems LLC.                */
/*                                                                   */
/*-------------------------------------------------------------------*/
Parse Arg Help Class Copies        /* Check for Help */
If SYSVAR("SYSISPF")<>"ACTIVE" then do
   Say "ISPF must be active to use "PRINTIT
   exit(16)
end
Address ISREDIT "MACRO (Help Class Copies) PROCESS"
signal on novalue      /* un-initialized vars*/
signal on halt         /* attention key      */
If Help = "?" Then do
   Call Disp_Help
   ZEDSMSG = 'Help displayed'
   ZEDLMSG = 'Help information was displayed'
   ZDLMSG = 'Help displayed'
   Address ISPEXEC "VPUT (ZDLMSG ZDLMSG) SHARED"
   Address ISPEXEC "SETMSG MSG(ISRZ001)"
   exit(4)
end
if Help = '' then do
   Dest = 'LOCAL'          /* <=== Change to your default printer    */
/*                                 LOCAL will print the output to    */
/*                                 the LOCAL spool                   */
end
else do
   Dest = Help
end
/*********************************************************************/
/*                                                                   */
/*        Now we will set site defaults for any missing parms        */
/*                                                                   */
If Class = '' Then Class = 'A'    /* <=== Change to site default     */
If Copies = '' Then Copies = '1'  /* <=== Change to site default     */
/*                                                                   */
/*********************************************************************/
If translate(Copies,' ','1234567890') <> ' ' Then do
   ZEDSMSG = 'Copies Value Invalid'
   ZEDLMSG = 'Non-Numeric Value for copies'
   ZDLMSG = 'Non-Numeric'
   Address ISPEXEC "VPUT (ZDLMSG ZDLMSG) SHARED"
   Address ISPEXEC "SETMSG MSG(ISRZ001)"
   Exit(8)
end
If LENGTH(Class) > 1 then do
   ZEDSMSG = 'Invalid Class'
   ZEDLMSG = 'Invalid Class Specified' Class
   ZDLMSG = 'Invalid SYSOUT Class'
   Address ISPEXEC "VPUT (ZDLMSG ZDLMSG) SHARED"
   Address ISPEXEC "SETMSG MSG(ISRZ001)"
   Exit(8)
End
"ISREDIT (DSN) = DATASET "
"ISREDIT (MEM) = MEMBER "
if mem <> '' Then do
   DSNI = DSN'('MEM')'
end
else do
   DSNI = DSN
end
"PRINTDS DSN('"DSNI"') CLASS("CLASS") COPIES("copies") DEST("dest")"
ZEDSMSG = 'Dataset Printed'
ZEDLMSG = 'Dataset' DSNI 'sent to printer'
ZDLMSG = 'Print Successful'
Address ISPEXEC "VPUT (ZDLMSG ZDLMSG) SHARED"
Address ISPEXEC "SETMSG MSG(ISRZ001)"
/*
Say "'"DSNI"' Routing "copies" copies of print to" DEST "as class "Class
*/
return
/*-------------------------------------------------------------------*/
/*                        Disp_Help Procedure                        */
/*-------------------------------------------------------------------*/
Disp_Help: Procedure
say" PRINTIT - This Edit Macro will print the contents of the dataset"
say"           to a printer. By default the print out will be sent to"
say"           LOCAL as class A output and one copy only"
say""
say" Usage: PRINTIT dest Class Copies | ? "
say""
say"    ?        - Generates this information."
say"    Dest     - Is the print destination (If omitted LOCAL is used)"
say"    Class    - Is the output class to use. (Default is A)"
say"    Copies   - Is the number of copies to print. (Default is 1)"
say""
say"   Note: If you want to changed the output class then you MUST"
say"         specify the destination printer. Likewise if you want"
say"         more than one copy then you must specify both destination"
say"         printer and output class."
say" "
say"   Return Codes :"
say"                 4 - Help displayed"
say"                 8 - Class or Copies value invalid"
say"                16 - Not under ISPF"
say""
Return
/*-------------------------------------------------------------------*/
/*                    End of Disp_Help Procedure                     */
/*-------------------------------------------------------------------*/
/*-------------------------------------------------------------------*/
/*                      Trap NOVALUE Condition                       */
/*-------------------------------------------------------------------*/
novalue:
say "NOVALUE entered from line" sigl
say condition("D")
say "The instruction is suppressed"
address "TSO"
"delstack"
exit(16)
/*-------------------------------------------------------------------*/
/*                        Trap HALT Condition                        */
/*-------------------------------------------------------------------*/
halt:
say "HALT acknowledged in line" sigl
say "Cleanup processing in progress"
address "TSO"
"delstack"
exit(16)
/*-------------------------------------------------------------------*/
/*                          End of PRINTIT                           */
/*-------------------------------------------------------------------*/
./ ADD NAME=REXXIT
/* Rexx */
/*-------------------------------------------------------------------*/
/*                                                                   */
/*                         REXX Exec : REXXIT                        */
/*                                                                   */
/*                      ***** Edit Macro *****                       */
/*                                                                   */
/*  Description : Add a boilerplate and some standard 'traps' to     */
/*                a REXX exec. If the member being processed already */
/*                has a rexx definition then the boilerplate is      */
/*                inserted after it.                                 */
/*                                                                   */
/*                The macro will define a NOVALUE and HALT section   */
/*                in the member.                                     */
/*                                                                   */
/*  Created on : 22 Mar 2018                                         */
/*  Created by : Kevin Ferguson                                      */
/*             : Userid MIT001                                       */
/*             : Using ABBYDALE.DEVL.EMACS(REXXIT)                   */
/*                                                                   */
/*  Called by : Edit Macro                                           */
/*                                                                   */
/*  Calls :  USERNAME and indirectly PROPER                          */
/*                                                                   */
/*  Panels Used : None                                               */
/*                                                                   */
/*  Change Activity :                                                */
/*                                                                   */
/*  MM/DD/YYYY  ID   Comment                                         */
/*  ---------------------------------------------------------------  */
/*  05/16/2021  DSF  Added panels used information to the both the   */
/*                   macro and the boilerplate that ets created.     */
/*                                                                   */
/*  05/17/2021  RRR  Added ability to generate an Edit Macro         */
/*                   skeleton.                                       */
/*                                                                   */
/*  05/19/2021  ISP  Added disp_help procedure and check for ISPF    */
/*                                                                   */
/*  05/20/2021  USR  Removed name processing to external EXEC        */
/*                                                                   */
/*  06/26/2021  ---  Removed duplicate novalue label                 */
/*                                                                   */
/*  07/22/2023  EXC  Added exec name variable in case of alias use   */
/*                                                                   */
/*                ©Copyright of Abbydale Systems LLC.                */
/*                                                                   */
/*-------------------------------------------------------------------*/
parse upper ARG EMAC                                            /*RRR*/
If SYSVAR('SYSISPF')<>'ACTIVE' then do                          /*ISP*/
   Say 'ISPF must be running to use this exec'                  /*ISP*/
   exit(16)                                                     /*ISP*/
end                                                             /*ISP*/
ADDRESS ISREDIT "MACRO (EMAC) PROCESS"                          /*RRR*/
ADDRESS ISREDIT "(DSNAME) = DATASET"
ADDRESS ISREDIT "(MEMBER) = MEMBER"
ADDRESS ISREDIT '(LASTLINE) = LINENUM .ZLAST'
if  lastline > 0 then
ADDRESS ISREDIT "(LINE) = LINE 1"
address ISredit "Profile unlock"
address ISredit "HILITE REXX"
address ISredit "Profile lock"
ADDRESS ISREDIT "RESET"
uline = translate(LINE)
rexx = 'N'
If INDEX(uline,'REXX') > 0 then do
    ZEDSMSG = 'Already Rexx'
    ZEDLMSG = 'Member' member 'will only have the boiler plate added'
    ADDRESS ISPEXEC "SETMSG MSG(ISRZ000)"
    rexx = 'Y'
/*  exit (0) */
 end
s = USERID()
/*ascb = storage(224,4)                              psaaold      USR*/
/*asxb = storage(d2x(c2d(ascb)+108),4)               ascbasxb     USR*/
/*acee = storage(d2x(c2d(asxb)+200),4)               acee         USR*/
/*unam = storage(d2x(c2d(acee)+100),4)               aceeunam     USR*/
/*name=strip(storage(d2x(c2d(unam)+1),24))           Get name     USR*/
username xname                                                  /*USR*/
parse pull xname                                                /*USR*/
name = Strip(xname,b,'"')                                       /*USR*/
row = 0
if rexx = 'N' then do
   Address ISREDIT "LINE_AFTER "row "= '/* rexx */'"
end
   row = row + 1
fill = '-'
tline = '-'
call putline
fill = ' '
tline = ' '
call putline
tline = 'REXX Exec : 'member
call putline
if EMAC <> "" then do                                           /*RRR*/
   fill = ' '                                                   /*RRR*/
   tline = ' '                                                  /*RRR*/
   call putline                                                 /*RRR*/
   tline = '***** Edit Macro *****'                             /*RRR*/
   call putline                                                 /*RRR*/
end                                                             /*RRR*/
tline = ' '
call putline
tline = 'Description :'
call putleft
tline = ' '
call putline
tline = 'Created on : 'date()
call putleft
tline = 'Created by : 'name
call putleft
tline = '           : Userid 's
call putleft
tline = '           : Using' dsname'('member')'
call putleft
tline = ' '
call putline
tline = 'Called by :'
call putleft
tline = ' '
call putline
tline = 'Calls :'
call putleft
tline = ' '                                                     /*DSF*/
call putline                                                    /*DSF*/
tline = ' '                                                     /*DSF*/
tline = 'Panels Used :'                                         /*DSF*/
call putleft                                                    /*DSF*/
tline = ' '                                                     /*DSF*/
call putline                                                    /*DSF*/
tline = 'Change Activity :'
call putleft
tline = ' '
call putline
tline = '©Copyright of Abbydale Systems LLC.'
call putline
tline = ' '
call putline
fill = '-'
tline = '-'
call putline
mline = 'Parse Arg Help         /* Check for Help */'           /*ISP*/
call putcode                                                    /*ISP*/
mline = 'dialogid = sysvar(sysicmd)'                            /*EXC*/
call putcode                                                    /*EXC*/
mline = 'parse source Exec_String '                             /*EXC*/
call putcode                                                    /*EXC*/
mline = 'excnme = word(Exec_String,3)'                          /*EXC*/
call putcode                                                    /*EXC*/
mline = 'If SYSVAR("SYSISPF")<>"ACTIVE" then do'                /*ISP*/
call putcode                                                    /*ISP*/
mline = '   Say "ISPF must be active to use "'member            /*ISP*/
call putcode                                                    /*ISP*/
mline = '   exit(16)'                                           /*ISP*/
call putcode                                                    /*ISP*/
mline = 'end'                                                   /*ISP*/
call putcode                                                    /*ISP*/
if EMAC <> "" then do                                           /*RRR*/
   mline = 'Address ISREDIT "MACRO (Help) PROCESS"'         /*ISP RRR*/
   call putcode                                                 /*RRR*/
end                                                             /*RRR*/
mline = 'If Help = "?" Then do'                                 /*ISP*/
call putcode                                                    /*ISP*/
mline = '   Call Disp_Help'                                     /*ISP*/
call putcode                                                    /*ISP*/
mline = '   exit(4)'                                            /*ISP*/
call putcode                                                    /*ISP*/
mline = 'end'                                                   /*ISP*/
call putcode                                                    /*ISP*/
mline = 'signal on novalue      /* un-initialized vars*/ '
call putcode
mline = 'signal on halt         /* attention key      */ '
call putcode
mline = 'return'                                                /*ISP*/
call putcode                                                    /*ISP*/
ADDRESS ISREDIT '(LASTLINE) = LINENUM .ZLAST'
row = lastline
fill = '-'                                                      /*ISP*/
tline = '-'                                                     /*ISP*/
call putline                                                    /*ISP*/
fill = ' '                                                      /*ISP*/
tline = 'Disp_Help Procedure'                                   /*ISP*/
call putline                                                    /*ISP*/
fill = '-'                                                      /*ISP*/
tline = '-'                                                     /*ISP*/
call putline                                                    /*ISP*/
fill = ' '                                                      /*ISP*/
mline = 'Disp_Help: Procedure EXPOSE excnme'              /* ISP EXC */
call putcode                                                    /*ISP*/
mline = '$nam2$ = RIGHT($nam2$,8," ")'                          /*EXC*/
call putcode                                                    /*EXC*/
mline = 'say "$name$ -"'                                  /* ISP EXC */
call putcode                                                    /*ISP*/
mline = 'say""'                                                 /*ISP*/
call putcode                                                    /*ISP*/
mline = 'say "Usage: $name$  xxxxx | ?"'                  /* ISP EXC */
call putcode                                                    /*ISP*/
mline = 'say""'                                                 /*ISP*/
call putcode                                                    /*ISP*/
mline = 'say"    ?        - Generates this information."'       /*ISP*/
call putcode                                                    /*ISP*/
mline = 'say""'                                                 /*ISP*/
call putcode                                                    /*ISP*/
mline = 'say"   Return Codes :"'                                /*ISP*/
call putcode                                                    /*ISP*/
mline = 'say"                 4 - Help displayed"'              /*ISP*/
call putcode                                                    /*ISP*/
mline = 'say"                16 - Not under ISPF"'              /*ISP*/
call putcode                                                    /*ISP*/
mline = 'say""'                                                 /*ISP*/
call putcode                                                    /*ISP*/
mline = 'Return'                                                /*ISP*/
call putcode                                                    /*ISP*/
fill = '-'                                                      /*ISP*/
tline = '-'                                                     /*ISP*/
call putline                                                    /*ISP*/
fill = ' '                                                      /*ISP*/
tline = 'End of Disp_Help Procedure'                            /*ISP*/
call putline                                                    /*ISP*/
fill = '-'                                                      /*ISP*/
tline = '-'                                                     /*ISP*/
call putline                                                    /*ISP*/
tline = '-'
call putline
fill = ' '
tline = 'Trap NOVALUE Condition'
call putline
fill = '-'
tline = '-'
call putline
fill = ' '
mline = 'novalue:'
call putcode
mline = 'say "NOVALUE entered from line" sigl'
call putcode
mline = 'say condition("D")'
call putcode
mline = 'say "The instruction is suppressed"'
call putcode
mline = 'address "TSO"'
call putcode
mline = '"delstack"'
call putcode
mline = 'exit(16)'
call putcode
fill = '-'
tline = '-'
call putline
fill = ' '
tline = 'Trap HALT Condition'
call putline
fill = '-'
tline = '-'
call putline
fill = ' '
mline = 'halt:'
call putcode
mline = 'say "HALT acknowledged in line" sigl '
call putcode
mline = 'say "Cleanup processing in progress"'
call putcode
mline = 'address "TSO"'
call putcode
mline = '"delstack"'
call putcode
mline = 'exit(16)'
call putcode
fill = '-'
tline = '-'
call putline
fill = ' '
tline = 'End of 'member
call putline
fill = '-'
tline = '-'
call putline
Address ISREDIT 'CHANGE ALL $name$ ""excnme ""'                 /*EXC*/
Address ISREDIT 'CHANGE ALL $nam2$ "excnme"'                    /*EXC*/
Address TSO "ISREDIT RESET"                                     /*EXC*/
exit
putline:
mline = '/*'CENTER(tline,67,fill)'*/'
Address ISREDIT "LINE_AFTER "row "= '"mline"'"
row = row + 1
return
putleft:
mline = '/*  'LEFT(tline,65,fill)'*/'
putcode:
Address ISREDIT "LINE_AFTER "row "= '"mline"'"
row = row + 1
return
/*-------------------------------------------------------------------*/
/*                           End of REXXIT                           */
/*-------------------------------------------------------------------*/
./ ADD NAME=RUNJCL
/* rexx */
/*-------------------------------------------------------------------*/
/*                                                                   */
/*                        REXX Exec : RUNJCL                         */
/*                                                                   */
/*                      ***** Edit Macro *****                       */
/*                                                                   */
/*  Description :                                                    */
/*                                                                   */
/*  Created on : 16 Apr 2018                                         */
/*  Created by : Kevin Ferguson                                      */
/*             : Userid MIT001                                       */
/*             : using ABBYDALE.PROD.EMACS(RUNJCL)                   */
/*                                                                   */
/*  Called by :                                                      */
/*                                                                   */
/*  Calls : FINDIT                                                   */
/*                                                                   */
/*  Panels Used : ASLRUN01                                           */
/*                                                                   */
/*  Change Activity :                                                */
/*                                                                   */
/*                ©Copyright of Abbydale Systems LLC.                */
/*                                                                   */
/*-------------------------------------------------------------------*/
signal on halt         /* attention key      */
ARG mem edit
IF mem='' THEN DO
  ADDRESS ISREDIT
"ISREDIT MACRO (mem edit) PROCESS"
"ISREDIT (MEMBER) = MEMBER"
end
upper mem edit
if mem = '' then mem = member
if POS('.',mem) > 0 then do
   if pos('(',mem) > 0 then do
      rundsn = SUBSTR(mem,1,POS('(',mem)-1)
      mem = SUBSTR(mem,POS('(',mem)+1,(POS(')',mem)-POS('(',mem)-1))
      mem = SUBSTR(mem,POS('(',mem)+1,LENGTH(mem)-POS(')',mem))
   end
end
else do
   ADDRESS ISPEXEC  "VGET RUNDSN PROFILE"
   IF rc > 0 THEN mem = '/'
   if rundsn = '' then mem = '/'
   if mem = '/' then do
      findit bslrun01 ispplib
      IF rc > 0 THEN DO
 say 'Enter the Dataset name from which the member is to be submitted'
   pull rundsn
   say "Enter member name to be submitted"
   pull mem
   end
   else do
   mem =
   ADDRESS ISPEXEC "DISPLAY PANEL(ASLRUN01)"
             if mem = '' then do
                ADDRESS ISPEXEC  "VPUT RUNDSN PROFILE"
                exit
             end
   end
   end
ADDRESS ISPEXEC  "VPUT RUNDSN PROFILE"
end
rundsn = STRIP(rundsn,'b',"'")   /* remove any quote */
If edit = "EDIT" then do
address ISPEXEC "EDIT DATASET('"rundsn"("mem")')"
   if rc <> 0 then exit
end
Z = OUTTRAP(LIST.)
ADDRESS TSO "SUBMIT '"rundsn"("MEM")' NOJOBCHAR"
do z = 1 to list.0
say list.z
end
EXIT
/*-------------------------------------------------------------------*/
/*                        Trap HALT Condition                        */
/*-------------------------------------------------------------------*/
halt:
say "HALT acknowledged in line" sigl
say "Cleanup processing in progress"
address "TSO"
"delstack"
exit(16)
/*-------------------------------------------------------------------*/
/*                           End of RUNJCL                           */
/*-------------------------------------------------------------------*/
./ ADD NAME=SETLANG
/* rexx */
/*-------------------------------------------------------------------*/
/*                                                                   */
/*                        REXX Exec : SETLANG                        */
/*                                                                   */
/*                      ***** Edit Macro *****                       */
/*                                                                   */
/*  Description : Set highlighting depending on the language that    */
/*                is detected                                        */
/*                                                                   */
/*  Created on : 23 May 2016                                         */
/*  Created by : Kevin Ferguson                                      */
/*             : Userid MIT001                                       */
/*             : Using ABBYDALE.PROD.EMACS(SETLANG)                  */
/*                                                                   */
/*  Called by : Edit Macro                                           */
/*                                                                   */
/*  Calls : Nothing                                                  */
/*                                                                   */
/*  Panels Used : None                                               */
/*                                                                   */
/*  Change Activity :                                                */
/*                                                                   */
/*                ©Copyright of Abbydale Systems LLC.                */
/*                                                                   */
/*-------------------------------------------------------------------*/
"ISREDIT MACRO PROCESS"
"ISREDIT SCAN OFF"
lang = "ON AUTO"
"ISREDIT SEEK 'Identification Division' FIRST"
If rc  = 0 then do
   "ISREDIT SEEK 'Environment Division' FIRST"
   If rc  = 0 then do
      "ISREDIT SEEK 'Data Division' FIRST"
      If rc  = 0 then do
        "ISREDIT SEEK 'Procedure Division' FIRST"
        If rc  = 0 then do
           lang = "ON COBOL"
           signal DoIt
        end
      end
   end
end
"ISREDIT SEEK '/*' FIRST"    /* look for the string */
If rc  = 0 then do
   "ISREDIT (NUM1) = LINENUM .ZCSR"
   "ISREDIT SEEK '*/' FIRST"    /* look for the string */
   If rc  = 0 then do
      "ISREDIT (NUM2) = LINENUM .ZCSR"
      "ISREDIT SEEK 'rexx' FIRST"    /* look for the string */
      If rc = 0 then do
         "ISREDIT (NUM3) = LINENUM .ZCSR"
         lang = "LOGIC REXX"
      end
   end
end
else do
   "ISREDIT SEEK ' LA ' FIRST 2 66"    /* look for the string */
   If rc = 0 then do
      "ISREDIT SEEK ' LTR ' FIRST 2 66"    /* look for the string */
      If  rc = 0 then do
         lang = "ON ASM"
         signal DoIt
      end
   end
end
"ISREDIT SEEK ')ATTR'  FIRST 1 5"    /* look for the string */
if rc = 0 then do
   "ISREDIT SEEK ')BODY'  FIRST 1 5"    /* look for the string */
   If rc = 0 then do
      lang = "ON PANEL"
      signal DoIt
   end
end
"ISREDIT SEEK '//'  FIRST 1 2"    /* look for the string */
if rc = 0 then do
   "ISREDIT SEEK ' EXEC '  FIRST 3 66"    /* look for the string */
   If rc = 0 then do
      lang = "ON JCL"
      signal DoIt
   end
end
"ISREDIT SEEK '#endif' FIRST"     /* look for the string */
if rc = 0 then do
   "ISREDIT SEEK '#define' FIRST"    /* look for the string */
   If rc = 0 then do
      lang = "ON C"
      signal DoIt
   end
end
DoIt:
"ISREDIT Profile unlock"
"ISREDIT HILITE "lang
"ISREDIT Profile lock"
"ISREDIT RESET"
"ISREDIT CURSOR=1 1"
exit
/*-------------------------------------------------------------------*/
/*                           End of SETLANG                          */
/*-------------------------------------------------------------------*/
./ ADD NAME=STARTASM
/*-------------------------------------------------------------------*/
/*                                                                   */
/*                         REXX Exec :STARTASM                       */
/*                                                                   */
/*                      ***** Edit Macro *****                       */
/*                                                                   */
/*  Description : Create a skeleton Assembler Program                */
/*                                                                   */
/*  Created on : 22 Mar 2018                                         */
/*  Created by : Kevin Ferguson                                      */
/*             : Userid MIT001                                       */
/*             : Using ABBYDALE.DEVL.REXX(STARTASM)                  */
/*                                                                   */
/*  Called by : Edit Macro                                           */
/*                                                                   */
/*  Calls :  Nothing                                                 */
/*                                                                   */
/*  Change Activity :                                                */
/*                                                                   */
/*                ©Copyright of Abbydale Systems LLC.                */
/*                                                                   */
/*-------------------------------------------------------------------*/
ADDRESS ISREDIT "MACRO"
ADDRESS ISREDIT "(DSNAME) = DATASET"
ADDRESS ISREDIT "(MEMBER) = MEMBER"
ADDRESS ISREDIT '(LASTLINE) = LINENUM .ZLAST'
if  lastline > 0 then
ADDRESS ISREDIT "(LINE) = LINE 1"
address ISredit "Profile unlock"
address ISredit "HILITE ASM"
address ISredit "Profile lock"
ADDRESS ISREDIT "RESET"
uline = translate(LINE)
s = USERID()
ascb = storage(224,4)                             /* psaaold  */
asxb = storage(d2x(c2d(ascb)+108),4)              /* ascbasxb */
acee = storage(d2x(c2d(asxb)+200),4)              /* acee     */
unam = storage(d2x(c2d(acee)+100),4)              /* aceeunam */
name=strip(storage(d2x(c2d(unam)+1),20))          /* Get name */
row = 0
mem = left(member,8,' ')
mline = '         PRINT NOGEN'
call putcode
mline = mem 'START 0'
call putcode
mline = mem 'AMODE 31'
call putcode
mline = mem 'RMODE ANY'
call putcode
mline = '         COPY ASLEQUC              Register equates'
call putcode
mline = '         IEFJSSIB'
call putcode
mline = '         IEFSSOBH'
call putcode
mline = mem 'TITLE ''Your Title - Copyright Abbydale Systems LLC'''
call putcode
mline = '         ASLDATA DATA=YES,LIST=YES,INFO=YES'
call putcode
fill = '-'
tline = '-'
call putline
fill = ' '
tline = member
call putline
fill = '-'
tline = '-'
call putline
fill = ' '
tline = ' '
call putline
tline = 'Description :'
call putleft
tline = ' '
call putline
tline = 'Created on : 'date()
call putleft
tline = 'Created by : 'name
call putleft
tline = '           : Userid('s')'
call putleft
tline = '           : Using' dsname'('member')'
call putleft
tline = ' '
call putline
tline = 'Called by :'
call putleft
tline = ' '
call putline
tline = 'Calls :'
call putleft
tline = ' '
call putline
tline = 'Change Activity :'
call putleft
tline = ' '
call putline
fill = '-'
tline = '-'
call putline
fill = ' '
tline = '©Copyright of Abbydale Systems LLC.'
call putline
fill = '-'
tline = '-'
call putline
mline = mem 'BEGIN R12,VER=1.0'
call putcode
mline = '         EOJ   C=(R15)             Return to caller'
call putcode
ADDRESS ISREDIT '(LASTLINE) = LINENUM .ZLAST'
row = lastline
tline = '-'
call putline
fill = ' '
tline = 'End of 'member
call putline
fill = '-'
tline = '-'
call putline
mline = '         LTORG'
call putcode
mline = '         END' member
call putcode
mline = '         PUNCH '' MODE AMODE(31)''   BINDER AMODE STATEMENT.'
call putcode
mline = '         PUNCH '' MODE RMODE(ANY)''  BINDER RMODE STATEMENT.'
call putcode
mline = '         PUNCH '' ENTRY 'member'''     MODULE ENTRY POINT.'
call putcode
mline = '         PUNCH '' NAME  'member'(R)''   MODULE NAME.'
call putcode
mline = '         END'
call putcode
exit
putline:
mline = '*'CENTER(tline,69,fill)'*'
Address ISREDIT "LINE_AFTER "row "= '"mline"'"
row = row + 1
return
putleft:
mline = '*  'LEFT(tline,67,fill)'*'
putcode:
Address ISREDIT "LINE_AFTER "row "= DATALINE (mline)"
row = row + 1
return
/*-------------------------------------------------------------------*/
/*                           End of STARTASM                         */
/*-------------------------------------------------------------------*/
./ ADD NAME=STARTCOB
/*-------------------------------------------------------------------*/
/*                                                                   */
/*                       REXX Exec : STARTCOB                        */
/*                                                                   */
/*                      ***** Edit Macro *****                       */
/*                                                                   */
/*  Description : Create a skeleton Cobol Program                    */
/*                                                                   */
/*  Created on : 22 Mar 2018                                         */
/*  Created by : Kevin Ferguson                                      */
/*             : Userid MIT001                                       */
/*             : Using ABBYDALE.DEVL.REXX(STARTCOB)                  */
/*                                                                   */
/*  Called by : Edit Macro                                           */
/*                                                                   */
/*  Calls :  Nothing                                                 */
/*                                                                   */
/*  Change Activity :                                                */
/*                                                                   */
/*                ©Copyright of Abbydale Systems LLC.                */
/*                                                                   */
/*-------------------------------------------------------------------*/
ADDRESS ISREDIT "MACRO"
ADDRESS ISREDIT "(DSNAME) = DATASET"
ADDRESS ISREDIT "(MEMBER) = MEMBER"
ADDRESS ISREDIT '(LASTLINE) = LINENUM .ZLAST'
if  lastline > 0 then
ADDRESS ISREDIT "(LINE) = LINE 1"
address ISredit "Profile unlock"
address ISredit "HILITE COB"
address ISredit "Profile lock"
ADDRESS ISREDIT "RESET"
uline = translate(LINE)
s = USERID()
ascb = storage(224,4)                             /* psaaold  */
asxb = storage(d2x(c2d(ascb)+108),4)              /* ascbasxb */
acee = storage(d2x(c2d(asxb)+200),4)              /* acee     */
unam = storage(d2x(c2d(acee)+100),4)              /* aceeunam */
name=strip(storage(d2x(c2d(unam)+1),20))          /* Get name */
row = 0
mem = left(member,8,' ')'.'
fill = '-'
mline = '      *'
call putline
fill = ' '
mline = '       IDENTIFICATION DIVISION.'
call putcode
fill = '-'
mline = '      *'
call putline
mline = '       PROGRAM-ID. 'mem
call putcode
fill = '-'
mline = '      *'
call putline
fill = ' '
mline = '      *'
call putline
mline = '      * Description :'
fill = ' '
call putline
fill = ' '
mline = '      *'
call putline
mline = '      * Created on : 'date()
call putline
mline = '      * Created by : 'name
call putline
mline = '      *            : Userid('s')'
call putline
mline = '      *            : Using' dsname'('member')'
call putline
fill = ' '
mline = '      *'
call putline
mline = '      * Called by :'
call putline
fill = ' '
mline = '      *'
call putline
mline = '      * Calls :'
call putline
fill = ' '
mline = '      *'
call putline
mline = '      * Change Activity :'
call putline
fill = ' '
mline = '      *'
call putline
fill = '-'
mline = '      *'
call putline
fill = ' '
mline = '      *             ©Copyright of Abbydale Systems LLC.'
call putline
fill = '-'
mline = '      *'
call putline
fill = ' '
mline = '       ENVIRONMENT DIVISION.'
call putcode
fill = '-'
mline = '      *'
call putline
mline = '       INPUT-OUTPUT SECTION.'
call putcode
fill = '-'
mline = '      *'
call putline
mline = '       DATA DIVISION.'
call putcode
fill = '-'
mline = '      *'
call putline
mline = '       WORKING-STORAGE SECTION.'
call putcode
fill = '-'
mline = '      *'
call putline
mline = '       LINKAGE SECTION.'
call putcode
fill = '-'
mline = '      *'
call putline
mline = '       PROCEDURE DIVISION.'
call putcode
fill = '-'
mline = '      *'
call putline
mline = '       A-MAIN SECTION.'
call putcode
fill = '-'
mline = '      *'
call putline
mline = '           STOP RUN.'
call putcode
ADDRESS ISREDIT '(LASTLINE) = LINENUM .ZLAST'
row = lastline
fill = '-'
mline = '      *'
call putline
fill = ' '
mline = '      *           End of 'member
call putline
fill = '-'
mline = '      *'
call putline
exit
putline:
mline = Left(mline,67,fill)'*'
Address ISREDIT "LINE_AFTER "row "= '"mline"'"
row = row + 1
return
putleft:
mline = '*  'LEFT(tline,64,fill)'*'
putcode:
Address ISREDIT "LINE_AFTER "row "= '"mline"'"
row = row + 1
return
/*-------------------------------------------------------------------*/
/*                           End of STARTCOB                         */
/*-------------------------------------------------------------------*/
./ ADD NAME=STARTMAC
/* rexx */
/*-------------------------------------------------------------------*/
/*                                                                   */
/*                       REXX Exec : STARTMAC                        */
/*                                                                   */
/*                      ***** Edit Macro *****                       */
/*                                                                   */
/*  Description : Build a boilerplate for an assembler DSECT         */
/*                                                                   */
/*  Created on : 30 Mar 2022                                         */
/*  Created by : Wendy Miller                                        */
/*             : Userid MIT002                                       */
/*             : Using ABBYDALE.DEVL.REXX(STARTMAC)                  */
/*                                                                   */
/*  Called by : ** Edit Macro **                                     */
/*                                                                   */
/*  Calls : Nothing                                                  */
/*                                                                   */
/*  Panels Used : None                                               */
/*                                                                   */
/*  Change Activity :                                                */
/*                                                                   */
/*                ©Copyright of Abbydale Systems LLC.                */
/*                                                                   */
/*-------------------------------------------------------------------*/
Parse Arg Help         /* Check for Help */
If SYSVAR("SYSISPF")<>"ACTIVE" then do
   Say "ISPF must be active to use "STARTMAC
   exit(16)
end
Address ISREDIT "MACRO (Help) PROCESS"
If Help = "?" Then do
   Call Disp_Help
   exit(4)
end
Address ISREDIT "(MEMBER) = MEMBER"
Address ISREDIT "Profile unlock"
Address ISREDIT '(LASTLINE) = LINENUM .ZLAST'
if  lastline > 0 then do
   Address ISREDIT "(LINE) = LINE 1"
end
Address ISREDIT "HILITE ASM"
Address ISREDIT "Profile lock"
Address ISREDIT "CAPS OFF"
Address ISREDIT "RESET"
uline = translate(LINE)
s = userid()
ascb = storage(224,4)                             /* psaaold  */
asxb = storage(d2x(c2d(ascb)+108),4)              /* ascbasxb */
acee = storage(d2x(c2d(asxb)+200),4)              /* acee     */
unam = storage(d2x(c2d(acee)+100),4)              /* aceeunam */
name=strip(storage(d2x(c2d(unam)+1),20))          /* Get name */
row = 0
padmem = ""
xmem = ""
exitmem = "END OF "||member
do i = 1 to length(member)
   padmem = padmem||substr(member,i,1)||' '
end
do i = 1 to length(exitmem)
   xmem = xmem||substr(exitmem,i,1)||' '
end
mem = left(member,8,' ')
mline = mem 'DSECT'
call putcode
tline = '-'
fill = '-'
call putline
fill = ' '
tline = padmem
call putline
tline = '-'
fill = '-'
call putline
tline = ' '
fill = ' '
call putline
tline = 'Description :'
call putleft
tline = ' '
call putline
tline = 'Created on : 'date()
call putleft
tline = 'Created by : 'name
call putleft
tline = '           : Userid('s')'
call putleft
tline = ' '
fill = ' '
call putline
tline = '  Used by :'
call putleft
tline = ' '
call putline
tline = '  Change Activity :'
call putleft
tline = ' '
fill = ' '
call putline
tline = '-'
fill = '-'
call putline
fill = ' '
tline = '©Copyright of Abbydale Systems LLC.'
call putline
fill = '-'
tline = '-'
call putline
mline = '         PUSH  PRINT'
call putcode
mline = '         PRINT ON'
call putcode
Address ISREDIT '(LASTLINE) = LINENUM .ZLAST'
row = lastline
mline = member||'_End    EQU *'
call putcode
mline = member||'_Length EQU '||member||'_End-'member
call putcode
mline = '         POP   PRINT'
call putcode
tline = '-'
fill = '-'
call putline
fill = ' '
tline = xmem
call putline
tline = '-'
fill = '-'
call putline
signal on novalue      /* un-initialized vars*/
signal on halt         /* attention key      */
return
putline:
mline = '*'CENTER(tline,69,fill)'*'
Address ISREDIT "LINE_AFTER "row "= '"mline"'"
row = row + 1
return
putleft:
mline = '*  'LEFT(tline,67,fill)'*'
putcode:
Address ISREDIT "LINE_AFTER "row "= DATALINE (mline)"
row = row + 1
return
/*-------------------------------------------------------------------*/
/*                        Disp_Help Procedure                        */
/*-------------------------------------------------------------------*/
Disp_Help: Procedure
say "STARTMAC - This EDIT MACRO will add a boilerplate for an"
say "           assembler DSECT. If the member being edited has"
say "           data in it the boilerplate is wrapped around it."
say "           Your data will not be lost."
say""
say "           The DSECT will have the same name as the member being"
say "           edited. It will generate a length for DSECT by naming"
say "           an equate member_End and name the length value as"
say "           member_Length."
say""
say "Usage: STARTMAC | ?"
say""
say"    ?        - Generates this information."
say""
say"   Return Codes :"
say"                 4 - Help displayed"
say"                16 - Not under ISPF"
say""
Return
/*-------------------------------------------------------------------*/
/*                    End of Disp_Help Procedure                     */
/*-------------------------------------------------------------------*/
/*-------------------------------------------------------------------*/
/*                      Trap NOVALUE Condition                       */
/*-------------------------------------------------------------------*/
novalue:
say "NOVALUE entered from line" sigl
say condition("D")
say "The instruction is suppressed"
address "TSO"
"delstack"
exit(16)
/*-------------------------------------------------------------------*/
/*                        Trap HALT Condition                        */
/*-------------------------------------------------------------------*/
halt:
say "HALT acknowledged in line" sigl
say "Cleanup processing in progress"
address "TSO"
"delstack"
exit(16)
/*-------------------------------------------------------------------*/
/*                          End of STARTMAC                          */
/*-------------------------------------------------------------------*/
./ ADD NAME=STARTPNL
/*-------------------------------------------------------------------*/
/*                                                                   */
/*                         REXX Exec : STARTPNL                      */
/*                                                                   */
/*                      ***** Edit Macro *****                       */
/*                                                                   */
/*  Description : Create a skeleton ISPF Panel                       */
/*                                                                   */
/*  Created on : 22 Mar 2018                                         */
/*  Created by : Kevin Ferguson                                      */
/*             : Userid MIT001                                       */
/*             : Using ABBYDALE.DEVL.REXX(STARTPNL)                  */
/*                                                                   */
/*  Called by : Edit Macro                                           */
/*                                                                   */
/*  Calls :  Nothing                                                 */
/*                                                                   */
/*  Change Activity :                                                */
/*                                                                   */
/*                ©Copyright of Abbydale Systems LLC.                */
/*                                                                   */
/*-------------------------------------------------------------------*/
ADDRESS ISREDIT "MACRO"
ADDRESS ISREDIT "(DSNAME) = DATASET"
ADDRESS ISREDIT "(MEMBER) = MEMBER"
ADDRESS ISREDIT '(LASTLINE) = LINENUM .ZLAST'
if  lastline > 0 then
ADDRESS ISREDIT "(LINE) = LINE 1"
address ISredit "Profile unlock"
address ISredit "HILITE PANEL"
address ISredit "Profile lock"
ADDRESS ISREDIT "RESET"
uline = translate(LINE)
s = USERID()
ascb = storage(224,4)                             /* psaaold  */
asxb = storage(d2x(c2d(ascb)+108),4)              /* ascbasxb */
acee = storage(d2x(c2d(asxb)+200),4)              /* acee     */
unam = storage(d2x(c2d(acee)+100),4)              /* aceeunam */
name=strip(storage(d2x(c2d(unam)+1),20))          /* Get name */
row = 0
mem = left(member,8,' ')
mline = ')ATTR'
call putcode
mline = ' _ TYPE(INPUT) INTENS(HIGH) CAPS(ON) JUST(LEFT) COLOR(TURQ)'
mline = mline 'PAD(''_'')'
Call putcode
mline = ' ! TYPE(TEXT)  INTENS(&INTENS) COLOR(RED)'
call putcode
mline = ' # TYPE(TEXT)  SKIP(ON)  COLOR(BLUE)'
call putcode
mline = ' + TYPE(TEXT)  SKIP(ON)  COLOR(TURQ)'
call putcode
mline = ' ~ TYPE(TEXT)  INTENS(HIGH) JUST(ASIS) COLOR(WHITE)'
call putcode
mline = ' ` TYPE(TEXT)  INTENS(HIGH) JUST(ASIS) COLOR(RED)'
mline = mline 'HILITE(REVERSE)'
call putcode
mline = ' } TYPE(TEXT)  INTENS(HIGH) SKIP(ON)  COLOR(YELLOW)'
call putcode
mline = ' { TYPE(TEXT)  INTENS(HIGH) SKIP(ON)  COLOR(GREEN)'
call putcode
mline = ' ^ TYPE(OUTPUT) SKIP(ON) INTENS(HIGH) COLOR(BLUE)'
call putcode
mline = ')BODY EXPAND('''')'
call putcode
mline = '+Your snappy panel title goes here                         '
mline = mline '+USERID   -  &ZUSER    '
Call putcode
mline = '# '
mline = mline '' ''
Call putcode
mline = '{Option ===>_ZCMD'
Call putcode
mline = '# '
mline = mline '' ''
Call putcode
mline = '%''*'''
Call putcode
mline = '%*%Date :{&ZDATE '' ''%Time :{&ZTIME '''
mline = mline '''%Julian Date:{&ZJ4DATE%*'
Call putcode
mline = '%*'' ''*'
Call putcode
fill = '-'
tline = '-'
call putline
fill = ' '
tline = ' '
call putline
tline = 'Your code goes here'
call putleft
tline = ' '
call putline
fill = '-'
tline = '-'
call putline
ADDRESS ISREDIT '(LASTLINE) = LINENUM .ZLAST'
row = lastline
fill = ' '
tline = ' '
call putline
mline = '%*'' ''}Press !PFK3} to terminate'' ''%*'
call putcode
mline = '%''*'''
call putcode
mline = '%''*'' #Copyright Abbydale Systems LLC 2017 -^copy%''*'''
call putcode
mline = '%''*'''
call putcode
mline = ')INIT'
call putcode
mline = ' &copy = &ZSTDYEAR'
call putcode
mline = ' .cursor = ZCMD'
call putcode
mline = ')REINIT'
call putcode
mline = ')PROC'
call putcode
mline = '  &ZTRAIL = .TRAIL'
call putcode
mline = ')END'
call putcode
exit
putline:
mline = '*'CENTER(tline,69,fill)'*'
Address ISREDIT "LINE_AFTER "row "= '"mline"'"
row = row + 1
return
putleft:
mline = '*  'LEFT(tline,67,fill)'*'
putcode:
Address ISREDIT "LINE_AFTER "row "= DATALINE (mline)"
row = row + 1
return
./ ENDUP       "REVIEW" PDS MEMBER OFFLOAD AT 22:34 ON 23-09-11