- 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 ;;
