DENTDSE ;WISC/MLH-DENTAL SCREEN HANDLER-PROCESS FIELD > 80 CHAR IN LENGTH ;9/1/92 10:26
;;1.2;DENTAL;***15**;Oct 08, 1992
RESPONSE(MHX,MHFL,MHDX,MHDY) ; process a response from the user
N DX,DY,DEHAR,MHY,QUIT,X
;
S X=0 X ^%ZOSF("RM") ; turn off auto wrap
X ^%ZOSF("EOFF") ; turn off echo
S DX=MHDX,DY=MHDY X IOXY ; position cursor
S MHY="" ; the output string
;
; read and process characters until the user says quit
S QUIT=0
FOR D RD Q:QUIT D:DEHAR>31!(DEHAR=126) PROC Q:QUIT ; don't process control chars or tilde
;
; did user enter anything?
I MHY="" S MHY=MHX ; nope, default to input
S X=+$G(IOM) X ^%ZOSF("RM") ; reset margin
X ^%ZOSF("EON") ; echo on
QUIT MHY_"~"_(QUIT'=2) ; second piece indicates a timeout
;
RD ; read one character
R *DEHAR:DTIME
IF DEHAR'=-1,DEHAR'=13,DEHAR'=27
E S QUIT=$S(DEHAR=-1:2,1:1) ; bailout (QUIT=1) or timeout (QUIT=2)
Q
;
PROC ; process one character
I DEHAR'=127 D ; process ordinary character
. D PROCCHAR
E I MHY'="" D PROCDEL ; process <DELETE> if possible
;I $L(MHY)'<MHFL S QUIT=1
Q
;
PROCCHAR ; process ordinary character
IF $L(MHY)<MHFL D ; not at the end yet
. W $C(DEHAR)
. I MHDX<79 S MHDX=MHDX+1
. E S (DY,MHDY)=MHDY+1,(DX,MHDX)=0 X IOXY
. S MHY=MHY_$C(DEHAR)
. Q
ELSE D ; we're at the end, start overwriting
. W *8,*7,$C(DEHAR) ; get rid of the last char
. S $E(MHY,MHFL)=$C(DEHAR)
. Q
;END IF
;
Q
;
PROCDEL ; process <DELETE>
I MHDX>0 W $C(8,32,8) S MHDX=MHDX-1
E S (DX,MHDX)=79,(DY,MHDY)=MHDY-1 X IOXY W " "
S MHY=$E(MHY,1,$L(MHY)-1)
Q
;
MLH ;TEST TAG
W @IOF S TEST=$$^DENTDSE($G(TEST),110,0,10)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDENTDSE 1746 printed Dec 13, 2024@01:46:32 Page 2
DENTDSE ;WISC/MLH-DENTAL SCREEN HANDLER-PROCESS FIELD > 80 CHAR IN LENGTH ;9/1/92 10:26
+1 ;;1.2;DENTAL;***15**;Oct 08, 1992
RESPONSE(MHX,MHFL,MHDX,MHDY) ; process a response from the user
+1 NEW DX,DY,DEHAR,MHY,QUIT,X
+2 ;
+3 ; turn off auto wrap
SET X=0
XECUTE ^%ZOSF("RM")
+4 ; turn off echo
XECUTE ^%ZOSF("EOFF")
+5 ; position cursor
SET DX=MHDX
SET DY=MHDY
XECUTE IOXY
+6 ; the output string
SET MHY=""
+7 ;
+8 ; read and process characters until the user says quit
+9 SET QUIT=0
+10 ; don't process control chars or tilde
FOR
DO RD
if QUIT
QUIT
if DEHAR>31!(DEHAR=126)
DO PROC
if QUIT
QUIT
+11 ;
+12 ; did user enter anything?
+13 ; nope, default to input
IF MHY=""
SET MHY=MHX
+14 ; reset margin
SET X=+$GET(IOM)
XECUTE ^%ZOSF("RM")
+15 ; echo on
XECUTE ^%ZOSF("EON")
+16 ; second piece indicates a timeout
QUIT MHY_"~"_(QUIT'=2)
+17 ;
RD ; read one character
+1 READ *DEHAR:DTIME
+2 IF DEHAR'=-1
IF DEHAR'=13
IF DEHAR'=27
+3 ; bailout (QUIT=1) or timeout (QUIT=2)
IF '$TEST
SET QUIT=$SELECT(DEHAR=-1:2,1:1)
+4 QUIT
+5 ;
PROC ; process one character
+1 ; process ordinary character
IF DEHAR'=127
Begin DoDot:1
+2 DO PROCCHAR
End DoDot:1
+3 ; process <DELETE> if possible
IF '$TEST
IF MHY'=""
DO PROCDEL
+4 ;I $L(MHY)'<MHFL S QUIT=1
+5 QUIT
+6 ;
PROCCHAR ; process ordinary character
+1 ; not at the end yet
IF $LENGTH(MHY)<MHFL
Begin DoDot:1
+2 WRITE $CHAR(DEHAR)
+3 IF MHDX<79
SET MHDX=MHDX+1
+4 IF '$TEST
SET (DY,MHDY)=MHDY+1
SET (DX,MHDX)=0
XECUTE IOXY
+5 SET MHY=MHY_$CHAR(DEHAR)
+6 QUIT
End DoDot:1
+7 ; we're at the end, start overwriting
IF '$TEST
Begin DoDot:1
+8 ; get rid of the last char
WRITE *8,*7,$CHAR(DEHAR)
+9 SET $EXTRACT(MHY,MHFL)=$CHAR(DEHAR)
+10 QUIT
End DoDot:1
+11 ;END IF
+12 ;
+13 QUIT
+14 ;
PROCDEL ; process <DELETE>
+1 IF MHDX>0
WRITE $CHAR(8,32,8)
SET MHDX=MHDX-1
+2 IF '$TEST
SET (DX,MHDX)=79
SET (DY,MHDY)=MHDY-1
XECUTE IOXY
WRITE " "
+3 SET MHY=$EXTRACT(MHY,1,$LENGTH(MHY)-1)
+4 QUIT
+5 ;
MLH ;TEST TAG
+1 WRITE @IOF
SET TEST=$$^DENTDSE($GET(TEST),110,0,10)
+2 QUIT
