|
Have you checked the prototype for zzr030? You pass value $ramp22 to it, is something happening to it in that module (zzr030)? Eric DeLong Sally Beauty Company MIS-Sr. Programmer/Analyst 940-898-7863 or ext. 1863 -----Original Message----- From: Reeve Fritchman [mailto:reeve@ltl400.com] Sent: Tuesday, October 23, 2001 1:52 PM To: Rpg400-L@Midrange. Com Subject: Corrupted timestamps? Code included...but you're not allowed to snicker. 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 //=92Caus 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 -- _______________________________________________ This is the RPG programming on the AS400 / iSeries (RPG400-L) mailing list To post a message email: RPG400-L@midrange.com To subscribe, unsubscribe, or change list options, visit: http://lists.midrange.com/cgi-bin/listinfo/rpg400-l or email: RPG400-L-request@midrange.com Before posting, please take a moment to review the archives at http://archive.midrange.com/rpg400-l.
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.
midrange.com
