kfcred ;CREDITEREN VAN FAKTUREN; [ 05/20/99   2:43 PM ]
 ;
 New R,%J
 Set R=^KOD(KC,US,UR,1)
 If $P(R,D,22) Do M1 Set K="-" Quit
 Set %J=$$%J^vhRtn1(),FP=UD*100+1 Write @F,@F1
 Kill ^HULP(%J)
 Set K=$$FAKTUUR()
 Kill ^HULP(%J)
 If K="-" Quit
 Do DETAIL(K)
 Kill ^HULP(%J)
 Quit
 ;
DETAIL(FNR) 
 New DL,CNT,LD,UUR,UZ,UK,L,StkCorr,GLOB
 Set GLOB=$S($D(^KFA("F",FNR)):"KFA",$D(^KFAP("F",FNR)):"KFAP",1:"")
 If GLOB="" Set K="-" Quit
 Set LD(1)="^HULP(%J,"
 Set LD(2)=$P($T(T5),U,2,99)_$P($T(T9),U,2,99),LD(2,1)=$P($T(T6),U,2,99)_$P($T(T9),U,2,99)
 Set LD(2,2)=$P($T(T7),U,2,99),LD(2,3)=$P($T(T8),U,2,99)
 Set LD(3)=$P(UD,D),LD(4)=$P(UD,D,2)-$P(UD,D)+1,LD(6)=2,LD(10)="CB^"_$ZN
 Set FP=UD*100+1 Write @F,@F1
 Set R="",$P(R,D,35)=D
 Set $P(R,D,5)=$P($T(T12),U,$F("NFDE",KT))
 Set $P(R,D,5)=$P(R,D,5)_$$EXTNUM^vhDTyp(FNR,0,".",0)
 Set $P(R,D,5)=$P(R,D,5)_$P($T(T13),U,$F("NFDE",KT))_$P(@("^"_GLOB_"(""F"",FNR,0,0)"),D,6)
 Set $P(R,D,12)="*",$P(R,D,17)="KF11#1"
 Set CNT=1,^HULP(%J,CNT)=R
 Set UUR=0,FP=UD*100+1 Write @F,@F1
 For  Set UUR=$O(@("^"_GLOB_"(""F"",FNR,UUR)")) Quit:$E(UUR)'="U"  Do
 .Set UZ=100
 .For  Set UZ=$O(@("^"_GLOB_"(""F"",FNR,UUR,UZ)")) Quit:UZ=""  Do
 ..Set R=@("^"_GLOB_"(""F"",FNR,UUR,UZ)"),$P(R,D,12)=""
 ..If $P(R,D,3) Set $P(R,D,3)=-$P(R,D,3)
 ..For I=9,10,16 If $P(R,D,I) Set $P(R,D,I)=$J(-$P(R,D,I),0,2)
 ..If $P(R,D,2),'$D(^KPR($P(R,D,2))) Set $P(R,D,2)="",$P(R,D,5)=$P($T(T11),U,2),$P(R,D,17)="KF1925"
 ..Set CNT=CNT+1,^HULP(%J,CNT)=R
 Set DL(1)="LD"
 Do WL^PROC
DSL Set FP=2201 Write @F,@F1,!?2,$P($T(T14),U,2),!?2,$P($T(T15),U,2)
 Do SL^PROC
 If R="-" Set K=R Quit
 If R="C" Set (K,StkCorr)=$$MODSTOCK() Goto DSL:K="-" Do COPY Goto DSL:K="-" Quit
 If R="ENTER" Do MARK Set DL(2)="DO" Do ML^PROC
 Goto DSL
 ;
FAKTUUR() 
 New FNR,DAT,DL,CNT,LD,GLOB
FNR Set FNR=$$ASK^vhINP("Faktuurnummer : ",6,"","page up (SEL) voor lijst") If FNR="-" Quit FNR
 If 'zb,$L(FNR) Do  Goto FNR:GLOB="",FNR:$P(@("^"_GLOB_"(""F"",FNR,0,0)"),D)'=KC Quit FNR
 .Set GLOB=$S($D(^KFA("F",FNR)):"KFA",$D(^KFAP("F",FNR)):"KFAP",1:"")
 Do INIT^PROC("KREDNFSEL","LD")
 Set DL(1)="LD",CNT=0,DAT=""
 Set CNT=$$MORE(LD(6),LD(4))
 Do WL^PROC
FSL Do SL^PROC
 If R="-" Quit R
 If R="ENTER",$D(^HULP(%J,LD(6))) Quit $P(^HULP(%J,LD(6)),D)
 Goto FSL
 ;
MORE(LSelect,LMax) 
 If CNT,DAT="" Quit CNT
 For  Set DAT=$O(^KFA1("F",KC,DAT)) Quit:DAT=""!(CNT-LSelect>LMax)  Do
 .Set FNR=""
 .For  Set FNR=$O(^KFA1("F",KC,DAT,FNR)) Quit:FNR=""  Do
 ..Set R=^KFA("F",FNR,0,3) Quit:$P(R,D,27)'=KKN
 ..Set R=^KFA("F",FNR,0,0) Quit:$P(R,D,2)'="F"
 ..Set CNT=CNT+1,^HULP(%J,CNT)=FNR_D_$P(R,D,6)
 ..If CNT=10 Do WL^PROC
 Set LD(9)=CNT
 Quit CNT
 ;
CB(K,R) 
 If $P($P(R,D,17),"#")="KF11" Quit 3
 If $P(R,D,17)="KF5" Quit 2
 If '$P(R,D,2) Quit 1
 Quit ""
 ;
