KBHPP G 1 ;BEHEER PRIJZEN PORT; Go naar KBHPPG - Quit naar MENU [ 06/25/2001  4:35 PM ]
 ;
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
 ;
C1 W !?2,"O[] = openen" Q
C2 W !?2,"A[] = alle prijzen aanpassen   B[] = bepaalde prijs aanpassen"
C2A W !?2,"G[] = gewichtgrens aanpassen   P[] = printen prijzentabel"
C2B W !?3,"[] = ",$S($N(^(GGW))>9999:"begin",1:"volgende") Q
C3 W !?2,"[] = niet aanpassen" W:SW1 "   -[] = terug naar selektie" Q
C4 W !?2,"GRENS[] = prijzen tot grens"
 W !?2,"?[] = overzicht landcodes   -[] = einde programma" Q
 ;
R3 S R1=$P(R,D,2),R2=$P(R,D,4),R0=$J($P(R,D,1),0,R2),R3=" ",R4="" S:R2 R4=","_$P(R0,".",2),R1=R1-1-R2 S:R0<0 R3="-",R0=-R0
R3A S R0=+$P(R0,".",1) F R5=3,7 S R6=$L(R0) G R3B:R6'>R5 S R0=$E(R0,1,R6-R5)_"."_$E(R0,R6-R5+1,R6)
R3B W ?$P(R,D,3),$J(R0,R1),R4,R3
R3Z K R0,R1,R2,R3,R4,R5,R6 Q  ;V1 26.11.84
 ;
S0 S K=$P($T(+1),";",2)_" "_QN_" ",FP=203+$L(K) W @F61,@F11,@F1,@F,@F5 S FP=202 W @F,@F4,K,@F5
S0Z Q
 ;
