source: FOIAVistA/tag/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDGF3.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1DDGF3 ;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 ;
19LNU I DY>$P(DDGFLIM,U) D RC(DY-1,DX)
20 Q
21LND I DY<$P(DDGFLIM,U,3) D RC(DY+1,DX)
22 Q
23CHR I DX<$P(DDGFLIM,U,4) D RC(DY,DX+1)
24 Q
25CHL I DX>$P(DDGFLIM,U,2) D RC(DY,DX-1)
26 Q
27ELR 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
34ELL 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
41TBR 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
45TBL 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 ;
50SCT I DY>$P(DDGFLIM,U) D RC($P(DDGFLIM,U),DX)
51 Q
52SCB I DY<$P(DDGFLIM,U,3) D RC($P(DDGFLIM,U,3),DX)
53 Q
54SCR I DX<$P(DDGFLIM,U,4) D RC(DY,$P(DDGFLIM,U,4))
55 Q
56SCL I DX>$P(DDGFLIM,U,2) D RC(DY,$P(DDGFLIM,U,2))
57 Q
58SELECT ;
59 Q:'$D(@DDGFREF@("BKRC",DDGFWIDB,DY))
60 G SELECT^DDGFBSEL
61 ;
62SAVE ;Save data
63 G SAVE^DDGFSV
64 ;
65BKADD ;Add a new block
66 G ADD^DDGFBK
67 ;
68HBKADD ;Add a header block
69 G ADD^DDGFHBK
70 ;
71HELP ;Invoke help screens
72 D ^DDGFH,REFRESH^DDGF,RC(DY,DX)
73 Q
74 ;
75TO W $C(7)
76QUIT ;
77EXIT ;
78VIEW S DDGFE=1
79 Q
80CLEANUP ;
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 ;
96PAINT ;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 ;
110RC(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 ;
118READ() N S,Y
119 F R *Y:DTIME D C Q:Y'=-1
120 Q Y
121 ;
122C I Y<0 S Y="TO" Q
123 S S=""
124C1 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
Note: See TracBrowser for help on using the repository browser.