/*TECHPS    Author: David McRitchie        (written  in REXX)        */
/*                 "The REXX Macros Toolbox"                           */
/*          Created 1994/02/16 for PostScript (from PU00L 1993/10/15 */
/*-------------------------------------------------------------------*/
/*       Macro: TECHPS                                               */
/*       Purpose: Print content of member in EDIT to PU2ZD in SysTech*/
/*                prints nice two-sided copies on LaserJet IV   MX   */
/*-------------------------------------------------------------------*/
/* Related clists: PU00L, TECHPS, @PRINTNX, SCRIPTPS,  @SCRIPT ....  */
/*********************************************************************/
/***************  TECHPS options *************************************/
/*  Options -- plus anything valid for SCRIPTPS macro                */
/*     BROWSE          -- Browse input file to SCRIPT command        */
/*     CHARS(xxx)      -- override calculated default                */
/*     CLASS(class)    -- override CLASS(G) default                  */
/*     COPIES(copies)  -- override default of 1                      */
/*     DEST(dest) or GO TECHPS PU                                    */
/*     NOLABEL         -- do not show labels, only meaningful if NX  */
/*     NX              -- include only NX lines, also                */
/*                         show labels unless NOLABEL option invoked */
/*     STOP            -- testing, BROWSE script input, stop, noprint*/
/*
    Font       in.  GT24 GT20  GT18 GT15 GT12 GT10"
    Portrait   7.6   182  152   136  114   91   76"
               7.5              129                corrected PSA90
    Landscape 10.1   242  202   181  151  121  101"
 *********************************************************************/
    address "ISREDIT";"MACRO (TOKEN)"
    terminate = 0
    dev="PSA"
    otoken=token
    address "ISPEXEC" "CONTROL ERRORS RETURN"
    zedsmsg = "**";zedlmsg="**"
    token = " "translate(token)" "
    "(rowx,colx) = cursor"
    qcnt = 0
    addon = 0
    q.=""
    font="";chars="";pagex=""
    parse var token left "CHARS(" chars ")" right
    if CHARS \= "" then token =  left right
    i = pos(' NOLABEL ',token)
    if i=0 then nolabel=0; else do; nolabel=1;
         token = substr(token,1, i)||substr(token,i+9); end;
    parse var token left " CLASS(" class ") " right
    if class = "" then class=G   /* for PostScript*/
    else token = " "left right" "
    parse var token left "COPIES(" copies ")" right
    if copies = "" then copies="1"; else token = left right
    parse var token left " PAGE(" pagex  ")" right
    if pagex  \= "" then do;pagex=" Page("pagex")"; token = left right;end;
    i = pos(' STOP ',token)
    if i=0 then STOP=0; else do; STOP=1;
         token = substr(token,1, i)||substr(token,i+6); end;
    i = pos(" NX ", token)
    if i \= 0 then do; NXOPT="NX";
      token = substr(token,1,i)||substr(token,i+4)
    end; else NXOPT=""
    if NXOPT = "NX" then if NOLABEL = 0  then do
       "LOC FIRST LABEL"
       if rc \= 0 then NOLABEL = 1
    end
    Address "ISREDIT" "(CHG) = DATA_CHANGED"
    if CHG = "YES" then if NXOPT = "" then do
         zedsmsg = "Not Saved/Not Printed"
         ZEDLMSG = "Data has not been saved, Save then reissue TECHPS"
         call msg0
         call note zedlmsg
         call note "  or invoke with NX option ===> TECHPS NX"
         exit 1;
    end
Parse var token left " DEV(" DEV ")" right
If dev /= '' then token = left right;
/* some special devices not checking for redundancy */
I = index(token," L "); If I /=0 then
   do;DEV = "PSA90";token = substr(token,1,I)substr(token,I+3);end
I = index(token," ACROSS "); If I /=0 then
   do;DEV = "PSA90";token = substr(token,1,I)substr(token,I+8);end
I = index(token," LEGAL "); If I/=0 then   /* change paper size*/
   do; dev="PSL"; token = substr(token,1,I)substr(token,I+7); end
