KTDTL G 1 ;AFDRUKKEN TOELEVERINGEN ;Do naar KTDTLB - Quit naar KTO32 [ 11/29/2003   1:16 PM ]
 ;
R3 S R1=$P(R,D,2),R2=$P(R,D,4),R0=$J($P(R,D,1),0,R2),R3=" ",R4="" S:R2 R4=","_$P(R0,".",2),R1=R1-1-R2 S:R0<0 R3="-",R0=-R0
R3A S R0=+$P(R0,".",1) F R5=3,7 S R6=$L(R0) G R3B:R6'>R5 S R0=$E(R0,1,R6-R5)_"."_$E(R0,R6-R5+1,R6)
R3B W ?$P(R,D,3),$J(R0,R1),R4,R3
R3Z K R0,R1,R2,R3,R4,R5,R6 Q  ;V1 26.11.84
 ;
S0 F I=UVN-TLN:1:39 W !?V,$P($T(T2),U,2)
S0Z Q
 ;
S1 S UVN=UVN+TLN I UVN>40 D S0,HDD0^KTDTLB G S1
S1A S TLN=0 W !?V,$P($T(T2),U,2),$C(13),?(2+V),$J($E(PNR,1,11),11) I PSN F R=1,2 W $C(13),?(2+V),$J($E(PNR,1,11),11)
 W ?(16+V),PC,?(18+V+VUO),UO G S1Z:'PR
S1B S R=UA_"\8\"_(65+V)_"\0" D:+R R3 S R=UEP_"\13\"_(74+V)_"\2" D:+R R3 S R=+UK_"\5\"_(82+V)_"\2" S:$P(UK,"#",2) R=+UK_"\5\"_(76+V)_"\2" D:+R R3
S1C S R=$P(UK,"#",2)_"\5\"_(82+V)_"\2" D:+R R3 I +UK W "%"
S1G S R=UN_"\13\"_(90+V)_"\2" D:+R R3 W:$L(ULT) ?(106+V),ULT I UEP!(UN) W $C(13) W:UEP ?(88+V),USP W:UN ?(89+V),U26
S1Z Q
 ;
S2 S (UK,UO,PLF)="",X=@("^"_Q_"PR(PR,0)"),PC=$P(X,D,1),X=^(1),PSN=$P(X,D,20),X=^(2),PNR=$P(X,D,25) S X=$N(^("J")) S:$E(X,2,99)'=5005 X=^(X),PLF=" "_$P(X,D,3)
S2A S USP=$P("%\/M",D,$F("HM",$P(U2,D,21))-1)
S2C S UN=$P(U2,D,9),UEP=$P(U2,D,6),U26=$P(U2,D,26),ULT=$P(U2,D,25) D S1
S2D S (UA,UEP,UN,ULT,PC,PNR)="",UK=$P(U2,D,7)
S2E S PXN=1,X=$P(@("^"_Q_"PR(PR,4)"),D,1,3)_D,X1=$P(^(5),D,1,3)
S2F S UO=PLF S:UO=" " UO="" I UO=""&$L($P(X,D,1)) S VUO=0,UO=" "_$P(X,D,1),PXN=2 S:'$L($P(X,D,2)) UO=UO_" "
S2G I $L(UO)!(UEP)!(+UK) D S1
S2H S (U2,UO,UEP,UK)="",VUO=0
S2I F Y=PXN:1:6 Q:'$L($P((X_X1),D,Y))  S:Y=1 UO=" " S:Y>1 UO=" " S UO=UO_$P((X_X1),D,Y) S:'$L($P((X_X1),D,Y+1)) UO=UO_" " D S1
S2J S (UO,UEP,UK)="",VUO=6 I $N(@("^"_Q_UGL_"(LC,TR,UZ)"))'=-1&(UVN<41) D S1
S2Z Q
 ;
S3 S TLN=1,PLF="",X=$N(@("^"_Q_"PR(PR,""J"")")) S:$E(X,2,99)'=5005 X=^(X),PLF=" "_$P(X,D,3) S UK=$P(U2,D,7),PXN=1,X=$P(^(4),D,1,3)_D,X1=$P(^(5),D,1,3)
S3B S UO=PLF S:UO=" " UO="" I UO=""&$L($P(X,D,1)) S UO=" "_$P(X,D,1),PXN=2 S:'$L($P(X,D,2)) UO=UO_" "
S3C I $L(UO)!(+UK) S TLN=TLN+1
S3D F Y=PXN:1:6 Q:'$L($P((X_X1),D,Y))  S TLN=TLN+1
S3E I $N(@("^"_Q_UGL_"(LC,TR,UZ)"))'=-1&(UVN<41) S TLN=TLN+1
S3Z Q
 ;
1 S R=51 D ^KFOLE
BREACK1 B 1
 S V=2,HDT=1,VUO=6
2 S TR=$N(@Q20) G BREACK0:TR=-1!(TR>LTR),2:'$D(@Q20),5:Q20["UGL"
3 S U2=^(TR) G 2:$L($P(U2,D,2)) S LC=$P(U2,D,1)
5 S U2=@("^"_Q_"LE(@(""^""_Q_""L1(LC)""),2)"),LLT=$P(U2,D,2),U2=^(3),LLV=$P(U2,D,3),U2=^(0),LX=$P(U2,D,18),LLL=$P(U2,D,17),LBN=$P(U2,D,16) S:LLT LLT=LLT_"D"
6 F I=2:1:9 S @$P("LN\LN2\LA\LS\LP\LW\LL\LT",D,(I-1))=$P(U2,D,I)
7 S TL=$F("NFDE",LT)-1,U2=@("^"_Q_UGL_"(LC,TR,1)"),UI=$P(U2,D,2),UVM=$P(U2,D,18),UVN=0,UZ=100
70 I 'SW37,TL'=HDT D ^KBA99
8 D HD^KTDTLB S UVN=UVN+9
9 S UZ=$N(@("^"_Q_UGL_"(LC,TR,UZ)")) G 11:UZ'=-1 S @("^"_Q_"HBDTO($J,TR)")="" I LC=5005,$D(^BLBeri("Z",TR)) S BLBeri=1
10 D ^KTDTLA W # G 2
11 S U2=^(UZ),PR=$P(U2,D,2),UA=$P(U2,D,3) I '$L(PR) S UO=$P(U2,D,5),(PNR,PC,PSN)="",TLN=1 D S1 G 9
13 S PUA=UA D S3,S2
14 G 9
BREACK0 B 0
21 S R=$P(^cLOG(boot,"DEV",$$DEV^vhPRINTER($I,1)),D,11) S:'R R=66 D ^KFOLE
 ;
YZ K PR,LL,LP,LS,LT,LW,LN,LN2,PEH,PI1,PI2,PMA,PPL,PUA,REF,TL,U2,UA,UI,XN Q
 ;
T2 ;:             :                                                 :         :              :              :       :
 ;
Z X ^cZ Q
ZZ ; 23.05.91 - 11 u 07