source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDGFHBK.m@ 1736

Last change on this file since 1736 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
RevLine 
[613]1DDGFHBK ;SFISC/MKO-ADD, EDIT, DELETE HEADER BLOCK ;01:48 PM 22 Nov 1994
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5ADD ;Add a header block
6 ;Check to see if a header block already exists for this page
7 S DDGFBH=$P(^DIST(.403,+DDGFFM,40,DDGFPG,0),U,2)
8 I DDGFBH D MSG^DDGF($C(7)_"This page already has a header block.") H 2 D MSG^DDGF() K DDGFBH Q
9 ;
10 N B
11 S DDGFDY=DY,DDGFDX=DX
12 ;
13 ;Invoke form to enter block name
14 K DDGFBNUM,DDGFBNAM
15 D DDS(.404,"[DDGF HEADER BLOCK SELECT]")
16 G:$G(DDGFBNUM)=DDGFBH!'$G(DDGFBNUM) ADDQ
17 ;
18 I $D(^DIST(.403,+DDGFFM,40,DDGFPG,40,"B",DDGFBNUM)) D DDS(.404,"[DDGF BLOCK ADD]","",21) G ADDQ
19 ;
20 S $P(^DIST(.403,+DDGFFM,40,DDGFPG,0),U,2)=DDGFBNUM
21 ;
22 ;If this looks like a brand new block, stuff in DD number
23 I $L(^DIST(.404,DDGFBNUM,0),U)=1,'$O(^(0)) D
24 . S DIE="^DIST(.404,",DA=DDGFBNUM
25 . S DR="1////"_$P(^DIST(.403,+DDGFFM,0),U,8)
26 . D ^DIE K DIE,DA,DR
27 ;
28 D:DDGFBH DELETE^DDGFBK(DDGFBH,1)
29 D BK^DDGFLOAD(DDGFPG,DDGFBNUM,$P(DDGFLIM,U),$P(DDGFLIM,U,2),0,0,1,1)
30 ;
31 S DY=DDGFDY,DX=DDGFDX
32 S B=DDGFBNUM,C=$P(@DDGFREF@("F",DDGFPG,B),U,4)
33 S DDGFADD=1
34 K DDGFBNUM,DDGFBNAM
35 G EDIT
36 ;
37ADDQ ;Abort adding a header block
38 D REFRESH^DDGF,RC(DDGFDY,DDGFDX)
39 K DDGFANS,DDGFBH,DDGFBNUM,DDGFBNAM,DDGFDY,DDGFDX
40 Q
41 ;
42EDIT ;Edit/Delete header block
43 ;In: B,C
44 N C1,C2,C3
45 S DDGFDY=DY,DDGFDX=DX,DDGFBH=B
46 S (DDGFBKNN,DDGFBKNO)=C
47 S DDSFILE=.403,DDSFILE(1)=.4031,DA(1)=+DDGFFM,DA=DDGFPG
48 S DR="[DDGF HEADER BLOCK EDIT]",DDSPARM="KTW"
49 D ^DDS K DDSFILE,DA,DR,DDSPARM
50 S DDGFBHN=$P(^DIST(.403,+DDGFFM,40,DDGFPG,0),U,2)
51 ;
52 I DDGFBHN'=DDGFBH D
53 . D DELETE^DDGFBK(DDGFBH,DDGFBHN)
54 . D:DDGFBHN BK^DDGFLOAD(DDGFPG,DDGFBHN,$P(DDGFLIM,U),$P(DDGFLIM,U,2),0,0,1,1)
55 ;
56 S C=DDGFBKNN,B=DDGFBHN
57 ;
58 ;Update TMP if coordinates or name changed, or new block
59 I DDGFBKNN'=DDGFBKNO!$G(DDGFADD) D
60 . D WRITE^DDGLIBW(DDGFWIDB,$J("",$L(DDGFBKNO)),$P(DDGFLIM,U),$P(DDGFLIM,U,2),"",1)
61 . D WRITE^DDGLIBW(DDGFWIDB,C,$P(DDGFLIM,U),$P(DDGFLIM,U,2),"",1)
62 ;
63 D REFRESH^DDGF,RC(DDGFDY,DDGFDX)
64 S:'$G(DDGFADD) DDGFE=1
65 K DDGFADD,DDGFBH,DDGFBHN,DDGFBKNN,DDGFBKNO,DDGFDY,DDGFDX
66 Q
67 ;
68DDS(DDSFILE,DR,DA,DDSPAGE) ;
69 ;Call DDS
70 S DDSPARM="KTW" D ^DDS K DDSPARM
71 Q
72 ;
73RC(DDGFY,DDGFX) ;Update status line, reset DX and DY, move cursor
74 N S
75 I DDGFR D
76 . S DY=IOSL-6,DX=IOM-9,S="R"_(DDGFY+1)_",C"_(DDGFX+1)
77 . X IOXY W S_$J("",7-$L(S))
78 S DY=DDGFY,DX=DDGFX X IOXY
79 Q
Note: See TracBrowser for help on using the repository browser.