RPLPR ;RAADPLEGEN PRODUCTEN ;RPLPR; Do naar RPLPR2, RPLPR3, SELPR en PROC [ 12/16/2003  10:18 AM ]
 G 1
 ;
T30 ;WELK SCHERM ;S,W,M,V,H,O,T,U,R   -[] = einde programma
T31 ;WELK SCHERM ;T   -[] = einde programma
T101 ;IDENTNUMMER;3;2;;3;2;;;11;;;;;;;325;;;;;;;1
T102 ;PRODUKTNAAM;4;2;;4;2;;;25;;;;;;;101;;;;;;;1
T103 ;KLASSIFIKATIE;6;2;;6;2;;"" I $P(B("I"),D,4) S U3=$$DISPL^KLASS($P(B("I"),D,4));24;;;;;;;101;;;;;;;1
T104 ;Fys stock;3;27;;3;43;;K S K=$S($D(PR):$$DISPSTOC^PRODUKT4(PR),1:K),U3=$J(K,8);15;;;;;;;114;;;;;;;
T105 ;St/Niet-st;4;27;;4;43;;$P("NIET-STOCK\STOCK",D,K+1);10;;;;;;;220;;;;;;;
T106 ;Gem weekv;5;27;;5;43;;K S FN(1)=K+$P(K,"#",2),FN(2)=8,FN(4)="N" D FN^PROC S U3=$J(R,8),K=+K I K S FN(1)=K,FN(4)="N+" D FN^PROC S U3=U3_"(S="_R_")";8;;;;9;;;221;;;;;;;
T107 ;Verpakking;6;27;;6;43;;K S U3="",FN(2)=8,FN(4)="N+" F K=16,15,14 S FN(1)=$P(B("J"),D,K) I FN(1) D FN^PROC S:$L(U3) U3=U3_" - " S U3=U3_R;8;;;;22;;;101;;;;;;;
T108 ;Katprijs;3;58;;3;73;;$P("CONS\PLUS\LIJST\RABAT\SPIL\BASIS\GROOT",D,$F("CPLRSBG",K)-1);5;;;;;;;219;;;;;;;
T109 ;Leverterm;4;58;;4;73;;K S FN(1)=$P(B("J"),D,7),FN(2)=8,FN(4)="N" D FN^PROC S U3=$J(R,8);8;;;;;;;101;;;;;;;
T110 ;Min bst h;5;58;;5;73;;K S FN(1)=$P(B("J"),D,6),FN(2)=8 D FN^PROC S U3=$J(R,8);8;;;;;;;101;;;;;;;
T111 ;;7;27;;7;43;;K S $P(U2,U,1)="Bufferw" S:$P(B(1),D,24) K=$P(B(1),D,24),$P(U2,U,1)="Limiet" S FN(1)=K,FN(2)=8 D FN^PROC S U3=$J(R,8) I 'SW5 S FP=$P(U2,U,2)*100+$P(U2,U,3)+2 W @F,@F6,$P(U2,U,1),@F9;8;;;;;;;217;;;;;;;
T112 ;Scanning;7;58;;7;73;;K S FN(1)=K,FN(2)=8 D FN^PROC S U3=$J(R,8);8;;;;;;;118;;;;;;;
 ;
S2 S U2=A(U1),X=$P(U2,U,16) S:'$D(B(X\100)) B(X\100)="\\\\\\\\\\\\\\\\\\\\\\\\\" S (K,U3)=$P(B(X\100),D,X#100) I $L($P(U2,U,8)) X "S U3="_$P(U2,U,8)
 S FP=$P(U2,U,5)*100+$P(U2,U,6) I '$P(U2,U,23) S FP=FP-3 W @F,@F9,":"
 S FP=$P(U2,U,2)*100+$P(U2,U,3) W:$P(U2,U,22) @F,$J(U1#100,2) I '$P(U2,U,23) S FP=FP+2 W @F,@F6,$P(U2,U,1),@F9
 S FP=$P(U2,U,5)*100+$P(U2,U,6)
 W @F,$J("",$P(U2,U,9)),$J("",$P(U2,U,13)),@F,U3
 Q
 ;
 ;Titel
TI S K=$P($T(+1),U,2)_QN_" ",FP=203+$L(K) W @F,@F5 S FP=202 W @F,@F4,K,@F5
 Q
 ;
 ;Verwijder ballast
VBA F I=4,7,10:1:12,14,15,17:1:22 S $P(U2,U,I)=""
 Q
 ;
 ;Omschakelen naar 80- of 132 kolommen
NCOL(TCol) 
 S:'$D(NCol) NCol=80
 S:'$D(TCol) TCol=$S('$D(DL):80,$D(@DL(1)@(5)):@DL(1)@(5),1:80)
 I TCol'=NCol s NCol=TCol,KIF=0 W @("@FS"_NCol) D TI
 Q
 ;
 ;Produkteninformatie
