cA334 ;Algemeen printprogramma ;%A334 ; [ 08/31/01 12:34 PM ] G 1 ; T0 ;Algemeen printprogramma ; T1 ;Blz :;Druk Ctrl-C om te stoppen ---vervolg---;Einde; [] = ok ; ; T0F ;Programme d'impression universel ; T1F ;Page:;Tapez Ctrl-C pour interrompre ---suite---;Fin; [] = ok ; ; T0E ;General print program ; T1E ;Page:;Press Ctrl-C to interrupt ---next---;End; [] = ok ; ; T0D ;Algemeen printprogramma ; T1D ;Pag :;Druck Ctrl-C für Unterbrechung ---nächste---;Ende; [] = ok ; ; CR() W $C(13) S $X=0 Q "" ; carriage return FF() W $C(12,13) S ($X,$Y)=0 Q "" ; form feed ; R3 S R1=$P(R,D,2),R2=$P(R,D,4),R0=$J($P(R,D),0,R2),R3=$S($P(R,D,5):"",1:" "),R4="" S:R2 R4=","_$P(R0,".",2),R1=R1-1-R2 S:R0<0 R3="-",R0=-R0 R3A S R0=+$P(R0,".") F R5=3,7 S R6=$L(R0) Q: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 ;V3 05.07.88 ; SUB S R=K_D_(RR3-RR2-$P(RR1,D,4)-1+($P(RR1,D,5)=2)-$S('($P(RR1,D)#1)&$P(RR1,D,9):$P(RR1,D,6)+1,1:0))_D_D_$S('$P(RR1,D,9)!($P(RR1,D)#1):$P(RR1,D,6),1:"")_D_$S($P(RR1,D,5)=2:1,1:"") SUBZ Q ; TXT S RR2=$S(RR>1:$P(TAB,D,RR-1),1:0)+1,RR3=$P(TAB,D,RR) I 'LN(0)!$P(RR1,D,5)!$P(RR1,D,8) S $P(RR1,D,10)=0 TXTA S K=$P(RR1,D) I $P(RR1,D,5) D SUB,R3 G TXTD TXTB W ?RR2+V,$J("",$P(RR1,D,3)) I $L($P(RR1,D,7)) X "S K="_$P(RR1,D,7) TXTC I LN(0),$P(RR1,D,10),K=TZT(RR),RR<$L(TAB,D) S K="" G TXTE TXTD S LN(0)=0,TZT(RR)=K I $P(RR1,D,5) G TXTG TXTE S:K=""&'LN(0)&$P(RR1,D,10) K=">NULL<" S K=$E(K,1,RR3-RR2-$P(RR1,D,3)-$P(RR1,D,4)) TXTF W:'$P(RR1,D,2) K W:$P(RR1,D,2)=1 $J(K,RR3-RR2-$P(RR1,D,4)) W:$P(RR1,D,2)=2 $J("",RR3-RR2-$P(RR1,D,3)-$L(K)\2),K TXTG W ?RR3+V,@SEP TXTZ K R,RR1,RR2,RR3 Q ; TOT S RRT=$P(TXT(RR),D,8) F R=1:1:$L(TAB,D) S AFS(RRT,R)=$G(AFS(RRT,R)) TOTA S AFS(RRT,RR)=AFS(RRT,RR)+TXT(RR)_D_$P(TXT(RR),D,2,7) TOTZ K R,RRT Q ; 1 S PTS=$G(PTS),SUBDEL=$G(SUBDEL,U) I PTS=1 D . I '$D(PTS(1)) S:F71'[" S F70=" F71=F71_" S F70="""_F70_"""" S F70="D ^cA611" S PTS(1)="" X F70 I $G(QW) D B^cA612 W /WWR(1) . S V=0 10 G ^cA334F:"\F\3\4\"[(D_PTS_D) S BLZ=$G(BLZ),LNMAX=$G(LNMAX,50),V=$G(V) I '$D(F80) X F70 W @F80 11 S:'BLZ!'$G(LN) LN=0 S:'$D(SEP) SEP=F30 S:'($D(END)#10) END=0 I 'BLZ,'LN D DEF S END(0)=0,AFS=0 12 I PTS S R=TAB,TAB="" F S K=$P(R,D),R=$P(R,D,2,999) Q:'K S:K<79 TAB=TAB_K_D I 'R S TAB=TAB_79 13 F R=1:1:$L(TAB,D) S TXT(R)=$G(TXT(R)),TZT(R)=$G(TZT(R)) 14 S R=$O(TXT($L(TAB,D))) I R'="" K TXT(R),TZT(R) G 14 15 I $G(AFS)<9 S AFS=$G(AFS)+1 I AFS>8 F S R=$O(AFS(R)) Q:R="" S LNMAX=LNMAX-1 16 S LN(0)=$G(LN(0)) ; 2 I END=1 D AFS,END G YZ 20 I END=2 D AFS S END=0 G YZ 21 I END=3 D SEP S END=0 G YZ 22 I END=4 D AFS S (END,LN)=0 G YZ 23 I END=5 D:LN TOP D:'LN HD,TIT S END=0 G YZ 24 I END=6 D END G YZ 25 I END=7 D DEF S END=0 G YZ 26 I END=8 D:LN TOP D:'LN HD D TIT S END=0 G YZ 27 I END>100 D SEP:LN+1LNMAX D AFS G 3 33 W !?V,@SEP S END(0)=0,RR="" 35 S RR=$O(TXT(RR)) I RR'="" S RR1=TXT(RR) D TXT,TOT:$P(TXT(RR),D,8) G 35 37 S LN(0)=1 ; YZ K RR Q ; S1 S RS1=$P(R4,SUBDEL,2),RS2=$P(R4,SUBDEL,3),R4=$P(R4,SUBDEL) I 'RS2 S R4=$E(R4,1,R3-R2) S1A W ?R2+V W:'RS1 R4 W:RS1=1 $J(R4,R3-R2) W:RS1=2 $J("",R3-R2-$L(R4)\2),R4 S1B W ?R3+V W:'RS2 @SEP S1Z K RS1,RS2 Q ; SEP W !?V,@SEP F R1=1:1:$L(TAB,D) S R2=$S(R1>1:$P(TAB,D,R1-1),1:0)+1,R3=$P(TAB,D,R1)-1 F R4=R2:1:R3 W $C($S(END>100:END-100,1:45)) I R4=R3 W @SEP SEPZ S END(0)=$S(END=132:0,1:1),LN(0)=0 S:END<100&END LN=LN+1 K R1,R2,R3,R4 Q ; HD W:BLZ&'PTS $$FF D ISO ; VJ 31.08.01 I $L($G(^DPAR(0,"X","PRINT","ISO"))) X ^("ISO") I $L($G(^DPAR(0,"X","PRINT","QU"))) X ^("QU") S BLZ=BLZ+1,R=$O(HD(""),-1)-3,LN=$S(R<0:0,1:R),R="" I PTS W /CUP(1,1),/WCMD S ($X,$Y)=0 HDA I 'PTS,$G(HD(1))="S",$D(HD(2)) S R=HD(2),LN=$S('$G(FAX)&$P(R,D,14):7,1:10) D ^cA317 W @@DEF G HDZ HDB S R=$O(HD(R)) G HDZ:R="" W $$CR I R>1!$G(FAX) W ! HDC S R1=$P(HD(R),D) S:R<4&'$L(R1) R1=@("^"_Q_"BA(99,R)") W ?V,R1 HDD S R1=$P(HD(R),D,2),R2=$P(R1,SUBDEL,2),R3=$P(R1,SUBDEL,3),R4=$P(R1,SUBDEL,4),R1=$P(R1,SUBDEL) HDE S:$G(FAX) (R3,R4)="" I R2="C" S R2=$L(R1) S:R3="F82"&'PTS R2=R2*2 S R2=$P(TAB,D,$L(TAB,D))-R2\2 HDF S:R2<30 R2=30 S:$L(R3) R3=@R3 S:'R4!PTS R4=1 HDG W ?R2+V W:$L(R3) @R3 W R1,@F83,@@DEF W:'PTS&'$G(FAX)&'$G(PTS(2)) $$CR S R4=R4-1 I R4>0 G HDG HDH S R1=$P(HD(R),D,3) I R1="" S R1=$S(R=1:$P($T(@("T1"_QT)),U,2),R=2:DT,R=3:TD,1:"") HDI S:R=1 R1=R1_$J(BLZ,3) I PTS S FP=R*100+81-$L(R1),$X=FP#100-1 W /CUP(FP\100,$X+1) HDJ W ?$P(TAB,D,$L(TAB,D))-$L(R1)+1+V,R1 G HDB HDZ K R,R1,R2,R3,R4 D TOP Q ; ; ISO toevoegen aan hoofding ISO S R="" I $G(ISO)="" G ISOZ ISOA S R=$O(HD(R),-1) I R G ISOZ:$P(HD(R),D,3)=ISO,ISOA ISOB S:R<4 R=4 I $L($P($G(HD(R)),D,3)) S R=R+1 G ISOB S $P(HD(R),D,3)=ISO ISOZ Q ; ; initialen toevoegen aan hoofding QU S R="" I $G(QU)="" G QUZ QUA S R=$O(HD(R),-1) I R G QUZ:$P(HD(R),D,3)=QU,QUA QUB S:R<4 R=4 I $L($P($G(HD(R)),D,3)) S R=R+1 G QUB S $P(HD(R),D,3)=QU QUZ Q ; TIT D SEP S R="" TITA S R=$O(TIT(R)) G TITY:R="" W !?V,@SEP S LN=LN+1 TITB F R1=1:1:$L(TAB,D) S R2=$S(R1>1:$P(TAB,D,R1-1),1:0)+1,R3=$P(TAB,D,R1),R4=$P(TIT(R),D,R1) D S1 TITC G TITA TITY I $O(TIT(R))'="" D SEP TITZ S LN(0)=0 K R,R1,R2,R3,R4 Q ; TOP W ! S R="" I LN S LN=LN+1 TOPA S R=$O(TOP(R)) G TOPZ:R="" W ! S R0="",LN=LN+1 TOPB S R0=$O(TOP(R,R0),'PTS*2-1) G TOPA:R0="" S R1=TOP(R,R0),R2=$P(R1,SUBDEL,2),R3=$P(R1,SUBDEL,3),R4=$P(R1,SUBDEL,4),R1=$P(R1,SUBDEL) TOPC S:$G(FAX) (R3,R4)="" I R2="C" S R2=$L(R1) S:R3="F82"&'PTS R2=R2*2 S R2=$P(TAB,D,$L(TAB,D))-R2\2 TOPD S:$L(R3) R3=@R3 S:'R4!PTS R4=1 TOPE I R2+V+$L(R1)<$P(TAB,D,$L(TAB,D))!'PTS W:$G(QW)&PTS /CUP($Y+1,$X+1) W ?R2+V W:$L(R3) @R3 W R1,@F83,@@DEF W:'$G(FAX) $$CR S R4=R4-1 G TOPE:R4>0 TOPF G TOPB TOPZ S LN(0)=0 K R,R0,R1,R2,R3,R4 Q ; AFS I 'LN D HD,TIT AFSA D SEP:'END(0) S RRA="" AFSB S RRA=$O(AFS(RRA)) G AFSX:RRA="" W !?V,@SEP S LN=LN+1,RR="" AFSC F RR=1:1:$L(TAB,D) S AFS(RRA,RR)=$G(AFS(RRA,RR)) AFSD S RR=$O(AFS(RRA,$L(TAB,D))) I RR'="" K AFS(RRA,RR) G AFSD AFSE S RR=$O(AFS(RRA,RR)) I RR'="" S RR1=AFS(RRA,RR) D TXT G AFSE AFSF G AFSB AFSX I $O(AFS(RRA))'="" D SEP AFSY I PTS W /CUP(24,2),@F4,$P($T(@("T1"_QT)),U,$S(END=1!(END=6):4,1:3)),$P($T(@("T1"_QT)),U,5),@F5,@F0 D ^cAFA0("",0,0,0,0,27,0,0,0) S LN=0 AFSZ S:LN'