KTRPL G 1 ; MODULE REGISTREREN PRODUKTLIJNEN TOELEV.; Quit naar KTO10 - Do naar KF31 [ 09/24/2003   2:14 PM ]
 ;
M1 S MSG="MUNT PRODUKT NIET GELIJK AAN MUNT "_TOU G MY
M3 S MSG="ER IS GEEN LEVERANCIER GEOPEND VOOR DIT PRODUKT" G MY
M4 S MSG="LEVERANCIER PRODUKT NIET GELIJK AAN LEVERANCIER "_TOU G MY
M5 S MSG="PRODUKT IN GEBRUIK" G MY
M6 S MSG="GEEN MUNTKODE VOOR DIT PRODUKT" G MY
M7 S MSG="DEZE TOELEVERING MAG ENKEL 7-PRODUKTEN BEVATTEN" G MY
M8 S MSG="DEZE TOELEVERING MAG GEEN 7-PRODUKTEN BEVATTEN" G MY
M9 S MSG="DIT IS EEN MOEDER MET ""SOCKBEWEGING OVER KINDEREN""" G MY
MY S SW12=1,FP=2403+F60 W @F,@F2,@F4,MSG," [] = OK ",@F5,@F0 R K G YZ
 ;
1 K A S SW25=1,SW12=0,Q15="^(""W    0.0T""_UOD_$J(TR,6,0)_$J(UZ,3,0))"
3 S X=@("^"_Q_UGL_"(LC,TR,1)")
 S UOD=$TR($$EXTDATE^vhDTyp($$INTDATE^vhDTyp($P(X,D,2)),"DS"),D,"")
 S UI=$P(X,D,2),UJ=$P(X,D,3),UVM=$P(X,D,18)
5 G 9:K="." S K=K_" "
 I '$D(@("^"_Q_"PR1(K)")) S K=$$SELECT^PRODUKT6("L",LC) S:'K K="-" G YZ:K="-" S PR=K G 10
7 S PR=$P(@("^"_Q_"PR1(K)"),D,1) G 10
9 D ^KF31 G YZ:K="-"
10 S R=$P(^KPR(PR,0),D,3)
 I $L(R),R'?4.7N D  G YZ:K="-"
 .N PROld
 .S PROld=PR,R="S K=$$GENERATE^"_R_"(LC,PR,""L"")"
 .X R
 .S PR=K S:K=PROld!'K K="-"
 L (@("^"_Q_UGL_"(LC,TR)"),@("^"_Q_"PR(PR)")):2 E  G M5
11 S UA=0,X=@("^"_Q_"PR(PR,0)"),PC=$P(X,D,1),PST=$P(X,D,14),PY=$P(X,D,17)
 I $P(X,D,23)="S" S FP=2211 W @F,@F1,@F,PC G M9
12 S X=^(1),UE=$P(X,D,12),PSN=$P(X,D,20)
 G YZ:'$$IsCommAkt^PRODUKT2(PR,,,0)
 S X=@("^"_Q_"PR(PR,2)"),PRE=$P(X,D,9),PID=$P(X,D,25)
13 S FP=UL*100+1 W @F,@F1 S FP=1903+F60 W @F,$C(13),?2,"IDENTNR : ",?12,PID,?27,"PRODUKT  : ",PC
 I $E(PID)'=7,$$CHECKDO()=7 G M7
 I $E(PID)=7,$$CHECKDO()'=7 G M8
