tldm-universe/Ardent/UV/APP.PROGS/DC.ITEM4

subroutine DC.ITEM4( item, assoc.name, assoc.item, result )
*******************************************************************************
*
*
*	Convert dictionary item(s) from Pick to Uni*Verse format:
*		convert a single item
*
*	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.
*
*	The basis for this Pick-to-Uni*Verse dictionary converter was a
*	Microdata-to-Prime converter written by J. Michael Cannady and
*	Thomas J. Rauschenbach of Fulcrum Computer Group, Inc.  Ardent 
*	was granted permission to use that code by Infocel, Inc., a successor
*	of Fulcrum.
*
*******************************************************************************
*
*
*	Maintenence log - insert most recent change descriptions at top
*
*	Date.... GTAR# WHO Description.........................................
*	10/22/98 23801 SAP Change company name to Ardent
*	10/14/98 23801 SAP Change copyrights. 
*	08/01/89 - MR # 6152, put release four DC in release 5
*	10/22/86 - MR #3303, added missing "end" before "for i = 11 to
*				nbr.fields"				HBB
*	09/24/86 - MR #3257, bring across attributes > 10		HBB
*	09/23/86 - MR #3244, assume a null A/AMC to mean @ID		HBB
*	08/18/86 - MR #3102, changed DC.COMMON.DECL to DC.COMM.DECL	HBB
*	03/15/86 - MR history purged at 3.4.1, see previous release for changes
*
*******************************************************************************
*
*  Convert a single dictionary item from Pick to Uni*Verse format. 
*
*    Arguments:
*	item          - On entry, the Pick dictionary item to convert.  
*		  	On return, the Uni*Verse item to write.
*	assoc.name    - On entry, null.  On return, the name of any
*			"ASSOCnn" phrase to write to the dictionary.
*	assoc.item    - On entry, null.  On return, the association phrase
*			named by "assoc.name"
*	result        - Boolean: returned "true" if the conversion is 
*			successful, false otherwise
*
*******************************************************************************
*
$options DEFAULT
$include UNIVERSE.INCLUDE DC.COMM.DECL
*
    equ true to 1
    equ false to 0
    equ CR to char( 13 ) : char( 10 )
    CRT.COL = 26
    LPTR.COL = 26
    assoc.name = ""
    assoc.item = ""
    result = true
    pick.item = item
*
*
*
*
******************************************************************************
*
*   Look for associated multivalues.  On regular Pick systems, they're 
*   specified in attribute 4 in the forms "C;AMC[;AMC...;AMC]" and "D;AMC".  
*   On a Microdata, they're specified as correlatives in the forms
*   "D1;AMC[;AMC...;AMC]" and "D2;AMC".  For convenience, we seek out the 
*   Microdata form and change it to the Pick form before processing.
* 
******************************************************************************
*
    if pick.item< 8 > <> "" then
       assoc = ""
       for i = 1 to ( count( pick.item< 8 >, @VM ) + 1 )
          temp = pick.item< 8, i >
          if temp matches "D1;0X" then
             assoc = "C;" : temp[ 4, len( temp ) - 3 ]
             pick.item = delete( pick.item, 8, i, 0 )
          end else
             if temp matches "D2;1N0N" then
                assoc = "D;" : temp[ 4, len( temp ) - 3 ]
                pick.item = delete( pick.item, 8, i, 0 )
             end
          end
       next i  
       convert "," to ";" in assoc;		* in case they can't type
       pick.item< 4 > = assoc
    end
* 
******************************************************************************
*
*   Set up the new uni*Verse item.  It's seven attributes long. 
*
******************************************************************************
*
*
    universe.item = @FM : @FM : @FM : @FM : @FM : @FM : @FM
*
*
*
    A.AMC = pick.item< 2 >			;* set up COMMON variables
    if A.AMC = 0 or A.AMC = "" then 
	name = '@ID'
    end else
	if num( A.AMC ) then
	    if A.AMC = 9999 then
		name = "LEN( @RECORD )"
	    end else
		name = "@RECORD< " : A.AMC : " >"
	    end
        end else