S1 ;NIEUWE PRIJS
S1A F P=1:1:12 Q:GD=$P(ZGR,D,P)
S1AA S PR=^(GL),OPR=$P(PR,D,P),FP=1941 W @F,"OUDE PRIJS : ",OPR S R="NPR\21\3\NIEUWE PRIJS\C3\5\\""-""[K!(K?.N!(K?.N1""."".N&IsEuro)&(K'<0))\\" D R0 G S1Z:"-"[K
S1B F X=1:1:12 S TPR(X)=$P(PR,D,X)
S1C S YK=TVO(GD),XK=TDK(GL),FP=507+(XK*100)+(YK*8) W @F,$J(NPR,5)
S1D S TPR(YK)=NPR S PR=TPR(1) F X=2:1:12 S PR=PR_D_TPR(X)
S1E S ^(GL)=PR
S1Z Q
 ;
S2 ;ZONE
S2A S R="GD\21\3\ZONE\\1\\K=""-""!(K>0),$D(TVO(K))\19\10",FP=1903 W @F,@F1,$P(R,D,4)," : " W:SW1 GD
S2Z Q
 ;
S3 ;GEWICHTGRENS
S3A S R="GL\21\3\GEWICHTGRENS\\4\\K=""-""!(K>0),$D(TDK(K))\19\32",FP=1917 W @F,@F1,$P(R,D,4)," : " W:SW1 GL
S3Z Q
 ;
S4 ;NIEUWE GRENS
S4A S R="NG\21\3\NIEUWE GRENS\C3\4\\""-""[K!(K?.N&(K>0))\\" D R0
S4B I NG,NG?.N S NG=+NG
S4Z Q
 ;
 ;START PROGRAMMA
1 D S0 S NM(2)=^KBA(99,2),NM(3)=^(3),FAMNTRND=$$MUNT^vhRtn1(,4),IsEuro=$$ISEURO^vhRtn1()
3 S R="LND\21\3\GEEF DE LANDCODE\C4\5\\$L(K)\" D R0
 G YZ:K="-",^KBHPPG:K="GRENS" S (LND,K)=$$LANDKODE(K) G 3:"-"[K S LAND=$$LAND^vhRtn1(K,2)
 G 10:$D(^KPORT(0,$$SAVEKODE(K),0))
5 S FP=2103+F60 W @F,@F1,LAND S R="K\23\3\PRIJZENTABEL BESTAAT NOG NIET\C1\1\\""-O""[K&$L(K)\" D R0 G 3:K="-"
7 S ^KPORT(0,$$SAVEKODE(LND),0)="1\2\3\4\5\6\7\8\9\10\11\12",^(100000)="0\0\0\0\0\0\0\0\0\0\0\0"
9 F I=9952:1:9999 S ^(I)="0\0\0\0\0\0\0\0\0\0\0\0"
10 S FP=255 W @F,@F1,$E(LAND,1,25)
20 L ^KPORT(0,$$SAVEKODE(LND)):2 E  S FP=2403+F60 W @F,@F4,"PRIJZENTABEL ",$E(LAND,1,25)," IN GEBRUIK [] = OK ",@F5,@F0 R K G YZ
25 S ZGR=^KPORT(0,$$SAVEKODE(LND),0),(TDK("-"),TVO("-"))=""
30 S FP=410 W @F,"ZONE" F X=1:1:8 S ZN=$P(ZGR,D,X),FP=FP+8 W @F,$J(ZN,2)," |" S TVO(ZN)=X
40 S GGW=0 W !?5,"TOT KG |-------|-------|-------|-------|-------|-------|-------|-------|"
50 F X=1:1:12 S GGW=$N(^(GGW)),TDK(GGW)=X,FP=504+(X*100) W @F,"|",$J(GGW,7)," |" S PR=^(GGW),FP=FP+3 F Y=1:1:8 S MP=$P(PR,D,Y),FP=FP+8 W @F,$J(MP,5)," |"
60 S FP=1901 W @F,@F2 S R="ANT\21\3\AANPASSEN PRIJZEN OF GEWICHTSGRENZEN OF PRINTEN TABEL\C2\1\\""-ABGP""[K\\" D R0
62 I K="" S:$N(^(GGW))>9999 GGW=0 K TDK S TDK("-")="",FP=601 W @F,@F1 G 50
65 S SW1=0 G YZ:ANT="-",210:ANT="P",150:ANT="G" S:ANT="A" SW1=1 G 90:SW1
 ;PRIJZEN
70 D S2,R0 G 105:GD="-"
80 D S3,R0 G 70:GL="-"
90 I SW1 S GL=0 F A=1:1:12 S GL=$N(TDK(GL)) F B=1:1:8 S GD=$P(ZGR,D,B) D S2,S3,S1 G 105:NPR="-"
100 I 'SW1 D S1 G 80:NPR="-",70
105 G 60
 ;NIEUWE GEWICHTGRENS
150 K TNG S GGR=$O(TDK(""))-1
155 F X=1:1:12 S GGR=$N(^(GGR)),TNG(X)=GGR
160 D S3,R0 G 205:GL="-"
170 D S4 G 160:"-"[NG,170:NG>$N(^(GL))!$D(^(NG)) I TDK(GL)-1>0 G 170:TNG(TDK(GL)-1)'<NG
180 I TDK(GL)+1<3 G 170:TNG(TDK(GL)+1)'>NG
190 S TNG(TDK(GL))=NG,TDK(NG)=TDK(GL) K TDK(GL) S FP=508+(TDK(NG)*100) W @F,$J(TNG(TDK(NG)),4)
200 S:NG>GGW GGW=NG S ^(NG)=^(GL) K ^(GL) G 160
205 K TNG G 60
 ;UITLIJSTEN TABEL
210 D
 .D:$G(QW) ZWINT^vhRtn2(1)
 .N QW
 .D INIT^vhPRINTER(80) Q:'$D(Print)
 .W !!!?4,QN,?68,DT,!?4,NM(2),?36,"PRIJZEN PORT",?69,TD,!?4,NM(3),?36,LAND
 .W !!!!?11,"ZONE" S PRT=^KPORT(0,$$SAVEKODE(LND),0) F X=1:1:8 W ?12+(8*X)-$L($P(PRT,D,X)),$P(PRT,D,X)
 .S GGW=0 W !?4,"TOT KG +" F X=1:1:64 W "-"
 .W !?11,"|" F X=1:1:48 S GGW=$N(^(GGW)),PRT=^(GGW) W ! S R=GGW_"\5\5\0" D:+R R3 W "|" F Y=1:1:8 S R=$P(PRT,D,Y)_"\6\"_(6+(8*Y))_D_FAMNTRND D:+R R3
 .W # D CLOSE^vhPRINTER
 D:$G(QW) ZWINT^vhRtn2(0) S R=^KPORT(0,$$SAVEKODE(LND),0) G 60
 ;
YZ L  K A,ANT,B,ZGR,GGR,GGW,GD,GL,ZN,MP,NG,NM,NPR,OPR,P,PR,PRT,SW1,TDK,TNG,TPR,TVO,X,XK,Y,YK Q
 ;
LANDKODE(LandKode) 
 New K,Versie6
 If LandKode'="GRENS" Do
 .Set Versie6=$$ISVERS6^vhRtn1
 .If LandKode="?" Do
 ..If Versie6 Set LandKode=$$^cANSYN("ISO.LAND","","",0) Quit
 ..Do 2^cA241
 ..Set LandKode=K
 .Else  Do
 ..Set LandKode=$$LAND^vhRtn1(LandKode)
 ..Set:$L(LandKode) LandKode=$$LAND^vhRtn1(LandKode,,'Versie6+1)
 Quit LandKode
 ;
SAVEKODE(LandKode) 
 New Versie6
 If LandKode'="GRENS" Set Versie6=$$ISVERS6^vhRtn1 Set:Versie6 LandKode=$$LAND^vhRtn1(LandKode,"I")
 Quit LandKode
 ;