Return to DIR0.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIR0.m, revision 1.1.1.1

1.1       snw         1: DIR0   ;SFISC/MKO-FIELD EDITOR ;02:41 PM  12 Oct 1994
                      2:        ;;21.0;VA FileMan;;Dec 28, 1994
                      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:        W:$D(DTOUT) $C(7)
                     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,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:        ;
                     66:        S (DIR0A,DIR0D)=$G(DIR0A)
                     67:        S:'$G(DIR0R) DIR0R=0
                     68:        S:'$G(DIR0S) DIR0S=0
                     69:        S:'$G(DIR0L) DIR0L=IOM-1-DIR0S
                     70:        S:'$G(DIR0M) DIR0M=245
                     71:        S:'$G(DIR0FLG)["r" DIR0RJ=1
                     72:        ;
                     73:        I $G(DIR0NL)>1 D
                     74:        . D EN^DIR02,END
                     75:        E  D INIT,^DIR01,END,PAINT
                     76:        ;
                     77:        S X=DIR0A
                     78:        I $D(DTOUT) K DTOUT S:Y="" Y="TO"
                     79:        S $P(Y,U,2)=+$G(DIR0CHG)
                     80:        D KILL^DDGLIB0($G(DIR0FLG))
                     81:        K DIR0("CIN"),DIR0("COUT")
                     82:        Q
                     83:        ;
                     84: INIT   ;
                     85:        K DTOUT
                     86:        X DDGLZOSF("EOFF"),DDGLZOSF("TRMON")
                     87:        S DIR0SV=$G(DIR0("L"))
                     88:        S:'$G(DIR0C) DIR0C=1
                     89:        S (DIR0QT,DIR0QU)=0,DY=DIR0R,DX=DIR0S,DIR0F=DIR0S+DIR0L
                     90:        ;
                     91:        X IOXY
                     92:        S DIR0SP=$J("",DIR0L) S:$G(DDGLVAN) DIR0SP=$TR(DIR0SP," ","_")
                     93:        I DIR0C-1>DIR0L D
                     94:        . W $S('$D(DDGLVAN):$P(DDGLVID,DDGLDEL,6),1:"")_$E(DIR0A,DIR0C-DIR0L,DIR0C-1)
                     95:        . S DX=DIR0F
                     96:        E  D
                     97:        . W $S('$D(DDGLVAN):$P(DDGLVID,DDGLDEL,6),1:"")_$E(DIR0A,1,DIR0L)_$E(DIR0SP,$L(DIR0A)+1,999)
                     98:        . S DX=DIR0S+DIR0C-1
                     99:        . X IOXY
                    100:        Q
                    101:        ;
                    102: END    ;
                    103:        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))
                    104:        S:Y="" Y=$P($G(DIR0QT),U,2)
                    105:        N X,Y S DIR0SP=$TR(DIR0SP,"_"," ")
                    106:        Q
                    107:        ;
                    108: PAINT  ;
                    109:        N DIR0X
                    110:        I $G(DIR0FLG)["P" W $P(DDGLVID,DDGLDEL,10) Q
                    111:        I '$G(DIR0RJ) S DIR0X=$E(DIR0A,1,DIR0L)_$E(DIR0SP,$L(DIR0A)+1,999)
                    112:        E  S DIR0X=$E(DIR0SP,$L(DIR0A)+1,999)_$E(DIR0A,1,DIR0L)
                    113:        S DX=DIR0S X IOXY
                    114:        W $P(DDGLVID,DDGLDEL,10)_$P(DDGLVID,DDGLDEL)_DIR0X_$P(DDGLVID,DDGLDEL,10)
                    115:        Q
                    116:        ;
                    117: UPDATE(DIR0NA,DIR0NC)  ;Update ans/curs pos
                    118:        N DIR0STR,DIR0X
                    119:        S:$D(DIR0NA)[0 DIR0NA=DIR0A
                    120:        S:$D(DIR0NC)[0 DIR0NC=DIR0C
                    121:        S:DIR0NC<1 DIR0NC=1
                    122:        S:DIR0NC-1>$L(DIR0NA) DIR0NC=$L(DIR0NA)+1
                    123:        S DIR0X=DX+DIR0NC-DIR0C
                    124:        ;
                    125:        I DIR0A=DIR0NA,DIR0X'<DIR0S,DIR0X'>DIR0F D
                    126:        . S DX=DIR0X X IOXY
                    127:        E  D
                    128:        . S DIR0X=DIR0NC-DIR0L S:DIR0X<1 DIR0X=1
                    129:        . S DX=DIR0S X IOXY
                    130:        . S DIR0STR=$E(DIR0NA,DIR0X,DIR0X+DIR0L-1)
                    131:        . W DIR0STR_$E(DIR0SP,$L(DIR0STR)+1,999)
                    132:        . S DX=DIR0S+DIR0NC-DIR0X X IOXY
                    133:        ;
                    134:        S DIR0A=DIR0NA,DIR0C=DIR0NC
                    135:        Q
                    136:        ;
                    137: KILL   ;
                    138:        D KILL^DDGLIB0()
                    139:        Q
                    140:        ;
                    141:        ;#8074  Press <PF1>H for help
                    142:        ;#7002  Insert^Replace