| 1 | DDGFHBK ;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 | ;
|
|---|
| 5 | ADD ;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 | ;
|
|---|
| 37 | ADDQ ;Abort adding a header block
|
|---|
| 38 | D REFRESH^DDGF,RC(DDGFDY,DDGFDX)
|
|---|
| 39 | K DDGFANS,DDGFBH,DDGFBNUM,DDGFBNAM,DDGFDY,DDGFDX
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | EDIT ;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 | ;
|
|---|
| 68 | DDS(DDSFILE,DR,DA,DDSPAGE) ;
|
|---|
| 69 | ;Call DDS
|
|---|
| 70 | S DDSPARM="KTW" D ^DDS K DDSPARM
|
|---|
| 71 | Q
|
|---|
| 72 | ;
|
|---|
| 73 | RC(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
|
|---|