If DEV = '' then DEV = "PSA"
Parse var token left " DEST(" dest ")" right;token = left right
If dest = "" then do    /* this portion matches  clist SCRIPTPS */
   I = index(token," GO ")
   If I /= 0 then do;dest = "P15NF";  /* used to be P15NF, PROG1A3A */
      token =substr(token,1,I)substr(token,I+4); end;
   I = index(token," TECHPS ")
   If I /= 0 then do;dest = "PU2ZD";  /* used to use TCPPRTST */
      token =substr(token,1,I)substr(token,I+8); end;
   I = index(token," PU ")
   If I /= 0 then do;dest = "PU2ZD";  /* used to use TCPPRTST */
      token =substr(token,1,I)substr(token,I+4); end;
      /*  SYSx.VPS.CNTL for prod,   SYSx.VPS.R61.CNTL for test       */
      /*        | member    =G         =A   |  =G         =A         */
      /*        | dual      dest=    dest=  | single G    single A   */
      /* TCP    |  no dual avail for TCP    | TCPPRTST    TCPPRTS1   */
      /*        |                           | ======== or ========   */
      /* VTAM   | PU2ZDALL PU2ZD    PU2ZD   |                        */
      /*        | ======== <--active        |                        */
end
if dest='' then dest="PU2ZD"  /* default for TECHPS will be used*/

    SCALE =,
      "1...5...10...15...20...25...30...35...40...45...50...55...60"||,
      "...65...70...75...80...85...90...95..100..105..110..115..120"||,
      "..125..130..135..140..145..150..155..160..165..170..175..180"||,
      "..185..190..195..200..205..210..215..220..225"
    addon = 0
    if NXOPT = "NX" then do;
      if nolabel=0 then addon = 15; else addon=7
      scale = left(" ",addon)scale;
    end
    else do;
      addon = 0 /* even if label unless NX won't show*/
      scale = left(" ",addon)scale;
    end;
    "(var016) = data_width"
    data_width = dwchk()
    font = chars
    /* attempt to reduce apparent data_width */
    a1=data_width
    a2=a1 + addon
    if dev \= "PSA90" then do
       if      a2 > 152 then do; font = gt24; mpl=182; end;
       else if a2 > 129 then do; font = gt20; mpl=152; end;
       else if a2 > 114 then do; font = "GT18"; mpl=129; end;
       else if a2 >  91 then do; font = "GT15"; mpl=114; end;
       else if a2 >  76 then do; font = "GT12"; mpl=91; end;
       else do; font = "GT10"; mpl=76; end;
    end
    else do;
       if      a2 > 202 then do; font = gt24; mpl=242; end;
       else if a2 > 181 then do; font = gt20; mpl=202; end;
       else if a2 > 151 then do; font = "GT18"; mpl=181; end;
       else if a2 > 121 then do; font = "GT15"; mpl=151; end;
       else if a2 > 101 then do; font = "GT12"; mpl=121; end;
       else do; font = "GT10"; mpl=101; end;
    end
    if chars \= "" then font = chars
    qcnt=qcnt+1;q.qcnt = ".* " data_width" chars in longest line,",
      || " treated as" a2 "with addon of" addon
    qcnt=qcnt+1;q.qcnt = ".* font="font" accomodates" mpl" chars/line",
         ", override="chars
    qcnt=qcnt+1;q.qcnt=".* Font  in.  GT24 GT20  GT18 GT15 GT12 GT10"
    qcnt=qcnt+1;q.qcnt=".* Port  7.6   182  152   136  114   91   76"
    qcnt=qcnt+1;q.qcnt=".* Land 10.1   242  202   181  151  121  101"
    notex = A1||"(+"addon||") line lengths accomodated up to",
        mpl "bytes by" font "dev("dev")"
    call info(notex)
    scale = substr(scale,1,data_width)
    if token \= "" then do
           ZEDSMSG = "Bad Parm"
           ZEDLMSG = 'Unknow options "'token'"'
           ADDRESS "ISPEXEC" "SETMSG MSG(ISRZ000)"
           exit 4
    end
    scale = substr(scale,1,data_width)

    address "ISREDIT"
    "(say1,say2) = cursor"
    "CURSOR =" rowx colx
    ZEDSMSG =
    ZEDLMSG = "** Process into Q. ---------- **"
    ADDRESS "ISPEXEC" "CONTROL DISPLAY LOCK"
    call msg0

    ADDRESS "ISREDIT" "(DSN) = DATASET"
    ADDRESS "ISREDIT" "(MEMBER) = MEMBER"
    SYSUID = SYSVAR("SYSUID")
    userid = SYSVAR("SYSUID")
    inputdsn = "'"sysuid".SPELL.MACRO.TEXT'"
    if member = '' then dsname="'"dsn"'"
    else dsname ="'"dsn"("strip(member)")'"
    s9999 = "'"sysuid".s9999ps.list'"
    PROFILE = "DSMPROF4"       /*DEFAULT*/
    /* TSO dataset conventions for use w/o quotes */
    /* Allocate DCF input dataset -- allow up to 200 bytes/rec*/
    ADDRESS "TSO"
    status = msg("off")
    "free fi(ESPELL)";"free da("inputdsn")"
    "free da("s9999")"
    if sysdsn(inputdsn) = "OK" then "del" inputdsn
    if sysdsn(s9999)    = "OK" then "del" s9999
    status = msg("on")
    "ALLOC FI(ESPELL) NEW CAT SPACE(45 45) TRACKS UNIT(SYSDA)" ,
      "LRECL(255) RECFM(V B M) BLKSIZE(3156)" ,
      "DSN("inputdsn") REUSE"
    /*  DCB attributes to the contrary will be reset by DCF */

    /* Open file and SAY some SCRIPT commands to be sure */
    /* data is formatted properly for parsing (later).     */

    qcnt=qcnt+1; q.qcnt =".pm .8i"
    qcnt=qcnt+1; q.qcnt =".rh on"
    qcnt=qcnt+1;
    if dev = "PSA90" then q.qcnt=".ll 8.5i"; else q.qcnt=".ll 6i"
    qcnt=qcnt+1; q.qcnt =".bf @smalls ="
    qcnt=qcnt+1; q.qcnt =".dc ps ›"
