KF21CC G 1 ;MODULE FAKTURATIE (FAKTURATIE) ;Go naar KF21C [ 03/27/2002  10:14 AM ]
 ;
1 K BR S @%Q1=0,(SW13,UPT,UGW)=0,UKILS=UKIL,I1=@("^"_Q_"K1(KCF)"),KX=$P(@("^"_Q_"KL(I1,0)"),D,18),KN=$P(^(0),D,2),KB=+$P(^(0),D,15),KK=$P(^(0),D,17)
3 S (MST,NET,BTW,LXT,EGA)=0 F I=0:1:9 S:$D(PBTW(I)) (MST(I),NET(I),BTW(I),EGA(I))=0 S:$D(PTXT(I)) (LXT(I),MST(I+10))=0
 S UDEC=$$MUNT^vhRtn1(VM,4)
5 S UR=-1
7 S UR=$N(UTF(UR)) G 24:UR=-1
9 S UZ=0,@("^"_Q_"FA(US,FNR,""U""_$E(""000000"",1,6-$L(UR))_UR,UZ)")=D,FP=2406+$L(UOU)+$L(UR) W @F,@F2,@F5
10 S FP=2403+F60 W @F,@F4,UOU," ",UR," ",@F5
11 S UZ=$N(@("^"_Q_"OD(KC,US,UR,UZ)")) G 15:UZ'=-1 I UKIL'=1 D COPY^KF21B("G")
 S U2=@("^"_Q_"O1(UR,US)"),^(US)=$P(U2,D,1)_D_UR_D_FNR_D_$P(U2,D,3,99),^(US,UR)=""
12 S @("^"_Q_"U1(UR,US)")=$P(U2,D,1)_D_FNR_D_$P(U2,D,3,99),^(US,UR)=""
13 K @("^"_Q_"OB(UR,US)") K:UKIL'=1 @("^"_Q_"O2(US,KC,UR)"),@("^"_Q_"OD(KC,US,UR)") G 7
15 S U2=^(UZ) I UZ=1 D
 .S $P(U2,D,28)="F",^(UZ)=U2
 .S X=$J($P($P(U2,D,13),"#",1),0,2)
 .S:$L(VM) X=$J(X/UPAR,0,UDEC),U2=$P(U2,D,1,12)_D_X_"#"_$P($P(U2,D,13),"#",2,3)_D_$P(U2,D,14,99)
 .S UPT=UPT+X,UGW=UGW+$P($P(U2,D,13),"#",3),UKIL=$P(U2,D,15)
17 S @("^"_Q_"FA(US,FNR,""U""_$E(""000000"",1,6-$L(UR))_UR,UZ)")=U2 G 11:UZ<100 S BTWK=$P(U2,D,8) G 11:$P(U2,D,1)=""
18 S:'KB&(BTWK>0) BTWK=0,U2=$P(U2,D,1,7)_D_BTWK_D_$P(U2,D,9,99),^(UZ)=U2 S UG=$P(U2,D,1),UGK=$P(U2,D,11)
19 S:$E(UG,$L(UG))'=" " UG=UG_" " S:'$D(BR(UG)) BR(UG)=0 S BR(UG)=BR(UG)+$J($P(U2,D,16),1,2)
21 S:$E(UGK,$L(UGK))'=" " UGK=UGK_" " S:'$D(BR(UGK)) BR(UGK)=0 S BR(UGK)=BR(UGK)+$J($P(U2,D,9),1,2)-$J($P(U2,D,16),1,2)
23 S NET(BTWK#10)=NET(BTWK#10)+$J($P(U2,D,9),1,2) S:KB&(BTWK\10) MST(BTWK\10+10)=MST(BTWK\10+10)+$J($P(U2,D,10)-($P(U2,D,9)*KK/100),1,2) G 11
24 S BTWK=0 F I=0:1:9 I $D(NET(I)) S:NET(I)'=0 BTWK=I
25 S UG=$P(@("^"_Q_"BA(157)"),D,1) S:$E(UG,$L(UG))'=" " UG=UG_" " S:'$D(BR(UG)) BR(UG)=0 S BR(UG)=BR(UG)+$J(UPT,1,2)
26 F I=0:1:9 I $D(NET(I)) S MST(I)=MST(I)+$J(NET(I)-(NET(I)*KK/100),1,2)
27 S NET(BTWK#10)=NET(BTWK#10)+$J(UPT,1,2),MST(BTWK#10)=MST(BTWK#10)+$J(UPT,1,2)
28 F I=0:1:9 I $D(PBTW(I)) S MST=MST+MST(I),NET=NET+NET(I) S:KB=1!(KB=2) BTW(I)=BTW(I)+$J((MST(I)*+PBTW(I)/100),1,2),BTW=BTW+BTW(I)
29 F I=0:1:9 I $D(PTXT(I)) S LXT(I)=LXT(I)+$J(MST(I+10)*+PTXT(I)/100,1,2),LXT=LXT+$J(MST(I+10)*+PTXT(I)/100,1,2)
31 I KB=2 F I=0:1:9 S:$D(PBTW(I)) EGA(I)=EGA(I)+$J((MST(I)*+PEGA(I)/100),1,2),EGA=EGA+EGA(I)
33 S KC=KCF,FC="F",R=FDT_D_KX D R4 S VVD=R,UCAECE=1 G 33^KF21C
 ;
YZ K NET,MST,BTW,EGA,TTB,KKB,KKBX,BR,VVD,KB,KK,KN,KX,LXT,U2,UG,UGK,UKILS,UR,VM,UPAR,UDEC,UCAECE Q
 ;
R4 S R1=";D;EM;MEM",R2=$P(R,D,1),RD=R2\1,RM=R2#1*100,RJ=+$P(R2,".",3),R2=$P(R,D,2) G R4E:R2="" D R4A G R4C
R4A I RM>12 S RJ=RJ+1,RM=RM-12 G R4A
R4B S R3="R3="_$P("31\RM=2&'(RJ#4)+28\31\30\31\30\31\31\30\31\30\31",D,RM),@R3 Q
R4C S:R2[$P(R1,";",3) RD=R3 S:R2[$P(R1,";",2) RD=RD+R2 G:R2[$P(R1,";",2) R4D S RM=RM+R2 D R4A S:R2[$P(R1,";",4)!(RD>R3) RD=R3 G R4E
R4D G R4E:RD'>R3 S RD=RD-R3,RM=RM+1 D R4A G R4D
R4E S RJ=RJ#100,R=$E(RD/100_0,2,3)_"."_$E(RM/100_0,2,3)_"."_$E("0"_RJ,$L(RJ),3)
R4Z K R1,R2,R3,RD,RM,RJ Q  ;V4 09.07.85
 Q
Z X ^cZ Q
ZZ ; 03.04.91 -  8 u 15