| [613] | 1 | DIR0 ;SFISC/MKO-FIELD EDITOR ;11:32 AM 15 Feb 1995
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | SM ;
|
|---|
| 6 | N DIR0A,DIR0C,DIR0CH,DIR0CHG,DIR0D,DIR0F,DIR0L,DIR0M
|
|---|
| 7 | N DIR0P,DIR0QT,DIR0QU,DIR0R,DIR0RJ,DIR0S,DIR0SP,DIR0ST,DIR0SV,DX,DY
|
|---|
| 8 | S DIR0P="" D:$D(DIR0("IN"))[0 GETKEY^DIR0K
|
|---|
| 9 | S:$P(DIR0,U,6) DIR0RJ=1
|
|---|
| 10 | ;
|
|---|
| 11 | I $G(DDSH) D
|
|---|
| 12 | . K DDSH
|
|---|
| 13 | . S DY=IOSL-1,DX=0 X IOXY W $P(DDGLCLR,DDGLDEL)
|
|---|
| 14 | . I DDO,'DDM W "COMMAND:"
|
|---|
| 15 | . S DX=IOM-33 X IOXY W $P(DDGLVID,DDGLDEL,10)_$$EZBLD^DIALOG(8074)
|
|---|
| 16 | . S DX=IOM-8 X IOXY
|
|---|
| 17 | . W $P(DDGLVID,DDGLDEL,6)_$P($$EZBLD^DIALOG(7002),U,$G(DIR0("REP"))>0+1)_$P(DDGLVID,DDGLDEL,10)
|
|---|
| 18 | ;
|
|---|
| 19 | S (DIR0A,DIR0D)=$G(DIR("B"))
|
|---|
| 20 | S DIR0R=$P(DIR0,U),DIR0S=$P(DIR0,U,2),DIR0L=$P(DIR0,U,3),DIR0M=245
|
|---|
| 21 | ;
|
|---|
| 22 | W $P(DDGLVID,DDGLDEL,10)
|
|---|
| 23 | S DY=$P(DIR0,U,4),DX=$P(DIR0,U,5)
|
|---|
| 24 | I $D(DIR("A"))=11 D
|
|---|
| 25 | . N DIX
|
|---|
| 26 | . S DIX="" F S DIX=$O(DIR("A",DIX)) Q:DIX="" D
|
|---|
| 27 | .. X IOXY W DIR("A",DIX)
|
|---|
| 28 | .. S DY=DY+1
|
|---|
| 29 | ;
|
|---|
| 30 | I $D(DIR("A"))#2 D
|
|---|
| 31 | . X IOXY W DIR("A")
|
|---|
| 32 | . I DDO,DY=IOSL-1 W $P(DDGLCLR,DDGLDEL)
|
|---|
| 33 | ;
|
|---|
| 34 | D INIT,^DIR01
|
|---|
| 35 | ;
|
|---|
| 36 | I $D(DTOUT) W $C(7) S DIR0A=DIR0D
|
|---|
| 37 | I DIR0A="@",DIR0D'="@" S DIR0A=""
|
|---|
| 38 | S:DIR0CH="QT" DIR0A=DIR0D
|
|---|
| 39 | S X=DIR0A
|
|---|
| 40 | S:X?1"^".E!(X?1"?".E) DIR0A=DIR0D
|
|---|
| 41 | S DIR0N=X=DIR0D S:DIR0A'=DIR0D DIR0("L")=DIR0A
|
|---|
| 42 | ;
|
|---|
| 43 | D END,PAINT
|
|---|
| 44 | X DDGLZOSF("EON"),DDGLZOSF("TRMOFF")
|
|---|
| 45 | Q
|
|---|
| 46 | ;
|
|---|
| 47 | EN(DIR0R,DIR0S,DIR0L,DIR0NL,DIR0A,DIR0M,DIR0C,DIR0MAP,DIR0FLG,X,Y) ;
|
|---|
| 48 | ;Field editor
|
|---|
| 49 | N DIR0CH,DIR0CHG,DIR0D,DIR0F,DIR0KD,DIR0P,DIR0QT,DIR0QU
|
|---|
| 50 | N DIR0RJ,DIR0SP,DIR0ST,DIR0SV,DIR0TO,DX,DY
|
|---|
| 51 | ;
|
|---|
| 52 | D INIT^DDGLIB0()
|
|---|
| 53 | ;
|
|---|
| 54 | I $D(DIR0MAP)<2 D
|
|---|
| 55 | . S DIR0P="D"
|
|---|
| 56 | . D:$D(DIR0("DIN"))[0 GETKEY^DIR0K
|
|---|
| 57 | E D
|
|---|
| 58 | . S DIR0P="C"
|
|---|
| 59 | . I $O(DIR0MAP(""))!($D(DIR0MAP("IN"))[0) D
|
|---|
| 60 | .. D GETKEY^DIR0K
|
|---|
| 61 | .. K DIR0MAP S DIR0MAP("IN")=DIR0("CIN"),DIR0MAP("OUT")=DIR0("COUT")
|
|---|
| 62 | . E D
|
|---|
| 63 | .. S DIR0("CIN")=$G(DIR0MAP("IN")),DIR0("COUT")=$G(DIR0MAP("OUT"))
|
|---|
| 64 | .. S:DIR0("CIN")[(U_"KD"_U) DIR0KD=$P(DIR0("COUT"),";",$L($P(DIR0("CIN"),U_"KD"_U),U))
|
|---|
| 65 | .. S:DIR0("CIN")[(U_"TO"_U) DIR0TO=$P(DIR0("COUT"),";",$L($P(DIR0("CIN"),U_"TO"_U),U))
|
|---|
| 66 | ;
|
|---|
| 67 | S (DIR0A,DIR0D)=$G(DIR0A)
|
|---|
| 68 | S:'$G(DIR0R) DIR0R=0
|
|---|
| 69 | S:'$G(DIR0S) DIR0S=0
|
|---|
| 70 | S:'$G(DIR0L) DIR0L=IOM-1-DIR0S
|
|---|
| 71 | S:'$G(DIR0M) DIR0M=245
|
|---|
| 72 | S:'$G(DIR0FLG)["r" DIR0RJ=1
|
|---|
| 73 | ;
|
|---|
| 74 | I $G(DIR0NL)>1 D
|
|---|
| 75 | . D EN^DIR02,END
|
|---|
| 76 | E D INIT,^DIR01,END,PAINT
|
|---|
| 77 | ;
|
|---|
| 78 | S X=DIR0A
|
|---|
| 79 | I $D(DTOUT) K DTOUT S:Y="" Y="TO"
|
|---|
| 80 | S $P(Y,U,2)=+$G(DIR0CHG)
|
|---|
| 81 | D KILL^DDGLIB0($G(DIR0FLG))
|
|---|
| 82 | K DIR0("CIN"),DIR0("COUT")
|
|---|
| 83 | Q
|
|---|
| 84 | ;
|
|---|
| 85 | INIT ;
|
|---|
| 86 | K DTOUT
|
|---|
| 87 | X DDGLZOSF("EOFF"),DDGLZOSF("TRMON")
|
|---|
| 88 | S DIR0SV=$G(DIR0("L"))
|
|---|
| 89 | S DIR0C=$S($G(DIR0C)<1:0,1:DIR0C)+1
|
|---|
| 90 | S:DIR0C-1>$L(DIR0A) DIR0C=$L(DIR0A)+1
|
|---|
| 91 | S (DIR0QT,DIR0QU)=0,DY=DIR0R,DX=DIR0S,DIR0F=DIR0S+DIR0L
|
|---|
| 92 | ;
|
|---|
| 93 | X IOXY
|
|---|
| 94 | S DIR0SP=$J("",DIR0L) S:$G(DDGLVAN) DIR0SP=$TR(DIR0SP," ","_")
|
|---|
| 95 | I DIR0C-1>DIR0L D
|
|---|
| 96 | . W $S('$D(DDGLVAN):$P(DDGLVID,DDGLDEL,6),1:"")_$E(DIR0A,DIR0C-DIR0L,DIR0C-1)
|
|---|
| 97 | . S DX=DIR0F
|
|---|
| 98 | E D
|
|---|
| 99 | . W $S('$D(DDGLVAN):$P(DDGLVID,DDGLDEL,6),1:"")_$E(DIR0A,1,DIR0L)_$E(DIR0SP,$L(DIR0A)+1,999)
|
|---|
| 100 | . S DX=DIR0S+DIR0C-1
|
|---|
| 101 | . X IOXY
|
|---|
| 102 | Q
|
|---|
| 103 | ;
|
|---|
| 104 | END ;
|
|---|
| 105 | S Y=$P("U^D^R^L^N^NB^NP^PP^SEL^EX^QT^CL^SV^RF",U,$L($P("^UP^DOWN^TAB^FDL^CR^NB^NP^PP^SEL^EX^QT^CL^SV^RF^",U_DIR0CH_U),U))
|
|---|
| 106 | S:Y="" Y=$P($G(DIR0QT),U,2)
|
|---|
| 107 | N X,Y S DIR0SP=$TR(DIR0SP,"_"," ")
|
|---|
| 108 | S DIR0C=DIR0C-1
|
|---|
| 109 | Q
|
|---|
| 110 | ;
|
|---|
| 111 | PAINT ;
|
|---|
| 112 | N DIR0X
|
|---|
| 113 | I $G(DIR0FLG)["P" W $P(DDGLVID,DDGLDEL,10) Q
|
|---|
| 114 | I '$G(DIR0RJ) S DIR0X=$E(DIR0A,1,DIR0L)_$E(DIR0SP,$L(DIR0A)+1,999)
|
|---|
| 115 | E S DIR0X=$E(DIR0SP,$L(DIR0A)+1,999)_$E(DIR0A,1,DIR0L)
|
|---|
| 116 | S DX=DIR0S X IOXY
|
|---|
| 117 | W $P(DDGLVID,DDGLDEL,10)_$P(DDGLVID,DDGLDEL)_DIR0X_$P(DDGLVID,DDGLDEL,10)
|
|---|
| 118 | Q
|
|---|
| 119 | ;
|
|---|
| 120 | UPDATE(DIR0NA,DIR0NC) ;Update ans/curs pos
|
|---|
| 121 | N DIR0STR,DIR0X
|
|---|
| 122 | S:$D(DIR0NA)[0 DIR0NA=DIR0A
|
|---|
| 123 | S DIR0NC=$S($D(DIR0NC)[0:DIR0C-1,1:DIR0NC)+1
|
|---|
| 124 | S:DIR0NC<1 DIR0NC=1
|
|---|
| 125 | S:DIR0NC-1>$L(DIR0NA) DIR0NC=$L(DIR0NA)+1
|
|---|
| 126 | S DIR0X=DX+DIR0NC-DIR0C
|
|---|
| 127 | ;
|
|---|
| 128 | I DIR0A=DIR0NA,DIR0X'<DIR0S,DIR0X'>DIR0F D
|
|---|
| 129 | . S DX=DIR0X X IOXY
|
|---|
| 130 | E D
|
|---|
| 131 | . S DIR0X=DIR0NC-DIR0L S:DIR0X<1 DIR0X=1
|
|---|
| 132 | . S DX=DIR0S X IOXY
|
|---|
| 133 | . S DIR0STR=$E(DIR0NA,DIR0X,DIR0X+DIR0L-1)
|
|---|
| 134 | . W DIR0STR_$E(DIR0SP,$L(DIR0STR)+1,999)
|
|---|
| 135 | . S DX=DIR0S+DIR0NC-DIR0X X IOXY
|
|---|
| 136 | ;
|
|---|
| 137 | S DIR0A=DIR0NA,DIR0C=DIR0NC
|
|---|
| 138 | Q
|
|---|
| 139 | ;
|
|---|
| 140 | KILL ;
|
|---|
| 141 | D KILL^DDGLIB0()
|
|---|
| 142 | Q
|
|---|
| 143 | ;
|
|---|
| 144 | ;#8074 Press <PF1>H for help
|
|---|
| 145 | ;#7002 Insert^Replace
|
|---|
