in_v2.rexxincl 29.11.2002 16:06:28
/**********************************************************************/
/* in_V2: input old V2-Format (Stuzza) */
/* out_V2: ouput old V2_Format */
/* needed for EDIFACT-Conversion (V3 --> V2 Konversion) */
/* : for example CREMUL.DEF */
/* (c) Th. Schneider, February 2002 */
/**********************************************************************/
in_V2_definition:
parse arg def
call init_V2
call open def
line_no=0
do while lines(def)>0
line=strip(linein(def));line_no=line_no+1
if char(line,1)='*' then iterate /* skip comments */
if line='' then iterate /* skip blank lines */
do while lastchar(line)='-' /* continuation line follows*/
linelen=length(line)
line=substr(line,1,linelen-1)!!strip(linein(def))
line_no=line_no+1
end
/* say line_no':'line */
linelen=length(line)
call parse_V2_definition_line
end
call close def
return
init_V2: /* init V2 definitions */
V2_type.=''
V2_id.=''
V2_name.=''
V2_req.='' /* M=mandatory, C=Conditional, N= ??, R= ?? */
V2_freq.=1
V2_field1.=0 /* index of first field of record */
V2_field2.=0 /* index of last field of record */
V2_codes.='' /* list of permitted codes, points to 'C' elements*/
V2_types='RT F C *' /* valid VT def record types */
/* RT=Record-Type, F=Field, C= Code*/
V2_RT.=0 /* Record-Type lookup table */
nn_V2=0
V2_Record.=0
n_Record_Types=0
n_V2_in=0 /* number of V2 input records */
n_V2_out=0 /* number of V2 output records */
return
parse_V2_definition_line:
parse var line type':'id':'name':'req':'form':'note
freq=1 /* default frequency is 1 */
if wordpos(type,V2_types)>0 then do
nn_V2=nn_V2+1
ii_V2=nn_V2
V2_type.ii_V2 =type
V2_id.ii_V2 =id
V2_name.ii_V2 =name
V2_form.ii_V2 =form
V2_req.ii_V2 =req /* M=mandatory, C=Conditional, N= ??, R= ?? */
V2_freq.ii_V2 =freq
V2_note.ii_V2 =note
end
if wordpos(type,V2_types)= 0 then do
call error 'illegal line-type:' type 'expected:' V2_types
return
end
select
when type='RT' then do /* Record Type */
if V2_lookup(id)<>0 then
call warning 'Duplicate defined Record-Type:' id
V2_Record.id=ii_V2
ii_V2_Record=ii_V2
ii_V2_Field=0;ii_V2_Code=0 =0
n_Record_types=n_Record_types+1
V2_Field1.ii_V2_Record=ii_V2+1
end
when type='F' then do /* new Field (elementary Field)*/
ii_V2_Field=ii_V2
V2_Field2.ii_V2_Record=ii_V2
end
when type='C' then do
if ii_V2_Field=0 then do
call error 'Code-record without preceeding Field definition'
return
end
ii_V2_Code=ii_V2
V2_codes.ii_V2_Field=V2_codes.ii_V2_Field' 'ii_V2
end
otherwise do
call error 'invalid type: 'type 'ignored'
end
end /* select type */
return
V2_lookup:
arg id1
return V2_Record.id1
display_V2:
parse arg rec_id2
if rec_id2 = '' then do /* all records wanted */
ivv1=1; ivv2=nn_V2
end
else do
ir=V2_lookup(rec_id2) /* specific record wanted */
if ir=0 then call abort 'unknown V2-record-id:' rec_id2
call info2 'Record: ' V2_name.ir
ivv1=V2_field1.ir
ivv2=V2_field2.ir
end
do ivv= ivv1 to ivv2
type=V2_type.ivv
select
when type='RT' then do /* record type */
call info2 'Record: ' V2_name.ivv
end
when type='F' then do
id=V2_id.ivv
e_id=right(V2_id.ivv,2)
e_name=left(V2_name.ivv,30)
e_form=left(V2_form.ivv,6)
e_val=V2.id
call info e_id ':' e_name ':' e_form ':' e_val
end
otherwise nop
end
end
return
out_V2:
parse arg rec_id
if opt_display then call display_V2 rec_id /* debug display */
ir=V2_lookup(rec_id) /* specific record wanted */
if ir=0 then call abort 'unknown V2-record-id:' rec_id 'in out_V2!'
ivv1=V2_field1.ir
ivv2=V2_field2.ir
rec_data=''
do ivv= ivv1 to ivv2
a_type=V2_type.ivv
if a_type <> 'F' then iterate /* skip codes */
a_id=V2_id.ivv
a_name=V2_name.ivv
a_form=V2_form.ivv
a_val=strip(V2.a_id) /* strip leading and trailing spaces */
a_class=substr(a_form,1,1) /* only 'd', 'n' or 'a' */
a_len=substr(a_form,2)
if pos('.',a_len) > 0 then do
parse var a_len a_len '.' a_dec
end
select
when a_class = 'n' then a_val=right(a_val,a_len,'0')
when a_class = 'a' then a_val=left(a_val,a_len)
when a_class = 'd' then a_val=right(a_val,a_len) /* date */
/* dates may be truncated from JJJJMMTT to JJMMTT !! */
otherwise do
call error 'invalid Type:' a_class 'for field: 'a_name ,
'in record type:' rec_id
call info 'only "a" and "n" allowed!'
call abort 'please correct V2.DEF'
end
end
rec_data=rec_data!!a_val /* build record-data */
end
call lineout V2_file,rec_data
n_V2_out=n_V2_out + 1
return
in_V2:
if lines(V2_file) = 0 then return '' /* nullstring is EOF */
V2_rec=linein(V2_file)
V2_rec_type=substr(V2_rec,119,2)
ir=V2_lookup(V2_rec_type) /* specific record wanted */
if ir=0 then call abort 'unknown V2-record-type:' V2_rec_type,
'in file:' V2_file
ivv1=V2_field1.ir
ivv2=V2_field2.ir
a_loc=1
do ivv= ivv1 to ivv2
a_type=V2_type.ivv
if a_type <> 'F' then iterate /* skip codes */
a_id=V2_id.ivv
a_name=V2_name.ivv
a_form=V2_form.ivv
a_val=strip(V2.a_id) /* strip leading and trailing spaces */
a_class=substr(a_form,1,1) /* only 'n' or 'a' */
a_len=substr(a_form,2)
if pos('.',a_len) > 0 then do
parse var a_len a_len '.' a_dec
end
else a_dec=0
a_val=substr(V2_rec,a_loc,a_len)
select
when a_class = 'n' then do
a_val=strip(a_val,'L','0') /* strip leading zeros */
if length(a_val) < a_dec+1
then a_val=right(a_val,a_dec+1,'0')
if a_dec>0 then do
n_dec=a_dec /* fixed number of decimals given */
n_digs=length(a_val)
f_int=substr(a_val,1,n_digs-2)
f_dec=substr(a_val,n_digs-1,2)
f_val=f_int'.'f_dec /* fixed value with comma now */
a_val=f_val
end
else V2.a_id=a_val
if datatype(a_val) <> 'NUM' then do
call error 'V2 field:' a_id':' a_name '=' a_val,
'is NOT numeric, ZERO assumed!'
a_val=0
end
V2.a_id=a_val
end
when a_class = 'a' then do
V2.a_id=strip(a_val,'T',' ') /* strip trailing spaces*/
end
when a_class = 'd' then do /* DATE */
V2.a_id=a_val /* dates no change */
end
otherwise do
call error 'invalid Type:' a_class 'for field: 'a_name ,
'in record type:' V2_rec_type
call info 'only "d", "a" and "n" allowed!'
call abort 'please correct V2.DEF'
end
end
a_loc=a_loc + a_len /* increase position */
end
n_V2_in=n_V2_in+1
return V2_rec_type