KFSO G 1 ; MODULE SLUITEN ORDERS; Quit naar %F10 Go naar KFSOA [ 09/17/2003  2:12 PM ]
 ;
1 N CorLevT,GenProd,NoSa,WeekDag,WekenVH2Klant,VerpakkingsType
 K UTA,UTB S UL=+UD,FP=UD*100+1 W @F,@F1 S SW12=1,X=@("^"_Q_UGL_"(KC,US,UR,1)"),UAF=$P(X,D,22),UTYP=$P(X,D,25)
 I UTYP="L" G 71
 I $L(UAF) K HalTOENr G 71:'$D(WLVW),71:'WLVW D ^KFLVWS G 71
 K WLVW S UZ=100
10 I KYW,KQG D  G YZ:K="-" S FP=+USM*100+1 W @F,@F1
 .S K="" Q
 .S R="K\"_+USM_"\3\HANDEL MET KWANTUMKORTING\""EXTRA KORTING TOEGEKEND   [] = JA   -[] = HERNEMEN""\1\\""-""[K\\"
 .D R0
100 K @("^"_Q_"HULP($J)")
2 S Q15="^(""W    0.0T""_UOD_$J(TR,6,0)_$J((UZ-100),3,0))"
 S UOD=$P(X,D,2),UOD=$TR($$EXTDATE^vhDTyp($$INTDATE^vhDTyp(UOD),"DS"),D,"")
3 S UZ=$N(@("^"_Q_UGL_"(KC,US,UR,UZ)")) G 9:UZ=-1 S U2=^(UZ),PR=$P(U2,D,2) G 3:'$L(PR)&($P($P(U2,D,17),"#")'="KF11")
 I $P($P(U2,D,17),"#")="KF11" D  G 3
 .S $P(U2,D,15)="",$P(U2,D,17)="KTO11"
 .S $P(U2,D,5)=$$REPLACE5^vhRtn1($P(U2,D,5),"Groep ","Gruppe","groep ","gruppe","stuks","stück","stuk","stück","GROEP ","GRUPPE")
 .S $P(U2,D,5)=$$REPLACE5^vhRtn1($P(U2,D,5),"gelijksluitend","gleichschliessend","GELIJKSLUITEND","GLEICHSCHLIESSEND","verschillend sluitend","verschieden schliessend","VERSCHILLEND SLUITEND","VERSCHIEDEN SCHLIESSEND")
 .S @("^"_Q_"HULP($J,0,UZ)")=U2
 G 3:$P(U2,D,14)["S",3:$P(U2,D,14)["Z",3:'$$MAGHANDEL^PRODUKT2(PR) I $P(U2,D,27) S UAF=2 G 3
5 S PSN=$P(@("^"_Q_"PR(PR,1)"),D,20),Y=^(0) G 3:$P(Y,D,23)="S"
 S PC=$P(Y,D,1),PST=$P(Y,D,14),PY=$P(Y,D,17),Y=^(2),PRE=$P(Y,D,9),PID=$P(Y,D,25),Y=$N(^("J")) G 3:$E(Y,1)'="J" S Y=^(Y)
50 S LEV=$P(Y,D,1),PLQ=$P(Y,D,6),PLL=$P(Y,D,7),PGV=$P(Y,D,16) S:'PGV PGV=1
 S WekenVH2Klant=1 S:LEV=6502 WekenVH2Klant=0 ; Additek
 I $P($G(^KPR(PR,"G")),D) S GenPRNr=$P(^KPR(PR,0),D,3) I GenPRNr,$P($G(^KPR(GenPRNr,0)),D,3)="GENPROD" G 3
 I 'PSN G 6:$P(U2,D,3)>(PST+PY+$P(U2,D,3)-PRE),3:$P(U2,D,3)<PLQ D S0 G 3:K="V",6
52 G 3:$P(U2,D,3)<PLQ,3:$P(U2,D,3)#PGV
 S ULT=$$INTDATE^vhDTyp(%WK,"DW")+(PLL+WekenVH2Klant*7) S ULT=$$EXTDATE^vhDTyp(ULT,"DW")
 G 3:$$INTDATE^vhDTyp(ULT,"DW")>$$INTDATE^vhDTyp($S($L($P(U2,D,29)):$P(U2,D,29),1:$P(U2,D,25)),"DW") D S0 G 3:K="V"
6 S R=^KLE(^KL1(LEV),2),CorLevT=$P(R,D,16),NoSa="" S:$P(R,D,3) NoSa="S"
 S VerpakkingsType=$$GetVerpakkingsType(PR)
 S R=$$LEVPR^KPRIJS(LEV,PR,NoSa),PA=$P(R,D),UEP=$P(R,D,4),PK1=$P(R,D,5),PK2=$P(R,D,6)
 S USP=$P(Y,D,28) S:'$L(USP) USP="E"
 S UBE=$J(UEP*$P(U2,D,3)/$P("1\100\1000",D,$F("EHM",USP)-1),0,2)
60 S UMC=$P(Y,D,17),UN=$J(PA*$P(U2,D,3)/$P("1\100\1000",D,$F("EHM",USP)-1),0,2)
 S WeekDag=$$EXTDATE^vhDTyp(,"DWN")
 S ULT=$P(U2,D,25) ; Levertermijn van het order
 S:ULT'?5N ULT=$$INTDATE^vhDTyp(ULT,"DW")
 S ULT=$$CALCDATE^vhDTyp(ULT,"W",-$S(PLL:WekenVH2Klant,ULT>$$CALCDATE^vhDTyp(,"W",1,"LD"):1,WeekDag>4:0,WeekDag<3:0,1:1)-CorLevT)
 S ULT=$$EXTDATE^vhDTyp(ULT,"DW") ; Levertermijn voor de toelevering
 S:LEV=5810 LEV=LEV_D_$TR($J(PLL,2)," ",0)
7 S @("^"_Q_"HULP($J,LEV,VerpakkingsType,UZ)")=D_$P(U2,D,2,4)_"\\"_UEP_D_PK1_"#"_PK2_"\\"_UN_D_UN_"\\L\\\\"_UBE_"\KTRPL\\\\"_USP_D_UMC_"\\\"_ULT_"\\"_UR_D_UZ_"\\\\\\\\" G 3
9 I $O(@("^"_Q_"HULP($J,0)"))="" K @("^"_Q_"HULP($J,0)")
 D:$D(@("^"_Q_"HULP($J,0)")) TEXTTOE
 S LEV=0,UJ="" I '$D(@("^"_Q_"HULP($J)")) S:'UAF UAF=1 G 33
90 S UJ="KOMM. "_$E($P(@("^"_Q_"KL(@(""^""_Q_""K1(KC)""),0)"),D,2),1,19)
11 S LEV=$N(@("^"_Q_"HULP($J,LEV)")) I LEV=-1 K @("^"_Q_"HULP($J)") S UAF=2 G 33
 D CheckVerpakkingsTypes(LEV)
 S VerpakkingsType=""
15 Set VerpakkingsType=$N(@("^"_Q_"HULP($J,LEV,VerpakkingsType)")) G 11:VerpakkingsType=-1
21 I '$G(HalTOENr) D
 .L (@("^"_Q_UGL_"(KC,US,UR)"),@("^"_Q_"TO(0,""TR"")"))
 .S TR=$$GETNUM^FLOW("KTO","KTO1")
 E  S TR=HalTOENr
 L (@("^"_Q_UGL_"(KC,US,UR)"),@("^"_Q_"TO($P(LEV,D),TR)"))
 K HalTOENr
27 S UMC="",UUZ=0,UZ=100
 S @("^"_Q_"TO($P(LEV,D),TR,1)")=D_$S($$INTDATE^vhDTyp($P(X,D,2))<$H:DT,1:$P(X,D,2))_D_UJ_"\\\"_$P(LEV,D)_D_UR_D_KC_"\\\\\\\\\\"_UMC_"\\\\2\\\\"
 S @("^"_Q_"TO1(TR)")=$P(LEV,D)_D
29 S UUZ=$N(@("^"_Q_"HULP($J,LEV,VerpakkingsType,UUZ)")),UZ=UZ+1
30 G 31:UUZ'=-1 S @("^"_Q_"TO($P(LEV,D),TR,0)")=UZ,$P(^(1),D,18)=UMC
 S (@("^"_Q_"TO1(TR)"),@("^"_Q_"TOB(TR)"))=$P(LEV,D)_D,@("^"_Q_"TO2($P(LEV,D),TR)")=""
 I $D(@("^"_Q_"TO(0,2)")) S TRLC=TR
300 S:LEV=5005 ^BLBeri("Z",TR)=LEV_D L @("^"_Q_UGL_"(KC,US,UR)")
 G 15
31 S Z=@("^"_Q_"HULP($J,LEV,VerpakkingsType,UUZ)") I $L($P(Z,D,2)) S $P(Z,D,13)=UZ-100
 S:$P(Z,D,17)="KTO11" $P(Z,D,15)=$$UNIEKLNR^FLOWTOE($P(LEV,D),TR)
 S @("^"_Q_"TO($P(LEV,D),TR,UZ)")=Z G 29:'$L($P(Z,D,2))
 S UMC=$P(Z,D,22)
 S ZZ=@("^"_Q_UGL_"(KC,US,UR,$P($P(Z,D,28),"";""))")
 D KWNODE^FLOWORD(KC,UR,$P($P(Z,D,28),";"))
 S @("^"_Q_UGL_"(KC,US,UR,$P($P(Z,D,28),"";""))")=$P(ZZ,D,1,26)_D_TR_D_UZ_D_$P(ZZ,D,29,99)
 D SWNODE^FLOWTOE($P(LEV,D),TR,UZ)
 Do ProductToeleveringLijnGemaakt^FLOWTOE2($P(LEV,D),TR,UZ)
 D SWNODE^FLOWORD(KC,UR,$P($P(Z,D,28),";"))
 G 29
33 G 33^KFSOA
71 S K=","
 ;
YZ K UJ,KL,LEV,PGV,PC,PID,PLQ,PST,PY,PRE,PB,PL,PLL,PM,PP,PPAR,PSN,TR,Q15,U2,UOD,UAF,ULV,UMC,PA,UN,UEP,UBE,ULT
 K UMC,USPPK1,PK2,UPAR,UPT,URR,UUZ,X,X1,X2,Y,Z,ZZ,UTYP,VTA
 Q
 ;
S0 I $G(VTA)="A" S K="T" Q
 S FP=1401 W @F,@F1,$C(13),?2,"IDENTNR : ",PID,?27,"PRODUKT  : ",PC S FP=1511 W @F,@F5 S FP=1502 W @F W:'PSN @F4,"NIET-ST",@F5 W:PSN " STOCK" S FP=1511 W @F,": ",(PST-$P(PRE,"#",2)+$P(U2,D,3))
 W !?2,"BESTELD : ",$P(PY,"#",2),!?2,"LEVERT  : ",$S($L($P(U2,D,29)):$P(U2,D,29),1:$P(U2,D,25)),!?2,"M BST H : ",PLQ,!?2,"AANTAL  : ",$P(U2,D,3)
 S R="VTA\"_+USM_"\3\LEVERING UIT VOORRAAD, VIA TOELEVERING OF ALLEN TOELEVERING\""V[] = VOORRAAD   T[] = TOELEVERING   A[] = ALLEN TOELEVERING""\1\\""VTA""[K&$L(K)" D R0
 S FP=1401 W @F,@F1
 Q
 ;
TEXTTOE 
 New K,R,Ask,OLNr,LEVNr,VerpakkingsType
 Set OLNr=100,Ask=0
 For  Set OLNr=$O(^KHULP($J,0,OLNr)) Quit:OLNr=""  Do
 .Set R=^KHULP($J,0,OLNr) Set:$P(R,D,18)="" Ask=1
 Set K=""
 If Ask Set R="K\"_+USM_"\3\"_$P($T(T1),U,2)_"\1\\"".""[K\\" Do R0
 Set OLNr=100
 For  Set OLNr=$O(^KHULP($J,0,OLNr)) Quit:OLNr=""  Do
 .Set R=^KHULP($J,0,OLNr)
 .If $P($P(R,D,18),";",4)["T"
 .Else  If $P(R,D,18)="",K="."
 .Else  Quit
 .Set LEVNr=0
 .For  Set LEVNr=$O(^KHULP($J,LEVNr)) Q:LEVNr=""  Do
 ..Set VerpakkingsType=""
 ..For  Set VerpakkingsType=$O(^KHULP($J,LEVNr,VerpakkingsType)) Q:VerpakkingsType=""  Do
 ...Set ^KHULP($J,LEVNr,VerpakkingsType,OLNr)=R
 Kill ^KHULP($J,0)
 Quit
 ;
 ; Ophalen verpakkingstype voor het uitsplitsen van de toeleveringen i.v.m. TBX
GetVerpakkingsType(PRNr)
 New VerpakkingsType
 Set VerpakkingsType=0
 Do:$$ISTBX^PRODUKT2(PRNr)
 . Set VerpakkingsType=$LG(##class(Prod.Kenmerk.DataDefinitie).Get("TBX",PRNr,"VERPAK"))
 . Set VerpakkingsType=$S(VerpakkingsType="":0,VerpakkingsType="P":"P","SZ"[VerpakkingsType:"SZ","OC"[VerpakkingsType:"OC","BA"[VerpakkingsType:"BA","KI"[VerpakkingsType:"KI",1:0)
 Quit VerpakkingsType
 ;
 ; Indien slechts 1 verpakkingstype, dan bij de 0 toevoegen
CheckVerpakkingsTypes(LEV)
 New VerpakkingsType
 Set VerpakkingsType=$O(^KHULP($J,LEV,0))
 If $L(VerpakkingsType),$O(^KHULP($J,LEV,VerpakkingsType))="" Merge ^KHULP($J,LEV,0)=^KHULP($J,LEV,VerpakkingsType) Kill ^KHULP($J,LEV,VerpakkingsType)
 Quit
 ;
T1 ;WENST U DE TEKSTLIJNEN IN DE TOELEVERING OP TE NEMEN\"[] = neen   .[] = ja"
 ;
R0 S R7="K'[D&(K'?.E1C.E)" S:$P(R,D,8)'="" R7=R7_","_$P(R,D,8) S:$P(R,D,7)'="" R7=R7_","_$P($T(@$P(R,D,7))," ",2,99)
R0A S R2=$P(R,D,2),R3=$P(R,D,3),R4=$P(R,D,4),R5=$P(R,D,5),R6=$P(R,D,6)
R0B S R0=$L(R4)+R3+3 S FP=R2*100+R3+F60 W @F W:R3<4 @F1 W @F2,R4," : " I R5'="" W:R5["""" !,?2,@R5 D:R5'["""" @R5
R0C S FP=R2*100+R0+F60 W @F,@F2 W $E("........................................",1,R6),@F,@F0
R0D R K S:$P(R,D,7)="DCTR" RD=$P(K,".",1),RM=$P(K,".",2),RJ=$P(K,".",3) W @F2 I $L(K)'>R6,@R7 S @$P(R,D,1)=K G R0F
R0E G R0C
R0F S FP=$P(R,D,9)*100+($P(R,D,10)*1) I FP W @F,$E("                                        ",1,R6),@F,K
R0Z K R,R0,R2,R3,R4,R5,R6,R7,RD,RM,RJ Q
 ;