KPPL4 G 1 ;PRODUKTENLIJST ;(VOLGENS LEVERANCIER - ;KPPL1;Go van KPPL1, naar KPPL7, KPPL10 - Do naar KPSELS [ 08/05/2002   4:27 PM ]
 ;
T1 ;SELEKTIE : 
T2 ;: HOOFDGROEP      : GROEP           : SUBGROEP        : IDENTNUMMER : ARTIKEL  -  OMSCHRIJVING                                  : D :
T3 ;:-----------------:-----------------:-----------------:-------------:-----------------------------------------------------------:---:
T4 ;BLZ:
T5 ;NEDERLAND;FRAN;DUIT
T6 ;SE OMSCHRIJVING)
 ;
S2 W $C(13),?56,$J($E(PNR,1,11),11),?70,$E(PC,1,11),?82,$TR(PN,FVAN,FNAAR),?109,$J($TR(PCO,FVAN,FNAAR),18),?130,$P("\D",D,PDP+1)
S2Z Q
 ;
S3 W $C(13),?82,$TR(PN2,FVAN,FNAAR)
S3Z Q
 ;
1 I KANT<3 G ^KPPL7:KANT=2,^KPPL10
11 S BLZ=0,I=100 G 19:$N(B(I))=-1 D HD,^KPSELS
19 S Q0="^"_Q_"PR(PR,0)",Q1="^"_Q_"LE(LE)",Q2="^"_Q_"PL(LES)",Q3="^"_Q_"HULP($J,PRCS)",(HX,HXX,GX,GXX,SX,SXX)=""
23 I LE'=0 S X=$D(@Q1) G 27:X
25 S LE=$N(@Q1) I LE=-1!(LE]LEX) G 160
27 S LES=$P(LE," ",2)_" ",LNM=$P(^(LE,0),D,2),X=$D(@Q2) G 25:'X D S9,HD
29 S PRCS=PRC I PRC'=0 S X=$D(@Q3) G 100:X
31 S PRCS=$N(@Q3) I PRCS=-1!(PRCS]PRCX) W !,$P($T(T3),U,2),# G 25
100 S PR=+^(PRCS) D ^KPCHKPR G 31:'OK
 G 31:$P(A(1),D,25)
112 S PC=$P(A(0),D,1),PSN=$P(A(1),D,20),PN=$P(A($P("0\1\2",D,KANT-2)),D,$P("2\22\2",D,KANT-2)),GVP=0 I $D(A("J")) S GVP=$P(A("J"),D,15) S:'GVP GVP=$P(A("J"),D,16)
113 S PN2=$P(A($P("0\3\3",D,KANT-2)),D,$P("11\21\23",D,KANT-2)),PNR=$P(A(2),D,25),PDP=$D(^("E"))
114 S PCO="" S:$D(@("^"_Q_"COL($E(""    "",1,4-$L($E(PC,22,25)))_$E(PC,22,25)_"" "")")) PCO=^($E("    ",1,4-$L($E(PC,22,25)))_$E(PC,22,25)_" ",$P("N\F\D",D,KANT-2))
116 S:'$D(A("I")) A("I")="" I HX'=$P(A("I"),D,1) S (HX,HXX)=$P(A("I"),D,1),(GX,GXX)=$P(A("I"),D,2),(SX,SXX)=$P(A("I"),D,3)
118 I GX'=$P(A("I"),D,2) S (GX,GXX)=$P(A("I"),D,2),(SX,SXX)=$P(A("I"),D,3)
120 I SX'=$P(A("I"),D,3) S (SX,SXX)=$P(A("I"),D,3)
122 S LN=LN+3 I LN>50 W !,$P($T(T3),U,2),# D HD G 122
125 W !,": ",$E(HXX,EXH,99),?18,": ",$E(GXX,EXG,99),?36,": ",$E(SXX,EXS,99),?54,": ",$J($E(PNR,1,11),11),?68,": ",$E(PC,1,11)
127 W ?82,$TR(PN,FVAN,FNAAR),?109,$J($TR(PCO,FVAN,FNAAR),18),?128,": ",$P("\D",D,PDP+1),?132,":" I '$D(B(220)),PSN D S2,S2
130 W !,":",?18,":",?36,":",?54,":",?68,": " W:GVP>1 $J($P("VP\EM\VP\VP",D,KANT-2)_":"_GVP,8) W ?82,$TR(PN2,FVAN,FNAAR),?128,":",?132,":" I '$D(B(220)),PSN D S3,S3
133 W !,":",?18,":",?36,":",?54,":",?68,":",?128,":",?132,":"
136 S (HXX,GXX,SXX)="" G 31
160 D CLOSE^vhPRINTER K @("^"_Q_"HULP($J)")
YZ Q
 ;
HD S BLZ=BLZ+1,LN=0 W !,QN,?125,$P($T(T4),U,2),$J(BLZ,4),!,NM2,?30,@F82,$P($T(+1),U,2),@F83,$C(13),?60,$P($T(+1),U,3),$P($T(T5),U,KANT-1),$P($T(T6),U,2),?125,DT,!,NM3
HDA W ?30,$P($T(T1),U,2),X1,"   ",X2,?126,TD,!! I LE=-1!(LE]LEX) G HDZ
HDB I BLZ>1!($N(B(100))=-1) W LNM,!!,$P($T(T3),U,2),!,$P($T(T2),U,2),!,$P($T(T3),U,2)
HDZ Q
 ;
S9 K @("^"_Q_"HULP($J)") S SL=LES,SM=0,S1="^"_Q_"PL(SL,SM)",S2="^"_Q_"PL(SL,SM,SR)",S3="^"_Q_"PL(SL,SM,SR,SP)"
S9A S SM=$N(@S1) G S9Z:SM=-1 S SR=0
S9B S SR=$N(@S2) G S9A:SR=-1 S SP=0
S9C S SP=$N(@S3) G S9B:SP=-1 S R=+^(SP),@("^"_Q_"HULP($J,SP)")=R G S9C
S9Z K SL,SM,SR,SP,S1,S2,S3,R Q
 ;