DIR0K ;SFISC/MKO-GET KEYS FOR FIELD EDITOR ;12:16 PM 15 Feb 1995
;;22.0;VA FileMan;;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
;
GETKEY ;Get key sequences
N AU,AD,AR,AL,F1,F2,F3,F4,I,K,T
N REMOVE,PREVSC,NEXTSC
S AU=$P(DDGLKEY,U,2)
S AD=$P(DDGLKEY,U,3)
S AR=$P(DDGLKEY,U,4)
S AL=$P(DDGLKEY,U,5)
S F1=$P(DDGLKEY,U,6)
S F2=$P(DDGLKEY,U,7)
S F3=$P(DDGLKEY,U,8)
S F4=$P(DDGLKEY,U,9)
S REMOVE=$P(DDGLKEY,U,13)
S PREVSC=$P(DDGLKEY,U,14)
S NEXTSC=$P(DDGLKEY,U,15)
;
S DIR0(DIR0P_"IN")="",DIR0(DIR0P_"OUT")=""
;
I DIR0P="C" S I="" F S I=$O(DIR0MAP(I)) Q:I'=+$P(I,"E") S T=DIR0MAP(I) D INOUT
F I=1:1 S T=$P($T(GENMAP+I),";;",2,999) Q:T="" D INOUT
I DIR0P="" F I=1:1 S T=$P($T(SMMAP+I),";;",2,999) Q:T="" D INOUT
;
S DIR0(DIR0P_"IN")=DIR0(DIR0P_"IN")_U
S DIR0(DIR0P_"OUT")=$E(DIR0(DIR0P_"OUT"),1,$L(DIR0(DIR0P_"OUT"))-1)
Q
;
INOUT ;Set DIR0("IN") and DIR0("OUT")
I $P(T,";",2)="KEYDOWN" Q:$P(T,";")="" S DIR0KD=$P(T,";"),K="KD"
E I $P(T,";",2)="TIMEOUT" Q:$P(T,";")="" S DIR0TO=$P(T,";"),K="TO"
E S @("K="_$P(T,";",2))
I DIR0(DIR0P_"IN")'[(U_K) D
. S DIR0(DIR0P_"IN")=DIR0(DIR0P_"IN")_U_K
. S DIR0(DIR0P_"OUT")=DIR0(DIR0P_"OUT")_$P(T,";")_";"
;
Q
GENMAP ;General field editor key sequences
;;RIGHT;AR
;;LEFT;AL
;;JRT;F1_AR
;;JLT;F1_AL
;;FDE;F1_F1_AR
;;FDB;F1_F1_AL
;;WRT;F1_" "
;;WRT;$C(12)
;;WLT;$C(10)
;;DEL;REMOVE
;;DEL;F2
;;CLR;F1_"D"
;;CLR;$C(21)
;;DEOF;F1_F2
;;DLW;$C(23)
;;CR;$C(13)
;;UP;AU
;;DOWN;AD
;;TAB;$C(9)
;;RPM;F3
;;BS;$C(127)
;;BS;$C(8)
;;
SMMAP ;ScreenMan specific key sequences
;;FDL;F4
;;NB;F1_F4
;;NP;F1_AD
;;NP;NEXTSC
;;PP;F1_AU
;;PP;PREVSC
;;HLP;F1_"H"
;;SEL;F1_"L"
;;EX;F1_"E"
;;QT;F1_"Q"
;;CL;F1_"C"
;;SV;F1_"S"
;;RF;F1_"R"
;;ZM;F1_"Z"
;;
DIR0K ;SFISC/MKO-GET KEYS FOR FIELD EDITOR ;12:16 PM 15 Feb 1995
+1 ;;22.0;VA FileMan;;Mar 30, 1999
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
GETKEY ;Get key sequences
+1 NEW AU,AD,AR,AL,F1,F2,F3,F4,I,K,T
+2 NEW REMOVE,PREVSC,NEXTSC
+3 SET AU=$PIECE(DDGLKEY,U,2)
+4 SET AD=$PIECE(DDGLKEY,U,3)
+5 SET AR=$PIECE(DDGLKEY,U,4)
+6 SET AL=$PIECE(DDGLKEY,U,5)
+7 SET F1=$PIECE(DDGLKEY,U,6)
+8 SET F2=$PIECE(DDGLKEY,U,7)
+9 SET F3=$PIECE(DDGLKEY,U,8)
+10 SET F4=$PIECE(DDGLKEY,U,9)
+11 SET REMOVE=$PIECE(DDGLKEY,U,13)
+12 SET PREVSC=$PIECE(DDGLKEY,U,14)
+13 SET NEXTSC=$PIECE(DDGLKEY,U,15)
+14 ;
+15 SET DIR0(DIR0P_"IN")=""
SET DIR0(DIR0P_"OUT")=""
+16 ;
+17 IF DIR0P="C"
SET I=""
FOR
SET I=$ORDER(DIR0MAP(I))
IF I'=+$PIECE(I,"E")
QUIT
SET T=DIR0MAP(I)
DO INOUT
+18 FOR I=1:1
SET T=$PIECE($TEXT(GENMAP+I),";;",2,999)
IF T=""
QUIT
DO INOUT
+19 IF DIR0P=""
FOR I=1:1
SET T=$PIECE($TEXT(SMMAP+I),";;",2,999)
IF T=""
QUIT
DO INOUT
+20 ;
+21 SET DIR0(DIR0P_"IN")=DIR0(DIR0P_"IN")_U
+22 SET DIR0(DIR0P_"OUT")=$EXTRACT(DIR0(DIR0P_"OUT"),1,$LENGTH(DIR0(DIR0P_"OUT"))-1)
+23 QUIT
+24 ;
INOUT ;Set DIR0("IN") and DIR0("OUT")
+1 IF $PIECE(T,";",2)="KEYDOWN"
IF $PIECE(T,";")=""
QUIT
SET DIR0KD=$PIECE(T,";")
SET K="KD"
+2 IF '$TEST
IF $PIECE(T,";",2)="TIMEOUT"
IF $PIECE(T,";")=""
QUIT
SET DIR0TO=$PIECE(T,";")
SET K="TO"
+3 IF '$TEST
SET @("K="_$PIECE(T,";",2))
+4 IF DIR0(DIR0P_"IN")'[(U_K)
Begin DoDot:1
+5 SET DIR0(DIR0P_"IN")=DIR0(DIR0P_"IN")_U_K
+6 SET DIR0(DIR0P_"OUT")=DIR0(DIR0P_"OUT")_$PIECE(T,";")_";"
End DoDot:1
+7 ;
+8 QUIT
GENMAP ;General field editor key sequences
+1 ;;RIGHT;AR
+2 ;;LEFT;AL
+3 ;;JRT;F1_AR
+4 ;;JLT;F1_AL
+5 ;;FDE;F1_F1_AR
+6 ;;FDB;F1_F1_AL
+7 ;;WRT;F1_" "
+8 ;;WRT;$C(12)
+9 ;;WLT;$C(10)
+10 ;;DEL;REMOVE
+11 ;;DEL;F2
+12 ;;CLR;F1_"D"
+13 ;;CLR;$C(21)
+14 ;;DEOF;F1_F2
+15 ;;DLW;$C(23)
+16 ;;CR;$C(13)
+17 ;;UP;AU
+18 ;;DOWN;AD
+19 ;;TAB;$C(9)
+20 ;;RPM;F3
+21 ;;BS;$C(127)
+22 ;;BS;$C(8)
+23 ;;
SMMAP ;ScreenMan specific key sequences
+1 ;;FDL;F4
+2 ;;NB;F1_F4
+3 ;;NP;F1_AD
+4 ;;NP;NEXTSC
+5 ;;PP;F1_AU
+6 ;;PP;PREVSC
+7 ;;HLP;F1_"H"
+8 ;;SEL;F1_"L"
+9 ;;EX;F1_"E"
+10 ;;QT;F1_"Q"
+11 ;;CL;F1_"C"
+12 ;;SV;F1_"S"
+13 ;;RF;F1_"R"
+14 ;;ZM;F1_"Z"
+15 ;;
