Annotation of freem_fileman/DIR0.m, revision 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
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DIR0.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman