Return to DDGF3.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDGF3.m, revision 1.1.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