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

DDGFFLDA.m

Go to the documentation of this file. 
  1. DDGFFLDA ;SFISC/MKO-ADD A FIELD ;2:22 PM  13 Sep 1995
  1.  ;;22.0;VA FileMan;;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ADD ;Add a field
  1.  I '$O(^DIST(.403,+DDGFFM,40,DDGFPG,40,0)) D  Q
  1.  . D MSG^DDGF($C(7)_"There are no blocks defined on this page.  To add a block, press <PF2>B.")
  1.  . H 2 D MSG^DDGF()
  1.  S DDGFDY=DY,DDGFDX=DX
  1.  ;
  1.  ;Invoke form to select block, field order, field type
  1.  K DDGFBLCK,DDGFFORD,DDGFTYPE
  1.  S DDSFILE=.404,DDSFILE(1)=.4044
  1.  S DR="[DDGF FIELD ADD]",DDSPARM="KTW"
  1.  D ^DDS K DDSFILE,DA,DR,DDSPARM
  1.  ;
  1.  I '$D(DDGFBLCK)!'$D(DDGFFORD)!'$D(DDGFTYPE) G ADDQ
  1.  ;
  1.  ;Get relative field coordinates
  1.  S (DDGFCAP,DDGFCAP0)=""
  1.  S (DDGFSUP,DDGFSUP0)=""
  1.  S (DDGFCC,DDGFCC0)=""
  1.  ;
  1.  S DDGFB2=@DDGFREF@("F",DDGFPG,DDGFBLCK)
  1.  S DDGFB1=$P(DDGFB2,U),DDGFB2=$P(DDGFB2,U,2)
  1.  ;
  1.  I DDGFTYPE=1 D
  1.  . S DDGFCC0=DDGFDY-DDGFB1+1_","_(DDGFDX-DDGFB2+1)
  1.  E  D
  1.  . S DDGFD1=DDGFDY-DDGFB1+1,DDGFD2=DDGFDX-DDGFB2+1
  1.  . S (DDGFDC,DDGFDC0)=DDGFD1_","_DDGFD2
  1.  . S (DDGFDL,DDGFDL0)=1
  1.  ;
  1.  I DDGFTYPE'=1,DDGFD1<1!(DDGFD2<1) D  G ADDQ
  1.  . D MSG^DDGF($C(7)_"Unable to add a field above or to the left of the block.")
  1.  . H 2 D MSG^DDGF()
  1.  ;
  1.  K DDGFD1,DDGFD2
  1.  ;
  1.  ;Add field order to block file
  1.  S DIC="^DIST(.404,"_DDGFBLCK_",40,",DIC(0)="L"
  1.  S DIC("P")=$P(^DD(.404,40,0),U,2)
  1.  S DA(1)=DDGFBLCK,X=DDGFFORD
  1.  K DD,DO D FILE^DICN
  1.  I Y=-1 K DIC,DA,Y D MSG^DDGF($C(7)_"Unable to add field.") H 2 D MSG^DDGF() G ADDQ
  1.  ;
  1.  ;Stuff values for field type, data coordinate, and data length
  1.  ;If form-only field, also stuff in default read type
  1.  S DIE=DIC,DA(1)=DDGFBLCK,DA=+Y
  1.  S DR="2////"_DDGFTYPE
  1.  S:DDGFTYPE'=1 DR=DR_";4.1////"_DDGFDC_";4.2////1"
  1.  S:DDGFTYPE=2 DR=DR_";20.1////F"
  1.  D ^DIE K DIC,DIE,DR,Y
  1.  ;
  1.  ;Invoke appropriate form
  1.  S DDSFILE=.404,DDSFILE(1)=.4044,DDSPARM="CKTW"
  1.  S DDGFDD=$P(^DIST(.404,DDGFBLCK,0),U,2)
  1.  S DR="[DDGF FIELD "_$P("CAPTION ONLY^FORM ONLY^DD^COMPUTED",U,DDGFTYPE)_"]"
  1.  D ^DDS K DDSFILE,DR,DDSPARM,DDGFDD
  1.  ;
  1.  I $D(DA)#2,DDGFTYPE'=1,$G(DDSCHANG)'=1 D
  1.  . S DIK="^DIST(.404,"_DA(1)_",40,"
  1.  . D ^DIK K DIK
  1.  E  I $D(DA)#2 D
  1.  . D SAVE
  1.  . D LOADF
  1.  ;
  1. ADDQ ;Refresh and cleanup
  1.  D REFRESH^DDGF
  1.  D RC(DDGFDY,DDGFDX)
  1.  ;
  1.  K DA,DDSCHANG
  1.  K DDGFB1,DDGFB2,DDGFD1,DDGFD2
  1.  K DDGFSUP,DDGFSUP0,DDGFCAP,DDGFCAP0,DDGFCC,DDGFCC0
  1.  K DDGFDL,DDGFDL0,DDGFDC,DDGFDC0
  1.  K DDGFDY,DDGFDX,DDGFBLCK,DDGFFORD,DDGFTYPE
  1.  Q
  1.  ;
  1. SAVE ;Save changes to caption, coordinates, data length, and suppress
  1.  ;colon flag
  1.  S:DDGFCAP="" (DDGFSUP,DDGFCC)=""
  1.  S DR=""
  1.  ;
  1.  S:DDGFCAP]"" DR=DR_"1////"_DDGFCAP_";"
  1.  S:DDGFCC]"" DR=DR_"5.1////"_DDGFCC_";"
  1.  S:DDGFSUP DR=DR_"5.2////1;"
  1.  ;
  1.  I DDGFTYPE'=1 D
  1.  . S:DDGFDC'=DDGFDC0 DR=DR_"4.1////"_DDGFDC_";"
  1.  . S:DDGFDL'=DDGFDL0 DR=DR_"4.2////"_DDGFDL_";"
  1.  I DR="" K DR Q
  1.  ;
  1.  S DIE="^DIST(.404,"_DA(1)_",40,"
  1.  S DR=$E(DR,1,$L(DR)-1)
  1.  D ^DIE K DIE,DR,Y
  1.  Q
  1.  ;
  1. LOADF ;Set DDGFREF and window buffer
  1.  N C,C1,C2,C3,D,D1,D2,D3,L
  1.  ;
  1.  I DDGFCAP="" D
  1.  . S (C,C1,C2,C3)=""
  1.  . K @DDGFREF@("F",DDGFPG,DDGFBLCK,DA)
  1.  E  D
  1.  . S C=DDGFCAP_$S(DDGFTYPE'=1&'DDGFSUP:":",1:"")
  1.  . S C1=$P(DDGFCC,",")-1+DDGFB1
  1.  . S C2=$P(DDGFCC,",",2)-1+DDGFB2
  1.  . S C3=C2+$L(C)-1
  1.  . ;
  1.  . S @DDGFREF@("F",DDGFPG,DDGFBLCK,DA)=C1_U_C2_U_C3_U_C
  1.  . S @DDGFREF@("RC",DDGFWID,C1,C2,C3,DDGFBLCK,DA,"C")=""
  1.  . D WRITE^DDGLIBW(DDGFWID,C,C1-$P(DDGFLIM,U),C2-$P(DDGFLIM,U,2),"",1)
  1.  ;
  1.  I DDGFTYPE'=1 D
  1.  . S D1=$P(DDGFDC,",")-1+DDGFB1
  1.  . S D2=$P(DDGFDC,",",2)-1+DDGFB2
  1.  . S D3=D2+DDGFDL-1
  1.  . ;
  1.  . S $P(@DDGFREF@("F",DDGFPG,DDGFBLCK,DA),U,5,8)=D1_U_D2_U_D3_U_DDGFDL
  1.  . I D1]"",D2]"" S @DDGFREF@("RC",DDGFWID,D1,D2,D3,DDGFBLCK,DA,"D")=""
  1.  . D:DDGFDL WRITE^DDGLIBW(DDGFWID,$TR($J("",DDGFDL)," ","_"),D1-$P(DDGFLIM,U),D2-$P(DDGFLIM,U,2),"",1)
  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