Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MCARDSE

MCARDSE.m

Go to the documentation of this file.
  1. MCARDSE ;WISC/MLH-MEDICINE SCREEN HANDLER-PROCESS FIELD ;5/2/96 13:31
  1. ;;2.3;Medicine;;09/13/1996
  1. RESPONSE(MHX,MHFL,MHDX,MHDY) ; process a response from the user
  1. N DX,DY,MCHAR,MHY,QUIT,X
  1. ;
  1. S X=0 X ^%ZOSF("RM") ; turn off auto wrap
  1. X ^%ZOSF("EOFF") ; turn off echo
  1. S DX=MHDX,DY=MHDY X IOXY ; position cursor
  1. S MHY="" ; the output string
  1. ;
  1. ; read and process characters until the user says quit
  1. S QUIT=0
  1. F D RD Q:QUIT D:MCHAR>31&(MCHAR'=126)&(MCHAR<128) PROC D:MCHAR=27 PCK Q:QUIT ; don't process control chars or tilde
  1. ;
  1. I MCHAR=13,(MHY[U) S MCMASS=1 K MCDID
  1. I $E(MHY,1)="?" S MCMASS=1 K MCDID
  1. I MHY="^D"!(MHY="^U") S MCMASS=1 K MCDID
  1. ; did user enter anything?
  1. I MHY="" S MHY=MHX ; nope, default to input
  1. S X=+$G(IOM) X ^%ZOSF("RM") ; reset margin
  1. X ^%ZOSF("EON") ; echo on
  1. S:$E(MHY,1)=U MHY=$$UPPER(MHY)
  1. S:$P(DJJ(V),U,4)["S" MHY=$$UPPER(MHY)
  1. QUIT MHY_"~"_(QUIT'=2) ; second piece indicates a timeout
  1. UPPER(X) ;CONVERT TO UPPERCASE
  1. N Y
  1. X ^%ZOSF("UPPERCASE")
  1. Q Y
  1. ;
  1. RD ; read one character
  1. R *MCHAR:DTIME
  1. I MCHAR'=-1,MCHAR'=13 ;,MCHAR'=27 ;Allow the escape charcter
  1. E S QUIT=$S(MCHAR=-1:2,1:1) ; bailout (QUIT=1) or timeout (QUIT=2)
  1. Q
  1. ;
  1. PROC ; process one character
  1. I MCHAR'=127 D ; process ordinary character
  1. . D PROCCHAR
  1. E I MHY'="" D PROCDEL ; process <DELETE> if possible
  1. Q
  1. ;
  1. PROCCHAR ; process ordinary character
  1. IF $L(MHY)<MHFL D ; not at the end yet
  1. . W $C(MCHAR)
  1. . I MHDX<79 S MHDX=MHDX+1
  1. . E S (DY,MHDY)=MHDY+1,(DX,MHDX)=0 X IOXY
  1. . S MHY=MHY_$C(MCHAR)
  1. . Q
  1. ELSE D ; we're at the end, start overwriting
  1. . W $C(8,7),$C(MCHAR) ; get rid of the last char
  1. . S MHY=$$INSERT^MCU(MHY,MHFL,MCHAR)
  1. . Q
  1. ;END IF
  1. Q
  1. ;
  1. PROCDEL ; process <DELETE>
  1. I MHDX>0 W $C(8,32,8) S MHDX=MHDX-1
  1. E S (DX,MHDX)=79,(DY,MHDY)=MHDY-1 X IOXY W " "
  1. S MHY=$E(MHY,1,$L(MHY)-1)
  1. Q
  1. ;
  1. MLH ;TEST TAG
  1. W @IOF S TEST=$$RESPONSE^MCARDSE($G(TEST),110,0,10)
  1. Q
  1. PCK ;WISC/DCB-Process the escape keys see bottom for mapping
  1. N STR,CHR S STR=$C(27) ;Set the String to Escape
  1. F R *CHR:.001 Q:CHR=-1 S STR=STR_$C(CHR) ; Clear the buffer
  1. I STR=IOCUD K MCDID S QUIT=1 Q
  1. I STR=IOKP4 D JUMP Q
  1. S MHY=$S(STR=IOCUB:"^U",STR=IOCUU:"<",STR=IOCUF:"^D",STR=IOPF1:"^T",STR=IOPF2:"^O",STR=IOPF3:"?",STR=IOPF4:"??",STR=IOKP1:"^C",STR=IOKP3:"^",STR=IOKP5:"^R",STR=IOKP6:" ",STR=IOKP9:"@",STR=IOKP7:"^H",1:"")
  1. S:MHY'="" QUIT=1
  1. Q
  1. ;
  1. JUMP ;This allow the user to type in a field number w/o pressing return
  1. N NUM,LOW,HI
  1. S LOW=$O(DJJ("")),HI=DJL
  1. X DJCP X XY W DJLIN X ^%ZOSF("EON") K MCDID S MCMASS=1
  1. W !,"Input a field number",LOW," to ",HI," to jump to."
  1. R !,"Field Number: ",NUM:DTIME I ('$T)!(NUM["^") S QUIT=2 Q
  1. G:NUM["?" JUMP
  1. S NUM=+NUM
  1. I (NUM<LOW)!(NUM>HI) S MHY=U_V,QUIT=1 Q
  1. S MHY="^"_NUM,QUIT=1
  1. Q