Return to DDGFFLDA.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DDGFFLDA	;SFISC/MKO-ADD A FIELD ;01:43 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: ADD	;Add a field
    5: 	I '$O(^DIST(.403,+DDGFFM,40,DDGFPG,40,0)) D  Q
    6: 	. D MSG^DDGF($C(7)_"There are no blocks defined on this page.  To add a block, press <PF2>B.")
    7: 	. H 2 D MSG^DDGF()
    8: 	S DDGFDY=DY,DDGFDX=DX
    9: 	;
   10: 	;Invoke form to select block, field order, field type
   11: 	K DDGFBLCK,DDGFFORD,DDGFTYPE
   12: 	S DDSFILE=.404,DDSFILE(1)=.4044
   13: 	S DR="[DDGF FIELD ADD]",DDSPARM="KTW"
   14: 	D ^DDS K DDSFILE,DA,DR,DDSPARM
   15: 	;
   16: 	I '$D(DDGFBLCK)!'$D(DDGFFORD)!'$D(DDGFTYPE) G ADDQ
   17: 	;
   18: 	;Get relative field coordinates
   19: 	S (DDGFCAP,DDGFCAP0)=""
   20: 	S (DDGFSUP,DDGFSUP0)=""
   21: 	S (DDGFCC,DDGFCC0)=""
   22: 	;
   23: 	S DDGFB2=@DDGFREF@("F",DDGFPG,DDGFBLCK)
   24: 	S DDGFB1=$P(DDGFB2,U),DDGFB2=$P(DDGFB2,U,2)
   25: 	;
   26: 	I DDGFTYPE=1 D
   27: 	. S DDGFCC0=DDGFDY-DDGFB1+1_","_(DDGFDX-DDGFB2+1)
   28: 	E  D
   29: 	. S DDGFD1=DDGFDY-DDGFB1+1,DDGFD2=DDGFDX-DDGFB2+1
   30: 	. S (DDGFDC,DDGFDC0)=DDGFD1_","_DDGFD2
   31: 	. S (DDGFDL,DDGFDL0)=1
   32: 	;
   33: 	I DDGFTYPE'=1,DDGFD1<1!(DDGFD2<1) D  G ADDQ
   34: 	. D MSG^DDGF($C(7)_"Unable to add a field above or to the left of the block.")
   35: 	. H 2 D MSG^DDGF()
   36: 	;
   37: 	K DDGFD1,DDGFD2
   38: 	;
   39: 	;Add field order to block file
   40: 	S DIC="^DIST(.404,"_DDGFBLCK_",40,",DIC(0)="L"
   41: 	S DIC("P")=$P(^DD(.404,40,0),U,2)
   42: 	S DA(1)=DDGFBLCK,X=DDGFFORD
   43: 	D FILE^DICN
   44: 	I Y=-1 K DIC,DA,Y D MSG^DDGF($C(7)_"Unable to add field.") H 2 D MSG^DDGF() G ADDQ
   45: 	;
   46: 	;Stuff values for field type, data coordinate, and data length
   47: 	S DIE=DIC,DA(1)=DDGFBLCK,DA=+Y
   48: 	S DR="2////"_DDGFTYPE
   49: 	S:DDGFTYPE'=1 DR=DR_";4.1////"_DDGFDC_";4.2////1"
   50: 	D ^DIE K DIC,DIE,DR,Y
   51: 	;
   52: 	;Invoke appropriate form
   53: 	S DDSFILE=.404,DDSFILE(1)=.4044,DDSPARM="CKTW"
   54: 	S DDGFDD=$P(^DIST(.404,DDGFBLCK,0),U,2)
   55: 	S DR="[DDGF FIELD "_$P("CAPTION ONLY^FORM ONLY^DD^COMPUTED",U,DDGFTYPE)_"]"
   56: 	D ^DDS K DDSFILE,DR,DDSPARM,DDGFDD
   57: 	;
   58: 	I $D(DA)#2,DDGFTYPE'=1,$G(DDSCHANG)'=1 D
   59: 	. S DIK="^DIST(.404,"_DA(1)_",40,"
   60: 	. D ^DIK K DIK
   61: 	E  I $D(DA)#2 D
   62: 	. D SAVE
   63: 	. D LOADF
   64: 	;
   65: ADDQ	;Refresh and cleanup
   66: 	D REFRESH^DDGF
   67: 	D RC(DDGFDY,DDGFDX)
   68: 	;
   69: 	K DA,DDSCHANG
   70: 	K DDGFB1,DDGFB2,DDGFD1,DDGFD2
   71: 	K DDGFSUP,DDGFSUP0,DDGFCAP,DDGFCAP0,DDGFCC,DDGFCC0
   72: 	K DDGFDL,DDGFDL0,DDGFDC,DDGFDC0
   73: 	K DDGFDY,DDGFDX,DDGFBLCK,DDGFFORD,DDGFTYPE
   74: 	Q
   75: 	;
   76: SAVE	;Save changes to caption, coordinates, data length, and suppress
   77: 	;colon flag
   78: 	S:DDGFCAP="" (DDGFSUP,DDGFCC)=""
   79: 	S DR=""
   80: 	;
   81: 	S:DDGFCAP]"" DR=DR_"1////"_DDGFCAP_";"
   82: 	S:DDGFCC]"" DR=DR_"5.1////"_DDGFCC_";"
   83: 	S:DDGFSUP DR=DR_"5.2////1;"
   84: 	;
   85: 	I DDGFTYPE'=1 D
   86: 	. S:DDGFDC'=DDGFDC0 DR=DR_"4.1////"_DDGFDC_";"
   87: 	. S:DDGFDL'=DDGFDL0 DR=DR_"4.2////"_DDGFDL_";"
   88: 	I DR="" K DR Q
   89: 	;
   90: 	S DIE="^DIST(.404,"_DA(1)_",40,"
   91: 	S DR=$E(DR,1,$L(DR)-1)
   92: 	D ^DIE K DIE,DR,Y
   93: 	Q
   94: 	;
   95: LOADF	;Set DDGFREF and window buffer
   96: 	N C,C1,C2,C3,D,D1,D2,D3,L
   97: 	;
   98: 	I DDGFCAP="" D
   99: 	. S (C,C1,C2,C3)=""
  100: 	. K @DDGFREF@("F",DDGFPG,DDGFBLCK,DA)
  101: 	E  D
  102: 	. S C=DDGFCAP_$S(DDGFTYPE'=1&'DDGFSUP:":",1:"")
  103: 	. S C1=$P(DDGFCC,",")-1+DDGFB1
  104: 	. S C2=$P(DDGFCC,",",2)-1+DDGFB2
  105: 	. S C3=C2+$L(C)-1
  106: 	. ;
  107: 	. S @DDGFREF@("F",DDGFPG,DDGFBLCK,DA)=C1_U_C2_U_C3_U_C
  108: 	. S @DDGFREF@("RC",DDGFWID,C1,C2,C3,DDGFBLCK,DA,"C")=""
  109: 	. D WRITE^DDGLIBW(DDGFWID,C,C1-$P(DDGFLIM,U),C2-$P(DDGFLIM,U,2),"",1)
  110: 	;
  111: 	I DDGFTYPE'=1 D
  112: 	. S D1=$P(DDGFDC,",")-1+DDGFB1
  113: 	. S D2=$P(DDGFDC,",",2)-1+DDGFB2
  114: 	. S D3=D2+DDGFDL-1
  115: 	. ;
  116: 	. S $P(@DDGFREF@("F",DDGFPG,DDGFBLCK,DA),U,5,8)=D1_U_D2_U_D3_U_DDGFDL
  117: 	. I D1]"",D2]"" S @DDGFREF@("RC",DDGFWID,D1,D2,D3,DDGFBLCK,DA,"D")=""
  118: 	. D:DDGFDL WRITE^DDGLIBW(DDGFWID,$TR($J("",DDGFDL)," ","_"),D1-$P(DDGFLIM,U),D2-$P(DDGFLIM,U,2),"",1)
  119: 	Q
  120: 	;
  121: RC(DDGFY,DDGFX)	;Update status line, reset DX and DY, move cursor
  122: 	N S
  123: 	I DDGFR D
  124: 	. S DY=IOSL-6,DX=IOM-9,S="R"_(DDGFY+1)_",C"_(DDGFX+1)
  125: 	. X IOXY W S_$J("",7-$L(S))
  126: 	S DY=DDGFY,DX=DDGFX X IOXY
  127: 	Q