cAN2141 ;Scrolling ;%AN214 ; [ 09/26/00  9:50 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) I $L(J) S J(0)=$S(UIND:^(J),1:J)
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 UI1=RSL(I,0),UATTL=0 I $L($P(UATT,D,2)) X $P(UATT,D,2)  ; lijnattr.
S2C S S1=0 F  S S1=$O(RSM(S1)) Q:S1=""  S S2=RSM(S1,1) D
 . N U3
 . 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),/SGR(UATTL),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 W /SGR(0) Q
 ;
 ; test op filter
S3() N S1,S2,UI1 S S1=1,UI1=J(0)
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
S3D I S1 D S5
S3E I 'S1,$P($H,",",2)-I("H")>60 S I=JJ     ; reactie na 60 seconden
S3Z Q S1
 ;
 ; clear attribute
S4 N S1,S2 S UI1="" I $L($G(RSL(II,0))) S UI1=RSL(II,0)
S4A S UATTL=0 I $L($P(UATT,D,2)) X $P(UATT,D,2)       ; lijnattribuut
S4B D BALK(0) I UATTL D BALK(UATTL) W /SGR(0)
S4Z Q
 ;
 ; $H laatste OK op filter
S5 S I("H")=$P($H,",",2)
S5Z 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))
 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
 
BALKZ W /CUP(II+USCR-1,1),/WDSP Q
 ;
 ; initialisatie
1 W /WSCROFF F I=USCR:1:$P(USCR,D,2) W /CUP(I,1),/WCML
11 S RSD=UREF I UIND S RSD=^DMC(UQC,USC,"DATA","INDEX"),RSD=$E(RSD,1,$L(RSD)-1)_","_UIND_",UI1)"
12 I USORT S RSD="^HULP(""SORT"",RSORT,UI1)",UFLT="",UIND=1
13 S II=1,J=$P(UFLT,D,1+$P(USCR,D,3)),JJ=$P(USCR,D,2)-$P(USCR,D)+1,RK=0
15 D S5 I $G(REFRESH) D
 . W /SGR(0) F I=USCR:1:$P(USCR,D,2) W /CUP(I,1),/WCML       ; vegen
 . I REFRESH=1 D
 .. I $D(RSL(1)) D  I $L(J) S J=I Q      ; geen lege scroll
 ... D S1(RSL(1),-1) S I=J F  D S1(J,1) Q:J=""  Q:$$S3
 .. S J=$P(USCR,D,1+$P(USCR,D,3))        ; lege scroll => PgUp
 .. K RSL S I=0 F  Q:I=JJ  D S1(J,-1) Q:J=""  I $$S3 S RSL(JJ-I)=J,I=I+1
 .. S J=$P(UFLT,D,1+$P(USCR,D,3)) I '$D(RSL(1)) Q
 .. D S1(RSL(1),-1) S I=J F  D S1(J,1) Q:J=""  Q:$$S3
 .. S J=$S($L(J):I,1:$P(UFLT,D,1+$P(USCR,D,3)))
 . I REFRESH>1 D
 .. S II=99,J=$P(UFLT,D,1+$P(USCR,D,3))
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,RSL(I,0)=J(0) D S2
18 I I<JJ F  S I=I+1 Q:I>JJ  D             ; lijnen doortrekken
 . N S1,S2 W /CUP(I+USCR-1,1),/WCML      ; vegen (ivm refresh)
 . 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
19 I $G(REFRESH),'$D(RSL(II)) D  I REFRESH=2,'$D(RSL(II)) G 17:$L(J) S II=1
 . I REFRESH=1 S II=$O(RSL(""),-1) I 'II S II=1
 . I REFRESH=2 F I=1:1 Q:'$D(RSL(I))  I RSL(I,0)=UI1 S II=I Q
 . I REFRESH=3 S II=1
 ;
 ; positionering van de balk
2 I $G(REFTOP) D REFTOP^cAN210
20 S RSV=RK W /CUP(II+(USCR-1),1) D:UATT  W /WDSP K EXIT,REFRESH,REFTOP
 . I $L($P(UATT,D,3)) X $P(UATT,D,3)
 . D BALK(UATT)
21 D ^cAFA0(RK,0,0,0,0,"23\24\25\26\31\32"_RSKEYS,UTIM,0,0),S5
 ;
3 ; speciale functies
320 I $D(^DMC(UQC,USC,"SYN",0,0,RK,0)) D  G Y:$G(EXIT),15:$G(REFRESH),2
 . S UI1="" I $L($G(RSL(II,0))) S UI1=RSL(II,0)
 . S OK=1 X ^(0) I 'OK S EXIT=1
323 I RK=23 D  G 2                                              ; Home
 . I RK=RSV D BEL Q
 . I '$D(RSL(1)) D BEL Q
 . I $L(UATT) D S4
 . S II=1
 . S J=$P(UFLT,D,1+$P(USCR,D,3)) F  D S1(J,1) Q:J=""  Q:$$S3
 . I J=RSL(II) 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,RSL(I,0)=J(0)
 . F I=JJ:-1:1 I $D(RSL(I)) D S2
324 I RK=24 D  G 2                                              ; End
 . I RK=RSV D BEL Q
 . I '$D(RSL(1)) D BEL Q
 . I $L(UATT) D S4
 . S II=$O(RSL(""),-1)
 . S J=$P(UFLT,D,2-$P(USCR,D,3)) F  D S1(J,-1) Q:J=""  Q:$$S3
 . I J=RSL(II) 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,RSL(1,0)=J(0)
 . 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 $L(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(II) 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) M RSL(II)=RSL(II-1)
 .. F II=JJ:-1:2 I $G(RSL(II))="" K RSL(II)
 .. K RSL(1) S RSL(1)=J,RSL(1,0)=J(0)
 . 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 $L(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(II) 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,RSL(JJ,0)=J(0)
 . 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),15:$G(REFRESH),2                    ; Tab
 . I $L(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^cAN214 S REFRESH=1 Q         ; detail
 . I RK=28 X X W /WREFRESH                         ; module
331 I RK=31 D  G 2                                              ; Pijl ^
 . I '$D(RSL(1)) D BEL Q
 . I $L(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(II) 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,RSL(1,0)=J(0)
 .. 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 $L(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(II) 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,RSL(JJ,0)=J(0)
 .. F I=1:1:JJ D S2 S II=I
335 I RK=35 S REFRESH=1 G 15                                    ; 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