VERVS ;WIJZIGEN VAN VERVOERLIJST BLUM (SORT) ;VERVOER; Do naar PROC [ 10/31/2001  3:09 PM ]
 ;
T10 ;GEWENSTE SORTEERVOLGORDE : .
T11 ;P = volgens produkt   T = volgens toelevering   - = einde programma
T12 ;Rangschikken volgens ;produkt;toelevering;blum;verpakking
T13 ;Onbek
T14 ;*** I'm thinking ***
 ;
SA1 S FP=255 W @F,$J("",5),@FMTK,$P($T(T14),U,2),@FMTk
 Q
 ;
 ; Sorteervolgorde
SORT K ^HULP($J,"VVL") S FP=2303 w @F,@F1,$P($T(T10),U,2),!?2,$P($T(T11),U,2)
SORT1 D IK^PROC1 I R'="-" G SORT1:R="",SORT1:"PT"'[R D SSM
 S FP=2301 W @F,@F1
 Q
 ;
 ; Select sortmodule
SSM S FP=2303 W @F,@F1,$P($T(T12),U,2),$P($T(T12),U,$F("PTBV",R)+1) D @("SP"_R)
 Q
 ;
 ; Sort volgens produkt
SPP D SA1 S (FAKRF,LRF)=-1,HULP="^HULP($J,""VVL"",HG,GR,SG,PCC,$P(R,D,9,10)"
SPP0 S FAKRF=$N(^Verv(LC,"D",VRF,FAKRF)) G SPP3:FAKRF=-1
SPP1 S LRF=$N(^Verv(LC,"D",VRF,FAKRF,LRF)) G SPP0:LRF=-1
 S R=^(LRF) I '$D(TYPE) G SPP1:$P(R,D,9)="P"
 I $D(TYPE),TYPE'="V" G SPP1:$P(R,D,9)="P"
 I $D(SOVD),$L(SOVD) G SPP1:SOVD="N"&$L($P(R,D,16)),SPP1:SOVD="O"&'$L($P(R,D,16))
 I $P(R,D,1)="" S $P(R,D,1)=$P($T(T13),U,2)
 D PRO S (HG,GR,SG)=" " G SPP2:'PR,SPP2:'$D(^KPR(PR,0))
 I $E($N(^("I")),1)="I" S K=$P(^($N(^("I"))),D,1,3),HG=$P(K,D,1),GR=$P(K,D,2),SG=$P(K,D,3)
SPP2 S PC=$P(R,D,16) D COK,SVL,HULP G SPP1
SPP3 S HG=-1,LRF=0,(TRX,ABX)=""
SPP4 S HG=$N(^HULP($J,"VVL",HG)) G SPP11:HG=-1 S GR=-1
SPP5 S GR=$N(^HULP($J,"VVL",HG,GR)) G SPP4:GR=-1 S SG=-1
SPP6 S SG=$N(^HULP($J,"VVL",HG,GR,SG)) G SPP5:SG=-1 S PCC=-1
SPP7 S PCC=$N(^HULP($J,"VVL",HG,GR,SG,PCC)) G SPP6:PCC=-1 S AB=-1
SPP8 S AB=$N(^HULP($J,"VVL",HG,GR,SG,PCC,AB)) G SPP7:AB=-1,SPP10:'$D(TYPE) S PAL=-1
SPP9 S PAL=$N(^HULP($J,"VVL",HG,GR,SG,PCC,AB,PAL)) I PAL=-1!(TYPE'="V"&(PAL>1)) K ^HULP($J,"VVL",HG,GR,SG,PCC,AB) G SPP8
 S R=^(PAL) D TNAB G SPP9
SPP10 S R=^(AB) K ^(AB) D TNAB G SPP8
SPP11 Q
 ;
 ; Sort volgens toelevering
SPT D SA1 S (FAKRF,LRF)=-1,HULP="^HULP($J,""VVL"",$P(R,D,1),$P(R,D,9,10)"
SPT0 S FAKRF=$N(^Verv(LC,"D",VRF,FAKRF)) G SPT2:FAKRF=-1
SPT1 S LRF=$N(^Verv(LC,"D",VRF,FAKRF,LRF)) G SPT0:LRF=-1
 S R=^(LRF) I '$D(TYPE) G SPT1:$P(R,D,9)="P"
 I $D(TYPE),TYPE'="V" G SPT1:$P(R,D,9)="P"
 I $D(SOVD),$L(SOVD) G SPT1:SOVD="N"&$L($P(R,D,16)),SPT1:SOVD="O"&'$L($P(R,D,16))
 I $P(R,D,1)="" S $P(R,D,1)=$P($T(T13),U,2)
 D PRO,SVL,HULP G SPT1
SPT2 S TR=-1,LRF=0,(TRX,ABX)=""
SPT3 S TR=$N(^HULP($J,"VVL",TR)) G SPT7:TR=-1 S AB=-1
SPT4 S AB=$N(^HULP($J,"VVL",TR,AB)) G SPT3:AB=-1,SPT6:'$D(TYPE) S PAL=-1
SPT5 S PAL=$N(^HULP($J,"VVL",TR,AB,PAL)) I PAL=-1!(TYPE'="V"&(PAL>1)) K ^HULP($J,"VVL",TR,AB) G SPT4
 S R=^(PAL) D TNAB G SPT5
SPT6 S R=^(AB) K ^(AB) D TNAB G SPT4
SPT7 Q
 ;
 ; Sort volgens blum (vervoerlijst)
SPB D SA1 S (FAKRF,LRF)=-1,HULP="^HULP($J,""VVL"",VRF,FAKRF_LRF"
SPB0 S FAKRF=$N(^Verv(LC,"D",VRF,FAKRF)) G SPB2:FAKRF=-1
SPB1 S LRF=$N(^Verv(LC,"D",VRF,FAKRF,LRF)) G SPB0:LRF=-1
 S R=^(LRF) I '$D(TYPE) G SPB1:$P(R,D,9)="P"
 I $D(TYPE),TYPE'="V" G SPB1:$P(R,D,9)="P"
 I $D(SOVD),$L(SOVD) G SPB1:SOVD="N"&$L($P(R,D,16)),SPB1:SOVD="O"&'$L($P(R,D,16))
 I $P(R,D,1)="" S $P(R,D,1)=$P($T(T13),U,2)
 D PRO,SVL,HULP G SPB1
SPB2 S TR=-1,LRF=0,(TRX,ABX)=""
SPB3 S TR=$N(^HULP($J,"VVL",TR)) G SPB7:TR=-1 S AB=-1
SPB4 S AB=$N(^HULP($J,"VVL",TR,AB)) G SPB3:AB=-1,SPB6:'$D(TYPE) S PAL=-1
SPB5 S PAL=$N(^HULP($J,"VVL",TR,AB,PAL)) I PAL=-1!(TYPE'="V"&(PAL>1)) K ^HULP($J,"VVL",TR,AB) G SPB4
 S R=^(PAL) D TNAB G SPB5
SPB6 S R=^(AB) K ^(AB) D TNAB G SPB4
SPB7 Q
 ;
 ; Sort volgens verpakking
SPV D SA1 S (FAKRF,LRF)=-1,HULP="^HULP($J,""VVL"",$P(RR,D,16),FAKRF_LRF"
SPV0 S FAKRF=$N(^Verv(LC,"D",VRF,FAKRF)) G SPV2:FAKRF=-1
SPV1 S LRF=$N(^Verv(LC,"D",VRF,FAKRF,LRF)) G SPV0:LRF=-1
 S R=^(LRF) I '$D(TYPE) G SPV1:$P(R,D,9)="P"
 I $D(TYPE),TYPE'="V" G SPV1:$P(R,D,9)="P"
 I $D(SOVD),$L(SOVD) G SPV1:SOVD="N"&$L($P(R,D,16)),SPV1:SOVD="O"&'$L($P(R,D,16))
 I $P(R,D,1)="" S $P(R,D,1)=$P($T(T13),U,2)
 D PRO,SVL,HULP G SPV1
SPV2 S TR=-1,LRF=0,(TRX,ABX)=""
SPV3 S TR=$N(^HULP($J,"VVL",TR)) G SPV7:TR=-1 S AB=-1
SPV4 S AB=$N(^HULP($J,"VVL",TR,AB)) G SPV3:AB=-1,SPV6:'$D(TYPE) S PAL=-1
SPV5 S PAL=$N(^HULP($J,"VVL",TR,AB,PAL)) I PAL=-1!(TYPE'="V"&(PAL>1)) K ^HULP($J,"VVL",TR,AB) G SPV4
 S R=^(PAL) D TNAB G SPV5
SPV6 S R=^(AB) K ^(AB) D TNAB G SPV4
SPV7 Q
 ;
 ; Produkt
PRO S $P(R,D,16)="*** "_$P(R,D,8)_" ***"_D,PR=$P(R,D,7) I PR,$D(^KPR(PR,0)) S $P(R,D,16)=$P(^(0),D,1)_D_$P(^(2),D,25)_D_$P("*",D,$P(^(1),D,20)+1) G PRO1
 I $D(^BLProd("D",0_$P(R,D,8))) S $P(R,D,16)=$P(^(0_$P(R,D,8)),D,1)_"\\#"
PRO1 Q
 ;
 ; Compress korttekst
COK S:PR PCC=$$COMPR^PRODUKT(PR)
 S:'PR PCC=$$UPTRIMAN^vhRtn1(PC)
 Q
 ;
 ; Toeleveringsnummer - AB nummer
TNAB S TRXX=$P(R,D,1)
 S:$P(R,D,1)=TRX $P(R,D,1)="" S:$P(R,D,1)'="" TRX=$P(R,D,1)
 S:$P(R,D,2)=ABX $P(R,D,2)="" S:$P(R,D,2)'="" ABX=$P(R,D,2),$P(R,D,1)=TRXX
 I $P(R,D,1) S K=R,FN(1)=+R,FN(2)=15,FN(3)=0,FN(4)="N+" D FN^PROC S $P(K,D,1)=R,R=K
 S LRF=LRF+1,^HULP($J,"VVL",LRF)=R
 Q
 ;
 ; Schikken vervoerlijn
SVL I $P(R,D,7),$D(^KPR($P(R,D,7))) S $P(R,D,19)=$P(^($P(R,D,7),0),D,6)
 I $L($P(R,D,19)) S $P(R,D,19)=$E($P(R,D,19),1)_"."_$E($P(R,D,19),2)_"."_$E($P(R,D,19),3)
 S $P(R,D,9)=$S($P(R,D,9)="M":"M",$P(R,D,9)="P":"B",1:"")
 S R=$P(R,D,1)_D_$P(R,D,3)_D_$P(R,D,16)_D_$P(R,D,10,11)_D_$P(R,D,13)_"\\\"_$P(R,D,3,4)_D_$P(R,D,1)_D_$P(R,D,17,19)_D_$P(R,D,9)
 G SVL1:'+R I $D(^KTO(LC,+R,1)) S K=^(1),$P(R,D,7,8)=$P(K,D,7,8)
 I $P(R,D,8),$D(^KK1($P(R,D,8))) S $P(R,D,8)=$P(^KKL(^($P(R,D,8)),0),D,2)
SVL1 Q
 ;
 ; Opbouwen hulp
HULP S $P(R,D,21)=$P(R,D,5) D TOEL:$P(R,D,6)="V" I '$D(LIJST) S @(HULP_")")=R G HULP3
 G HULP1:$D(^Verv(LC,"D",VRF,FAKRF,LRF,"V")) I $P(R,D,15)'="M" S $P(RR,D,16)=" ",@(HULP_",0)")=R K RM G HULP3
 S RM=R S:TYPE="C" @(HULP_",0)")=R G HULP3
HULP1 S K=^("V"),PRF=0,RR=R I $P(R,D,15)'="B" K RM
HULP2 G HULP3:K="" S $P(RR,D,16)=$P($P(K,D,1),U,1),$P(RR,D,17)=$P($P(K,D,1),U,2),$P(RR,D,18)=$P($P(K,D,1),U,3)
 S:$P(RR,D,16)="" $P(RR,D,16)=" " S $P(RR,D,19)=$P(RR,D,17)*$P(RR,D,18)
 S K=$P(K,D,2,99),$P(RR,D,20)=$P(K,U,1),PRF=PRF+1,@(HULP_",PRF)")=RR S:TYPE="V" $P(RR,D,4,5)="REST \" G HULP2:'$D(RM) S ^(0)=RM G HULP2
HULP3 Q
 ;
 ; Toeleveringsaantal
TOEL S AB=-1,TR=$P(R,D,1)
TOEL1 S AB=$N(^KTO3(TR,AB)) I AB'=-1,$P(AB,D,2)'=$P(R,D,10) G TOEL1
 I AB'=-1 S UZ=$P(AB,D,3),$P(R,D,21)=$P(^KTO(LC,TR,UZ),D,3)
 Q
 ;
Z X ^cZ Q
ZZ ; 20.09.91 - 13 u 16