Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DDGFBK

DDGFBK.m

Go to the documentation of this file. 
  1. DDGFBK ;SFISC/MKO-ADD, EDIT, DELETE BLOCK ;2:11 PM  13 Sep 1995
  1.  ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1.  ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1.  ;;Licensed under the terms of the Apache License, Version 2.0.
  1.  ;
  1. ADD ;Add a new block
  1.  N B,C1,C2,C3
  1.  S DDGFDY=DY,DDGFDX=DX
  1.  ;
  1.  ;Invoke form to enter block name
  1.  K DDGFBNUM,DDGFBNAM
  1.  D DDS(.404,"[DDGF BLOCK ADD]")
  1.  G:'$D(DDGFBNUM) ADDQ
  1.  ;
  1.  ;Ask whether block should be added or indicate duplicate block
  1.  K DDGFANS
  1.  S DDSPAGE=$S($P(^DIST(.403,+DDGFFM,40,DDGFPG,0),U,2)=DDGFBNUM!$D(^(40,"B",DDGFBNUM)):21,1:11)
  1.  D DDS(.404,"[DDGF BLOCK ADD]","",DDSPAGE)
  1.  G:DDSPAGE=21 ADDQ
  1.  I '$G(DDGFANS) D  G ADDQ
  1.  . I $D(^DIST(.404,DDGFBNUM,0))#2,'$P(^(0),U,2) D
  1.  .. N DIK,DA
  1.  .. S DIK="^DIST(.404,",DA=DDGFBNUM
  1.  .. D ^DIK
  1.  K DDSPAGE,DDGFANS
  1.  ;
  1.  ;Add block to page
  1.  S DIC="^DIST(.403,+DDGFFM,40,DDGFPG,40,",DIC(0)="L"
  1.  S DA(2)=+DDGFFM,DA(1)=DDGFPG
  1.  S DIC("P")=$P(^DD(.4031,40,0),U,2)
  1.  S (DINUM,X)=DDGFBNUM
  1.  K DO,DD D FILE^DICN K DINUM,X
  1.  G:Y=-1 ADDQ
  1.  ;
  1.  ;Stuff in values for block order, coordinates, and type
  1.  S DIE=DIC,DA=+Y
  1.  S DDGFC=DDGFDY-$P(DDGFLIM,U)+1_","_(DDGFDX-$P(DDGFLIM,U,2)+1)
  1.  S DR="1////"_($O(^DIST(.403,+DDGFFM,40,DDGFPG,40,"AC",""),-1)+1\1)_";2////"_DDGFC_";3////e"
  1.  D ^DIE K DA,DIC,DIE,DR,X,Y,DDGFC
  1.  ;
  1.  ;If this looks like a brand new block, stuff in DD number
  1.  I $L(^DIST(.404,DDGFBNUM,0),U)=1,'$O(^(0)) D
  1.  . S DIE="^DIST(.404,",DA=DDGFBNUM
  1.  . S DR="1////"_$P(^DIST(.403,+DDGFFM,0),U,8)
  1.  . D ^DIE K DA,DIE,DR
  1.  ;
  1.  D BK^DDGFLOAD(DDGFPG,DDGFBNUM,$P(DDGFLIM,U),$P(DDGFLIM,U,2),DDGFDY,DDGFDX,0,1)
  1.  ;
  1.  S DY=DDGFDY,DX=DDGFDX
  1.  S B=DDGFBNUM,C=$P(@DDGFREF@("F",DDGFPG,B),U,4)
  1.  S C1=DY,C2=DX,C3=C2+$L(DDGFBNAM)-1
  1.  S DDGFADD=1
  1.  K DDGFBNUM,DDGFBNAM
  1.  S:$G(DDGFBV) DDGFORIG(B)=DY_U_DX
  1.  G EDIT
  1.  ;
  1. ADDQ ;Adding aborted
  1.  D REFRESH^DDGF,RC(DDGFDY,DDGFDX)
  1.  K DDGFANS,DDGFBNAM,DDGFBNUM,DDGFDX,DDGFDY,DDSPAGE,DA,DIC,Y
  1.  Q
  1.  ;
  1. EDIT ;Edit block
  1.  ;In: B,C1,C2,C3,C
  1.  S DDGFDY=DY,DDGFDX=DX
  1.  S DDGFBK=B,DDGFC1=C1,DDGFC2=C2,DDGFC3=C3
  1.  S DDGFBKCO=C1-$P(DDGFLIM,U)+1_","_(C2-$P(DDGFLIM,U,2)+1)
  1.  S DDGFBKNO=C
  1.  ;
  1.  ;Invoke form to edit block
  1.  S DDSFILE=.403,DDSFILE(1)=.4032
  1.  S DA(2)=+DDGFFM,DA(1)=DDGFPG,DA=B
  1.  S DR="[DDGF BLOCK EDIT]",DDSPARM="KTW"
  1.  D ^DDS K DDSFILE,DA,DR,DDSPARM
  1.  ;
  1.  ;If block was deleted, remove data from DDGFREF
  1.  I $D(^DIST(.403,+DDGFFM,40,DDGFPG,40,DDGFBK,0))[0 D DELETE(DDGFBK) G EDITQ
  1.  ;
  1.  S:$D(DDGFBKCN)[0 DDGFBKCN=DDGFBKCO
  1.  S:$D(DDGFBKNN)[0 DDGFBKNN=DDGFBKNO
  1.  ;
  1.  S C=DDGFBKNN
  1.  S C1=$P(DDGFBKCN,",")-1+$P(DDGFLIM,U)
  1.  S C2=$P(DDGFBKCN,",",2)-1+$P(DDGFLIM,U,2)
  1.  S C3=C2+$L(C)-1
  1.  ;
  1.  ;Update TMP if coordinates or name changed, or new block
  1.  I DDGFBKCN'=DDGFBKCO!(DDGFBKNN'=DDGFBKNO)!$G(DDGFADD) D
  1.  . D WRITE^DDGLIBW(DDGFWIDB,$J("",$L(DDGFBKNO)),DDGFC1-$P(DDGFLIM,U),DDGFC2-$P(DDGFLIM,U,2),"",1)
  1.  . D WRITE^DDGLIBW(DDGFWIDB,C,C1-$P(DDGFLIM,U),C2-$P(DDGFLIM,U,2),"",1)
  1.  ;
  1. EDITQ D REFRESH^DDGF,RC(DDGFDY,DDGFDX)
  1.  S:'$G(DDGFADD) DDGFE=1
  1.  K DDGFADD,DDGFBK,DDGFBKCO,DDGFBKNO,DDGFBKCN,DDGFBKNN
  1.  K DDGFC1,DDGFC2,DDGFC3,DDGFDX,DDGFDY
  1.  Q
  1.  ;
  1. DELETE(B,E) ;Remove block from DDGFREF
  1.  ;E : means don't set DDGFEBV or DDGFBDEL
  1.  ;    (used by EDIT^DDGFHBK when a different header block is chosen)
  1.  N F,N
  1.  ;Remove from TMP
  1.  S F="" F  S F=$O(@DDGFREF@("F",DDGFPG,B,F)) Q:F=""  D
  1.  . S N=@DDGFREF@("F",DDGFPG,B,F)
  1.  . K:$P(N,U,4)]"" @DDGFREF@("RC",DDGFWID,$P(N,U),$P(N,U,2),$P(N,U,3),B)
  1.  . K:$P(N,U,8)>0 @DDGFREF@("RC",DDGFWID,$P(N,U,5),$P(N,U,6),$P(N,U,7),B)
  1.  K @DDGFREF@("F",DDGFPG,B)
  1.  ;
  1.  ;If no blocks on page, set DDGFEBV to exit Block Viewer
  1.  ;DDGFBDEL indicates block name should not be painted
  1.  I $G(DDGFBV) D:'$G(E)
  1.  . I '$P(^DIST(.403,+DDGFFM,40,DDGFPG,0),U,2),'$O(^(40,0)) S DDGFEBV=1
  1.  . S DDGFBDEL=1
  1.  E  D PG^DDGFLOAD(+DDGFFM,+DDGFPG,1,1)
  1.  ;
  1.  ;If used on no other forms, ask whether to delete from block file
  1.  I '$O(^DIST(.403,"AB",B,"")),'$O(^DIST(.403,"AC",B,"")) D
  1.  . K DDGFANS S DDGFBK=B
  1.  . D DDS(.404,"[DDGF BLOCK DELETE]")
  1.  . I $G(DDGFANS) S DIK="^DIST(.404,",DA=DDGFBK D ^DIK K DIK,DA
  1.  . K DDGFANS,DDGFBK
  1.  Q
  1.  ;
  1. DDS(DDSFILE,DR,DA,DDSPAGE) ;
  1.  ;Call DDS
  1.  S DDSPARM="KTW" D ^DDS K DDSPARM
  1.  Q
  1.  ;
  1. RC(DDGFY,DDGFX) ;Update status line, reset DX and DY, move cursor
  1.  N S
  1.  I DDGFR D
  1.  . S DY=IOSL-6,DX=IOM-9,S="R"_(DDGFY+1)_",C"_(DDGFX+1)
  1.  . X IOXY W S_$J("",7-$L(S))
  1.  S DY=DDGFY,DX=DDGFX X IOXY
  1.  Q