cAN2121 ;Scrolling ;%AN212 ; [ 02/25/00  10:15 AM ]
 G 1
 ;
T0 ;Scrolling ;
 ;
T0F ;'Scrolling' ;
 ;
T0E ;Scrolling ;
 ;
 ; volgende (1) of vorige (-1) index
S1(UI1,S2)         I $P(USCR,D,3) S S2=$S(S2<0:1,1:-1)
S1A K J S J=$O(@RSD,S2)
S1Z Q
 ;
 ; tonen van de lijn
S2 N K,S1,S2,UI1,VAN,LEN,TOT,MAX,ZZ S $ZT="TRAP^cAN000"
S2A S MAX=$P(QW(QW),D,4)-($P(QW(QW),D,5)*2),ZZ=$J("",MAX)
S2B S S1=0 F  S S1=$O(RSM(S1)) Q:S1=""  S S2=RSM(S1,1) D
 . N U3 S UI1=RSL(I)
 . I UDD<5 S K=$P($G(@UREF@($P(S2,D)\100-1)),D,$P(S2,D)#100)
 . I UDD=5 S K=$P($G(@UREF),D,$P(S2,D)#100)
 . S VAN=$P(S2,D,2),LEN=$P(S2,D,3),TOT=VAN+LEN-1
 . I $L($P(S2,D,5)) X $P(S2,D,5)    ; wat ipv K
 . S U3=$G(U3,K)     ; dit heeft te maken met totalen op listing
 . I $P(S2,D,4) S U3=$J(U3,LEN)     ; rechts
 . E  S U3=$E(U3_$J("",LEN),1,LEN)  ; links
 . S ZZ=$S(VAN>1:$E(ZZ,1,VAN-1),1:"")_U3_$S(TOT<MAX:$E(ZZ,TOT+1,MAX),1:"")
S2X W /CUP(I+USCR-1,1),/WWR(1),ZZ S RSL(I,9)=ZZ
S2Y F S2=1:1:$L(RSM(0,0),D) S S1=$P(RSM(0,0),D,S2) I S1 W /CUP(I+USCR-1,S1),@USEP
S2Z Q
 ;
 ; test op filter
S3() N S1,S2 S S1=1
S3A I $L($P(UFLT,D)) S S1=0,S2=$P(UFLT,D) D
 . I S2=+S2,J>S2 S S1=1 Q
 . I S2'=+S2,J]S2 S S1=1
S3B I S1,$L($P(UFLT,D,2)) S S1=0,S2=$P(UFLT,D,2) D
 . I S2=+S2,J<S2 S S1=1 Q
 . I S2'=+S2,S2]J S S1=1 Q
 . S J="~" ; einde bestand
S3C I S1,$L($P(UFLT,D,3)) X $P(UFLT,D,3) S S1=$T
S3Z Q S1
 ;
 ; clear attribute
S4 D BALK(0)
S4A N S1,S2
S4B F S2=1:1:$L(RSM(0,0),D) S S1=$P(RSM(0,0),D,S2) I S1 W /CUP(II+USCR-1,S1),@USEP
S4C W /CUP(II+USCR-1,1),/WDSP
S4Z Q
 ;
 ; balk aan/af
BALK(C) W /CUP(II+USCR-1,1),/SGR(C),$G(RSL(II,9)),/CUP(II+USCR-1,1)
 I '$D(RSL(II,9)) W $J("",$P(QW(QW),D,4)-($P(QW(QW),D,5)*2)),/CUP(II+USCR-1,1)
BALKZ W /WDSP Q
 ;
1 W /WSCROFF F I=USCR:1:$P(USCR,D,2) W /CUP(I,1),/WCML
11 S RSD=UREF
15 S II=1,J=$P(UFLT,D,1+$P(USCR,D,3)),JJ=$P(USCR,D,2)-$P(USCR,D)+1,RK=0
17 K RSL S I=0 F  Q:I=JJ  D S1(J,1) Q:J=""  I $$S3 S I=I+1 S RSL(I)=J D S2
19 I I<JJ S:'I I=1 F  Q:I>JJ  D  S I=I+1
 . N S1,S2
 . F S2=1:1:$L(RSM(0,0),D) S S1=$P(RSM(0,0),D,S2) I S1 W /CUP(I+USCR-1,S1),@USEP
 ;
 ; vraagstelling onderaan
2 S RSV=RK W /CUP(II+(USCR-1),1) D:UATT  W /WDSP K EXIT,REFRESH
 . D BALK(UATT)
 . N S1,S2
 . F S2=1:1:$L(RSM(0,0),D) S S1=$P(RSM(0,0),D,S2) I S1 W /CUP(II+USCR-1,S1),@USEP
 . W /CUP(II+USCR-1,1)
21 D ^cAFA0(RK,0,0,0,0,"23\24\25\26\31\32"_RSKEYS,UTIM,0,0)
 ;
3 ; speciale functies
320 I $D(^DMC(UQC,USC,"SYN",0,0,RK,0)) D  G Y:'OK,17:$G(REFRESH),2
 . S OK=1 X ^(0) Q:'OK!'$G(REFRESH)
 . W /SGR(0) F I=USCR:1:$P(USCR,D,2) W /CUP(I,1),/WCML
 . I $D(RSL(1)) D S1(RSL(1),-1)
 . I '$D(RSL(JJ)) S J=$P(UFLT,D,1+$P(USCR,D,3))
323 I RK=23 D  G 2                                              ; Home
 . I RK=RSV D BEL Q
 . I '$D(RSL(1)) D BEL Q
 . I UATT D S4
 . S II=1 I '$D(RSL(JJ)) Q
 . S J=$P(UFLT,D,1+$P(USCR,D,3)) F  D S1(J,1) Q:J=""  Q:$$S3
 . I J=RSL(1) D BEL Q
 . K RSL F I=USCR:1:$P(USCR,D,2) W /CUP(I,1),/WCML
 . S I=0,J=$P(UFLT,D,1+$P(USCR,D,3)) F  Q:I=JJ  D S1(J,1) Q:J=""  I $$S3 S I=I+1 S RSL(I)=J
 . F I=JJ:-1:1 I $D(RSL(I)) D S2 S II=I
324 I RK=24 D  G 2                                              ; End
 . I RK=RSV D BEL Q
 . I '$D(RSL(1)) D BEL Q
 . I UATT D S4
 . S II=$O(RSL(""),-1) I '$D(RSL(JJ)) Q
 . S J=$P(UFLT,D,2-$P(USCR,D,3)) F  D S1(J,-1) Q:J=""  Q:$$S3
 . I J=RSL(JJ) D BEL Q
 . K RSL F I=USCR:1:$P(USCR,D,2) W /CUP(I,1),/WCML
 . S I=0,J=$P(UFLT,D,2-$P(USCR,D,3)) F  Q:I=JJ  D S1(J,-1) Q:J=""  I $$S3 S I=I+1 D
 .. F II=I:-1:2 M RSL(II)=RSL(II-1) K RSL(II-1)
 .. S RSL(1)=J
 . F I=1:1:JJ I $D(RSL(I)) D S2 S II=I
325 I RK=25 D  G 2                                              ; PgUp
 . I '$D(RSL(1)) D BEL Q
 . I UATT D S4
 . I II=1 S RSV=RK
 . S II=1 I RK'=RSV Q
 . S J=$P(UFLT,D,1+$P(USCR,D,3)) F  D S1(J,1) Q:J=""  Q:$$S3
 . I J=RSL(1) D BEL Q
 . S I=1,J=RSL(1) F  Q:I=JJ  D S1(J,-1) Q:J=""  I $$S3 S I=I+1 D
 .. F II=JJ:-1:2 I $D(RSL(II)) K RSL(II) M RSL(II)=RSL(II-1)
 .. K RSL(1) S RSL(1)=J
 . F I=JJ:-1:1 I $D(RSL(I)) D S2 S II=I
326 I RK=26 D  G 324:RK=24,2                                    ; PgDn
 . I '$D(RSL(1)) D BEL Q
 . I UATT D S4
 . S JJ(0)=$O(RSL(""),-1)
 . I II=JJ(0) S RSV=RK
 . S II=JJ(0) I RK'=RSV Q
 . S J=$P(UFLT,D,2-$P(USCR,D,3)) F  D S1(J,-1) Q:J=""  Q:$$S3
 . I J=RSL(JJ(0)) D BEL Q
 . I II<JJ S RSV=RK,RK=24 Q
 . S I=1,J=RSL(JJ) F  Q:I=JJ  D S1(J,1) Q:J=""  I $$S3 S I=I+1 D
 .. F II=1:1:JJ-1 K RSL(II) M RSL(II)=RSL(II+1)
 .. K RSL(JJ) S RSL(JJ)=J
 . F I=1:1:JJ D S2 S II=I
327 I RK=27 G Y                                                 ; Esc
328 I RK=28 D BEL G 2                                           ; Enter
329 I RK=29 D  G Y:$G(EXIT),17:$G(REFRESH),2                    ; Tab
 . I UATT D S4
 . D ^cAN001($P(UTX,D,QTU),22,UQM,USM,UFU,SW4_"#1","","")
 . I K="-"!(K=",")!(RK=27) Q
 . I K S UDET=+K D S1^cAN212 D  S REFRESH=1 Q
 .. I $D(RSL(1)) D S1(RSL(1),-1)
 .. I '$D(RSL(JJ)) S J=$P(UFLT,D,1+$P(USCR,D,3))
 . I RK=28 X X W /WREFRESH S II=1 I $G(REFRESH) D
 .. F I=USCR:1:$P(USCR,D,2) W /CUP(I,1),/WCML
 .. I $D(RSL(1)) D S1(RSL(1),-1)
 .. I '$D(RSL(JJ)) S J=$P(UFLT,D,1+$P(USCR,D,3))
331 I RK=31 D  G 2                                              ; Pijl ^
 . I '$D(RSL(1)) D BEL Q
 . I UATT D S4
 . I II>1 S II=II-1 Q
 . S J=$P(UFLT,D,1+$P(USCR,D,3)) F  D S1(J,1) Q:J=""  Q:$$S3
 . I J=RSL(1) D BEL Q
 . S I=0,J=RSL(1) F  Q:I  D S1(J,-1) Q:J=""  I $$S3 D
 .. F II=JJ:-1:2 I $D(RSL(II-1)) M RSL(II)=RSL(II-1)
 .. S RSL(1)=J
 .. F I=JJ:-1:1 I $D(RSL(I)) D S2 S II=I
332 I RK=32 D  G 324:RK=24,2                                    ; Pijl v
 . I '$D(RSL(1)) D BEL Q
 . I UATT D S4
 . S JJ(0)=$O(RSL(""),-1)
 . I II<JJ(0) S II=II+1 Q
 . S J=$P(UFLT,D,2-$P(USCR,D,3)) F  D S1(J,-1) Q:J=""  Q:$$S3
 . I J=RSL(JJ(0)) D BEL Q
 . I II<JJ S RSV=RK,RK=24 Q
 . S I=0,J=RSL(JJ) F  Q:I  D S1(J,1) Q:J=""  I $$S3 D
 .. F II=1:1:JJ-1 M RSL(II)=RSL(II+1)
 .. S RSL(JJ)=J
 .. F I=1:1:JJ D S2 S II=I
335 I RK=35 S REFRESH=1 G 17                                    ; Timed-out
 ;
39 D BEL G 21
 ;
Y K RSD,RSL
YZ Q
 ;
BEL W $C(7) Q     
 ;
ZZ ; 05.02.01 - 16 u 23 * V7.84