cAN2111 ;Scrolling ;%AN211 ; [ 02/25/00  10:03 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 D
 . I $L($P(UFLT,D)) S S1=0,S2=$P(UFLT,D) D
 .. I S2=+S2,J>S2 S S1=1
 .. I S2'=+S2,J]S2 S S1=1
 . I S1,$L($P(UFLT,D,2)) S S1=0,S2=$P(UFLT,D,2) D
 .. I S2=+S2,J<S2 S S1=1
 .. I S2'=+S2,S2]J S S1=1
 . I S1,$L($P(UFLT,D,3)) X $P(UFLT,D,3) S S1=$T
S3Z Q S1
 ;
 ; onderste lijn desnoods doorscrollen
S4 I II=JJ D
 . F II=1:1:JJ-1 M RSL(II)=RSL(II+1)
 . S RSL(JJ)=UI1
 . F I=1:1:JJ D S2 S II=I
S4A I II<JJ S II=II+1,RSL(II)=UI1
S4Z Q
 ;
 ; algemene initialisatie
1 W /WSCROFF F I=USCR:1:$P(USCR,D,2) W /CUP(I,1),/WCML
11 S RSD=UREF,RSINS=0
13 S ULEN=$P(QW(QW),D,4)-($P(QW(QW),D,5)*2),AUTO=1_D_0_D_1
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
2 S RSV=RK K EXIT,REFRESH
21 S (KR,UI1)="" I $G(RSL(II)) S UI1=RSL(II),KR=$P($G(@UREF),D)
22 I UI1="",$O(@RSD)="" S UI1=1,@UREF="" G 1
23 D ^cAFA0(KR,$P(QW(QW),D)+$P(QW(QW),D,5)+$P(USCR,D)-1+II-1,$P(QW(QW),D,2)+$P(QW(QW),D,5),ULEN,UATT,"2\4\25\26\27\29\31\32"_RSKEYS,0,0,AUTO)
25 S $P(AUTO,D,2)=$P(RK,D,2),$P(AUTO,D,3)=$P(RK,D,3),RK=+RK
27 I $P(AUTO,D,3)=ULEN S $P(AUTO,D,3)=1
29 S $P(@UREF,D)=$E(K,1,ULEN),I=II D S2    ; update lijn + opnieuw tonen
 ;
3 ; speciale functies
300 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)
 . 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))
302 I RK=2 S RK=32,RSINS=1                                      ; F2
325 I RK=25 S RSINS=0 D  G 2                                    ; PgUp
 . I '$D(RSL(1)) D BEL Q
 . 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 K RSL(II) 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
326 I RK=26 S RSINS=0 D  G 2                                    ; PgDn
 . I '$D(RSL(1)) D BEL Q
 . 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
 . 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 S RK=32,RSINS=0,$P(AUTO,D,3)=1                      ; Enter
329 I RK=29 S RSINS=0 D  G Y:$G(EXIT),17:$G(REFRESH),2          ; Tab
 . 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 S RSINS=0 D  G 2                                    ; Pijl ^
 . I '$D(RSL(1)) D BEL Q
 . 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 17:$G(REFRESH),2                               ; Pijl v
 . I RSINS D  Q                                              ; ins. lijn
 .. I RSINS>1 S UI1=UI1+1,II=II+1
 .. S J=UI1 F  S UI1=UI1+1,I=UI1 Q:'$D(@UREF)
 .. F UI1=I:-1:J+1 S UI1=UI1-1,K=@UREF,UI1=UI1+1,@UREF=K
 .. S UI1=J,@UREF="",$P(AUTO,D,3)=1,REFRESH=1 D S1(RSL(1),-1)
 .. I RSINS=1 S RSINS=2
 .. I II>JJ D S1(J,1) S II=JJ
 . I '$D(RSL(1)) D BEL Q
 . 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)) S UI1=UI1+10,$P(AUTO,D,3)=1 D S4 Q         ; wrap
 . 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
368 I RK=68 S RSINS=0 D  G 17                                   ; ^D
 . K @UREF,RSL(II)
 . F I=USCR:1:$P(USCR,D,2) W /CUP(I,1),/WCML
 . F I=II+1:1:JJ Q:'$D(RSL(I))  M RSL(I-1)=RSL(I) K RSL(I)
 . I $D(RSL(II)) D S1(RSL(1),-1) Q
 . F II=JJ:-1:1 Q:$D(RSL(II))
 . I $D(RSL(II)) D S1(RSL(1),-1) Q
 . S I=0,J=UI1 F  Q:I=JJ  D S1(J,-1) Q:J=""  I $$S3 S I=I+1,II=I
 . I $L(J) D S1(J,-1)
 ;
39 D BEL G 21
 ;
Y S J=1E12 F  D S1(J,-1) Q:J=""  Q:$L($P(^(J),D))  K ^(J)
YY K RSD,RSL
YZ Q
 ;
BEL W $C(7) Q     
 ;
ZZ ; 05.02.01 - 16 u 23 * V7.84