KP8 G 1 ;KONTROLELIJST PRODUKTEN ;OVERLAY NAAR KP9 [ 08/05/2002  11:42 AM ]
 ;
1 S X=$N(@("^"_Q_"BA(18,-1)")) F X=0:1:9 S:$D(^(X)) PBTW(X)=$P(^(X),D,1) S:$D(^(X+10)) PTXT(X)=$P(^(X+10),D,1)
10 S NM1=@("^"_Q_"BA(99,2)"),NM2=^(3),I1=0,BLZ=0,U=";",I1X=" ",I2X="",LN=0,MAX=0
BREAK B 1
 S SW=0
11 S FP=228+$L(QN) W @F61,@F11,@F1,@F,@F5 S FP=202 W @F,@F4,$P($T(+1),";",2),QN," ",@F5
20 S BLA="                              "
40 S Y=@("^"_Q_"PR(0,0)"),Y="A"
50 S Y=$N(^(Y)) G 505:Y=-1 S @Y=^(Y) G 50
505 S LN=403,LGT=0 F I="HG","GR","SG","MK" S T(I)="KEUZE "_$P(@I,D,2) S:$L($P(@I,D,2))>LGT LGT=$L($P(@I,D,2))
510 S (H,HH,G,GG,S,SS,M,MM,P)="",T="EINDE PROGRAMMA" G 520:$P(HG,D,2)="" S SEL=$P(HG,D,2),NIV="" D S2 S LN=403 G YZ:K="-",550:K=""
512 S H="" D S3 G 510:K="-" S H=R I K="" S H=K
514 S HH="" G 510:K="-"&($P(HG,D,2)="") S T="EINDE PROGRAMMA",SEL=$P(HG,D,2),NIV="" D S4 G 512:K="-" S HH=R S:K="" HH=K S:K="." HH=H G 550:HH="",514:H]HH,550:H'=HH
520 G 530:$P(GR,D,2)="" S T=T("HG"),SEL=$P(GR,D,2),NIV="H" D S2 G 514:K="-",550:K=""
522 S G="" D S3 G 520:K="-" S G=R I K="" S G=K
524 S GG="" G 514:K="-"&($P(GR,D,2)="") S T=T("HG"),SEL=$P(GR,D,2),NIV="H" D S4 G 522:K="-" S GG=R S:K="" GG=K S:K="." GG=G G 550:GG="",524:G]GG,550:G'=GG
530 G 540:$P(SG,D,2)="" S T=T("GR"),SEL=$P(SG,D,2),NIV="H,G" D S2 G 524:K="-",550:K=""
532 S S="" D S3 G 530:K="-" S S=R I K="" S S=K
534 S SS="" G 524:K="-"&($P(SG,D,2)="") S T=T("GR"),SEL=$P(SG,D,2),NIV="H,G" D S4 G 532:K="-" S SS=R S:K="" SS=K S:K="." SS=S G 550:SS="",534:S]SS,550:S'=SS
540 G 550:$P(MK,D,2)="" S T=T("SG"),SEL=$P(MK,D,2),NIV="H,G,S" D S2 G 534:K="-",550:K=""
542 S M="" D S3 G 540:K="-" S M=R I K="" S M=K
544 S MM="" G 534:K="-"&($P(MK,D,2)="") S T=T("SG"),SEL=$P(MK,D,2),NIV="H,G,S" D S4 G 542:K="-" S MM=R S:K="" MM=K S:K="." MM=M G 550:MM="",544:M]MM
550 D INIT^vhPRINTER(132)
60 I '$D(Print) S LN=LN-100 G 510:H=""&(HH=""),514:G=""&(GG=""),524:S=""&(SS=""),534:M=""&(MM=""),544
70 F I="DL","G",84:1:100 K @("F"_I)
80 K HG,GR,SG,MK,LE,LP,L D ^KP9 G 11
 ;
YZ Q
 ;
S2 S FP=LN+100 W @F,@F1 S R="K\19\3\[] = ALLE "_SEL_"EN\K1\1\\"""_$E(SEL,1,1)_"-""[K\" D R0 I K="-" S LN=LN-100 G S2Z
S2A S LN=LN+100
S2Z Q
 ;