PIF D NCOL() I PIF=1,U4'=VTB S FP=@DL(1)@(3)*100+1 W @F,@F1
 G PIF2:PIF S PIF=1 K A F X=101:1:110 S A(X)=$P($T(@("T"_X)),U,2,99)
 S U1=100,SW5=0 I VTB'=U4 S SW5=1,FP=401 W @F,@F1
PIF1 S U1=$N(A(U1)) I U1'=-1 K FN D S2 G PIF1
PIF2 Q
 ;
PIF3 F X=111:1:112 S A(X)=$P($T(@("T"_X)),U,2,99)
 S U1=110,SW5=0 I VTB'=U4 S SW5=1,FP=701 W @F,@F1
 G PIF1
 Q
 ;
 ;Verwijderen produkteninfo
VPI N GRef
 S GRef=$$GREF(),X=100
VPI1 S X=X+1,U2=$P($T(@("T"_X)),U,2,99),FP=$P(U2,U,2)*100+$P(U2,U,3)
 W @F,$J("",$P(U2,U,6)-$P(U2,U,3)),$J("",$P(U2,U,9)),$J("",$P(U2,U,13)) G VPI1:X<110
 K A S A(101)=$P(@("^"_GRef_"(0,101)"),U,1,16),A(102)=$P(^(102),U,1,16),SW5=1,U1=101 D S2 S U1=102 D S2
 Q
 ;
 ;Raadplegen klant
RAK
 S R=$S($L(VTB):VTB,1:SW2)
 I VTB="H" G RAK1:'$D(^HULP($J,"P"_PR,"F",STF(6))) S KC=$P(^(STF(6)),D,7) G RAK2
 I VTB="M" G RAK1:'DEM,RAK1:'$D(^HULP($J,"P"_PR,"M",BP,DEM(6))) S KC=$P(^(DEM(6)),D,1) G RAK2
 I VTB="O" G RAK1:'$D(^HULP($J,"P"_PR,"O",OOT(6))) D  G RAK2
 . S KC=$P(^(OOT(6)),D,2)
 . I KC,$D(^KK1(KC)) D
 . . N ORDNr
 . . S ORDNr=$P(^HULP($J,"P"_PR,"O",OOT(6)),D)
 . . S Screen="O",SELECT="ORD;"_ORDNr
 . . K ^HULP($J,"K"_KC,"O")
 I VTB="U" G RAK1:'$P($G(^HULP($J,"P"_PR,"U",UTZ(6))),D,1) S KC=$P(^(UTZ(6)),D,1) G RAK2
 I VTB="R" G RAK1:'$P($G(^HULP($J,"P"_PR,"R",PRF(6))),D,2) S KC=$P(^(PRF(6)),D,2) G RAK2
 I VTB="V" G RAK1:'$D(^AKANAL(PR,VKA(6))),RAK1:$P(^(VKA(6)),D)="MOK" S KC=$P(^(VKA(6)),D,2) G RAK2
RAK1 G 33
 ;
RAK2 I KC,$D(^KK1(KC)) S PARAM=KC S:$D(Screen) $P(PARAM,D,2)=Screen S:$D(SELECT) $P(PARAM,D,7)=SELECT K Screen,SELECT D NCOL(80) G PK^RPLSW
 G 33
 ;
 ;Raadplegen produkt Blum
RPB S R=$S($L(VTB):VTB,1:SW2)
 Set ID=$TR($P(B(3),D,25),".","")
 I $L(ID),$D(^BLProd("D",ID)) S PARAM=ID G LB^RPLSW
 S $E(ID)=0 I $L(ID),$D(^BLProd("D",ID)) S PARAM=ID D NCOL(80) G LB^RPLSW
 D O8^RPLPR2 G 33
 ;
REFRESH S R=U4,(SW2,VTB)="",PIF=0
 S:R="X" VTB="O"
 Write @F11,@F1 D TI,PIF
 Q
 ;
 ;Reset tabellen
RET S (VKA(6),VKA(7),WVK(7),MOM(6),MOM(7),STF(6),STF(7),TMS(7),OOT(6),OOT(7),PTA(7),PRF(6),PRF(7))=1
 I $D(PARAM),$L($P(PARAM,D,4)) D
 .I $P(PARAM,D,5) X "S "_$P(PARAM,D,4)_"(6)="_$P(PARAM,D,5)
 .I $P(PARAM,D,6) X "S "_$P(PARAM,D,4)_"(7)="_$P(PARAM,D,6)
 K VKA(9),WVK(9),MOM(9),STF(9),TMS(9),OOT(9),PTA(9),PRF(9)
 Q
 ;
 ;Start
