- DDWK ;SFISC/MKO-SCREEN EDITOR MAIN ROUTINE ;11:32 AM 25 Aug 2000 [ 04/02/2003 8:25 AM ]
- ;;22.0;VA FileMan;**1001**;APR 1, 2003
- ;;22.0;VA FileMan;**18**;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- GETKEY ;Get key sequences and defaults
- N AU,AD,AR,AL,F1,F2,F3,F4
- N FIND,SELECT,INSERT,REMOVE,PREVSC,NEXTSC
- N A1,A2,A3,I,K,N,T
- 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 FIND=$P(DDGLKEY,U,10)
- S SELECT=$P(DDGLKEY,U,11)
- S INSERT=$P(DDGLKEY,U,12)
- S REMOVE=$P(DDGLKEY,U,13)
- S PREVSC=$P(DDGLKEY,U,14)
- S NEXTSC=$P(DDGLKEY,U,15)
- ;
- S A1="DDW(""IN"")",A2="DDW(""OT"")",A3=0
- S (DDW("IN"),DDW("OT"))=""
- F I=1:1 S T=$P($T(MAP+I),";;",2,999) Q:T="" D
- . S @("K="_$P(T,";",2)),T=$P(T,";")
- . I K]"",@A1'[(U_K) D
- .. I $L(@A1)+$L(K)+2>255!($L(@A2)+$L(T)+1>255) D
- ... S @A1=@A1_U,$E(@A2,$L(@A2))=""
- ... S A3=A3+1,A1=$NA(@A1@(A3)),A2=$NA(@A2@(A3))
- ... S (@A1,@A2)=""
- .. S @A1=@A1_U_K
- .. S @A2=@A2_T_U
- S @A1=@A1_U,$E(@A2,$L(@A2))=""
- Q
- ;
- MAP ;Keys for main screen
- ;;UP;AU
- ;;DN;AD
- ;;RT;AR
- ;;LT;AL
- ;;TAB;$C(9)
- ;;PUP;F1_AU
- ;;PUP;PREVSC
- ;;PDN;F1_AD
- ;;PDN;NEXTSC
- ;;JLT;F1_AL
- ;;JRT;F1_AR
- ;;LB;FIND
- ;;LB;F1_F1_AL
- ;;LE;SELECT
- ;;LE;F1_F1_AR
- ;;TOP;F1_"T"
- ;;BOT;F1_"B"
- ;;WRT;F1_" "
- ;;WRT;$C(12)
- ;;WLT;$C(10)
- ;;RUB;$C(127)
- ;;RUB;$C(8)
- ;;DEL;REMOVE
- ;;DEL;F4
- ;;DEOL;F1_F2
- ;;BRK;$C(13)
- ;;JN;F1_"J"
- ;;RFT;F1_"R"
- ;;ST;F1_"?"
- ;;XLN;F1_"D"
- ;;TST;F1_$C(9)
- ;;TSALL;F1_F1_$C(9)
- ;;LST;F1_","
- ;;RST;F1_"."
- ;;WRM;F2
- ;;RPM;INSERT
- ;;RPM;F3
- ;;SV;F1_"S"
- ;;SW;F1_"A"
- ;;EX;F1_"E"
- ;;QT;F1_"Q"
- ;;QT;$C(5)
- ;;HLP;F1_"H"
- ;;DLW;$C(23)
- ;;MRK;F1_"M"
- ;;UMK;F1_F1_"M"
- ;;CUT;F1_"X"
- ;;CPY;F1_"C"
- ;;PST;F1_"V"
- ;;FND;F1_"F"
- ;;NXT;F1_"N"
- ;;GTO;F1_"G"
- ;;CHG;F1_"P"
- ;;AUT;F1_F1_"S"
- ;;';$C(27)_"Q"
- ;;';$C(27)_"R"
- ;;";$C(27)_"S"
- ;;";$C(27)_"T"
- ;;
- DDWK ;SFISC/MKO-SCREEN EDITOR MAIN ROUTINE ;11:32 AM 25 Aug 2000 [ 04/02/2003 8:25 AM ]
- +1 ;;22.0;VA FileMan;**1001**;APR 1, 2003
- +2 ;;22.0;VA FileMan;**18**;Mar 30, 1999
- +3 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +4 ;
- GETKEY ;Get key sequences and defaults
- +1 NEW AU,AD,AR,AL,F1,F2,F3,F4
- +2 NEW FIND,SELECT,INSERT,REMOVE,PREVSC,NEXTSC
- +3 NEW A1,A2,A3,I,K,N,T
- +4 SET AU=$PIECE(DDGLKEY,U,2)
- +5 SET AD=$PIECE(DDGLKEY,U,3)
- +6 SET AR=$PIECE(DDGLKEY,U,4)
- +7 SET AL=$PIECE(DDGLKEY,U,5)
- +8 SET F1=$PIECE(DDGLKEY,U,6)
- +9 SET F2=$PIECE(DDGLKEY,U,7)
- +10 SET F3=$PIECE(DDGLKEY,U,8)
- +11 SET F4=$PIECE(DDGLKEY,U,9)
- +12 SET FIND=$PIECE(DDGLKEY,U,10)
- +13 SET SELECT=$PIECE(DDGLKEY,U,11)
- +14 SET INSERT=$PIECE(DDGLKEY,U,12)
- +15 SET REMOVE=$PIECE(DDGLKEY,U,13)
- +16 SET PREVSC=$PIECE(DDGLKEY,U,14)
- +17 SET NEXTSC=$PIECE(DDGLKEY,U,15)
- +18 ;
- +19 SET A1="DDW(""IN"")"
- SET A2="DDW(""OT"")"
- SET A3=0
- +20 SET (DDW("IN"),DDW("OT"))=""
- +21 FOR I=1:1
- SET T=$PIECE($TEXT(MAP+I),";;",2,999)
- IF T=""
- QUIT
- Begin DoDot:1
- +22 SET @("K="_$PIECE(T,";",2))
- SET T=$PIECE(T,";")
- +23 IF K]""
- IF @A1'[(U_K)
- Begin DoDot:2
- +24 IF $LENGTH(@A1)+$LENGTH(K)+2>255!($LENGTH(@A2)+$LENGTH(T)+1>255)
- Begin DoDot:3
- +25 SET @A1=@A1_U
- SET $EXTRACT(@A2,$LENGTH(@A2))=""
- +26 SET A3=A3+1
- SET A1=$NAME(@A1@(A3))
- SET A2=$NAME(@A2@(A3))
- +27 SET (@A1,@A2)=""
- End DoDot:3
- +28 SET @A1=@A1_U_K
- +29 SET @A2=@A2_T_U
- End DoDot:2
- End DoDot:1
- +30 SET @A1=@A1_U
- SET $EXTRACT(@A2,$LENGTH(@A2))=""
- +31 QUIT
- +32 ;
- MAP ;Keys for main screen
- +1 ;;UP;AU
- +2 ;;DN;AD
- +3 ;;RT;AR
- +4 ;;LT;AL
- +5 ;;TAB;$C(9)
- +6 ;;PUP;F1_AU
- +7 ;;PUP;PREVSC
- +8 ;;PDN;F1_AD
- +9 ;;PDN;NEXTSC
- +10 ;;JLT;F1_AL
- +11 ;;JRT;F1_AR
- +12 ;;LB;FIND
- +13 ;;LB;F1_F1_AL
- +14 ;;LE;SELECT
- +15 ;;LE;F1_F1_AR
- +16 ;;TOP;F1_"T"
- +17 ;;BOT;F1_"B"
- +18 ;;WRT;F1_" "
- +19 ;;WRT;$C(12)
- +20 ;;WLT;$C(10)
- +21 ;;RUB;$C(127)
- +22 ;;RUB;$C(8)
- +23 ;;DEL;REMOVE
- +24 ;;DEL;F4
- +25 ;;DEOL;F1_F2
- +26 ;;BRK;$C(13)
- +27 ;;JN;F1_"J"
- +28 ;;RFT;F1_"R"
- +29 ;;ST;F1_"?"
- +30 ;;XLN;F1_"D"
- +31 ;;TST;F1_$C(9)
- +32 ;;TSALL;F1_F1_$C(9)
- +33 ;;LST;F1_","
- +34 ;;RST;F1_"."
- +35 ;;WRM;F2
- +36 ;;RPM;INSERT
- +37 ;;RPM;F3
- +38 ;;SV;F1_"S"
- +39 ;;SW;F1_"A"
- +40 ;;EX;F1_"E"
- +41 ;;QT;F1_"Q"
- +42 ;;QT;$C(5)
- +43 ;;HLP;F1_"H"
- +44 ;;DLW;$C(23)
- +45 ;;MRK;F1_"M"
- +46 ;;UMK;F1_F1_"M"
- +47 ;;CUT;F1_"X"
- +48 ;;CPY;F1_"C"
- +49 ;;PST;F1_"V"
- +50 ;;FND;F1_"F"
- +51 ;;NXT;F1_"N"
- +52 ;;GTO;F1_"G"
- +53 ;;CHG;F1_"P"
- +54 ;;AUT;F1_F1_"S"
- +55 ;;';$C(27)_"Q"
- +56 ;;';$C(27)_"R"
- +57 ;;";$C(27)_"S"
- +58 ;;";$C(27)_"T"
- +59 ;;
