|
midrange.com
This is a multi-part message in MIME format.
--
[ Picked text/plain from multipart/alternative ]
I’m using a timestamp (type “Z”) field with INZ(*SYS) to stamp added
records.
Somewhere in the program (my debug Watch says it happens when I CHECKR on a
completely different field) the timestamp becomes garbage and ends up
looking like this: ’01-10- 23-10.16.42.927000’ instead of
‘2001-10-23-10.16.42.927000’
This is a production program and I’m pretty sure I’m NOT using pointers.
And I’m having the same problem with a couple of other similar programs;
this is the first time they’ve run on my V5R1 box. I’d attach a snapshot of
the DEBUG but it will get dropped…
Has anybody else experienced this problem?
Thanks,
Rf
H/copy qrpgclesrc,xxr000
Fxclsxport ip e disk
Fqprint o f 132 printer
Faap002 uf e k disk
Fnul00502 uf a e k disk
Farp001 uf a e k disk
Fncp001 if a e k disk
Fncl00201 if a e k disk
Farl00203 if a e k disk
Fncp004 if a e k disk
D $acct s 7 0 inz(44770)
D $uc c
const('ABCDEFGHIJKLMNOPQRSTUVWXYZ')
D $lc c
const('abcdefghijklmnopqrstuvwxyz')
D $new s n
D @nodups s 1
D @return s 2
D/copy qrpgclesrc,xxr001
//start of /COPY (included for clarity)
D/eject
D sds
D @@pgm 1 10
D @@sc 11 15 0
D @@psts 16 20 0
D @@sn 21 28
D @@rout 29 36
D @@prms 37 39 0
D @@em 40 46
D @@inst 47 50
D @@msgw 51 80
D @@plib 81 90
D @@emsg 91 170
D @@excp 171 174
D @@file 201 208
D @@fsd 209 243
D @@job 244 253
D @@user 254 263
D @@jobn 264 269
D @@date 276 281 0
D @@time 282 287 0
D @@cdat 288 293 0
D @@ctim 294 299 0
D $off c const('0')
D $false c const('0')
D $on c const('1')
D $true c const('1')
D $nrf c const('1')
D$$ ds
D $$city 20 inz
D $$cty 15 inz
D $$ctry 2 inz
D $$cust 7 inz
D $$date 7p 0 inz(0)
D $$emp 7p 0 inz(0)
D $$mseq 9p 0 inz(0)
D $$ordr 7p 0 inz(0)
D $$oseq 9p 0 inz(0)
D $$pnam 7 inz(' ')
D $$pro 11p 0 inz(0)
D $$quotation 10a inz(' ')
D $$reg 2 inz
D $$ro 7p 0 inz(0)
D $$routing 10a inz(' ')
D $$scac 6 inz
D $$segment 10a inz(' ')
D $$st 2 inz
D $$tid 5 inz
D $$trip 7p 0 inz(0)
D $$unit 15 inz
D $$zip 6 inz
D $$zone 3 inz
D $errormsgid s 7
D $partycode s 2
D $retcd s 2
D $iso_date s d inz(*loval)
D $iso_time s t inz(*loval)
D $null_date s d inz(*loval)
D $null_time s d inz(*loval)
D $iso_cur_date s d inz(*sys)
D $iso_cur_time s t inz(*sys)
D $timestamp s z inz(*sys)
D/eject
//End of /COPY (included for clarity)
D/copy qrpgplesrc,aar404pr
D/copy qrpgplesrc,nur905pr
D/copy qrpgplesrc,zzr030pr
Ixport
I $company04 l1
I $address05 l1
I $city06 l1
C* $used02 cabeq *blanks tag999
C $company04 cabeq *blanks tag999
C $ramp22 cabeq *blanks tag999
C eval nmcust Ð*blanks
C eval $new Ð*on
C clear cmrec
C* if $dicode21 > *blanks
Check for short name
C* eval nmname Ð'V-' + $dicode21
C* nmname chain arl00203
C* if %found
C* eval $new Ð*off
C* eval cmcust Ðnmcust
C* endif
C* endif
C* if $delcode23 > *blanks and cmcust Ð*blanks
Check for short name
C* eval nmname Ð'V-' + $delcode23
C* nmname chain arl00203
C* if %found
C* eval $new Ð*off
C* eval cmcust Ðnmcust
C* endif
C* endif
C eval nmname Ð'V-' + $company04
C nmname chain arl00203
C if %found(arl00203)
C eval $new Ð*off
C eval cmcust Ðnmcust
C endif
C cmcust chain arp001
C if $company04 < 'A'
C eval $company04 Ð%triml($company04)
C endif
C eval cmname Ð$company04
C eval cmabbr Ð$company04
C $lc:$uc xlate $address05 cmadr1
C eval cmcity Ð$city06
C eval cmst Ð$stpr07
C exsr subr01
C eval cmscac Ð%subst(cmname:1:6)
C select
C when $company04 Ð'CN'
C eval cmscac Ð'CNRR99'
C when $company04 Ð'CITY CARTAGE'
C eval cmscac Ð'CITY'
C when %subst($company04:1:4) Ð'CMX'
C eval $company04 Ð'CMX'
C eval cmscac Ð'CMX999'
C when $company04 Ð'DDI TRANSPORTATION'
C eval cmscac Ð'DDI999'
C when $company04 Ð'DISPATCH TRANSPORTATION
INC.'
C eval cmscac Ð'DISP99'
C when $company04 Ð'G.P.S.'
C eval cmscac Ð'GPS999'
C when $company04 Ð'BERRY & SMITH'
C eval cmscac Ð'BERSM9'
C when $company04 Ð'INTERMODAL WEST'
C eval cmscac Ð'IMW999'
C when $company04 Ð'MORGAN SOUTHERN'
C eval cmscac Ð'MORS99'
C when $company04 Ð'TENNESSEE EXPRESS'
C eval cmscac Ð'TENN99'
C when $company04 Ð'GEMINI'
C eval cmscac Ð'GEMI99'
C when $company04 Ð'GREAT POINT INTERMODAL'
C eval cmscac Ð'GEMI99'
C when $company04 Ð'ARL INC'
C eval cmscac Ð'ARL999'
C when cmname Ð'SOUTHERN CALIFORNIA MOTOR
DEL'
C eval cmscac Ð'SO CAL'
C endsl
C testn $cophon10 999999
C 99 move $cophon10 cmphon
C testn $cofax14 999999
C 99 move $cofax14 cmfax
C testn $diphon18 999999
C 99 move $diphon18 cmshpp
C 99 move $diphon18 cmrcvp
C testn $difax20 999999
C 99 move $difax20 cmshpf
C 99 move $difax20 cmrcvf
C eval cmausr Ð$addby30
C *ymd/ move $addon31 $iso_date
C *cymd move $iso_date cmadat
C
C eval cmuusr Ð$chgby32
C *ymd/ move $chgon32 $iso_date
C *cymd move $iso_date cmudat
C if not %found(arp001)
C eval $$pnam Ð*blanks
C callp aar404($$pnam:
C cmcity:
C cmst:
C cmzip:
C cmcnty:
C cmctry:
C cmtid:
C $$zone:
C $$reg:
C 'Y':
C @return)
C if $new
C movel(p) '$$LCN' tbdkey
C tbdkey chain tbdrec 99
C add 1 tbdnd2
C z-add tbdnd2 wrk7n0 7 0
C move wrk7n0 cmcust
C update tbdrec
C clear tbdrec
C endif
C eval cmgrp Ð'*CLS'
C eval cmstat Ð'A'
C eval cmcls Ð'V'
C eval cmsns Ð1
C eval cmsnb Ð1
C eval cmptyc Ð'C'
C eval cmctid Ð'GO'
C eval cmlang Ð'E'
C eval cmcur Ð'US'
C if cmctry Ð'CA'
C eval cmcur Ð'CA'
C endif
C if cmctry Ð'ME'
C eval cmlang Ð'S'
C endif
C if cmst Ð'PQ' or cmst Ð'QC'
C eval cmlang Ð'F'
C endif
C write cmrec
C* if $dicode21 > *blanks
C* clear nmrec
C* eval nmcust Ðcmcust
C* eval nmname Ð$dicode21
C* write nmrec
C* endif
C* if $delcode23 > *blanks and
C* $delcode23 <> $dicode21
C* clear nmrec
C* eval nmcust Ðcmcust
C* eval nmname Ð$delcode23
C* write nmrec
C* endif
C endif
C if not %found(arl00203)
C eval nmname Ð'V-' + $company04
C eval nmcust Ðcmcust
C write nmrec
C endif
C if cmscac Ð'SO CAL'
C eval nmname Ð'V-' + 'SO CAL'
C eval nmcust Ðcmcust
C write(e) nmrec
C endif
C if %found(arp001)
C update cmrec
C endif
C eval nclacct Ðcmcust
C nclacct chain ncl00201
C if not %found(ncl00201)
C
C eval nclscac Ðcmscac
C
C *ymd/ move $addon31 $iso_date
C move $iso_date nclats
C move $iso_date ncleffdt
C eval nclauser Ð$addby30
C eval nclaws Ð@@pgm
C
C *ymd/ move $chgon32 $iso_date
C move $iso_date nclcts
C eval nclcuser Ð$chgby32
C eval nclcws Ð@@pgm
C
C write nclrec
C
C endif
C $nu klist
C kfld nuncust
C kfld nunjob
C kfld nuniadt
C kfld nunname
C time $timestamp //I added this
to make the program work
C if $coname09 > *blanks
C eval nuncust Ðcmcust
C eval nunjob Ð*blanks
C eval nuniadt Ð*loval
C eval nunname Ð$coname09
C $nu chain nul00502
C eval nunnamef Ð$coname09
C testn $cophon10 999999
C 99 move $cophon10 nunphone
C testn $cofax14 999999
C 99 move $cofax14 nunfax
C eval nuncts Ð$timestamp //’Caus it used
to blow up here
C eval nuncuser Ð@@user
C eval nuncws Ð@@pgm
C if not %found(nul00502)
C callp nur905(nunseq:$errormsgid)
C eval nunats Ð$timestamp
C eval nunauser Ð@@user
C eval nunaws Ð@@pgm
C write nunrec
C endif
C
C if %found(nul00502)
C update nunrec
C endif
C endif
C eval nuncust Ðcmcust
C eval nunjob Ð'DISPATCH'
C eval nuniadt Ð*loval
C eval nunname Ð*blanks
C $nu chain nul00502
C eval nunnamef Ð'Dispatch'
C testn $diphon18 999999
C 99 move $diphon18 nunphone
C testn $difax20 999999
C 99 move $difax20 nunfax
C eval nuncts Ð$timestamp
C eval nuncuser Ð@@user
C eval nuncws Ð@@pgm
C if not %found(nul00502)
C callp nur905(nunseq:$errormsgid)
C eval nunats Ð$timestamp
C eval nunauser Ð@@user
C eval nunaws Ð@@pgm
C write nunrec
C endif
C
C if %found(nul00502)
C update nunrec
C endif
C if $ramp22 <> *blanks
C callp zzr030($ramp22)
C ' ' checkr $ramp22 j 3 0
//Debug WATCH trapped a change to $TIMESTAMP here
C if %found
C eval ncpscac Ðcmscac
C eval ncpacct Ðcmcust
C eval ncpstpr Ð%subst($ramp22:j-1:2)
C eval ncpcity Ð%subst($ramp22:1:j-2)
C eval ncpsta Ð%subst($ramp22:1:j-2)
C ' ' checkr ncpcity j
C if %found and %subst(ncpcity:j:1) Ð','
C eval ncpcity Ð%subst(ncpcity:1:j-1)
C endif
C ' ' checkr ncpsta j
C if %found and %subst(ncpsta :j:1) Ð','
C eval ncpsta Ð%subst(ncpsta :1:j-1)
C endif
C $ncp klist
C kfld ncpscac
C kfld ncpacct
C kfld ncpctry
C kfld ncpstpr
C kfld ncpcty
C kfld ncpcity
C kfld ncpsta
C time $timestamp //I added this
to make the program work
C $ncp chain ncp004
C if not %found(ncp004)
C eval ncpats Ð$timestamp
C eval ncpauser Ð@@user
C eval ncpaws Ð@@pgm
C eval ncpcts Ð$timestamp
C eval ncpcuser Ð@@user
C eval ncpcws Ð@@pgm
C write ncprec
C endif
C endif
C endif
C cmscac cabeq *blanks tag999
C $nch klist
C kfld nchscac
C kfld nchacct
C clear nchrec
C eval nchscac Ðcmscac
C nchscac chain ncp001
C if not %found(ncp001)
C eval nchacct Ðcmcust
C eval nchstat Ð'A'
C *ymd/ move $addon31 $iso_date
C move $iso_date nchcts
C eval nchcuser Ð$addby30
C eval nchcws Ð@@pgm
C *ymd/ move $chgon32 $iso_date
C move $iso_date nchats
C eval nchauser Ð$chgby32
C eval nchaws Ð@@pgm
C write(e) nchrec
C endif
C tag999 tag
C subr01 begsr
C eval cmzip Ð*blanks
C eval cmzip4 Ð*blanks
C $lc:$uc xlate $zip08 $zip08
C select
C when %subst($zip08:6:1) Ð'-'
C eval cmzip Ð%subst($zip08:1:5)
C eval cmzip4 Ð%subst($zip08:7:4)
C when %subst($zip08:4:1) Ð*blanks
C eval cmzip Ð%subst($zip08:1:3) +
C %subst($zip08:5:3)
C other
C eval cmzip Ð$zip08
C endsl
C endsr
C *inzsr begsr
C $ncp02 klist
C kfld ncpacct
C kfld ncpsta
C endsr
Oqprint e exc001
O cmcust
O cmname +1
O cmcity +1
O cmst +1
O cmscac +2
O ncpsta +2
O 99 +1 '**'
D/copy qrpgplesrc,zzr030
--
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