1 I $D(PARAM) D
 .S:$L($P(PARAM,D,1)) PR=$P(PARAM,D,1)
 .S:$L($P(PARAM,D,2)) U4=$P(PARAM,D,2)
 .S:$L($P(PARAM,D,7)) SELECT=$P(PARAM,D,7)
 D ^RPLPR3 G 22:$D(PR) S BPROG=$ZN G 21
 ;
 ;Selectie produkt
2 S SW5=0
21 S K=$$SELECT^PRODUKT6(,,,,$S(sScr("VTW"):"NODO;NOKP",1:"ALL"),,,,,1) 
 S FP=1900 Write @F,@F1
 I 'K G YZ:'$D(PR),23
 S PR=K G 23:PR=PRX
 S ^HULP($J,"P"_PR,"F")=""
 K Sch5Aank
22 S PIF=0,U1=100
 D FETCHB
 I $D(U4),"1234567"'[U4 G 23
 S U1=101 D S2 S U1=102 D S2
23 D VHUnRead^RPLPR5(PR) ; Ongelezen kennisankers voor klant Van Hoecke tonen
 D RET:PR'=PRX K PARAM G 3:'$D(U4),4:U4=SW2&(U4'=5)&(U4'=6) D  G 35:PR'=PRX,35:"M"[VTB,35:"\SAM\SAMS\PAL\"[(D_U4_D)
 .S Input=$G(U4)
 .D EXEC^vhMenu("RPLPRSPEC",.Input)
 .I U4=Input D EXEC^vhMenu("RPLPR",.Input)
 .S U4=Input
 S DL(2)=19 D WL^PROC G 35
 ;
 ;Keuze scherm
3 S FP=2203+F60 W @F,$P($T(@("T3"_(+sScr("VTW")))),U,2),":",!?2 F R=1:1:SW4 W R,","
 W $P($T(@("T3"_(+sScr("VTW")))),U,3)
31 I SW2=1 D
 .S R=$$OMSCHR(SW2)
 E  I SW2=3 D
 .S R=$$BESTREF()
 E  I SW2=6 D
 .S R=$$OMSCHR(SW2)
 E  D
 .I '$D(IK) D CVL^PROC S IK(1)=R_"\[31~;SPEC"
 .D IK^PROC1
33 S PRX=PR
 S Input=R
 I R="COM" D
 .D MENU^RPLPR4
 E  I R="SPEC" D
 .D SPEC^RPLPR4
 E  D
 .D EXEC^vhMenu("RPLPRSPEC",.Input)
 .I R=Input D EXEC^vhMenu("RPLPR",.Input)
 .S R=Input
 G YZ:R="-",31:R="ENTER" I R=",",$D(EXTERN) G YZ
 I R="P"!(R="I") S U4=$S($L(VTB):VTB,1:SW2) G 2
 I R=")"!(R="(") S U4=$S($L(VTB):VTB,1:SW2) D  G YZ:$D(EXTERN),22:$L(R) S R="P" G 2
 .S Aktie=R I $D(EXTERN) S LScreen=U4 Q
 .D NEXT
 If sScr("VTW"),";1;2;3;4;T;,;"'[(";"_R_";") Goto 31
 S U4=R
