| 1 | MCARDSE ;WISC/MLH-MEDICINE SCREEN HANDLER-PROCESS FIELD ;5/2/96 13:31
|
|---|
| 2 | ;;2.3;Medicine;;09/13/1996
|
|---|
| 3 | RESPONSE(MHX,MHFL,MHDX,MHDY) ; process a response from the user
|
|---|
| 4 | N DX,DY,MCHAR,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 | 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
|
|---|
| 14 | ;
|
|---|
| 15 | I MCHAR=13,(MHY[U) S MCMASS=1 K MCDID
|
|---|
| 16 | I $E(MHY,1)="?" S MCMASS=1 K MCDID
|
|---|
| 17 | I MHY="^D"!(MHY="^U") S MCMASS=1 K MCDID
|
|---|
| 18 | ; did user enter anything?
|
|---|
| 19 | I MHY="" S MHY=MHX ; nope, default to input
|
|---|
| 20 | S X=+$G(IOM) X ^%ZOSF("RM") ; reset margin
|
|---|
| 21 | X ^%ZOSF("EON") ; echo on
|
|---|
| 22 | S:$E(MHY,1)=U MHY=$$UPPER(MHY)
|
|---|
| 23 | S:$P(DJJ(V),U,4)["S" MHY=$$UPPER(MHY)
|
|---|
| 24 | QUIT MHY_"~"_(QUIT'=2) ; second piece indicates a timeout
|
|---|
| 25 | UPPER(X) ;CONVERT TO UPPERCASE
|
|---|
| 26 | N Y
|
|---|
| 27 | X ^%ZOSF("UPPERCASE")
|
|---|
| 28 | Q Y
|
|---|
| 29 | ;
|
|---|
| 30 | RD ; read one character
|
|---|
| 31 | R *MCHAR:DTIME
|
|---|
| 32 | I MCHAR'=-1,MCHAR'=13 ;,MCHAR'=27 ;Allow the escape charcter
|
|---|
| 33 | E S QUIT=$S(MCHAR=-1:2,1:1) ; bailout (QUIT=1) or timeout (QUIT=2)
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | PROC ; process one character
|
|---|
| 37 | I MCHAR'=127 D ; process ordinary character
|
|---|
| 38 | . D PROCCHAR
|
|---|
| 39 | E I MHY'="" D PROCDEL ; process <DELETE> if possible
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | PROCCHAR ; process ordinary character
|
|---|
| 43 | IF $L(MHY)<MHFL D ; not at the end yet
|
|---|
| 44 | . W $C(MCHAR)
|
|---|
| 45 | . I MHDX<79 S MHDX=MHDX+1
|
|---|
| 46 | . E S (DY,MHDY)=MHDY+1,(DX,MHDX)=0 X IOXY
|
|---|
| 47 | . S MHY=MHY_$C(MCHAR)
|
|---|
| 48 | . Q
|
|---|
| 49 | ELSE D ; we're at the end, start overwriting
|
|---|
| 50 | . W $C(8,7),$C(MCHAR) ; get rid of the last char
|
|---|
| 51 | . S MHY=$$INSERT^MCU(MHY,MHFL,MCHAR)
|
|---|
| 52 | . Q
|
|---|
| 53 | ;END IF
|
|---|
| 54 | Q
|
|---|
| 55 | ;
|
|---|
| 56 | PROCDEL ; process <DELETE>
|
|---|
| 57 | I MHDX>0 W $C(8,32,8) S MHDX=MHDX-1
|
|---|
| 58 | E S (DX,MHDX)=79,(DY,MHDY)=MHDY-1 X IOXY W " "
|
|---|
| 59 | S MHY=$E(MHY,1,$L(MHY)-1)
|
|---|
| 60 | Q
|
|---|
| 61 | ;
|
|---|
| 62 | MLH ;TEST TAG
|
|---|
| 63 | W @IOF S TEST=$$RESPONSE^MCARDSE($G(TEST),110,0,10)
|
|---|
| 64 | Q
|
|---|
| 65 | PCK ;WISC/DCB-Process the escape keys see bottom for mapping
|
|---|
| 66 | N STR,CHR S STR=$C(27) ;Set the String to Escape
|
|---|
| 67 | F R *CHR:.001 Q:CHR=-1 S STR=STR_$C(CHR) ; Clear the buffer
|
|---|
| 68 | I STR=IOCUD K MCDID S QUIT=1 Q
|
|---|
| 69 | I STR=IOKP4 D JUMP Q
|
|---|
| 70 | 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:"")
|
|---|
| 71 | S:MHY'="" QUIT=1
|
|---|
| 72 | Q
|
|---|
| 73 | ;
|
|---|
| 74 | JUMP ;This allow the user to type in a field number w/o pressing return
|
|---|
| 75 | N NUM,LOW,HI
|
|---|
| 76 | S LOW=$O(DJJ("")),HI=DJL
|
|---|
| 77 | X DJCP X XY W DJLIN X ^%ZOSF("EON") K MCDID S MCMASS=1
|
|---|
| 78 | W !,"Input a field number",LOW," to ",HI," to jump to."
|
|---|
| 79 | R !,"Field Number: ",NUM:DTIME I ('$T)!(NUM["^") S QUIT=2 Q
|
|---|
| 80 | G:NUM["?" JUMP
|
|---|
| 81 | S NUM=+NUM
|
|---|
| 82 | I (NUM<LOW)!(NUM>HI) S MHY=U_V,QUIT=1 Q
|
|---|
| 83 | S MHY="^"_NUM,QUIT=1
|
|---|
| 84 | Q
|
|---|
