File:  [Coherent Logic Development] / freem_fileman / USER / DDSU.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:19 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DDSU	;SFISC/MLH-PROCESS HELP ;02:11 PM  26 Oct 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: LIST	;
    5: 	D FM:'$D(DDS),SC:$D(DDS)
    6: 	Q
    7: 	;
    8: SC	;Screen Help
    9: 	N A0,A1,A2,A3,A4,A5,A6,DDSB1,X,Y
   10: 	K DTOUT,DUOUT
   11: 	;
   12: 	W $P(DDGLVID,DDGLDEL,9) S X=$G(IOM,80)-1 X ^%ZOSF("RM")
   13: 	I $D(DDQ)#2,DDQ>DDSHBX!$D(DDSID) S DY=$P(DDQ,U),DX=$P(DDQ,U,2)
   14: 	E  D CLRMSG^DDS S DY=DDSHBX
   15: 	X DDXY
   16: 	;
   17: 	S:$G(DDD,5)=5 DDD=1
   18: 	S:$D(DDO) DDSB1=DDO
   19: 	S DDM=1,DDO=.5
   20: 	S (A0,DIY,X)="",A1=0,A5=$S(DDD=2:$O(DS(0)),1:$O(DDH(A0)))
   21: 	K A2,DDSQ
   22: 	;
   23: 	F  D SC1 Q:DDO'<1!(X=U)!'A0!DIY!$D(DTOUT)!$D(DUOUT)
   24: 	;
   25: 	I $D(DDSB1) S:DDO<1 DDO=DDSB1
   26: 	E  K DDO
   27: 	;
   28: 	S %=0
   29: 	S DDQ=$S(DY>(IOSL-1):IOSL-1,1:DY)_U_DX
   30: 	S:DDQ>DDSHBX DDM=1
   31: 	I $D(A2) K DDD,DDH,DDQ S %=A2 S:%'=1 DDSQ=1 D CLRMSG^DDS G QQ
   32: 	I $D(DDC),DDC'<0 D SV
   33: 	E  K DDD,DDH S DDSQ=1
   34: 	;
   35: QQ	S X=0 X ^%ZOSF("RM") W $P(DDGLVID,DDGLDEL,8)
   36: 	Q
   37: 	;
   38: SC1	S A6=A0,A0=$O(DDH(A0)) S:A6="" A6=A0-1
   39: 	I 'A0,DDD Q:DDD=1  Q:DD<DS
   40: 	;
   41: 	S A4=$O(DDH(+A0,""))
   42: 	I A4'="X"!(DY'>DDSHBX) S DY=DY+1 X DDXY
   43: 	I A4="E" D SC2 Q
   44: 	;
   45: 	I $Y'<(IOSL-1)!'A0 D SC2 Q:DDO'<1!(X=U)!'A0!DIY!$D(DTOUT)!$D(DUOUT)  S DY=DDSHBX+1,DX=0 X DDXY
   46: 	Q:A4=""
   47: 	;
   48: 	D WR
   49: 	;
   50: 	I $Y'<(IOSL-1),'$D(DTOUT),'$D(DUOUT) D  Q
   51: 	. W ! D SC2
   52: 	. W $P(DDGLVID,DDGLDEL,8) S X=0 X ^%ZOSF("RM") D REFRESH^DDSUTL
   53: 	. W $P(DDGLVID,DDGLDEL,9) S X=$G(IOM,80)-1 X ^%ZOSF("RM")
   54: 	. S DX=0,DY=DDSHBX X DDXY
   55: 	;
   56: 	S DY=$Y,DX=0
   57: 	Q
   58: 	;
   59: SC2	S DX=0,DY=IOSL-1 X DDXY
   60: 	W $S(DDD=1:$$EZBLD^DIALOG(8053),1:$$EZBLD^DIALOG(8081,A5_"-"_A6))_$P(DDGLCLR,DDGLDEL)
   61: 	;
   62: 	R X:DTIME E  S DTOUT=1 K DDC G Q2
   63: 	I X?1."^" S DUOUT=1,X=U K DDC G Q2
   64: 	;
   65: 	I X]"",X<A5!(X>A6) W $C(7) G SC2
   66: 	E  I X S:DDD["J" DDO=$O(DDH(X,"")) K DDC
   67: 	D CLRMSG^DDS
   68: 	S DDM=1
   69: 	;
   70: Q2	S DIY=X,DY=DDSHBX
   71: 	Q
   72: 	;
   73: ASK	W $P(A4,U,2)_$S(%'>2:"? ",1:"")_$S(%>0&(%<3):$P($$EZBLD^DIALOG(7001),U,%)_"// ",1:"")_$P(DDGLCLR,DDGLDEL)
   74: 	S A2=0
   75: 	R X:$G(DTIME,300) E  S DTOUT=1,A2=-1 Q
   76: 	;
   77: 	I %>2 S A2=X Q
   78: 	;
   79: 	N %1 S %1=$$PRS^DIALOGU(7001,X) S:%1>0 X=$E($P(%1,U,2))
   80: 	K %1
   81: 	;
   82: 	I "YyNn^"'[X W $C(7) X DDXY G ASK
   83: 	I X]"","^Nn"[X S A2=2 K DDC Q
   84: 	S:"Yy"[X A2=1
   85: 	S:X=""&(%]"") A2=+%
   86: 	S DDD=1
   87: 	Q
   88: 	;
   89: SV	;Kill DDH array, but save the "ID" nodes and DDH itself
   90: 	K A1,A2
   91: 	S:$D(DDH("ID")) A1=DDH("ID")
   92: 	S:$D(DDH("ID",1)) A2=DDH("ID",1)
   93: 	K DDH S DDH=0
   94: 	S:$D(A1) DDH("ID")=A1
   95: 	S:$D(A2) DDH("ID",1)=A2
   96: 	Q
   97: 	;
   98: FM	;FileMan help - Non screen
   99: 	N A0,A1,A2,A3,A4,DDSDIW,DDSDIY,Y
  100: 	S A0=""
  101: 	F  S A0=$O(DDH(A0)) Q:'A0  S DDSDIW=$X,DDSDIY=$Y D W I $G(DDD)>2,DDSDIW-$X!(DDSDIY-$Y) D STP Q:$D(DTOUT)
  102: 	;
  103: Q	I '$D(DTOUT) D SV S DDH=0
  104: 	E  K DDH K:'DTOUT DTOUT
  105: 	Q
  106: 	;
  107: STP	I DD+DIY'>79 W ?DD S DD=DD+DIY Q
  108: 	;
  109: T	W !?3 S DD=DIY+3
  110: 	I $Y>DIZ!'$Y D
  111: 	. R "'^' TO STOP: ",%Y:$G(DTIME,300)
  112: 	. E  S DTOUT=1 K DDD
  113: 	. W *13,$J("",15),*13 Q:$D(DTOUT)
  114: 	. I %Y[U S DTOUT=0 K DDD
  115: 	. D Y W ?3
  116: 	Q
  117: 	;
  118: W	S A4=$O(DDH(A0,"")) Q:A4=""  Q:DDH(A0,A4)=""
  119: 	W:'$D(DDD) !
  120: 	I $G(DDD)=3,A4["T" K DDD
  121: 	;
  122: WR	I A4["X" D  Q
  123: 	. N DDD,DIY,DDSXEC
  124: 	. S DDSXEC=DDH(A0,A4)
  125: 	. N DDH
  126: 	. I $D(DDS) N DDSID S DDSID=1
  127: 	. X DDSXEC
  128: 	;
  129: 	I A4["Q" D  Q
  130: 	. S A4=DDH(A0,A4),%=$P(A4,U,1)
  131: 	. I $D(DDS) D ASK Q
  132: 	. W $P(A4,U,2)
  133: 	. D YN^DICN
  134: 	;
  135: 	I A4["T" D  Q
  136: 	. I DDH(A0,A4)[$C(0) D
  137: 	.. S DX=$L(DDH(A0,A4),$C(0))-1
  138: 	.. X DDXY
  139: 	.. S DDH(A0,A4)=$TR(DDH(A0,A4),$C(0),"")
  140: 	. W DDH(A0,A4)
  141: 	;
  142: 	I '$D(DDS),DDD'["J",A4'=+A4 Q
  143: 	I $D(DDS),DDD=2!(DDD["J") W A0,?7
  144: 	;
  145: 	W DDH(A0,A4)
  146: 	D:$D(DDH("ID"))
  147: 	. N DDD,DIY,DDSID
  148: 	. S DDSID=DDH("ID")
  149: 	. S:$D(DDH("ID",1))#2 DDSID(1)=DDH("ID",1)
  150: 	. N DDH
  151: 	. S:$D(DDSID(1))#2 DDH("ID",1)=DDSID(1) K DDSID(1)
  152: 	. S Y=A4
  153: 	. X DDSID
  154: 	Q
  155: 	;
  156: Y	D:'$D(DISYS) OS^DII
  157: 	S $X=0,$Y=0
  158: 	S DIZ=$S($D(DILN)&'$D(DIR0):DILN,1:21)
  159: 	Q
  160: 	;
  161: Z	D Y,T
  162: 	Q
  163: 	;
  164: H	S:'$D(A1) A1="T"
  165: 	S DDH=$G(DDH)+1,DDH(DDH,A1)=DST
  166: 	K A1,DST
  167: 	D SC
  168: 	Q
  169: 	;#8053  Press 'RETURN' to continue...
  170: 	;#8081  Choose |from-to| or '^'...
  171: 	;#7001  Yes^No

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>