S3 S FP=LN+100 W @F,@F1,"IN ALFABETISCHE ORDE VANAF ",SEL,$E(BLA,1,LGT-$L(SEL)+1),":",!?2,"[] = VANAF HET BEGIN" S R=L*100_D_SEL_D_NIV D S7 G S3:K="."
S3A I K="-" S LN=LN-100 G S3Z
S3B S LN=LN+100,FP=LN+30+LGT W @F,@F1 W:'$L(K)!(R=" ") "BEGIN" I $L(K)&(R'=" ") W R
S3Z Q
 ;
S4 S FP=LN+100 W @F,@F1,"IN ALFABETISCHE ORDE TOT ",SEL,$E(BLA,1,LGT-$L(SEL)+3),":",!?2,"[] = TOT HET EINDE   .[] = ZELFDE ",SEL S R=L*100_D_SEL_D_NIV D S7
S4A I K="-" S LN=LN-100 G S4Z
S4B S LN=LN+100,FP=LN+30+LGT W @F,@F1 W:'$L(K) "EINDE" W:K="." "ZELFDE ",SEL I $L(K)&(K'=".") W R
S4Z Q
 ;
K1 W !?1,"-[] = ",T,!?1,$E(SEL,1,1),"[] = BEPAALDE ",SEL,"EN"
K1Z Q
 ;
R0 S R7="K'[D&(K'?.E1C.E)" S:$P(R,D,8)'="" R7=R7_","_$P(R,D,8) S:$P(R,D,7)'="" R7=R7_","_$P($T(@$P(R,D,7))," ",2,99)
R0A S R2=$P(R,D,2),R3=$P(R,D,3),R4=$P(R,D,4),R5=$P(R,D,5),R6=$P(R,D,6)
R0B S R0=$L(R4)+R3+3 S FP=R2*100+R3+F60 W @F W:R3<4 @F1 W @F2,R4," : " I R5'="" W:R5["""" !,?2,@R5 D:R5'["""" @R5
R0C S FP=R2*100+R0+F60 W @F,@F2 W $E("........................................",1,R6),@F,@F0
R0D R K S:$P(R,D,7)="DCTR" RD=$P(K,".",1),RM=$P(K,".",2),RJ=$P(K,".",3) W @F2 I $L(K)'>R6,@R7 S @$P(R,D,1)=K G R0F
R0E G R0C
R0F S FP=$P(R,D,9)*100+($P(R,D,10)*1) I FP W @F,$E("                                        ",1,R6),@F,K
R0Z K R,R0,R2,R3,R4,R5,R6,R7,RD,RM,RJ Q
 ;
S7 S S4=$P(R,D,1)+1+F60,S0=0,SA=$P(R,D,2),S8="^"_Q_"PH("_$P(R,D,3) S:$L($P(R,D,3)) S8=S8_"," S S8=S8_"S2)",FP=S4 W @F,@F1
S7A S FP=2403+F60 W @F,@F1 W:$D(ST) "VOLGNUMMER OF " W SA,"  [] = ",$P("EINDE\VERVOLG",D,S0+1)," : ",@F0
S7B R K G S7A:K?.E1C.E,S7Z:K="-"!(K=".") S:$L(K) S0=0 S FP=S4,S9=0 W @F,@F1 I K="" K ST G S7Z:'S0 S S1=S4 G S7H
S7C G S7D:'$D(ST(K)) S S3=ST(K) G S7M
S7D S K=$$UPCASE^vhRtn1(K) K ST S S6=K S:K=" " S6=""
S7E S S5=$E(S6,1,28),S1=S4,(S2,S3)=S5,(S2,S3)=$N(@(S8)) G S7K:S2=-1 S S2=$N(^(S2))
S7F I $E(S2,1,$L(S6))'=S6&'S0&($E(S3,1,$L(S6))=S6) G S7M
S7G S S2=S5
S7H S S2=$N(@(S8)) G S7K:($E(S2,1,$L(S6))]S6)&'S0&(S1=S4) G S7L:S2=-1 I $E(S2,1,$L(S6))'=S6 S S0=0 G S7A
S7I S FP=S1,S9=S9+1,ST(S9)=S2 W @F,$C(13),?2,S9,". ",?6 W:S2=" " "ZONDER" W:S2'=" " S2
S7J S S1=S1+100 G S7H:S1<(2300+F60) S S0=1 G S7A
S7K S FP=2403+F60 W @F,@F2,@F4,SA," ONBEKEND ",@F5,@F0 H 2
S7L S (S2,S0)=0 G S7A
S7M S R=S3
S7Z K S0,S1,S2,S3,S4,S5,S6,S7,S8,S9,SA,ST Q
 ;