KFCRED ;CREDITEREN VAN FAKTUREN; [ 03/21/2003  10:46 AM ]
 ;
 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(@("T"_(12+(GLOB="KFAP")))),U,$F("NFDE",KT))
 Set $P(R,D,5)=$P(R,D,5)_$$EXTNUM^vhLib.DataTypes(FNR,0,".",0)
 Set $P(R,D,5)=$P(R,D,5)_$P($T(T14),U,$F("NFDE",KT))_$P(@("^"_GLOB_"(""F"",FNR,0,0)"),D,6)
 Set $P(R,D,12)="*",$P(R,D,17)="KF11#1",$P(R,D,18)=$P($H,",",2)_";T;;OBF"
 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(T15),U,2),!?2,$P($T(T16),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,IGLOB
FNR Set FNR=$$ASK^vhINP("Faktuur- of proformanummer : ",6,"","page up (SEL) voor lijst fakturen,  P[] voor lijst proforma") If FNR="-" Quit FNR
 If 'zb,$L(FNR),FNR'="P" 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:"")
 Set GLOB=$S(FNR="P":"KFAP",1:"KFA"),IGLOB=GLOB_1
 Do INIT^PROC("KREDNFSEL","LD")
 Set LD(8)=$S(GLOB="KFA":"Fakt. nr.",1:"Prof. nr.")_"| Datum"
 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(@("^"_IGLOB_"(""F"",KC,DAT)")) Quit:DAT=""!(CNT-LSelect>LMax)  Do
 .Set FNR=""
 .For  Set FNR=$O(@("^"_IGLOB_"(""F"",KC,DAT,FNR)")) Quit:FNR=""  Do
 ..Set R=@("^"_GLOB_"(""F"",FNR,0,3)") Quit:$P(R,D,27)'=KKN
 ..Set R=@("^"_GLOB_"(""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,ExtraTxt,Reden
 New Aantal,Prijs,Korting1,Korting2,LevTerm,BtwKode,zb,OrdMunt,LijnMunt,AFA
 Do DL^PROC
 Set FP=2201
 Write @F,@F1
 Set K="C",OrdMunt=$P(^KOD(KC,US,UR,1),D,18) Set:OrdMunt="" OrdMunt=$$FADEF^vhRtn1()
 Set (X,Reden)=$$PI^vhPOPUP("C;C","O1-","","FLOWORD","KREDIETNOTA")
 If X="" Set K="-" Do EL^PROC Set FP=$P(USM,U)*100+1 Write @F,@F1 Quit
 Set R=^RES("FLOWORD","PI","KREDIETNOTA","D",X),ExtraTxt=$P(R,"`",4)
 Set R=^RES("FLOWORD","PI","KREDIETNOTA","D",X,KT)
 Set TXT="",$P(TXT,D,35)=D
 Set $P(TXT,D,5)=R,$P(TXT,D,17)="KF11#1",$P(TXT,D,18)=$P($H,",",2)_";T;;OBF"
 Set DL(1)="AD" Do WL^PROC
 Set UVN=^KOD(KC,US,UR,0),X=^(1)
 Set UOD=$TR($$EXTDATE^vhLib.DataTypes($$INTDATE^vhLib.DataTypes($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),AFA=$P(R,D,21),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 LijnMunt=$P(R,D,22) Set:LijnMunt="" LijnMunt=$$FADEF^vhRtn1()
 ..If OrdMunt'="MTL",LijnMunt'=OrdMunt Set Prijs=$$MUNT^vhRtn1(LijnMunt,5,Prijs_"#1",,OrdMunt)
 ..Set LevTerm=""
 ..If Aantal<0 Set LevTerm=blLeveringsTermijn.GetVroegsteLeverDag($H)
 ..Else  If $D(DefLevT) Set LevTerm=DefLevT
 ..Do PINSERT^FLOWORD("","",PR,Aantal_";*",Prijs_D_AFA,Korting1,Korting2,LevTerm,1,StkCorr,1,$$KOSTEN(PR,Aantal,Reden),1)
 ..Set FP=$P(UD,D,2)+1*100+1 Write @F,@F1
 .If $P($P(R,D,17),"#")="KF1925" Do
 ..Set LijnMunt=$P(R,D,22) Set:LijnMunt="" LijnMunt=$$FADEF^vhRtn1()
 ..If OrdMunt'="MTL",LijnMunt'=OrdMunt Do
 ...For X=6,9,10,16 If $P(R,D,X) Set $P(R,D,X)=$$MUNT^vhRtn1(LijnMunt,5,$P(R,D,X)_"#1",,OrdMunt)
 ..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)
 Do:ExtraTxt LMODIFY^FLOWORD("W")
 Set K="C"
 Quit
 ;
 ; Bepalen kosten
KOSTEN(PRNr,Aantal,Reden) 
 New R,Kost,KostRef,LEVNr,HoofdGr
 Set R=^RES("FLOWORD","PI","KREDIETNOTA","D",Reden),KostRef=$P(R,"`",3),Kost=""
 If $L(KostRef) For  Do  Quit:$L(Kost)  Quit:KostRef=""
 .Set Kost=$P(KostRef,";"),KostRef=$P(KostRef,";",2,99)
 .If $E($P(Kost,"#",2))="J" Do  ; Kosten leverancierafhankelijk
 ..Set LEVNr=$$LEVNR^PRODUKT2(PRNr)
 ..If ";"_$$GETALG^DEFAULTS("KFCRED","KOSTEN",$P(Kost,"#",2))_";"[(";"_LEVNr_";") Set Kost=$P(Kost,"#")
 ..Else  Set Kost=""
 .Else  If $E($P(Kost,"#",2))="I" Do  ; Kosten klassificatieafhankelijk
 ..Set HoofdGr=$P($$DISPLP^KLASS(PRNr),"-")
 ..If ";"_$$GETALG^DEFAULTS("KFCRED","KOSTEN",$P(Kost,"#",2))_";"[(";"_HoofdGr_";") Set Kost=$P(Kost,"#")
 ..Else  Set Kost=""
 .Else  If Kost?1.2N1"%" ; Kosten %
 .Else  If Kost?1.2N1"%"1"?" ; Kosten % met bevestiging
 .Else  If Kost?1.2N,Kost ; Default kosten
 .Else  If Kost?1.2N1"."1N,Kost
 .Else  If Kost?1.2N1"."2N,Kost
 .Else  If Kost?1.2N1"?",Kost ; Default kosten met bevestiging
 .Else  If Kost?1.2N1"."1N1"?",Kost
 .Else  If Kost?1.2N1"."2N1"?",Kost
 .Else  Set Kost=""
 Quit Kost
 ;
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=".":"Z",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 ;Cfr. proforma ;Cfr. proforma ;Cfr. proforma
T14 ; van ; du ; von 
T15 ;[] = selekteer lijn voor copy   C = copieer geselekteerde lijnen 
T16 ; - = exit