source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCARDSE.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1MCARDSE ;WISC/MLH-MEDICINE SCREEN HANDLER-PROCESS FIELD ;5/2/96 13:31
2 ;;2.3;Medicine;;09/13/1996
3RESPONSE(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
25UPPER(X) ;CONVERT TO UPPERCASE
26 N Y
27 X ^%ZOSF("UPPERCASE")
28 Q Y
29 ;
30RD ; 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 ;
36PROC ; 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 ;
42PROCCHAR ; 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 ;
56PROCDEL ; 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 ;
62MLH ;TEST TAG
63 W @IOF S TEST=$$RESPONSE^MCARDSE($G(TEST),110,0,10)
64 Q
65PCK ;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 ;
74JUMP ;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
Note: See TracBrowser for help on using the repository browser.