/* PURPOSE: TSO PRINTOFF FOR MEMBER CURRENTLY DISPLAYED IN EDIT
    /* CONTRIBUTED:   F. DAVID MCRITCHIE             1989/05/11 BWTR
    /* USER CONTACT:  F. DAVID MCRITCHIE
    /* CODE MAINT.:   SYSTECH GROUP
    /*  RELATED CLISTS
    /*    @PRINT  USES PRINTOFF IF IT CAN OR CREATES A BATCH JOB
    /*      OTHERWISE.  CAN PRINT TO A PROFS USERID.
    /*    @VP     USES ONLY VSPRINT THE DATASET NAME IN EDIT
    /*      IS ADDED ON YOUR BEHALF.
  /**************************************************************
  /* DOCUMENTED  IS03.SHARE.TEXT(@VP)
  /* EXAMPLES:   ==> @VP                      GOES TO BWATER 3800
  /*             ==> @VP DOWN           GOES TO BWATER 3800-5 CLASS=2
  /*             ==> @VP DEST(P100E)          GOES TO SYSTECH PRINTER
  /*             ==> @VP SYSTECH              GOES TO SYSTECH PRINTER
  /*             ==> @VP DEST(CGDL2)          DALLAS --- XEROX PRINTER
  /*             ==> @VP CFO.LASER            CHARLOTTE - LASER PRINTER
  /*             ==> @VP CFO.LASER            CHARLOTTE - LASER PRINTER
  /*
  /* THE FOLLOWING ARE NORMAL VPSPRINT OPTIONS -- ALSO SEE DOCUMENTATED
  /*             ==> @VP DOUBLE               DOUBLE SPACING
  /* THERE ARE AT LEAST 60 ADDITIONAL OPTIONS, SOME OF THE MORE INTERESTING INCLUDE...
  /*         HEXSP/HEXS2('BYTES-ACROSS')
  /*         HX/HEX4/HEX8/X4/X8/XX
  /*         LMARGIN('INTEGER')
  /*
  /* THE FOLLOWING OPTIONS WILL CAUSE A BATCH JOB TO BE USED
  /*    CHARS(XXXX) GENERATES   CHARS=XXXX,
  /*    FCB(XXXX)   GENERATES   FCB=XXXX,
  /*    GTXX        GENERATES   FCB=XXXX,
  /*    SCRIPT  WHICH IMPLIES   FCB=8X11,CHARS=GT12,
  /****************************************************************
            CONTROL ASIS
 ISREDIT    MACRO (TOK1,TOK2,TOK3,TOK4,TOK5,TOK6,TOK7,TOK8,TOK9,TOK10,+
   TOK11,TOK12,TOK13,+
          TOK14,TOK15,TOK16,TOK17,TOK18,TOK19,TOK20,TOK21,TOK22,TOK23,+
             TOK24,TOK25,TOK26,+
          TOK27,TOK28,TOK29,TOK30,TOK31,TOK32,TOK33,TOK34,TOK35,TOK36,+
             TOK37,TOK38,TOK39)
        SET BLANKS = &STR(                          )
    ISREDIT (DSNX) = DATASET
    ISREDIT (MEMBERX) = MEMBER
        IF &STR(&MEMBERX) = &STR() THEN SET DSNXX = &DSNX
        ELSE SET DSNXX = &DSNX(&MEMBERX)
    ISREDIT (DCHG) = DATA_CHANGED
 /* OUTPUT FOR CLASS = A    UNLESS  SCRIPT,         */
 /*           IN WHICH CASE IT OUTPUTS TO CLASS Y   */
    SET COPIES = 1
    SET MSGCLASS = 9
    SET RP = &STR()
    IF &DCHG = YES THEN DO
       WRITE ******************************************************
       WRITE * YOUR FILE HAS NOT BEEN SAVED AFTER MAKING CHANGES  *
       WRITE *                                                    *
       WRITE * THE FILE PRINTED WILL NOT REFLECT CHANGES MADE IN  *
       WRITE *       THE  CURRENT EDIT SESSION                    *
       WRITE ******************************************************
       WRITE REPLY <ENTER KEY> TO PRINT OLD VERSION
       WRITE REPLY "SAVE"   | "SAV" TO SAVE THEN PRINT SAVED VERSION
       WRITE REPLY "CANCEL" | "CAN" IF YOU DO NOT WANT TO PRINT THE OLD
       READ PARM1
       IF &SUBSTR(1:3,&STR(&SYSCAPS(&PARM1.)   )) = CAN THEN DO
          WRITE TERMINATED BY YOUR COMMAND ... "CAN".
          SET &ZEDSMSG = &STR(TERMINATED)
          SET &XEDLMSG = &STR(CHANGES DONE SINCE LAST SAVE -- +
                      YOU HAVE REPLIED TO CANCEL @VP)
          SET &ZEDLMSG = &STR(&XEDLMSG.)
          ISPEXEC     SETMSG MSG(ISRZ000)
          EXIT CODE(8)
       END
       IF &SUBSTR(1:3,&STR(&SYSCAPS(&PARM1.)   )) = SAV THEN DO
          ISREDIT SAVE
          SET RC = &LASTCC.
          /* 0 - NORMAL SAVE, 4 - NEW MEMBER SAVED, 12 DATA NOT SAVED
          IF &RC. > 4  THEN DO
           WRITE ******************************************************
           WRITE * UNABLE TO SAVE YOUR FILE   RC = &RC.               *
           WRITE ******************************************************
           SET &ZEDSMSG = &STR(TERMINATED)
           SET &XEDLMSG = &STR(UNABLE TO SAVE CHANGES -- +
                       PERHAPS A COMPRESS IS NEEDED)
           SET &ZEDLMSG = &STR(&XEDLMSG.)
           ISPEXEC     SETMSG MSG(ISRZ000)
           EXIT CODE(8)
          END
          GOTO SAVED
       END
       SET &ZEDSMSG = &STR(PRINTED/OLD CONTENT)
       SET &XEDLMSG = &STR(CHANGES DONE SINCE LAST SAVE -- +
                   CONTENT PRINTED NOT SAME AS DISPLAYED...)
       SET &ZEDLMSG = &STR(&XEDLMSG.)
      ISPEXEC     SETMSG MSG(ISRZ000)
    END
  SAVED: -
    IF &STR(&DSNX) = &STR() THEN -
       EXIT CODE(12)
        SET BLANKS = &STR(&BLANKS&BLANKS)
        SET BLANKS = &STR(&BLANKS&BLANKS)
        SET BLANKS = &STR(&BLANKS&BLANKS)
        SET LP = &STR((
        SET RP = &STR())
        SET N0 = 20
        SET N  = 0
        SET I = 0
        SET L = 0
        /*********
        SET I = 1
       DO WHILE &I <= 100
        SET TOKEN = &&TOK&I
        SET TOKEN = &STR(&SYSCAPS(&TOKEN))
        IF DEBUG = &DEBUG THEN WRITE  &I  TOK&&I=&&TOK&I  TOKEN=&TOKEN
        IF &STR(&TOKEN) = &STR() THEN GOTO END_TOK
        IF &STR(&TOKEN) = SYSTECH | &STR(&TOKEN) = P100E | +
          &STR(&TOKEN) = TECH -
                                  | &STR(&TOKEN) = SYSTECH THEN DO
           SET REMAIN = &SYSNSUB(1,P100E &REMAIN.)
           GOTO NXT_TOK
        END
        IF HELP = &STR(&TOKEN) +
           THEN DO
             SET &&TOKEN.    = &STR(&TOKEN)
             IF DEBUG = &DEBUG THEN WRITE  &I  TOK&I=&TOK&&I  +
               TOKEN=&TOKEN
             GOTO NXT_TOK
           END
        IF &SUBSTR(1:5,&STR(&TOKEN)       ) = &STR(DEST&STR(&LP))  +
          THEN DO
           SET TOKEN = &SUBSTR(6:&EVAL(&LENGTH(&STR(&TOKEN))-1),+
             &STR(&TOKEN)         )
           SET REMAIN = &SYSNSUB(1,&TOKEN. &REMAIN.)
           ISREDIT LINE_BEFORE .ZF = NOTELINE +
               "REMOVED DEST( )  PASSING &TOKEN.  TO VPSPRINT"
           GOTO NXT_TOK
        END
        SET REMAIN = &SYSNSUB(1,&REMAIN. &TOKEN.)
 NXT_TOK: -
        SET I = &I + 1
      END
 END_TOK: SET I = &I
      IF &STR(&REMAIN.) = &STR() THEN SET REMAIN = LOCAL
       SET REMAIN = &SYSNSUB(1,'&DSNXX.' &REMAIN.)
      ISREDIT LINE_BEFORE .ZF = NOTELINE +
                "&SYSTIME. TSO VP &SYSNSUB(1,&REMAIN.)"
       VPSPRINT &REMAIN.
       SET RC = &LASTCC.
       IF 0 ^= &RC. THEN DO
          SET &ZEDSMSG = &STR(PRINTVPS -- RC=&RC.)
          SET &ZEDLMSG = &STR(&ZEDSMSG. -- ERROR MESSAGE WAS TYPED)
         ISREDIT     LINE_BEFORE .ZF    = NOTELINE "*ERROR** &ZEDLMSG."
          ISPEXEC     SETMSG MSG(ISRZ000)
       END
       EXIT CODE(1)
     /*****************************************************************
     /*****************************************************************