KTO30 G 1 ;REGISTRATIE TOELEVERINGEN (SELEKTIE TOELEV.) ;Go van MENU - Quit naar MENU - Do naar KTO17,KTO12,KTO10,%F18 [ 11/20/2003  11:54 AM ]
 ;
FTA(LEVNr,ToeRef,PRNr,EDIORDNr,BackGrnd,FBRef)
 S AutoToe=1,LC=LEVNr,Extern=1 G 1
FTE S Jump=1,EXTNr=TOENr
 ;
1 S UGL="TO",UG1="TO1",UG2="TO2",UGB="TOB",WNR="  ",UKIL="",X=$N(@("^"_Q_"BA(18,-1)"))
3 S U=";",X=@("^"_Q_UGL_"(0,0)") F I="TD","TT","UTL","TSM","TSC","TV","TUM","TOU" S @I=^(I)
5 S BS="\\\\\\\\\\\\\\\\\\\\\\\\\\",BLA="                                        ",PNT="........................................"
7 S UD=TD,UVV=$P($P(TV," ",2),"=",2),Q1="^"_Q_UGL_"(0,""TR"")"
 D ^cA105
 X X,TT K X,TT
8 G 19
9 I $D(Goto) K:Goto="FTE^KTO30" Jump I Goto'="FTE^KTO30" D CLEAN^vhPROGRAM G @Goto
 Q:$D(Extern)!$D(Jump)  S U1=@Q1,U1=100 L
11 S U1=$N(^(U1)) G 19:U1'?.N S U2=^(U1),FP=$P(U2,U,2)*100+$P(U2,U,3) W @F,"  "
15 I '$P(U2,U,23) S FP=$P(U2,U,2)*100+$P(U2,U,3) W @F,$E(BLA,1,$P(U2,U,6)-$P(U2,U,3))
17 S FP=$P(U2,U,5)*100+$P(U2,U,6) W @F,$E(BLA,1,$P(U2,U,9)),$E(BLA,1,$P(U2,U,13)) G 11
19 S (SW13,UTEL)=0,UL=+UD,FP=UD*100+1 W @F,@F1 K UTA,UTB
21 I $G(AutoToe) S (K,TR)="A"
 E  D
 .K LC S LVHCYB="W"
 .I $D(Extern)!$D(Jump) S (K,TR)=EXTNr
 .E  S UGLTemp=Q_UGL,UG1Temp=Q_UG1,(K,TR)=$$SELECT^FLOW(UGLTemp,UG1Temp) K UGLTemp,UG1Temp
