Return to DDGFHBK.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DDGFHBK	;SFISC/MKO-ADD, EDIT, DELETE HEADER BLOCK ;01:48 PM  22 Nov 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    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