| 1 | DDGF3 ;SFISC/MKO-Block Viewer Page ;02:49 PM  12 Oct 1994 | 
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999 | 
|---|
| 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 | 
|---|