35 
 I R="PRINT" D PRINT^RPLPR4
 I $E(U4)="P","\O\T\"[(D_$E(U4,2,9)_D) D DPRINT^RPLPR4($E(U4,2,9))
 I U4="MAIL" D MAIL^RPLPR4
 I U4="REFRESH" D  Goto 33
 .New Par
 .Merge Par=^HULP($J,"PAR") ; Parameters terugzetten
 .Kill ^HULP($J)
 .Merge ^HULP($J,"PAR")=Par
 .Set R=VTB,VTB="",U4=""
 I U4="WP" G 33:$G(NoMod) D WIJZIG("") G 1
 I U4="D" D DET^RPLPR1 G YZ:R="-" I R="P"!(R="I") S U4=$S($L(VTB):VTB,1:SW2) G 33
 I U4="B" G 31:'$$ASK^vhWACHTW("BLUM") G RPB
 I U4="C" G 33:'$$PW("C66"),33:$G(NoMod) D WIJZIG("") G 1
 I $E(U4)="W","\O\T\"[(D_$E(U4,2,9)_D) D MOD^RPLPR1(1)
 I U4="H" D STF^RPLPR1 G 33
 I U4="K" G RAK
 I U4="6" D KLA^RPLPR1,FetchPROms(PR,,.PROms) G 31
 I U4="X",SW2=5 S U4=5,(SW2,EXTRA)="X"
 I U4="5" G 31:'$$ASK^vhWACHTW("PRODUKT") D LEV^RPLPR1 G 31
 I U4="M" D MOM^RPLPR1 G 33
 I U4="O" D OOT^RPLPR1 G 33
 I U4="S" D TMS^RPLPR1 G 33
 I U4="V" D VKA^RPLPR1 G 33
 I U4="Y" G 31:'$$ASK^vhWACHTW("PRODUKT") D VAL^RPLPR1 G 33
 I U4="W" D WVK^RPLPR1 G 33
 I U4="T" K ^HULP($J,"P"_PR,"PT") S VTB="" D PTA^RPLPR1 G 33
 I U4="U" D UTZ^RPLPR1 G 33
 I U4="R" D PRF^RPLPR1 G 33
 I U4="SAM" D RAADPL^PRLINK(PR,1),FETCHB G 33
 I U4="SAMS" D RAADPL^PRLINKS(PR,1) G 33
 I U4="PAL" D RAADPL^EWPAL(PR,1) G 33
 I U4="KENM" D RAADPL^PRKENMERK(PR,1) G 33
 I U4="+" D VRV^RPLPR1 G 33
 I U4="?" Do MENU^RPLPR4
 ;I U4="?"!(U4="HELP") D HLP^RPLPR1 G 33 ; F10 -HELP afgesloten CW 11.12.09
 I U4="," G YZ:'$D(STACK) D NCOL(80) G BC^RPLSW
 ;I U4=7 S (U4,R)=5 w U4,",",SW4 r r
 I U4?1N,U4,U4'>SW4,U4'=SW2 G 37
 S R=$S($L(VTB):VTB,1:SW2) G 31:R?.N,33
37 D NCOL(80),SA^RPLPR1 S PIF=0,FP=601 W @F,@F1 I $L(VTB) D VPI S VTB=""
 I SW2'=U4!SW5 S SW2=U4,SW5=1 D S3,S1
 ;
 ;Hoofdschermen
4 D:SW2=1 FetchPROms(PR,,.PROms)
 D:SW2=3 DELBREF,GETBREF
 S U1=SW2*100+2
41 S U1=$N(A(U1)) G 31:U1=-1 D S2 G 41
 I U4=5 S U4=7
 ;
YZ 
 I $D(EXTERN),$D(U4) S LScreen=U4
 D NCOL(80) K A,B,^HULP($J) Q
 ;
S1 N GRef
 S GRef=$$GREF()
 S Y=$D(@("^"_GRef_"(0,0)")),Y=SW2+1*100,(X,K)=SW2*100,K=SW2>1*2+K
S1A S X=$N(^(X)) I X>0,X<Y S U2=^(X) D VBA S K=K+1,A(K)=U2 G S1A
S1Z Q
 ;
S3 S X=102
S3A S X=$N(A(X)) I X>0 K A(X) G S3A
S3Z Q
 ;
 ; Paswoord
PW(SN) 
 N IK
 S SN=$E(SN,2,99) I SN="" Q 1
 I SW2=U4 Q 1
 S IK(2)=1 D  I SN="" Q 1
 .F  D IK^PROC1 Q:R'=$E(SN)  S SN=$E(SN,2,99) Q:SN=""
 Q 0
 ;
WIJZIG(Element) 
 N Aktie
W1 S R=$$WIJZIG^PRODUKT(PR,$S(SW2=6:"K",SW2=5:"L",1:SW2),Element)
 S $P(R,D)=$S($P(R,D)="L":5,$P(R,D)="K":6,1:$P(R,D))
 S PARAM=PR_D_$S($L(VTB):VTB,1:$P(R,D))
 S Element=$P(R,D,2),Aktie=$P(R,D,3),Aktie=$S(Aktie="P":"(",Aktie="N":")",1:"")
 I Aktie="" K Sch5Aank Q
 D NEXT G W1:$L(R) K PARAM,PR,PRX,U4
 Q
 ;
NEXT 
 N PRT
 S FP=255 W @F,$J("",10),@FMTK,"*** Zoekend ***",@FMTk
 S PRT=$$NEXT^PRODUKT($S($P($G(sRef("SELPR")),D)="L":"L",1:"K"),PR,$S(Aktie="(":-1,1:1),sScr("VTW"))
 I $L(PRT) S PR=PRT
 S FP=255 W @F,@F2
 S SW5=0
 Kill Aktie,Sch5Aank
 Q
 ;
