KFAFR G 1 ;AFROEP-ORDERLIJNEN; Go naar KFAFRA [ 08/05/2002  10:44 AM ]
 ;
M0 S FP=2403+F60 W @F,@F2,@F4,MSG," [] = OK ",@F5,@F0 R K G YZ
M1 S MSG="HET ORDER IS NOG NIET GESLOTEN" 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
 ;
1 S SW12=1,ULSV=UL K UZ S Q15="^(""W    0.0""_UOR_UOD_$J(UR,6,0)_$J((UVN-100),3,0))"
 S Q16="^(""W    0.0T""_UOD_$J(TR,6,0)_$J((TUZ-100),3,0))"
2 S X=^(1),UOD=$TR($$EXTDATE^vhDTyp($$INTDATE^vhDTyp($P(X,D,2)),"DS"),D,"")
 S UOR=$P("R\O",D,$P(X,D,17)+1),UAF=$P(X,D,22),UTYP=$P(X,D,25)
 I UTYP="L" G YZ
 I UTYP'="A" G ^KFAFRB
 G M1:'UAF
3 L @("^"_Q_UGL_"(KC,US,UR)")
4 K UA,UO,UEP,UBE,U30 S FP=$P(UD,D,2)+1*100+1 W @F,@F1 G 43:'$D(UTA)!($N(UTA(0))=-1)
 S FP=2403+F60 W @F,"NUMMER v/d LIJN   -[] = TERUG NAAR ",$P(USM,U,3)," : ",@F0 R K
5 G 3:K?.E1C.E!(K="")!($P(K,"E",2)>29),43:K="-"!(K=",") S UVN=K+100
 I $D(UTA(K)) S UL=UTA(K),U2=@("^"_Q_UGL_"(KC,US,UR,UVN)") G 9:$P(U2,D,2)
7 S FP=2403+F60 W @F,@F2,@F4,"LIJN ",$P("ONBEKEND\NIET OPSPLITSBAAR",D,$D(^(UVN))+1)," [] = OK ",@F5,@F0 R K G 3
9 S PR=$P(U2,D,2),TR=$P(U2,D,27) I TR S LC=$P(@("^"_Q_"TO1(TR)"),D) L +@("^"_Q_"TO(LC,TR)"):2 E  G M4
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 S FP=1903+F60 W @F,@F1,$C(13),?2,"IDENTNR : ",?12,PID,?27,"PRODUKT  : ",PC
17 S X=$N(^("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
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 D ^KF0268
29 G 1^KFAFRA
43 S UL=ULSV S:K="," K="-"
 ;
YZ K ULSV,LC,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,TR,%TC,%INT,%EXT L @("^"_Q_UGL_"(KC,US,UR)") Q
 Q
Z X ^cZ Q
ZZ ; 12.10.90 - 15 u 19