KF0CC G 1 ; MODULE REGISTREREN PRODUKTLIJNEN ORDERS (BEP. PROD.); Quit naar %F10 - Do naar KF31 - Go naar KF0ACC [ 01/09/2003  8:47 AM ]
 ;
M1 S MSG="MUNT KLANT NIET TOEGELATEN VOOR "_UOU G MY
M2 S MSG="B.T.W.-kode NIET TOEGELATEN VOOR DIT "_UOU G MY
M3 S MSG="ER IS GEEN LEVERANCIER GEOPEND VOOR DIT PRODUKT" G MY
M4 S MSG="MUNT PRODUKT NIET GELIJK AAN MUNT "_UOU G MY
M5 S MSG="PRODUKT IN GEBRUIK" G MY
M6 S MSG="GEEN MUNTKODE VOOR DIT PRODUKT" G MY
M7 S MSG="EEN ORGALUX ORDER MAG ENKEL ORGALUX-PRODUKTEN BEVATTEN" G MY
M8 S MSG="EEN NIET-ORGALUX ORDER MAG GEEN ORGALUX-PRODUKTEN BEVATTEN" 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.0""_UOR_UOD_$J(UR,6,0)_$J(UZ,3,0))"
2 S X=@("^"_Q_UGL_"(KC,US,UR,1)")
 S UOD=$TR($$EXTDATE^vhDTyp($$INTDATE^vhDTyp($P(X,D,2)),"DS"),D,"")
 S UOR=$P("R\O",D,$P(X,D,17)+1),UVM=$P(X,D,18),UB=$P(X,D,20)
3 S UAF=$P(X,D,22) G M1:'$$CHKMUNT^FLOW(UVM)
5 G 9:K="." S K=K_" "
 I '$D(@("^"_Q_"PR1(K)")) S K=$$SELECT^PRODUKT6("","",K,,"NODO;NOKP",,,,KC,1) 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="-",10
 .N PROld
 .S PROld=PR,R="S K=$$GENERATE^"_R_"(KC,PR)"
 .X R
 .S PR=K S:K=PROld!'K K="-"
11 G 111:'UAF
 N IsOrgal,OrgalPr
 S IsOrgal=$$ISORGAL^FLOW("O",UR)
 G 111:IsOrgal=""
 S OrgalPr=$E($$SORTKEY^PRODUKT(PR,1),3,4)="OL"
 I IsOrgal,'OrgalPr G M7
 I 'IsOrgal,OrgalPr G M8
111 L (@("^"_Q_UGL_"(KC,US,UR)"),@("^"_Q_"PR(PR)")):2 E  G M5
 S UA=0,X=@("^"_Q_"PR(PR,0)"),PC=$P(X,D,1),PST=$P(X,D,14),PY=$P(X,D,17),PB=$P(X,D,5) S:KB<1 PB=0 I $L(UB),UB'=PB G M2
12 S X=^(1),UE=$P(X,D,12),PSN=$P(X,D,20),ULT=""
134 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 : ",PID,?27,"PRODUKT  : ",PC
17 S X=$N(^("J")) I $E(X,1,1)'="J" G M3
18 S X=^(X),PLL=$P(X,D,7),UMC=$P(X,D,17) G M6:"I"[UMC I $L(UAF) G M4:KV="MTL"&(UMC'=UVM)
23 S R=$$KLANTPR^KPRIJS(KC,PR)
 S UEP=$P(R,D,1),UMC=$P(R,D,2),AFA=$P(R,D,3),PLP=$P(R,D,4),PK1=$P(R,D,5),PK2=$P(R,D,6),KKD=$P(R,D,7)
 S PKP=$P(R,D,8),UPAR=$P(R,D,9),USP=$P(R,D,10),AFE=$P(R,D,11)
27 S ULT=$$INTDATE^vhDTyp(%WK,"DW")+7 S:'PSN ULT=ULT+($P(X,D,7)*7) S ULT=$$EXTDATE^vhDTyp(ULT,"DW")
28 S PLP=$J(PLP,1,2),UEP=$J(UEP,1,2),R=PSN_D_(PST-$P(PRE,"#",2))_D_$P(PY,"#",2)_D_$P(X,D,6)_D_ULT_D_$P(X,D,14,16)_D_UMC_D_AFA_D_PLP_D_PK1_D_PK2_D_PKP_D_UEP_D_KKD_D_PLL_D_PST_D D ^KF0268
29 G 33^KF0ACC
 ;
YZ K AFA,AFE,AFR,KPC,KKD,UPAR,MSG,PKP,PLL,PST,PB,PC,PR,PK1,PK2,PGV,PNV,PKV,PLP,PPL,PID,PRE,PSN,PVK,PY,Q15,S,SW25,UE,UN,UB,UAF,UOD,UOR,UVM,X L @("^"_Q_UGL_"(KC,US,UR)") Q
 ;