KFAFRB G 1 ;AFROEP-ORDERLIJNEN (split naar een ander order); Go naar KFAFRC [ 08/05/2002  10:44 AM ]
 ;
T1 ;VOLGNUMMER OF ;   [] = vervolg;
 ;
SELAFR() 
 N URC,UZC,PC,PCC,PR
 K ^HULP($J) S URC=""
 F  S URC=$O(^KOD(KC,US,URC)) Q:URC=""  D
 .S R=^KOD(KC,US,URC,1) Q:$P(R,D,25)'="A"!'$P(R,D,22)!($P(R,D,27)'=KKN)  S UZC=100
 .I UVM'="MTL",UVM'=$P(R,D,18) Q
 .F  S UZC=$O(^KOD(KC,US,URC,UZC)) Q:UZC=""  D
 ..S R=^KOD(KC,US,URC,UZC) Q:'$P(R,D,2)  ;!$P(R,D,27)
 ..S PR=$P(R,D,2),PC=$P(^KPR(PR,0),D)
 ..S PCC=$$COMPR^PRODUKT(PR)
 ..I $E(PCC,$L(PCC))=" " S PCC=$E(PCC,1,$L(PCC)-1)
 ..S PCC=PCC_URC_UZC_" "
 ..S ^HULP($J,PCC)=PR_D_PC_D_URC_D_UZC_D_$P(R,D,3)
 I '$D(^HULP($J)) Q ""
 S R="K\1800\PRODUKTNAAM\PR\HULP("_$J_"," D R7 S R=K
 I R'="-" S R=$P(^HULP($J,R),D,3,4)
 K ^HULP($J)
 Q R
 ;
M0 S FP=2403+F60 W @F,@F2,@F4,MSG," [] = OK ",@F5,@F0 R K G YZ
M1 S MSG="MUNT KLANT NIET TOEGELATEN VOOR "_UOU G M0
M3 S MSG="ER IS GEEN LEVERANCIER GEOPEND VOOR DIT PRODUKT" G M0
M4 S MSG="TOELEVERING IN GEBRUIK" G M0
M5 S MSG="PRODUKT IN GEBRUIK" G M0
M6 S MSG="GEEN AFROEPORDERS BESCHIKBAAR VOOR DEZE KLANT" G M0
M7 S MSG="AFROEPORDER IN GEBRUIK" G M0
M8 S MSG="EEN ORGALUX ORDER MAG ENKEL ORGALUX-PRODUKTEN BEVATTEN" G M0
M9 S MSG="EEN NIET-ORGALUX ORDER MAG GEEN ORGALUX-PRODUKTEN BEVATTEN" G M0
 ;
1 S SW12=1,ULSV=UL K UZ S Q15="^(""W    0.0""_UOR_UOD_$J(UR,6,0)_$J((UVN-100),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)
 S UAF=$P(X,D,22),UTYP=$P(X,D,25) G M1:'$$CHKMUNT^FLOW(UVM)
 S R=$$SELAFR() G M6:R="",43:R="-"
3 S URC=$P(R,D),UVN=$P(R,D,2),X=@("^"_Q_"OD(KC,US,URC,UVN)"),TR=$P(X,D,27)
 L +@("^"_Q_UGL_"(KC,US,URC)"):2 E  G M7
 I TR S LC=$P(@("^"_Q_"TO1(TR)"),D) L +@("^"_Q_"TO(LC,TR)"):2 E  G M4
4 K UA,UO,UEP,UBE,U30 I '$D(BackGrnd) N BackGrnd
 S U2=@("^"_Q_UGL_"(KC,US,URC,UVN)"),BackGrnd=$G(BackGrnd)
9 S PR=$P(U2,D,2)
 G 10:'UAF
 N IsOrgal,OrgalPr
 S IsOrgal=$$ISORGAL^FLOW("O",UR)
 G 10:IsOrgal=""
 S OrgalPr=$E($$SORTKEY^PRODUKT(PR,1),3,4)="OL"
 I IsOrgal,'OrgalPr G M8
 I 'IsOrgal,OrgalPr G M9
10 L +@("^"_Q_"PR(PR)"):2 E  G M5
11 S PK1=$P($P(U2,D,7),"#",1),PK2=$P($P(U2,D,7),"#",2)
112 S AFRR=$P(U2,D,21),AFA=$E(AFRR,1),AFR=$E(AFRR,2),AFE=$P("1\100\1000",D,$F("EHM",AFA)-1),UEP=$J($P(U2,D,9)/$P(U2,D,3)*AFE,1,2)
12 S X=@("^"_Q_"PR(PR,0)"),PC=$P(X,D,1),(PST,PPS)=$P(X,D,14),PY=$P(X,D,17),X=^(1),PSN=$P(X,D,20),X=^(2),PRE=$P(X,D,9),PID=$P(X,D,25),PPS=PPS-$P(PRE,"#",2) S:'$P(U2,D,27) PPS=PPS+$P(U2,D,3)
13 D:'BackGrnd IDPROD^KF0
17 S X=$N(@("^"_Q_"PR(PR,""J"")")) I $E(X,1,1)'="J" G M3
19 S X=^(X),PLL=$P(X,D,7)
 S R=$$KLANTPR^KPRIJS(KC,PR),UMC=$P(R,D,2),PLP=$P(R,D,4),CIFP=$P(R,D,13)*AFE
21 S UPAR=$$MUNT^vhRtn1(UMC,,12)
23 S ULT=$$INTDATE^vhDTyp(%WK,"DW") S:TR ULT=ULT+(PLL+1*7) S ULT=$$EXTDATE^vhDTyp(ULT,"DW")
 I $D(ULTD),$$INTDATE^vhDTyp(ULTD,"DW")>$$INTDATE^vhDTyp(ULT,"DW") S ULT=ULTD
 I $L($G(LevTerm)),$$INTDATE^vhDTyp(LevTerm,"DW")>$$INTDATE^vhDTyp(ULT,"DW") S ULT=LevTerm K DefLevT
 E  D:BackGrnd IDPROD^KF0 S BackGrnd=0
 I $D(DefLevT),$$INTDATE^vhDTyp(DefLevT,"DW")>$$INTDATE^vhDTyp(ULT,"DW") S ULT=DefLevT
27 S R=PSN_D_PPS_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_D_UEP_D_D_$P(X,D,7)_D_PST_D_D
 I BackGrnd S BackGrnd=R
 E  D ^KF0268 S BackGrnd=""
29 G 1^KFAFRC
43 S UL=ULSV S:K="," K="-"
 ;
YZ K ULSV,LC,TR,TUZ,GR,AFA,AFE,AFR,AFRR,UMC,UPAR,MSG,PST,PPS,PC,PR,PLL,PLP,CIFP,PID,PRE,PSN,PY,PK1,PK2,PGV,PNV,PKV,S,Q15,Q16
 K UA,UE,UK,UEP,UBE,UOD,UOR,ULT,U26,UAF,X,U30,UVM,%TC,%INT,%EXT L @("^"_Q_UGL_"(KC,US,UR)") Q
 ;
R7 S R4=$P(R,D,2)+1+F60,R0=0,RA=$P(R,D,3),R8="^"_Q_$P(R,D,4),R9="^"_$P(R,D,5),FP=R4 W @F,@F1
R7A S FP=2403+F60 W @F,@F1 W:$D(RT) $P($T(T1),U,2) W RA W:R0 $P($T(T1),U,3) W " : ",@F0
R7B R K G R7A:K?.E1C.E S:$L(K) R0=0 S FP=R4,R10=0 W @F,@F1 G R7Z:K="-",R7D:K=""&('R0) I K="" K RT S R1=R4 G R7H
R7C G R7D:'$D(RT(K)) S R3=RT(K) G R7M
R7D K RT S R6=$$UPTRIMAN^vhRtn1(K)
R7E S R5=$E(R6,1,28) S:R6="" R5=" " S R1=R4,(R2,R3)=R5 G R7M:$D(@(R9_"R2_"" "")")) S:R5?.N R5=R5_" " S (R2,R3)=$N(@(R9_"R5)")) G R7K:R2=-1 S R2=$N(^(R2))
R7F I $E(R2,1,$L(R6))'=R6&'R0&($E(R3,1,$L(R6))=R6) S R7=$D(@(R8_"(R3)")) G R7M
R7G S R2=R5
R7H S R2=$N(@(R9_"R2)")) G R7K:($E(R2,1,$L(R6))]R6)&'R0&(R1=R4) G R7L:R2=-1 I $E(R2,1,$L(R6))'=R6 S R0=0 G R7A
R7I S FP=R1,R10=R10+1,RT(R10)=R2 W @F,$C(13),?2,R10,". ",?6,$P(^(R2),D,2),?37,$P(^(R2),D,3)," ",$P(^(R2),D,4)-100,?47,$J($P(^(R2),D,5),6),?59,$E($P(@(R8_"($P(@(R9_""R2)""),D,1),0)"),D,2),1,20)
R7J S R1=R1+100 G R7H:R1<(2300+F60) S R0=1 G R7A
R7K X ^cTXT(0,"N",8) R K
R7L S (R2,R0)=0 G R7A
R7M S:$E(R3,$L(R3))'=" " R3=R3_" " S (@$P(R,D,1),K)=R3
R7Z K R0,R1,R2,R3,R4,R5,R6,R7,R8,R9,R10,RA,RT Q
 ;