cI39M ;Conversie muntcodes ;%I39M ; [ 03/27/00 1:49 PM ] ; T1 ;Dit programma converteert de 'eigen' muntcodes naar de ISO-codes.; T2 ; T3 ; T8 ;Q-waarde(s) <; T9 ;Start ; ; ; init + uitleg 1 S Q=$G(Q) D ^cA604,MASTER^cQ5:'$D(boot) S QU=$G(QU,"DAM") 11 w !!,$P($T(+1),U,2),!! 13 f i=1:1 s j=$p($t(@("T"_i)),U,2) q:j="" w j,! ; ; vraagstelling 2 s qq=$g(^cLOG("Q"),Q) i $d(boot) s qq=$g(^cLOG(boot,"Q"),qq) 21 i $p(qq,D)="SYS" s qq=$p(qq,D,2,999) 23 i qq[D s qq=$tr(qq,D," ") 24 i qq[" Y" s qq=$p(qq," Y")_" "_$p($p(qq," YQ",2,999)," ",2,999) g 24 25 w !,$p($t(T8),U,2),qq,">" r k g YZ:k="-"!(k="^") i $l(k) s qq=k g 25 27 w !,$p($t(T9),U,2) r k g 25:"-^"[k&$l(k) s k=$tr(k,"JjYy1","11110") g 27:k'=1 29 s (JOB,tel)=0 ; ; aflopen Q-waardes 3 b 1 30 k ^HULP(boot,$J) s i="" f s i=$o(^ISO(0,"ISO.MUNT",i)) q:i="" s ^HULP(boot,$J,$p(^(i,0),D))="" 31 s Q=$p(qq," "),qq=$p(qq," ",2,999) i Q'?1.3U g 31:$l(qq),YZ 33 w !,Q,?5,$g(@("^"_Q_"BA(99,1)"),"?") 35 k ^HULP($t(+0),Q) s ^(Q)=DT_D_TD ; ; eigen muntcodes 4 k VM s i="" f s i=$o(@("^"_Q_"BA(11,i)")) q:i="" d . s VM(i)=$p(^(i),D) ; VM(eigen code)=off. code . i VM(i)="" s VM(i)=i 41 s i="" f s i=$o(VM(i)) q:i="" d . s j=0,sw=$d(^HULP(boot,$J,VM(i))) . i 'sw s ^HULP($t(+0),Q,i,"BA")=VM(i)_" is geen ISO-code!" . i i=VM(i) k VM(i) w:'sw !?5,i,?8," (geen ISO-code)" q . w !?5,i,?8," -> ",VM(i) i 'sw w " (geen ISO-code)" 43 h 10 ; ; boekhouding 5 s BF=$p(@("^"_Q_"BA(39)"),D) i BF="" s BF="BF" ; "oude" code 51 s BEF=$g(VM(BF),BF) ; nieuwe code 52 i BF="BF"!(BF="FB") S BEF="BEF",VM(BF)=BEF 53 w !,"Boekhouding:",BF,"->",BEF 54 s g="AR",bi=111,of=0 d S1 s g="ARA" d S1 55 i Q'="TC" s g="KL",of=1 d S1 s g="LE" d S1 56 s g="AA",bi=124,bi4=0 d S2 s g="VE" d S2 s g="AALOG",bi2=0 d S3 57 s g="AAB",bi=109 d S2 s g="VEB" d S2 58 s g="FI",bi=123,bi2=124 d S3 s g="FIE" d S3 59 s g="K3",bi=107,bi4=116 d S2 s g="L3" d S2 s g="L2",bi=110 d . w " ,",g s i1=0,v6=0 . f s i1=$o(@("^"_Q_g)@(i1)) q:i1="" d .. s vm=$p(^(i1),D,bi#100) .. s sw=$s(vm="":1,1:$d(VM(vm))) i sw d UPD .. i 'sw d LOG ; ; producten, aankoop en verkoop 6 s g="PR",v6=0 w " ",!,g f bi=131:1:135 s vm=$p($g(@("^"_Q_g)@(0,19)),D,bi#100),sw=$s($l(vm):$d(VM(vm)),1:0) d UPD:sw,LOG:$l(vm)&'sw 61 s g="PR_LE",v6=1,bi=117 d ; aankoop . w " ,",g s i1=0 f s i1=$o(^DATA(Q,g,i1)) q:i1="" d .. s vm=$p(^(i1,bi\100-1),D,bi#100) .. s sw=$s(vm="":1,1:$d(VM(vm))) i sw d UPD .. i 'sw d LOG .. s kc=$p(^(0),D),vm=$p(^(0),D,17) i kc,vm'=$$SG^cAFA1("LE",kc,111) s ^HULP($t(+0),Q,g,i1)=vm_" verschilt van leverancier "_kc_": "_$p(^(0),D,11) . d S1C ; patronen 62 s bi=118 f ugl="TO","TOL" d ; bons V6 . s g=ugl f s g=$o(^DATA(Q,g)) q:$p(g,".")'=ugl d .. w " ,",g s v6=1,i1=0 .. s i1=0 f s i1=$o(^DATA(Q,g,i1)) q:i1="" d ... s vm=$p(^(i1,bi\100-1),D,bi#100) ; hoofding ... s sw=$s(vm="":1,1:$d(VM(vm))) i sw d UPD ... i 'sw d LOG .. d S1C ; patronen 63 s bi=118 f ugl="OD","UL","TO","TOL" d ; bons V5 . w " ,",ugl s kc=0 f s kc=$o(@("^"_Q_ugl)@(kc)) q:kc="" d .. s us=0 f s us=$o(@("^"_Q_ugl)@(kc,us)) q:us="" d ... s g=ugl_"."_us,v6=0 ... s ur=0 f s ur=$o(@("^"_Q_ugl)@(kc,us,ur)) q:ur="" d .... s vm=$p(^(ur,bi\100),D,bi#100) ; hoofding .... s sw=$s(vm="":1,1:$d(VM(vm))) i sw d UPD .... i 'sw d LOG .... s uz=100 f s uz=$o(@("^"_Q_ugl)@(kc,us,ur,uz)) q:uz="" d ..... n bi ; detailln ..... s bi=122,vm=$p(^(uz),D,bi#100),sw=$s($l(vm):$d(VM(vm)),1:0) ..... d UPD:sw,LOG:$l(vm)&'sw ..... s bi=171,vm=$p(^(uz),D,bi#100),sw=$s($l(vm):$d(VM(vm)),1:0) ..... d UPD:sw,LOG:$l(vm)&'sw 64 s v6=0,bi=105 f g="FA","FU" d ; facturen . w " ,",g s us="" f s us=$o(@("^"_Q_g)@(us)) q:us="" d .. s fnr="" f s fnr=$o(@("^"_Q_g)@(us,fnr)) q:fnr="" d ... s vm=$p(^(fnr,0,0),D,bi#100) ... s sw=$s(vm="":1,1:$d(VM(vm))) i sw d UPD ... i 'sw d LOG 65 s v6=0,bi=105 f g="STKL","STLE" d ; statist. . w " ,",g s kc=0 f s kc=$o(@("^"_Q_g)@(kc)) q:kc="" d .. s pr=0 f s pr=$o(@("^"_Q_g)@(kc,pr)) q:'pr d ... s vm=$p(^(pr,0),D,bi#100) ... s sw=$s(vm="":1,1:$d(VM(vm))) i sw d UPD ... i 'sw d LOG ... s i3=0 f s i3=$o(@("^"_Q_g)@(kc,pr,i3)) q:i3="" d .... s i4=0 f s i4=$o(@("^"_Q_g)@(kc,pr,i3,i4)) q:i4="" d ..... s vm=$p(^(i4),D,bi#100) ..... s sw=$s(vm="":1,1:$d(VM(vm))) i sw d UPD ..... i 'sw d LOG ; ; specifieke gegevens 7 s g="TOA6",v6=0,bi=110 d ; AKP->BH . w " ,",g s kc=0 f s kc=$o(@("^"_Q_g)@(kc)) q:kc="" d .. s i2="" f s i2=$o(@("^"_Q_g)@(kc,i2)) q:i2="" d ... s i3="" f s i3=$o(@("^"_Q_g)@(kc,i2,i3)) q:i3="" d .... s vm=$p(^(i3),D,bi#100) .... s sw=$s(vm="":1,1:$d(VM(vm))) i sw d UPD .... i 'sw d LOG ; ; opkuis eigen muntcodes 9 s vm=$o(VM("")) i $l(vm) s i2=VM(vm) d k VM(vm) G 9 . i '$d(@("^"_Q_"BA")@(11,i2)) s ^(i2)=^(vm) . s $p(^(i2),D)=i2 i vm'=i2 k ^(vm) 91 s $p(@("^"_Q_"BA")@(39),D)=BEF 97 d ^cA106,^cA105 s $P(^HULP($t(+0),Q),D,3)=DT_D_TD 99 g 31 ; volgende Q-waarde ; YZ w ! Q ; UPD ; update UPDA s ref=$zr l +@ref UPDB i v6 d W^cAN220(g,9,i1,bi,$s(vm="":BEF,1:VM(vm))) i $d(@ref) UPDC i 'v6 s $p(@ref,D,bi#100)=$s(vm="":BEF,1:VM(vm)) UPDD l -@ref i 'JOB s tel=tel+1 w $e("/-\|",tel),$C(8) i tel=4 s tel=0 UPDZ q ; LOG ; log onbekende muntcodes LOGA s ref=$zr LOGB i '$d(^HULP(boot,$J,vm)) s ^HULP($t(+0),Q,vm,ref)="geen ISO-code" LOGC i $d(@ref) ; terugzetten naked reference LOGZ q ; S1 ; conversie signalitiek, openstaande facturen, openingspatronen S1A w " ,",g s i1=0,v6=$d(^DMS(Q,g)) S1B f s i1=$o(@("^"_Q_g)@(i1)) q:i1="" d . s vm=$p(^(i1,bi\100-1),D,bi#100) . s sw=$s(vm="":1,1:$d(VM(vm))) i sw d UPD . i 'sw d LOG . i of s i2=9999 f s i2=$o(@("^"_Q_g)@(i1,i2)) q:i2'?5.6N d .. s vm=$p(^(i2),D,9) ; facturen .. s sw=$s(vm="":1,1:$d(VM(vm))) i sw n bi,v6 s bi=109,v6=0 d UPD .. i 'sw d LOG S1C s v6=0 f s i1=$o(@("^"_Q_"BA")@("%A",1,g,i1)) q:i1="" d ; patronen . i i1=0 k ^(i1) q . s vm=$p(^(i1,bi\100-1),D,bi#100) . s sw=$s(vm="":1,1:$d(VM(vm))) i sw d UPD . i 'sw,vm'="?" d LOG S1Z q ; S2 ; conversie globals boekhouding op 2/4 niveaus S2A w " ,",g s i1=0,v6=0 S2B f s i1=$o(@("^"_Q_g)@(i1)) q:i1="" d . s i2=0 f s i2=$o(@("^"_Q_g)@(i1,i2)) q:i2="" i i2'["." d .. s vm=$p(^(i2),D,bi#100) .. s sw=$s(vm="":1,1:$d(VM(vm))) i sw d UPD .. i 'sw d LOG .. i bi4 s i3=0 f s i3=$o(@("^"_Q_g)@(i1,i2,i3)) q:i3="" d ... s i4=0 f s i4=$o(@("^"_Q_g)@(i1,i2,i3,i4)) q:i4="" d .... n bi s bi=bi4 .... s vm=$p(^(i4),D,bi#100) .... s sw=$s(vm="":1,1:$d(VM(vm))) i sw d UPD .... i 'sw d LOG .. s i2=i2+.99 S2Z q ; S3 ; conversie globals boekhouding op 3 niveaus S3A w " ,",g s i1=0,v6=0 S3B f s i1=$o(@("^"_Q_g)@(i1)) q:i1="" d . s i2=0 f s i2=$o(@("^"_Q_g)@(i1,i2)) q:i2="" d .. s i3=0 f s i3=$o(@("^"_Q_g)@(i1,i2,i3)) q:i3="" d ... s vm=$p(^(i3),D,bi#100) ... s sw=$s(vm="":1,1:$d(VM(vm))) i sw d UPD ... i 'sw d LOG ... i bi2 d .... n bi s bi=bi2 .... s vm=$p(^(i3),D,bi#100) .... s sw=$s(vm="":1,1:$d(VM(vm))) i sw d UPD .... i 'sw d LOG S3Z q ; ;----------------------------------------------------------- JOB(qq) ; gejobde ingang JOBA S $ZT="TRAP^cAN000" JOBB S D="\",U=";" D ^cA106,^cA105,QT^cQ5 S %Q1="FOUTTRAP",QU="DAM" JOBC L ^JOB($T(+0)):2 E G JOBZ JOBD I $ZV["MSM" D DEV I DEV S JOB=1 D 3 C DEV JOBZ H ; DEV S DEV=$$HFS^cQ9 I DEV<51!(DEV>54) S DEV=0 G DEVZ DEVA S I=$T(+0)_".TXT" DEVB O DEV:(I:"W"):2 E S DEV=0 G DEVZ DEVC U DEV:(I:"W") DEVZ Q ; ZZ ; 10.04.00 - 11 u 03 * V7.3