DENTDSE.m

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 ---DENTDSE   1746     printed  Apr 23, 2025@18:00:58                                                                                                                                                                                                     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