KPSL3 G 1 ;STOCKLIJST ;(VOLGENS KLASSIFIKATIE);KPSL1;Go van KPSL1 - Do naar KPSELS [ 08/05/2002  10:22 AM ]
 ;
T1 ;SELEKTIE : 
T2 ;: HB-PNT : MIN-BH : LT : IDENTNUMMER : PRODUKTNAAM               : FYS-ST : ST-RESERVAT-KOM : KOM-TOELEVER-ST : TEO-ST : PRA-ST :   :
T3 ;:--------:--------:----:-------------:---------------------------:--------:-----------------:-----------------:--------:--------:---:
T4 ;BLZ:
T5 ;:        :        :    :             :                           :        :                 :                 :        :        :   :
 ;
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
 ;
S1 W $C(13) S PHBP=PBW+PLL*PGW,AGVS=AGV S:$E(PQ,1)="#" AGVS=$P(PQ,"#",2) S:PHBP<(AGVS*PGV) PHBP=AGVS*PGV S:'PSN PHBP=0 S R=PHBP_"\7\1\0" D:PSN R3
S1A S R=PLQ_"\7\10\0" D:+R R3 W:PLL ?20,$J(PLL,2) W ?25,$J($E(PNR,1,11),11),?39,PC W:PCA ?64,"#"
 I $L(AST) W $C(13),@FMTB,?65,AST W:'BOLD @FMTb W $C(13)
S1B S R=PST_"\7\66\0" D:+R R3 S R=$P(PRE,"#",2)_"\7\75\0" D:+R R3 S R=$P(PRE,"#",3)_"\7\84\0" D:+R R3
S1C S R=$P(PY,"#",3)_"\7\93\0" D:+R R3 S R=$P(PY,"#",2)_"\7\102\0" D:+R R3 S R=PST+$P(PY,"#",2)-$P(PRE,"#",2)_"\7\111\0" D:+R R3 S R=PST-$P(PRE,"#",2)_"\7\120\0" D:+R R3
S1D S PSP="",PSP=PSP_$S('PSN&(PST+$P(PY,"#",2)-$P(PRE,"#",2)!(PST-$P(PRE,"#",2))):"?",1:" ")_$S('PSN&(+PRE>(PST+PY)):"*",1:" ")_$S((PST+PY-PRE)<PHBP:"!",1:" ")
S1E W ?129,PSP
S1Z Q
 ;
1 S SGT="",(BLZ,SWP,SWS,PSUBGR)=0,BP=DJ-1_"."_DM_" "
 D INIT^vhPRINTER(132) G YZ:'$D(Print)
 S LNMAX=Print("LEN")-10-Print("BOT")-Print("TOP")
 S 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 (TFSP,TFNP,TTSP,TTNP,TPSP,TPNP,AGV)=0 S:$D(@("^"_Q_"STPR(0,0,6)")) AGV=+^(6)
22 F I="HG","GR","SG" S @("EX"_$E(I,1))=$P(@("^"_Q_"PR(0,I)"),D,5)
23 I HG'=0 S X=$D(@Q1) G 27:X
25 S HG=$N(@Q1) I HG=-1!(HG]HGX) G 160
27 D HD S GRS=GR I GR'=0 S X=$D(@Q2) G 31:X
29 S GRS=$N(@Q2) I GRS=-1!(GRS]GRX) W # G 25
31 S SGS=SG I SG'=0 S X=$D(@Q3) G 35:X
33 S SGS=$N(@Q3) I SGS=-1!(SGS]SGX) G 29
35 I SGS'=SGT S SGT=SGS,PSUBGR=1
36 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:'SWP!SWS W !,$P($T(T3),U,2) S SWP=0,SWS=1,LN=LN+1 G 33
100 S PR=+^(PRCS) D ^KPCHKPR G 37:'OK
 G 37:$P(A(1),D,25)
111 ;S AST="***" I $N(@("^"_Q_"STPR(PR,0,BP)"))'=-1 S AST=""
 S AST="***" I $D(^AKANAL(PR)) S AST=""
