RPLLPR ;Lijst produkten ;[ 10/26/2001  2:12 PM ]
 Set Q="K" Do ^cA604
 W @FS80
 Kill ^HULP($J+100)
 Do TITEL,INIT
 Quit:'$D(LPR(2))
 Goto XXX
 Set DOC=$P($T(+1),";",2),LSTX="K"
 Set SELK=1 Do PP^KPSEL Quit:K="-"
 Set HG=$S(HG=0:"",1:$E(HG,1,$L(HG)-1)),HGX=$S(HGX="ZZZZZ":"",1:$E(HGX,1,$L(HGX)-1))
 Set GR=$S(GR=0:"",1:$E(GR,1,$L(GR)-1)),GRX=$S(GRX="ZZZZZ":"",1:$E(GRX,1,$L(GRX)-1))
 Set SG=$S(SG=0:"",1:$E(SG,1,$L(SG)-1)),SGX=$S(SGX="ZZZZZ":"",1:$E(SGX,1,$L(SGX)-1))
 Set NrLijn=1,FP=401 Write @F,@F1
 Do BUILDK(+LPR(2),HG,HGX,GR,GRX,SG,SGX)
XXX Do BUILDK(+LPR(2),"01CH","01CH","01CH02MID","01CH02MID")
 W *27,"[?5i"
 Do LOOP
 W *27,"[?4i"
 Kill ^HULP($J+100)
 W @FS80
 Quit
 ;Opbouw hulpbestand volgens Klassificatie
BUILDK(FixNr,HGB,HGE,GRB,GRE,SGB,SGE) 
 Set HGB=$G(HGB)_" "
 Set HGE=$S($G(HGE)'="":HGE,1:"ZZZZZ")_" "
 Set GRB=$G(GRB)_" "
 Set GRE=$S($G(GRE)'="":GRE,1:"ZZZZZ")_" "
 Set SGB=$G(SGB)_" "
 Set SGE=$S($G(SGE)'="":SGE,1:"ZZZZZ")_" "
 Set HG=HGB
 Set:HG'=" " HG=$O(^KPH(HG),-1)
 Set Cnt=0
 For  Set HG=$O(^KPH(HG)) Quit:HG=""!(HG]HGE)  Do 
 .Set GR=" " Set:HG=HGB GR=GRB
 .Set:GR'=" " GR=$O(^KPH(HG,GR),-1)
 .For  Set GR=$O(^KPH(HG,GR)) Quit:GR=""!(GR]$S(HG=HGE:GRE,1:"ZZZ"))  Do 
 ..Set SG=" " Set:GR=GRB SG=SGB
 ..Set:SG'=" " SG=$O(^KPH(HG,GR,SG),-1)
 ..For  Set SG=$O(^KPH(HG,GR,SG)) Quit:SG=""!(SG]$S(GR=GRE:SGE,1:"ZZZ"))  Do 
 ...Set PKT=""
 ...For  Set PKT=$O(^KPH(HG,GR,SG,"  ",PKT)) Quit:PKT=""  Do
 ....Set PC=^(PKT)
 ....For I=1:1:FixNr Set Cnt=Cnt+1,^HULP($J+100,"PL",Cnt)=PC_D_I
 Set LPR(9)=Cnt
 Quit
INIT 
 Kill LPR
 Set LPR(1)="^HULP($J+100,""PL"")"    
 Do LIJSTD
 Quit:'$D(LPR(2))
 s LPR(3)=2+LPR("T")
 s LPR(6)=1
 s LPR(8)=LPR("T",LPR("T")),LPR("T")=LPR("T")-1
 s LPR(10)="CALLB^RPLLPR"
 s DL(1)="LPR"
 Quit
 
LOOP Do REFRESH
 Set R=""
 For  Quit:R="-"  Do
 .Do SL^proc
 .If R="-" Quit
 .If R="R" Do REPEAT,REFRESH
 .If R="P" Do RAADPL,REFRESH
 .If R="W" Do WIJZIG,REFRESH
 Quit
REPEAT Quit:'$D(RepScherm)
 Set PR=$P(^HULP($J+100,"PL",LPR(6)),D)
 Write:$G(LPR(5))=132 @FS80
 Set:RepScherm="W" Repeat=$$WIJZIG^PRODUKT(PR,$P(Repeat,D),$P(Repeat,D,2))
 Set:RepScherm="P" Repeat=$$RAADPL^PRODUKT(PR,$P(Repeat,D))
 Goto AKTIE
RAADPL Set PR=$P(^HULP($J+100,"PL",LPR(6)),D)
 Write:$G(LPR(5))=132 @FS80
 Set Repeat=$$RAADPL^PRODUKT(PR)
 Set RepScherm="P"
 Goto AKTIE
WIJZIG Set PR=$P(^HULP($J+100,"PL",LPR(6)),D)
 Write:$G(LPR(5))=132 @FS80
 Set Repeat=$$WIJZIG^PRODUKT(PR)
 Set RepScherm="W"
 Goto AKTIE
AKTIE Set Aktie=$P(Repeat,D,3)
 Quit:"P"'=Aktie&("N"'=Aktie)
 Set:Aktie="P" Point=LPR(6)-LPR(2)
 
 Set:Aktie="N" Point=LPR(6)+LPR(2)
 Quit:'$D(^HULP($J+100,"PL",Point))
 Set LPR(6)=Point
 Goto REPEAT
