Return to DDGFBK.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DDGFBK	;SFISC/MKO-ADD, EDIT, DELETE BLOCK ;01:47 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 new block
    6: 	N B,C1,C2,C3
    7: 	S DDGFDY=DY,DDGFDX=DX
    8: 	;
    9: 	;Invoke form to enter block name
   10: 	K DDGFBNUM,DDGFBNAM
   11: 	D DDS(.404,"[DDGF BLOCK ADD]")
   12: 	G:'$D(DDGFBNUM) ADDQ
   13: 	;
   14: 	;Ask whether block should be added or indicate duplicate block
   15: 	K DDGFANS
   16: 	S DDSPAGE=$S($P(^DIST(.403,+DDGFFM,40,DDGFPG,0),U,2)=DDGFBNUM!$D(^(40,"B",DDGFBNUM)):21,1:11)
   17: 	D DDS(.404,"[DDGF BLOCK ADD]","",DDSPAGE)
   18: 	G:DDSPAGE=21!'$G(DDGFANS) ADDQ
   19: 	K DDSPAGE,DDGFANS
   20: 	;
   21: 	;Add block to page
   22: 	S DIC="^DIST(.403,+DDGFFM,40,DDGFPG,40,",DIC(0)="L"
   23: 	S DA(2)=+DDGFFM,DA(1)=DDGFPG
   24: 	S DIC("P")=$P(^DD(.4031,40,0),U,2)
   25: 	S (DINUM,X)=DDGFBNUM
   26: 	D FILE^DICN K DINUM,X
   27: 	G:Y=-1 ADDQ
   28: 	;
   29: 	;Stuff in values for block order, coordinates, and type
   30: 	S DIE=DIC,DA=+Y
   31: 	S DDGFC=DDGFDY-$P(DDGFLIM,U)+1_","_(DDGFDX-$P(DDGFLIM,U,2)+1)
   32: 	S DR="1////"_($O(^DIST(.403,+DDGFFM,40,DDGFPG,40,"AC",""),-1)+1\1)_";2////"_DDGFC_";3////e"
   33: 	D ^DIE K DA,DIC,DIE,DR,X,Y,DDGFC
   34: 	;
   35: 	;If this looks like a brand new block, stuff in DD number
   36: 	I $L(^DIST(.404,DDGFBNUM,0),U)=1,'$O(^(0)) D
   37: 	. S DIE="^DIST(.404,",DA=DDGFBNUM
   38: 	. S DR="1////"_$P(^DIST(.403,+DDGFFM,0),U,8)
   39: 	. D ^DIE K DA,DIE,DR
   40: 	;
   41: 	D BK^DDGFLOAD(DDGFPG,DDGFBNUM,$P(DDGFLIM,U),$P(DDGFLIM,U,2),DDGFDY,DDGFDX,0,1)
   42: 	;
   43: 	S DY=DDGFDY,DX=DDGFDX
   44: 	S B=DDGFBNUM,C=$P(@DDGFREF@("F",DDGFPG,B),U,4)
   45: 	S C1=DY,C2=DX,C3=C2+$L(DDGFBNAM)-1
   46: 	S DDGFADD=1
   47: 	K DDGFBNUM,DDGFBNAM
   48: 	S:$G(DDGFBV) DDGFORIG(B)=DY_U_DX
   49: 	G EDIT
   50: 	;
   51: ADDQ	;Adding aborted
   52: 	D REFRESH^DDGF,RC(DDGFDY,DDGFDX)
   53: 	K DDGFANS,DDGFBNAM,DDGFBNUM,DDGFDX,DDGFDY,DDSPAGE,DA,DIC,Y
   54: 	Q
   55: 	;
   56: EDIT	;Edit block
   57: 	;In: B,C1,C2,C3,C
   58: 	S DDGFDY=DY,DDGFDX=DX
   59: 	S DDGFBK=B,DDGFC1=C1,DDGFC2=C2,DDGFC3=C3
   60: 	S DDGFBKCO=C1-$P(DDGFLIM,U)+1_","_(C2-$P(DDGFLIM,U,2)+1)
   61: 	S DDGFBKNO=C
   62: 	;
   63: 	;Invoke form to edit block
   64: 	S DDSFILE=.403,DDSFILE(1)=.4032
   65: 	S DA(2)=+DDGFFM,DA(1)=DDGFPG,DA=B
   66: 	S DR="[DDGF BLOCK EDIT]",DDSPARM="KTW"
   67: 	D ^DDS K DDSFILE,DA,DR,DDSPARM
   68: 	;
   69: 	;If block was deleted, remove data from DDGFREF
   70: 	I $D(^DIST(.403,+DDGFFM,40,DDGFPG,40,DDGFBK,0))[0 D DELETE(DDGFBK) G EDITQ
   71: 	;
   72: 	S:$D(DDGFBKCN)[0 DDGFBKCN=DDGFBKCO
   73: 	S:$D(DDGFBKNN)[0 DDGFBKNN=DDGFBKNO
   74: 	;
   75: 	S C=DDGFBKNN
   76: 	S C1=$P(DDGFBKCN,",")-1+$P(DDGFLIM,U)
   77: 	S C2=$P(DDGFBKCN,",",2)-1+$P(DDGFLIM,U,2)
   78: 	S C3=C2+$L(C)-1
   79: 	;
   80: 	;Update TMP if coordinates or name changed, or new block
   81: 	I DDGFBKCN'=DDGFBKCO!(DDGFBKNN'=DDGFBKNO)!$G(DDGFADD) D
   82: 	. D WRITE^DDGLIBW(DDGFWIDB,$J("",$L(DDGFBKNO)),DDGFC1-$P(DDGFLIM,U),DDGFC2-$P(DDGFLIM,U,2),"",1)
   83: 	. D WRITE^DDGLIBW(DDGFWIDB,C,C1-$P(DDGFLIM,U),C2-$P(DDGFLIM,U,2),"",1)
   84: 	;
   85: EDITQ	D REFRESH^DDGF,RC(DDGFDY,DDGFDX)
   86: 	S:'$G(DDGFADD) DDGFE=1
   87: 	K DDGFADD,DDGFBK,DDGFBKCO,DDGFBKNO,DDGFBKCN,DDGFBKNN
   88: 	K DDGFC1,DDGFC2,DDGFC3,DDGFDX,DDGFDY
   89: 	Q
   90: 	;
   91: DELETE(B,E)	;Remove block from DDGFREF
   92: 	;E : means don't set DDGFEBV or DDGFBDEL
   93: 	;    (used by EDIT^DDGFHBK when a different header block is chosen)
   94: 	N F,N
   95: 	;Remove from TMP
   96: 	S F="" F  S F=$O(@DDGFREF@("F",DDGFPG,B,F)) Q:F=""  D
   97: 	. S N=@DDGFREF@("F",DDGFPG,B,F)
   98: 	. K:$P(N,U,4)]"" @DDGFREF@("RC",DDGFWID,$P(N,U),$P(N,U,2),$P(N,U,3),B)
   99: 	. K:$P(N,U,8)>0 @DDGFREF@("RC",DDGFWID,$P(N,U,5),$P(N,U,6),$P(N,U,7),B)
  100: 	K @DDGFREF@("F",DDGFPG,B)
  101: 	;
  102: 	;If no blocks on page, set DDGFEBV to exit Block Viewer
  103: 	;DDGFBDEL indicates block name should not be painted
  104: 	I $G(DDGFBV) D:'$G(E)
  105: 	. I '$P(^DIST(.403,+DDGFFM,40,DDGFPG,0),U,2),'$O(^(40,0)) S DDGFEBV=1
  106: 	. S DDGFBDEL=1
  107: 	E  D PG^DDGFLOAD(+DDGFFM,+DDGFPG,1,1)
  108: 	;
  109: 	;If used on no other forms, ask whether to delete from block file
  110: 	I '$O(^DIST(.403,"AB",B,"")),'$O(^DIST(.403,"AC",B,"")) D
  111: 	. K DDGFANS S DDGFBK=B
  112: 	. D DDS(.404,"[DDGF BLOCK DELETE]")
  113: 	. I $G(DDGFANS) S DIK="^DIST(.404,",DA=DDGFBK D ^DIK K DIK,DA
  114: 	. K DDGFANS,DDGFBK
  115: 	Q
  116: 	;
  117: DDS(DDSFILE,DR,DA,DDSPAGE)	;
  118: 	;Call DDS
  119: 	S DDSPARM="KTW" D ^DDS K DDSPARM
  120: 	Q
  121: 	;
  122: RC(DDGFY,DDGFX)	;Update status line, reset DX and DY, move cursor
  123: 	N S
  124: 	I DDGFR D
  125: 	. S DY=IOSL-6,DX=IOM-9,S="R"_(DDGFY+1)_",C"_(DDGFX+1)
  126: 	. X IOXY W S_$J("",7-$L(S))
  127: 	S DY=DDGFY,DX=DDGFX X IOXY
  128: 	Q