112 S PBW=$P(A(1),D,17),PSN=$P(A(1),D,20),PCA=$P(A(1),D,25),PGW=+$P(A(1),D,21)
113 S PC=$P(A(0),D,1),PST=$P(A(0),D,14),PY=$P(A(0),D,17),PQ=$P(A(0),D,22),PRE=$P(A(2),D,9),PNR=$P(A(2),D,25),(PLL,PLQ,PGV)=0
114 S X="J" I $D(A(X)) S PLQ=$P(A(X),D,6),PLL=$P(A(X),D,7),PGV=$P(A(X),D,16)
117 I KSTC="N",'PST,'$P(PRE,"#",2),'$P(PRE,"#",3),'$P(PY,"#",3),'$P(PY,"#",2) G 37
119 S PPL=$P(A(X),D,19),PMA=$P(A(X),D,17),PK1=$P(A(X),D,9),PK2="",PEA=$P(A(X),D,28) K A
121 S:PEA="H" PPL=PPL/100 S:PEA="M" PPL=PPL/1000 S PPAR=1 S:$L(PMA) PPAR=$$MUNT^vhRtn1(PMA,,11)
123 S PPL=$J(PPL*PPAR*(100-PK1)/100*(100-PK2)/100,0,2)
125 G 129:$E(PC,18,21)="*KP*"
126 I PSN S TFSP=TFSP+(PST*PPL+.99999\1),TTSP=TTSP+(PST+$P(PY,"#",2)-$P(PRE,"#",2)*PPL+.99999\1),TPSP=TPSP+(PST-$P(PRE,"#",2)*PPL+.99999\1) G 129
127 S TFNP=TFNP+(PST*PPL+.99999\1),TTNP=TTNP+(PST+$P(PY,"#",2)-$P(PRE,"#",2)*PPL+.99999\1),TPNP=TPNP+(PST-$P(PRE,"#",2)*PPL+.99999\1)
129 I PSUBGR D PSUBGR(SGS)
130 S LN=LN+1 I LN'<LNMAX W:'SWS !,$P($T(T3),U,2),# D HD G 130
 W !,$P($T(T5),U,2) S BOLD=0 I '$D(B(220)),PSN S BOLD=1
 W:BOLD @FMTB D S1 W:BOLD @FMTb
150 S SWP=1,SWS=0 G 37
160 I 'TFSP,'TFNP,'TTSP,'TPSP,'TTNP,'TPNP G 170
162 D HD
164 W !!?25,"STOCK PROD   NIET-ST PROD         TOTAAL",!!?2,"WAARDE FYS-ST :" S R=TFSP_"\13\22\0" D:+R R3
165 S R=TFNP_"\13\37\0" D:+R R3 S R=TFSP+TFNP_"\13\52\0" D:+R R3
166 W !!?2,"WAARDE TEO-ST :" S R=TTSP_"\13\22\0" D:+R R3
167 S R=TTNP_"\13\37\0" D:+R R3 S R=TTSP+TTNP_"\13\52\0" D:+R R3
168 W !!?2,"WAARDE PRA-ST :" S R=TPSP_"\13\22\0" D:+R R3
169 S R=TPNP_"\13\37\0" D:+R R3 S R=TPSP+TPNP_"\13\52\0" D:+R R3
170 W # D CLOSE^vhPRINTER
YZ Q
 ;
HD S BLZ=BLZ+1,LN=0,SWS=1 W !,QN,?125,$P($T(T4),U,2),$J(BLZ,4),!,NM2,?30,@F82,$P($T(+1),U,2),@F83,$C(13),?51,$P($T(+1),U,3),?125,DT,!,NM3
HDA W ?30,$P($T(T1),U,2),X1,"   ",X2,?126,TD,!! I HG=-1!(HG]HGX) G HDZ
HDB I BLZ>1!($N(B(100))=-1) W $E(HG,EXH,99) W:GR=GRX "- ",$E(GR,EXG,99) W:SG=SGX "- ",$E(SG,EXS,99) W !!,$P($T(T3),U,2),!,$P($T(T2),U,2),!,$P($T(T3),U,2)
HDZ Q
 ;
PSUBGR(KSS) 
 S PSUBGR=0
PSG S LN=LN+1 I LN+1>LNMAX W:'SWS !,$P($T(T3),U,2) W # D HD G PSG
 W !,$P($T(T5),U,2),$C(13),?39,@FMTB,$$DISPLS^KLASS(KSS),@FMTb
 Q
 ;