CALLB(Nr,Ref) 
 S PR=$P(Ref,D)
 S LT=$P(Ref,D,2)
 Set G=LPR("G",LT)
 S:G[";0;" FL(3,0)=^KPR(PR,0)
 S:G[";1;" FL(3,1)=^KPR(PR,1)
 S:G[";2;" FL(3,2)=^KPR(PR,2)
 S:G[";3;" FL(3,3)=^KPR(PR,3)
 S:G[";4;" FL(3,4)=^KPR(PR,5)
 S:G[";5;" FL(3,5)=^KPR(PR,4)
 S:G[";J;" FL(3,"J")=^KPR(PR,$O(^KPR(PR,"J")))
 s:G[";I;" FL(3,"I")=^KPR(PR,$O(^KPR(PR,"I")))
 If LPR("L",LT)="RPLLPR7STK" Set TWV=20,TKL=4,TAKL=1,%WK=$$EXTDATE^vhLib.DataTypes(,"W") Do CALC^KPSBI2B
 Quit LT
TITEL 
 Set K=$P($T(+1),";",2)_QN_" ",FP=103+$L(K) Write @F11,@F1,@F,@F5
 Set FP=102 Write @F,@F4,K,@F5
 Quit
REFRESH I $G(LPR(5))=132 W @FS132
 Do TITEL
 K LPR(7)
 W @FMTI
 F I=1:1:LPR("T") S FP=1+I*100+1 W @F,LPR("T",I)_$J("",80-$L(LPR("T",I)))
 W @FMTi
 Do WL^proc
 Quit
 ;Input welke lijstdefinitie de gebruiker wenst
LIJSTD New Y,X,J,L,R,T,Gap,Lengte,LD
 Set Y(0)=0,LD="RPLL" 
 For  Set LD=$O(^LD("D",LD)) Quit:$E(LD,1,4)'="RPLL"  Set Y(0)=Y(0)+1,Y(Y(0))=$P(^LD("D",LD),"\")_D_LD
 Set Y="14\MVC\Selecteer lijstdefinities"
 Do ^POP
 Quit:X=""
 Set Gap=0,Lengte=0
 For I=1:1:$L(X,";") Do 
 .Set Y=$P(X,";",I) 
 .Set LPR("L",I-Gap)=$P(Y(Y),D,2)
 .Set LPR(2,I-Gap)=^LD("L",$P(Y(Y),D,2))
 .Set LPR("T",I-Gap)=$G(^LD("L",$P(Y(Y),D,2),"H"))
 .If LPR("L",I-Gap)["EMPTY" Do
 ..Do LIJND("PR",$P(Y(Y),D,1))
 ..If R="" Set Gap=Gap+1 Quit
 ..Set LPR(2,I-Gap)=LPR(2,I-Gap)_$S($L(LPR(2,I-Gap))&($E(LPR(2,I-Gap),$L(LPR(2,I-Gap)))'=D):D,1:"")_R
 ..Set LPR("T",I-Gap)=LPR("T",I-Gap)_T
 .Set L=0,G=";" For J=1:1 S R=$P(LPR(2,I-Gap),D,J) Quit:R=""  Set L=L+$P(R,";",4)+$L($P(R,";",6)) I $P(R,";",1)?1.E1"."1.N,G'[(";"_$P($P(R,";"),".")_";") S G=G_$P($P(R,";"),".")_";"
 .Set:L>Lengte Lengte=L
 .Set LPR("G",I-Gap)=G
 Quit:'($L(X,";")-Gap)
 Set LPR(2)=$L(X,";")-Gap_"F"
 Set:Lengte>80 LPR(5)=132
 Set LPR("T")=+LPR(2)-$S(LPR("L",+LPR(2))["BLANKO":1,1:0)
 Quit
LIJND(K1,Txt) New Y,X,I,Cnt,K2
 Set Y(0)=0,R="",T=""
 Set K2=0,Cnt=0
 For  Set K2=$O(^List(K1,K2)) Quit:K2=""  Set Y(0)=Y(0)+1,Y(Y(0))=$P(^List(K1,K2),";",1)_"\"_K2
 Set Y="8\MV\Selecteer velden"_$S($L($G(Txt)):" : "_Txt,1:"")_D_"LIJNC^RPLLPR"
 S FP=201 W @F,@F1
 Do ^POP
 Quit:X=""
 Do LIJNF 
 
LIJNF New Z,I
 Set (R,T)="",L=0
 Quit:X=""
 For I=1:1:$L(X,";") Do
 .Set Z=$P(Y($P(X,";",I)),D,2)
 .Set Z=^List(K1,Z)
 .Set:I=$L(X,";") $P(Z,";",8)=""
 .Set R=R_$S($L(R):D,1:"")_$P(Z,";",3,10)
 .Set L=L+$P(Z,";",6)+$L($P(Z,";",8))
 .Set T=T_$S($L(T):D,1:"")_""""_$S($P(Z,";",2)="*":$P(Z,";",1),1:$P(Z,";",2))_""";C;C;"_($P(Z,";",6)+$S($L(T):2,1:1))_";;"_$TR($P(Z,";",8)," ","")
 Set Z=R,FL(1)=T,FL(2)="" Do FL^proc S T=R,R=Z
 Quit
LIJNC New R,T,L
 Do LIJNF 
 If L>132 Write *7 Set X="" Quit
 Set FP=301 Write @F,"Lijnlengte : ",L,@F2
 Set FP=401 Write @F,"Kolomdefinitie :"
 Set FP=601 Write @F,@F2
 Set FP=501 Write @F,T,"<",@F2
 Quit