cA1000 ;INPUT-ROUTINE ;%A100 ; [ 10/20/00  12:17 PM ]
 ;
T0 ;Input-routine ;
 ;
T0F ;Input-routine ;
 ;
T0E ;Input-routine ;
 ;
1 S $ZT="TRAP^cAN000"
10 N R0,R1,R2,R3,R4,R5,RFP,RI,RJ,RW,RZA,RZB,RZC I '$P(R,D,14) N RK
 N RH0,RH1,RHH D H0,H1    ; time-out voor $C(0) en F3
11 S (R1,R2,R3)=0,R4=$P(R,D,6),RI=0,RJ=$C(250),$P(RJ,RJ,R4)=RJ,RW=0
13 S R0=$G(@$P(R,D)) S:R0="-"!(R0=",")!($P(R,D)="K")!'$P(R,D,13) R0="" S R0=$E(R0_RJ,1,R4)
15 S R5=$P(R,D,8) S:R5="" R5=1 S R5=R5_"&(K'[D)&(K'[$C(34))"
17 I $L($P(R,D,7)) S R5=R5_"&("_$P($T(@$P(R,D,7)),U,2,999)_")"
19 I $ZV["MSM" U 0:(0::::1+4+64+4096+65536:524288+4194304:::$C(13))
 I $ZV'["MSM" U 0:(0:"S")
 ;
 ; tekst vraag + commentaar
2 S FP=$P(R,D,2)*100+$P(R,D,3) W @F,$P(R,D,4)," :" I $P(R,D,3)<4 W @F1
21 I $L($P(R,D,5)) W:$P(R,D,5)["""" !?2,@$P(R,D,5) D:$P(R,D,5)'["""" @$P(R,D,5)
23 S RFP=$P(R,D,2)*100+$P(R,D,3)+$L($P(R,D,4))+3
 ;
 ; tonen volledige input
3 S FP=R1*100+RFP W:RI @F,@F95 W @F,$TR(R0,$E(RJ),$C(U("D","RT")))
 ;
 ; positionering cursor
4 S FP=R1*100+RFP+R2 W @F I RI W @F94,@F,$TR($E(R0,R2+1),$E(RJ),$C(U("D","RT"))),@F
41 S RHH=$P($H,",",2)-RH0 I RHH<0 D H0
 I $G(U("T",0))>0,RHH>U("T",0) W $C(0) D H0        ; time-out $C(0)
 S RHH=$P($H,",",2)-RH1 I RHH<0 D H1
 I $G(U("T",1))>0,RHH>U("T",1) S RK=3 G 6          ; time-out F3
 R *RK:1                                           ; lees 1 karakter
 I $ZV["MSM" S RZA=$ZA,RZB=$ZB\256,RZC=$ZC
 I $ZV'["MSM" S RZA=$ZA,RZB=$ZB,RZC=RZA\256#2 I '$T S (RZB,RZC)=""
43 I RZC D S2 G 41                                   ; foutdetectie
45 I $ZV["MSM",RK>0&'RZB S:RK<27 RZB=RK+64 S:RK=27!(RK=127) RZB=RK
 I $ZV'["MSM",RK>0,RK=$A(RZB) D
 . I RK=127 S RZB=RK Q         ; backspace
 . I RK<27 S RZB=RK+64 Q       ; ^A ... ^Z
 . I RK>27 S RZB=""            ; karakter
47 I $ZV["MSM",RZB S RK=$G(U("D",RZB),0) G 6
 I $ZV'["MSM" I $L(RZB) D  S RK=$G(U("D",RZB),0) G 6
 . I RZB?.E1C.E D              ; escape-string
 .. S RZC=RZB,RZB=""
 .. F RK=1:1:$L(RZC) S RZB=RZB_$A(RZC,RK) I RK<$L(RZC) S RZB=RZB_" "
49 I RK<1 G 41
 ;
 ; gewone input
5 D H0,H1 S RK=$C(RK) I RK?1C D S2 G 41
51 I RI,$E(R0,R4)'=$E(RJ) D S2 G 41
53 S R0=$S(R2:$E(R0,1,R2),1:"")_RK_$E(R0,R2+2-RI,R4-RI)
55 I R2+1<R4 S R2=R2+1
57 G 3:RI W RK G 4
 ;
 ; speciale toetsen
6 D H0,H1
601 ;                                                 ; F1
603 I RK=3 S RK=27                                    ; F3
620 ;                                                 ; F20
621 I RK=21 D  G 3                                    ; Insert
 . S RI='RI I 'RI W @F95
622 I RK=22 D  G 3                                    ; Delete
 . I R0=RJ D S2 Q
 . S R0=$S(R2:$E(R0,1,R2),1:"")_$E(R0,R2+2,R4)_$E(RJ)
623 I RK=23 D  G 3:RI,4                               ; Home
 . S (R1,R2)=0
624 I RK=24 D  G 3:RI,4                               ; End
 . S R2=$F(R0_RJ,RJ)-R4-1 I R2+1>R4 S R2=R4-1
625 I RK=25,$P(R,D,14) S K="",RW=1 G Y                ; PgUp
626 I RK=26,$P(R,D,14) S K="",RW=1 G Y                ; PgDn
627 I RK=27 S R0="-",RK=28                            ; Escape
628 I RK=28 D  G Y:RW,3                               ; Enter
 . D S1 S (R1,R2,RI)=0 W @F95
629 I RK=29,$P(R,D,14) S K="",RW=1 G Y                ; Tab     
630 I RK=30 D  G 3                                    ; Backspace
 . I 'R2 D S2 Q
 . S R0=$E(R0,1,R2-1)_$E(R0,R2+1,999)_$E(RJ),R2=R2-1
631 I RK=31,$P(R,D,14) S K="",RW=1 G Y                ; Pijl Omhoog
632 I RK=32,$P(R,D,14) S K="",RW=1 G Y                ; Pijl Omlaag
633 I RK=33 D  G 3:RI,4                               ; Pijl Links
 . I R2 S R2=R2-1 Q
 . D S2
634 I RK=34 D  G 3:RI,4                               ; Pijl Rechts
 . I R2+1<R4 S R2=R2+1 Q
 . D S2
668 I RK=68 D  G 3                                    ; ^D
 . S R0=$E($S(R2:$E(R0,1,R2),1:"")_RJ,1,R4)
69 I $P(R,D,14),$P(R,D,14)_"#"[("#"_RK_"#") S K="",RW=1 G Y    ; ^A...^Z
 ;
7 D S2 G 41
 ;
Y I $ZV["MSM" U 0:(0:::::1+64+2097152+8388608:::$C(13))
 I $ZV'["MSM" U 0:(0:"")
YA I RW S @$P(R,D)=K,FP=RFP W @F,@F95,@F,K,@F2
YB S FP=$P(R,D,9)*100+$P(R,D,10) I FP W @F,@F95,@F,K,$J("",R4-$L(K)) I K="-"!(K=",") W @F," "
YZ Q
 ;
H0 S RH0=$P($H,",",2) Q     ; time-out $C(0)
H1 S RH1=$P($H,",",2) Q     ; time-out F3
 ;
S1 S K=$P(R0_RJ,RJ),K=$TR(K,$E(RJ)," "),RW=0 S:$P(R,D,11) K=$$UC^cAFA1(K) I @R5 S RW=1
S1A I R2=1!(R4=1),$E(R0)="-"!($E(R0)=",") S K=$E(R0) I @R5 S RW=1
S1Z D S2:'RW Q
 ;
S2 W $C(7) Q
 ;
 ; opladen driver
DRV D DRV^cAFA0 Q
 ;
DCTR ;K?2N1"."2N1"."2N&$E(K,1,2)&$E(K,4,5)&($E(K,1,2)<32)&($E(K,4,5)<13)&'("04060911"[$E(K,4,5)&($E(K,1,2)=31))&'(+$E(K,4,5)=2&(('($E(K,7,8)#4)&($E(K,1,2)>29))!($E(K,7,8)#4&($E(K,1,2)>28))))!("-,"[K)
 ;
ZZ ; 05.02.01 - 16 u 23 * V7.84