COPY 
 New PR,Q15,UOD,UOR,UVN,X,R,UA,ULT,TXT,Count,Line,%Kost
 New Aantal,Prijs,Korting1,Korting2,LevTerm,BtwKode,zb
 Do DL^PROC
 Set K="C"
 Do LIST^POP("KREDIETNOTA","",$P(USM,U),"TITEL","LKPF")
 If X="" Set K="-" Do EL^PROC Set FP=$P(USM,U)*100+1 Write @F,@F1 Quit
 Set R=^POP("D","KREDIETNOTA",X),%Kost=$P("\?",D,$P(R,D,6)+1),R=$P(R,D,$F("NFDE",KT))
 Set TXT="",$P(TXT,D,35)=D
 Set $P(TXT,D,5)=R,$P(TXT,D,17)="KF11#1"
 Set DL(1)="AD" Do WL^PROC
 Set UVN=^KOD(KC,US,UR,0),X=^(1)
 Set UOD=$TR($$EXTDATE^vhDTyp($$INTDATE^vhDTyp($P(X,D,2)),"DS"),D,"")
 Set UOR=$P("R\O",D,$P(X,D,17)+1)
 Set Q15="^(""W    0.0""_UOR_UOD_$J(UR,6,0)_$J((UVN-100),3,0))",Line=""
 For  Set Line=$O(^HULP(%J,Line)) Quit:Line=""  Do
 .Set R=^HULP(%J,Line) Quit:'$L($P(R,D,12))
 .Set $P(R,D,12)="",PR=$P(R,D,2)
 .If PR Do  Quit
 ..New UVM,UTYP,UOD,UOR
 ..Set $P(R,D,12)="L",UA=$P(R,D,3),ULT=$P(R,D,25)
 ..Set UZ=^KOD(KC,US,UR,0)-100
 ..Set Aantal=$P(R,D,3),Prijs=$P(R,D,6),Korting1=$P($P(R,D,7),"#"),Korting2=$P($P(R,D,7),"#",2),LevTerm=$P(R,D,25)
 ..Set LevTerm="" If $D(DefLevT) Set LevTerm=DefLevT
 ..Do PINSERT^FLOWORD("","",PR,Aantal,Prijs,Korting1,Korting2,LevTerm,1,StkCorr,1,%Kost)
 ..Set FP=$P(UD,D,2)+1*100+1 Write @F,@F1
 .If $P($P(R,D,17),"#")="KF1925" Do
 ..For  Set BtwKode=$$BTWKODE($P(R,D,8),"Btw-% voor """_$P(R,D,5)_"""") If $G(zb)'="CANC" Quit:$L(BtwKode)
 ..Set $P(R,D,8)=BtwKode
 .Do TINSERT^FLOWORD("","",R)
 .Set FP=$P(UD,D,2)+1*100+1 Write @F,@F1
 Do TINSERT^FLOWORD("","",TXT)
 Set K="C"
 Quit
 ;
MARK 
 Set R=^HULP(%J,LD(6)),$P(R,D,12)=$S($L($P(R,D,12)):"",1:"*")
 Set ^HULP(%J,LD(6))=R
 Do EL^PROC
 Quit
 ;
 ; Met of zonder stockwijziging
MODSTOCK() 
 New K
 Set K=$$ASKL^vhINP("FLOWORD","MODSTOCKALL")
 Set:"."'[K K="-"
 Quit $S(K=".":"S",1:K)
 ;
BTWKODE(BtwKode,Titel) 
 New I,R,Count
 Set Titel=$G(Titel,"Btw-%"),Count=0
 For I=0:1:9 If $D(^KBA(18,I)) Do
 .Set R=^KBA(18,I)
 .Quit:$P(R,D,3)
 .Set Count=Count+1,BtwKode(Count)=I_D_$P(R,D)
 .Set Pos=12-(Count\2)_";"_(40-($L(Titel)\2))
 Set BtwKode=$$WILD^vhPOPUP(Pos,"1KO-",Titel,.BtwKode,BtwKode)
 Quit BtwKode
 ;
M1 Set K="HET ORDER IS REEDS GESLOTEN" Goto MY
MY Set FP=2401+F60
 Write @F,@F2,"  ",@F4,K," [] = OK ",@F5,@F0
 Read K
 Quit
 ;
 ; Produktlijn
T5 ;12;C;C;1;;\2;C;L;25;;|;;$P(^KPR(X,0),D)\0;C;L;6;;|
 ; Manuele lijn
T6 ;12;C;C;1;;\5;C;L;32;;|
 ; Orderreferentielijn
T7 ;12;C;C;1;;\5;C;L;54;;|\"";C;L;18;;|
 ; Tekstlijn
T8 ;12;C;C;1;;\5;C;L;42;;|\"";C;L;11;;|\"";C;L;18;;|
 ; Produkt- en manuele lijn
T9 ;\3;N;R;9;;|\7;C;R;11;;|;;$S($P(X,"#"):$J($TR($FN($P(X,"#"),",",1),".,",",."),4),1:"")_$S($P(X,"#",2):" + "_$J($TR($FN($P(X,"#",2),",",1),".,",",."),4),1:"")\26;C;L;1\6;N;R;13;2\22;C;R;3\21;C;L;1;;|;;$S($E(X)="H":"%",1:"")\25;C;L;5
T11 ;Verwijderd produkt
T12 ;Cfr. faktuur ;Cfr. facture ;Cfr. rechnung
T13 ; van ; du ; von 
T14 ;[] = selekteer lijn voor copy   C = copieer geselekteerde lijnen 
T15 ; - = exit