17 S X=$N(@("^"_Q_"PR(PR,""J"")")) G M3:$E(X,1,1)'="J",M4:$E(X,2,99)'=LC&(PR'=5667)
18 S X=@("^"_Q_"PR(PR,X)"),UMC=$P(X,D,17) G M6:"I"[UMC I $L(UVM)&(UVM'=UMC)&(PR'=5667) G M1
19 S ULT=$P(X,D,7),PLQ=$P(X,D,6),PGV=$P(X,D,16),USP=$P(X,D,28)
 G YZ:'$$CheckInsert(TR,PR)
 S FP=1903+F60 W @F
 N NoSa
 S NoSa=$$NoSaAankoop^PRODUKT2(PR)
 S R=$$LEVPR^KPRIJS(LC,PR,NoSa),PA=$P(R,D),UEP=$P(R,D,4),PK1=$P(R,D,5),PK2=$P(R,D,6)
20 I $H#7'=4,'PSN,ULT=1,LC=5005,$E(PID)'=7 S ULT=2
21 S:'$L(USP) USP="E"
 S ULT=$$INTDATE^vhDTyp(%WK,"DW")+(ULT*7)
 S ULT=$$EXTDATE^vhDTyp(ULT,"DW")
27 S R=PSN_D_(PST-$P(PRE,"#",2))_D_$P(PY,"#",2)_D_ULT_D_PLQ_D_UEP_D_PK1_D_PK2_D_PA_D_UMC_D_USP_D_PGV_D
 D ^KTRWL S:'PLQ PLQ=1 S:'PGV PGV=1
30 I $L($G(LevTerm)) S K=LevTerm K LevTerm
 E  S R="K\23\54\LEVERT \C1\5" D R0 G YZ:K="-",YZ:K=","
 I $L(K) D VALDATE^vhDTyp(K,"DW") G 30:'%TC D
 .S:K?.N&($P(%EXT,"/",2)<%WK) $P(%EXT,"/")=$$EXTDATE^vhDTyp($$CALCDATE^vhDTyp(,"J","+1"),"J")
 .S ULT=%EXT,FP=2039+F60
 .W @F,"     ",@F,ULT
33 I $G(Aantal) S (K,UA)=Aantal K Aantal
 E  S FP=2354 W @F,@F2 S R="UA\24\54\AANTAL \\6\\""-,""[K&$L(K)!(K?.N&(K>0))\\" D R0 G 30:K="-",YZ:K=","
 G 33:K<PLQ I K>PLQ G 33:K#PGV
37 I '$L(UVM) S X=@("^"_Q_UGL_"(LC,TR,1)"),X=$P(X,D,1,17)_D_UMC_D_$P(X,D,19,99),^(1)=X
39 S UC=PR,UBE=$J(UEP*UA/$P("1\100\1000",D,$F("EHM",USP)-1),1,2),UN=$J(PA*UA/$P("1\100\1000",D,$F("EHM",USP)-1),1,2),B(102)=PR,B(103)=UA,B(104)=UE,B(106)=UEP,B(107)=PK1_"#"_PK2
41 S (B(109),B(110))=UN,B(112)="L",B(113)=UZ,B(116)=UBE,B(117)="KTRPL",B(121)=USP,B(122)=UMC,B(125)=ULT
45 S UK="" S:PK1 UK=$J(PK1,4,1) S:PK2 UK=UK_" "_$J(PK2,4,1)
47 S ^KTO3(TR,UZ_D_D_(100+UZ))=""
 ;
YZ K MSG,PGV,PST,PC,PR,PA,UI,UJ,PID,PRE,PY,Q15,SW25,UE,UOD,X,%TC,%INT,%EXT L @("^"_Q_UGL_"(LC,TR)") Q
 ;
C1 S FP=2454+F60 W @F,"[] = VOORSTEL AANGENOMEN" Q
 ;
CHECKDO() 
 New R,PRNr,IDNr,Line
 Set Line="",IDNr=PID
 For  Set Line=$O(^KTO(LC,TR,Line),-1) Quit:Line'>100  Do  Quit:IDNr'=PID
 .Set R=^KTO(LC,TR,Line),PRNr=$P(R,D,2)
 .Set:PRNr IDNr=$P(^KPR(PRNr,2),D,25)
 Quit $E(IDNr)
 ;
 ; Controle of een product mag opgenomen worden in een toelevering (vooral voor DO)
CheckInsert(TOENr,PRNr)
 New I,K,Insert,LEVNr,BLKLNr,KLNr,Warn,U2,U3,IsDOToe,IsDOProd,TLNr
 Set Insert=1,LEVNr=$P(^KTO1(TOENr),D)
 ; Controle 'Blum' + 'DO'
 If LEVNr=5005 Do
 . Set IsDOProd=$$IsDOProd^FLOWTOE3(PRNr),BLKLNr=$P(^KTO(LEVNr,TOENr,1),D,9)
 . If BLKLNr Do  ; Het klantnummer is ingevuld, dus controle
 . . Set IsDOToe=$P(^BLBeri("K",BLKLNr),D,6)="DO"
 . . Set IsDOToe=$$IsDOToe^FLOWTOE3(TOENr)
 . . If 'IsDOToe,'IsDOProd Quit
 . . Set KLNr=$P(^BLBeri("K",BLKLNr),D,3)
 . . If KLNr Set Insert=BLKLNr=$P($G(^PRPUTZ("N",PRNr,KLNr,0)),D)
 . . Else  Set Insert=0 ; Geen VH-klant bekend (E12)
 . . Quit:Insert
 . . Set Warn="Product '"_$P(^KPR(PRNr,0),D)
 . . Set Warn=Warn_"'~is geen 'DO'-product"
 . . Set Warn=Warn_" voor "_$$BLKlant^FLOWTOE(BLKLNr,1)_"."
 . . Do WARN^vhTXTPOP(Warn,"")
 . Else  If IsDOProd Do  ; Het klantnummer is nog niet ingevuld, dus opvragen en invullen indien DO
 . . Set TLNr=100
 . . For  Set TLNr=$O(^KTO(LEVNr,TOENr,TLNr)) Quit:TLNr=""  Quit:$P(^KTO(LEVNr,TOENr,TLNr),D,2)
 . . If TLNr Set Insert=0 Do WARN^vhTXTPOP("Deze toelevering bevat reeds andere producten.","") Quit
 . . Set BLKLNr=$$KLSELECT^FLOWTOE3(PRNr,"","B")
 . . If 'BLKLNr Set Insert=0
 . . Else  Do
 . . . Set $P(^KTO(LEVNr,TOENr,1),D,9)=BLKLNr,I=100
 . . . For  Set I=$O(^KTO(0,I)) Quit:'I  Do
 . . . . Set U2=^KTO(0,I)
 . . . . Quit:$P(U2,U,16)'=109
 . . . . Set (U3,K)=BLKLNr If $L($P(U2,U,8)) Set U3="S U3="_$P(U2,U,8) Xecute U3
 . . . . Set FP=$P(U2,U,5)*100+$P(U2,U,6) Write @F,$J("",$P(U2,U,9)),$J("",$P(U2,U,13)),@F,U3
 Quit Insert
 ;
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 W @F2 I $L(K)'>R6,@R7 S @$P(R,D,1)=K
R0E E  G R0C
R0F S FP=$P(R,D,9)*100+($P(R,D,10)*1) I FP W @F,$J("",R6),@F,K
R0Z K R,R0,R2,R3,R4,R5,R6,R7 Q  ;V4 03.10.84
 ;
SCROL(Aantal,Prijs,Korting1,Korting2,LevTerm) 
 I '$L(Aantal),'$L(Prijs),'$L(Korting1),'$L(Korting2),'$L(LevTerm) K Aantal,Prijs,Korting1,Korting2,LevTerm
 G 1
 Q
 ;