DDWK ;SFISC/MKO-SCREEN EDITOR MAIN ROUTINE ;11:32 AM 25 Aug 2000
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
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"
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDWK 2163 printed Nov 22, 2024@17:54:01 Page 2
DDWK ;SFISC/MKO-SCREEN EDITOR MAIN ROUTINE ;11:32 AM 25 Aug 2000
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
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 ;;
