File:  [Coherent Logic Development] / freem_fileman / USER / DDGF3.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: DDGF3	;SFISC/MKO-Block Viewer Page ;02:49 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: 	;Variables used:
    5: 	;  DDGFBV      = flag indicating we're on block viewer page
    6: 	;  DDGFORIG(B) = original $Y^original $X for all blocks that were
    7: 	;                  selected, since they were potentially moved
    8: 	;  DDGFEBV     = flag that can be set to exit block viewer page
    9: 	;                  after a block has been selected
   10: 	;
   11: 	N DDGFE
   12: 	S DDGFE=0,DDGFBV=1 K DDGFORIG,DDGFEBV
   13: 	;
   14: 	D PAINT,RC(DY,DX)
   15: 	F  S Y=$$READ W:$T(@Y)="" $C(7) D:$T(@Y)]"" @Y D:$D(DDGFMSG) MSG^DDGF() Q:DDGFE!$G(DDGFEBV)
   16: 	D CLEANUP
   17: 	Q
   18: 	;
   19: LNU	I DY>$P(DDGFLIM,U) D RC(DY-1,DX)
   20: 	Q
   21: LND	I DY<$P(DDGFLIM,U,3) D RC(DY+1,DX)
   22: 	Q
   23: CHR	I DX<$P(DDGFLIM,U,4) D RC(DY,DX+1)
   24: 	Q
   25: CHL	I DX>$P(DDGFLIM,U,2) D RC(DY,DX-1)
   26: 	Q
   27: ELR	N Y,X
   28: 	S Y=DY,X=DX
   29: 	F  D  Q:Y=""!(X]"")
   30: 	. S X=$O(@DDGFREF@("BKRC",DDGFWIDB,Y,X))
   31: 	. S:X="" Y=$O(@DDGFREF@("BKRC",DDGFWIDB,Y))
   32: 	D:X]"" RC(Y,X)
   33: 	Q
   34: ELL	N Y,X
   35: 	S Y=DY,X=DX
   36: 	F  D  Q:Y=""!(X]"")
   37: 	. S X=$O(@DDGFREF@("BKRC",DDGFWIDB,Y,X),-1)
   38: 	. S:X="" Y=$O(@DDGFREF@("BKRC",DDGFWIDB,Y),-1)
   39: 	D:X]"" RC(Y,X)
   40: 	Q
   41: TBR	I DX<$P(DDGFLIM,U,4) D
   42: 	. D RC(DY,$S(DX+5'<$P(DDGFLIM,U,4):$P(DDGFLIM,U,4),1:DX+5))
   43: 	E  I DY<$P(DDGFLIM,U,3) D RC(DY+1,$P(DDGFLIM,U,2))
   44: 	Q
   45: TBL	I DX>$P(DDGFLIM,U,2) D
   46: 	. D RC(DY,$S(DX-5'>$P(DDGFLIM,U,2):$P(DDGFLIM,U,2),1:DX-5))
   47: 	E  I DY>$P(DDGFLIM,U) D RC(DY-1,$P(DDGFLIM,U,4))
   48: 	Q
   49: 	;
   50: SCT	I DY>$P(DDGFLIM,U) D RC($P(DDGFLIM,U),DX)
   51: 	Q
   52: SCB	I DY<$P(DDGFLIM,U,3) D RC($P(DDGFLIM,U,3),DX)
   53: 	Q
   54: SCR	I DX<$P(DDGFLIM,U,4) D RC(DY,$P(DDGFLIM,U,4))
   55: 	Q
   56: SCL	I DX>$P(DDGFLIM,U,2) D RC(DY,$P(DDGFLIM,U,2))
   57: 	Q
   58: SELECT	;
   59: 	Q:'$D(@DDGFREF@("BKRC",DDGFWIDB,DY))
   60: 	G SELECT^DDGFBSEL
   61: 	;
   62: SAVE	;Save data
   63: 	G SAVE^DDGFSV
   64: 	;
   65: BKADD	;Add a new block
   66: 	G ADD^DDGFBK
   67: 	;
   68: HBKADD	;Add a header block
   69: 	G ADD^DDGFHBK
   70: 	;
   71: HELP	;Invoke help screens
   72: 	D ^DDGFH,REFRESH^DDGF,RC(DY,DX)
   73: 	Q
   74: 	;
   75: TO	W $C(7)
   76: QUIT	;
   77: EXIT	;
   78: VIEW	S DDGFE=1
   79: 	Q
   80: CLEANUP	;
   81: 	S DDGFDY=DY,DDGFDX=DX
   82: 	D CLOSE^DDGLIBW(DDGFWIDB,1)
   83: 	I $D(DDGFORIG) D
   84: 	. N A
   85: 	. S A=$$AREA^DDGLIBW(DDGFWID)
   86: 	. D DESTROY^DDGLIBW(DDGFWID,1)
   87: 	. D CREATE^DDGLIBW(DDGFWID,A,$P(@DDGFREF@("F",DDGFPG),U,3)]"")
   88: 	. D BLK^DDGFUPDB(.DDGFORIG)
   89: 	E  D OPEN^DDGLIBW(DDGFWID)
   90: 	S DY=IOSL-6,DX=46 X IOXY W $J("",13)
   91: 	S DY=IOSL-1,DX=0 X IOXY W $P(DDGLCLR,DDGLDEL)_$P(DDGLVID,DDGLDEL)_"<PF1>Q=Quit  <PF1>E=Exit  <PF1>S=Save  <PF1>V=Block Viewer  <PF1>H=Help"_$P(DDGLVID,DDGLDEL,10)
   92: 	D RC(DDGFDY,DDGFDX)
   93: 	K DDGFDY,DDGFDX,DDGFBV,DDGFEBV,DDGFORIG
   94: 	Q
   95: 	;
   96: PAINT	;Paint block displayer window
   97: 	N B,C,S,DY,DX
   98: 	D CLOSE^DDGLIBW(DDGFWID,1)
   99: 	S DY=IOSL-6,DX=46 X IOXY W "BLOCK VIEWER"
  100: 	S DY=IOSL-1,DX=0 X IOXY W $P(DDGLCLR,DDGLDEL)_$P(DDGLVID,DDGLDEL)_"<PF1>V=Main Screen  <PF1>H=Help"_$P(DDGLVID,DDGLDEL,10)
  101: 	I $$EXIST^DDGLIBW(DDGFWIDB) D FOCUS^DDGLIBW(DDGFWIDB) Q
  102: 	D CREATE^DDGLIBW(DDGFWIDB,$P(DDGFLIM,U,1,2)_U_($P(DDGFLIM,U,3)-$P(DDGFLIM,U,1)+1)_U_($P(DDGFLIM,U,4)-$P(DDGFLIM,U,2)+1),$P(@DDGFREF@("F",DDGFPG),U,3)]"")
  103: 	S B="" F  S B=$O(@DDGFREF@("F",DDGFPG,B)) Q:B=""  D
  104: 	. S C=@DDGFREF@("F",DDGFPG,B)
  105: 	. S S=$P(C,U,4)
  106: 	. S:$P(C,U,3)'<IOM S=$E(S,1,IOM-$P(C,U,2)-1)
  107: 	. D WRITE^DDGLIBW(DDGFWIDB,S,$P(C,U)-$P(DDGFLIM,U),$P(C,U,2)-$P(DDGFLIM,U,2))
  108: 	Q
  109: 	;
  110: RC(DDGFY,DDGFX)	;Update status line, reset DX and DY, move cursor
  111: 	N S
  112: 	I DDGFR D
  113: 	. S DY=IOSL-6,DX=IOM-9,S="R"_(DDGFY+1)_",C"_(DDGFX+1)
  114: 	. X IOXY W S_$J("",7-$L(S))
  115: 	S DY=DDGFY,DX=DDGFX X IOXY
  116: 	Q
  117: 	;
  118: READ()	N S,Y
  119: 	F  R *Y:DTIME D C Q:Y'=-1
  120: 	Q Y
  121: 	;
  122: C	I Y<0 S Y="TO" Q
  123: 	S S=""
  124: C1	S S=S_$C(Y)
  125: 	I DDGF("IN")'[(U_S) D  I Y=-1 W $C(7) Q
  126: 	. I $C(Y)'?1L S Y=-1 Q
  127: 	. S S=$E(S,1,$L(S)-1)_$C(Y-32) S:DDGF("IN")'[(U_S_U) Y=-1
  128: 	;
  129: 	I DDGF("IN")[(U_S_U),S'=$C(27) S Y=$P(DDGF("OUT"),U,$L($P(DDGF("IN"),U_S_U),U)) Q
  130: 	R *Y:5 G:Y'=-1 C1 W $C(7)
  131: 	Q

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