*
*           << This check has to be here because CONVERT.VOC doesn't. >>
*
	    call @DC.MESSAGE( "Nonnumeric A/AMC: ", A.AMC )
	    result = false
	    return
	end
    end
    pick.item< 9 > = pick.item< 9 >[ 1, 1 ]
    if pick.item< 9 >= "U" then pick.item< 9 >= "L"    
    VTYPE = pick.item< 9 >
*
*
*
******************************************************************************
*
*   Now let's build the new uni*Verse item.
*
******************************************************************************
*
*
*   Strip leading spaces from correlative/conversion attributes.
*
    loop
    while pick.item< 8 >[ 1, 1 ] = " " do
       pick.item< 8 > = pick.item< 8 >[ 2, len( pick.item< 8 >)]
    repeat
    loop
    while pick.item< 7 >[ 1, 1 ] = " " do
       pick.item< 7 > = pick.item< 7 >[ 2, len( pick.item< 7 >)]
    repeat

    if pick.item< 8 > = "" and A.AMC <> 9999 then
       universe.item< 1 > = "D"			;* Data type
       universe.item< 2 > = pick.item< 2 >	;* Location = A/AMC
    end else
       universe.item< 1 > = "I " : A.AMC	;* I descriptor
       psource = pick.item< 8 >			;* Pick correlative
       ucode = ""				;* in COMMON
       universe.item< 8 > = psource		;* save correlative
       PARSE.ONLY = false			;* Really convert the code
       call @DC.CORR.CONV( pick.item< 2 >, name, psource, ucode, result )
       if result and ucode and psource = "" then
          convert @VM to ";" in ucode;
          universe.item< 2 > = ucode		;* I code from correlative
       end else
          if not( NO.ERR ) then
             ins FILE : " " : ITEM.NAME before ERR.REC< -1 >
          end
       end
*
*      Check for special Pick "size of record" item.
*
       if A.AMC = 9999 and universe.item< 2 > = "" then
           universe.item< 2 > = "LEN( @RECORD )"
       end 
              
    end
*
*
    if result then
        psource = pick.item< 7 >		  ;* Pick conversion(s)
        if psource then
           ucode = ""				  ;* in COMMON
           PARSE.ONLY = true			  ;* just check the syntax
           call @DC.CORR.CONV( pick.item< 2 >, name, psource, ucode, result )
           if result and ucode and psource = "" then
              universe.item< 3 > = ucode          ;* Uni*Verse conversion(s)
           end else
              if not( NO.ERR ) then
                 ins FILE : " " : ITEM.NAME before ERR.REC< -1 >
              end
           end
       end
    end
*
*
    universe.item< 4 > = pick.item< 3 >		;* Column heading
    universe.item< 5 > = pick.item< 10 > : VTYPE
*						;* Length and justification
    universe.item< 6 > = "M"			;* assume multivalued
*
*
    if pick.item< 4 > matches "D;0N" then;      * secondary associated mv
       universe.item< 7 > = "ASSOC" : pick.item< 4 >[ 3, len( pick.item< 4 > )]
    end else
       if pick.item< 4 > matches "C;0X" then;   * primary associated mv
	  assoc.name = "ASSOC" : pick.item< 2 >
          universe.item< 7 > = assoc.name
          assoc.item = ""
          assoc.item< 1 > = "PH"
          assoc.item< 2 > = ITEM.NAME
          for i = 2 to ( count( pick.item< 4 >, ";" ) + 1 )
             assoc.item< 2 > = assoc.item< 2 > : " " : field( pick.item< 4 >, ";", i )
          next i
          assoc.item< 2 > = trim( assoc.item< 2 >)
       end else
          universe.item< 7 > = ""
       end
    end
* 
*
*  << Allow for the clowns who keep extra stuff in their dictionaries. >>
*
   nbr.fields = dcount( pick.item, @AM )
   if nbr.fields > 10 then
      if universe.item< 1 > <> "D" then 
         if nbr.fields > 14 then
            call @DC.MESSAGE( "Truncating at attribute 14.", "" )
            nbr.fields = 14
         end
      end
      for i = 11 to nbr.fields
         if pick.item< i > <> "" then universe.item< i > = pick.item< i >
      next i
   end
   item = universe.item
*
*
   return
*
*
*
end