KFCOLS(DefAant) ;CONTRACT-ORDERLIJNEN (Ophalen van de lijnen); [ 08/05/2002  10:44 AM ]
 ;
 New I,R,W,X,URC,UZC,PCC,OrdDat,OrdRef,IntDat,TotAfn,Rec,Input,prompt,DL,LD,%SC,%R,%C,ln,TotContr,MinAfn
 Set DefAant=$G(DefAant)
 Set PC=$P(^KPR(PR,0),D),PID=$P(^(2),D,25)
7 Set PCC=$$COMPR^PRODUKT(PR)
 Set:$E(PCC,$L(PCC))=" " PCC=$E(PCC,1,$L(PCC)-1)
 Kill ^HULP($J)
 Set W="W",TotContr=0
 For  S W=$O(^KPR(PR,W)) Quit:$E(W,9)'="R"  Do
 .Set URC=$TR($E(W,18,23)," ",""),UZC=100+$TR($E(W,24,26)," ","")
 .Quit:$P($G(^KO1(URC,US)),D)'=KC
 .Set R=^KOD(KC,US,URC,1)
 .Quit:$P(R,D,25)'="C"!'$P(R,D,22)!($P(R,D,27)'=KKN)
 .If UVM'="MTL",UVM'=$P(R,D,18) Quit
 .Set OrdDat=$P(R,D,2),OrdRef=$P(R,D,3),IntDat=$$INTDATE^vhDTyp(OrdDat)
 .Set R=^KOD(KC,US,URC,UZC),TotContr=TotContr+$P(R,D,3)
 .Set ^HULP($J,IntDat_URC_UZC_" ")=PR_D_PC_D_URC_D_UZC_D_$P(R,D,3)_D_OrdDat_D_OrdRef
 Quit:'$D(^HULP($J)) ""
 Set FP=UL*100+1
 Write @F,@F1
 Set FP=1903+F60
 Write @F,$C(13),?2,"IDENTNR : ",PID,?27,"PRODUKT  : ",PC
 ;Set:DefAant'<TotContr DefAant=0
AANTAL Set R="Aantal\22\3\"_$P($T(T1),U,2)
 If $O(^($O(^HULP($J,""))))="" Set R=R_" "_$P(^($O(^HULP($J,""))),D,3)
 Else  Set R=R_"S"
 Set R=R_$P($T(T1),U,3)_"\"""_$P($T(T2),U,2)_$S(DefAant>TotContr:TotContr,'DefAant:TotContr,1:DefAant)
 Set R=R_"  ("_$P($T(T2),U,$S(DefAant>TotContr:4,'DefAant:4,1:3))
 If $S(DefAant>TotContr:1,'DefAant:1,1:0),$O(^($O(^HULP($J,""))))'="" Set R=R_"en"
 If DefAant Do
 .Set R=R_" - "_$P($T(T2),U,$S(DefAant>TotContr:3,1:4))
 .If DefAant'>TotContr,$O(^($O(^HULP($J,""))))'="" Set R=R_"en"
 .Set R=R_" = "_$S(DefAant>TotContr:DefAant,1:TotContr)
 Set R=R_")""\6\\""-.""[K&($L(K)<2)!(K?.N&(K'>TotContr))"
 Do R0
 If $L(K),"-0."[K Kill ^HULP($J) Set:K="." K="" Set:K=0 K="" Quit K
 Set:K="" (K,Aantal)=$S(DefAant>TotContr:TotContr,'DefAant:TotContr,1:DefAant)
 Set MinAfn=$P($G(^KPBI("D",KC,PR)),D,2)
 If K<MinAfn,'$$CHECK^vhWACHTW("PETER VDR",2402) G AANTAL
 Set TotAfn=K,R=$O(^HULP($J,""))
 If $O(^(R))="" Do  Quit R
 .Set R=^(R)
 .If $P(R,D,5)'<Aantal Set $P(R,D,8)=Aantal,Aantal=0
 .Else  Set $P(R,D,8)=$P(R,D,5),Aantal=Aantal-$P(R,D,5)
 .Set R=$P(R,D,3,4)_D_$P(R,D,8)
 .Set R=PR_U_R Set:Aantal R=R_";\\"_Aantal
 .Kill ^HULP($J)
 Do INIT^PROC("KFCOLS","LD"),RL^PROC1
 For I=1:1 Quit:'$D(^HULP($J,I))  Do
 .Set Rec=^HULP($J,I)
 .If $P(Rec,D,5)'>Aantal Set $P(Rec,D,8)=$P(Rec,D,5),Aantal=Aantal-$P(Rec,D,5)
 .Else  Set $P(Rec,D,8)=Aantal,Aantal=0
 .Set ^HULP($J,I)=Rec
 Set R=$P($P(LD(8),"`"),"=")_"="_$C(27)_"[1m"_$C(27)_"[5m"_$$EXTNUM^vhDTyp(TotAfn,12,".T",0)_$C(27)_"[22m"_$C(27)_"[25m",$P(LD(8),"`")=R
 Do WL^PROC
 For  Do SL^PROC Quit:"-C"[R  Do  Quit:R="C"
 .Set Input=R,Rec=$G(^HULP($J,@DL(1)@(6)))
 .Quit:Rec=""
 .If Input="COM" Do CALL^vhMenu("FLOWORDC")
 .If Input="C" Set R="C" Quit
 .If Input="A" Do
 ..Set TotAfn=0
 ..For I=1:1 Quit:'$D(^HULP($J,I))  Do
 ...Set Rec=^HULP($J,I),$P(Rec,D,8)=$P(Rec,D,5),^HULP($J,I)=Rec
 ...Set TotAfn=TotAfn+$P(Rec,D,8)
 .Else  If Input="X" Do
 ..Set TotAfn=0
 ..For I=1:1 Quit:'$D(^HULP($J,I))  Set $P(^HULP($J,I),D,8)=""
 .Else  Do
 ..Set TotAfn=TotAfn-$P(Rec,D,8)
 ..If Input="W" Do
 ...Do DISPLAY^vhScherm("KFCOLS")
 ...Set X=$P(Rec,D,8)
 ...For  Set %R=23,%C=2,ln=6,prompt="Afname   : ",FP=2301 W @F,@F2 Do ^vhINP Quit:X'>$P(Rec,D,5)
 ...If X?.N Set $P(Rec,D,8)=X
 ..Set:Input="ENTER" $P(Rec,D,8)=$P(Rec,D,5)
 ..Set:Input="V" $P(Rec,D,8)=""
 ..Set TotAfn=TotAfn+$P(Rec,D,8),^HULP($J,@DL(1)@(6))=Rec
 .Set R=$P($P(LD(8),"`"),"=")_"="_$C(27)_"[1m"_$C(27)_"[5m"_$$EXTNUM^vhDTyp(TotAfn,12,".T",0)_$C(27)_"[22m"_$C(27)_"[25m",$P(LD(8),"`")=R
 .Do WL^PROC
 Goto 7:R="-"
 Set R=""
 For I=1:1 Quit:'$D(^HULP($J,I))  Do
 .Set Rec=^HULP($J,I)
 .Quit:'$P(Rec,D,8)
 .Set:$L(R) R=R_U Set R=R_$P(Rec,D,3,4)_D_$P(Rec,D,8)
 If R="" Set R="-"
 Else  Set R=PR_U_R Set:Aantal R=R_";\\"_Aantal
 Kill ^HULP($J)
 Quit R
 ;
R0 S R7=1 S:$P(R,D,8)'="" R7=R7_"&("_$P(R,D,8)_")" S:$P(R,D,7)'="" R7=R7_"&("_$P($T(@$P(R,D,7)),U,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),R8="",$P(R8,".",R6)="."
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,@F2,@R5 D:R5'["""" @R5
R0C S FP=R2*100+R0+F60 W @F,@F2,R8,@F,@F0 R K W @F2 I $L(K)'>R6,K'["""",K'[D,K'?.E1C.E,@R7 S @$P(R,D)=K
R0D E  G R0C
R0E S FP=$P(R,D,9)*100+$P(R,D,10) I FP W @F,$J("",R6),@F,K
R0Z K R,R0,R2,R3,R4,R5,R6,R7,R8 Q  ;V8 05.07.88
 ;
T1 ;AANTAL VAN CONTRACTORDER; AF TE NEMEN
T2 ;.[] = geen   [] = ;default aantal;aantal in contract
 ;