KKAA260 ;MAANDOMZET PER PEGIO PER ... (voorbereiden);KKAA26; Quit naar KKAA26 [ 10/10/97  2:59 PM ]
 G 1
 ;
S1 S $P(R,D,1)=$P(R,D,1)+$P(K,D,3),$P(R,D,2)=$P(R,D,2)+$P(K,D,6)
S1Z Q
 ;
S2 S:'$D(^(0)) ^(0)="" S R=^(0) D S1 S ^(0)=R
S2Z Q
 ;
1 K ^HULP($J) S FBP=DJ-1 S:DM>6 FBP=DJ S FBP=FBP_".07",FBP=0,LBP=DJ_"."_DM
11 S Q0="^"_Q_"KL(KL)",Q1="^"_Q_"KL(KL,0)",Q2="^"_Q_"STKL(KC)",Q3="^"_Q_"STKL(KC,PR)",Q4="^"_Q_"STKL(KC,PR,BP)",Q5="^"_Q_"PR(PR,0)"
13 S KL=0,KLX="ZZZZZ",FBP=FBP_" ",LBP=LBP_" "
 ;
2 S KL=$N(@Q0) G YZ:KL=-1 S K=^(KL,0),KC=$P(K,D,1),KRE=$P(K,D,20),FP=2403 W @F,@F1,$P(K,D,1),"   ",$P(K,D,2)
21 S K=^(1),KAK=$P(K,D,11)_" ",KTY=$$GetKlantType^KLANT5(KC)_" ",K=^KKL(^KK1(KC),2),KPK=$P(K,D,3)_" "
23 S:KRE="" KRE=0 S:KAK=" " KAK=1 S:KTY=" " KTY=1 S:KPK=" " KPK="L "
25 S KPKX=$P("0\1\2\3\4\5\6\7",D,$F("CPLRSBG",$E(KPK))-1),KRE(KRE)=KRE,KAK(KAK)=KAK,KPK(KPKX)=KPK,KTY(KTY)=KTY
 ;
3 S BP=$J(FBP-.01,0,2)_" ",PR=0
31 S BP=$N(@Q4) G 2:BP=-1!(BP]LBP) S K=^(BP)
33 S:'$D(^HULP($J,BP,KRE,0,0)) ^(0)="" S R=^(0) D S1 S ^(0)=R
35 S:'$D(^HULP($J,BP,KRE,"A",KAK)) ^(KAK)="" S R=^(KAK) D S1 S ^(KAK)=R D S2
37 S:'$D(^HULP($J,BP,KRE,"P",KPK)) ^(KPK)="" S R=^(KPK) D S1 S ^(KPK)=R D S2
38 S:'$D(^HULP($J,BP,KRE,"T",KTY)) ^(KTY)="" S R=^(KTY) D S1 S ^(KTY)=R D S2
39 G 31
 ;
YZ Q
 ;
Z X ^cZ Q
ZZ ; 28.01.90 - 15 u 58