TRANSUTD ;NEW PROGRAM [ 02/14/2001  1:57 PM ]
 ;
 Set Q="K" d ^cA604
 Write @F11,@F1,@FCH
 Set FP=2303 Write @F,"Selekteer ""Save chars"" van het ""File menu"" : .",!?2,"[] = ok"
 Read *K
 Set UtilSel=99998,UtilNext=0,IdentNr=""
 For MaxCount=0:1 Set IdentNr=$O(^PVTEMP(IdentNr)) Quit:IdentNr=""
 For  Set UtilNext=$O(^KLIH(UtilSel,UtilNext)) Quit:UtilNext=""  Do
 .Set KlantInd=^KLIH(UtilSel,UtilNext)
 .Set R=^KKL(KlantInd,0),KLNr=$P(R,D)
 .For I=1,2,4:1:9 Do
 ..Set K=$P(R,D,I)
 ..Set:I=8 K=$$LAND^vhRtn1(K,2,$P(R,D,9))
 ..Write K,$C(9)
 .Write $C(9),$C(9),$C(13)
 .Set Count=0,HoofdGr=""
 .For  Set HoofdGr=$O(^KKAAP(KLNr,HoofdGr)) Quit:HoofdGr=""  Do
 ..Set Groep=""
 ..For  Set Groep=$O(^KKAAP(KLNr,HoofdGr,Groep)) Quit:Groep=""  Do
 ...Set SubGroep=""
 ...For  Set SubGroep=$O(^KKAAP(KLNr,HoofdGr,Groep,SubGroep)) Quit:SubGroep=""  Do
 ....Set KortComp=""
 ....For  Set KortComp=$O(^KKAAP(KLNr,HoofdGr,Groep,SubGroep,KortComp)) Quit:KortComp=""  Do
 .....Set R=^KKAAP(KLNr,HoofdGr,Groep,SubGroep,KortComp),IdentNr=$P(R,D)
 .....If $D(^PVTEMP(IdentNr)) Do
 ......For I=1:1:8 Write $C(9)
 ......Write ^PVTEMP(IdentNr),$C(13) Set Count=Count+1
 .For Count=Count+1:1:MaxCount Do
 ..For I=1:1:10 Write $C(9)
 ..Write $C(13)
 Read *K Write @FCS