DDGFFLD ;SFISC/MKO - EDIT A FIELD ;19APR2016
;;22.2;VA FileMan;**3,5**;Jan 05, 2016;Build 28
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;GFT;**1055**
;
;COME IN WITH 'F'=FIELD NUMBER ON BLOCK 'B', PAGE DDGFWID="P4"
;
EDIT ;
Q:$D(^DIST(.404,B,40,F,0))[0
I T="D" Q:C]"" K @DDGFREF@("F",DDGFPG,B,F)
;
S DDGFDY=DY,DDGFDX=DX
S DDGFTYPE=$P(^DIST(.404,B,40,F,0),U,3)
I 'DDGFTYPE D
. I $G(^DIST(.404,B,40,F,20))'?."^" S DDGFTYPE=2 Q
. I $P($G(^DIST(.404,B,0)),U,2),$G(^DIST(.404,B,40,F,1)) S DDGFTYPE=3
G:'DDGFTYPE EDITQ
;
S DDGFB2=@DDGFREF@("F",DDGFPG,B)
S DDGFB1=$P(DDGFB2,U),DDGFB2=$P(DDGFB2,U,2)
S DDGFDD=$P(^DIST(.404,B,0),U,2)
S (DDGFSUP,DDGFSUP0)=$S(C]""&(DDGFTYPE'=1):$E(C,$L(C))'=":",1:"")
S (DDGFCAP,DDGFCAP0)=$S(DDGFTYPE=1!DDGFSUP0:C,1:$E(C,1,$L(C)-1))
S (DDGFCC,DDGFCC0)=$S(C]"":C1-DDGFB1+1_","_(C2-DDGFB2+1),1:"")
I $D(D) D
. S (DDGFDL,DDGFDL0)=L
. S (DDGFDC,DDGFDC0)=D1-DDGFB1+1_","_(D2-DDGFB2+1)
K DDGFB1,DDGFB2
;
S DDSFILE=.404,DDSFILE(1)=.4044,DDSPARM="KSTW"
S DR="[DDGF FIELD "_$P("CAPTION ONLY^FORM ONLY^DD^COMPUTED",U,DDGFTYPE)_"]"
S DA=F,DA(1)=B
D
. N B,F,T,C,C1,C2,D,D1,D2,L,P1,P2
DDS . D ^DDS K DDSFILE,DDSPARM,DR,DDGFDD ;RECURSIVE CALL TO SCREENMAN FOR A GIVEN FIELD
;
;If caption, caption coords, data length, data coords, or suppress
;colon flag changed we need to update some local variables
I '$D(DA) D KILLPGS^DDGFFLDA(B,DDGFWID) ;FIELD IS GONE
I $D(DA)#2,$G(DDSSAVE) D ;BECAUSE DDSPARM CONTAINED "S", DDSSAVE CAN COME BACK FROM ^DDS
. S DDGFNDB=$G(@DDGFREF@("F",DDGFPG,B))
. S:DDGFCAP="" (DDGFSUP,DDGFCC)=""
. S DR=""
. ;
. I DDGFCAP'=DDGFCAP0!(DDGFSUP'=DDGFSUP0) D ;CAPTION HAS BEEN CHANGED
.. S C=DDGFCAP_$S(DDGFCAP]""&(DDGFTYPE'=1)&'DDGFSUP:":",1:"")
.. S:DDGFCAP'=DDGFCAP0 DR=DR_"1////"_$S(DDGFCAP]"":DDGFCAP,1:"@")_";"
.. S:DDGFSUP'=DDGFSUP0 DR=DR_"5.2////"_$S(DDGFSUP:1,1:"@")_";"
. ;
. D:DDGFCC'=DDGFCC0 ;LOCATION OF CAPTION HAS BEEN CHANGED
.. S C1=$S(DDGFCAP]"":$P(DDGFCC,",")-1+$P(DDGFNDB,U),1:"")
.. S C2=$S(DDGFCAP]"":$P(DDGFCC,",",2)-1+$P(DDGFNDB,U,2),1:"")
.. S DR=DR_"5.1////"_$S(DDGFCC]"":DDGFCC,1:"@")_";"
. ;
. D:$D(D)
.. D:DDGFDC'=DDGFDC0
... S D1=$P(DDGFDC,",")-1+$P(DDGFNDB,U)
... S D2=$P(DDGFDC,",",2)-1+$P(DDGFNDB,U,2)
... S DR=DR_"4.1////"_DDGFDC_";"
.. D:DDGFDL'=DDGFDL0
... S L=DDGFDL
... S D=$TR($J("",L)," ","_")
... S DR=DR_"4.2////"_DDGFDL_";"
. ;
. I T="D",C]"" D
.. D WRITE^DDGLIBW(DDGFWID,C,C1-P1,C2-P2,"",1)
.. S @DDGFREF@("RC",DDGFWID,C1,C2,C2+$L(C)-1,B,F,"C")=""
. ;
. I DR]"" D D KILLPGS^DDGFFLDA(B,DDGFWID) ;SOMETHING'S CHANGED, SO ERASE OTHER PAGES CONTAINING THIS BLOCK
.. N B,F,T,C,C1,C2,D,D1,D2,L,P1,P2
.. S DIE="^DIST(.404,"_DA(1)_",40,"
.. S DR=$E(DR,1,$L(DR)-1)
.. D ^DIE
;
K DA,DDGFNDB
K DDGFSUP,DDGFSUP0,DDGFCAP,DDGFCAP0,DDGFCC,DDGFCC0
K DDGFDL,DDGFDL0,DDGFDC,DDGFDC0,DDSSAVE
K DIE,DR
;
D REFRESH^DDGF,RC(DDGFDY,DDGFDX)
EDITQ S DDGFE=1
K DDGFDY,DDGFDX,DDGFTYPE
Q
;
RC(DDGFY,DDGFX) ;Update status line, reset DX and DY, move cursor
N S
I DDGFR D
. S DY=IOSL-6,DX=IOM-9,S="R"_(DDGFY+1)_",C"_(DDGFX+1)
. X IOXY W S_$J("",7-$L(S))
S DY=DDGFY,DX=DDGFX X IOXY
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDGFFLD 3425 printed Apr 09, 2024@21:46 Page 2
DDGFFLD ;SFISC/MKO - EDIT A FIELD ;19APR2016
+1 ;;22.2;VA FileMan;**3,5**;Jan 05, 2016;Build 28
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;GFT;**1055**
+7 ;
+8 ;COME IN WITH 'F'=FIELD NUMBER ON BLOCK 'B', PAGE DDGFWID="P4"
+9 ;
EDIT ;
+1 if $DATA(^DIST(.404,B,40,F,0))[0
QUIT
+2 IF T="D"
if C]""
QUIT
KILL @DDGFREF@("F",DDGFPG,B,F)
+3 ;
+4 SET DDGFDY=DY
SET DDGFDX=DX
+5 SET DDGFTYPE=$PIECE(^DIST(.404,B,40,F,0),U,3)
+6 IF 'DDGFTYPE
Begin DoDot:1
+7 IF $GET(^DIST(.404,B,40,F,20))'?."^"
SET DDGFTYPE=2
QUIT
+8 IF $PIECE($GET(^DIST(.404,B,0)),U,2)
IF $GET(^DIST(.404,B,40,F,1))
SET DDGFTYPE=3
End DoDot:1
+9 if 'DDGFTYPE
GOTO EDITQ
+10 ;
+11 SET DDGFB2=@DDGFREF@("F",DDGFPG,B)
+12 SET DDGFB1=$PIECE(DDGFB2,U)
SET DDGFB2=$PIECE(DDGFB2,U,2)
+13 SET DDGFDD=$PIECE(^DIST(.404,B,0),U,2)
+14 SET (DDGFSUP,DDGFSUP0)=$SELECT(C]""&(DDGFTYPE'=1):$EXTRACT(C,$LENGTH(C))'=":",1:"")
+15 SET (DDGFCAP,DDGFCAP0)=$SELECT(DDGFTYPE=1!DDGFSUP0:C,1:$EXTRACT(C,1,$LENGTH(C)-1))
+16 SET (DDGFCC,DDGFCC0)=$SELECT(C]"":C1-DDGFB1+1_","_(C2-DDGFB2+1),1:"")
+17 IF $DATA(D)
Begin DoDot:1
+18 SET (DDGFDL,DDGFDL0)=L
+19 SET (DDGFDC,DDGFDC0)=D1-DDGFB1+1_","_(D2-DDGFB2+1)
End DoDot:1
+20 KILL DDGFB1,DDGFB2
+21 ;
+22 SET DDSFILE=.404
SET DDSFILE(1)=.4044
SET DDSPARM="KSTW"
+23 SET DR="[DDGF FIELD "_$PIECE("CAPTION ONLY^FORM ONLY^DD^COMPUTED",U,DDGFTYPE)_"]"
+24 SET DA=F
SET DA(1)=B
+25 Begin DoDot:1
+26 NEW B,F,T,C,C1,C2,D,D1,D2,L,P1,P2
DDS ;RECURSIVE CALL TO SCREENMAN FOR A GIVEN FIELD
DO ^DDS
KILL DDSFILE,DDSPARM,DR,DDGFDD
End DoDot:1
+1 ;
+2 ;If caption, caption coords, data length, data coords, or suppress
+3 ;colon flag changed we need to update some local variables
+4 ;FIELD IS GONE
IF '$DATA(DA)
DO KILLPGS^DDGFFLDA(B,DDGFWID)
+5 ;BECAUSE DDSPARM CONTAINED "S", DDSSAVE CAN COME BACK FROM ^DDS
IF $DATA(DA)#2
IF $GET(DDSSAVE)
Begin DoDot:1
+6 SET DDGFNDB=$GET(@DDGFREF@("F",DDGFPG,B))
+7 if DDGFCAP=""
SET (DDGFSUP,DDGFCC)=""
+8 SET DR=""
+9 ;
+10 ;CAPTION HAS BEEN CHANGED
IF DDGFCAP'=DDGFCAP0!(DDGFSUP'=DDGFSUP0)
Begin DoDot:2
+11 SET C=DDGFCAP_$SELECT(DDGFCAP]""&(DDGFTYPE'=1)&'DDGFSUP:":",1:"")
+12 if DDGFCAP'=DDGFCAP0
SET DR=DR_"1////"_$SELECT(DDGFCAP]"":DDGFCAP,1:"@")_";"
+13 if DDGFSUP'=DDGFSUP0
SET DR=DR_"5.2////"_$SELECT(DDGFSUP:1,1:"@")_";"
End DoDot:2
+14 ;
+15 ;LOCATION OF CAPTION HAS BEEN CHANGED
if DDGFCC'=DDGFCC0
Begin DoDot:2
+16 SET C1=$SELECT(DDGFCAP]"":$PIECE(DDGFCC,",")-1+$PIECE(DDGFNDB,U),1:"")
+17 SET C2=$SELECT(DDGFCAP]"":$PIECE(DDGFCC,",",2)-1+$PIECE(DDGFNDB,U,2),1:"")
+18 SET DR=DR_"5.1////"_$SELECT(DDGFCC]"":DDGFCC,1:"@")_";"
End DoDot:2
+19 ;
+20 if $DATA(D)
Begin DoDot:2
+21 if DDGFDC'=DDGFDC0
Begin DoDot:3
+22 SET D1=$PIECE(DDGFDC,",")-1+$PIECE(DDGFNDB,U)
+23 SET D2=$PIECE(DDGFDC,",",2)-1+$PIECE(DDGFNDB,U,2)
+24 SET DR=DR_"4.1////"_DDGFDC_";"
End DoDot:3
+25 if DDGFDL'=DDGFDL0
Begin DoDot:3
+26 SET L=DDGFDL
+27 SET D=$TRANSLATE($JUSTIFY("",L)," ","_")
+28 SET DR=DR_"4.2////"_DDGFDL_";"
End DoDot:3
End DoDot:2
+29 ;
+30 IF T="D"
IF C]""
Begin DoDot:2
+31 DO WRITE^DDGLIBW(DDGFWID,C,C1-P1,C2-P2,"",1)
+32 SET @DDGFREF@("RC",DDGFWID,C1,C2,C2+$LENGTH(C)-1,B,F,"C")=""
End DoDot:2
+33 ;
+34 ;SOMETHING'S CHANGED, SO ERASE OTHER PAGES CONTAINING THIS BLOCK
IF DR]""
Begin DoDot:2
+35 NEW B,F,T,C,C1,C2,D,D1,D2,L,P1,P2
+36 SET DIE="^DIST(.404,"_DA(1)_",40,"
+37 SET DR=$EXTRACT(DR,1,$LENGTH(DR)-1)
+38 DO ^DIE
End DoDot:2
DO KILLPGS^DDGFFLDA(B,DDGFWID)
End DoDot:1
+39 ;
+40 KILL DA,DDGFNDB
+41 KILL DDGFSUP,DDGFSUP0,DDGFCAP,DDGFCAP0,DDGFCC,DDGFCC0
+42 KILL DDGFDL,DDGFDL0,DDGFDC,DDGFDC0,DDSSAVE
+43 KILL DIE,DR
+44 ;
+45 DO REFRESH^DDGF
DO RC(DDGFDY,DDGFDX)
EDITQ SET DDGFE=1
+1 KILL DDGFDY,DDGFDX,DDGFTYPE
+2 QUIT
+3 ;
RC(DDGFY,DDGFX) ;Update status line, reset DX and DY, move cursor
+1 NEW S
+2 IF DDGFR
Begin DoDot:1
+3 SET DY=IOSL-6
SET DX=IOM-9
SET S="R"_(DDGFY+1)_",C"_(DDGFX+1)
+4 XECUTE IOXY
WRITE S_$JUSTIFY("",7-$LENGTH(S))
End DoDot:1
+5 SET DY=DDGFY
SET DX=DDGFX
XECUTE IOXY
+6 QUIT
