| [613] | 1 | DENTDSE ;WISC/MLH-DENTAL SCREEN HANDLER-PROCESS FIELD > 80 CHAR IN LENGTH ;9/1/92 10:26
|
|---|
| 2 | ;;1.2;DENTAL;***15**;Oct 08, 1992
|
|---|
| 3 | RESPONSE(MHX,MHFL,MHDX,MHDY) ; process a response from the user
|
|---|
| 4 | N DX,DY,DEHAR,MHY,QUIT,X
|
|---|
| 5 | ;
|
|---|
| 6 | S X=0 X ^%ZOSF("RM") ; turn off auto wrap
|
|---|
| 7 | X ^%ZOSF("EOFF") ; turn off echo
|
|---|
| 8 | S DX=MHDX,DY=MHDY X IOXY ; position cursor
|
|---|
| 9 | S MHY="" ; the output string
|
|---|
| 10 | ;
|
|---|
| 11 | ; read and process characters until the user says quit
|
|---|
| 12 | S QUIT=0
|
|---|
| 13 | FOR D RD Q:QUIT D:DEHAR>31!(DEHAR=126) PROC Q:QUIT ; don't process control chars or tilde
|
|---|
| 14 | ;
|
|---|
| 15 | ; did user enter anything?
|
|---|
| 16 | I MHY="" S MHY=MHX ; nope, default to input
|
|---|
| 17 | S X=+$G(IOM) X ^%ZOSF("RM") ; reset margin
|
|---|
| 18 | X ^%ZOSF("EON") ; echo on
|
|---|
| 19 | QUIT MHY_"~"_(QUIT'=2) ; second piece indicates a timeout
|
|---|
| 20 | ;
|
|---|
| 21 | RD ; read one character
|
|---|
| 22 | R *DEHAR:DTIME
|
|---|
| 23 | IF DEHAR'=-1,DEHAR'=13,DEHAR'=27
|
|---|
| 24 | E S QUIT=$S(DEHAR=-1:2,1:1) ; bailout (QUIT=1) or timeout (QUIT=2)
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | PROC ; process one character
|
|---|
| 28 | I DEHAR'=127 D ; process ordinary character
|
|---|
| 29 | . D PROCCHAR
|
|---|
| 30 | E I MHY'="" D PROCDEL ; process <DELETE> if possible
|
|---|
| 31 | ;I $L(MHY)'<MHFL S QUIT=1
|
|---|
| 32 | Q
|
|---|
| 33 | ;
|
|---|
| 34 | PROCCHAR ; process ordinary character
|
|---|
| 35 | IF $L(MHY)<MHFL D ; not at the end yet
|
|---|
| 36 | . W $C(DEHAR)
|
|---|
| 37 | . I MHDX<79 S MHDX=MHDX+1
|
|---|
| 38 | . E S (DY,MHDY)=MHDY+1,(DX,MHDX)=0 X IOXY
|
|---|
| 39 | . S MHY=MHY_$C(DEHAR)
|
|---|
| 40 | . Q
|
|---|
| 41 | ELSE D ; we're at the end, start overwriting
|
|---|
| 42 | . W *8,*7,$C(DEHAR) ; get rid of the last char
|
|---|
| 43 | . S $E(MHY,MHFL)=$C(DEHAR)
|
|---|
| 44 | . Q
|
|---|
| 45 | ;END IF
|
|---|
| 46 | ;
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | PROCDEL ; process <DELETE>
|
|---|
| 50 | I MHDX>0 W $C(8,32,8) S MHDX=MHDX-1
|
|---|
| 51 | E S (DX,MHDX)=79,(DY,MHDY)=MHDY-1 X IOXY W " "
|
|---|
| 52 | S MHY=$E(MHY,1,$L(MHY)-1)
|
|---|
| 53 | Q
|
|---|
| 54 | ;
|
|---|
| 55 | MLH ;TEST TAG
|
|---|
| 56 | W @IOF S TEST=$$^DENTDSE($G(TEST),110,0,10)
|
|---|
| 57 | Q
|
|---|
