%META:TOPICINFO{author="ChrisBartram" date="1149893178" format="1.1" version="1.1"}%
%META:TOPICPARENT{name="Hp3000MpexXeqs"}%
<pre>
(* Author: Leonard S. Berkowitz                                    *)

(* CREDATE, a customized LISTF mode                                *)

(* This is a LISTF mode based upon MPEX's mode 3 that is sorted by *)
(* creation date and time in ascending order and then by number of *)
(* sectors in descending order.  After each "date" break, a faint  *)
(* separator line, a total line and a heavy separator line are     *)
(* printed.                                                        *)
(*                                                                 *)
(* N. B.  If this LISTF mode is executed in batch job, the creator *)
(* and number of sectors are printed in the file line.             *)
(*                                                                 *)
(* To 'compile' this file, the variable LISTF_TEST must exist.     *)
(* Therefore, SETVAR LISTF_TEST FALSE.                             *)
(*                                                                 *)
(* To 'compile' this file, the variable DESCRIPTION must exist.    *)
(* Therefore, SETVAR DESCRIPTION "SAMPLE".                         *)

(* *-------------------------------------------------------------* *)
(* *                                                             * *)
(* *                       Change Log                            * *)
(* *                                                             * *)
(* *   Date   by  Modification                                   * *)
(* * -------- --- -----------------------------------------------* *)
(* * 07/10/92 LSB Cloned ACCDATE which was a copy of DATESORT    * *)
(* *                from VECSL supplied with MPEX 23.11115.      * *)
(* * 08/21/92 LSB Added revision information in output.          * *)
(* * 12/29/92 LSB Added CRETIME as second-level sort key.        * *)
(* * 02/26/93 LSB Added optional description line in heading.    * *)
(* * 03/01/93 LSB Commented description line in heading because  * *)
(* *                prompt is printed in CIOR listing.           * *)
(* * 03/23/93 LSB Added CO_NAME plus name of LISTF mode in revi- * *)
(* *                sion information.                            * *)
(* *              Modified placement of 'revision' in redirected * *)
(* *                output file.                                 * *)
(* * 03/26/93 LSB Changed header to print ',' only if HPJOBNAME  * *)
(* *                has a value.                                 * *)
(* * 03/29/93 LSB Added variable END_OF_FILESET to prevent an    * *)
(* *                extra heading on last 'page'.                * *)
(* * 11/03/93 LSB Changed handling of CO_NAME so that it is      * *)
(* *                treated as an MPEX variable and not an       * *)
(* *                MPE/iX variable.                             * *)
(* *              Changed handling of LISTF_TEST so that it is   * *)
(* *                treated as an MPEX variable and not an       * *)
(* *                MPE/iX variable.                             * *)
(* *              Changed handling of WGLCPU so that it is       * *)
(* *                treated as an MPEX variable and not an       * *)
(* *                MPE/iX variable.                             * *)
(* * 04/25/95 LSB Added FMTCOMMA on number of files and sectors. * *)
(* * 05/14/96 LSB Changed revision display to use modification   * *)
(* *                date of source file rather than compiled     * *)
(* *                file.                                        * *)
(* * 05/18/98 LSB Commented out DESCRIPTION handling.            * *)
(* *                                                             * *)
(* *-------------------------------------------------------------* *)
(*                                                                 *)
(*SVARSET ("DESCRIPTION",                                          *)
(*            (READSTRING                                          *)
(*                ("Optional description? (max 72)",               *)
(*             "RTRIM",                                            *)
(*             72) ) );                                            *)

VAR LINE_WIDTH: INTEGER;

VAR AUSPICES: STRING [20];

SVARSET
    ("AUSPICES", (STR (HPPROMPT,1,(POS (" ",HPPROMPT) -1) ) ) );

IF OUTRECSIZE () < 132 THEN
    IVARSET ("LINE_WIDTH",79)
ELSE
    IVARSET ("LINE_WIDTH",100);

VAR END_OF_FILESET: BOOLEAN;

BVARSET ("END_OF_FILESET",FALSE);

IF OUTRECSIZE () < 132 THEN
  BEGIN
    MPEXHEADER1:=
        RPT (" ",27) +
        "File" +
        RPT (" ",2) +
        "Creation" +
        RPT (" ",5) +
        "Modify" +
        RPT (" ",6) +
        "Access" +
        RPT (" ",5) +
        "Allocation";

    MPEXHEADER2:=
        "<--- F i l e   N a m e --> " +
        "Code" +
        RPT (" ",4) +
        "Date" +
        RPT (" ",8) +
        "Date" +
        RPT (" ",8) +
        "Date" +
        RPT (" ",8) +
        "Date"
  END
ELSE
  BEGIN
    MPEXHEADER1:=
        RPT (" ",36) +
        "File" +
        RPT (" ",2) +
        "Creation" +
        RPT (" ",5) +
        "Modify" +
        RPT (" ",6) +
        "Access" +
        RPT (" ",5) +
        "Allocation";

    MPEXHEADER2:=
        "<--- F i l e   N a m e --> " +
        "Creator" +
        RPT (" ",2) +
        "Code" +
        RPT (" ",4) +
        "Date" +
        RPT (" ",8) +
        "Date" +
        RPT (" ",8) +
        "Date" +
        RPT (" ",8) +
        "Date" +
        RPT (" ",8) +
        "Sectors"
  END;

MPEXHEADER3:="";

FOR RFILE IN MPEXFILESET
  SORT (CREDATE,CRETIME,SECTORS:"DESC")

  PAGEHEAD
    BEGIN
      IF NOT BVAR ("END_OF_FILESET") THEN
          BEGIN
            WRITELN (" ");

            WRITELN
                (STRWRITE
                     (SVAR ("HPSYSNAME") +
                      " " +
                      UPS (SVAR ("MPEXFILESET") ):
                      IVAR ("LINE_WIDTH"):
                      "CENTER") );

            IF HPJOBNAME <> "" THEN
                WRITELN
                    (STRWRITE
                         (HPJOBNAME +
                          "," +
                          HPUSER +
                          "." +
                          HPACCOUNT +
                          ", " +
                          HPDATEF +
                          ", " +
                          HPTIMEF:
                          IVAR ("LINE_WIDTH"):
                          "CENTER") )
            ELSE
                WRITELN
                    (STRWRITE
                         (HPUSER +
                          "." +
                          HPACCOUNT +
                          ", " +
                          HPDATEF +
                          ", " +
                          HPTIMEF:
                          IVAR ("LINE_WIDTH"):
                          "CENTER") );

(*          IF LEN (SVAR ("DESCRIPTION") ) ) > 0 THEN              *)
(*            BEGIN                                                *)
(*              WRITELN (" ");                                     *)
(*                                                                 *)
(*              WRITELN ( (DESCRIPTION):                           *)
(*                       IVAR ("LINE_WIDTH"):                      *)
(*                       "CENTER");                                *)
(*            END;                                                 *)

            WRITELN (" ");

            WRITELN
                (STRWRITE
                     ("(Sorted by creation date & time, ascending; "+
                      "then by sectors, descending)":
                      IVAR ("LINE_WIDTH"):
                      "CENTER") );

            IF OUTRECSIZE () < 132 THEN
                WRITELN
                    (STRWRITE
                        (" (creator and sectors omitted "+
                         "on terminal display)":
                         IVAR ("LINE_WIDTH"):
                         "CENTER") );

            WRITELN (" ");

            WRITELN (MPEXHEADER1);

            WRITELN (MPEXHEADER2);

            WRITELN (" ");
          END
    END

  ONBREAKAFTER 1
    BEGIN
      WRITELN
          (RPT (".",IVAR ("LINE_WIDTH") ) );

      WRITELN
          ("Totals for creation date of ",
           CREDATE:'%0D %1M %0Y',
           ",    ",
           FMTCOMMA (TOTAL (1,1) ):7:"R",
           " file(s), ",
           FMTCOMMA (TOTAL (1,SECTORS) ):10:"R",
           " sector(s)");

      WRITELN
          (RPT ("=",IVAR ("LINE_WIDTH") ) );

      WRITELN (" ");
    END

    DO
      BEGIN
        IF OUTRECSIZE () < 132 THEN
            WRITELN
                (FILE:8,
                 ".",
                 GROUP:8,
                 ".",
                 ACCOUNT:8,
                 " ",
                 CODE:5,
                 " ",
                 CREDATE:'%0D %1M %0Y',
                 RPT (" ",3),
                 MODDATE:'%0D %1M %0Y',
                 RPT (" ",3),
                 ACCDATE:'%0D %1M %0Y',
                 RPT (" ",3),
                 RSTDATE:'%0D %1M %0Y')
        ELSE
            WRITELN
                (FILE:8,
                 ".",
                 GROUP:8,
                 ".",
                 ACCOUNT:8,
                 " ",
                 CREATOR:8,
                 " ",
                 CODE:5,
                 " ",
                 CREDATE:'%0D %1M %0Y',
                 RPT (" ",3),
                 MODDATE:'%0D %1M %0Y',
                 RPT (" ",3),
                 ACCDATE:'%0D %1M %0Y',
                 RPT (" ",3),
                 RSTDATE:'%0D %1M %0Y',
                 RPT (" ",4),
                 FMTCOMMA (SECTORS):10:"R");
      END

  FINALLY
    BEGIN
      WRITELN
          ("Totals for all creation dates",
           RPT (" ",13),
           FMTCOMMA (TOTAL (0,1) ):7:"R",
           " file(s), ",
           FMTCOMMA (TOTAL (0,SECTORS) ):10:"R",
           " sector(s)");

      BVARSET ("END_OF_FILESET",TRUE);

      WRITELN (" ");

      WRITELN (" ");

      WRITELN
          (RPT (" ", (IVAR ("LINE_WIDTH") - 48) ),
           SVAR ("AUSPICES"),
           "'s CREDATE, revision: ",
           VEFINFO ("CREDATE.LISTF.VESOFT").MODDATE,
           ", ",
           VEFINFO ("CREDATE.LISTF.VESOFT").MODTIME);

      IF BVAR ("LISTF_TEST") = TRUE THEN
          BEGIN
            WRITELN (" ");

            WRITELN ("Start of debugging information");

            WRITELN (" ");

            WRITELN ("   LEN (OUTBUFFER) = ",
                     STRWRITE (LEN (OUTBUFFER):12),
                     "   OUTRECSIZE () = ",
                     STRWRITE (OUTRECSIZE ():12) );

            WRITELN (" ");

            WRITELN ("   OUTBUFFER = ");

            WRITELN (OUTBUFFER);
          END
    END

</pre>



-- Main.ChrisBartram - 09 Jun 2006