DELBREF 
 N I,R
 S I=300
 F  S I=$O(A(I)) Q:'I  S R=$P(A(I),U,16) I "\502\503\601\602\603\"[(D_R_D) K A(I)
 Q
 ;
GETBREF 
 N C,I
 S C=0 F I=501:1:503,601:1:603,504:1:510,604:1:610 S C=C+1,BestRef(C)=$P($G(B(I\100)),D,I#100)
 F C=C:-1 Q:C=6  I BestRef(C)="" K BestRef(C)
 Q
 ;
BESTREF()
 N R,BESTREF
 D INIT^vhLIST("RPLPR","BESTREF",.BESTREF),WRITE^vhLIST(.BESTREF)
 S R=$$SCROLL^vhLIST(.BESTREF)
 Q R
 ;
GREF() 
 New GRef
 Xecute "Set GRef="_$G(^KPR(0,"GREF"),"""KPR""")
 Quit GRef
 ;
FETCHB
 K B S B(1)=^KPR(PR,0) F X=1:1:15 I $D(^(X)) S B(X+1)=^(X)
 S B("I")="" I $E($N(^("I")),1)="I" S B("I")=^($N(^("I")))
 S B("J")="" I $E($N(^("J")),1)="J" S B("J")=^($N(^("J")))
 Q
 ;
 ; Ophalen van de omschrijvingen N, F, D en E
FetchPROms(PRNr,Taal,PROms)
 New I,Count,Kleur
 Kill PROms
 Set Taal=$G(Taal,"N\F\D\E"),Count=0
 For  Do  Quit:Taal=""
 . Set PROms=$$GETOMSCH^PRODUKT2(PRNr,$P(Taal,D))
 . Do:$L($TR(PROms,D,""))
 . . Set Kleur=$$OMSCHR^PRKLEUR(PRNr,$P(Taal,D))
 . . For I=1:1:$L(PROms,D) Do:$L($P(PROms,D,I))
 . . . Set Count=Count+1,PROms(Count)=$P("NED\FRA\DTS\ENG",D,$F("NFDE",$E(Taal))-1)_D_$P(PROms,D,I)
 . . . If I=1 Set PROms(Count)=PROms(Count)_$J("",26-$L($P(PROms(Count),D,2)))_" "_$J(Kleur,18)_"\1"
 . Set Taal=$P(Taal,D,2,99)
 Quit
 ;
 ; Tonen en scrollen in de omschrijving op de schermen 1 en 6
OMSCHR(Scherm)
 N I,O,R,OMSCHR,ScreenPos,Taal
 S Scherm=$G(Scherm,1)
 S Taal="",Taal("P")=1
 F I=1:1 D  Q:'$D(PROms(I))
 .S R=$G(PROms(I))
 .I '$P(R,D,3) S:'$D(PROms(I)) Taal=Taal_";"_(I-1) Q
 .S:I>1 Taal=Taal_";"_(I-1) S Taal=Taal_D_$P(R,D)_";"_I
 S $E(Taal)=""
 D INIT^vhLIST("RPLPR","OMSCHR",.OMSCHR)
 D:Scherm=6
 .S ScreenPos=OMSCHR("POS")
 .S $P(ScreenPos,";")=9,$P(ScreenPos,";",3)=20
 .S OMSCHR("POS")=ScreenPos,$P(OMSCHR("SET"),"`")=ScreenPos
OMSCHRWL
 D WRITE^vhLIST(.OMSCHR)
 S R=$$SCROLL^vhLIST(.OMSCHR,"X`S zb=$S(zb=""NP"":""NP"",zb=""PP"":""PP"",1:"""")")
 S O=OMSCHR("OFFSET")+1
 F I=1:1:$L(Taal,D) I O'<$P($P(Taal,D,I),";",2),O'>$P($P(Taal,D,I),";",3) S Taal("P")=I Q
 I R="NP" D  G OMSCHRWL
 .S Taal("P")=Taal("P")+1 S:Taal("P")>$L(Taal,D) Taal("P")=1
 .S R=$P(Taal,D,Taal("P"))
 .S OMSCHR("OFFSET")=$P(R,";",2)-1
 I R="PP" D  G OMSCHRWL
 .S Taal("P")=Taal("P")-1 S:Taal("P")<1 Taal("P")=$L(Taal,D)
 .S R=$P(Taal,D,Taal("P"))
 .S OMSCHR("OFFSET")=$P(R,";",2)-1
 Q R
 ;