KPDP3 G 1 ;DEELPRODUKTEN ;(VOLGENS KLASSIFIKATIE);KPDP1;Go van KPDP1 - Do naar KPSELS [ 08/05/2002  11:56 AM ]
 ;
T1 ;SELEKTIE : 
T2 ;: HOOFDGROEP      : GROEP           : SUBGROEP        : PRODUKTNAAM               : IDENTNUMMER : PRODUKTNAAM DEELPRODUKT   : AANTAL :
T3 ;:-----------------:-----------------:-----------------:---------------------------:-------------:---------------------------:--------:
T4 ;BLZ:
 ;
SC S PCDC=$$COMPR^PRODUKT($E(PDP,2,99))
 Q
 ;
S1 W !,": ",$E(HGG,EXH,99),?18,": ",$E(GRG,EXG,99),?36,": ",$E(SGG,EXS,99),?54,": ",PC,?82,": ",PID,?96,": ",PCD,?124,":"
S1A W:PDA $J(PDA,7,0) W ?133,":"
S1Z 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
 ;
1 S BLZ=0,I=100 G 19:$N(B(I))=-1 D HD,^KPSELS
19 S Q0="^"_Q_"PR(PR,0)",Q1="^"_Q_"PH(HG)",Q2="^"_Q_"PH(HG,GRS)",Q3="^"_Q_"PH(HG,GRS,SGS)",Q4="^"_Q_"PH(HG,GRS,SGS,MK,PRCS)"
21 S PLX="" F I="HG","GR","SG" S @("EX"_$E(I,1))=$P(@("^"_Q_"PR(0,I)"),D,5)
23 I HG'=0 S HGG=HG,X=$D(@Q1) G 27:X
25 S (HG,HGG)=$N(@Q1) I HG=-1!(HG]HGX) G 160
27 S LN=100,(GRS,GRG)=GR I GR'=0 S X=$D(@Q2) G 31:X
29 S (GRS,GRG)=$N(@Q2) I GRS=-1!(GRS]GRX) W:LN<100 !,$P($T(T3),U,2),# G 25
31 S (SGS,SGG)=SG I SG'=0 S X=$D(@Q3) G 35:X
33 S (SGS,SGG)=$N(@Q3) I SGS=-1!(SGS]SGX) G 29
35 S PRCS=PRC I PRC'=0 S X=$D(@Q4) G 100:X
37 S PRCS=$N(@Q4) I PRCS=-1!(PRCS]PRCX) G 33
100 S PR=+^(PRCS) D ^KPCHKPR G 37:'OK
110 S PDP=$E($N(@("^"_Q_"PR(PR,""D"")")),1) G 37:PDP'="D"
112 S PC=$P(A(0),D,1),PID=$P(A(2),D,25),DLN=2 K @("^"_Q_"HULP($J)")
114 S PDP=$N(@("^"_Q_"PR(PR,PDP)")) G 118:$E(PDP,1)'="D" S PDA=+^(PDP),PCD=$P(@("^"_Q_"PR($E(PDP,2,99),0)"),D,1),PIDD=$P(^(2),D,25)
116 D SC S @("^"_Q_"HULP($J,PCDC)")=PIDD_D_PCD_D_PDA_D,DLN=DLN+1 G 114
118 S LN=LN+DLN I LN>50 W:LN<100 !,$P($T(T3),U,2),# D HD G 118
120 S (PCD,PDA)="" D S1 S PCDC=-1
122 S PCDC=$N(@("^"_Q_"HULP($J,PCDC)"))
124 I PCDC'=-1 S X=^(PCDC),(HGG,GRG,SGG,PC)="",PID=$P(X,D,1),PCD=$P(X,D,2),PDA=$P(X,D,3) D S1 G 122
126 W !,":",?18,":",?36,":",?54,":",?82,":",?96,":",?124,":",?133,":"
128 G 37
160 D CLOSE^vhPRINTER K @("^"_Q_"HULP($J)")
YZ Q
 ;
HD S BLZ=BLZ+1,LN=0 W !,QN,?126,$P($T(T4),U,2),$J(BLZ,4),!,NM2,?30,@F82,$P($T(+1),U,2),@F83,$C(13),?62,$P($T(+1),U,3),?126,DT,!,NM3
HDA W ?127,TD,!! I HG=-1!(HG]HGX) G HDZ
HDB I BLZ>1!($N(B(100))=-1) W HG W:GR=GRX "- ",GR W:SG=SGX "- ",SG W !!,$P($T(T3),U,2),!,$P($T(T2),U,2),!,$P($T(T3),U,2)
HDZ Q
 ;