PRLINKL ;AFDRUKKEN SAMENGESTELDE PRDUKTEN ;[ 05/27/2003  8:50 AM ]
 ;
 Set K=$P($T(+1),";",2)_QN_" ",FP=202
 Write @F,@F4,K,@F5
 Set DOC=$P($T(+1),";",2),LSTX="KLPB",SELK=0,%J=$$%J^vhRtn1(),PRLink="M"
 Kill ^HULP(%J)
 Do PP^KPSEL
 If K'="-" Do
 .Kill DOC,LSTX,SELK
 .Set (PCount,Count)=0,FP=2303
 .Write @F,@F1,!?2,"Produkten geselekteerd :"
 .Do @("MFETCH"_LST)
 .Do INIT^PROC("PRLINK"_PRLink,.LD)
 .Do ^OUTPUT("SPT")
 Kill ^HULP(%J)
 Quit
 ;
MFETCHP 
 Set Q0="^"_Q_"PR(PR,0)",Q1="^"_Q_"PR1(PRC)"
 Set:PRC'=0 PRC=$O(@Q1,-1)
 For  Set PRC=$O(@Q1) Quit:PRC=""!(PRC]PRCX)  Do
 .Set PR=$P(@Q1,D)
 .If PRLink="M",'$D(^PRLINK("D",PR)) Quit
 .If PRLink="K",'$D(^PRLINK("IKM",PR)) Quit
 .If PRLink="",'$D(^PRLINK("D",PR)),'$D(^PRLINK("IKM",PR)) Quit
 .Do ^KPCHKPR
 .Quit:'OK
 .Do PUTHULP(PR,PRLink)
 Quit
 ;
MFETCHK 
 Set Q0="^"_Q_"PR(PR,0)",Q1="^"_Q_"PH(HG)",Q2="^"_Q_"PH(HG,GRS)"
 Set Q3="^"_Q_"PH(HG,GRS,SGS)",Q4="^"_Q_"PH(HG,GRS,SGS,MK,PRCS)"
 Set:HG'=0 HG=$O(@Q1,-1)
 For  Set HG=$O(@Q1) Quit:HG=""!(HG]HGX)  Do
 .Set GRS=GR Set:GRS'=0 GRS=$O(@Q2,-1)
 .For  Set GRS=$O(@Q2) Quit:GRS=""!(GRS]GRX)  Do
 ..Set SGS=SG Set:SGS'=0 SGS=$O(@Q3,-1)
 ..For  Set SGS=$O(@Q3) Quit:SGS=""!(SGS]SGX)  Do
 ...Set PRCS=PRC Set:PRCS'=0 PRCS=$O(@Q4,-1)
 ...For  Set PRCS=$O(@Q4) Quit:PRCS=""!(PRCS]PRCX)  Do
 ....Set PR=$P(@Q4,D)
 ....If PRLink="M",'$D(^PRLINK("D",PR)) Quit
 ....If PRLink="K",'$D(^PRLINK("IKM",PR)) Quit
 ....If PRLink="",'$D(^PRLINK("D",PR)),'$D(^PRLINK("IKM",PR)) Quit
 ....Do ^KPCHKPR
 ....Quit:'OK
 ....Do PUTHULP(PR,PRLink)
 Quit
 ;
MFETCHL 
 Set Q0="^"_Q_"PR(PR,0)",Q1="^"_Q_"LE(LE)",Q2="^"_Q_"PL(LES)",Q3="^"_Q_"HULP($J,PRCS)"
 Set:LE'=0 LE=$O(@Q1,-1)
 For  Set LE=$O(@Q1) Quit:LE=""!(LE]LEX)  Do
 .Set LES=$P(LE," ",2)_" " Quit:'$D(@Q2)  Do S9
 .Set PRCS=PRC Set:PRCS'=0 PRCS=$O(@Q3,-1)
 .For  Set PRCS=$O(@Q3) Quit:PRCS=""!(PRCS]PRCX)  Do
 ..Set PR=$P(@Q3,D)
 ..If PRLink="M",'$D(^PRLINK("D",PR)) Quit
 ..If PRLink="K",'$D(^PRLINK("IKM",PR)) Quit
 ..If PRLink="",'$D(^PRLINK("D",PR)),'$D(^PRLINK("IKM",PR)) Quit
 ..Do ^KPCHKPR
 ..Quit:'OK
 ..Do PUTHULP(PR,PRLink)
 Quit
 ;
