tldm-universe/Ardent/UV/APP.PROGS/PR.RECORD.B

******************************************************************************
*
*	PRINT.RECORD subroutine for PI/open COPY verb
*
*	Module	%M%	Version	%I% 	Date	%H%
*
*	(c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
*	This is unpublished proprietary source code of Ardent Software Inc.
*	The copyright notice above does not evidence any actual or intended
*	publication of such source code.
*
*******************************************************************************
*
*	Maintenance log - insert most recent change descriptions at top
*
*	Date.... GTAR# WHO Description.........................................
*	10/14/98 23801 SAP Change copyrights. 
*	10/17/95 15321 SHJ Fix output when field number is greater than 10000
*	04/28/95 16448 LDG Added UNICODE version of HEX.SW for NLS.
*	03/28/95 13618 SHK Fix spacing problems with CRT
*	07/30/93 10871 WLG Fix CRT for null fields not to print space.
*	07/16/93 10871 EAP Minor changes for Universe compatibility
*	06/25/93 10871 EAP Ported PI/open COPY verb to Universe
*******************************************************************************
*
* START-DESCRIPTION :
*
*  This subroutine prints one record on the terminal or printer, in the
*  format required by the COPY and LIST.ITEM verbs.  It is called as
*  follows:
*
*      CALL -PRINT.RECORD( RECORD.ID, RECORD, LPTR.NO, LPTR.WIDTH,
*               NUM.SUPPRESS.FLAG, ID.SUPPRESS.FLAG, HEX.SW)
*
*  Arguments (all input):
*
*     RECORD.ID           The ID of the record to be printed.
*
*     RECORD              The text of the record to be printed.
*
*     LPTR.NO             The printunit on which to print.  If terminal
*                         output is required, LPTR.NO should be set to
*                         zero, and PRINTER OFF should be in effect.
*
*     LPTR.WIDTH          The effective line width of the output device,
*                         i.e. the actual device width LESS any margin
*                         that may be in effect.
*
*     NUM.SUPPRESS.FLAG   If true, the line numbers which normally appear
*                         on the output will be suppressed.
*
*     ID.SUPPRESS.FLAG    If true, the record ID, which is otherwise
*                         output before the text of the record, will be
*                         suppressed.
*
*     HEX.SW              If >0, the text of the record will be output
*                         in hexadecimal (using MX0C conversion).
*                         If -1, the text will be output in Unicode 4-digit
*                         hexadecimal format (using MU0C conversion).
*
* END-DESCRIPTION
*
*  START-DESIGN:
*
*  END-DESIGN
*
*  START-FUTURES:
*
*  1.  The OCONV for the HEX option will only convert input strings up to
*      93 characters. LOOP required to feed OCONV substrings and conactenate
*      the output.
*
*  END-FUTURES
*
*  START-CODE:
*
*  START-LOCALIZATION
*
*  END-LOCALIZATION
*
      SUBROUTINE PRINT.RECORD (RECORD.ID, RECORD, LPTR.NO, LPTR.WIDTH,
         NUM.SUP.SW, ID.SUP.SW, HEX.SW)
*
*
      INDENT = 5                        ;* EG. '0001 '
      IF LPTR.WIDTH <= INDENT THEN LINE.SPLIT = 80
         ELSE LINE.SPLIT = LPTR.WIDTH
      IF NOT(NUM.SUP.SW) THEN
         LINE.SPLIT -= INDENT
      END
      IF NOT(ID.SUP.SW) THEN
         PRINT ON LPTR.NO '     ' :RECORD.ID
      END

      DISPLAY.LINE.LENGTH = 0
      MAX.FIELD.COUNT = DCOUNT(RECORD,@FM)
*
      * Process all fields in record.
      FOR FIELD.COUNT = 1 TO MAX.FIELD.COUNT

         BEGIN CASE
         CASE HEX.SW > 0 
            RECORD.FIELD = OCONV(RECORD<FIELD.COUNT>,"MX0C")
            * Ensure also that line split is multiple of 2, so that a
            * hex character is not displayed split across a line:
            LINE.SPLIT -= MOD(LINE.SPLIT, 2)
         CASE HEX.SW = -1  ;* (don't use < 0, as HEX.SW can be '')
         * Unicode form wanted - caller should have checked NLS is on:
            RECORD.FIELD = OCONV(RECORD<FIELD.COUNT>,"MU0C")
            * Ensure also that line split is multiple of 4, so that a
            * Unicode character is not displayed split across a line:
            LINE.SPLIT -= MOD(LINE.SPLIT, 4)
         CASE 1
            RECORD.FIELD = RECORD<FIELD.COUNT>
         END CASE

         IF NOT(NUM.SUP.SW)
         THEN
	    IF FIELD.COUNT < 10000 THEN
              LINE.NO.DISPLAY = FMT(FIELD.COUNT, "4'0'R"):' '
	    END ELSE
              LINE.NO.DISPLAY = FMT(FIELD.COUNT, "5'0'R"):' '
	    END
         END ELSE
            LINE.NO.DISPLAY = ''
         END

         *
         * Split field if required. FMT will split the line up by inserting
         * text marks into the string ...
         *

         ORIGINAL.TEXT.MARKS = COUNT(RECORD.FIELD, @TM)
		 IF RECORD.FIELD # "" THEN
         		RECORD.TEMP = FMT(RECORD.FIELD, LINE.SPLIT : "L")
		 END ELSE
			RECORD.TEMP = ""
		 END
         TEXT.MARK.SEPARATED.FIELDS = DCOUNT(RECORD.TEMP, @TM)

         *
         * Now process string, we are ONLY interested in text marks, all
         * other marks should be ignored and left in the string. Also we
         * are only interested in text marks which have been put there by
         * FMT, others should be ignored and left. Use DISLEN to check the
         * text marks.
         *

         DISPLAY.LINE = FIELD(RECORD.TEMP, @TM, 1)
         IF ORIGINAL.TEXT.MARKS EQ 0
         THEN
            PRINT ON LPTR.NO LINE.NO.DISPLAY : TRIMB(DISPLAY.LINE)
            IF NOT(NUM.SUP.SW) THEN LINE.NO.DISPLAY = '     '
         END

         FOR LOOP.COUNTER = 2 TO TEXT.MARK.SEPARATED.FIELDS
            LINE.CHUNK = FIELD(RECORD.TEMP, @TM, LOOP.COUNTER)
            IF ORIGINAL.TEXT.MARKS EQ 0
            THEN
               PRINT ON LPTR.NO LINE.NO.DISPLAY : TRIMB(LINE.CHUNK)
               IF NOT(NUM.SUP.SW) THEN LINE.NO.DISPLAY = '     '
            END ELSE
               DISPLAY.LINE.LENGTH= LEN(DISPLAY.LINE:@TM:LINE.CHUNK)
               IF DISPLAY.LINE.LENGTH GT LINE.SPLIT
               THEN
                  PRINT ON LPTR.NO LINE.NO.DISPLAY : TRIMB(DISPLAY.LINE)
                  IF NOT(NUM.SUP.SW) THEN LINE.NO.DISPLAY = '     '
                  DISPLAY.LINE = LINE.CHUNK
               END ELSE
                  DISPLAY.LINE := @TM:LINE.CHUNK
               END
            END
         NEXT LOOP.COUNTER

         IF ORIGINAL.TEXT.MARKS NE 0
         THEN
            PRINT ON LPTR.NO LINE.NO.DISPLAY : TRIMB(DISPLAY.LINE)
            IF NOT(NUM.SUP.SW) THEN LINE.NO.DISPLAY = '     '
         END

      NEXT FIELD.COUNT

*      PRINT ON LPTR.NO

      RETURN

   END
*
*  END-CODE