25 G YZ:K="-"&'$D(FDT),YZ:K="-",29:K="L",27:$D(@("^"_Q_UG1_"(TR)")),21:UGL="UL"&$D(@("^"_Q_"OD"))
26 I TR'="A" L TR:2 E  S FP=2403+F60 W @F,@F2,@F4,TOU," ",TR," IN GEBRUIK ! ",@F5,@F0 H 3 G 21
260 S FP=UD*100+1 W @F,@F1 D ^KTO17 G 9:K="-" S LVHCYB="O" G 33
27 S U2=^(TR) I $P(U2,D,2)'=""&('$D(@("^"_Q_UGL_"($P(U2,D,1),TR)"))) D S3 G 19
28 S LC=$P(U2,D,1) G 32
29 S R="KIN\"_($P(UD,D,2)*100)_"\LEVERANCIER\LE\L1" D ^cF18 G 21:K="-" S LC=$P(KIN," ",2) S FP=UD+1*100+2 W @F,@F1,"LEVERANCIER : ",$P(^(KIN,0),D,2)
31 S X=UD+2,TR=-1
310 I X<20 S TR=$N(@("^"_Q_UGL_"(LC,TR)")) I TR'=-1 S X=X+1,FP=X*100+1+F60 W @F,$C(13),?1+6-$L(TR),TR,?10,$P(^(TR,1),D,2),?21,$P(^(1),D,3) G 310
312 S R="K\21\3\GEEF "_TOU_"NUMMER\""" S:UGL="TO"!'$D(@("^"_Q_"TO")) R=R_"A[] = automatisch nummer   " S:TR'=-1 R=R_"[] = VERVOLG" S R=R_"""\6\\""-,A""[K!(K?.N&(K>199999)&(K<300000))\\" D R0
314 G 19:K="," I K="" S X=UD+2,FP=X*100+1 W @F,@F1 G 310
315 I K="-" S FP=UD*100+1 W @F,@F1 G 29
316 I '$D(@("^"_Q_UG1_"(K)")) S TR=K G 26:UGL="TO"!'$D(@("^"_Q_"TO")),31
317 I $P(^(K),D,1)'=LC S FP=2203+F60 W @F,@F1 S FP=2403+F60 W @F,@F4,TOU,"NUMMER ",K," IS IN GEBRUIK VOOR ANDERE LEVERANCIER ! ",@F5,@F0 H 3 G 312
318 S U2=^(K) I $P(U2,D,2)'=""&('$D(@("^"_Q_UGL_"($P(U2,D,1),K)"))) D S3 G 312
319 S TR=K
32 S FP=UD*100+1 W @F,@F1 D ^KTO12
33 L @("^"_Q_UGL_"(LC,TR)"):2 E  S FP=2403+F60 W @F,@F2,@F4,TOU," ",TR," IN GEBRUIK ! ",@F5,@F0 H 3 G 9
35 D ^KTO10 I SW13,$D(@("^"_Q_UGL_"(LC,TR)")) S @("^"_Q_UGB_"(TR)")=LC_D I LC=5005 S ^BLBeri("Z",TR)=LC_D
37 D:$D(TR) S1
 I $D(LVHCYB),LVHCYB'="V",'$D(@("^"_Q_UG1_"(TR)")) S LVHCYB="V"
 I $D(LVHCYB),LVHCYB="O",$D(@("^"_Q_UGL_"(0,2)")) S TRLC=TR D @^(2) G 9
 I $D(LVHCYB),LVHCYB="W",$D(@("^"_Q_UGL_"(0,3)")) S TRLC=TR D @^(3) G 9
 I $D(LVHCYB),LVHCYB="V",$D(@("^"_Q_UGL_"(0,4)")) S TRLC=TR D @^(4) G 9
38 G 9
 ;
YZ Q
 ;
S1 G S1Z:'$D(@("^"_Q_UG1_"(TR)")),S1Z:$N(@("^"_Q_UGL_"(LC,TR,100)"))'=-1
S1A S K=$P(@("^"_Q_UGL_"(LC,TR,1)"),D,10) D KILL^KTO4(LC,TR,K)
S1B K @("^"_Q_UG1_"(TR)"),@("^"_Q_UGB_"(TR)"),@("^"_Q_UG2_"(LC,TR)")
S1C K @("^"_Q_UGL_"(LC,TR)"),^BLBeri("Z",TR)
S1D S SW13=0 I LVHCYB'="O" S LVHCYB="V"
S1E E  K LVHCYB
S1Z Q
 ;
R0 S R7="K'[D&(K'?.E1C.E)" S:$P(R,D,8)'="" R7=R7_","_$P(R,D,8) S:$P(R,D,7)'="" R7=R7_","_$P($T(@$P(R,D,7)),";",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)
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,@R5 D:R5'["""" @R5
R0C S FP=R2*100+R0+F60 W @F,@F2 W $E("........................................",1,R6),@F,@F0
R0D R K S:$P(R,D,7)="DCTR" RD=$P(K,".",1),RM=$P(K,".",2),RJ=$P(K,".",3) W @F2 I $L(K)'>R6,@R7 S @$P(R,D,1)=K G R0F
R0E G R0C
R0F S FP=$P(R,D,9)*100+($P(R,D,10)*1) I FP W @F,$E("                                        ",1,R6),@F,K
R0Z K R,R0,R2,R3,R4,R5,R6,R7,RD,RM,RJ Q
 ;
S3 S FP=2203+F60 W @F,@F1 S FP=2403+F60 W @F,@F4,UOU," ",K," IS REEDS " W:UGL="UL" "GEFAKTUREERD" W:UGL="OD" "OVERGEBOEKT" W " - KLANT : ",$P(U2,D,1) W:UGL="UL" " - FAKTUUR : ",$P(U2,D,2) W " ",@F5,@F0 H 3
S3Z Q
 ;
DCTR ;K?2N1"."2N1"."2N&(RD>0)&(RM>0)&(RD<32)&(RM<13)&'("04060911"[RM&(RD=31))&'(+RM=2&(('(RJ#4)&(RD>29))!(RJ#4&(RD>28))))!("-"[K)
 Q
 ;