MFETCHB 
 Set Q0="^"_Q_"PR(PR,0)",Q1="^"_Q_"PSEL($J,PRC)"
 Set:PRC'=0 PRC=$O(@Q1,-1)
 For  Set PRC=$O(@Q1) Quit:PRC=""!(PRC]PRCX)  Do
 .Set PR=$P(@Q1,D)
 .If PRLink="M",'$D(^PRLINK("D",PR)) Quit
 .If PRLink="K",'$D(^PRLINK("IKM",PR)) Quit
 .If PRLink="",'$D(^PRLINK("D",PR)),'$D(^PRLINK("IKM",PR)) Quit
 .Do ^KPCHKPR
 .Quit:'OK
 .Do PUTHULP(PR,PRLink)
 Quit
 ;
MFETCHE(PRNr) 
 New %J,A,B,DL,LD,PRLINK,PRLINKM,PRLINKK,PRLink
 Set %J=$$%J^vhRtn1(),PRLink=$$CHKLINK^PRLINK(PRNr)
 Set (PCount,Count)=0
 Kill ^HULP(%J)
 Do PUTHULP(PRNr,PRLink)
 Do INIT^vhLISTO("PRLINK","PRLINK"_PRLink,.LD)
 Set DL(1)="LD"
 D ^OUTPUT("SP")
 Kill ^HULP(%J)
 Quit
 ;
PUTHULP(PRNr,PRLink) 
 New R,MPRNr,KPRNr,LinkType,Aantal,FCount,MCount,SortKey
 Set PCount=PCount+1
 If '(PCount#100) Set FP=2428 Write @F,PCount
 Set FCount=Count+1,(MCount,KCount)=0
 If "M"[PRLink Do
 .Set KPRNr=""
 .Kill ^HULP(%J,"S")
 .For  Set KPRNr=$O(^PRLINK("D",PRNr,KPRNr)) Quit:'KPRNr  Do
 ..Set SortKey=$$SORTKEY^PRODUKT(KPRNr),^HULP(%J,"S",SortKey)=KPRNr
 .Set SortKey=""
 .For  Set SortKey=$O(^HULP(%J,"S",SortKey)) Quit:SortKey=""  Do
 ..Set KPRNr=^HULP(%J,"S",SortKey),Aantal=$P(^PRLINK("D",PRNr,KPRNr),D)
 ..Set LinkType=$P(^KPR(KPRNr,0),D,23),LinkType=$S(LinkType="":"S",1:LinkType)
 ..Set MCount=MCount+1,Count=Count+1,R=$G(^HULP(%J,Count))
 ..Set $P(R,D,8)=$P(R,D,8),$P(R,D,5,7)=KPRNr_D_LinkType_D_Aantal
 ..Set ^HULP(%J,Count)=R
 If "K"[PRLink Do
 .Set MPRNr=""
 .Kill ^HULP(%J,"S")
 .For  Set MPRNr=$O(^PRLINK("IKM",PRNr,MPRNr)) Quit:'MPRNr  Do
 ..Set SortKey=$$SORTKEY^PRODUKT(MPRNr),^HULP(%J,"S",SortKey)=MPRNr
 .Set SortKey=""
 .For  Set SortKey=$O(^HULP(%J,"S",SortKey)) Quit:SortKey=""  Do
 ..Set MPRNr=^HULP(%J,"S",SortKey),Aantal=$P(^PRLINK("D",MPRNr,PRNr),D)
 ..Set KCount=KCount+1,Count=Count+1,R=$G(^HULP(%J,Count))
 ..Set $P(R,D,8)=$P(R,D,8),$P(R,D,3,4)=MPRNr_D_Aantal
 ..Set ^HULP(%J,Count)=R
 Set $P(^HULP(%J,FCount),D,1,2)=$S(KCount>MCount:KCount,1:MCount)_D_PRNr
 Kill ^HULP(%J,"S")
 Quit
 ;
CB(Ref) 
 New R
 Quit:'$D(Ref) ""  Quit:'$D(@Ref) ""
 Set R=@Ref
 Quit:'$P(R,D) ""
 If Print("BLZ"),Print("LIJN")+R+1>(Print("MAXLIJN")-Print("FOOT")+1) Quit "PB"
 Quit "BR\Ref"
 ;
S9 K @("^"_Q_"HULP($J)") S SL=LES,SM=0,S1="^"_Q_"PL(SL,SM)",S2="^"_Q_"PL(SL,SM,SR)",S3="^"_Q_"PL(SL,SM,SR,SP)"
S9A S SM=$N(@S1) G S9Z:SM=-1 S SR=0
S9B S SR=$N(@S2) G S9A:SR=-1 S SP=0
S9C S SP=$N(@S3) G S9B:SP=-1 S R=+^(SP),@("^"_Q_"HULP($J,SP)")=R G S9C
S9Z K SL,SM,SR,SP,S1,S2,S3,R Q
 ;