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