/*********************************************************************/
/*     qcnt=qcnt+1; q.qcnt =".se TODAY  '&DAY(&SYSDAYOFW.).,",     *'*/
/*          "&MONTH(&SYSMONTH.). &SYSDAYOFM., 19&SYSYEAR.'"        *'*/
/*********************************************************************/
    qcnt=qcnt+1; q.qcnt =".ri on"
    qcnt=qcnt+1; q.qcnt ="<Printed via TECHPS>  &$CONT."
    qcnt=qcnt+1; q.qcnt =".bf fontp2 ="
    qcnt=qcnt+1; q.qcnt =".bf hi2  ="
    parse var dsname "'"dsnamex"'"
    qcnt=qcnt+1; q.qcnt =dsnamex
    qcnt=qcnt+1; q.qcnt =".pf "
    qcnt=qcnt+1; q.qcnt =".pf"
    qcnt=qcnt+1; q.qcnt =".ct   "font " on &DAY(&SYSDAYOFW.)",
          date("o") "at" time("n")" for" userid
    qcnt=qcnt+1; q.qcnt =".ri off"
    saveq = q.qcnt
    qcnt=qcnt+1; q.qcnt =".pf"
    qcnt=qcnt+1; q.qcnt =".sp 1"
    qcnt=qcnt+1; q.qcnt =".rh off"
    qcnt=qcnt+1; q.qcnt = ".rf odd  "
    qcnt=qcnt+1; q.qcnt = ".pm .8i"
    qcnt=qcnt+1;
    if dev = "PSA90" then q.qcnt=".ll 9.7i"; else q.qcnt=".ll 7.2i"
    qcnt=qcnt+1; q.qcnt = ".sv off  "
    qcnt=qcnt+1; q.qcnt = ".fo right"
    qcnt=qcnt+1; q.qcnt = ".sp 2    "
    qcnt=qcnt+1; q.qcnt = " &$PS    "
    qcnt=qcnt+1; q.qcnt = ".rf off  "
    qcnt=qcnt+1; q.qcnt = ".rf even "
    qcnt=qcnt+1; q.qcnt =".pm .8i"
    qcnt=qcnt+1; q.qcnt = ".sv off  "
    qcnt=qcnt+1; q.qcnt = ".fo left "
    qcnt=qcnt+1; q.qcnt = ".sp 2    "
    qcnt=qcnt+1; q.qcnt = " &$PS.   "
    qcnt=qcnt+1; q.qcnt = ".rf off  "
    qcnt=qcnt+1; q.qcnt =".sv off"
    qcnt=qcnt+1;
    if dev = "PSA90" then q.qcnt=".ll 10.1i"; else q.qcnt=".ll 7.6i"
    qcnt=qcnt+1; q.qcnt =".if 1403 = &$PDEV. .llmax"
    call dirinfo; /* directory info extracted from @PRINTNX */
    qcnt=qcnt+1; q.qcnt =".dd file dsn "dsname
    qcnt=qcnt+1; q.qcnt =".bf" font "GT15 ="
    qcnt=qcnt+1; q.qcnt =".fo off fold"
    /******* bring in file currently in edit *********************/
    /*******   .imfile is a special DCF macro for this purpose   */
    if NXOPT = "" then do; qcnt=qcnt+1; q.qcnt =".imfile file";end;
    else call modified_input    /* or use alternative for unsaved*/
    /*************************************************************/
    qcnt=qcnt+1; q.qcnt =".pf"
    qcnt=qcnt+1; q.qcnt =".sk 1"
    qcnt=qcnt+1;
    if dev = "PSA90" then q.qcnt=".ll 8.5i"; else q.qcnt=".ll 6.0i"
    qcnt=qcnt+1; q.qcnt =".hr left right" /* instead of  .$PARM */
    qcnt=qcnt+1;
    if dev = "PSA90" then q.qcnt=".ll 10.1i"; else q.qcnt=".ll 7.6i"
    qcnt=qcnt+1; q.qcnt =".bf" font "GT15 ="
    qcnt=qcnt+1; q.qcnt =scale
    qcnt=qcnt+1; q.qcnt = ".if &$PASS = &$PSNO. .$FONT TY"
    qcnt=qcnt+1; q.qcnt =".pf"
    qcnt=qcnt+1;
    if dev = "PSA90" then q.qcnt=".ll 8.5i"; else q.qcnt=".ll 6.0i"
    qcnt=qcnt+1; q.qcnt =".bf" font "GT15 ="
    qcnt=qcnt+1; q.qcnt =".se face '&$TYPESIZE. &$TYPEFACE.'"
    if pos("BROWSE",token) \= 0 then do
      qcnt=qcnt+1; q.qcnt =".$font ty"
    end
    qcnt=qcnt+1; q.qcnt =".pf"
    qcnt=qcnt+1; q.qcnt =".bf @smalls ="
    qcnt=qcnt+1; q.qcnt =saveq " with" font "(&face.)"
    qcnt=qcnt+1; q.qcnt =".pf"
    qcnt=qcnt+1; q.qcnt =".if &$LST = 1 .sk 0"
    qcnt=qcnt+1; q.qcnt =".se *lcdv1 = '&$PN with &$LC."
    qcnt=qcnt+1; q.qcnt =".se *lcdv2 = '&*lcdv1. lines remaining"
    qcnt=qcnt+1; q.qcnt =".se *lcdv  = '&*lcdv2. (&DV'&$LC.dv/&DV'1"
    qcnt=qcnt+1; q.qcnt =".if &$PASS. = &$PSNO."
    qcnt=qcnt+1; q.qcnt =".th .ty LASTPAGE is &*lcdv.dv)"
    qcnt=qcnt+1; q.qcnt =".rh on"
    qcnt=qcnt+1; q.qcnt =".sp 5i"
    qcnt=qcnt+1; q.qcnt =".ce (Last Page left intentionally Blank)"
    qcnt=qcnt+1; q.qcnt =".rh off"
    qcnt=qcnt+1; q.qcnt =".cp"
    qcnt=qcnt+1; q.qcnt =".if &SYSVARD = yes"
    qcnt=qcnt+1; q.qcnt =".an SYSPAGE = EVEN"
    qcnt=qcnt+1; q.qcnt =".th .pa odd"
    qcnt=qcnt+1; q.qcnt =".th .rh sup"
    qcnt=qcnt+1; q.qcnt =".th .rf sup"

    Address "TSO" "EXECIO * DISKW ESPELL (STEM Q. FINIS"
    /* Invoke SCRIPT/VS */
    if stop = 1 then do
       address "TSO" "$BROWSE" inputdsn
       Say "SCRIPT command if issued would have looked like..."
       say        "SCRIPT" inputdsn,
        " PRO('SCRIPT.R40.MACLIB(DSMPROF4)') LIB('SCRIPT.R40.MACLIB')",
        " FO('SCRIPT.R40.FONTPS') index DEV("dev")",
        " CHARS(PSFHV) FP(2)SYS(X NO H NO D YES ) M(ID)",
        " FILE("s9999")"pagex
       exit
    end
    address "ISPEXEC" "CONTROL ERRORS EXIT"
    Address "TSO" "SCRIPT" inputdsn,
        " PRO('SCRIPT.R40.MACLIB(DSMPROF4)') LIB('SCRIPT.R40.MACLIB')",
        " FO('SCRIPT.R40.FONTPS') index DEV("dev")",
        " CHARS(PSFHV) FP(2)SYS(X NO H NO D YES ) M(ID)",
        " FILE("s9999")"pagex
    SCRIPT_RC = RC
    status = msg("off")
    address "TSO" "FREE DA("s9999")"
    terminate = terminate + 1
    if terminate \= 1 then exit 16
    status = msg("on")
    i = pos("BROWSE",token)
    if i \= 0 then do;  /* debugging check files created*/
            SAY "SCRIPT return code rc="script_rc  "CLASS="class,
               "font" font "scale=" length(scale),
               "one of longer lines" say1 say2
            address "TSO" "$BROWSE" dsname
            address "TSO" "$EDIT"   inputdsn
            address "TSO" "$BROWSE" s9999;
            Address "ISREDIT" "MEND"
            say zerrmsg zedsmsg zedlmsg zcmd
            exit 1;
            SAY "THIS STATEMENT SHOULD NEVER APPEAR"
    end;
    ZEDSMSG =""
    ZEDLMSG = "** Completed----------------- ** -- FINAL PHASE"
    ADDRESS "ISPEXEC" "CONTROL DISPLAY LOCK"
    call msg0

    status = msg("off")
    Address "TSO"
   "FREE FI(ESPELL) DELETE"
   "FREE OUTDES(NAME1) FI(SYSUT1 SYSUT2 SYSPRINT)"
    status = msg("on")
    OUTDES = "CLASS("class") DEST("dest")",
        "FORMDEF(A10111) LINECT(0) GROUPID(TECHPS)"
   "OUTDES NAME1" OUTDES
  /* class = A*/
   "ALLOC FI(SYSPRINT) DUMMY                 "
   "ALLOC FI(SYSUT1) DA("s9999") SHR"
   "ALLOC FI(SYSUT2) SYSOUT("class") OUTDES(NAME1) COPIES("copies")"
   "ALLOC FI(SYSIN) DUMMY REUSE              "
   "CALL 'SYS1.LINKLIB(IEBGENER)'            "
   if rc = 0 then
   ZEDSMSG = "Printed"
   ZEDLMSG = time("n"),
      "TECHPS -Document has been Printed to CLASS("class")" font,
      "DEST("dest") copies("copies")"
   call note zedlmsg
   if NXOPT = "" then call note " Option NX would include",
      "sequence numbers and labels on printed listing"
   call msg0
   address "ISREDIT" "UP MAX"
   "FREE FI(SYSUT1 SYSUT2) OUTDES(NAME1)     "
   "ALLOC FI(SYSIN) DA(*) REUSE              "
   "ALLOC FI(SYSPRINT) DA(*) REUSE           "
   Address "ISREDIT" "MEND"
   exit 1;
   say "This statement--should never print"
 dirinfo:
 /******** extracted from @PRINTNX *******************/
  address "ISREDIT"
  " (VAR018) = DATAID"
  " (VAR018A) = DATASET"
  " (VAR043) = MEMBER"
  " (DSNX)          = DATASET"
  " (NUMX)          = NUMBER"
  x = LISTDSI("'"DSNX"'") "DIRECTORY"
  LMSG = "DCB=(RECFM="SYSRECFM",LRECL="SYSLRECL",BLKSIZE="SYSBLKSIZE,
        ||",DSORG="SYSDSORG")  NUMBER "NUMX
  IF VAR043 = "" THEN DO
          xyz=""  /* statistics not avail. for sequential file */
          signal nostats;
  END
  Address "ISPEXEC" "LMINIT DATAID(DDVAR) DATASET('"VAR018A"') ENQ(SHR)"
  if rc \= 0 then say "LMINIT RC="RC
  Address "ISPEXEC" "LMOPEN DATAID("ddvar") OPTION(INPUT)"
  if rc \= 0 then  say "LMOPEN RC="RC
  Address "ISPEXEC" "LMMFIND DATAID("ddvar") MEMBER("VAR043")",
     "STATS(YES)"
  if rc \=0 then say "LMFIND RC="RC
  LRC = RC
  IF LRC = 8 THEN  NOTFOUND = 1
  ZEDLMSG = lmsg; call msg0
  VAR043 = SUBSTR(VAR043,1,8)
  /************************************************************/
   XYZ = VAR043 ZLVERS"."ZLMOD ZLCDATE ZLMDATE
   XYZ = XYZ ZLMTIME ZLCNORC ZLINORC ZLMNORC
   XYZ = XYZ LEFT(ZLUSER,8)
  nostats:
   " (VAR037) = LINENUM .ZLAST"
   IF ZLCNORC ="" THEN XYZ = VAR043,
     "                                  "VAR037"   *NO ",
     "STATISTICS*   "
   IF NOTFOUND = "" THEN XYZ = VAR043  ,
       "<<--------------- no prior statistics exist ---------->>"
   "(VAR014A) = DATA_CHANGED"
   if VAR014A = "NO" then do
      changed = "-- Data Unchanged"
   end
   else do
      changed = "-- Data Changed"
   end
   IF VAR014A = "YES" THEN
      " LINE_AFTER 0 = NOTELINE ""=== TECHPS" otoken "-- issued "||,
         "("date('j')")" date('o') time('n') "Data has been changed "||,
                                    "==========="""
 ELSE
      " LINE_AFTER 0 = NOTELINE ""=== TECHPS" otoken "-- issued "||,
         "("date('j')")" date('o') time('n') "======================"||,
                                    "==========="""
   if xyz \= "" then do
   " LINE_AFTER 0 = NOTELINE ""=== "XYZ" =="""
   " LINE_AFTER 0 = NOTELINE ""=== MEMBER-- VV.MM CREATED- ",
     "---MODIFIED---  CURR  INIT   MOD LASTUSER =="""
   end

   /* ------------------------------*/

       qcnt=qcnt+1; q.qcnt= ".sk 1"
       qcnt=qcnt+1; q.qcnt= ".kp on"
       qcnt=qcnt+1; q.qcnt= ".bf gt20 GT15 ="
       qcnt=qcnt+1; q.qcnt= ".bx 0 6i"
       qcnt=qcnt+1; q.qcnt= ".in 2 "
       qcnt=qcnt+1; q.qcnt= ".ir 2"
        if xyz \= "" then do
          qcnt=qcnt+1; q.qcnt= " MEMBER-- VV.MM "||,
           "CREATED- ---MODIFIED---  CURR  INIT   MOD LASTUSER"
          qcnt=qcnt+1; q.qcnt= " "XYZ
          qcnt=qcnt+1; q.qcnt= ".bx"
       end
       qcnt=qcnt+1; q.qcnt= " DSN="||left(SYSDSNAME,44),
          "Created" SYSCREATE
       qcnt=qcnt+1; q.qcnt= " "LMSG
       qcnt=qcnt+1; q.qcnt= ".bx off"
       qcnt=qcnt+1; q.qcnt= ".kp off"
       qcnt=qcnt+1; q.qcnt= ".sk 1"
   /* ------------------------------*/
 /*IF ZLCNORC  /="" THEN do*/
     if xyz \= "" then do
      Address "ISPEXEC" "LMCLOSE DATAID("ddvar")"
      if rc \=0 then say "LMCLOSE RC="RC
      Address "ISPEXEC" "LMFREE DATAID("ddvar")"
      if rc \=0 then say "LMFREE  RC="RC
     end
 /*end*/
 /**** end extracted from @PRINTNX *******************/
  return

 modified_input:
 unshown = 0
 /* TECHPS and PU00L contains coding similar to @PRINTNX */
 address "ISREDIT"
 "(maxrec) = LINENUM .ZLAST"
 qcnt=qcnt+1; q.qcnt =".ti 5F 5F"
 qcnt=qcnt+1; q.qcnt =".ti"
 qcnt=qcnt+1; q.qcnt =".su off"
 qcnt=qcnt+1; q.qcnt =".dc gml off"
 qcnt=qcnt+1; q.qcnt =".dc cw  off"
 qcnt=qcnt+1; q.qcnt =".li on"
 do rec = 1 to maxrec
    "(XSTATUS) = XSTATUS" REC
    if XSTATUS = "X" then do
       if unshown = 0 then qfrom = rec + 0
       unshown = unshown + 1
    end
    else do
       if unshown /= 0 then do
          recm1 = rec - 1
          qcnt=qcnt+1; q.qcnt = "        - - - - - - - - -",
                unshown "LINE(S), lines" right(QFROM,6,'0')"-"||,
                right(recm1,6,'0') "Not Displayed"
          unshown = 0
       end
       "(LINE) = LINE" rec
       "(LABEL,NEST) = LABEL" rec
       line=strip(line,'t')
       qcnt=qcnt+1;
       if nolabel = 1
          then q.qcnt = right(rec,6,'0') line
          else q.qcnt = " "left(label,6) right(rec,6,'0') line
       /* We could have provided more room when labels are not used, */
       /* but chose to keep report uniform for NX listings regard-   */
       /* less of whether labels are used or not.  <design choice>   */
    end
end
qcnt=qcnt+1; q.qcnt = ".li off"
qcnt=qcnt+1; q.qcnt =".dc gml : : e"
qcnt=qcnt+1; q.qcnt =".dc cw 5E"
qcnt=qcnt+1; q.qcnt =".su on"
q.0 = qcnt;
return
INFO: parse arg arg;
      address "ISREDIT" "line_before .zf = infoline (arg)"; return
NOTE: parse arg arg;
      address "ISREDIT" "line_before .zf = noteline (arg)"; return
MSG0: /* SPF/PC invokes SETMSG in incorrectly */
      if v1 = "REXXSAA"
         then /*Address*/ "ISPEXEC" "SETMSG MSG(ISRZ000)"
         else Address "ISPEXEC" "SETMSG MSG(ISRZ000)"
return  0
dwchk:
   tmax = var016; if tmax > 250 then tmax = 250;
   ttmax = tmax;
   do jj = ttmax to 70 by -10;
      address "ISREDIT" "seek first p'^'" jj tmax
      if rc \= 0 then tmax = jj;
   end;
   do j = tmax to 70   by -1
      address "ISREDIT" "seek first p'^'" j tmax
      if rc = 0 then return j;
   end;
   return 70